Check-in [bc9590bbdb]
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Merge trunk to get better handling of 'phi' operations. Fix issues that prevented compilability with these changes.
Timelines: family | ancestors | descendants | both | notworking | kbk-nre
Files: files | file ages | folders
SHA3-256: bc9590bbdbba89086792f13fae2e09e03f2389bc007eec773eadc15db8812748
User & Date: kbk 2018-04-16 01:09:15
Context
2018-04-16
23:46
Dump bitcode to files after module verification, to try to debug optimizer crashes. Commit missing changes to the debug helper for better phi handling. check-in: 504ceb334b user: kbk tags: notworking, kbk-nre
01:09
Merge trunk to get better handling of 'phi' operations. Fix issues that prevented compilability with these changes. check-in: bc9590bbdb user: kbk tags: notworking, kbk-nre
2018-04-15
21:52
Merge kbk-phi-reform. The code issuer no longer creates dummy 'undef' slots for variables only to replace them. Instead, 'phi' operations are created without data sources and have their data sources added after processing the quadcode. check-in: 3578806182 user: kbk tags: trunk
03:07
Finish coding the thunk builder for NRE procs. Generated code for NRE now aborts in the optimizer. check-in: ab703b4b95 user: kbk tags: notworking, kbk-nre
Changes

Changes to codegen/build.tcl.

4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299

4300
4301
4302
4303
4304
4305
4306
4307
    #
    # Parameters:
    #	code -	The Tcl return code, as an INT.
    #	errVar -
    #		Where the actual result code is to be written to.
    #
    # Results:
    #	None.

    method setReturnCode(INT) {code errVar} {
	my store [my getInt32 $code] $errVar

	return
    }

    # Builder:instanceOf.DOUBLE(STRING) --
    #
    #	Generate code to check if the given STRING contains something that can
    #	be parsed to get a DOUBLE. Quadcode implementation ('instanceOf').
    #






|


|
>
|







4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
    #
    # Parameters:
    #	code -	The Tcl return code, as an INT.
    #	errVar -
    #		Where the actual result code is to be written to.
    #
    # Results:
    #	Returns an LLVM int32 value ref containng the code

    method setReturnCode(INT) {code errVar} {
	set value [my getInt32 $code]
	my store $value $errVar
	return $value
    }

    # Builder:instanceOf.DOUBLE(STRING) --
    #
    #	Generate code to check if the given STRING contains something that can
    #	be parsed to get a DOUBLE. Quadcode implementation ('instanceOf').
    #

Changes to codegen/compile.tcl.

263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
...
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
...
340
341
342
343
344
345
346

347
348
349
350
351
352
353
...
603
604
605
606
607
608
609
610
611

612
613
614
615
616
617
618
619
...
848
849
850
851
852
853
854
855
856
857

858
859


860
861
862
863
864
865
866
....
1029
1030
1031
1032
1033
1034
1035












1036
1037
1038
1039
1040
1041
1042
....
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
....
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437

1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450

1451
1452
1453
1454
1455
1456
1457
....
1459
1460
1461
1462
1463
1464
1465
1466
1467


1468
1469
1470
1471
1472
1473
1474
....
2214
2215
2216
2217
2218
2219
2220




2221
2222
2223


2224
2225





2226
2227
2228

2229

2230
2231
2232
2233
2234

2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
....
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360

2361
2362
2363
2364
2365
2366
2367
	$b @location 0
	set errorCode [$b alloc int "tcl.errorCode"]
	set curr_block $block(-1)
	set 0 [$b int 0]

	##############################################################
	#
	# Create stubs for variables in LLVM; because of loops, uses may occur
	# before a variable is written to.
	#

	dict for {name typecode} $vtypes {
	    lassign $name kind formalname origin
	    set type [nameOfType $typecode]

	    # Make the debugging information for the variable provided it is a
	    # variable as perceived from the Tcl level. "Internal" temporary
................................................................................
		    }
		} else {
		    # Not a parameter; set up the debugging metadata as a
		    # local variable.
		    $func localvar $formalname $type
		}
	    }

	    # This is awful, but these *must* be unique things to replace, so
	    # we make them be individual loads of a memory location that has
	    # never been written to. This prevents them from being coalesced
	    # too early by the constant management engine; merely using an
	    # undef would make disparate values become unified.
	    #
	    # It is a major problem if any of these actually survives the
	    # optimisation phase.
	    #
	    # This cannot be left until the first reference to the variable;
	    # that might be from a phi, and those must be first in their basic
	    # blocks.

	    if {![info exist undefs($type)]} {
		set tycode [expr {$type eq "VOID" ? "void*" : $type}]
		set undefs($type) [$b alloc $tycode "undef.$type"]
	    }
	    set variables($name) [$b load $undefs($type) "undef.$formalname"]
	}

	foreach insn $quads {
	    switch -exact -- [lindex $insn 0 0] {
		"NRE.entry" {
		    set coro_info \
			[my IssueNREEntrySequence $curr_block $block(0)]
		    set curr_block $block(0)
................................................................................
	#
	# Convert Tcl parse output, one instruction at a time.
	#

	set pc -1
	set ERROR_TEMPLATE "\n    (compiling \"%s\" @ pc %d: %s)"
	set phiAnnotations {}

	set theframe {}
	set thevarmap {}
	set syntheticargs {}
	set currentline 0
	set currentprocrelline 0
	set currentscript {}

................................................................................
			[$b $opcode [my LoadOrLiteral $src] \
			     [$b load $errorCode] $name]
		}
		"initException" {
		    my IssueException $l
		}
		"setReturnCode" {
		    lassign $l opcode - src
		    append opcode ( [my ValueTypes $src] )

		    $b $opcode [my LoadOrLiteral $src] $errorCode
		}
		"procLeave" {
		    set srcs [lassign $l opcode tgt]
		    set name [my LocalVarName $tgt]
		    append opcode ( [my ValueTypes {*}$srcs] )
		    set srcs [lmap s $srcs {my LoadOrLiteral $s}]
		    my StoreResult $tgt [$b $opcode {*}$srcs $errorCode $name]
................................................................................
			set s $block($spc)
			if {$s ni [dict get $pred $curr_block]} {
			    my Warn "%s not predecessor to %s in %s; skipping..." \
				[$s name] [$curr_block name] $cmd
			    continue
			}
			lappend sources $s
			lappend values [my LoadOrLiteral $var]
		    }
		    set name phi_[my LocalVarName $tgt]

		    set value [$b phi $values $sources $name]
		    my StoreResult $tgt $value "phi"


		    if {[lindex $quads [expr {$pc+1}] 0 0] ne "phi"} {
			foreach {name value} $phiAnnotations {
			    my AnnotateAssignment $name $value
			}
			set phiAnnotations {}
		    }
		}
................................................................................
		    dict append opts -errorinfo \
			[format $ERROR_TEMPLATE $cmd $pc $l]
		}
		return -options $opts $msg
	    }
	}
	$b @loc {}













	##############################################################
	#
	# Set increment paths, so that where we have a basic block that just
	# falls through to its successor (not permitted in LLVM IR) we convert
	# it to an explicit jump.
	#
................................................................................

	set arguments [lassign $operation opcode tgt corohandle origname]
	set rettype [dict get $vtypes $tgt]
	set vname [my LocalVarName $tgt]
	set called [my ResolveInvoke $rettype $origname $arguments]
	if {$called ne {}} {
	    my IssueNREReturnFromInvokedFunction \
		$rettype $tgt $corohandle $callframe $called $arguments $vname
	    return {}
	} else {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]
	    set i -1
	    my IssueNREReturnFromInvokedCommand \
		$rettype $tgt $corohandle $callframe $arguments $vname
	    ;				# objc will still contain
................................................................................
    #	Generates code to return from compiled NRE code.
    #
    # Parameters:
    #	rettype - Return type of the function
    #   tgt - Quadcode value representing the return value
    #	corohandle - Coroutine handle of the function that's just returned
    #	callframe - The current callframe
    #	called - Quadcode value giving the name of the function that was called
    #   arguments - List of quadcode values representing the arguments
    #	vname - LLVM name to assign to the result of the call
    #
    # Results:
    #	None.

    method IssueNREReturnFromInvokedFunction {rettype tgt corohandle callframe
					      called arguments vname} {

	# Built-in types that are handled here.
	set BASETYPES {ZEROONE INT DOUBLE NUMERIC STRING}
	set ts [lmap t $BASETYPES {Type $t?}]
	set tgttype [my ValueTypes $tgt]

	# Get the name of the function to call

	set callee [my GenerateFunctionName $tgt arguments $arguments]

	# Emit the sequence that destroys the LLVM coroutine and returns the
	# result as 'retval'
	lassign [my returnedFromCoro $rettype $callee $corohandle] \
	    retcode retval

	# Handle the return

	if {$tgttype eq "FAIL"} {
	    # This procedure only ever fails.
	    $b store $retval $errorCode
	    my SetErrorLine $errorCode

	} else {
	    set restype [TypeOf $retval]; # LLVM type ref of the return val
	    if {$restype in $ts} {
		$b store [$b extract $retval 0] $errorCode
	    } elseif {[Type $restype?] eq [Type $tgttype]} {
		set retval [$b ok $reval]
	    }
................................................................................
		my SetErrorLine $errorCode [$b maybe $retval]
	    }
	}

	# Pack a callframe reference with the return if needed

	if {"CALLFRAME" in $tgttype} {
	    set result [$b frame.pack $callframe $result]
	}


    }
 
    # TclCompiler:ResolveInvoke --
    #
    #	Determines whether an invoked command is known as a compiled
    #	function, and resolves it if it is.
    #
................................................................................
    #		with debugging intrinsics (unlike with other result-producing
    #		operations).
    #
    # Results:
    #	None.

    method StoreResult {desc value {opcode ""}} {




	if {[lindex $desc 0] eq "literal"} {
	    return -code error "cannot store into literal; it makes no sense"
	}


	if {[info exist variables($desc)]} {
	    set targetType [TypeOf $variables($desc)]





	    if {$targetType ne [TypeOf $value]} {
		my Warn "variable is of type %s and assigned value (to '%s') is %s" \
		    [PrintTypeToString $targetType] \

		    $desc [PrintValueToString $value]

	    }
	}
	if {[lindex $desc 0] eq "var"} {
	    if {$opcode eq "phi"} {
		upvar 1 phiAnnotations todo

		lappend todo [lindex $desc 1] $value
	    } else {
		my AnnotateAssignment [lindex $desc 1] $value
	    }
	}
	if {[info exist variables($desc)]} {
	    if {$targetType ne [TypeOf $value]} {
		return -code error [format \
			"type mismatch: variable {%s} of type '%s' but was assigned value of type '%s'" \
			$desc [PrintTypeToString [TypeOf $variables($desc)]] \
			[PrintTypeToString [TypeOf $value]]]
	    }
	    ReplaceAllUsesWith $variables($desc) $value
	}
	set variables($desc) $value
	return
    }

    # TclCompiler:AnnotateAssignment --
    #
    #	Annotate an assignment to a named Tcl variable with debug metadata
................................................................................
    #
    # Results:
    #	The PC at which the 'free' occurs, or 0 if the value isn't consumed
    #	(there is never a free as the first instruction in a function, so this
    #	may be used as a boolean).

    method IsConsumed {var search} {
	while 1 {
	    switch [lindex $quads $search 0] {
		"free" {
		    if {[lindex $quads $search 2] eq $var} {
			return $search
		    }
		}
		"jump" - "jumpFalse" - "jumpTrue" - "return" -
		"jumpMaybe" - "jumpMaybeNot" - "NRE.suspend" {
		    return 0
		}
		default {
		    if {$var in [lindex $quads $search]} {
			return 0
		    }
		}
	    }
	    incr search
	}

    }

    # TclCompiler:ConvertIndices --
    #
    #	Convert the most common cases of literal end-based indexing into forms
    #	that can actually be processed by the low-level code issuer.
    #






|
<
<







 







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>







 







|

>
|







 







|

|
>
|

>
>







 







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







 







|







 







|







|







>
|












>







 







|

>
>







 







>
>
>
>
|
|

>
>
|
<
>
>
>
>
>
|
<
<
>
|
>
|
|

<
<
>
|




<
<
<
<
<
<
|
<
<







 







|
|






|










>







263
264
265
266
267
268
269
270


271
272
273
274
275
276
277
...
295
296
297
298
299
300
301
302



















303
304
305
306
307
308
309
...
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
...
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
...
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
....
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
....
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
....
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
....
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
....
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230

2231
2232
2233
2234
2235
2236


2237
2238
2239
2240
2241
2242


2243
2244
2245
2246
2247
2248






2249


2250
2251
2252
2253
2254
2255
2256
....
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
	$b @location 0
	set errorCode [$b alloc int "tcl.errorCode"]
	set curr_block $block(-1)
	set 0 [$b int 0]

	##############################################################
	#
	# Create debug info for variables in LLVM



	dict for {name typecode} $vtypes {
	    lassign $name kind formalname origin
	    set type [nameOfType $typecode]

	    # Make the debugging information for the variable provided it is a
	    # variable as perceived from the Tcl level. "Internal" temporary
................................................................................
		    }
		} else {
		    # Not a parameter; set up the debugging metadata as a
		    # local variable.
		    $func localvar $formalname $type
		}
	    }
        }




















	foreach insn $quads {
	    switch -exact -- [lindex $insn 0 0] {
		"NRE.entry" {
		    set coro_info \
			[my IssueNREEntrySequence $curr_block $block(0)]
		    set curr_block $block(0)
................................................................................
	#
	# Convert Tcl parse output, one instruction at a time.
	#

	set pc -1
	set ERROR_TEMPLATE "\n    (compiling \"%s\" @ pc %d: %s)"
	set phiAnnotations {}
	set phiPending {}
	set theframe {}
	set thevarmap {}
	set syntheticargs {}
	set currentline 0
	set currentprocrelline 0
	set currentscript {}

................................................................................
			[$b $opcode [my LoadOrLiteral $src] \
			     [$b load $errorCode] $name]
		}
		"initException" {
		    my IssueException $l
		}
		"setReturnCode" {
		    lassign $l opcode tgt src
		    append opcode ( [my ValueTypes $src] )
		    my StoreResult $tgt \
			[$b $opcode [my LoadOrLiteral $src] $errorCode]
		}
		"procLeave" {
		    set srcs [lassign $l opcode tgt]
		    set name [my LocalVarName $tgt]
		    append opcode ( [my ValueTypes {*}$srcs] )
		    set srcs [lmap s $srcs {my LoadOrLiteral $s}]
		    my StoreResult $tgt [$b $opcode {*}$srcs $errorCode $name]
................................................................................
			set s $block($spc)
			if {$s ni [dict get $pred $curr_block]} {
			    my Warn "%s not predecessor to %s in %s; skipping..." \
				[$s name] [$curr_block name] $cmd
			    continue
			}
			lappend sources $s
			lappend values $var
		    }
		    set name [my LocalVarName $tgt]
		    set type [Type [nameOfType [dict get $vtypes $tgt]]]
		    set value [$b phiStub $type $name]
		    my StoreResult $tgt $value "phi"
		    lappend phiPending $value $sources $values

		    if {[lindex $quads [expr {$pc+1}] 0 0] ne "phi"} {
			foreach {name value} $phiAnnotations {
			    my AnnotateAssignment $name $value
			}
			set phiAnnotations {}
		    }
		}
................................................................................
		    dict append opts -errorinfo \
			[format $ERROR_TEMPLATE $cmd $pc $l]
		}
		return -options $opts $msg
	    }
	}
	$b @loc {}

	##############################################################
	#
	# Fix up phi operations, now that their sources should all be
	# known.

	foreach {phiRef sources values} $phiPending {
	    foreach s $sources v $values {
		set value [my LoadOrLiteral $v]
		$b phiAddIncoming $phiRef $value $s
	    }
	}

	##############################################################
	#
	# Set increment paths, so that where we have a basic block that just
	# falls through to its successor (not permitted in LLVM IR) we convert
	# it to an explicit jump.
	#
................................................................................

	set arguments [lassign $operation opcode tgt corohandle origname]
	set rettype [dict get $vtypes $tgt]
	set vname [my LocalVarName $tgt]
	set called [my ResolveInvoke $rettype $origname $arguments]
	if {$called ne {}} {
	    my IssueNREReturnFromInvokedFunction \
		$rettype $tgt $corohandle $callframe $origname $arguments $vname
	    return {}
	} else {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]
	    set i -1
	    my IssueNREReturnFromInvokedCommand \
		$rettype $tgt $corohandle $callframe $arguments $vname
	    ;				# objc will still contain
................................................................................
    #	Generates code to return from compiled NRE code.
    #
    # Parameters:
    #	rettype - Return type of the function
    #   tgt - Quadcode value representing the return value
    #	corohandle - Coroutine handle of the function that's just returned
    #	callframe - The current callframe
    #	origname - Quadcode value giving the name of the function
    #   arguments - List of quadcode values representing the arguments
    #	vname - LLVM name to assign to the result of the call
    #
    # Results:
    #	None.

    method IssueNREReturnFromInvokedFunction {rettype tgt corohandle callframe
					      origname arguments vname} {

	# Built-in types that are handled here.
	set BASETYPES {ZEROONE INT DOUBLE NUMERIC STRING}
	set ts [lmap t $BASETYPES {Type $t?}]
	set tgttype [my ValueTypes $tgt]

	# Get the name of the function to call
	set fname [lindex $origname 1]
	set callee [my GenerateFunctionName $fname arguments $arguments]

	# Emit the sequence that destroys the LLVM coroutine and returns the
	# result as 'retval'
	lassign [my returnedFromCoro $rettype $callee $corohandle] \
	    retcode retval

	# Handle the return

	if {$tgttype eq "FAIL"} {
	    # This procedure only ever fails.
	    $b store $retval $errorCode
	    my SetErrorLine $errorCode
	    my StoreResult $tgt $errorCode
	} else {
	    set restype [TypeOf $retval]; # LLVM type ref of the return val
	    if {$restype in $ts} {
		$b store [$b extract $retval 0] $errorCode
	    } elseif {[Type $restype?] eq [Type $tgttype]} {
		set retval [$b ok $reval]
	    }
................................................................................
		my SetErrorLine $errorCode [$b maybe $retval]
	    }
	}

	# Pack a callframe reference with the return if needed

	if {"CALLFRAME" in $tgttype} {
	    set retval [$b frame.pack $callframe $retval]
	}

	my StoreResult $tgt $retval
    }
 
    # TclCompiler:ResolveInvoke --
    #
    #	Determines whether an invoked command is known as a compiled
    #	function, and resolves it if it is.
    #
................................................................................
    #		with debugging intrinsics (unlike with other result-producing
    #		operations).
    #
    # Results:
    #	None.

    method StoreResult {desc value {opcode ""}} {

	upvar 1 phiAnnotations phiAnnotations

	# Validate that the destination is indeed a variable or temporary
	if {[lindex $desc 0] ni {"var" "temp"}} {
	    return -code error "cannot store into $desc; it makes no sense"
	}

	# Validate that SSA form has been preserved
	if {[info exists variables($desc)]} {

	    return -code error "Duplicate definition of $desc"
	}

	# Type check the assignment
	set destType [nameOfType [dict get $vtypes $desc]]
	if {[Type $destType] ne [TypeOf $value]} {


	    my Warn "Attempt to store the value\
	             '[PrintValueToString $value]'\
                     into a variable, '$desc', of type '$destType'"
	}

	if {[lindex $desc 0] eq "var"} {


	    if {[lindex $opcode 0] eq "phi"} {
		lappend phiAnnotations [lindex $desc 1] $value
	    } else {
		my AnnotateAssignment [lindex $desc 1] $value
	    }
	}









	set variables($desc) $value
	return
    }

    # TclCompiler:AnnotateAssignment --
    #
    #	Annotate an assignment to a named Tcl variable with debug metadata
................................................................................
    #
    # Results:
    #	The PC at which the 'free' occurs, or 0 if the value isn't consumed
    #	(there is never a free as the first instruction in a function, so this
    #	may be used as a boolean).

    method IsConsumed {var search} {
	while {$search < [llength $quads]} {
	    switch [lindex $quads $search 0 0] {
		"free" {
		    if {[lindex $quads $search 2] eq $var} {
			return $search
		    }
		}
		"jump" - "jumpFalse" - "jumpTrue" - "return" -
		"jumpMaybe" - "jumpMaybeNot" - "NRE.return" - "NRE.suspend" {
		    return 0
		}
		default {
		    if {$var in [lindex $quads $search]} {
			return 0
		    }
		}
	    }
	    incr search
	}
	error "IsConsumed ran away!"
    }

    # TclCompiler:ConvertIndices --
    #
    #	Convert the most common cases of literal end-based indexing into forms
    #	that can actually be processed by the low-level code issuer.
    #

Changes to codegen/coro.tcl.

393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {
    puts "Emit return to the thunk"
    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle \
				 [my cast(int) [AlignOf [Type STRING]]] \
				 [Const false bool]] "promise.addr.raw"]
    set promiseType named{$resType.promise,int32,$resType}
    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]
    puts "Value is of type [PrintTypeToString [TypeOf $value]]"
    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle
    puts "Returned to the thunk"
    return $value
}
oo::define Builder export NRReturnToThunk
 
# TclCompiler method CoroSuspend --
#
#	Generates code to suspend the current coroutine and resume at a






<








<


<







393
394
395
396
397
398
399

400
401
402
403
404
405
406
407

408
409

410
411
412
413
414
415
416
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {

    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle \
				 [my cast(int) [AlignOf [Type STRING]]] \
				 [Const false bool]] "promise.addr.raw"]
    set promiseType named{$resType.promise,int32,$resType}
    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]

    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle

    return $value
}
oo::define Builder export NRReturnToThunk
 
# TclCompiler method CoroSuspend --
#
#	Generates code to suspend the current coroutine and resume at a

Changes to codegen/jit.tcl.

155
156
157
158
159
160
161

162
163
164
165
166
167
168






169
170
171
172
173
174
175
		# For code that needs to bind to Tcl, make the thunks. Then
		# finalise the thunks, which finishes building the module's
		# init function.
		foreach c $publicInterface {
		    $c generateThunk $thunkBuilder
		}

		$thunkBuilder finalize
	    }

	    timeit dump-pre {
		# Save the current IR
		variable dumpPre [$module dump]
		variable bitcodePre [$module bitcode]






	    }

	    # Check that what we have is actually correct!
	    $module verify
	    if {$debug} {
		parray ::useCount
	    }






>







>
>
>
>
>
>







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
		# For code that needs to bind to Tcl, make the thunks. Then
		# finalise the thunks, which finishes building the module's
		# init function.
		foreach c $publicInterface {
		    $c generateThunk $thunkBuilder
		}

		$thunkBuilder finalize
	    }

	    timeit dump-pre {
		# Save the current IR
		variable dumpPre [$module dump]
		variable bitcodePre [$module bitcode]
		set f_ [open test.bc wb]
		puts -nonewline $f_ $bitcodePre
		close $f_
		set f_ [open test.ll w]
		puts $f_ $dumpPre
		close $f_
	    }

	    # Check that what we have is actually correct!
	    $module verify
	    if {$debug} {
		parray ::useCount
	    }

Changes to codegen/llvmbuilder.tcl.

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
....
1044
1045
1046
1047
1048
1049
1050
1051











































1052
1053
1054
1055
1056
1057
1058
....
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
	if {[TypeOf $left] ne [TypeOf $right]} {
	    return -code error "values must both be of the same type"
	} elseif {[GetTypeKind [TypeOf $left]] ne "LLVMIntegerTypeKind"} {
	    return -code error "values must be integers"
	}
	my Locate [BuildOr $b $left $right $name]
    }

    # Builder:phi --
    #
    #	Generate a phi node, the characteristic instruction of SSA form.
    #
    #	The only instruction that can precede another phi nodes in a basic
    #	block is another phi node; arguably each basic block starts with a
    #	(possibly empty) sequence of phi nodes. The lists of values and
................................................................................
	}
	set phi [BuildPhi $b $type $name]
	foreach value $values block $sources {
	    AddIncoming $phi $value [my LABEL $block]
	}
	return $phi
    }












































    # Builder:rem --
    #
    #	Generate code to get the remainder when two integers of the same bit
    #	width (giving an integer) or two doubles (giving a double) are
    #	divided.
    #
    # Parameters:
................................................................................
		my Locate [BuildFRem $b $left $right $name]
	    }
	    default {
		return -code error "values must be integers or doubles"
	    }
	}
    }

    # Builder:ret --
    #
    #	Return from the current function. Widely used, marks the end of the
    #	current basic block.
    #
    # Parameters:
    #	value (optional) -






|







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
....
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
....
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
	if {[TypeOf $left] ne [TypeOf $right]} {
	    return -code error "values must both be of the same type"
	} elseif {[GetTypeKind [TypeOf $left]] ne "LLVMIntegerTypeKind"} {
	    return -code error "values must be integers"
	}
	my Locate [BuildOr $b $left $right $name]
    }
 
    # Builder:phi --
    #
    #	Generate a phi node, the characteristic instruction of SSA form.
    #
    #	The only instruction that can precede another phi nodes in a basic
    #	block is another phi node; arguably each basic block starts with a
    #	(possibly empty) sequence of phi nodes. The lists of values and
................................................................................
	}
	set phi [BuildPhi $b $type $name]
	foreach value $values block $sources {
	    AddIncoming $phi $value [my LABEL $block]
	}
	return $phi
    }
 
    # Builder:phiStub --
    #
    #	Generates a stub of a phi operation whose values and sources
    #	will be filled in at a later time.
    #
    # Parameters:
    #	type - An LLVM type reference giving the type of the variable
    #	name (optional) - A name to give to the result value
    #
    # Results:
    #	Returns an LLVM value reference to the phi operation. The values
    #	and sources must be filled in with the 'finishPhi' method below.

    method phiStub {type name} {
	my @validToIssue
	return [BuildPhi $b $type $name]
    }
 
    # Builder:phiAddIncoming --
    #
    #	Adds a value and a data source to a phi operation created by 'phiStub'
    #
    # Parameters:
    #	phi - Reference to the phi operation returned from 'phiStub'
    #	value - LLVM value ref to the input value to add to the phi
    #	source - Basic block ref to the source of the value.
    #
    # Results:
    #	None.

    method phiAddIncoming {phi value source} {
	set restype [TypeOf $phi]
	set valtype [TypeOf $value]
	if {$valtype ne $restype} {
	    error "Wrong type encountered in phiAddIncoming:\
	           expected [PrintTypeToString $restype]\
                   and got [PrintTypeToString $valtype]\
		   trying to update [PrintValueToString $phi]\
		   with [PrintValueToString $value]"
	}
	AddIncoming $phi $value [my LABEL $source]
    }
 
    # Builder:rem --
    #
    #	Generate code to get the remainder when two integers of the same bit
    #	width (giving an integer) or two doubles (giving a double) are
    #	divided.
    #
    # Parameters:
................................................................................
		my Locate [BuildFRem $b $left $right $name]
	    }
	    default {
		return -code error "values must be integers or doubles"
	    }
	}
    }
 
    # Builder:ret --
    #
    #	Return from the current function. Widely used, marks the end of the
    #	current basic block.
    #
    # Parameters:
    #	value (optional) -

Changes to codegen/stdlib.tcl.

739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
....
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
....
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
....
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
	    nonnull $valueObj
	    set boolVar [my alloc int32 "boolPtr"]
#	    The following does not work
#	    set sizeofBool [my castPtr2Int [my gep [my null int32*] 1] \
#				int64 sizeof(int)]
	    set sizeofBool [Const 4 int64]
	    set str [$api Tcl_GetString $valueObj]
	    my call [$m intrinsic lifetime.start] \
		[list $sizeofBool [my cast(ptr) $boolVar char]]
	    set code [$api Tcl_GetBooleanFromObj {} $valueObj $boolVar]
	    set res [my undef struct{int1,int1}]
	    set res [my insert $res [my eq $code [Const 0]] 0]
	    set res \
		[my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1]
	    my call [$m intrinsic lifetime.end] \
		[list $sizeofBool [my cast(ptr) $boolVar char]]
	    my ret $res
	}
	my closure GetBoolean {valueObj} {
	    my call ${tcl.impl.getBoolean} [list $valueObj] "result"
	}
	unset -nocomplain valueObj
	
................................................................................
	    nonnull $list
	    set objcVar [my alloc int]
	    set interp [$api tclInterp]
	    my condBr [my maybe $steps_init] $earlierError $listLength
	label earlierError:
	    my ret $steps_init
	label listLength:
	    my call [$m intrinsic "lifetime.start"] \
		[list $sizeof(int) [my castPtr2Ptr $objcVar char*]]
	    set code [$api Tcl_ListObjLength $interp $list $objcVar]
	    my condBr [my eq $code $0] $lengthOk $lengthBad
	label lengthOk:
	    set steps_before [my unmaybe $steps_init]
	    set objc [my load $objcVar "objc"]
	    set count [my div [my add $objc [my sub $stride [Const 1 int]]] \
			   $stride "count"]
................................................................................
	    my br $done
	label lengthBad:
	    set stepsBad [my fail int]
	    my br $done
	label done:
	    set steps [my phi [list $stepsOk $stepsBad] \
			   [list $lengthOk $lengthBad]]
	    my call [$m intrinsic "lifetime.end"] \
		[list $sizeof(int) [my castPtr2Ptr $objcVar char*]]
	    my ret $steps
	}

	##### Function: tcl.list.foreach.start.finish #####
	#
	# Type signature: steps:int?,ecvar:int*->FAIL FOREACH
	#
................................................................................
	label test2:
	    my condBr [my eq $code [Const 3]] $handleBreak $test3
	label test3:
	    my condBr [my eq $code [Const 4]] $handleContinue $test4
	label test4:
	    my condBr [my eq $code [Const 1]] $handleError $done
	label handleError "handle.error"
	    my call [$m intrinsic lifetime.start] \
		[list [Const 4 int64] [my cast(ptr) $limitVar char]]
	    set name [$api Tcl_GetStringFromObj $procName $limitVar]
	    SetValueName $name "name"
	    set limit [Const 60]
	    set nameLen [my load $limitVar "name.len"]
	    set overflow [my gt $nameLen $limit]
	    $api Tcl_AppendObjToErrorInfo $interp [$api Tcl_ObjPrintf \
		    [my constString "\n    (procedure \"%.*s%s\" line %d)"] \
		    [my select $overflow $limit $nameLen] $name \
		    [my select $overflow [my constString "..."] \
			    [my constString ""]] \
		    [my dereference $interp 0 Interp.errorLine]]
	    my call [$m intrinsic lifetime.end] \
		[list [Const 4 int64] [my cast(ptr) $limitVar char]]
	    my br $done
	label handleReturn "handle.return"
	    set newcode [$api TclUpdateReturnInfo $interp]
	    my store $newcode $ecvar
	    my ret $newcode
	label handleBreak "handle.leaked.break"
	    $api Tcl_SetObjResult $interp [$api Tcl_ObjPrintf \






<
<





<
<







 







<
<







 







<
<







 







<
<











<
<







739
740
741
742
743
744
745


746
747
748
749
750


751
752
753
754
755
756
757
....
2887
2888
2889
2890
2891
2892
2893


2894
2895
2896
2897
2898
2899
2900
....
2902
2903
2904
2905
2906
2907
2908


2909
2910
2911
2912
2913
2914
2915
....
4231
4232
4233
4234
4235
4236
4237


4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248


4249
4250
4251
4252
4253
4254
4255
	    nonnull $valueObj
	    set boolVar [my alloc int32 "boolPtr"]
#	    The following does not work
#	    set sizeofBool [my castPtr2Int [my gep [my null int32*] 1] \
#				int64 sizeof(int)]
	    set sizeofBool [Const 4 int64]
	    set str [$api Tcl_GetString $valueObj]


	    set code [$api Tcl_GetBooleanFromObj {} $valueObj $boolVar]
	    set res [my undef struct{int1,int1}]
	    set res [my insert $res [my eq $code [Const 0]] 0]
	    set res \
		[my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1]


	    my ret $res
	}
	my closure GetBoolean {valueObj} {
	    my call ${tcl.impl.getBoolean} [list $valueObj] "result"
	}
	unset -nocomplain valueObj
	
................................................................................
	    nonnull $list
	    set objcVar [my alloc int]
	    set interp [$api tclInterp]
	    my condBr [my maybe $steps_init] $earlierError $listLength
	label earlierError:
	    my ret $steps_init
	label listLength:


	    set code [$api Tcl_ListObjLength $interp $list $objcVar]
	    my condBr [my eq $code $0] $lengthOk $lengthBad
	label lengthOk:
	    set steps_before [my unmaybe $steps_init]
	    set objc [my load $objcVar "objc"]
	    set count [my div [my add $objc [my sub $stride [Const 1 int]]] \
			   $stride "count"]
................................................................................
	    my br $done
	label lengthBad:
	    set stepsBad [my fail int]
	    my br $done
	label done:
	    set steps [my phi [list $stepsOk $stepsBad] \
			   [list $lengthOk $lengthBad]]


	    my ret $steps
	}

	##### Function: tcl.list.foreach.start.finish #####
	#
	# Type signature: steps:int?,ecvar:int*->FAIL FOREACH
	#
................................................................................
	label test2:
	    my condBr [my eq $code [Const 3]] $handleBreak $test3
	label test3:
	    my condBr [my eq $code [Const 4]] $handleContinue $test4
	label test4:
	    my condBr [my eq $code [Const 1]] $handleError $done
	label handleError "handle.error"


	    set name [$api Tcl_GetStringFromObj $procName $limitVar]
	    SetValueName $name "name"
	    set limit [Const 60]
	    set nameLen [my load $limitVar "name.len"]
	    set overflow [my gt $nameLen $limit]
	    $api Tcl_AppendObjToErrorInfo $interp [$api Tcl_ObjPrintf \
		    [my constString "\n    (procedure \"%.*s%s\" line %d)"] \
		    [my select $overflow $limit $nameLen] $name \
		    [my select $overflow [my constString "..."] \
			    [my constString ""]] \
		    [my dereference $interp 0 Interp.errorLine]]


	    my br $done
	label handleReturn "handle.return"
	    set newcode [$api TclUpdateReturnInfo $interp]
	    my store $newcode $ecvar
	    my ret $newcode
	label handleBreak "handle.leaked.break"
	    $api Tcl_SetObjResult $interp [$api Tcl_ObjPrintf \

Changes to codegen/struct.tcl.

84
85
86
87
88
89
90

91
92
93
94
95
96
97
...
447
448
449
450
451
452
453

454
455
456
457
458
459
460
    #	None.
    #
    # Results:
    #	None.

    method FinalizeDebuggingMetadata {} {
	if {[info exist dbbuild]} {

	    try {
		my debug destroy
	    } on error msg {
		puts ERROR:$msg
	    }
	    oo::objdefine [self] deletemethod debug
	    unset -nocomplain dbbuild
................................................................................
	set level [expr {max(0, min(3, int($level)))}]

	set bld [PassManagerBuilderCreate]
	AddCoroutinePassesToExtensionPoints $bld
	set pm [CreatePassManager] ; # Module pass manager
	set fpm [CreateFunctionPassManagerForModule $module]
	catch {set td [CreateTargetData ""]}

	my FinalizeDebuggingMetadata
	try {
	    if {[info exist td]} {
		SetDataLayout $module [CopyStringRepOfTargetData $td]
		AddTargetData $td $pm
		AddTargetData $td $fpm
	    }






>







 







>







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    #	None.
    #
    # Results:
    #	None.

    method FinalizeDebuggingMetadata {} {
	if {[info exist dbbuild]} {
	    puts "Finalizing the debug metadata..."
	    try {
		my debug destroy
	    } on error msg {
		puts ERROR:$msg
	    }
	    oo::objdefine [self] deletemethod debug
	    unset -nocomplain dbbuild
................................................................................
	set level [expr {max(0, min(3, int($level)))}]

	set bld [PassManagerBuilderCreate]
	AddCoroutinePassesToExtensionPoints $bld
	set pm [CreatePassManager] ; # Module pass manager
	set fpm [CreateFunctionPassManagerForModule $module]
	catch {set td [CreateTargetData ""]}
	my verify
	my FinalizeDebuggingMetadata
	try {
	    if {[info exist td]} {
		SetDataLayout $module [CopyStringRepOfTargetData $td]
		AddTargetData $td $pm
		AddTargetData $td $fpm
	    }

Changes to demos/perftest/tester.tcl.

2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
....
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
    calltest3
    # Callframe tests
    callframe::test1
    callframe::test2
    callframe::test3
    callframe::test4
    # The interprocedural tests
    # mrtest::*			-- NO NRE
    coscaller1
    coscaller2
    xsum xsum2
    # Namespace tests
    nstestaux::pts
    nstest::nstest0
    nstest::nstest1
................................................................................
    expandtest::test10
    expandtest::test11
    expandtest::test12

    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    # rectest1                  -- NO NRE
    # qsort  			-- NO NRE
    impure
    impure-caller
    impure-typecheck-int
    impure2
    comps
    bug-7c599d4029::*
    singleton::*






|







 







|
|







2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
....
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
    calltest3
    # Callframe tests
    callframe::test1
    callframe::test2
    callframe::test3
    callframe::test4
    # The interprocedural tests
    # mrtest::*				NO NRE
    coscaller1
    coscaller2
    xsum xsum2
    # Namespace tests
    nstestaux::pts
    nstest::nstest0
    nstest::nstest1
................................................................................
    expandtest::test10
    expandtest::test11
    expandtest::test12

    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    # rectest1				NO NRE
    # qsort				NO NRE
    impure
    impure-caller
    impure-typecheck-int
    impure2
    comps
    bug-7c599d4029::*
    singleton::*

Changes to quadcode/constfold.tcl.

57
58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
76
...
344
345
346
347
348
349
350









351
352
353
354
355
356
357
		    "@debug-line" - "@debug-script" -
		    "dictIterStart" - "directAppend" - "directArrayAppend" -
		    "directArrayLappend" - "directArrayLappendList" -
		    "directArraySet" - "directArrayUnset" - "directExists" -
		    "directGet" - "directLappend" - "directLappendList" -
		    "directSet" - "directUnset" - "directIsArray" -
		    "directMakeArray" - "foreachStart" - "entry" -
		    "extractExists" - "extractFail" -
		    "extractMaybe" - "initException" -
		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" - "purify" -
		    "NRE.suspend" -

		    "split" - "unset" - "unshareList" -
		    "initArray" - "setReturnCode" - "resolveCmd" - "originCmd" {
			# do nothing - these insns are not killable
			# this case goes away once I have a better handle
			# on what's killable.
			# Note that the "direct..." operations are probably
			# never killable due to the potential for global
			# effects (because of traces).
			lset bbcontent $b [incr newpc] $q
................................................................................
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace [lindex $q 1] with $res"
			}
			my replaceUses [lindex $q 1] $res
			set changed 1
		    }










		    default {
			my debug-constfold {
			    puts "$b:$pc: $q"
			}
			my diagnostic debug $b $pc \
			    "Is there an opportunity to replace %s\






|
|
|
|
>
|
<







 







>
>
>
>
>
>
>
>
>







57
58
59
60
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
		    "@debug-line" - "@debug-script" -
		    "dictIterStart" - "directAppend" - "directArrayAppend" -
		    "directArrayLappend" - "directArrayLappendList" -
		    "directArraySet" - "directArrayUnset" - "directExists" -
		    "directGet" - "directLappend" - "directLappendList" -
		    "directSet" - "directUnset" - "directIsArray" -
		    "directMakeArray" - "foreachStart" - "entry" -
		    "extractExists" - "extractFail" - "extractMaybe" -
		    "initArray" - "initException" -
		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" -
		    "NRE.suspend" - "originCmd" -
		    "purify" - "resolveCmd" - "setReturnCode" -
		    "split" - "unshareList" {

			# do nothing - these insns are not killable
			# this case goes away once I have a better handle
			# on what's killable.
			# Note that the "direct..." operations are probably
			# never killable due to the potential for global
			# effects (because of traces).
			lset bbcontent $b [incr newpc] $q
................................................................................
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace [lindex $q 1] with $res"
			}
			my replaceUses [lindex $q 1] $res
			set changed 1
		    }

		    "unset" {
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace [lindex $q 1] with Nothing"
			}
			my replaceUses [lindex $q 1] Nothing
			set changed 1
		    }

		    default {
			my debug-constfold {
			    puts "$b:$pc: $q"
			}
			my diagnostic debug $b $pc \
			    "Is there an opportunity to replace %s\

Changes to quadcode/deadcode.tcl.

185
186
187
188
189
190
191
192










193
194
195
196
197
198
199
	set blockMap [lrepeat [llength $bbcontent] -123456]
	set newBlocks {}
	set changed 0

	# Number the blocks depth-first. Blocks that precede the entry are
	# unreachable.
	set prevb -1
	foreach b [my bborder] {










	    if {$b > 0 && !$seenEntry} {
		# block b is unreachable and will be deleted. It is no longer
		# the predecessor of any other block. Removing the link allows
		# for more aggressive coalescence of the remaining blocks.
		foreach s [my bbsucc $b] {
		    my removePred $s $b
		}






|
>
>
>
>
>
>
>
>
>
>







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
	set blockMap [lrepeat [llength $bbcontent] -123456]
	set newBlocks {}
	set changed 0

	# Number the blocks depth-first. Blocks that precede the entry are
	# unreachable.
	set prevb -1
	set neworder [my bborder]
	my debug-deadbb {
	    puts "New basic block order: $neworder"
	}
	set pb -1
	foreach b $neworder {
	    if {$b < $pb} {
		set changed 1
	    } else {
		set pb $b
	    }
	    if {$b > 0 && !$seenEntry} {
		# block b is unreachable and will be deleted. It is no longer
		# the predecessor of any other block. Removing the link allows
		# for more aggressive coalescence of the remaining blocks.
		foreach s [my bbsucc $b] {
		    my removePred $s $b
		}

Changes to quadcode/transformer.tcl.

379
380
381
382
383
384
385
386
387




388
389
390
391
392
393
394
    #	Returns a four-element list: return type, list of parameter types,
    #	list of variable types, list of quadcode instructions.

    method getFlattenedQuads {} {

	# Promote entry to, return from, and invocation of procedures
	# and commands that require non-recursive evaluation.

	my promoteNREOperations





	# Make sure basic block begin with debug info

	my propDebugInfo

	# Insert instructions to widen types at phis.
	my widen






<

>
>
>
>







379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
397
    #	Returns a four-element list: return type, list of parameter types,
    #	list of variable types, list of quadcode instructions.

    method getFlattenedQuads {} {

	# Promote entry to, return from, and invocation of procedures
	# and commands that require non-recursive evaluation.

	my promoteNREOperations

	# Promoting NRE operations will have put basic blocks out of
	# topologic order, so fix that.
	my deadbb

	# Make sure basic block begin with debug info

	my propDebugInfo

	# Insert instructions to widen types at phis.
	my widen