Tcl Source Code

static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static void		RegisterAuxDataType(AuxDataType *typePtr);
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    unsigned char *pc, Tcl_Obj *bufferObj);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, int maxChars);
/*

{
    return &tclInstructionTable[0];
}

/*
 *--------------------------------------------------------------
 *
 * RegisterAuxDataType --
 *
 *	This procedure is called to register a new AuxData type in the table
 *	of all AuxData types supported by Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The type is registered in the AuxData type table. If there was already
 *	a type with the same name as in typePtr, it is replaced with the new
 *	type.
 *
 *--------------------------------------------------------------
 */

static void
RegisterAuxDataType(
    AuxDataType *typePtr)	/* Information about object type; storage must
				 * be statically allocated (must live forever;
				 * will not be deallocated). */
{
    register Tcl_HashEntry *hPtr;
    int isNew;

    auxDataTypeTableInitialized = 1;
    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);

    /*
     * There are only two AuxData type at this time, so register them here.
     */

    RegisterAuxDataType(&tclForeachInfoType);
    RegisterAuxDataType(&tclJumptableInfoType);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAuxDataTypeTable --
 *

			    int catchOnly, ByteCode* codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int	TclFindCompiledLocal(CONST char *name, int nameChars,
			    int create, Proc *procPtr);


MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitAuxDataTypeTable(void);
MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,

#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode* codePtr,
			    unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    CONST char *string, int maxChars);

MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
			    char *bytes, int length, int flags);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,

 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned int	HashString(const char *bytes, int length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*
 *----------------------------------------------------------------------
 *
 * TclInitLiteralTable --
 *

	objPtr->bytes = bytes;
	objPtr->length = length;
    } else {
	TclInitStringRep(objPtr, bytes, length);
    }

#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
		(length>60? 60 : length), bytes);
    }
#endif

    globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;

		(length>60? 60 : length), bytes, globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * LookupLiteralEntry --
 *
 *	Finds the LiteralEntry that corresponds to a literal Tcl object
 *	holding a literal.
 *
 * Results:
 *	Returns the matching LiteralEntry if found, otherwise NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static LiteralEntry *
LookupLiteralEntry(
    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    register Tcl_Obj *objPtr)	/* Points to a Tcl object holding a literal
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;

	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;
}

#endif
/*
 *----------------------------------------------------------------------
 *
 * TclHideLiteral --
 *
 *	Remove a literal entry from the literal hash tables, leaving it in the
 *	literal array so existing references continue to function. This makes

		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
		    localPtr->objPtr) == NULL) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
			(length>60? 60 : length), bytes);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep");