tclquadcode

Check-in [02ab4301aa]
Login

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

Overview
Comment:Added a couple of tests to trigger loop-invariant code motion.

Corrected du-chain mismanagement in callframe.tcl (deleting moveToCallFrame), copyprop.tcl (deleting any quads), uselessphis (deleting anything), and narrow.tcl (cleanupNarrow, deleting anything). NOT WORKING: During node splitting, at least 'flightawarebench', 'msrange', 'bug7c59', and 'cse-caller' are still coming out with mismanaged chains.

Improved auditing in the 'tidy' pass of the transformer, and made it less aggressive about rechecking everything. NOT WORKING: in the 'wordcounter2' test case, it's missing at least one invocation of 'initArrayIfNotExists' because we're falling into the code gen in 'compile.tcl' for initArrayIfNotExists(ARRAY).

Advanced partial redundancy elimination to 'code complete' status. The stuff surrounding it is in bad enough shape at the moment that it is far from tested, and known not to be working for everything, but is patched out at the moment.

Timelines: family | ancestors | descendants | both | notworking | kbk-pre
Files: files | file ages | folders
SHA3-256:02ab4301aab34f90d6af2c170db5305ec34ca8070c4b3036240bf727a304c061
User & Date: kbk 2018-11-26 04:57:56
Context
2018-11-29
00:56
merge trunk check-in: 815387c202 user: kbk tags: notworking, kbk-pre
2018-11-26
04:57
Added a couple of tests to trigger loop-invariant code motion.

Corrected du-chain mismanagement in callframe.tcl (deleting moveToCallFrame), copyprop.tcl (deleting any quads), uselessphis (deleting anything), and narrow.tcl (cleanupNarrow, deleting anything). NOT WORKING: During node splitting, at least 'flightawarebench', 'msrange', 'bug7c59', and 'cse-caller' are still coming out with mismanaged chains.

Improved auditing in the 'tidy' pass of the transformer, and made it less aggressive about rechecking everything. NOT WORKING: in the 'wordcounter2' test case, it's missing at least one invocation of 'initArrayIfNotExists' because we're falling into the code gen in 'compile.tcl' for initArrayIfNotExists(ARRAY).

Advanced partial redundancy elimination to 'code complete' status. The stuff surrounding it is in bad enough shape at the moment that it is far from tested, and known not to be working for everything, but is patched out at the moment. check-in: 02ab4301aa user: kbk tags: notworking, kbk-pre

2018-11-23
18:42
Back out from quite a long false path - switch over from Simpson's modified SSAPRE to VanDrunen's GVNPRE. Implemented the two phases of BUILDSETS - results look correct for a couple of simple tests. check-in: e69362f376 user: kbk tags: kbk-pre
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to demos/perftest/tester.tcl.

1773
1774
1775
1776
1777
1778
1779


















1780
1781
1782
1783
1784
1785
1786
....
2312
2313
2314
2315
2316
2317
2318


2319
2320
2321
2322
2323
2324
2325
....
2485
2486
2487
2488
2489
2490
2491


2492
2493
2494
2495
2496
2497
2498
    proc test4 {} {
	set pq 0
	test4a p q
	return $pq
    }

}



















proc cse {x a} {
    set s 0
    for {set i 0} {$i < $a} {incr i} {
	if {($i & 1) == 0} {
	    incr s [expr {2*$x + 1}]
	} else {
................................................................................
    upvartest2::test4

    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}

    {cse-caller}


    {redundant-purify 2}
    {wideimpure 3.0}
}

set demos'slow' {
    {flightawarebench::test 5 5 2}
    {llength [hash::main]}
................................................................................
    upvar0a
    upvartest0::*
    upvartest1::*
    upvartest2::*
    flightawarebench::*
    hash::*
    redundant-purify


    cse cse-caller
    wideimpure
}
set toCompile'slow' {
    parseBuiltinsTxt::main
}
 







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







 







>
>







 







>
>







1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
....
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
....
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
    proc test4 {} {
	set pq 0
	test4a p q
	return $pq
    }

}

proc licm1 {a} {
    set a [expr {int($a)}]
    set s 0
    for {set i 0} {$i < $a} {incr i} {
	incr s [expr {2*$a + $i}]
    }
    return $s
}

proc licm2 {a} {
    set a [expr {int($a)}]
    set s 0
    for {set i 0} {$i < $a} {incr i} {
	incr s [expr {(2*$a + 1) + $i}]
    }
    return $s
}

proc cse {x a} {
    set s 0
    for {set i 0} {$i < $a} {incr i} {
	if {($i & 1) == 0} {
	    incr s [expr {2*$x + 1}]
	} else {
................................................................................
    upvartest2::test4

    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}

    {cse-caller}
    {licm1 100}
    {licm2 100}
    {redundant-purify 2}
    {wideimpure 3.0}
}

set demos'slow' {
    {flightawarebench::test 5 5 2}
    {llength [hash::main]}
................................................................................
    upvar0a
    upvartest0::*
    upvartest1::*
    upvartest2::*
    flightawarebench::*
    hash::*
    redundant-purify
    licm
    licm2
    cse cse-caller
    wideimpure
}
set toCompile'slow' {
    parseBuiltinsTxt::main
}
 

Changes to quadcode/callframe.tcl.

759
760
761
762
763
764
765

766
767
768
769
770
771
772
		lset bbcontent $b [incr outpc] $q
	    } elseif {[llength $newq] eq 3} {
		my debug-callframe {
		    puts "    no variables to move, delete this quad\
                              and replace $cfout with $cfin"
		}
		my replaceUses $cfout $cfin

		dict unset duchain $cfout
	    } else {
		my debug-callframe {
		    puts "    new quad: $newq"
		}
		lset bbcontent $b [incr outpc] $newq
	    }







>







759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
		lset bbcontent $b [incr outpc] $q
	    } elseif {[llength $newq] eq 3} {
		my debug-callframe {
		    puts "    no variables to move, delete this quad\
                              and replace $cfout with $cfin"
		}
		my replaceUses $cfout $cfin
		my removeUse $cfin $b
		dict unset duchain $cfout
	    } else {
		my debug-callframe {
		    puts "    new quad: $newq"
		}
		lset bbcontent $b [incr outpc] $newq
	    }

Changes to quadcode/copyprop.tcl.

52
53
54
55
56
57
58

59
60
61
62
63
64
65
..
82
83
84
85
86
87
88

89
90
91
92
93
94
95
		if {[lindex $to 0] eq "temp"
		    || [lrange $from 0 1] eq [lrange $to 0 1]} {
		    # Kill a copy
		    my debug-copyprop {
			puts "Fold copy:"
			puts "  $b:$pc: $q"
		    }

		    my removeUse $from $b
		    my replaceUses $to $from
		    dict unset udchain $to
		    set changed 1
		    continue;	# delete the quad

		}
................................................................................
		    # by coalescing the two quads.
		    my debug-copyprop {
			puts "Peephole-optimize copy:"
			puts "  $b:$frompc:\
                                     [lindex $bbcontent $b $frompc]"
			puts "  $b:$pc: $q"
		    }

		    
		    # Put the variable in place of the temp. No need
		    # to repair its du- and ud-chains, since it's not
		    # moving from block to block
		    lset bbcontent $b $frompc 1 $to
		    my debug-copyprop {
			puts "   Rewrite $b:$frompc: [lindex $bbcontent $b $frompc]"







>







 







>







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
		if {[lindex $to 0] eq "temp"
		    || [lrange $from 0 1] eq [lrange $to 0 1]} {
		    # Kill a copy
		    my debug-copyprop {
			puts "Fold copy:"
			puts "  $b:$pc: $q"
		    }
		    lset bbcontent $b $pc {nop {}}
		    my removeUse $from $b
		    my replaceUses $to $from
		    dict unset udchain $to
		    set changed 1
		    continue;	# delete the quad

		}
................................................................................
		    # by coalescing the two quads.
		    my debug-copyprop {
			puts "Peephole-optimize copy:"
			puts "  $b:$frompc:\
                                     [lindex $bbcontent $b $frompc]"
			puts "  $b:$pc: $q"
		    }
		    lset bbcontent $b $pc {nop {}}
		    
		    # Put the variable in place of the temp. No need
		    # to repair its du- and ud-chains, since it's not
		    # moving from block to block
		    lset bbcontent $b $frompc 1 $to
		    my debug-copyprop {
			puts "   Rewrite $b:$frompc: [lindex $bbcontent $b $frompc]"

Changes to quadcode/deadcode.tcl.

449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486



487
488
489
490
491
492
493
...
495
496
497
498
499
500
501
502







503
504



505

506


507
508
509
510
511
512
513
514
515
516
517
...
523
524
525
526
527
528
529

530





531
532
533
534
535
536
537
...
539
540
541
542
543
544
545

546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
    # variable, or else the result of the phi. It can be removed and its
    # output variable replaced with the input.

    method uselessphis {} {
	my debug-uselessphis {
	    puts "uselessphis:"
	    my dump-bb
	    dict for {v def} $udchain {
		puts "$v is defined in [dict get $udchain $v]"
		if {[dict exists $duchain $v]} {
		    puts "    and used in [dict keys [dict get $duchain $v]]"
		}
	    }
	}

	# Add all basic blocks to the worklist, with the entry at the end

	set worklist {}
	for {set b [expr {[llength $bbcontent]-1}]} {$b >= 0} {incr b -1} {
	    lappend worklist $b
	}

	# Process blocks from the worklist

	while {[llength $worklist] > 0} {
	    set b [lindex $worklist end]
	    set worklist [lrange $worklist[set worklist {}] 0 end-1]

	    # Do not use foreach here - each iteration might see data
	    # from the iteration befor it.
	    set j 0
	    for {set i 0} {$i < [llength [lindex $bbcontent $b]]} {incr i} {
		set q [lindex $bbcontent $b $i]
		if {[lindex $q 0] ne "phi"} break

		# Examine a phi operation for whether all its vars come
		# from the same place




		set dest [lindex $q 1]
		set source {}
		set dead 1
		foreach {from var} [lrange $q 2 end] {
		    if {$var ne $source && $var ne $dest} {
			if {$source eq {}} {
			    set source $var
................................................................................
			    set dead 0
			    break
			}
		    }
		}

		if {$dead} {








		    # This phi is dead. Remove all its operands from
		    # du-chains



		    foreach {from var} [lrange $q 2 end] {

			my removeUse $var $b


		    }

		    # Add any blocks that use the phi's value back on the
		    # worklist for reexamination
		    dict for {use -} [dict get $duchain $dest] {
			set idx [lsearch -sorted -integer -decreasing -bisect \
				     $worklist $use]
			if {[lindex $worklist $idx] != $use} {
			    set worklist [linsert $worklist[set worklist {}] \
					      [expr {$idx+1}] $use]
			}
................................................................................
		    # Get rid of the destination variable

		    dict unset udchain $dest
		    dict unset duchain $dest
		    dict unset types $dest

		    # delete the quad

		} else {





		    # Quad is not a dead phi, put it back in the list
		    lset bbcontent $b $j $q
		    incr j
		}
	    }

	    # Slide up the non-phi instructions
................................................................................
		set block [lindex $bbcontent $b]
		lset bbcontent $b {}
		lset bbcontent $b \
		    [lreplace $block[set block {}] $j [expr {$i-1}]]
	    }
	}


	my debug-uselessphis {
	    puts "after uselessphis:"
	    my dump-bb
	    dict for {v def} $udchain {
		puts "$v is defined in [dict get $udchain $v]"
		if {[dict exists $duchain $v]} {
		    puts "    and used in [dict keys [dict get $duchain $v]]"
		}
	    }
	}
	return
    }
 
    # unkillable --
    #
    #	Tests whether a quadcode instruction is unkillable







<
<
<
<
<
<





|










|








>
>
>







 








>
>
>
>
>
>
>

<
>
>
>

>

>
>



|







 







>

>
>
>
>
>







 







>



<
<
<
<
|
<







449
450
451
452
453
454
455






456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507

508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
...
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
...
554
555
556
557
558
559
560
561
562
563
564




565

566
567
568
569
570
571
572
    # variable, or else the result of the phi. It can be removed and its
    # output variable replaced with the input.

    method uselessphis {} {
	my debug-uselessphis {
	    puts "uselessphis:"
	    my dump-bb






	}

	# Add all basic blocks to the worklist, with the entry at the end

	set worklist {}
	for {set b [expr {[llength $bbcontent] - 1}]} {$b > 0} {incr b -1} {
	    lappend worklist $b
	}

	# Process blocks from the worklist

	while {[llength $worklist] > 0} {
	    set b [lindex $worklist end]
	    set worklist [lrange $worklist[set worklist {}] 0 end-1]

	    # Do not use foreach here - each iteration might see data
	    # from the iteration before it.
	    set j 0
	    for {set i 0} {$i < [llength [lindex $bbcontent $b]]} {incr i} {
		set q [lindex $bbcontent $b $i]
		if {[lindex $q 0] ne "phi"} break

		# Examine a phi operation for whether all its vars come
		# from the same place

		my debug-uselessphis {
		    puts "Examine $b:$i: $q"
		}
		set dest [lindex $q 1]
		set source {}
		set dead 1
		foreach {from var} [lrange $q 2 end] {
		    if {$var ne $source && $var ne $dest} {
			if {$source eq {}} {
			    set source $var
................................................................................
			    set dead 0
			    break
			}
		    }
		}

		if {$dead} {

		    my debug-uselessphis {
			puts "    The phi at $b:$i is useless"
			puts "    dest = $dest source = $source"
			puts "    $dest is used at [dict get $duchain $dest]"
			puts "    $source is used at [dict get $duchain $source]"
		    }

		    # This phi is dead. Remove all its operands from

		    # du-chains. Also zap them in the instruction so that
		    # 'replaceUses' won't find them
		    set indx 1
		    foreach {from var} [lrange $q 2 end] {
			incr indx 2
			my removeUse $var $b
			lset bbcontent $b $i $indx Nothing
			
		    }

		    # Add any blocks that use the phi's value back on the
		    # worklist for reexamination (USE PQ HERE?)
		    dict for {use -} [dict get $duchain $dest] {
			set idx [lsearch -sorted -integer -decreasing -bisect \
				     $worklist $use]
			if {[lindex $worklist $idx] != $use} {
			    set worklist [linsert $worklist[set worklist {}] \
					      [expr {$idx+1}] $use]
			}
................................................................................
		    # Get rid of the destination variable

		    dict unset udchain $dest
		    dict unset duchain $dest
		    dict unset types $dest

		    # delete the quad
		    
		} else {

		    my debug-uselessphis {
			puts "The phi at $b:$j is still useful"
		    }

		    # Quad is not a dead phi, put it back in the list
		    lset bbcontent $b $j $q
		    incr j
		}
	    }

	    # Slide up the non-phi instructions
................................................................................
		set block [lindex $bbcontent $b]
		lset bbcontent $b {}
		lset bbcontent $b \
		    [lreplace $block[set block {}] $j [expr {$i-1}]]
	    }
	}

	if 0 {
	my debug-uselessphis {
	    puts "after uselessphis:"
	    my dump-bb




	}

	}
	return
    }
 
    # unkillable --
    #
    #	Tests whether a quadcode instruction is unkillable

Changes to quadcode/duchain.tcl.

474
475
476
477
478
479
480

481

482
483
484
485
486

487
488
489
490
491
492
493
494
495

496

497
498
499
500
501
502
503
504
505

506

507
508
509
510
511
512
513
514
515
516
	incr b
    }

    set trouble 0
    set keys1 [lsort [dict keys $udchain]]
    set keys2 [lsort [dict keys $UDchain]]
    if {$keys1 ne $keys2} {

	puts stderr "$name: defined variables are $keys1 s/b $keys2"

	set trouble 1
    }
    foreach v $keys1 {
	if {[dict exists $UDchain $v]
	    && [dict get $UDchain $v] ne [dict get $udchain $v]} {

	    puts stderr "$name: $v ud-chain is [dict get $udchain $v] \
                                s/b [dict get $UDchain $v]"
	    set trouble 1
	}
    }

    set keys1 [lsort [dict keys $duchain]]
    set keys2 [lsort [dict keys $DUchain]]
    if {$keys1 ne $keys2} {

	puts stderr "$name: used variables are $keys1 s/b $keys2"

	set trouble 1
    }
	
    foreach v $keys1 {
	set chain1 [lsort -integer -stride 2 -index 0 [dict get $duchain $v]]
	if {[dict exists $DUchain $v]} {
	    set chain2 \
		[lsort -integer -stride 2 -index 0 [dict get $DUchain $v]]
	    if {$chain1 ne $chain2} {

		puts stderr "$name: $v du-chain is $chain1 s/b $chain2"

		set trouble 1
	    }
	}
    }

    if {$trouble} {
	return -code error "UD- and DU-chain audit failed in $name"
    }
	    
}







>
|
>





>
|
|







>
|
>









>
|
>










474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
	incr b
    }

    set trouble 0
    set keys1 [lsort [dict keys $udchain]]
    set keys2 [lsort [dict keys $UDchain]]
    if {$keys1 ne $keys2} {
	puts stderr "[my full-name]: $name:"
	puts stderr "    defined variables are $keys1"
	puts stderr "                      s/b $keys2"
	set trouble 1
    }
    foreach v $keys1 {
	if {[dict exists $UDchain $v]
	    && [dict get $UDchain $v] ne [dict get $udchain $v]} {
	    puts stderr "[my full-name]: $name: $v:"
	    puts stderr "    ud-chain is [dict get $udchain $v]"
	    puts stderr "            s/b [dict get $UDchain $v]"
	    set trouble 1
	}
    }

    set keys1 [lsort [dict keys $duchain]]
    set keys2 [lsort [dict keys $DUchain]]
    if {$keys1 ne $keys2} {
	puts stderr "[my full-name]: $name:"
	puts stderr "    used variables are $keys1"
	puts stderr "                   s/b $keys2"
	set trouble 1
    }
	
    foreach v $keys1 {
	set chain1 [lsort -integer -stride 2 -index 0 [dict get $duchain $v]]
	if {[dict exists $DUchain $v]} {
	    set chain2 \
		[lsort -integer -stride 2 -index 0 [dict get $DUchain $v]]
	    if {$chain1 ne $chain2} {
		puts stderr "[my full-name]: $name: $v:"
		puts stderr "    du-chain is $chain1"
		puts stderr "            s/b $chain2"
		set trouble 1
	    }
	}
    }

    if {$trouble} {
	return -code error "UD- and DU-chain audit failed in $name"
    }
	    
}

Changes to quadcode/narrow.tcl.

255
256
257
258
259
260
261

262
263
264
265
266
267
268
...
269
270
271
272
273
274
275

276
277
278
279
280
281
282

283
284
285
286
287
288
289
...
291
292
293
294
295
296
297

298
299
300
301
302
303
304
...
305
306
307
308
309
310
311

312
313
314
315
316
317
318
...
324
325
326
327
328
329
330

331
332
333
334
335
336
337
...
343
344
345
346
347
348
349

350
351
352
353
354
355
356
...
358
359
360
361
362
363
364

365
366
367
368
369
370
371
...
373
374
375
376
377
378
379


380
381
382
383
384
385
386

387

388
389
390
391
392
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
...
420
421
422
423
424
425
426

427
428
429
430
431
432

433
434
435
436
437
438
439
...
512
513
514
515
516
517
518

519
520
521
522
523
524
525
526
527
528
529
530
531

532
533
534
535
536
537
538
...
546
547
548
549
550
551
552

553
554
555
556
557
558
559
...
565
566
567
568
569
570
571

572
573
574
575
576
577
578
...
584
585
586
587
588
589
590

591
592
593
594
595
596
597
		    }
		    if {[info exists replacer]} {
			my debug-cleanupNarrow {
			    puts "$b:$pc: Able to remove $q because $source is\
			          [quadcode::nameOfType $inputType]\
				  and hence result is $result"
			}

			my removeUse $source $b
			my replaceUses $result $replacer
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................

		exists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {

			    my removeUse $source $b
			    my replaceUses $result {literal 1}
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
			"no" {

			    my removeUse $source $b
			    my replaceUses $result {literal 0}
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................

		extractArray {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set inputType [quadcode::typeOfOperand $types $source]
		    set flag [quadcode::dataType::existence $types $source]
		    if {$flag eq "no" || (!($inputType & $NONARRAY) && ($inputType & $ARRAY))} {

			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................

		extractExists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {

			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; #delete the quad
			}
		    }
................................................................................
		    set flag [quadcode::dataType::success $types $source]
		    switch -exact -- $flag {
			"no" { # unconditional failure - this is a FAIL already
			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc: replace $result with $source"
			    }

			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................
		    set flag [quadcode::dataType::success $types $source]
		    switch -exact -- $flag {
			"yes" { # unconditional success - this isn't a FAIL
			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc: replace $result with $source"
			    }

			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................

		extractScalar {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set inputType [quadcode::typeOfOperand $types $source]
		    set flag [quadcode::dataType::existence $types $source]
		    if {$flag eq "no" || (!($inputType & $ARRAY) && ($inputType & $NONARRAY))} {

			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................
		initIfNotExists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set default [lindex $q 3]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {


			    my removeUse $default $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
			"no" {

			    my removeUse $source $b

			    my replaceUses $result $default
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
		}

		initArrayIfNotExists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set default [lindex $q 3]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {

			    my removeUse $default $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
			"no" {
			    set q [list initArray $result]

			    set changed 1
			}
		    }
		}

		instanceOf {
		    set result [lindex $q 1]
................................................................................
		    set is [quadcode::dataType::isa \
				[quadcode::typeOfOperand $types $source] \
				$typecode]
		    set maybe [quadcode::dataType::mightbea \
				   [quadcode::typeOfOperand $types $source] \
				   $typecode]
		    if {$is} {

			my removeUse $source $b
			my replaceUses $result {literal 1}
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    } elseif {!$maybe} {

			my removeUse $source $b
			my replaceUses $result {literal 0}
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set typecode [lindex $q 0 1]
		    set is [quadcode::dataType::isa \
				[quadcode::typeOfOperand $types $source] \
				$typecode]
		    if {$is} {

			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}

		purify {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set inputType [quadcode::typeOfOperand $types $source]
		    if {!($inputType & $IMPURE)} {

			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................
			    # unconditional success - result is already
			    # at hand!

			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc replace result with $source"
			    }

			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................
		    set flag [quadcode::dataType::success $types $source]
		    switch -exact -- $flag {
			"yes" { # unconditional success - return code must be 0
			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc: replace result with {literal 0}"
			    }

			    my removeUse $source $b
			    my replaceUses $result {literal 0}
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................
		    set rcode [lindex $q 3]
		    if {$rcode eq "literal 0"} {
			my debug-cleanupNarrow {
			    puts "$b:$pc: delete $q"
			    puts "$b:$pc: replace $result with\
                                          '-code 0 -level 0'"
			}

			my removeUse $source $b
			my replaceUses $result \
			    {literal {-code 0 -level 0}}
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }







>







 







>







>







 







>







 







>







 







>







 







>







 







>







 







>
>







>

>











<



>
|







>







 







>






>







 







>













>







 







>







 







>







 







>







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
...
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
...
294
295
296
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
...
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
...
381
382
383
384
385
386
387
388
389
390
391
392
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
420
421
422
423
424
425
426
427
428
429
430
...
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
...
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
...
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
...
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
...
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
		    }
		    if {[info exists replacer]} {
			my debug-cleanupNarrow {
			    puts "$b:$pc: Able to remove $q because $source is\
			          [quadcode::nameOfType $inputType]\
				  and hence result is $result"
			}
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result $replacer
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................

		exists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result {literal 1}
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
			"no" {
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result {literal 0}
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................

		extractArray {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set inputType [quadcode::typeOfOperand $types $source]
		    set flag [quadcode::dataType::existence $types $source]
		    if {$flag eq "no" || (!($inputType & $NONARRAY) && ($inputType & $ARRAY))} {
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................

		extractExists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; #delete the quad
			}
		    }
................................................................................
		    set flag [quadcode::dataType::success $types $source]
		    switch -exact -- $flag {
			"no" { # unconditional failure - this is a FAIL already
			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc: replace $result with $source"
			    }
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................
		    set flag [quadcode::dataType::success $types $source]
		    switch -exact -- $flag {
			"yes" { # unconditional success - this isn't a FAIL
			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc: replace $result with $source"
			    }
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................

		extractScalar {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set inputType [quadcode::typeOfOperand $types $source]
		    set flag [quadcode::dataType::existence $types $source]
		    if {$flag eq "no" || (!($inputType & $ARRAY) && ($inputType & $NONARRAY))} {
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................
		initIfNotExists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set default [lindex $q 3]
		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my removeUse $default $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
			"no" {
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my removeUse $default $b
			    my replaceUses $result $default
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
		}

		initArrayIfNotExists {
		    set result [lindex $q 1]
		    set source [lindex $q 2]

		    set flag [quadcode::dataType::existence $types $source]
		    switch -exact -- $flag {
			"yes" {
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
			"no" {
			    set q [list initArray $result]
			    my removeUse $source $b
			    set changed 1
			}
		    }
		}

		instanceOf {
		    set result [lindex $q 1]
................................................................................
		    set is [quadcode::dataType::isa \
				[quadcode::typeOfOperand $types $source] \
				$typecode]
		    set maybe [quadcode::dataType::mightbea \
				   [quadcode::typeOfOperand $types $source] \
				   $typecode]
		    if {$is} {
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result {literal 1}
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    } elseif {!$maybe} {
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result {literal 0}
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set typecode [lindex $q 0 1]
		    set is [quadcode::dataType::isa \
				[quadcode::typeOfOperand $types $source] \
				$typecode]
		    if {$is} {
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}

		purify {
		    set result [lindex $q 1]
		    set source [lindex $q 2]
		    set inputType [quadcode::typeOfOperand $types $source]
		    if {!($inputType & $IMPURE)} {
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result $source
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }
		}
................................................................................
			    # unconditional success - result is already
			    # at hand!

			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc replace result with $source"
			    }
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result $source
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................
		    set flag [quadcode::dataType::success $types $source]
		    switch -exact -- $flag {
			"yes" { # unconditional success - return code must be 0
			    my debug-cleanupNarrow {
				puts "$b:$pc: delete $q"
				puts "$b:$pc: replace result with {literal 0}"
			    }
			    lset bbcontent $b $pc {nop {}}
			    my removeUse $source $b
			    my replaceUses $result {literal 0}
			    dict unset udchain $result
			    set changed 1
			    continue; # delete the quad
			}
		    }
................................................................................
		    set rcode [lindex $q 3]
		    if {$rcode eq "literal 0"} {
			my debug-cleanupNarrow {
			    puts "$b:$pc: delete $q"
			    puts "$b:$pc: replace $result with\
                                          '-code 0 -level 0'"
			}
			lset bbcontent $b $pc {nop {}}
			my removeUse $source $b
			my replaceUses $result \
			    {literal {-code 0 -level 0}}
			dict unset udchain $result
			set changed 1
			continue; # delete the quad
		    }

Changes to quadcode/pre.tcl.

14
15
16
17
18
19
20






21
22
23
24
25










26
27
28
29
30
31
32
..
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117








118
119
120
121
122
123
124
125
126








127
128
129
130
131
132
133
134



135


136


137
138
139





































140
141
142
143

144
145
146
147
148
149
150
151
152
...
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
...
205
206
207
208
209
210
211
212

213
214
215
216

217
218
219
220
221
222
223
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
...
289
290
291
292
293
294
295

296
297
298
299
300
301
302
...
314
315
316
317
318
319
320
321

322
323
324
325
326
327
328































































































































329
330
331
332
333
334
335
336






337
338
339
340
341
342
343
...
355
356
357
358
359
360
361


362


363
364
365
366
367

368
369
370
371
372
373
374

375
376
377
378
379
380
381
...
523
524
525
526
527
528
529






















































































































































































































































































































































































































































































































530
531
532

533
534
535
536
537
538
539
540
541
542
543
544



545
546
547
548
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
592

593
594


595
596
597
598
599



















600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629
630
631


632
633
634
635
636
637
638

639
640
641
642
643
644

645
646
647
648
649
650
651
652
653
654


655
656
657
658
659

660
661
662
663
664
665
666
# partitioned into a set of equivalence classes, corresponding with
# the values that they compute. Variables in the same class are known
# to be equal, and so code that computes them can be removed if the values
# are already available; loop-invariant values can be hoisted out of the
# corresponding loops, and so on.
#
# Sources of particular note include:






#
# [Dres93] Drechsler, Karl-Heinz, and Manfred P. Stadel. "A variation of
# Knoop, Rüthing and Steffen's _Lazy Code Motion._ _SIGPLAN Notices_ 28:5
# (May, 1993), pp. 29-38.
#










# [Simp96] Simpson, Loren Taylor. "Value-driven redundancy elimination."
# PhD thesis, Rice University, Houston, Texas (April 1996)
# https://www.clear.rice.edu/comp512/Lectures/Papers/SimpsonThesis.pdf
#
# [VaHo03] VanDrunen, Thomas J. and Antony L. Hosking. "Corner cases in
# value-based partial redundancy elimination." CSD Technical Report 03-032,
# Purdue University, West Lafayette, Indiana (November, 2003)
................................................................................
    variable gvn_eliminable
    proc _init {} {
	variable gvn_eliminable {}
	foreach opcode {
	    add
	    arrayExists arrayElementExists arrayGet arraySet arrayUnset
	    bitand bitnot bitor bitxor
	    concat copy
	    dictAppend dictExists dictGet dictGetOrNexist
	    dictLappend dictSet dictSetOrUnset dictSize dictUnset
	    div
	    eq expand exists expon extractArray extractCallFrame extractExists
	    extractFail extractMaybe extractScalar
	    foreachAdvance foreachIter foreachMayStep foreachStart
	    frameArgs frameDepth
................................................................................
#	Returns 1 if modifications were made, 0 if the method
#	accomplished nothing.
#
# Side effects:
#	Redundant calculations are removed.
#
# The removal of redundant calculations may expose additional
# opportunities for optimization. In particular, it is possible
# that phi operations will have become worthless, either because
# two such operations become the same operation, or because
# all inputs to a phi become the same input. It may be necessary
# to repeat this optimization after cleaning up useless phi's.
#
# It follows the general plan of [VAND04], chapter 4.

oo::define quadcode::transformer method partialredundancy {} {

    # TEMP - examine just the specific target scenario
    #if {[my full-name] ne "::cse(INT,INT)"
    #	 || [llength $bbcontent] != 11} {return 0}

    my debug-pre {
	puts "Before partial redundancy elimination:"
	my dump-bb
    }


    # 0. Initialize the global variable numbering tables.

    my pre_init









    # 1. Perform a top-down traversal of the basic blocks (which has the
    #    effect that any block's dominators will have been processed before
    #    the block itself). Compute the global value numbering that maps
    #	 expressions to their values. Compute the expression generation
    #	 sets (EXP_GEN, PHI_GEN, TMP_GEN) and analyze available expressions
    #	 (AVAIL_OUT).

    my pre_buildsets1









    # 2. Perform a traversal of the basic blocks in the retrograde direction
    #    (ensuring that a block's postdominators are processed before the
    #    block itself). Compute the anticipability of expressions in the
    #    blocks (ANTIC_IN).

    my pre_buildsets2




    set changed 0


    


    if {[catch {
	my audit-duchain pre
	my audit-phis pre





































    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }


    return $changed

}
 
# quadcode::transformer method pre_init --
#
#	Initializes the tables for global value numbering and partial
#	redundancy elimination
................................................................................
    my variable pre_phi_gen
    my variable pre_tmp_gen
    my variable pre_avail_out

    set pre_exp_gen {}
    set pre_phi_gen {}
    set pre_tmp_gen {}
    set pre_avail_out {}

    variable ::quadcode::gvn_eliminable

    # Walk through basic blocks in the forward direction
    set b -1
    foreach bb $bbcontent {
	incr b
................................................................................

	# Clear the 'gen' sets and inherit the 'avail_out' set from
	# the basic block's immediate dominator (which must have been
	# visited already!)
	set exp_gen_b {}
	set phi_gen_b {}
	set tmp_gen_b {}
	if {$b == 0} {

	    set avail_out_b {}
	} else {
	    set avail_out_b [lindex $pre_avail_out [lindex $bbidom $b]]
	}


	# Walk through instructions in the basic block
	set pc -1
	foreach q $bb {
	    incr pc
	    set argl [lassign $q opcode result]
	    set op [lindex $opcode 0]
................................................................................
		set expr [list {} $result]
		set v [my pre_gvn_lookup_or_add $expr]
		lappend phi_gen_b $result $argl

	    } elseif {$op eq "copy"} {

		# copy - give the result the same value number as the source.
		#        give result a unique value number if the copy is
		#        not from a var or temp
		set src [lindex $argl 0]
		set expr [list {} $result]
		if {$src ne {temp var}} {
		    set v [my pre_gvn_lookup_or_add $expr]
		} else {
		    set srcexpr [list {} $src]
		    set v [my pre_gvn_lookup $srcexpr]
		    my pre_gvn_add $expr $v
		}
		if {![dict exists $exp_gen_b $v]} {
		    dict set exp_gen_b $v $expr
		}
		lappend tmp_gen_b $result

	    } elseif {[dict exists $gvn_eliminable $op]} {

................................................................................
		
	    } else {

		# Anything else - make a unique value
		set expr [list {} $result]
		set v [my pre_gvn_lookup_or_add $expr]
		lappend tmp_gen_b $result

	    }

	    dict set avail_out_b $v $result
		
	}

	my debug-pre {
................................................................................
		puts "    value $v: $expr"
	    }
	}

	lappend pre_exp_gen $exp_gen_b
	lappend pre_phi_gen $phi_gen_b
	lappend pre_tmp_gen $tmp_gen_b
	lappend pre_avail_out $avail_out_b


    }

    return
	
}
 































































































































# quadcode::transformer method pre_buildsets2 --
#
#	Perform anticipable expression analysis.
#
# Results:
#	None.
#
# Side effects:






#	The 'pre_antic_in' variable is initialized to a list, indexed
#	by basic block number, of dictionaries that describe values that
#	are anticipable on entry to the block.
#
# This procedure follows the general plan of 'iterate until convergence'
# with the iteration being performed over basic blocks in the retrograde
# direction - that is, postdominators are visited before the blocks that
................................................................................

oo::define quadcode::transformer method pre_buildsets2 {} {

    my variable pre_exp_gen
    my variable pre_tmp_gen
    my variable pre_phi_gen



    my variable pre_antic_in



    # Initialize anticipable sets to empty. This initial value should
    # be accessed only in the case of an infinite loop, whose blocks will
    # have no postdominators.
    set pre_antic_in [lrepeat [llength $bbcontent] {}]


    # Calculate the retrograde order in which blocks are to be visited
    set bs [my bbrorder]

    # Iterate to convergence
    set changed 1
    while {$changed} {

	my debug-pre {
	    puts "Do one pass of anticipability analysis"
	} 

	set changed 0

	# Visit blocks in retrograde sequence
................................................................................
	    }
	}
    }

    return
}
 






















































































































































































































































































































































































































































































































# quadcode::transformer method pre_phi_translate
#
#	Translates an expression that is valid in a successor block

#	to one that is valid in the predecessor block
#
# Parameters:
#	es - Dictionary whose keys are global value numbers and
#	     whose values are expressions in the successor block
#	b - Predecessor block
#	s - Successor block
#
# Results:
#	Returns the translated expressions in the same dictionary
#	form as 'es'
#



# Described on page 1 of [VaHo03].

oo::define quadcode::transformer method pre_phi_translate {es b s} {

    my variable pre_phi_gen

    # Retrieve the phis in the successor block
    set phis [lindex $pre_phi_gen $s]
    set bkey [list bb $b]

    # Translate each expression in turn
    set translated {}
    dict for {v e} $es {
	lassign [my pre_mu $v $e $es $phis $bkey] newv newe
	if {$newv >= 0} {
	    dict set translated $newv $newe
	} else {
	    my debug-pre {
		puts "        value $newv = $newe need not be included in translated exprs"
	    }
	}
    }

    return $translated
}

# quadcode::transformer method pre_mu --
#
#	Translates a single expression that is transiting a set of phi
#	operations


#
# Parameters:
#	v - The expression's global value number
#	e - The expression being translated
#	es - The other expressions above the phi
#	phis - Two-level dictionary mapping variable name and origin basic
#	       block key to the variable name in the origin block
#	bkey - Basic block key for lookup in phis
#
# Results:
#	Returns a two-element list containing the value number of the
#	translated expression and the translated expression.

#
# Side effects:
#	This procedure has the possibility of creating a new expression,
#	which will then be added to the global value numbering.



#
# Page 1 of [VaHo03].


oo::define quadcode::transformer method pre_mu {v e es phis bkey} {



    my debug-pre {
	set pfx [format "    %*s" [info level] {}]
	puts "${pfx}translate value $v = $e"
    }



















    # Take apart the expression
    set argl [lassign $e opcode]
    set eout [list $opcode]

    if {$opcode eq {}} {

	# This expression is a single temporary. If it is the result
	# of a phi, replace it with its source variable
	set a [lindex $argl 0]
	if {[dict exists $phis $a $bkey]} {
	    set a2 [dict get $phis $a $bkey]
	    my debug-pre {
		puts "${pfx}  replace $a with $a2"
	    }
	    set a $a2
	}
	lappend eout $a

    } else {

	# This is an expression that calculates something. Recurse into
	# its operands

	foreach a $argl {
	    if {[lindex $a 0] ne "value"} {

		# Not a numbered value, just append it to the new expression
		lappend eout $a

	    } else {

		# Numbered value. Find what it translates to, and append
		# that to the new expression


		set v1 [lindex $a 1]
		set e1 [dict get $es $v1]
		lassign [my pre_mu $v1 $e1 $es $phis $bkey] v2 e2
		if {$v2 >= 0} {
		    my debug-pre {
			puts "${pfx}  replace $a with value $v2"
		    }

		    lappend eout [list value $v2]
		} else {
		    my debug-pre {
			puts "${pfx}  replace $a with [lindex $e2 1]"
		    }
		    lappend eout [lindex $e2 1]

		}
	    }
	}
    }
    
    if {[lindex $eout 0] ne {} || [lindex $eout 1 0] in {"temp" "var"}} {
	set vout [my pre_gvn_lookup_or_add $eout]
    } else {
	set vout -1
    }


    my debug-pre {
	puts "${pfx}result is value $vout = $eout"
    }
    return [list $vout $eout]
    

}
 
# quadcode::transformer method pre_clean --
#
#	Filters out killed dependent expressions from a set of anticipable
#	expressions
#







>
>
>
>
>
>



|

>
>
>
>
>
>
>
>
>
>







 







|







 







|
|
|
|
|
<
<




|
|






<



>
>
>
>
>
>
>
>









>
>
>
>
>
>
>
>








>
>
>
|
>
>
|
>
>

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




>

|







 







|







 







<
>
|
|
|
|
>







 







<
<


<
<
<
|
|
|
<







 







>







 







|
>







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








>
>
>
>
>
>







 







>
>

>
>





>







>







 







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

<
>
|




|






>
>
>


|
<
<
<
<
<
<




|
<
|
<
<
<
|
<
<
<


|
|

<
<
>
>




|
|
<
<


<
<
>


<
<
>
>
>
|
<
>

<
>
>
|

<
|

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






|
<

|
|
<
<
<
<





|
|
>


<
<

<

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

<
<
<
<
>




<
<
|
<
<
<
>
>

|

<

>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
...
104
105
106
107
108
109
110
111
112
113
114
115


116
117
118
119
120
121
122
123
124
125
126
127

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
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
183
184
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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
279
280
281
282
283
284
285

286
287
288
289
290
291
292
293
294
295
296
297
298
...
316
317
318
319
320
321
322


323
324



325
326
327

328
329
330
331
332
333
334
...
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
...
384
385
386
387
388
389
390
391
392
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
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
...
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
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
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
1039
1040
1041
1042
1043
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
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243

1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262






1263
1264
1265
1266
1267

1268



1269



1270
1271
1272
1273
1274


1275
1276
1277
1278
1279
1280
1281
1282


1283
1284


1285
1286
1287


1288
1289
1290
1291

1292
1293

1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325

1326
1327
1328




1329
1330
1331
1332
1333
1334
1335
1336
1337
1338


1339

1340



1341
1342
1343






1344
1345
1346




1347
1348
1349
1350
1351


1352



1353
1354
1355
1356
1357

1358
1359
1360
1361
1362
1363
1364
1365
1366
# partitioned into a set of equivalence classes, corresponding with
# the values that they compute. Variables in the same class are known
# to be equal, and so code that computes them can be removed if the values
# are already available; loop-invariant values can be hoisted out of the
# corresponding loops, and so on.
#
# Sources of particular note include:
#
# [Chow97] Chow, Fred, Sun Chan, Robert Kennedy, Shin-Ming Liu,
# Raymond Lu, and Peng Tu. "A new algorithm for partial redundancy
# elimination based on SSA form. Proc. ACM SIGPLAN 1997 Conf. on Programming
# Language Design and Implementation (PLDI '97), Las Vegas, Nevada,
# 1997, pp. 273-286. https://dl.acm.org/citation.cfm?id=258940
#
# [Dres93] Drechsler, Karl-Heinz, and Manfred P. Stadel. "A variation of
# Knoop, Rüthing and Steffen's _Lazy Code Motion._ _SIGPLAN Notices_ 28:5
# (May, 1993), pp. 29-38. https://dl.acm.org/citation.cfm?id=152823
#
# [MoRe76] Morel, Étienne, and Claude Renvoise. "Global optimization
# by suppression of partial redundancies." Proc. 2d Intl. Symp. on
# Programming, Paris, April 1976, pp. 147-159. (A more accessible but
# less detailed reference is [MoRe79].)
# https://dl.acm.org/citation.cfm?id=359069
#
# [MoRe79] Morel, Étienne, and Claude Renvoise. "Global optimization
# by suppression of partial redundancies." Communications of the ACM 22:2
# (February, 1979), pp. 96-103.
# 
# [Simp96] Simpson, Loren Taylor. "Value-driven redundancy elimination."
# PhD thesis, Rice University, Houston, Texas (April 1996)
# https://www.clear.rice.edu/comp512/Lectures/Papers/SimpsonThesis.pdf
#
# [VaHo03] VanDrunen, Thomas J. and Antony L. Hosking. "Corner cases in
# value-based partial redundancy elimination." CSD Technical Report 03-032,
# Purdue University, West Lafayette, Indiana (November, 2003)
................................................................................
    variable gvn_eliminable
    proc _init {} {
	variable gvn_eliminable {}
	foreach opcode {
	    add
	    arrayExists arrayElementExists arrayGet arraySet arrayUnset
	    bitand bitnot bitor bitxor
	    concat
	    dictAppend dictExists dictGet dictGetOrNexist
	    dictLappend dictSet dictSetOrUnset dictSize dictUnset
	    div
	    eq expand exists expon extractArray extractCallFrame extractExists
	    extractFail extractMaybe extractScalar
	    foreachAdvance foreachIter foreachMayStep foreachStart
	    frameArgs frameDepth
................................................................................
#	Returns 1 if modifications were made, 0 if the method
#	accomplished nothing.
#
# Side effects:
#	Redundant calculations are removed.
#
# The removal of redundant calculations may expose additional
# opportunities for optimization. In particular, it is possible that
# phi operations will have become worthless, either because two such
# operations become the same operation, or because all inputs to a phi
# become the same input. It may be necessary to repeat this
# optimization after cleaning up useless phi's.



oo::define quadcode::transformer method partialredundancy {} {

    # TEMP - examine just the specific target scenario
    if {0 && ([my full-name] ne "::cse(INT,INT)"
	      || [llength $bbcontent] != 11)} {return 0}

    my debug-pre {
	puts "Before partial redundancy elimination:"
	my dump-bb
    }


    # 0. Initialize the global variable numbering tables.

    my pre_init

    if {[catch {
	my audit-duchain pre-0
	my audit-phis pre-0
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }

    # 1. Perform a top-down traversal of the basic blocks (which has the
    #    effect that any block's dominators will have been processed before
    #    the block itself). Compute the global value numbering that maps
    #	 expressions to their values. Compute the expression generation
    #	 sets (EXP_GEN, PHI_GEN, TMP_GEN) and analyze available expressions
    #	 (AVAIL_OUT).

    my pre_buildsets1

    if {[catch {
	my audit-duchain pre-1
	my audit-phis pre-1
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }

    # 2. Perform a traversal of the basic blocks in the retrograde direction
    #    (ensuring that a block's postdominators are processed before the
    #    block itself). Compute the anticipability of expressions in the
    #    blocks (ANTIC_IN).

    my pre_buildsets2

    my debug-pre {
	my variable pre_antic_in
	puts "Anticipable values:"
	set b -1
	foreach d $pre_antic_in {
	    puts "   block [incr b]: [dict keys $d]"
	}
    }

    if {[catch {
	my audit-duchain pre-2
	my audit-phis pre-2
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }

    # 3. Perform code motion by inserting evaluations and phis at
    #    merge points.

    if {[catch {
	my audit-duchain pre-3
	my audit-phis pre-3
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }
    set did_something [my pre_insert]

    # 4. Rewrite the program to replace calculations of available values
    #    with copies from the temps that hold the values

    if {[catch {
	my audit-duchain pre-4
	my audit-phis pre-4
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }
    if {[my pre_eliminate]} {
	set did_something 1
    }

    # 5. Now, dead code elimination and copy propagation will eliminate
    #    any messes that step 4 left behind.
    
    if {[catch {
	my audit-duchain pre-5
	my audit-phis pre-5
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }
    my pre_cleanup

    return $did_something

}
 
# quadcode::transformer method pre_init --
#
#	Initializes the tables for global value numbering and partial
#	redundancy elimination
................................................................................
    my variable pre_phi_gen
    my variable pre_tmp_gen
    my variable pre_avail_out

    set pre_exp_gen {}
    set pre_phi_gen {}
    set pre_tmp_gen {}
    set pre_avail_out [lrepeat [llength $bbcontent] {}]

    variable ::quadcode::gvn_eliminable

    # Walk through basic blocks in the forward direction
    set b -1
    foreach bb $bbcontent {
	incr b
................................................................................

	# Clear the 'gen' sets and inherit the 'avail_out' set from
	# the basic block's immediate dominator (which must have been
	# visited already!)
	set exp_gen_b {}
	set phi_gen_b {}
	set tmp_gen_b {}


	# Determine values available on entry to the block. They will,
	# of course, continue to be available. We may need speculative
	# phis to be inserted.

	set avail_out_b [my pre_avail_in $b bb]

	# Walk through instructions in the basic block
	set pc -1
	foreach q $bb {
	    incr pc
	    set argl [lassign $q opcode result]
	    set op [lindex $opcode 0]
................................................................................
		set expr [list {} $result]
		set v [my pre_gvn_lookup_or_add $expr]
		lappend phi_gen_b $result $argl

	    } elseif {$op eq "copy"} {

		# copy - give the result the same value number as the source.


		set src [lindex $argl 0]
		set expr [list {} $result]



		set srcexpr [list {} $src]
		set v [my pre_gvn_lookup_or_add $srcexpr]
		my pre_gvn_add $expr $v

		if {![dict exists $exp_gen_b $v]} {
		    dict set exp_gen_b $v $expr
		}
		lappend tmp_gen_b $result

	    } elseif {[dict exists $gvn_eliminable $op]} {

................................................................................
		
	    } else {

		# Anything else - make a unique value
		set expr [list {} $result]
		set v [my pre_gvn_lookup_or_add $expr]
		lappend tmp_gen_b $result
		
	    }

	    dict set avail_out_b $v $result
		
	}

	my debug-pre {
................................................................................
		puts "    value $v: $expr"
	    }
	}

	lappend pre_exp_gen $exp_gen_b
	lappend pre_phi_gen $phi_gen_b
	lappend pre_tmp_gen $tmp_gen_b
	lset pre_avail_out $b $avail_out_b
	lset bbcontent $b $bb

    }

    return
	
}
 
# quadcode::transformer method pre_avail_in --
#
#	Calculates the AVAIL_IN set for a basic block
#
# Parameters:
#	b - Basic block number
#	bbVar - Variable in caller's scope containing the instructions
#	        in the block
#
# Results:
#	Returns the available expression set as a dictionary whose keys
#	are global value numbers and whose values are the leaders.
#
# Side effects:
#	May modify the basic block to insert speculative phi instructions.
#
# This procedure works around a limitation in [VanD04] that is not present
# in [MoRe76] or in [Simp96]. THe case that [VanD04] overlooks
# is a combination like
#
# 1: c1 = a1 + b1
#    jump 3
#
# 2: c2 = a1 + b1
#    jump 3
#
# 3: d1 = a1 + b1
#
# In this sequence, a1+b1 is fully available at block 3, requiring the
# insertion of a zero-cost phi operation. It may be only partially
# anticipable there, but [Simp96] would have found it, as would [MoRe79].
#
# The fix is to insert a speculative phi instruction at the head of (3:)
#
#    c3 = phi(c1, c2)
#
# which then makes c3 fully available to downstream calculations.
#
# This is less general than the phi-insertion step of [Chow97], but
# the case of values that are both partially available and partially
# anticipable is more complex than we are attempting yet.

oo::define quadcode::transformer method pre_avail_in {b bbVar} {

    my variable pre_avail_out

    upvar 1 $bbVar bb

    set preds [lindex $bbpred $b]
    set n [dict size $preds]
    if {$n == 0} {

	# The entry block has no available values at its start
	return {}
	
    } elseif {$n == 1} {

	# A block with a single predecessor has a trivial AVAIL_IN set
	dict for {p -} $preds break
	return [lindex $pre_avail_out $p]

    }

    my debug-pre {
	puts "  Compute available exprs at merge point $b"
    }

    # A merge point may need to have phi's inserted. Start with the values
    # that are available from the dominator.

    set avail_in [lindex $pre_avail_out [lindex $bbidom $b]]

    # Merge in any values that arrive from all predecessors but
    # do not originate in the dominator
    set firsttime 1
    set newphis {}
    dict for {p -} $preds {
	set avout_p [lindex $pre_avail_out $p]
	my debug-pre {
	    puts "    Available from $p: [dict keys $avout_p]"
	}
	if {$firsttime} {
	    dict for {v e} $avout_p {
		if {![dict exists $avail_in $v]} {
		    dict set newphis $v [list bb $p] $e
		}
	    }
	    set firsttime 0
	} else {
	    dict for {v phi} $newphis {
		if {![dict exists $avout_p $v]} {
		    dict unset newphis $v
		} else {
		    dict set newphis $v [list bb $p] [dict get $avout_p $v]
		}
	    }
	}
    }

    if {[dict size $newphis] == 0} {
	return $avail_in
    }

    # Create any speculative phis
    set newbb {}
    dict for {v argl} $newphis {
	dict for {- var} $argl break
	set var [my newVarInstance $var]
	dict for {frombb in} $argl {
	    my addUse $in $b
	}
	set insn [linsert $argl 0 phi $var]
	my debug-pre {
	    puts "  Speculative: $b:[llength $newbb]: $insn"
	}
	dict set udchain $var $b
	lappend newbb $insn
	my pre_gvn_add [list {} $var] $v
	dict set avail_in $v $var
    }
    set bb [linsert $bb[set bb ""] 0 {*}$newbb]

    return $avail_in
    
}

 
# quadcode::transformer method pre_buildsets2 --
#
#	Perform anticipable expression analysis.
#
# Results:
#	None.
#
# Side effects:
#	The 'pre_antic_loc' variable is initialized to a list, indexed
#	by basic block number, of dictionaries that describe values that
#	are anticipable LOCALLY on entry to the block, that is,
#	ones that are calculated locally but not dependent on temporaries
#	in the block (EXP_GEN-TMP_GEN).
#
#	The 'pre_antic_in' variable is initialized to a list, indexed
#	by basic block number, of dictionaries that describe values that
#	are anticipable on entry to the block.
#
# This procedure follows the general plan of 'iterate until convergence'
# with the iteration being performed over basic blocks in the retrograde
# direction - that is, postdominators are visited before the blocks that
................................................................................

oo::define quadcode::transformer method pre_buildsets2 {} {

    my variable pre_exp_gen
    my variable pre_tmp_gen
    my variable pre_phi_gen

    my variable pre_avail_out

    my variable pre_antic_in
    
    my variable pre_translate_cache

    # Initialize anticipable sets to empty. This initial value should
    # be accessed only in the case of an infinite loop, whose blocks will
    # have no postdominators.
    set pre_antic_in [lrepeat [llength $bbcontent] {}]
    set pre_translate_cache {}

    # Calculate the retrograde order in which blocks are to be visited
    set bs [my bbrorder]

    # Iterate to convergence
    set changed 1
    while {$changed} {

	my debug-pre {
	    puts "Do one pass of anticipability analysis"
	} 

	set changed 0

	# Visit blocks in retrograde sequence
................................................................................
	    }
	}
    }

    return
}
 
# quadcode::transformer method pre_insert --
#
#	Inserts new calculations for redundant expressions as
#	part of partial redundancy elimination.
#
# Results:
#	Returns 1 if any code was changed, 0 otherwise
#
# Side effects:
#
#	'copy' and 'phi' instructions are inserted in the quadcode
#	to make fully anticipable expressions available at merge
#	points where they are only partially available. This process
#	involves inserting computation of the needed expressions
#	on any predecessors where they are not available, and then
#	introducing a phi operation to combine the new expressions.
#
# Figures 4.8-4.9 on pp. 78-79 of [VanD].

oo::define quadcode::transformer method pre_insert {} {

    my variable pre_antic_in
    my variable pre_avail_out
    my variable pre_new_sets
    
    my debug-pre {
	puts "Try to find code insertion points"
    }

    set pre_new_sets [lrepeat [llength $bbcontent] {}]
    set did [lrepeat [llength $bbcontent] {}]

    # Iterate to convergence
    set did_something 0
    set changed 1
    while {$changed} {
	set changed 0

	# Process the basic blocks in forward sequence
	set b -1
	foreach didvals $did {
	    incr b

	    # Initially, the new instructions making values available
	    # are inherited from the dominator, and they also become
	    # the leaders for their values.
	    set avail_in_dom [lindex $pre_avail_out [lindex $bbidom $b]]
	    set new_sets_b $avail_in_dom
	    set avail_out_b [lindex $pre_avail_out $b]
	    lset pre_avail_out $b {}
	    dict for {v e} $new_sets_b {
		dict set avail_out_b $v $e
	    }
	    lset pre_avail_out $b $avail_out_b
		
	    # Handle merge points
	    set preds [lindex $bbpred $b]
	    if {[dict size $preds] > 1} {

		# Walk through the anticipable expressions at each merge point
		dict for {v e} [lindex $pre_antic_in $b] {

		    if {[dict exists $didvals $v]} {
			my debug-pre {
			    puts "Already hoisted value $v past $b"
			}
			continue
		    }
		    
		    my debug-pre {
			puts "Examine value $v = $e in block $b"
		    }

		    
		    # If an expression is a copy, we don't need to do
		    # anything because its value is known to be available.
		    # If an expression is available in the dominator, it's
		    # already available here, so there's no need to do anything
		    # more
		    if {[lindex $e 0] ne {}
			&& ![dict exists $avail_in_dom $e]} {

			# The expression e (whose value number is v)
			# is not a copy. The expression is anticipable
			# in block b but not its dominator.  This is
			# the case that may need a phi and one or more
			# assignments.

			if {[my pre_insert_do_expr $b $v $e]} {
			    dict set didvals $v {}
			    set changed 1
			    set did_something 1
			}
		    }
		}		    
	    }
	    lset did $b $didvals
	}
    }
    return $did_something
}
 
# quadcode::transformer method pre_insert_do_expr --
#
#	When an expression is found that is available at a merge point
#	but not its dominator, makes that expression available if possible.
#
# Parameters:
#	b - Basic block number of the merge point
#	preds - Dictionary whose keys are the predecessors of basic block b
#	v - Value number of the expression under consideration
#	e - Expression under consideration
#
# Results:
#	Returns 1 if the procedure did anything.
#
# Figure 4.8, page 78 of [VanD].
#
# TODO - Need to think about how to maintain a name and a debugging context
#	 for code that has been moved - or to suppress this optimization
#	 at low -O levels

oo::define quadcode::transformer method pre_insert_do_expr {b v e} {

    my variable pre_new_sets

    my debug-pre {
	puts "Examine value $v: $e for code motion at entry to block $b"
    }

    # Is this a point where it's appropriate to insert (It is if
    # the value is available on at least one predecessor, and not on all).

    set avail [my pre_insertion_point $b $v $e]
    if {[dict size $avail] == 0} {
	my debug-pre {
	    puts "$v: $e is not eligible to be hoisted above block $b"
	}
	return 0
    }

    my debug-pre {
	puts "The expression will be made available from:"
	dict for {p eprime} $avail {
	    puts "  block $p -> $eprime"
	}
    }

    set t [my pre_insert_make_mods $b $v $e $avail]

    set news [lindex $pre_new_sets $b]
    lset pre_new_sets $b {}
    dict set news $v $t
    lset pre_new_sets $b $news

    return 1
}
 
# quadcode::transformer method pre_insertion_point --
#
#	Tests whether the predecessors of the start of a given basic block
#	are appropriate insertion points for a partially available expression.
#
# Parameters:
#	b - Block being examined
#	v - Global value number of the expression being examined
#	e - Expression being examined, which will always be complex.
#
# Results:
#	Returns a dictionary whose keys are the basic block numbers
#	of predecessor blocks, and whose values are expressions
#	in the blocks.
#
# The expressions will be either SSA temporaries that contain the
# corresponding value at the end of the predecessor block, or complex
# expressions that must be evaluated in the predecessor. If the block
# is an inappropriate point to insert the evaluation of the given
# value, the returned dictionary will be empty.
#
# This procedure is roughly the second half of Figure 5.8 on page 78
# of [VanD04].

oo::define quadcode::transformer method pre_insertion_point {b v e} {

    my variable pre_avail_out
    set bbb -1

    set avail {};		# Return value of this method, being
    ;				# accumulated
    set by_some 0;		# Flag is true if the expression is available
    ;				# in at least one predecessor
    set all_same 1;		# Flag is true if all predecessors present
    ;				# the same value for the available expression

    set ve [dict create $v $e];	# Dictionary with the single pair v->e,
    ;				# to use as an argument to phi_translate

    # Iterate through the predecessors
    dict for {p -} [lindex $bbpred $b] {

	# Find the expression, eprime, that would make e available in the
	# predecessor
	dict for {vprime eprime} [my pre_phi_translate1 $v $e $p $b] break

	# Is the translated expression available in the predecessor already?
	set avail_out_p [lindex $pre_avail_out $p]
	if {![dict exists $avail_out_p $vprime]} {

	    # Not available - add it as something that needs to be evaluated
	    dict set avail $p $eprime
	    set all_same 0

	} else {

	    # It is available - add the temporary to the available set and
	    # update 'all_same'
	    set leader [dict get $avail_out_p $vprime]
	    set lexpr [list {} $leader]
	    dict set avail $p $lexpr
	    set by_some 1
	    if {![info exists first_s]} {
		set first_s $lexpr
	    } elseif {$first_s ne $lexpr} {
		set all_same 0
	    }
	}
    }

    # The expression will benefit from code motion at this point if
    # it is available in at least one predecessor, and it is not available
    # in the same SSA temporary in all predecessors. We also force code
    # motion if an expression is unavailable at a loop header

    if {($by_some && !$all_same)} {
	return $avail
    } else {
	return {}
    }
    
}
 
# quadcode::transformer method pre_insert_make_mods --
#
#	Inserts a phi at a merge point (and possible expression
#	evaluations above a merge point) to hoist one anticipated
#	expression above the merge.
#
# Parameters:
#	b - Basic block that the expression is leaving
#	v - Global value number of the expression
#	e - Expression being moved above block b
#	avail - Dictionary whose keys are the predecessor blocks
#	        and whose values are the expressions that need
#	        to be evaluated in the predecessors to make e
#	        fully available.
#
# Results:
#	Returns the name of the temporary that replaces the
#	expression in b.
#
# Side effects:
#	Adds any needed code to reify the expression in the predecessors,
#	and adds a phi at the start of b to pick up the expression value.
#	The value becomes available at the exit of b.
#
# The logic mostly follows Figure 4.9 on page 79 of [VanD04].

oo::define quadcode::transformer method pre_insert_make_mods {b v e avail} {

    my variable pre_avail_out

    my debug-pre {
	puts "Make value $v: $e available in block $b"
    }
    
    # Start building a phi to represent the temporary
    my debug-pre {
	puts "  Make temporary to hold $e at entry to block $b"
    }
    set outv [my pre_make_temp_for_expr $v $e]
    my debug-pre {
	puts "    Call it $outv!"
    }
    set phi [list phi $outv]
    dict set udchain $outv $b

    # Reify the expression in each predecessor block
    dict for {p eprime} $avail {

	my debug-pre {
	    puts "  Reify $eprime in block $p"
	}
	set argl [lassign $eprime opcode]
	if {$opcode ne {}} {

	    set avail_out_p [lindex $pre_avail_out $p]
	    lset pre_avail_out $p {}

	    # A complex expression actually needs to be evaluated
	    # in the predecessor block. Make the instruction and update
	    # ud- and du-chains
	    my debug-pre {
		puts "    Need to find temporary for value $v"
	    }
	    set t [my pre_make_temp_for_expr $v $eprime]
	    my debug-pre {
		puts "    Call it $t!"
	    }
	    dict set udchain $t $p
	    set tv [my pre_gvn_lookup_or_add $eprime]
	    my pre_gvn_add [list {} $t] $tv
	    set insn [list $opcode $t]
	    foreach a $argl {
		if {[lindex $a 0] ne "value"} {
		    lappend insn $a
		} else {
		    set var [dict get $avail_out_p [lindex $a 1]]
		    my addUse $var $p
		    lappend insn $var
		}
	    }

	    # Insert the instruction in the block
	    set pb [lindex $bbcontent $p]
	    lset bbcontent $p {}
	    my debug-pre {
		puts "  Add $insn before end of block $p"
	    }
	    set pb [linsert $pb[set pb ""] end-1 $insn]
	    lset bbcontent $p $pb
	    
	    # Make the value available at exit from the predecessor
	    dict set avail_out_p $tv $t
	    lset pre_avail_out $p $avail_out_p
	    
	} else {

	    # A simple value is already available and just needs to go
	    # on the phi being constructed
	    
	    set t [lindex $argl 0]
	}

	# Add the reified value to the phi under construction
	lappend phi [list bb $p] $t
	my addUse $t $b
	
    }

    # Paste the newly-build phi at the start of the block
    my debug-pre {
	puts "Add $phi at the start of $b"
    }
    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    set bb [linsert $bb[set bb {}] 0 $phi]
    lset bbcontent $b $bb

    # Make the value available at exit from the block
    set avail_out_b [lindex $pre_avail_out $b]
    lset pre_avail_out $b {}
    dict set avail_out_b $v $outv
    lset pre_avail_out $b $avail_out_b

    return $outv
}
 
# quadcode::transformer method pre_eliminate --
#
#	Eliminates redundant code once partial availability has been
#	resolved
#
# Results:
#	Returns 1 if anything was eliminated
#
# Side effects:
#	Rewrites quadcode to eliminate redundant operations.
#
# Figure 4.10 on page 80 of [VanD04].

oo::define quadcode::transformer method pre_eliminate {} {

    variable ::quadcode::gvn_eliminable

    my variable pre_avail_out

    my debug-pre {
	puts "Rewrite to eliminate redundant computations:"
    }

    set changed 0

    # Walk through the basic blocks and their AVAIL sets
    set b -1
    foreach bb $bbcontent avail_out_b $pre_avail_out {
	incr b
	my debug-pre {
	    puts "bb $b:"
	}
	set newbb {}

	# Walk through the instructions in the block
	set pc -1
	foreach q $bb {
	    incr pc
	    my debug-pre {
		puts "  $pc: $q"
	    }
	    set argl [lassign $q opcode result]
	    set op [lindex $opcode 0]

	    # Might this instruction have been eliminated?
	    if {[dict exists $gvn_eliminable $op]} {

		# Is there an earlier computation whose result can
		# replace the result of this instruction?
		set v [my pre_gvn_lookup [list {} $result]]
		set x [dict get $avail_out_b $v]
		if {$x ne $result} {

		    # Replace this instruction with a copy
		    foreach a $argl {
			if {[lindex $a 0] in {"temp" "var"}} {
			    my removeUse $a $b
			}
		    }
		    my addUse $x $b
		    set q [list copy $result $x]
		    set changed 1
		    my debug-pre {
			puts "-------> $q"
		    }
		}
	    }
	    
	    lappend newbb $q
	}
	lset bbcontent $b $newbb
    }
    return $changed
}
 
# quadcode::transformer method pre_cleanup --
#
#	Clean up globals left behind by partial redundancy elimination
#
# Results:
#	None

oo::define quadcode::transformer method pre_cleanup {} {

    my variable pre_antic_in
    my variable pre_avail_out
    my variable pre_exp_gen
    my variable pre_new_sets
    my variable pre_phi_gen
    my variable pre_tmp_gen
    my variable pre_translate_cache
    my variable pre_vexprs
    my variable pre_vn

    unset -nocomplain pre_antic_in
    unset -nocomplain pre_avail_out
    unset -nocomplain pre_exp_gen
    unset -nocomplain pre_new_sets
    unset -nocomplain pre_phi_gen
    unset -nocomplain pre_tmp_gen
    unset -nocomplain pre_translate_cache
    unset -nocomplain pre_vexprs
    unset -nocomplain pre_vn

    return
}
 
# quadcode::transformer method pre_make_temp_for_expr --
#
#	Creates a temporary variable to hold the value of an expression
#
# Parameters:
#	v - Global value number
#	e - Expression being evaluated
#
# Results:
#	Returns the name of the newly-created temp

oo::define quadcode::transformer method pre_make_temp_for_expr {v e} {

    my variable pre_vexprs

    set tempname [list temp $v]
    foreach c [lindex $pre_vexprs $v] {
	if {[lindex $c 0] eq {}} {
	    set cname [lindex $c 1]
	    if {[lindex $cname 0] eq "var" || [lindex $tempname 0] ne "var"} {
		set tempname $cname
	    }
	}
    }

    return [my newVarInstance $cname]
}
 
# quadcode::transformer method pre_phi_translate --
#

#	Translates a set of expressions that are valid in a successor
#	block to ones that are valid in the predecessor block
#
# Parameters:
#	es - Dictionary whose keys are global value numbers and
#	     whose values are expressions in the successor block
#	p - Predecessor block
#	s - Successor block
#
# Results:
#	Returns the translated expressions in the same dictionary
#	form as 'es'
#
# Side effects:
#	Caches the result of translation.
#
# Described on page 1 of [VaHo03].

oo::define quadcode::transformer method pre_phi_translate {es p s} {







    # Translate each expression in turn
    set translated {}
    dict for {v e} $es {
	lassign [my pre_phi_translate1 $v $e $p $s] newv newe

	dict set translated $newv $newe



    }



    return $translated
}
 
# quadcode::transformer method pre_phi_translate1 --
#


#	Translates an expression that is valid in a successof block to
#	one that is valid in a predecessor block.
#
# Parameters:
#	v - The expression's global value number
#	e - The expression being translated
#	p - The predecessor block
#	s - The successor block


#
# Results:


#	Returns the result of the translation
#
# Side effects:


#	Result is cached. The cache is necessary not only for speed but
#	also because 'pre_phi_insert' depends on being able to look up
#	an already-computed translation.


oo::define quadcode::transformer method pre_phi_translate1 {v e p s} {


    my variable pre_translate_cache
    my variable pre_phi_gen
    
    my debug-pre {

	puts "        Translate value $v: $e on edge $p -> $s"
    }

    set phis [lindex $pre_phi_gen $s]
    ;			       # Phi operations at the successor block
    set skey [list bb $p];     # Key for looking up predecessor value at a phi

    # Find the cached translations for this flowgraph edge. If this value
    # is already cached, return the translation
    if {[dict exists $pre_translate_cache $p $s]} {
	set es [dict get $pre_translate_cache $p $s]
    } else {
	set es {}
    }
    if {[dict exists $es $v]} {
	my debug-pre {
	    puts "        (cached) [dict get $es $v]"
	}
	return [dict get $es $v]
    }

    # Take apart the expression
    set argl [lassign $e opcode]
    set eout [list $opcode]

    if {$opcode eq {}} {

	# Translate a single SSA temporary

	set a [lindex $argl 0]
	if {[dict exists $phis $a $skey]} {
	    set a [dict get $phis $a $skey]




	}
	lappend eout $a

    } else {

	# Translate an expression that calculates something. All of its
	# dependent values will already have been translated. Rewrite
	# values, and leave other args unchanged.
	foreach a $argl {
	    if {[lindex $a 0] ne "value"} {


		lappend eout $a

	    } else {



		# The arg is 'value N', and we must have already translated
		# it. Retrieve it from the cache
		set vprime [lindex $a 1]






		if {[dict exists $es $vprime]} {
		    lappend eout [list value [lindex [dict get $es $vprime] 0]]
		} else {




		    error "$p->$s Value $vprime is not cached, but $e depends on it?"
		}
	    }
	}
    }


    set vout [my pre_gvn_lookup_or_add $eout]



    set result [list $vout $eout]
    dict set pre_translate_cache $p $s $v $result
    my debug-pre {
	puts "        result is value $vout: $eout"
    }

    
    return $result
}
 
# quadcode::transformer method pre_clean --
#
#	Filters out killed dependent expressions from a set of anticipable
#	expressions
#

Changes to quadcode/transformer.tcl.

316
317
318
319
320
321
322

323
324
325
326
327
328
329
...
342
343
344
345
346
347
348




349
350
351
352
353
354
355
...
524
525
526
527
528
529
530
531

532
533

534
535
536

537
538
539
540
541
542
543
544
545
546
547
548
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
592
593
594
595
596
597










598
599









600
601
602
603






604
605
606
607
608
609
610
	foreach pass {
	    bbpartition
	    constJumpPeephole
	    sortbb
	    loopinv
	    callFrameMotion
	    ssa

	    ud_du_chain
	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
................................................................................
		puts "$pass: $usec microseconds"
	    }
	}
	my debug-transform {
	    puts "after initial transform:"
	    my dump-bb
	}




    }
 
    # variant --
    #
    #	Makes a specialized version of this quadcode, once parameter types
    #	are given

................................................................................
#
# Preconditions:
#       Types must have already been inferred, including the requirement
#       that the return types of commands must be stable (or at least
#       conservative).
#
# Results:
#       None.

#
# Side effects:

#       Type-dependent operations (for example, narrowing, type checking)
#       are eliminated where the input types are known. Dead code (unconditional
#       jumps on noncritical edges, unreachable code, unused variables,

#       useless phi operations, useless copies) is removed.
#
#       The dominator tree is rebuilt.
#
#       This method may narrow the types of parameters to called functions,
#       or the result type of the function being processed. In this case,
#       type specialization may have been made invalid and will have to be
#       repaired.

oo::define quadcode::transformer method tidy {} {

    # Remove useless type checking
    set changed [my cleanupNarrow]




    # The following optimizations have no data type dependency.
    # They depend only on control and data flows, and so are safe
    # even though earlier operations may have spoilt type information.
    # 'deadjump' can cause data type analysis to be spoilt.
    # 'deadbb' can also cause it to be spoilt, because it could be that

    # a variable receives a particular type only in unreachable code.
    # 'bbidom' and 'bblevel' do not modify the program.

    # 'deadvars' removes unused values. This cannot affect data types,
    # but it affects dependencies if an entire procedure invocation can be
    # killed.
    # 'deadphis' and 'copyprop' remove only 'copy' and 'phi' operations,
    # 'and any operand that they replace hav exactly the same types
    # as the operands being replaced.

    # Remove useless data motion from callframes
    set changed [expr {[my cleanupMoveFromCallFrame] || $changed}]






    # Remove useless data motion into callframes
    set changed [expr {[my cleanupMoveToCallFrame] || $changed}]


    # Remove any totally irrelevant callframe use/defs
    set changed [expr {[my cleanupCallFrameUse] || [my deadvars] || $changed}]

    # Remove conditional jumps that depend on constants





    set changed [expr {[my deadjump] || $changed}]

    # Remove unreachable code and coalesce basic blocks where possible



    set changed [expr {[my deadbb] || $changed}]

    # Restore the dominator tree if it has been spoilt.




















    if {$changed} {
	my bbidom
	my bblevel

    }

    # Remove assignments to unused values












    set changed [expr {[my deadvars] || $changed}]

    # Remove useless phi operations
    my uselessphis;             # Remove useless phi operations




    # Do copy propagation
    if {[my copyprop] || [my constfold]} {
	set changed 1

	# Copy propagation may have destroyed the only references to
	# certain values. Hunt them down and kill them.










	my deadvars
	my uselessphis









    }

    # Perform partial redundancy elimination
    set changed [expr {[my partialredundancy] || $changed}]







    return $changed

}
 
# quadcode::transformer method sourceFile --
#







>







 







>
>
>
>







 







|
>


>
|
|
|
>
|










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

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



>

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







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
...
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
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

592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617

618
619
620
621
622
623
624
625
626
627
628
629
630
631


632
633
634
635



636


637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659


660
661
662
663
664
665
666
667
668
669
670
671
672
	foreach pass {
	    bbpartition
	    constJumpPeephole
	    sortbb
	    loopinv
	    callFrameMotion
	    ssa
	    renameTemps
	    ud_du_chain
	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
................................................................................
		puts "$pass: $usec microseconds"
	    }
	}
	my debug-transform {
	    puts "after initial transform:"
	    my dump-bb
	}
	my debug-audit {
	    my audit-duchain exit-from-transform
	    my audit-phis exit-from-transform
	}
    }
 
    # variant --
    #
    #	Makes a specialized version of this quadcode, once parameter types
    #	are given

................................................................................
#
# Preconditions:
#       Types must have already been inferred, including the requirement
#       that the return types of commands must be stable (or at least
#       conservative).
#
# Results:
#       Returns 1 if type inference must be repeated, 0 if the code
#	is thought to be ready to try jump threading.
#
# Side effects:
#
#       Type-dependent operations (for example, narrowing, type
#       checking) are eliminated where the input types are known. Dead
#       code (unconditional jumps on noncritical edges, unreachable
#       code, unused variables, useless phi operations, useless
#       copies) is removed.
#
#       The dominator tree is rebuilt.
#
#       This method may narrow the types of parameters to called functions,
#       or the result type of the function being processed. In this case,
#       type specialization may have been made invalid and will have to be
#       repaired.

oo::define quadcode::transformer method tidy {} {



    my debug-audit {
	my audit-duchain entry-to-tidy
	my audit-phis entry-to-tidy
    }






    # There's a distinct order of passes here.


    # We come in with type inference having been run, and 'cleanupNarrow'
    # depends on the types being right.




    #

    # 'cleanupMoveFromCallFrame'. 'cleanupMoveToCallFrame' and
    # 'cleanupCallFrameUse' can follow. They remove unneeded callframe
    # references. This change may make additional typing information
    # available, so we will want to rerun type analysis and try again
    # if any of these passes actually changes the code.
    #
    # Copy propagation and constant folding can follow. These operations
    # should not change the type of anything, they only simplify the code.

    #
    # When we kill conditional jumps and remove dead code, we can
    # destroy the basic block dominance relations, so we rebuild them
    # before getting into any further optimizations that need them.
    #
    # We can now try partial redundancy elimination, which cannot change
    # data types but only moves around operations of known type.
    # It can leave a mess to clean up, with dead variables, useless phis,
    # and the possibility that it's given rise to empty basic blocks,
    # allowing deadbb/deadjump possibly to do further restructuring.

    set changed 0


    lappend timings cleanupNarrow \
	[lindex [time {set result [my cleanupNarrow]}] 0]
    if {$result} {
	set changed 1
    }

    my debug-audit {
	my audit-duchain cleanupNarrow
	my audit-phis cleanupNarrow
    }

    foreach pass {
	deadjump
	deadbb
	deadvars
	uselessphis
	deadjump
	deadbb
    } {
	lappend timings $pass [lindex [time [list my $pass]] 0]
	my debug-audit {
	    my audit-duchain $pass
	    my audit-phis $pass
	}
    }

    if {$changed} {
	my bbidom
	my bblevel
	return 1
    }
	

    foreach pass {
	copyprop
	constfold
	cleanupMoveFromCallFrame
	cleanupMoveToCallFrame
	cleanupCallFrameUse
    } {
	set passcmd [string map [list @pass $pass] {
	    set result [my @pass]
	}]
	lappend timings $pass [lindex [time $passcmd] 0]
	if {$result} {
	    set changed 1
	}


	my debug-audit {
	    my audit-duchain $pass
	    my audit-phis $pass
	}



    }



    # want partialredundancy on the blank line
    foreach pass {
	bbidom
	bblevel

	copyprop
	constfold
	deadjump
	deadbb
	deadvars
	uselessphis
	deadjump
	deadbb
	bbidom
	bblevel
    } {
	lappend timings $pass [lindex [time [list my $pass]] 0]
	my debug-audit {
	    my audit-duchain $pass
	    my audit-phis $pass
	}
    }



    my debug-timings {
	foreach {pass usec} $timings {
	    puts "$pass: $usec microseconds"
	}
    }

    return $changed

}
 
# quadcode::transformer method sourceFile --
#

Changes to quadcode/typecheck.tcl.

255
256
257
258
259
260
261



262
263
264
265
266
267
268
269
270
271





272
273




274
275

276
277
278
279
280
281



282
283
284
285
286
287




288
289




290
291

292
293
294
295
296



297
298
299
300




301
302




303
304

305
306
307
308
309
310
311
	set j 0
	for {set i 0} {$i < [llength [lindex $bbcontent $b]]} {incr i} {
	    set q [lindex $bbcontent $b $i]

	    switch -exact [lindex $q 0 0] {

		"initParamTypeException" {



		    lassign $q op result src fref
		    set t [my determineFunctionParamType $op $fref]
		    if {$t != $quadcode::dataType::STRING} {
			set msg [format "can't use non-numeric value as\
                                         operand of \"%s\"" [lindex $fref 1]]
			set msgLit [list literal $msg]
			set exn {literal {-errorcode {ARITH DOMAIN {non-numeric string}}}}
			lset bbcontent $b $j \
			    [list initException $result $msgLit $exn \
				 {literal 1} {literal 0}]





			incr j
		    } else {




			my removeUse $src $b
			my replaceUses $result Nothing

			# delete the quad
		    }

		}

		"instanceOfParamType" {



		    lassign $q op result src fref
		    set t [my determineFunctionParamType $op $fref]
		    if {$t != $quadcode::dataType::STRING} {
			set t [expr {$t | $quadcode::dataType::IMPURE}]
			set op [list "instanceOf" $t [nameOfType $t]]
			lset bbcontent $b $j [list $op $result $src]




			incr j
		    } else {




			my removeUse $src $b
			my replaceUses $result {literal 1}

			# delete the quad
		    }
		}

		"purifyParam" {



		    lassign $q op result src fref
		    set t [my determineFunctionParamType $op $fref]
		    if {$t != $quadcode::dataType::STRING} {
			lset bbcontent $b $j [list purify $result $src]




			incr j
		    } else {




			my removeUse $src $b
			my replaceUses $result $src

			# delete the quad
		    }
		}

		default {
		    lset bbcontent $b $j $q
		    incr j







>
>
>







|


>
>
>
>
>


>
>
>
>


>






>
>
>





|
>
>
>
>


>
>
>
>


>





>
>
>



|
>
>
>
>


>
>
>
>


>







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
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
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
	set j 0
	for {set i 0} {$i < [llength [lindex $bbcontent $b]]} {incr i} {
	    set q [lindex $bbcontent $b $i]

	    switch -exact [lindex $q 0 0] {

		"initParamTypeException" {
		    my debug-rewriteParamChecks {
			puts "$b:$i: $q"
		    }
		    lassign $q op result src fref
		    set t [my determineFunctionParamType $op $fref]
		    if {$t != $quadcode::dataType::STRING} {
			set msg [format "can't use non-numeric value as\
                                         operand of \"%s\"" [lindex $fref 1]]
			set msgLit [list literal $msg]
			set exn {literal {-errorcode {ARITH DOMAIN {non-numeric string}}}}
			set newq \
			    [list initException $result $msgLit $exn \
				 {literal 1} {literal 0}]
			my removeUse $src $b
			lset bbcontent $b $j $newq
			my debug-rewriteParamChecks {
			    puts "$b:$j ----> $newq"
			}
			incr j
		    } else {
			my debug-rewriteParamChecks {
			    puts "$b:$i: (deleted)"
			}
			lset bbcontent $b $i {nop {}}
			my removeUse $src $b
			my replaceUses $result Nothing
			dict unset duchain $result
			# delete the quad
		    }

		}

		"instanceOfParamType" {
		    my debug-rewriteParamChecks {
			puts "$b:$i: $q"
		    }
		    lassign $q op result src fref
		    set t [my determineFunctionParamType $op $fref]
		    if {$t != $quadcode::dataType::STRING} {
			set t [expr {$t | $quadcode::dataType::IMPURE}]
			set op [list "instanceOf" $t [nameOfType $t]]
			set newq [list $op $result $src]
			lset bbcontent $b $j $newq
			my debug-rewriteParamChecks {
			    puts "$b:$j ----> $newq"
			}
			incr j
		    } else {
			my debug-rewriteParamChecks {
			    puts "$b:$i: (deleted)"
			}
			lset bbcontent $b $i {nop {}}
			my removeUse $src $b
			my replaceUses $result {literal 1}
			dict unset duchain $result
			# delete the quad
		    }
		}

		"purifyParam" {
		    my debug-rewriteParamChecks {
			puts "$b:$i: $q"
		    }
		    lassign $q op result src fref
		    set t [my determineFunctionParamType $op $fref]
		    if {$t != $quadcode::dataType::STRING} {
			set newq [list purify $result $src]
			lset bbcontent $b $j $newq
			my debug-rewriteParamChecks {
			    puts "$b:$j ----> $newq"
			}
			incr j
		    } else {
			my debug-rewriteParamChecks {
			    puts "$b:$i: (deleted)"
			}
			lset bbcontent $b $i {nop {}}
			my removeUse $src $b
			my replaceUses $result $src
			dict unset duchain $result
			# delete the quad
		    }
		}

		default {
		    lset bbcontent $b $j $q
		    incr j