Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch mistake
Excluding Merge-Ins
This is equivalent to a diff from
7b85bdfca9
to 1984824c19
2018-12-07
| | |
02:23 |
|
Closed-Leaf
check-in: 023d0828f0 user: kbk tags: poly1305
|
02:19 |
|
Closed-Leaf
check-in: 1984824c19 user: kbk tags: mistake
|
2018-12-06
| | |
21:17 |
|
check-in: c2a6505ae9 user: dkf tags: poly1305
|
03:15 |
|
check-in: 0e06123e97 user: kbk tags: trunk
|
2018-11-04
| | |
23:49 |
|
check-in: 7b85bdfca9 user: dkf tags: poly1305
|
2018-11-01
| | |
22:04 |
|
check-in: dfc7885448 user: kbk tags: trunk
|
2018-10-31
| | |
11:32 |
|
check-in: fb47c5a2cd user: dkf tags: poly1305
|
| | |
Changes to demos/perftest/tester.tcl.
︙ | | |
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
+
+
+
|
# Copyright (c) 2014-2017 by Kevin B. Kenny
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------
interp recursionlimit {} 4000
#############################################################################
#
# Test code definitions. These are all procedures; that's all we can currently
# compile.
proc cos {x {n 16}} {
|
︙ | | |
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
+
+
+
+
+
+
|
proc polartest {u v} {
set th [expr {atan2($v,$u)}]
set r [expr {hypot($v,$u)}]
set u2 [expr {$r * cos($th)}]
set v2 [expr {$r * sin($th)}]
return [expr {hypot($v2-$v, $u2-$u)}]
}
proc lmapconsttest {} {
lmap y {10 20 30} {
lmap x {1 2 3} {expr {$x + $y}}
}
}
# This is a cut-down version of the version in Tcllib's math package
namespace eval math {}
proc ::math::ln_Gamma { x } {
# Handle the common case of a real argument that's within the
# permissible range.
|
︙ | | |
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
|
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
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 {
incr s [expr {2*$x + 2}]
}
}
return $s
}
proc cse-caller {} {
for {set x 0} {$x < 3} {incr x} {
for {set y 0} {$y < 2} {incr y} {
lappend result [cse $x $y]
}
}
return $result
}
proc redundant-purify {adder} {
for {set i 0} {$i < 100} {incr i} {
incr x $adder
incr y $adder
incr y $adder
}
list $x $y
}
namespace eval ::inlinetwice {
proc carry limb {
list [expr {$limb & 0x0FFFFFFF}] [expr {$limb >> 28}]
}
proc test {a b} {
set a [expr {int($a)}]
set b [expr {int($b)}]
lassign [carry $a] a0 a1
lassign [carry $b] b0 b1
list $a1 [expr {$a0 + $b1}] $b0
}
}
namespace eval ::regexptest {
proc matchvar-1 {needle haystack} {
regexp -indices -- $needle $haystack where
return $where
}
}
namespace eval ::flightawarebench {
# See https://github.com/flightaware/tclbench/blob/master/math/bench.tcl
proc degrees_radians {degrees} {
return [expr {$degrees * 3.14159265358979323846 / 180.0}]
}
proc latlongs_to_distance {lat1 lon1 lat2 lon2} {
|
︙ | | |
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
|
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
|
+
|
{fib 85}
{fib-r 15}
{cos 1.2}
# Fails on a roundoff error: {tantest 1.2}
{inttest 345}
{math::ln_Gamma 1.3}
{polartest 0.6 0.8}
{lmapconsttest}
{powmul1 13 3}
{powmul2 13 3}
{zerodiv}
{uplustest 123 456}
{uplustest 01 010}
{cleanopt {uplustest abc def}}
# String operations
|
︙ | | |
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
|
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
|
+
+
|
{bug-7c599d4029::bug 0x1}
{linesearch::getAllLines1 2}
{linesearch::getAllLines2 2}
# {flightawarebench::test 5 5 2}
# {flightawarebench::clockscan 5 5 5}
parseBuiltinsTxt::main
{regexptest::matchvar-1 bra abracadabra}
vartest::check
vartest::throwcheck
nsvartest::check
directtest::check
directtest::alias
{directtest::ary3 abc 3 1}
{directtest::ary4 abc 5}
|
︙ | | |
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
|
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
|
-
+
+
+
+
+
+
+
+
+
+
+
|
{hash::H9fast ultraantidisestablishmentarianistically}
{hash::H9mid ultraantidisestablishmentarianistically}
{hash::H9slow ultraantidisestablishmentarianistically}
{toHex [poly1305 compute $key $msg]}
{poly1305 verify $key $msg $tag}
}
{wideimpure 3.0}
{cse-caller}
{licm1 100}
{licm2 100}
{redundant-purify 2}
{inlinetwice::test 0x10000003 0x50000007}
}
set demos'slow' {
{flightawarebench::test 5 5 2}
{llength [hash::main]}
}
#########################################################################
#
# List of procedures to compile. These do not need to be fully-qualified; the
# compilation engine will do that for us if necessary.
set toCompile {
# Mathematical operations; [fib] and [cos] are supposed to be accelerated
# heavily, the others are less critical
fib fib-r
::cos
tantest
inttest
math::ln_Gamma
polartest
lmapconsttest
shift
powmul1 powmul2
zerodiv
uplustest
# String operations
strtest
passthrough
|
︙ | | |
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
|
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
|
+
+
+
+
+
|
comps
bug-7c599d4029::*
singleton::*
linesearch::colinear
linesearch::sameline
linesearch::getAllLines1
linesearch::getAllLines2
regexptest::*
vartest::*
nsvartest::*
directtest::*
upvar0
upvar0a
upvartest0::*
upvartest1::*
upvartest2::*
flightawarebench::*
hash::*
redundant-purify
inlinetwice::*
licm1 licm2
cse cse-caller
wideimpure
poly1305::*
poly1305::tcl::mathfunc::*
}
set toCompile'slow' {
parseBuiltinsTxt::main
}
|
︙ | | |
Changes to quadcode/bb.tcl.
︙ | | |
348
349
350
351
352
353
354
355
356
357
358
359
360
361
|
348
349
350
351
352
353
354
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
382
383
384
385
386
387
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
lappend bbpred {}
# Link $to to the new block
my bblink $newb $to
return $newb
}
# bbcopy --
#
# Makes a copy of a basic block
#
# Parameters:
# b - Block number to copy
#
# Results:
# Returns the copied block
#
# Side effects:
# The copied block has no predecessors - it is assumed that the
# caller will relink it in the correct context. The copied block
# has as successors the successors of the original block.
method bbcopy {b} {
# Create the block
set newb [llength $bbcontent]
lappend bbcontent [lindex $bbcontent $b]
lappend bbpred {}
foreach s [my bbsucc $newb] {
my bblink $newb $s
}
return $newb
}
# bbindex --
#
# Look up a basic block index given the program counter
#
# Parameters:
# pc - Program counter in the quadcode
|
︙ | | |
494
495
496
497
498
499
500
501
|
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
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
my bborder-worker visited nodelist $s
}
lappend nodelist $node
}
return
}
}
# bbrorder --
#
# List the basic blocks in the program in reverse depth-first
# postorder of the minimum spanning tree of the flowgraph, starting
# from the exit nodes
#
# Results:
# Returns the ordered list of basic block indices
#
# This method is used in cases where an iteration needs to be conducted
# in such a way that a node's postdominators are visited before
# the node itself.
#
# This method must attempt to deal with infinite loops, so all nodes
# must be visited eventually. It therefore runs two passes. The first
# visits exit nodes, and the second visits everything else.
method bbrorder {} {
set l [llength $bbcontent]
set visited [lrepeat $l 0]
set nodelist {}
for {set i [expr {$l-1}]} {$i >= 0} {incr i -1} {
if {[llength [my bbsucc $i]] == 0} {
my bbrorder-worker visited nodelist $i
}
}
for {set i [expr {$l-1}]} {$i >= 0} {incr i -1} {
my bbrorder-worker visited nodelist $i
}
return [lreverse $nodelist]
}
method bbrorder-worker {visitedVar nodelistVar node} {
upvar 1 $visitedVar visited
upvar 1 $nodelistVar nodelist
if {![lindex $visited $node]} {
lset visited $node 1
dict for {p -} [lindex $bbpred $node] {
my bbrorder-worker visited nodelist $p
}
lappend nodelist $node
}
return
}
}
|
Changes to quadcode/builtin_specials.tcl.
︙ | | |
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
-
+
|
# After the switches come needle and haystack
incr ind 2
# Anything remaining on the line must be a match variable
if {$ind < [llength $q]} {
if {$ind >= [llength $q]} {
return {killable Inf noCallFrame {} pure {}}
} else {
return [list writes [expr {3-$ind}]]
}
}
|
︙ | | |
Changes to quadcode/callframe.tcl.
︙ | | |
759
760
761
762
763
764
765
766
767
768
769
770
771
772
|
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
}
|
︙ | | |
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
|
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
|
-
-
|
if {[lindex $p 0] eq "literal"} {
dict set written [lindex $p 1] {}
} else {
return {0 {}};
}
}
} else {
set i [expr {-$ind}]
foreach p [lrange $params [expr {-1 - $ind}] end] {
if {[lindex $p 0] eq "literal"} {
dict set written [lindex $p 1] {}
} else {
return {0 {}};
}
incr i
}
}
}
}
if {[dict exists $attrs writesNamed]} {
foreach nm [dict get $attrs writesNamed] {
|
︙ | | |
Changes to quadcode/constfold.tcl.
︙ | | |
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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
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
227
228
229
230
231
232
233
234
235
236
237
238
239
240
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
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
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
|
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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
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
227
228
229
230
231
232
233
234
235
236
237
238
239
240
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
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
349
350
351
352
353
354
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
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
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
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
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
|
+
+
-
+
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
-
+
-
-
+
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
-
+
+
|
# Walk through basic blocks in forward sequence.
for {set b 0} {$b < [llength $bbcontent]} {incr b} {
set newbb {}
set newpc -1
for {set pc 0} {$pc < [llength [lindex $bbcontent $b]]} {incr pc} {
set q [lindex $bbcontent $b $pc]
lset bbcontent $b $pc [list nop {}]
set mightfold 1
set argl {}
foreach arg [lrange $q 2 end] {
if {[lindex $arg 0] ne "literal"} {
set mightfold 0
break
}
lappend argl [lindex $arg 1]
}
set result [lindex $q 1]
if {$mightfold} {
switch -exact -- [lindex $q 0 0] {
"@debug-file" - "@debug-context" -
"@debug-line" - "@debug-script" -
"dictIterStart" - "directAppend" - "directArrayAppend" -
"directArrayLappend" - "directArrayLappendList" -
"directArraySet" - "directArrayUnset" - "directExists" -
"directGet" - "directLappend" - "directLappendList" -
"directSet" - "directUnset" - "directIsArray" -
"directMakeArray" - "foreachStart" - "entry" -
"extractExists" - "extractFail" -
"extractMaybe" - "initException" -
"jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" - "purify" -
"jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" -
"narrowToType" -
"procLeave" - "purify" -
"split" - "unshareList" -
"initArray" - "setReturnCode" - "resolveCmd" - "originCmd" {
# do nothing - these insns are not killable
# this case goes away once I have a better handle
# on what's killable.
# Note that the "direct..." operations are probably
# never killable due to the potential for global
# effects (because of traces).
lset bbcontent $b [incr newpc] $q
}
"add" {
lassign $argl x y
set res [list literal [expr {$x + $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"arrayExists" {
my debug-constfold {
puts "$b:$pc: examine $q"
}
# What type do I want?
set want $quadcode::dataType::ARRAY
# What type do I have?
set source [lindex $argl 0]
set have [typeOfLiteral $source]
# Can I say sommething definitive?
unset -nocomplain replacement
if {[quadcode::dataType::isa $have $want]} {
set replacement {literal 1}
} elseif {![quadcode::dataType::mightbea $have $want]} {
set replacement {literal 0}
}
if {[info exists replacement]} {
my debug-constfold {
puts "$b:$pc: can replace $result with\
$replacement and remove the instruction"
}
my removeUse $source $b
dict unset udchain $result
my replaceUses $result $replacement
set changed 1
continue; # delete the quad
}
}
"bitand" {
lassign $argl x y
set res [list literal [expr {$x & $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"bitnot" {
lassign $argl x
set res [list literal [expr {~$x}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"bitor" {
lassign $argl x y
set res [list literal [expr {$x | $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"bitxor" {
lassign $argl x y
set res [list literal [expr {$x ^ $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"copy" {
lassign $argl res
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"dictExists" {
set argl [lassign $argl d]
if {[llength $argl] == 0} {
set res 0
} else {
set res [dict exists $d {*}[lreverse $argl]]
}
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"dictGet" - "dictGetOrNexist" {
set argl [lassign $argl d]
set res [dict get $d {*}[lreverse $argl]]
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"dictIncr" {
set argl [lassign $argl res]
dict incr res {*}$argl
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"dictSet" - "dictSetOrUnset" {
set argl [lassign $argl d]
dict set d {*}[lreverse $argl]
set res [list literal $d]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"div" {
lassign $argl x y
if {[catch {expr {$x / $y}} res]} {
my diagnostic warning $b $pc \
"expression will divide by zero at run time"
lset bbcontent $b [incr newpc] $q
} else {
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
}
"eq" {
lassign $argl x y
set res [list literal [expr {$x == $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"exists" {
lassign $argl x
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with {literal 1}"
puts " replace $result with {literal 1}"
}
dict unset udchain $result
my replaceUses [lindex $q 1] {literal 1}
my replaceUses $result {literal 1}
set changed 1
continue; # delete the quad
}
"extractArray" {
my debug-constfold {
puts "$b:$pc: examine $q"
}
# What type do I want?
set want $quadcode::dataType::ARRAY
# What type do I have?
set source [lindex $argl 0]
set have [typeOfLiteral $source]
# Can I say sommething definitive?
unset -nocomplain replacement
if {[quadcode::dataType::isa $have $want]} {
set replacement [list literal $source]
} elseif {![quadcode::dataType::mightbea $have $want]} {
# This is dead code, but we don't know it yet
}
if {[info exists replacement]} {
my debug-constfold {
puts "$b:$pc: can replace $result with\
$replacement and remove the instruction"
}
my removeUse $source $b
dict unset udchain $result
my replaceUses $result $replacement
set changed 1
continue; # delete the quad
}
lset newbb [incr newpc] $q; # don't delete the quad
}
"extractScalar" {
my debug-constfold {
puts "$b:$pc: examine $q"
}
# What type do I want?
set want $quadcode::dataType::ARRAY
# What type do I have?
set source [lindex $argl 0]
set have [typeOfLiteral $source]
# Can I say sommething definitive?
unset -nocomplain replacement
if {[quadcode::dataType::isa $have $want]} {
# This is dead code, but we don't know it yet
} elseif {![quadcode::dataType::mightbea $have $want]} {
set replacement [list literal $source]
}
if {[info exists replacement]} {
my debug-constfold {
puts "$b:$pc: can replace $result with\
$replacement and remove the instruction"
}
my removeUse $source $b
dict unset udchain $result
my replaceUses $result $replacement
set changed 1
continue; # delete the quad
}
}
"ge" {
lassign $argl x y
set res [list literal [expr {$x >= $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"gt" {
lassign $argl x y
set res [list literal [expr {$x > $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"initIfNotExists" {
set res [list literal [lindex $argl 0]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"instanceOf" {
my debug-constfold {
puts "$b:$pc: examine $q"
}
# What type do I want?
set want [lindex $q 0 1]
# What type do I have?
set source [lindex $argl 0]
set have [typeOfLiteral $source]
# Can I say sommething definitive?
unset -nocomplain replacement
if {[quadcode::dataType::isa $have $want]} {
set replacement {literal 1}
} else {
set replacement {literal 0}
}
my debug-constfold {
puts "$b:$pc: can replace $result with\
$replacement and remove the instruction"
}
lset bbcontent $b $pc [list nop {}]
my removeUse $source $b
dict unset udchain $result
my replaceUses $result $replacement
set changed 1
continue; # delete the quad
}
"le" {
lassign $argl x y
set res [list literal [expr {$x <= $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"list" {
set res [list literal [list {*}$argl]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
my replaceUses [lindex $q 1] $res
dict unset udchain [lindex $q 1]
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"listAppend" {
set res [lindex $argl 0]
lappend res {*}[lrange $argl 1 end]
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"listConcat" {
set res [list literal [concat {*}$argl]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"listIndex" {
set res [list literal [lindex {*}$argl]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"listLength" {
set res [list literal [llength {*}$argl]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"listRange" {
set res [list literal [lrange {*}$argl]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"lshift" {
lassign $argl x y
set res [list literal [expr {$x << $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"lt" {
lassign $argl x y
set res [list literal [expr {$x < $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"mod" {
lassign $argl x y
if {[catch {expr {$x % $y}} res]} {
my diagnostic warning $b $pc \
"expression will divide by zero at run time"
lset bbcontent $b [incr newpc] $q
} else {
set res [list literal $res]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
}
"mul" {
"mult" {
lassign $argl x y
set res [list literal [expr {$x * $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"narrowToType" {
my debug-constfold {
puts "$b:$pc: examine $q"
}
# What type do I want?
set want [lindex $q 0 1]
# What type do I have?
set source [lindex $argl 0]
set have [typeOfLiteral $source]
# Can I say sommething definitive?
unset -nocomplain replacement
if {[quadcode::dataType::isa $have $want]} {
set replacement [lindex $q 0]
} elseif {![quadcode::dataType::mightbea $have $want]} {
# this is dead code, but we don't know it yet
}
if {[info exists replacement]} {
my debug-constfold {
puts "$b:$pc: can replace $result with\
$replacement and remove the instruction"
}
lset bbcontent $b $pc [list nop {}]
my removeUse $source $b
dict unset udchain $result
my replaceUses $result $replacement
set changed 1
continue; # delete the quad
}
}
"ne" {
lassign $argl x y
set res [list literal [expr {$x != $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"not" {
lassign $argl x
set res [list literal [expr {!$x}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"rshift" {
lassign $argl x y
set res [list literal [expr {$x >> $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"strcat" {
set res [list literal [join $argl ""]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"strrange" {
set res [list literal [string range {*}$argl]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"sub" {
lassign $argl x y
set res [list literal [expr {$x - $y}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"uminus" {
set res [list literal [expr {- [lindex $argl 0]}]]
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with $res"
puts " replace $result with $res"
}
dict unset udchain $result
my replaceUses [lindex $q 1] $res
my replaceUses $result $res
set changed 1
continue; # delete the quad
}
"unset" {
my debug-constfold {
puts "$b:$pc: $q"
puts " replace [lindex $q 1] with Nothing"
puts " replace $result with Nothing"
}
dict unset udchain $result
my replaceUses [lindex $q 1] Nothing
my replaceUses $result Nothing
set changed 1
continue; # delete the quad
}
default {
my debug-constfold {
puts "$b:$pc: $q"
}
my diagnostic debug $b $pc \
|
︙ | | |
Changes to quadcode/copyprop.tcl.
︙ | | |
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
-
-
+
+
+
-
+
-
-
+
+
+
+
-
-
+
+
+
+
+
+
+
+
|
}
# Walk thorough all the instructions, looking for copies
foreach b [my bborder] {
set outpc -1
for {set pc 0} {$pc < [llength [lindex $bbcontent $b]]} {incr pc} {
set q [lindex $bbcontent $b $pc]
if {[lindex $q 0] eq "copy"} {
my debug-copyprop {
puts "$b:$pc: $q"
}
lassign $q - to from
# Is this copy killable?
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
}
# Can a copy to a var from a temp be promoted?
# It may be promoted if the temp is created in the same
# basic block as the copy. Promoting it will cause uses
# of the temp to be replaced by the variable, so we
# will see no further copies from the temp to any
# other var.
} elseif {[lindex $to 0] eq "var"
&& [lindex $from 0] eq "temp"
&& $outpc >= 0
&& [lindex $bbcontent $b $outpc 1] eq $from
if {[lindex $to 0] eq "var"
&& [lindex $from 0] eq "temp"
&& [dict get $udchain $from] == $b} {
&& [lindex $bbcontent $b $outpc 0] ne "phi"
&& [my hasUniqueUse $from]} {
lassign [my findDef $from] - frompc -
# unique use of a temporary copies it to a variable
# immediately following creating it. Peephole optimize
# by coalescing the two quads.
my debug-copyprop {
puts "Peephole-optimize copy:"
puts " $b:$outpc:\
[lindex $bbcontent $b $outpc]"
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 $outpc 1 $to
lset bbcontent $b $frompc 1 $to
my debug-copyprop {
puts " Rewrite $b:$frompc: [lindex $bbcontent $b $frompc]"
}
# the temp is now irrelevant
dict unset duchain $from
dict unset udchain $from
dict set udchain $to $b
# Replace all uses of the temp with uses of the variable
my removeUse $from $b
my replaceUses $from $to
# the temp is now irrelevant
set changed 1
continue; # delete the copy
}
}
lset bbcontent $b [incr outpc] $q
|
︙ | | |
Changes to quadcode/dbginfo.tcl.
︙ | | |
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
-
|
set debugScript {}
}
break
}
}
}
return [list $sourcefile $debugLines $debugScript $debugContext]
}
# quadcode::transformer method propDebugInfo --
#
# Propagates debug information across the quadcode so that
# it is available locally in each basic block rather than
|
︙ | | |
Changes to quadcode/deadcode.tcl.
︙ | | |
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
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
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
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
|
-
+
-
-
-
-
-
-
+
+
-
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
-
-
+
|
}
# uselessphis --
#
# Removes dead phi operations from the basic blocks
#
# Results:
# None.
# Returns 1 if anything was removed, 0 otherwise
#
# Side effects:
# Removes code and rewrites variable references.
#
# Precondition:
# Code should be in SSA form with blocks ordered in depth-first numbering
#
# A phi operation is dead if its inputs are all either the same other
# 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]]"
}
}
}
}
set changed 0
# 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} {
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.
# 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
} else {
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
# 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
# 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]
}
}
# Replace the phi's value with the source value everywhere
my replaceUses $dest $source
# Get rid of the destination variable
dict unset udchain $dest
dict unset duchain $dest
dict unset types $dest
set changed 1
# 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
if {$j < $i} {
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
return $changed
}
# unkillable --
#
# Tests whether a quadcode instruction is unkillable
#
# Parameters:
|
︙ | | |
Changes to quadcode/duchain.tcl.
︙ | | |
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
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
49
50
51
52
53
54
55
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
# run any time after creating the SSA representation. Many quadcode
# transformations update the variables incrementally, using 'addUse',
# 'removeUse' and 'renameUses' to do the job. A few make sufficiently
# violent changes to the control flow that it is more effective simply
# to discard and rebuild the relations.
oo::define quadcode::transformer {
# reset_ud_du_chains --
#
# Resets the ud- and du-chains
#
# Results:
# None.
#
# When a pass such as partial redundancy elimination runs, it
# renames all variables. Rather than unlinking individual variables,
# it simply blows the ud- and du-chains away and starts afresh.
method reset_ud_du_chains {} {
set duchain {}
set udchain {}
}
# ud_du_chain --
#
# Records ud- and du-chains for quadcode in SSA form
#
# Results:
# None.
|
︙ | | |
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
-
+
-
|
method ud_du_chain {} {
my debug-duchain {
puts "before duchain"
my dump-bb
}
set duchain {}
my reset_ud_du_chains
set udchain {}
# Walk through the basic blocks, and the instructions in each block
set b -1
foreach content $bbcontent {
incr b
set pc -1
foreach q $content {
|
︙ | | |
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
|
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 "$name: defined variables are $keys1 s/b $keys2"
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 "$name: $v ud-chain is [dict get $udchain $v] \
s/b [dict get $UDchain $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 "$name: used variables are $keys1 s/b $keys2"
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 "$name: $v du-chain is $chain1 s/b $chain2"
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/heap.tcl.
︙ | | |
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
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
227
228
229
230
231
232
233
234
235
236
237
238
239
240
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
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
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
set xj $xjp1
}
}
# If y is less than the smaller child, then i is a suitable
# place to insert y
if {[$y < $xj]} break
# Place the smaller child at entry i, moving the gap to
# entry j.
lset content $i $xj
set i $j
}
# Reinsert y into the heap, and return z.
lset content $i $y
}
return $z
}
# size --
#
# Determines the length of the queue
#
# Results:
# Returns the queue length
method size {} {
llength $content
}
}
# quadcode::numheap --
#
# Heap object used for managing priority queues of simple numbers
oo::class create ::quadcode::numheap {
# Instance variables:
#
# content - List of objects, organized as a binary heap.
variable content
# Constructor
#
# Heap is initailly empty
constructor {} {
set content {}
}
# add --
#
# Adds an object to the heap.
#
# Parameters:
# y - Object to add
#
# Results:
# None
#
# Side effects:
# Queue content is altered.
method add {y} {
# Add a slot to the end of the worklist
set i [llength $content]
lappend content {}
# Sift up entries in the heap until we find the insertion point
while {$i > 0} {
set j [expr {($i - 1) / 2}]
set xj [lindex $content $j]
if {$xj < $y} break
lset content $i $xj
set i $j
}
# Insert the new item at the insertion point
lset content $i $y
return
}
# empty --
#
# Tests whether the queue is empty
#
# Results:
# Returns 0 if the queue is nonempty, 1 if it is empty
method empty {} {
expr {[my size] == 0}
}
# first --
#
# Inspects the object at the head of the queue
#
# Results:
# Returns the object without altering the queue
# Returns the empty string if the queue is empty
method first {} {
if {[llength $content] == 0} {
return {}
} else {
return [lindex $content 0]
}
}
# removeFirst --
#
# Removes the first object from the queue, and returns it.
#
# Results:
# Returns the removed object. Returns the empty string if the
# queue is empty.
#
# Side effects:
# Queue content is altered.
method removeFirst {} {
if {[llength $content] == 0} {
return {}
}
# Set aside the return value. Let i be the index of the gap in the heap
set z [lindex $content 0]
set i 0
# Remove the last element, y, from the heap
set y [lindex $content end]
set content [lrange $content 0 end-1]
if {[llength $content] > 0} {
# Sift the elements in the heap upward, finding a place
# where y can be reinserted
while {1} {
# Find the smaller of element i's two children
set j [expr {2*$i + 1}]
if {$j >= [llength $content]} break
set xj [lindex $content $j]
set jp1 [expr {$j + 1}]
if {$jp1 < [llength $content]} {
set xjp1 [lindex $content $jp1]
if {$xjp1 < $xj} {
set j $jp1
set xj $xjp1
}
}
# If y is less than the smaller child, then i is a suitable
# place to insert y
if {$y < $xj} break
# Place the smaller child at entry i, moving the gap to
# entry j.
lset content $i $xj
set i $j
}
|
︙ | | |
Changes to quadcode/inline.tcl.
︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
+
+
+
+
|
namespace upvar ::quadcode::dataType FAIL FAIL
my debug-inline {
puts "Before attempting to expand inlines:"
my dump-bb
}
my debug-audit {
my audit-duchain "entry to expandInlines"
my audit-phis "entry to expandInlines"
}
set didSomething 0
# Walk through all quadcodes, looking for 'invoke' of a literal.
# 'bs' is a queue of basic block numbers to analyze. If a block
# has potential calls following an inlined procedure, it will be
# split, and the index of the new block that must be analyzed will
|
︙ | | |
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
|
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
|
+
+
+
+
+
+
+
+
+
|
}
# Ready to inline, let's go!
my diagnostic note $b $pc "Inlining %s into %s" \
[$toInline full-name] [my full-name]
my expandOneInline $b $bb $pc $q $toInline
my debug-audit {
my audit-duchain "after expandOneInline [$toInline full-name]"
my audit-phis "after expandOneInline"
}
set didSomething 1
# FIXME:
# We've just moved the rest of the code out of the basic block, but
# there might be another call in the same bb that this will miss.
# For that reason, this procedure needs refactoring to be able
# to continue with the rewritten continuation of the block.
break
}
}
my debug-audit {
my audit-duchain "exit from expandInlines"
my audit-phis "exit from expandInlines"
}
return $didSomething
}
# quadcode::transformer method expandOneInline --
#
# Expands an inline procedure invocation.
|
︙ | | |
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
-
+
|
lappend bbpred {*}[lrepeat [llength $xbbcontent] {}]
my debug-inline {
puts "inline: [llength $xbbcontent] blocks added with inlined code"
}
# Unlink variables used in the 'invoke'
foreach {- v} [lrange $q 2 end] {
foreach v [lrange $q 2 end] {
if {[lindex $v 0] in {"var" "temp"}} {
my removeUse $v $b
}
}
my debug-inline {
puts "inline: variables in 'invoke' unlinked from du-chains"
}
|
︙ | | |
Added quadcode/loopinv.tcl.