Tcl Source Code

2013-02-22  Don Porter  <[email protected]>

	* generic/tclCompile.c:	Shift more burden of smart cleanup onto the
	* generic/tclExecute.c:	TclFreeCompileEnv() routine.  Stop crashes
	when the hookProc raises an error.

2013-02-20  Don Porter  <[email protected]>

	* generic/tclNamesp.c:	[Bug 3605447] Make sure the -clear option
	* tests/namespace.test:	to [namespace export] always clears, whether
	or not new export patterns are specified.

2013-02-15  Don Porter  <[email protected]>

    CompileHookProc *hookProc;	/* Procedure to invoke after compilation. */
    ClientData clientData;	/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure
				 * allocated in frame. */
    LiteralTable *localTablePtr = &(compEnv.localLitTable);



    int length, nested, result;
    char *string;
#ifdef TCL_TIP280
    ContLineLoc* clLocPtr;
#endif
#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {

	 * objects and aux data items is given to the ByteCode object.
	 */
    
#ifdef TCL_COMPILE_DEBUG
	TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/

	if (result == TCL_OK) {
	    TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
	    if (tclTraceCompile >= 2) {
		TclPrintByteCodeObj(interp, objPtr);
	    }
#endif /* TCL_COMPILE_DEBUG */
	}
    }




	



















    /*
     * Free storage allocated during compilation.
     */
    
    if (localTablePtr->buckets != localTablePtr->staticBuckets) {
	ckfree((char *) localTablePtr->buckets);
    }

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

void
TclFreeCompileEnv(envPtr)
    register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
{
    if (envPtr->source) {
	/* 
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */

	int i;
	LiteralEntry *entryPtr = envPtr->literalArrayPtr;
	AuxData *auxDataPtr = envPtr->auxDataArrayPtr;

	for (i = 0;  i < envPtr->literalArrayNext;  i++) {
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
	    entryPtr++;
	}

#ifdef TCL_COMPILE_DEBUG
	TclVerifyGlobalLiteralTable(envPtr->iPtr);
#endif /*TCL_COMPILE_DEBUG*/

	for (i = 0;  i < envPtr->auxDataArrayNext;  i++) {
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    if (envPtr->mallocedCodeArray) {
	ckfree((char *) envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	ckfree((char *) envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {

#ifdef TCL_TIP280
    /* TIP #280 */
    ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
    int* wlines = NULL;
    int  wlineat, cmdLine;
    int* clNext;
#endif

    if (envPtr->source == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    Tcl_DStringInit(&ds);

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    int numLitObjects = envPtr->literalArrayNext;
    Namespace *namespacePtr;
    int i;
#ifdef TCL_TIP280
    int new;
#endif
    Interp *iPtr;

    if (envPtr->source == NULL) {
	Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
    }

    iPtr = envPtr->iPtr;

    codeBytes = (envPtr->codeNext - envPtr->codeStart);
    objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
    exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
    auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));

     * byte code object (internal rep), for use with the bc compiler.
     */

    Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->lineBCPtr, (char*) codePtr, &new),
		      envPtr->extCmdMapPtr);
    envPtr->extCmdMapPtr = NULL;
#endif

    /* We've used up the CompileEnv.  Mark as uninitialized. */
    envPtr->source = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * LogCompilationInfo --
 *

    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure
				 * allocated in frame. */
    LiteralTable *localTablePtr = &(compEnv.localLitTable);
    register ByteCode *codePtr = NULL;
    				/* Tcl Internal type of bytecode.
				 * Initialized to avoid compiler warning. */


    Tcl_Obj *saveObjPtr;
    char *string;
    int length, result;

    /*
     * First handle some common expressions specially.
     */

    string = Tcl_GetStringFromObj(objPtr, &length);
    if (length == 1) {

	    /*
	     * Compilation errors. Free storage allocated for compilation.
	     */

#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/




    











	    TclFreeCompileEnv(&compEnv);
	    goto done;
	}

	/*
	 * Successful compilation. If the expression yielded no
	 * instructions, push an zero object as the expression's result.