# constjump.tcl --
#
# Code to simplify conditional jumps that depend on values that
# are constant in the predecessor block.
#
# Copyright (c) 2015 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-----------------------------------------------------------------------------
# quadcode::transformer method constJumpPeephole --
#
# Peephole optimization for conditional jumps that depend only on
# constants in earlier blocks.
#
# Preconditions:
# This method must run after critical edges in the flow graph are split,
# but before conversion to SSA form. (It reroutes edges in the flow
# graph in a way that makes SSA structure difficult to preserve.)
#
# Results:
# None.
#
# Side effects:
# Conditional jumps that depend on a constant in the
# immediate predecessor are handled by splitting the node.
#
# Notes:
# This pass is exceedingly likely to leave dead code behind, and
# it is important to clean up after it. It is sensible to defer the
# cleanup until after SSA generation. It is also sensible to wait to
# insert data type and variable existence assertions until after this
# pass has untangled the control flow.
#
# This method is designed to rationalize code that the Tcl bytecode
# compiler generates for && and || operations. Both of these operations
# generate code where there is a basic block containing a single jumpTrue
# or jumpFalse, and predecessor blocks that assign a literal 0 or 1 to the
# condition. This structure gets in the way of type inference, because it
# artificially causes control flows to converge, even though they will
# immediately separate again. A check like
# if {[string is double $x] && $x >= 0.0} { ... }
# will be unable to deduce in the body of the 'if' that $x is double
# without this transformation.
#
# TODO : An equivalent, and perhaps more powerful, transformation would
# be to defer the node splitting until after the code is in SSA
# form, and then test for 'jumpTrue' and 'jumpFalse' operations
# whose conditions depend on a phi that has at least one argument
# being a literal. The phi operations can then be split, at least
# moving the problem. Continued splitting should 'unzip' the code
# path all the way down to the conditional.
oo::define quadcode::transformer method constJumpPeephole {} {
my variable bbcontent
my variable bbpred
my debug-constJumpPeephole {
puts "before node splitting of conditional branches:"
my dump-bb
}
# Search for blocks that end in a conditional jump.
set b -1
foreach content $bbcontent {
incr b
# This optimization applies only to two-exit blocks. Work out
# what are the 'true' and 'false' branches
if {[lindex $content end 0] ne "jump"} continue
switch -exact [lindex $content end-1 0] {
"jumpTrue" {
set trueBranch [lindex $content end-1 1 1]
set falseBranch [lindex $content end 1 1]
}
"jumpFalse" {
set falseBranch [lindex $content end-1 1 1]
set trueBranch [lindex $content end 1 1]
}
default {
# Single-exit blocks are not suitable for this
# transformation
continue
}
}
# Determine whether the jump condition flows in from a
# predecessor block.
set assignedAt {}
set peephole 0
set pc -1
foreach q $content {
incr pc
switch -exact -- [lindex $q 0 0] {
"copy" {
# It's ok if the condition is copied before being tested
set src [lindex $q 2]
set tgt [lindex $q 1]
if {[dict exists $assignedAt $src]} {
set whence [dict get $assignedAt $src]
} else {
set whence $src
lappend whence -1
dict set assignedAt $src $whence
}
dict set assignedAt $tgt $whence
}
"jumpTrue" -
"jumpFalse" {
# Does the jump condition originate before the block?
set src [lindex $q 2]
if {![dict exists $assignedAt $src]} {
set whence $src
lappend whence -1
set peephole 1
} else {
set whence [dict get $assignedAt $src]
if {[lindex $whence 0] in {"temp" "var"}
&& [lindex $whence 2] == -1} {
set peephole 1
}
}
break
}
default {
# Assignment to a variable kills it for this optimization
if {[lindex $q 1 0] in {temp var}} {
set tgt [lindex $q 1]
set newtgt $tgt
lappend newtgt $pc
dict set assignedAt $tgt $newtgt
}
}
}
}
# If we find a condition that flows in from a predecessor, check
# all predecessors to find out if the condition is constant.
if {$peephole} {
set whence [lreplace $whence end end]
dict for {pb -} [lindex $bbpred $b] {
set pc -1
set assignedAt {}
set pbcontent [lindex $bbcontent $pb]
foreach q $pbcontent {
incr pc
switch -exact -- [lindex $q 0 0] {
"copy" {
# Copies of constants still might be constant
set src [lindex $q 2]
set tgt [lindex $q 1]
if {[dict exists $assignedAt $src]} {
set ultsrc [dict get $assignedAt $src]
} else {
set ultsrc $src
lappend ultsrc -1
dict set assignedAt $src $ultsrc
}
dict set assignedAt $tgt $ultsrc
}
default {
# Assignment to a variable from anything but a
# copy kills it for this optimization
if {[lindex $q 1 0] in {temp var}} {
set tgt [lindex $q 1]
set newtgt $tgt
lappend newtgt $pc
dict set assignedAt $tgt $newtgt
}
}
}
}
if {[dict exists $assignedAt $whence]} {
set ultsrc [dict get $assignedAt $whence]
if {[lindex $ultsrc 0] eq "literal"} {
set value [lindex $ultsrc 1]
# If testing the constant raises an error, simply
# leave the tangled code in place.
if {![catch {
if {$value} {
set exit $trueBranch
} else {
set exit $falseBranch
}
}]} {
# Rewrite the predecessor block to avoid the
# confluence.
lset bbcontent $pb {}
set pbcontent \
[lreplace $pbcontent[set pbcontent ""] \
end end \
{*}[lrange $content 0 end-2] \
[list jump [list bb $exit]]]
my removePred $b $pb
my bblink $pb $exit
lset bbcontent $pb $pbcontent
}
}
}
}
}
}
my debug-constJumpPeephole {
puts "after node splitting of conditional branches:"
my dump-bb
}
return
}