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

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

Overview
Comment:Reform the processing of 'phi' operations in 'codegen/compile.tcl', observing that variable definitions dominate all uses of the variables except for those in 'phi' operations, so creating dummy phi's and backpatching the data sources is a simpler approach than creating explict 'undef' values only to overwrite them.
Timelines: family | ancestors | descendants | both | kbk-phi-reform
Files: files | file ages | folders
SHA3-256: f4b8bc60e532a2db9c3db499a58b92a5cc1bf0d27cc06dd0a8f0c330c48804e0
User & Date: kbk 2018-04-15 21:49:56
Context
2018-04-16
04:17
More purges of uniqueUndef check-in: c9c75024dc user: kbk tags: kbk-phi-reform
2018-04-15
21:52
Merge kbk-phi-reform. The code issuer no longer creates dummy 'undef' slots for variables only to replace them. Instead, 'phi' operations are created without data sources and have their data sources added after processing the quadcode. check-in: 3578806182 user: kbk tags: trunk
21:49
Reform the processing of 'phi' operations in 'codegen/compile.tcl', observing that variable definitions dominate all uses of the variables except for those in 'phi' operations, so creating dummy phi's and backpatching the data sources is a simpler approach than creating explict 'undef' values only to overwrite them. check-in: f4b8bc60e5 user: kbk tags: kbk-phi-reform
19:12
Remove one llvm.lifetime call that is incompatible with LLVM5 check-in: d3b289185c user: kbk tags: kbk-phi-reform
Changes

Changes to codegen/build.tcl.

4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258

4259
4260
4261
4262
4263
4264
4265
4266
    #
    # Parameters:
    #	code -	The Tcl return code, as an INT.
    #	errVar -
    #		Where the actual result code is to be written to.
    #
    # Results:
    #	None.

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

	return
    }

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






|


|
>
|







4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
    #
    # Parameters:
    #	code -	The Tcl return code, as an INT.
    #	errVar -
    #		Where the actual result code is to be written to.
    #
    # Results:
    #	Returns an LLVM int32 value ref containng the code

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

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

Changes to codegen/compile.tcl.

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
...
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
...
569
570
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585
...
789
790
791
792
793
794
795
796
797
798

799
800


801
802
803
804
805
806
807
...
957
958
959
960
961
962
963












964
965
966
967
968
969
970
....
1960
1961
1962
1963
1964
1965
1966




1967
1968
1969


1970
1971





1972
1973
1974

1975

1976
1977
1978
1979
1980

1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
	$b @location 0
	set errorCode [$b alloc int "tcl.errorCode"]
	set curr_block $block(-1)
	set 0 [$b int 0]

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

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

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

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

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

	##############################################################
	#
	# Convert Tcl parse output, one instruction at a time.
	#

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

	set theframe {}
	set thevarmap {}
	set syntheticargs {}
	set currentline 0
	set currentprocrelline 0
	set currentscript {}
	foreach l $quads {
................................................................................
			[$b $opcode [my LoadOrLiteral $src] \
			     [$b load $errorCode] $name]
		}
		"initException" {
		    my IssueException $l
		}
		"setReturnCode" {
		    lassign $l opcode - src
		    append opcode ( [my ValueTypes $src] )

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

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


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













	##############################################################
	#
	# Set increment paths, so that where we have a basic block that just
	# falls through to its successor (not permitted in LLVM IR) we convert
	# it to an explicit jump.
	#
................................................................................
    #		with debugging intrinsics (unlike with other result-producing
    #		operations).
    #
    # Results:
    #	None.

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




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


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





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

		    $desc [PrintValueToString $value]

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

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

    # TclCompiler:AnnotateAssignment --
    #
    #	Annotate an assignment to a named Tcl variable with debug metadata






|
<
<







 







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









>







 







|

>
|







 







|

|
>
|

>
>







 







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







 







>
>
>
>
|
|

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

<
<
>
|




<
<
<
<
<
<
|
<
<







248
249
250
251
252
253
254
255


256
257
258
259
260
261
262
...
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
...
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
...
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
...
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
....
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972

1973
1974
1975
1976
1977
1978


1979
1980
1981
1982
1983
1984


1985
1986
1987
1988
1989
1990






1991


1992
1993
1994
1995
1996
1997
1998
	$b @location 0
	set errorCode [$b alloc int "tcl.errorCode"]
	set curr_block $block(-1)
	set 0 [$b int 0]

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



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

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




















	##############################################################
	#
	# Convert Tcl parse output, one instruction at a time.
	#

	set pc -1
	set ERROR_TEMPLATE "\n    (compiling \"%s\" @ pc %d: %s)"
	set phiAnnotations {}
	set phiPending {}
	set theframe {}
	set thevarmap {}
	set syntheticargs {}
	set currentline 0
	set currentprocrelline 0
	set currentscript {}
	foreach l $quads {
................................................................................
			[$b $opcode [my LoadOrLiteral $src] \
			     [$b load $errorCode] $name]
		}
		"initException" {
		    my IssueException $l
		}
		"setReturnCode" {
		    lassign $l opcode tgt src
		    append opcode ( [my ValueTypes $src] )
		    my StoreResult $tgt \
			[$b $opcode [my LoadOrLiteral $src] $errorCode]
		}
		"procLeave" {
		    set srcs [lassign $l opcode tgt]
		    set name [my LocalVarName $tgt]
		    append opcode ( [my ValueTypes {*}$srcs] )
		    set srcs [lmap s $srcs {my LoadOrLiteral $s}]
		    my StoreResult $tgt [$b $opcode {*}$srcs $errorCode $name]
................................................................................
			set s $block($spc)
			if {$s ni [dict get $pred $curr_block]} {
			    my Warn "%s not predecessor to %s in %s; skipping..." \
				[$s name] [$curr_block name] $cmd
			    continue
			}
			lappend sources $s
			lappend values $var
		    }
		    set name [my LocalVarName $tgt]
		    set type [Type [nameOfType [dict get $vtypes $tgt]]]
		    set value [$b phiStub $type $name]
		    my StoreResult $tgt $value "phi"
		    lappend phiPending $value $sources $values

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

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

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

	##############################################################
	#
	# Set increment paths, so that where we have a basic block that just
	# falls through to its successor (not permitted in LLVM IR) we convert
	# it to an explicit jump.
	#
................................................................................
    #		with debugging intrinsics (unlike with other result-producing
    #		operations).
    #
    # Results:
    #	None.

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

	upvar 1 phiAnnotations phiAnnotations

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

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

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

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


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

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


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









	set variables($desc) $value
	return
    }

    # TclCompiler:AnnotateAssignment --
    #
    #	Annotate an assignment to a named Tcl variable with debug metadata

Changes to codegen/llvmbuilder.tcl.

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











































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

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












































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

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






|







 







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







 







|







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

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

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

Changes to quadcode/constfold.tcl.

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
...
343
344
345
346
347
348
349









350
351
352
353
354
355
356
		    "directArraySet" - "directArrayUnset" - "directExists" -
		    "directGet" - "directLappend" - "directLappendList" -
		    "directSet" - "directUnset" - "directIsArray" -
		    "directMakeArray" - "foreachStart" - "entry" -
		    "extractExists" - "extractFail" -
		    "extractMaybe" - "initException" -
		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" - "purify" -
		    "split" - "unset" - "unshareList" -
		    "initArray" - "setReturnCode" - "resolveCmd" - "originCmd" {
			# do nothing - these insns are not killable
			# this case goes away once I have a better handle
			# on what's killable.
			# Note that the "direct..." operations are probably
			# never killable due to the potential for global
			# effects (because of traces).
................................................................................
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace [lindex $q 1] with $res"
			}
			my replaceUses [lindex $q 1] $res
			set changed 1
		    }










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






|







 







>
>
>
>
>
>
>
>
>







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
...
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
		    "directArraySet" - "directArrayUnset" - "directExists" -
		    "directGet" - "directLappend" - "directLappendList" -
		    "directSet" - "directUnset" - "directIsArray" -
		    "directMakeArray" - "foreachStart" - "entry" -
		    "extractExists" - "extractFail" -
		    "extractMaybe" - "initException" -
		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" - "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).
................................................................................
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace [lindex $q 1] with $res"
			}
			my replaceUses [lindex $q 1] $res
			set changed 1
		    }

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

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