Tcl Source Code

Check-in [06abbd6e02]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Shift more burden of smart cleanup onto the TclFreeCompileEnv() routine. Stop crashes when the hookProc raises an error.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 06abbd6e02950bdc740301abedaed7f7e3f5c76b
User & Date: dgp 2013-02-22 18:26:10
Context
2013-02-22
18:54
Restore the ReleaseCmdWordData cleanup routine from 8.4, to plug very rare memory leak. check-in: a616d4b120 user: dgp tags: core-8-5-branch
18:26
Shift more burden of smart cleanup onto the TclFreeCompileEnv() routine. Stop crashes when the hookP... check-in: 06abbd6e02 user: dgp tags: core-8-5-branch
18:24
Use iPtr field instead of source field to mark a CompileEnv as uninitialized. envPtr->source == NULL... check-in: 5c01d3bd75 user: dgp tags: core-8-4-branch
17:38
Shift more burden of smart cleanup onto the TclFreeCompileEnv() routine. Stop crashes when the hookP... check-in: 4b47ba25b7 user: dgp tags: core-8-4-branch
2013-02-21
03:16
3605447 Make sure the -clear option to [namespace export] always clears, whether or not new export p... check-in: a238b854d7 user: dgp tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 







1
2
3
4
5
6
7







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-19  Jan Nijtmans  <[email protected]>

>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13

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

	* generic/tclCompile.c:	Shift more burden of smart cleanup onto the
	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-19  Jan Nijtmans  <[email protected]>
︙︙

Changes to generic/tclCompile.c.

︙︙
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494

    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    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. */
    register AuxData *auxDataPtr;
    LiteralEntry *entryPtr;
    register int i;
    int length, result = TCL_OK;
    const char *stringPtr;
    ContLineLoc* clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
	if (Tcl_LinkVar(interp, "tcl_traceCompile",








<
<
<








478
479
480
481
482
483
484



485
486
487
488
489
490
491

    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    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. */



    int length, result = TCL_OK;
    const char *stringPtr;
    ContLineLoc* clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
	if (Tcl_LinkVar(interp, "tcl_traceCompile",
︙︙
549
550
551
552
553
554
555

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591

     * objects and aux data items is given to the ByteCode object.
     */

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


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

    if (result != TCL_OK) {
	/*
	 * Handle any error from the hookProc
	 */

	entryPtr = compEnv.literalArrayPtr;
	for (i = 0;  i < compEnv.literalArrayNext;  i++) {
	    TclReleaseLiteral(interp, entryPtr->objPtr);
	    entryPtr++;
	}
#ifdef TCL_COMPILE_DEBUG
	TclVerifyGlobalLiteralTable(iPtr);
#endif /*TCL_COMPILE_DEBUG*/

	auxDataPtr = compEnv.auxDataArrayPtr;
	for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }

    TclFreeCompileEnv(&compEnv);
    return result;
}

/*








>
|

|
|
|
|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








546
547
548
549
550
551
552
553
554
555
556
557
558
559
560






















561
562
563
564
565
566
567

     * 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);
	    fflush(stdout);
	}
#endif /* TCL_COMPILE_DEBUG */






















    }

    TclFreeCompileEnv(&compEnv);
    return result;
}

/*
︙︙
1045
1046
1047
1048
1049
1050
1051


























1052
1053
1054
1055
1056
1057
1058

void
TclFreeCompileEnv(
    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets) {
	ckfree((char *) envPtr->localLitTable.buckets);
	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;


























    }
    if (envPtr->mallocedCodeArray) {
	ckfree((char *) envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	ckfree((char *) envPtr->literalArrayPtr);
    }








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060

void
TclFreeCompileEnv(
    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets) {
	ckfree((char *) envPtr->localLitTable.buckets);
	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
    }
    if (envPtr->iPtr) {
	/* 
	 * 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);
    }
︙︙
1205
1206
1207
1208
1209
1210
1211




1212
1213
1214
1215
1216
1217
1218

    Tcl_DString ds;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine;
    int* clNext;
    Tcl_Parse *parsePtr = (Tcl_Parse *)
	    TclStackAlloc(interp, sizeof(Tcl_Parse));





    Tcl_DStringInit(&ds);

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








>
>
>
>








1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224

    Tcl_DString ds;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine;
    int* clNext;
    Tcl_Parse *parsePtr = (Tcl_Parse *)
	    TclStackAlloc(interp, sizeof(Tcl_Parse));

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

    Tcl_DStringInit(&ds);

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);
︙︙
2111
2112
2113
2114
2115
2116
2117




2118
2119
2120
2121
2122
2123
2124

#ifdef TCL_COMPILE_DEBUG
    unsigned char *nextPtr;
#endif
    int numLitObjects = envPtr->literalArrayNext;
    Namespace *namespacePtr;
    int i, isNew;
    Interp *iPtr;





    iPtr = envPtr->iPtr;

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








>
>
>
>








2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134

#ifdef TCL_COMPILE_DEBUG
    unsigned char *nextPtr;
#endif
    int numLitObjects = envPtr->literalArrayNext;
    Namespace *namespacePtr;
    int i, isNew;
    Interp *iPtr;

    if (envPtr->iPtr == 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));
︙︙
2228
2229
2230
2231
2232
2233
2234



2235
2236
2237
2238
2239
2240
2241

     * TIP #280. Associate the extended per-word line information with the
     * byte code object (internal rep), for use with the bc compiler.
     */

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




    codePtr->localCachePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *








>
>
>








2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254

     * TIP #280. Associate the extended per-word line information with the
     * byte code object (internal rep), for use with the bc compiler.
     */

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

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

    codePtr->localCachePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
︙︙

This page was generated in about 0.05s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19