# upvar.tcl --
#
# Methods to analyze the effect of [upvar] upon callers of a procedure.
#
# Copyright (c) 2017 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 analyzeUpvar --
#
# Analyzes the effect that [upvar] will have on the callers of the
# procedure being compiled.
#
# Results:
# Returns the procedure's frame effect
#
# Preconditions:
# The quadcode must be in SSA form. The 'callframeMotion' pass must
# have installed the (possibly redundant) 'moveToCallFrame' and
# 'moveFromCallFrame' instructions. Copy propagation must have been
# performed.
#
# Side effects:
# Calls the specializer to set attributes of the current procedure:
#
# reads - List of parameters that contain argument positions
# of input variables passed by name.
# writes - List of parameters that contain argument positions
# of output variables passed by name.
# readsNamed - List of names of input variables passed implicitly
# writesNamed - List of names of output variables passed implicitly
# noCallFrame - Flag if it is permissible to eliminate the caller's
# callframe entirely.
# allCallFrames - Flag if all callers on the stack must have
# callframes (because, for instance, of an
# [upvar] to an unknown stack level).
oo::define quadcode::transformer method analyzeUpvar {} {
my debug-upvar {
puts "Before \[upvar\] analysis:"
my dump-bb
}
# 1. Walk from the entry block, and analyze what variables contain
# the values of passed parameters.
set argPos [my upvarAnalyzeArgs]
# 2. Walk from the entry block, recording the state of [upvar]
# at each instruction that might change it.
set upvarState [my upvarFindAliases $argPos]
# 3. Walk 'moveToCallFrame', 'moveFromCallFrame' and 'invoke' to
# determine the procedure's effect on variables.
set procEffect [my upvarProcEffect $upvarState]
return $procEffect
}
# quadcode::transformer method upvarAnalyzeArgs --
#
# Determines what named variables in SSA-based quadcode are known to
# contain the values of passed parameters (with possible MAYBE and
# NEXIST monads eliminated). (TODO: It may in future also be necessary
# to look for widened or narrowed types.)
#
# Results:
# Returns a dictionary whose keys are SSA value names and whose values
# are the corresponding parameter positions.
oo::define quadcode::transformer method upvarAnalyzeArgs {} {
# Analyze the entry block, looking for 'param' instructions
set worklist {}
set argPos {}
foreach q [lindex $bbcontent 0] {
if {[lindex $q 0] eq "param"} {
set var [lindex $q 1]
set argIdx [expr {[lindex $q 2 1] + 1}]
my debug-upvar {
puts "[lindex $q 1] is argument \#$argIdx]"
}
dict set argPos $var $argIdx
my addUsesToUpvarWorklist worklist $var
}
}
# Propagate the identity of the parameters through copies, extracts,
# and type narrowing.
while {[llength $worklist] > 0} {
set worklist [lassign $worklist b]
foreach q [lindex $bbcontent $b] {
switch -exact [lindex $q 0 0] {
copy -
extractExists -
extractMaybe -
narrowToType -
purify -
widenTo {
set var [lindex $q 1]
set invar [lindex $q 2]
if {![dict exists $argPos $var]
&& [dict exists $argPos $invar]} {
set argIdx [dict get $argPos $invar]
my debug-upvar {
puts " $var also refers to arg $argIdx"
}
dict set argPos $var [dict get $argPos $invar]
my addUsesToUpvarWorklist worklist $var
}
}
}
}
}
return $argPos
}
# quadcode::transformer method upvarFindAliases --
#
# Determines what variables in a procedure's callframe may alias
# what variables in the caller's frame.
#
# Parameters:
#
# argPos -
# Dictionary whose keys are the names of quadcode variables and
# whose values are positions in the argument list. The values
# in question are known always to contain the values of
# passed parameters; therefore, if they appear on 'upvar', they
# are variables passed by name
#
#
# Results:
#
# Returns a two-element list.
#
# The first element indicates whether all alias effects could be
# computed. If it is zero, the second element is a dictionary described
# below. If it is 1, there is at least one
# Returns a dictionary whose keys are the names
# of quadcode variables that contain callframes. Each value in the
# dictionary is a second-level dictionary whose keys are the names
# of variables in the callframe and whose values are chosen from
# among:
#
# {arg N} - The variable name is the Nth parameter of the
# current procedure (pass-by-name}
# {named N} - The variable name is constant (named variable
# in the caller's frame).
# {unknown} - The variable name is unknown, but is known
# at least to be in the caller's callframe, rather
# farther out on the stack. (The implication
# of {unknown} is that the variable may potentially
# alias any variable in the caller's frame.)
# {global} - The variable is known to be in global or
# namespace scope, not in the callframe.
# {nonlocal} - The variable may be in the callframe of an
# outer caller, so calling this procedure might
# have nonlocal effects.
#
# Operations that change the aliasing status of one or more variables:
# callFrameNop
# extractCallFrame
# moveToCallFrame
# Do noting about aliasing, simply copy the aliasing information from
# the source callframe to the destination callframe.
# entry -
# On entry, no variable is an alias
# invoke -
# Adjust aliasing according to what the invoked command does.
# nsupvar
# Indicate that the designated variable is global. (If the target
# variable name is nonconstant, error out).
# phi
# Set the aliases in the result callframe to the union of the aliases
# in the input callframes
# upvar
# Indicate that the designated variable is an arg, a name, or an unknown
# ref (Only cases handled are upvar 1 and upvar #0)
# variable
# Indicate that the designated variable is global. (If the name is
# nonconstant, error out
oo::define quadcode::transformer method upvarFindAliases {argPos} {
# Trace data flows from the entry block.
set firstq [lindex $bbcontent 0 0]
if {[lindex $firstq 0] ne "entry" || [lindex $firstq 1] eq {}} {
# The procedure does not use the callframe
return {}
}
set worklist {}
set entryFrame [lindex $firstq 1]
dict set aliasInfo $entryFrame {}
my addUsesToUpvarWorklist worklist $entryFrame
# While there's analysis to be done, do it.
while {[llength $worklist] > 0} {
# Find the next basic block to analyze and walk its instructions,
# unpacking opcode, result, and input callframe from each one.
set worklist [lassign $worklist b]
set bb [lindex $bbcontent $b]
set pc -1
foreach q $bb {
incr pc
lassign $q opcode result arg1 arg2
# resFrame, if set is the alias info for the new quad.
unset -nocomplain resFrame
# Analyze individual quads
switch -exact -- [lindex $opcode 0] {
callFrameNop -
extractCallFrame -
invoke {
# These instructions do not change aliases, so copy
# the input frame to the result frame.
if {![dict exists $aliasInfo $arg1]} {
set resFrame {}
} else {
set resFrame [dict get $aliasInfo $arg1]
}
}
moveToCallFrame {
# If the variable isn't already upvar or global,
# this instruction will make it local.
if {![dict exists $aliasInfo $arg1]} {
set resFrame {}
} else {
set resFrame [dict get $aliasInfo $arg1]
}
if {[lindex $arg2 0] ne "literal"} {
return 1; # Local variable name not constant
}
foreach {localVar source} [lrange $q 3 end] {
if {[lindex $localVar 0] ne "literal"} {
error "cannot handle double-dereference"
}
set localVarName [lindex $localVar 1]
if {![dict exists $resFrame $localVarName]} {
dict set resFrame $localVarName local
}
}
}
nsupvar - variable {
# These instructions always make the local variable
# alias a namespace variable
if {![dict exists $aliasInfo $arg1]} {
set resFrame {}
} else {
set resFrame [dict get $aliasInfo $arg1]
}
if {[lindex $arg2 0] ne "literal"} {
return 1; # Local variable name not constant"
}
set localVar [lindex $arg2 1]
if {[dict exists $resFrame $localVar]
&& [dict get $resFrame $localVar] eq "local"} {
# TODO - How to report static errors?
error "$localVar is already defined"
}
dict set resFrame $localVar global
}
phi {
set isCallframe 0
if {![dict exists $aliasInfo $arg2]} {
set resFrame {}
} else {
set isCallframe 1
set resFrame [dict get $aliasInfo $arg2]
}
foreach {- arg} [lrange $q 4 end] {
if {[dict exists $aliasInfo $arg]} {
set isCallframe 1
set resFrame [my upvarPhi $resFrame \
[dict get $aliasInfo $arg]]
}
}
if {!$isCallframe} {
unset resFrame
}
}
upvar {
if {![dict exists $aliasInfo $arg1]} {
set resFrame {}
} else {
set resFrame [dict get $aliasInfo $arg1]
}
if {[lindex $arg2 0] ne "literal"} {
return 1; # Local variable name not constant"
}
set localVar [lindex $arg2 1]
set level [lindex $q 4]
set remoteName [lindex $q 5]
if {[lindex $remoteName 0] eq "literal"
&& [string first :: [lindex $remoteName 1]] >= 0} {
set status "global"
} elseif {[lindex $level 0] ne "literal"} {
set status "nonlocal"
} elseif {[lindex $level 1] eq "1"} {
if {[lindex $remoteName 0] eq "literal"} {
set status [list "named" [lindex $remoteName 1]]
} elseif {[dict exists $argPos $remoteName]} {
set status \
[list "arg" [dict get $argPos $remoteName]]
} else {
set status "unknown"
}
} elseif {[lindex $level 1] eq "#0"} {
set status "global"
} else {
set status "nonlocal"
}
if {[dict exists $resFrame $localVar]
&& [dict get $resFrame $localVar] eq "local"} {
# TODO - How to report static errors?
error "$localVar is already defined"
}
dict set resFrame $localVar $status
}
}
# If the state of the callframe at this point has changed,
# add the dependencies
if {[info exists resFrame]} {
set resFrame [lsort -ascii -increasing -index 0 -stride 2 \
$resFrame]
if {![dict exists $aliasInfo $result]
|| $resFrame ne [dict get $aliasInfo $result]} {
my debug-upvar {
puts "$b:$pc: $q"
puts " -> $resFrame"
}
dict set aliasInfo $result $resFrame
my addUsesToUpvarWorklist worklist $result
}
}
}
}
return $aliasInfo
}
# quadcode::transformer method upvarPhi --
#
# Combines the aliasing information when callframes arrive at a phi.
#
# Parameters:
# f1 - First callframe's alias information
# f2 - Second callframe's variable
#
# Results:
# Returns a conservative estimate of the alias information after
# the phi.
oo::define quadcode::transformer method upvarPhi {f1 f2} {
# Walk the first dictionary and promote the values to the second
# dictionary's alias type if necessary.
dict for {v a} $f1 {
if {[dict exists $f2 $v]} {
set b [dict get $f2 $v]
if {$a ne $b} {
if {$b eq "nonlocal"} {
dict set f1 $v $b
} elseif {$a eq "nonlocal"} {
} elseif {$b eq "unknown"} {
dict set f1 $v $b
} elseif {$a eq "unknown"} {
} elseif {$a eq "local"} {
dict set v1 $v $b
} elseif {$b eq "local"} {
} else {
# mismatched combination of named and arg
dict set v1 $v "unknown"
}
}
dict unset f2 $v
}
}
return [dict merge $f1 $f2]
}
# quadcode::transformer method upvarProcEffect --
#
# Determines the effect of a procedure on the outer callframes of
# the stack.
#
# Parameters:
# state - Dictionaries whose keys are the names of quadcode variables
# that designate callframes, and whose values are the possible
# aliases of the variables in outer frames.
#
# Results:
# Returns a dictionary that characterizes the code's effect.
oo::define quadcode::transformer method upvarProcEffect {aliasInfo} {
# All of the information should be in place to allow us simply to
# accumulate the effect of 'moveToCallFrame', 'moveFromCallFrame',
# and invoked commands.
set result [dict create \
killable Inf noCallFrame {} pure {} \
reads {} writes {} \
readsNamed {} writesNamed {} \
readsAny 0 writesAny 0 \
readsNonLocal 0 writesNonLocal 0]
# Walk through the quadcode, analyzing instructions that get/set
# values in the callframe for their effects on potential aliases.
set b -1
foreach bb $bbcontent {
incr b
set pc -1
foreach q $bb {
incr pc
set did 0
switch -exact -- [lindex $q 0] {
"moveFromCallFrame" {
set did 1
lassign $q opcode qcvar callframe cfvar
if {[lindex $cfvar 0] ne "literal"} {
error "Cannot handle double-dereference"
} else {
set cfvar [lindex $cfvar 1]
}
if {[dict exists $aliasInfo $callframe $cfvar]} {
my upvarRecordRead result \
[dict get $aliasInfo $callframe $cfvar]
# must do: dict unset result pure
}
}
"moveToCallFrame" {
set did 1
set vs [lassign $q opcode cfout cfin]
foreach {cfvar qcvar} $vs {
if {[lindex $cfvar 0] ne "literal"} {
error "Cannot handle double-dereference"
} else {
set cfvar [lindex $cfvar 1]
}
if {[dict exists $aliasInfo $cfout $cfvar]} {
my upvarRecordWrite result \
[dict get $aliasInfo $cfout $cfvar]
# must do: dict unset result pure;
# must do: dict unset result killable;
}
}
}
"invoke" {
set did 1
set argList [lassign $q opcode cfout cfin cmdName]
set typeList [lmap arg $argList {typeOfOperand $types $arg}]
set attrs [$specializer frameEffect $q $typeList]
my upvarInvoke result $aliasInfo $attrs $q $typeList
}
}
my debug-upvar {
if {$did} {
puts "$b:$pc: $q"
puts " effect changed to $result"
}
}
}
}
my debug-upvar {
puts "Before rewrites: stack effect: $result"
}
if {[dict get $result readsAny]} {
dict set result reads 0
} else {
dict set result reads [dict keys [dict get $result reads]]
}
dict unset result readsAny
if {[dict get $result writesAny]} {
dict set result writes 0
} else {
dict set result writes [dict keys [dict get $result writes]]
}
dict unset result writesAny
if {[llength [dict get $result reads]] == 0} {
dict unset result reads
}
if {[llength [dict get $result writes]] == 0} {
dict unset result writes
}
if {[dict size [dict get $result readsNamed]] == 0} {
dict unset result readsNamed
} else {
dict set result readsNamed [dict keys [dict get $result readsNamed]]
}
if {[dict size [dict get $result writesNamed]] == 0} {
dict unset result writesNamed
} else {
dict set result writesNamed [dict keys [dict get $result writesNamed]]
}
if {![dict get $result readsNonLocal]} {
dict unset result readsNonLocal
}
if {![dict get $result writesNonLocal]} {
dict unset result writesNonLocal
}
if {[dict exists $result reads]
|| [dict exists $result readsAny]
|| [dict exists $result readsNonLocal]} {
dict unset result pure
dict unset result noCallFrame
}
if {[dict exists $result writes]
|| [dict exists $result writesAny]
|| [dict exists $result writesNonLocal]} {
dict unset result pure
dict unset result noCallFrame
dict unset result killable
}
my debug-upvar {
puts "Stack effect calculated to be: $result"
}
return $result
}
# quadcode::transformer method upvarInvoke --
#
# Compute the callframe effect of an invoked command.
#
# Parameters:
# resultV - Name of a variable in caller's scope containing the
# callframe effect of the current command
# aliasInfo - Dictionary that identifies what callframe variables have
# aliases in the caller
# effect - Callframe effect of the invoked command.
# q - 'invoke' instruction being processed
# typeList - Types of the arguments to $q
#
# Results:
# None.
#
# Side effects:
# Records the effect of the 'invoke' on the current callframe.
oo::define quadcode::transformer method upvarInvoke {resultV aliasInfo
effect q typeList} {
upvar 1 $resultV result
# Record purity
if {![dict exists $effect pure]} {
dict unset result pure
}
# Record nonlocal effects
if {[dict exists $effect readsNonLocal]} {
dict set result readsNonLocal 1
}
if {[dict exists $effect writesNonLocal]} {
dict set result writesNonLocal 1
}
# Defer to specializer for produced and consumed variables
lassign [my variablesUsedBy $q $typeList] status varlist
if {$status} {
foreach v $varlist {
if {[dict exists $aliasInfo $v]} {
my recordRead [dict get $aliasInfo $v]
}
}
} else {
dict set result reads {0 {}}
}
lassign [my variablesProducedBy $q $typeList] status varlist
if {$status} {
foreach v $varlist {
if {[dict exists $aliasInfo $v]} {
my recordWrite [dict get $aliasInfo $v]
}
}
} else {
dict set result writes {0 {}}
}
}
oo::define quadcode::transformer method upvarRecordRead {resultV alias} {
upvar 1 $resultV result
if {$alias ni {"local" "global"}} {
dict unset result killable
dict unset result noCallFrame
}
my upvarRecordAction result $alias reads
}
oo::define quadcode::transformer method upvarRecordWrite {resultV alias} {
upvar 1 $resultV result
if {$alias ne "local"} {
dict unset result pure
dict unset result killable
dict unset result noCallFrame
}
my upvarRecordAction result $alias writes
}
oo::define quadcode::transformer method upvarRecordAction {resultV alias act} {
upvar 1 $resultV result
switch -exact -- [lindex $alias 0] {
"arg" {
dict set result $act [lindex $alias 1] {}
}
"global" {
dict set result ${act}Global {}
}
"local" {
}
"named" {
dict set result ${act}Named [lindex $alias 1] {}
}
"nonlocal" {
dict set result ${act}NonLocal {}
}
"unknown" {
dict set result $act {0 {}}
}
default {
error "TODO - Handle alias type $alias"
}
}
}
oo::define quadcode::transformer method addUsesToUpvarWorklist {worklistVar v} {
upvar 1 $worklistVar worklist
if {[dict exists $duchain $v]} {
dict for {use -} [dict get $duchain $v] {
my addToUpvarWorklist worklist $use
}
}
}
oo::define quadcode::transformer method addToUpvarWorklist {worklistVar item} {
upvar 1 $worklistVar worklist
set idx [lsearch -sorted -integer -increasing -bisect $worklist $item]
if {[lindex $worklist $idx] != $item} {
set worklist [linsert $worklist[set worklist {}] [expr {$idx+1}] $item]
}
}