Tcl Source Code

}

#
declare 225 {
    Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
	    int keyc, Tcl_Obj *const keyv[], int flags)
}
declare 226 {
    int TclObjBeingDeleted(Tcl_Obj *objPtr)
}

declare 227 {
    void TclSetNsPath(Namespace *nsPtr, int pathLength,
            Tcl_Namespace *pathAry[])
}
#  Used to be needed for TclOO-extension; unneeded now that TclOO is in the
#  core and NRE-enabled
#  declare 228 {

 */

MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;

/*
 * The head of the list of free Tcl objects, and the total number of Tcl
 * objects ever allocated and freed.
 */

MODULE_SCOPE Tcl_Obj *	tclFreeObjList;

#ifdef TCL_COMPILE_STATS
MODULE_SCOPE long	tclObjsAlloced;
MODULE_SCOPE long	tclObjsFreed;
#define TCL_MAX_SHARED_OBJ_STATS 5
MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
#endif /* TCL_COMPILE_STATS */

/* Slot 223 is reserved */
/* 224 */
EXTERN TclPlatformType * TclGetPlatform(void);
/* 225 */
EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
				Tcl_Obj *rootPtr, int keyc,
				Tcl_Obj *const keyv[], int flags);
/* 226 */
EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
/* 227 */
EXTERN void		TclSetNsPath(Namespace *nsPtr, int pathLength,
				Tcl_Namespace *pathAry[]);
/* Slot 228 is reserved */
/* 229 */
EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
				const char *myName, int myFlags, int index);

    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);
    void (*reserved223)(void);
    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
    int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
    void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
    void (*reserved228)(void);
    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */

/* Slot 221 is reserved */
/* Slot 222 is reserved */
/* Slot 223 is reserved */
#define TclGetPlatform \
	(tclIntStubsPtr->tclGetPlatform) /* 224 */
#define TclTraceDictPath \
	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
#define TclObjBeingDeleted \
	(tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
#define TclSetNsPath \
	(tclIntStubsPtr->tclSetNsPath) /* 227 */
/* Slot 228 is reserved */
#define TclPtrMakeUpvar \
	(tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */
#define TclObjLookupVar \
	(tclIntStubsPtr->tclObjLookupVar) /* 230 */

 * Table of all object types.
 */

static Tcl_HashTable typeTable;
static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(tableMutex)





/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

char tclEmptyString = '\0';


/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeObjects --
 *
 *	This function is called by Tcl_Finalize to clean up all registered
 *	Tcl_ObjType's
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *

    /*
     * Invalidate the string rep first so we can use the bytes value for our
     * pointer chain, and signal an obj deletion (as opposed to shimmering)
     * with 'length == -1'.
     */

    TclInvalidateStringRep(objPtr);
    objPtr->length = -1;

    if (ObjDeletePending(context)) {
	PushObjToDelete(context, objPtr);
    } else {
	TCL_DTRACE_OBJ_FREE(objPtr);
	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	    ObjDeletionLock(context);

		Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclObjBeingDeleted --
 *
 *	This function returns 1 when the Tcl_Obj is being deleted. It is
 *	provided for the rare cases where the reason for the loss of an
 *	internal rep might be relevant. [FR 1512138]
 *
 * Results:
 *	1 if being deleted, 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclObjBeingDeleted(
    Tcl_Obj *objPtr)
{
    return (objPtr->length == -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
 *	Create and return a new object that is a duplicate of the argument

    0, /* 219 */
    0, /* 220 */
    0, /* 221 */
    0, /* 222 */
    0, /* 223 */
    TclGetPlatform, /* 224 */
    TclTraceDictPath, /* 225 */
    TclObjBeingDeleted, /* 226 */
    TclSetNsPath, /* 227 */
    0, /* 228 */
    TclPtrMakeUpvar, /* 229 */
    TclObjLookupVar, /* 230 */
    TclGetNamespaceFromObj, /* 231 */
    TclEvalObjEx, /* 232 */
    TclGetSrcInfoForPc, /* 233 */