* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
* needed by stdlib.h in some configurations.
*/
-#include <stdio.h>
-
#ifndef _TCL
#include "tcl.h"
#endif
+#include <stdio.h>
+
#include <ctype.h>
#ifdef NO_LIMITS_H
# include "../compat/limits.h"
typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
- Tcl_Interp* interp, char* name, int length,
+ Tcl_Interp* interp, CONST84 char* name, int length,
Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr));
typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
- Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ Tcl_Interp* interp, CONST84 char* name, Tcl_Namespace *context,
int flags, Tcl_Var *rPtr));
typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
- char* name, Tcl_Namespace *context, int flags,
+ CONST84 char* name, Tcl_Namespace *context, int flags,
Tcl_Command *rPtr));
typedef struct Tcl_ResolverInfo {
* namespace has already cached a Command *
* pointer; this causes all its cached
* Command* pointers to be invalidated. */
- int resolverEpoch; /* Incremented whenever the name resolution
- * rules change for this namespace; this
- * invalidates all byte codes compiled in
- * the namespace, causing the code to be
- * recompiled under the new rules. */
+ int resolverEpoch; /* Incremented whenever (a) the name resolution
+ * rules change for this namespace or (b) a
+ * newly added command shadows a command that
+ * is compiled to bytecodes.
+ * This invalidates all byte codes compiled
+ * in the namespace, causing the code to be
+ * recompiled under the new rules.*/
Tcl_ResolveCmdProc *cmdResProc;
/* If non-null, this procedure overrides
* the usual command resolution mechanism
} VarTrace;
/*
+ * The following structure defines a command trace, which is used to
+ * invoke a specific C procedure whenever certain operations are performed
+ * on a command.
+ */
+
+typedef struct CommandTrace {
+ Tcl_CommandTraceProc *traceProc;/* Procedure to call when operations given
+ * by flags are performed on command. */
+ ClientData clientData; /* Argument to pass to proc. */
+ int flags; /* What events the trace procedure is
+ * interested in: OR-ed combination of
+ * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
+ struct CommandTrace *nextPtr; /* Next in list of traces associated with
+ * a particular command. */
+} CommandTrace;
+
+/*
+ * When a command trace is active (i.e. its associated procedure is
+ * executing), one of the following structures is linked into a list
+ * associated with the command's interpreter. The information in
+ * the structure is needed in order for Tcl to behave reasonably
+ * if traces are deleted while traces are active.
+ */
+
+typedef struct ActiveCommandTrace {
+ struct Command *cmdPtr; /* Command that's being traced. */
+ struct ActiveCommandTrace *nextPtr;
+ /* Next in list of all active command
+ * traces for the interpreter, or NULL
+ * if no more. */
+ CommandTrace *nextTracePtr; /* Next trace to check after current
+ * trace procedure returns; if this
+ * trace gets deleted, must update pointer
+ * to avoid using free'd memory. */
+} ActiveCommandTrace;
+
+/*
* When a variable trace is active (i.e. its associated procedure is
* executing), one of the following structures is linked into a list
* associated with the variable's interpreter. The information in
typedef struct Trace {
int level; /* Only trace commands at nesting level
* less than or equal to this. */
- Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */
+ Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
ClientData clientData; /* Arbitrary value to pass to proc. */
struct Trace *nextPtr; /* Next in list of traces for this interp. */
+ int flags; /* Flags governing the trace - see
+ * Tcl_CreateObjTrace for details */
+ Tcl_CmdObjTraceDeleteProc* delProc;
+ /* Procedure to call when trace is deleted */
} Trace;
/*
+ * When an interpreter trace is active (i.e. its associated procedure
+ * is executing), one of the following structures is linked into a list
+ * associated with the interpreter. The information in the structure
+ * is needed in order for Tcl to behave reasonably if traces are
+ * deleted while traces are active.
+ */
+
+typedef struct ActiveInterpTrace {
+ struct ActiveInterpTrace *nextPtr;
+ /* Next in list of all active command
+ * traces for the interpreter, or NULL
+ * if no more. */
+ Trace *nextTracePtr; /* Next trace to check after current
+ * trace procedure returns; if this
+ * trace gets deleted, must update pointer
+ * to avoid using free'd memory. */
+} ActiveInterpTrace;
+
+/*
* The structure below defines an entry in the assocData hash table which
* is associated with an interpreter. The entry contains a pointer to a
* function to call when the interpreter is deleted, and a pointer to
typedef VOID **TclHandle;
-EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID *ptr));
-EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle));
-EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
-EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle));
-
/*
*----------------------------------------------------------------
* Data structures related to history. These are used primarily
int stackTop; /* Index of current top of stack; -1 when
* the stack is empty. */
int stackEnd; /* Index of last usable item in stack. */
+ Tcl_Obj *errorInfo;
+ Tcl_Obj *errorCode;
} ExecEnv;
/*
/* Procedure invoked when deleting command
* to, e.g., free all client data. */
ClientData deleteData; /* Arbitrary value passed to deleteProc. */
- int deleted; /* Means that the command is in the process
- * of being deleted (its deleteProc is
- * currently executing). Other attempts to
- * delete the command should be ignored. */
+ int flags; /* Miscellaneous bits of information about
+ * command. See below for definitions. */
ImportRef *importRefPtr; /* List of each imported Command created in
* another namespace when this command is
* imported. These imported commands
* command. The list is used to remove all
* those imported commands when deleting
* this "real" command. */
+ CommandTrace *tracePtr; /* First in list of all traces set for this
+ * command. */
} Command;
/*
+ * Flag bits for commands.
+ *
+ * CMD_IS_DELETED - Means that the command is in the process
+ * of being deleted (its deleteProc is
+ * currently executing). Other attempts to
+ * delete the command should be ignored.
+ * CMD_TRACE_ACTIVE - 1 means that trace processing is currently
+ * underway for a rename/delete change.
+ * See the two flags below for which is
+ * currently being processed.
+ * CMD_HAS_EXEC_TRACES - 1 means that this command has at least
+ * one execution trace (as opposed to simple
+ * delete/rename traces) in its tracePtr list.
+ * TCL_TRACE_RENAME - A rename trace is in progress. Further
+ * recursive renames will not be traced.
+ * TCL_TRACE_DELETE - A delete trace is in progress. Further
+ * recursive deletes will not be traced.
+ * (these last two flags are defined in tcl.h)
+ */
+#define CMD_IS_DELETED 0x1
+#define CMD_TRACE_ACTIVE 0x2
+#define CMD_HAS_EXEC_TRACES 0x4
+
+/*
*----------------------------------------------------------------
* Data structures related to name resolution procedures.
*----------------------------------------------------------------
/*
* Information related to procedures and variables. See tclProc.c
- * and tclvar.c for usage.
+ * and tclVar.c for usage.
*/
int numLevels; /* Keeps track of how many nested calls to
* unless an "uplevel" command is
* executing). NULL means no procedure is
* active or "uplevel 0" is executing. */
- ActiveVarTrace *activeTracePtr;
+ ActiveVarTrace *activeVarTracePtr;
/* First in list of active traces for
* interp, or NULL if no active traces. */
int returnCode; /* Completion code to return if current
* are added/removed by calling
* Tcl_AddInterpResolvers and
* Tcl_RemoveInterpResolver. */
- char *scriptFile; /* NULL means there is no nested source
+ Tcl_Obj *scriptFile; /* NULL means there is no nested source
* command active; otherwise this points to
- * the name of the file being sourced (it's
- * not malloc-ed: it points to an argument
- * to Tcl_EvalFile. */
+ * pathPtr of the file being sourced. */
int flags; /* Various flag bits. See below. */
long randSeed; /* Seed used for rand() function. */
Trace *tracePtr; /* List of traces for this interpreter. */
* accessed directly; see comment above. */
Tcl_ThreadId threadId; /* ID of thread that owns the interpreter */
+ ActiveCommandTrace *activeCmdTracePtr;
+ /* First in list of active command traces for
+ * interp, or NULL if no active traces. */
+ ActiveInterpTrace *activeInterpTracePtr;
+ /* First in list of active traces for
+ * interp, or NULL if no active traces. */
+
+ int tracesForbiddingInline; /* Count of traces (in the list headed by
+ * tracePtr) that forbid inline bytecode
+ * compilation */
/*
* Statistical information about the bytecode compiler and interpreter's
* operation.
* interpreter; instead, have Tcl_EvalObj call
* Tcl_EvalEx. Used primarily for testing the
* new parser.
+ * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
+ * active; so no further trace callbacks should be
+ * invoked.
*/
#define DELETED 1
#define RAND_SEED_INITIALIZED 0x40
#define SAFE_INTERP 0x80
#define USE_EVAL_DIRECT 0x100
+#define INTERP_TRACE_IN_PROGRESS 0x200
/*
*----------------------------------------------------------------
#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
/*
- * The following macros are used to specify the runtime platform
+ * The following enum values are used to specify the runtime platform
* setting of the tclPlatform variable.
*/
} TclPlatformType;
/*
+ * The following enum values are used to indicate the translation
+ * of a Tcl channel. Declared here so that each platform can define
+ * TCL_PLATFORM_TRANSLATION to the native translation on that platform
+ */
+
+typedef enum TclEolTranslation {
+ TCL_TRANSLATE_AUTO, /* Eol == \r, \n and \r\n. */
+ TCL_TRANSLATE_CR, /* Eol == \r. */
+ TCL_TRANSLATE_LF, /* Eol == \n. */
+ TCL_TRANSLATE_CRLF /* Eol == \r\n. */
+} TclEolTranslation;
+
+/*
* Flags for TclInvoke:
*
* TCL_INVOKE_HIDDEN Invoke a hidden command; if not set,
*/
typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName, Tcl_Obj **attrObjPtrPtr));
+ int objIndex, Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr));
typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName, Tcl_Obj *attrObjPtr));
+ int objIndex, Tcl_Obj *fileName, Tcl_Obj *attrObjPtr));
typedef struct TclFileAttrProcs {
TclGetFileAttrProc *getProc; /* The procedure for getting attrs. */
typedef struct TclFile_ *TclFile;
/*
+ * Opaque names for platform specific types.
+ */
+
+typedef struct TclpTime_t_ *TclpTime_t;
+
+/*
+ * The "globParameters" argument of the function TclGlob is an
+ * or'ed combination of the following values:
+ */
+
+#define TCL_GLOBMODE_NO_COMPLAIN 1
+#define TCL_GLOBMODE_JOIN 2
+#define TCL_GLOBMODE_DIR 4
+#define TCL_GLOBMODE_TAILS 8
+
+/*
*----------------------------------------------------------------
- * Data structures related to hooking 'TclStat(...)' and
- * 'TclAccess(...)'.
+ * Data structures related to obsolete filesystem hooks
*----------------------------------------------------------------
*/
typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, struct stat *buf));
typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path, int mode));
typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, char *modeString,
+ CONST char *fileName, CONST char *modeString,
int permissions));
-typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
/*
- * Opaque names for platform specific types.
- */
-
-typedef struct TclpTime_t_ *TclpTime_t;
-
-/*
- * The following structure is used to pass glob type data amongst
- * the various glob routines and TclpMatchFilesTypes. Currently
- * most of the fields are ignored. However they will be used in
- * a future release to implement glob's ability to find files
- * of particular types/permissions/etc only.
- */
-typedef struct GlobTypeData {
- /* Corresponds to bcdpfls as in 'find -t' */
- int type;
- /* Corresponds to file permissions */
- int perm;
- /* Acceptable mac type */
- Tcl_Obj* macType;
- /* Acceptable mac creator */
- Tcl_Obj* macCreator;
-} GlobTypeData;
-
-/*
- * type and permission definitions for glob command
+ *----------------------------------------------------------------
+ * Data structures related to procedures
+ *----------------------------------------------------------------
*/
-#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_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)
+typedef Tcl_CmdProc *TclCmdProcType;
+typedef Tcl_ObjCmdProc *TclObjCmdProcType;
/*
*----------------------------------------------------------------
extern Tcl_ChannelType tclFileChannelType;
extern char * tclMemDumpFileName;
extern TclPlatformType tclPlatform;
-extern char * tclpFileAttrStrings[];
-extern CONST TclFileAttrProcs tclpFileAttrProcs[];
/*
* Variables denoting the Tcl object types defined in the core.
extern Tcl_ObjType tclByteArrayType;
extern Tcl_ObjType tclByteCodeType;
extern Tcl_ObjType tclDoubleType;
+extern Tcl_ObjType tclEndOffsetType;
extern Tcl_ObjType tclIntType;
extern Tcl_ObjType tclListType;
extern Tcl_ObjType tclProcBodyType;
extern Tcl_ObjType tclStringType;
+extern Tcl_ObjType tclArraySearchType;
+extern Tcl_ObjType tclIndexType;
+extern Tcl_ObjType tclNsNameType;
+#ifndef TCL_WIDE_INT_IS_LONG
+extern Tcl_ObjType tclWideIntType;
+#endif
+
+/*
+ * Variables denoting the hash key types defined in the core.
+ */
+
+extern Tcl_HashKeyType tclArrayHashKeyType;
+extern Tcl_HashKeyType tclOneWordHashKeyType;
+extern Tcl_HashKeyType tclStringHashKeyType;
+extern Tcl_HashKeyType tclObjHashKeyType;
/*
* The head of the list of free Tcl objects, and the total number of Tcl
#ifdef TCL_COMPILE_STATS
extern long tclObjsAlloced;
extern long tclObjsFreed;
+#define TCL_MAX_SHARED_OBJ_STATS 5
+extern long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
#endif /* TCL_COMPILE_STATS */
/*
*/
extern char * tclEmptyStringRep;
+extern char tclEmptyString;
/*
*----------------------------------------------------------------
*----------------------------------------------------------------
*/
-EXTERN int TclAccess _ANSI_ARGS_((CONST char *path,
- int mode));
-EXTERN int TclAccessDeleteProc _ANSI_ARGS_((TclAccessProc_ *proc));
-EXTERN int TclAccessInsertProc _ANSI_ARGS_((TclAccessProc_ *proc));
-EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void));
EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
- char *value));
-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 TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel inChan, Tcl_Channel outChan,
- int toRead, Tcl_Obj *cmdPtr));
-/*
- * TclCreatePipeline unofficially exported for use by BLT.
- */
-EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, Tcl_Pid **pidArrayPtr,
- TclFile *inPipePtr, TclFile *outPipePtr,
- TclFile *errFilePtr));
-EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
- Namespace *nsPtr, 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, GlobTypeData *types));
-EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
+ CONST char *value));
EXTERN void TclExpandTokenArray _ANSI_ARGS_((
Tcl_Parse *parsePtr));
-EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
- double value));
EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv)) ;
+ int objc, Tcl_Obj *CONST objv[])) ;
EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv));
+ int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv)) ;
+ int objc, Tcl_Obj *CONST objv[])) ;
EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv)) ;
+ int objc, Tcl_Obj *CONST objv[])) ;
EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void));
EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void));
EXTERN void TclFinalizeExecution _ANSI_ARGS_((void));
EXTERN void TclFinalizeIOSubsystem _ANSI_ARGS_((void));
+EXTERN void TclFinalizeFilesystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeLoad _ANSI_ARGS_((void));
EXTERN void TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void));
+EXTERN void TclFinalizeAsync _ANSI_ARGS_((void));
EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void));
EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void));
EXTERN void TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
-EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp *iPtr,
- 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,
- unsigned long now, long zone,
- unsigned long *timePtr));
-EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- Tcl_Obj *elemPtr, int leaveErrorMsg));
-EXTERN char * TclGetExtension _ANSI_ARGS_((char *name));
-EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, CallFrame **framePtrPtr));
-EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
-EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int endValue, int *indexPtr));
-EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
- int localIndex, int leaveErrorMsg));
-EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, long *longPtr));
-EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
- Tcl_Interp *interp, char *targetName));
-EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
- Tcl_Interp *interp, char *qualName,
- Namespace *cxtNsPtr, int flags,
- Namespace **nsPtrPtr, Namespace **altNsPtrPtr,
- Namespace **actualCxtPtrPtr,
- char **simpleNamePtr));
-EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
-EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *seekFlagPtr));
-EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
- Tcl_Command command));
EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
- char *pattern, char *unquotedPrefix,
- int globFlags, GlobTypeData* types));
-EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int flags));
-EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName,
- Tcl_DString *bufPtr));
-EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
- Tcl_Interp *interp));
-EXTERN int TclInExit _ANSI_ARGS_((void));
-EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- Tcl_Obj *elemPtr, long incrAmount));
-EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- long incrAmount));
-EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- long incrAmount, int flags));
+ char *pattern, Tcl_Obj *unquotedPrefix,
+ int globFlags, Tcl_GlobTypeData* types));
EXTERN void TclInitAlloc _ANSI_ARGS_((void));
-EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
- Tcl_Interp *interp, CallFrame *framePtr,
- Namespace *nsPtr));
EXTERN void TclInitDbCkalloc _ANSI_ARGS_((void));
EXTERN void TclInitEncodingSubsystem _ANSI_ARGS_((void));
EXTERN void TclInitIOSubsystem _ANSI_ARGS_((void));
EXTERN void TclInitNotifier _ANSI_ARGS_((void));
EXTERN void TclInitObjSubsystem _ANSI_ARGS_((void));
EXTERN void TclInitSubsystems _ANSI_ARGS_((CONST char *argv0));
-EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int flags));
-EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
-EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src,
int len));
-EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr));
-EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags, char *msg,
- int createPart1, int createPart2,
- Var **arrayPtrPtr));
-EXTERN int TclMathInProgress _ANSI_ARGS_((void));
-EXTERN int TclNeedSpace _ANSI_ARGS_((char *start, char *end));
-EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
-EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
-EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
-EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
-EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_((
- TclOpenFileChannelProc_ *proc));
-EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_((
- TclOpenFileChannelProc_ *proc));
-EXTERN int TclpAccess _ANSI_ARGS_((CONST char *filename,
+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 char * TclpAlloc _ANSI_ARGS_((unsigned int size));
+EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ Tcl_StatBuf *buf));
EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
-EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char *source,
- CONST char *dest));
-EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char *source,
- CONST char *dest, Tcl_DString *errorPtr));
-EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char *path));
-EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path));
-EXTERN void TclpExit _ANSI_ARGS_((int status));
+EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void));
EXTERN void TclpFinalizeCondition _ANSI_ARGS_((
Tcl_Condition *condPtr));
EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
CONST char *argv0));
EXTERN int TclpFindVariable _ANSI_ARGS_((CONST char *name,
int *lengthPtr));
-EXTERN void TclpFree _ANSI_ARGS_((char *ptr));
-EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
-EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
-EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
-EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
-EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
-EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char *name,
- Tcl_DString *bufferPtr));
-EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0));
EXTERN void TclpInitLock _ANSI_ARGS_((void));
EXTERN void TclpInitPlatform _ANSI_ARGS_((void));
EXTERN void TclpInitUnlock _ANSI_ARGS_((void));
-EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp));
+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 Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void));
EXTERN void TclpMasterLock _ANSI_ARGS_((void));
EXTERN void TclpMasterUnlock _ANSI_ARGS_((void));
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 TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
+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 TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr));
+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 int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj*pathPtr));
+EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, char *modeString,
+ 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 char * TclpRealloc _ANSI_ARGS_((char *ptr,
- unsigned int size));
EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file));
-EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path,
- int recursive, Tcl_DString *errorPtr));
-EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char *source,
- CONST char *dest));
-EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void));
EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
-EXTERN void TclpSysFree _ANSI_ARGS_((VOID *ptr));
-EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID *cp,
- unsigned int size));
-EXTERN void TclpUnloadFile _ANSI_ARGS_((ClientData clientData));
-EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, char *name2,
- int flags));
-EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *cmdInterp, Tcl_Command cmd));
-EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
-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 TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN void TclpUnloadFile _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
EXTERN VOID * TclpThreadDataKeyGet _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr));
EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_((
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 int TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *oldName, char *newName)) ;
-EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_((
- Tcl_Interp *interp, Command *newCmdPtr));
-EXTERN int TclServiceIdle _ANSI_ARGS_((void));
-EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- Tcl_Obj *elemPtr, Tcl_Obj *objPtr,
- int leaveErrorMsg));
-EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
- int localIndex, Tcl_Obj *objPtr,
- int leaveErrorMsg));
-EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char *string));
-EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *proto, int *portPtr));
-EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
- int size));
-EXTERN int TclStat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc));
-EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc));
-EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
+EXTERN VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
+ int result));
EXTERN void TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
int result, Tcl_Interp *targetInterp));
-EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
+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));
/*
*----------------------------------------------------------------
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_LsetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
#ifdef MAC_TCL
EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST84 char **argv));
EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
*----------------------------------------------------------------
*/
+EXTERN int TclCompileAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLindexCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileListCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLlengthCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLsetCmd _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
+EXTERN int TclCompileRegexpCmd _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
+EXTERN int TclCompileReturnCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileStringCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
/*
+ * Functions defined in generic/tclVar.c and currenttly exported only
+ * for use by the bytecode compiler and engine. Some of these could later
+ * be placed in the public interface.
+ */
+
+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));
+
+/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
* TclNewObj(objPtr) creates a new object denoting an empty string.
*
* EXTERN void TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
* EXTERN void TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+ *
+ * These macros are defined in terms of two macros that depend on
+ * memory allocator in use: TclAllocObjStorage, TclFreeObjStorage.
+ * They are defined below.
*----------------------------------------------------------------
*/
# define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */
-#ifdef TCL_MEM_DEBUG
-# define TclNewObj(objPtr) \
- (objPtr) = (Tcl_Obj *) \
- Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
- (objPtr)->length = 0; \
- (objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated()
-
-# define TclDbNewObj(objPtr, file, line) \
- (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+#define TclNewObj(objPtr) \
+ TclAllocObjStorage(objPtr); \
+ TclIncrObjsAllocated(); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
- (objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated()
-
-# define TclDecrRefCount(objPtr) \
+ (objPtr)->typePtr = NULL
+
+#define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount <= 0) { \
- if ((objPtr)->refCount < -1) \
- panic("Reference count for %lx was negative: %s line %d", \
- (objPtr), __FILE__, __LINE__); \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
if (((objPtr)->typePtr != NULL) \
&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
(objPtr)->typePtr->freeIntRepProc(objPtr); \
} \
- ckfree((char *) (objPtr)); \
+ if (((objPtr)->bytes != NULL) \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ ckfree((char *) (objPtr)->bytes); \
+ } \
+ TclFreeObjStorage(objPtr); \
TclIncrObjsFreed(); \
}
+#ifdef TCL_MEM_DEBUG
+# define TclAllocObjStorage(objPtr) \
+ (objPtr) = (Tcl_Obj *) \
+ Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__)
+
+# define TclFreeObjStorage(objPtr) \
+ if ((objPtr)->refCount < -1) { \
+ panic("Reference count for %lx was negative: %s line %d", \
+ (objPtr), __FILE__, __LINE__); \
+ } \
+ ckfree((char *) (objPtr))
+
+# define TclDbNewObj(objPtr, file, line) \
+ (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+ (objPtr)->refCount = 0; \
+ (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->length = 0; \
+ (objPtr)->typePtr = NULL; \
+ TclIncrObjsAllocated()
+
+#elif defined(PURIFY)
+
+/*
+ * The PURIFY mode is like the regular mode, but instead of doing block
+ * Tcl_Obj allocation and keeping a freed list for efficiency, it always
+ * allocates and frees a single Tcl_Obj so that tools like Purify can
+ * better track memory leaks
+ */
+
+# define TclAllocObjStorage(objPtr) \
+ (objPtr) = (Tcl_Obj *) Tcl_Ckalloc(sizeof(Tcl_Obj))
+
+# define TclFreeObjStorage(objPtr) \
+ ckfree((char *) (objPtr))
+
+#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+
+/*
+ * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's
+ * from per-thread caches.
+ */
+
+EXTERN Tcl_Obj *TclThreadAllocObj _ANSI_ARGS_((void));
+EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *));
+
+# define TclAllocObjStorage(objPtr) \
+ (objPtr) = TclThreadAllocObj()
+
+# define TclFreeObjStorage(objPtr) \
+ TclThreadFreeObj((objPtr))
+
#else /* not TCL_MEM_DEBUG */
#ifdef TCL_THREADS
+/* declared in tclObj.c */
extern Tcl_Mutex tclObjMutex;
#endif
-# define TclNewObj(objPtr) \
- Tcl_MutexLock(&tclObjMutex); \
- if (tclFreeObjList == NULL) { \
- TclAllocateFreeObjects(); \
- } \
- (objPtr) = tclFreeObjList; \
- tclFreeObjList = (Tcl_Obj *) \
- tclFreeObjList->internalRep.otherValuePtr; \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
- (objPtr)->length = 0; \
- (objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated(); \
- Tcl_MutexUnlock(&tclObjMutex)
+# define TclAllocObjStorage(objPtr) \
+ Tcl_MutexLock(&tclObjMutex); \
+ if (tclFreeObjList == NULL) { \
+ TclAllocateFreeObjects(); \
+ } \
+ (objPtr) = tclFreeObjList; \
+ tclFreeObjList = (Tcl_Obj *) \
+ tclFreeObjList->internalRep.otherValuePtr; \
+ Tcl_MutexUnlock(&tclObjMutex)
+
+# define TclFreeObjStorage(objPtr) \
+ Tcl_MutexLock(&tclObjMutex); \
+ (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
+ tclFreeObjList = (objPtr); \
+ Tcl_MutexUnlock(&tclObjMutex)
-# define TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount <= 0) { \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
- if (((objPtr)->typePtr != NULL) \
- && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
- (objPtr)->typePtr->freeIntRepProc(objPtr); \
- } \
- Tcl_MutexLock(&tclObjMutex); \
- (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
- tclFreeObjList = (objPtr); \
- TclIncrObjsFreed(); \
- Tcl_MutexUnlock(&tclObjMutex); \
- }
#endif /* TCL_MEM_DEBUG */
/*
#define TclGetString(objPtr) \
((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to compare Unicode strings. On
+ * big-endian systems we can use the more efficient memcmp, but
+ * this would not be lexically correct on little-endian systems.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN int TclUniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar *cs,
+ * CONST Tcl_UniChar *ct, unsigned long n));
+ *----------------------------------------------------------------
+ */
+#ifdef WORDS_BIGENDIAN
+# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
+#else /* !WORDS_BIGENDIAN */
+# define TclUniCharNcmp Tcl_UniCharNcmp
+#endif /* WORDS_BIGENDIAN */
+
#include "tclIntDecls.h"
# undef TCL_STORAGE_CLASS
#endif /* _TCLINT */
-
OSDN Git Service
