Tcl Source Code

Check-in [a8ffe21e92]
Login

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

Overview
Comment:[Bug 3384840]: Fix memory leaks in the assembler due to Tcl_Obj reference ownership error.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a8ffe21e9271ab6b0ffab29939887e98e655b5e4
User & Date: dkf 2011-08-04 13:16:22
Context
2011-08-05
18:53
merge from trunk to rc all but the AI_ADDRCONFIG experiment Closed-Leaf check-in: 06dea9b027 user: dgp tags: core-8-6-b2-rc, core-8-6-b2
2011-08-04
14:03
Don't use AI_ADDRCONFIG for now. It seems to do more harm than good. check-in: 585e304a31 user: max tags: trunk
13:16
[Bug 3384840]: Fix memory leaks in the assembler due to Tcl_Obj reference ownership error. check-in: a8ffe21e92 user: dkf tags: trunk
2011-08-03
19:42
Update file generated by `make dist` check-in: 3bbd204856 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.











1
2
3
4
5
6
7










2011-08-02  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b2 release.
	* tools/tcltk-man2html.tcl: Variable substitution botch.

2011-08-02  Donal K. Fellows  <[email protected]>

>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
2011-08-04  Donal K. Fellows  <[email protected]>

	* generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand)
	(GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]:
	A Tcl_Obj is allocated by GetNextOperand, so callers of it must not
	hold a reference to one in the 'out' parameter when calling it. This
	was causing a great many memory leaks.
	* tests/assemble.test (assemble-51.*): Added group of memory leak
	tests.

2011-08-02  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b2 release.
	* tools/tcltk-man2html.tcl: Variable substitution botch.

2011-08-02  Donal K. Fellows  <[email protected]>

Changes to generic/tclAssembly.c.

1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
    int status = TCL_ERROR;	/* Return value from this function */

    /*
     * Make sure that the instruction name is known at compile time.
     */

    tokenPtr = parsePtr->tokenPtr;
    instNameObj = Tcl_NewObj();
    Tcl_IncrRefCount(instNameObj);
    if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Look up the instruction name.
     */







<
<







1240
1241
1242
1243
1244
1245
1246


1247
1248
1249
1250
1251
1252
1253
    int status = TCL_ERROR;	/* Return value from this function */

    /*
     * Make sure that the instruction name is known at compile time.
     */

    tokenPtr = parsePtr->tokenPtr;


    if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Look up the instruction name.
     */
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj* intObj = Tcl_NewObj();
				/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */

    Tcl_IncrRefCount(intObj);
    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
	Tcl_DecrRefCount(intObj);
	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */








<
|






<

<







2081
2082
2083
2084
2085
2086
2087

2088
2089
2090
2091
2092
2093
2094

2095

2096
2097
2098
2099
2100
2101
2102
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */

    Tcl_Obj* intObj;		/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */


    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {

	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */

2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj* intObj = Tcl_NewObj();
				/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */

    Tcl_IncrRefCount(intObj);
    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
	Tcl_DecrRefCount(intObj);
	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */








<
|






<

<







2134
2135
2136
2137
2138
2139
2140

2141
2142
2143
2144
2145
2146
2147

2148

2149
2150
2151
2152
2153
2154
2155
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */

    Tcl_Obj* intObj;		/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */


    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {

	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */

2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj* intObj = Tcl_NewObj();
				/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */

    Tcl_IncrRefCount(intObj);
    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
	Tcl_DecrRefCount(intObj);
	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */








<
|






<

<







2187
2188
2189
2190
2191
2192
2193

2194
2195
2196
2197
2198
2199
2200

2201

2202
2203
2204
2205
2206
2207
2208
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */

    Tcl_Obj* intObj;		/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */


    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {

	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */

2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token
				 * in the source code */
    Tcl_Obj* varNameObj = Tcl_NewObj();
				/* Name of the variable */
    const char* varNameStr;
    int varNameLen;
    int localVar;		/* Index of the variable in the LVT */

    Tcl_IncrRefCount(varNameObj);
    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	Tcl_DecrRefCount(varNameObj);
	return -1;
    }
    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	return -1;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);







<
|




<

<







2241
2242
2243
2244
2245
2246
2247

2248
2249
2250
2251
2252

2253

2254
2255
2256
2257
2258
2259
2260
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token
				 * in the source code */

    Tcl_Obj* varNameObj;	/* Name of the variable */
    const char* varNameStr;
    int varNameLen;
    int localVar;		/* Index of the variable in the LVT */


    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {

	return -1;
    }
    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	return -1;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);

Changes to tests/assemble.test.

26
27
28
29
30
31
32

















33
34
35
36
37
38
39
    set sep {}
    for {set i 0} {$i < 256} {incr i} {
	append s $sep [list set v$i literal$i]
	set sep \n
    }
    return $s
}


















# assemble-1 - TclNRAssembleObjCmd

test assemble-1.1 {wrong # args, direct eval} {
    -body {
	eval [list assemble]
    }







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







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
    set sep {}
    for {set i 0} {$i < 256} {incr i} {
	append s $sep [list set v$i literal$i]
	set sep \n
    }
    return $s
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

# assemble-1 - TclNRAssembleObjCmd

test assemble-1.1 {wrong # args, direct eval} {
    -body {
	eval [list assemble]
    }
3194
3195
3196
3197
3198
3199
3200

































































3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
	for {set i 1} {$i < 30} {incr i} {
	    lappend result [ulam $i]
	}
	set result
    }
    -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
}


































































rename fillTables {}
rename assemble {}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:







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











3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
	for {set i 1} {$i < 30} {incr i} {
	    lappend result [ulam $i]
	}
	set result
    }
    -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
}

test assemble-51.1 {memory leak testing} memory {
    leaktest {
	apply {{} {assemble {push hello}}}
    }
} 0
test assemble-51.2 {memory leak testing} memory {
    leaktest {
	apply {{{x 0}} {assemble {incrImm x 1}}}
    }
} 0
test assemble-51.3 {memory leak testing} memory {
    leaktest {
	apply {{n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n
	    
		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n
	    
		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n
	    
		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n
	     
		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1
	    
		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n
	    
		pop;		# max
	    }
	}} 1
    }
} 0
test assemble-51.4 {memory leak testing} memory {
    leaktest {
	catch {
	    apply {{} {
		assemble {reverse polish notation}
	    }}
	}
    }
} 0

rename fillTables {}
rename assemble {}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End: