Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Merge trunk: expunge last uses of 'uniqueUndef' in constructing phi's |
|---|---|
| Timelines: | family | ancestors | descendants | both | notworking | kbk-nre |
| Files: | files | file ages | folders |
| SHA3-256: |
1855f5dc7a0840f77943c5952cadcdc8 |
| User & Date: | kbk 2018-04-17 00:11:41 |
Context
|
2018-04-17
| ||
| 21:53 | Added debugging types for NRE callbacks. check-in: 11236a5639 user: dkf tags: notworking, kbk-nre | |
| 00:11 | Merge trunk: expunge last uses of 'uniqueUndef' in constructing phi's check-in: 1855f5dc7a user: kbk tags: notworking, kbk-nre | |
| 00:09 | Finish expunging the uses of 'uniqueUndef' in constructing phis. check-in: f71cdfbdae user: kbk tags: trunk | |
|
2018-04-16
| ||
| 23:46 | Dump bitcode to files after module verification, to try to debug optimizer crashes. Commit missing changes to the debug helper for better phi handling. check-in: 504ceb334b user: kbk tags: notworking, kbk-nre | |
Changes
Changes to codegen/build.tcl.
7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 |
# Results:
# A NUMERIC LLVM value reference.
method uminus(NUMERIC) {value {name ""}} {
my call ${tcl.neg.numeric} [list $value] $name
}
# Builder:uniqueUndef --
#
# Create a unique undefined value. This is designed so that it can be
# replaced later on when fixing up a loop's back-references at a phi
# node.
#
# Parameters:
# type - Type (LLVM or name) of undef to create.
# name (optional) -
# The name of the result value.
#
# Results:
# LLVM undef value that is guaranteed distinct from all others.
method uniqueUndef {type {name ""}} {
set type [Type $type]
set n2 $name
if {$n2 ne ""} {
set n2 &$n2
}
my load [my alloc $type $n2] $name
}
# Builder:unshare(STRING) --
#
# Generate a writable buffer by "unsharing" a STRING. This examines the
# reference counts and applies Tcl_DuplicateObj if required; the result
# *may* be the original value.
#
# Parameters:
|
< < < < < < < < < < < < < < < < < < < < < < < |
7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 |
# Results:
# A NUMERIC LLVM value reference.
method uminus(NUMERIC) {value {name ""}} {
my call ${tcl.neg.numeric} [list $value] $name
}
# Builder:unshare(STRING) --
#
# Generate a writable buffer by "unsharing" a STRING. This examines the
# reference counts and applies Tcl_DuplicateObj if required; the result
# *may* be the original value.
#
# Parameters:
|
Changes to codegen/mathlib.tcl.
931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 |
params x y
set 0 [Const 0 int64]
set 1 [Const 1 int64]
build {
set r0 [my int 1 "result.enter"]
set n0 [my getInt64 $y "n.enter"]
# These are stand-ins for values that we've not generated yet
set nLoop [my uniqueUndef int64 "n"]
set xLoop [my uniqueUndef INT "x"]
set rLoop [my uniqueUndef INT "r"]
my br $loop(test)
label loop(test) "loop.test"
set sources [list $entry $loop(double)]
set thisn [my phi [list $n0 $nLoop] $sources "n.test"]
set x [my phi [list $x $xLoop] $sources "x.test"]
set result [my phi [list $r0 $rLoop] $sources "result.test"]
my condBr [my neq $thisn $0] $loop(bit0) $loop(result)
label loop(result) "result"
my ret $result
label loop(bit0) "loop.bit0"
my condBr [my cmpInt [my and $thisn $1] NE $0] \
$loop(mult) $loop(double)
label loop(mult) "loop.mult"
set multresult [my mult(INT,INT) $x $result "result.mult"]
set thisn2 [my sub $thisn $1 "n.mult"]
my br $loop(double)
label loop(double) "loop.double"
set sources [list $loop(bit0) $loop(mult)]
set thisn [my phi [list $thisn $thisn2] $sources "n.double"]
set result [my phi [list $result $multresult] $sources \
"result.double"]
ReplaceAllUsesWith $rLoop $result
ReplaceAllUsesWith $xLoop [my mult(INT,INT) $x $x "x.double"]
ReplaceAllUsesWith $nLoop [my rshift $thisn $1 "n.double"]
my br $loop(test)
}
##### Function tcl.ipow32 #####
#
# Type signature: x:INT * y:INT -> INT
#
|
< < < | < < < > > > | | | | |
931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 |
params x y
set 0 [Const 0 int64]
set 1 [Const 1 int64]
build {
set r0 [my int 1 "result.enter"]
set n0 [my getInt64 $y "n.enter"]
# These are stand-ins for values that we've not generated yet
my br $loop(test)
label loop(test) "loop.test"
set sources {$entry $loop(double)}
set thisn [PHI [Type int64] {$n0 $nLoop} $sources "n.test"]
set xbody [PHI [Type INT] {$x $xLoop} $sources "x.test"]
set result [PHI [Type INT] {$r0 $rLoop} $sources "result.test"]
my condBr [my neq $thisn $0] $loop(bit0) $loop(result)
label loop(result) "result"
my ret $result
label loop(bit0) "loop.bit0"
my condBr [my cmpInt [my and $thisn $1] NE $0] \
$loop(mult) $loop(double)
label loop(mult) "loop.mult"
set multresult [my mult(INT,INT) $xbody $result "result.mult"]
set thisn2 [my sub $thisn $1 "n.mult"]
my br $loop(double)
label loop(double) "loop.double"
set sources [list $loop(bit0) $loop(mult)]
set thisn [my phi [list $thisn $thisn2] $sources "n.double"]
set result [my phi [list $result $multresult] $sources \
"result.double"]
set rLoop $result
set xLoop [my mult(INT,INT) $xbody $xbody "x.double"]
set nLoop [my rshift $thisn $1 "n.double"]
my br $loop(test)
}
##### Function tcl.ipow32 #####
#
# Type signature: x:INT * y:INT -> INT
#
|
Changes to codegen/stdlib.tcl.
982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 .... 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 .... 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 .... 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 .... 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 .... 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 .... 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 .... 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 |
# trimmed are in the string 'trim' (length 'numTrim'). Works on UTF-8.
set f [$m local "tcl.impl.trimleft" int<-char*,int,char*,int readonly]
params bytes numBytes trim numTrim
build {
nonnull $bytes $trim
set chVar [my alloc int16]
set pLoop [my uniqueUndef char* "p"]
set nbLoop [my uniqueUndef int "nb"]
my condBr [my eq $numBytes $0] $ret0 $checkTrim
label checkTrim:
my condBr [my eq $numTrim $0] $ret0 $outerLoop
label ret0:
my ret $0
label outerLoop:
set sources [list $checkTrim $nextOuter]
set p [my phi [list $bytes $pLoop] $sources "p"]
set numBytes [my phi [list $numBytes $nbLoop] $sources "numBytes"]
set pInc [$api Tcl_UtfToUniChar $p $chVar]
SetValueName $pInc "pInc"
set ch1 [my load $chVar "ch1"]
set qLoop [my uniqueUndef char* "q"]
set blLoop [my uniqueUndef int "bl"]
my br $innerLoop
label innerLoop:
set sources [list $outerLoop $nextInner]
set q [my phi [list $trim $qLoop] $sources "q"]
set bytesLeft [my phi [list $numTrim $blLoop] $sources "bytesLeft"]
set qInc [$api Tcl_UtfToUniChar $q $chVar]
SetValueName $qInc "qInc"
set ch2 [my load $chVar "ch2"]
my condBr [my eq $ch1 $ch2] $doneInner $nextInner
label nextInner:
ReplaceAllUsesWith $qLoop [my getelementptr $q [list $qInc] "q"]
ReplaceAllUsesWith $blLoop \
[set bytesLeft2 [my sub $bytesLeft $qInc "bytesLeft"]]
my condBr [my gt $bytesLeft2 $0] $innerLoop $doneInner
label doneInner:
set sources [list $innerLoop $nextInner]
set bytesLeft [my phi [list $bytesLeft $bytesLeft2] $sources "bytesLeft"]
my condBr [my le $bytesLeft $0] $doneOuter $nextOuter
label nextOuter:
ReplaceAllUsesWith $pLoop \
[set p2 [my getelementptr $p [list $pInc] "p"]]
ReplaceAllUsesWith $nbLoop \
[set numBytes [my sub $numBytes $pInc "numBytes"]]
my condBr [my gt $numBytes $0] $outerLoop $doneOuter
label doneOuter:
set p [my phi [list $p $p2] [list $doneInner $nextOuter] "p"]
my ret [my cast(int) [my diff $p $bytes]]
}
##### Function tcl.impl.trimright #####
# Replacement for non-exposed TclTrimRight
................................................................................
# in the string 'trim' (length 'numTrim'). Works on UTF-8.
set f [$m local "tcl.impl.trimright" int<-char*,int,char*,int readonly]
params bytes numBytes trim numTrim
build {
nonnull $bytes $trim
set chVar [my alloc int16]
set pLoop [my uniqueUndef char* "p"]
set nbLoop [my uniqueUndef int "nb"]
set p [my getelementptr $bytes [list $numBytes] "p"]
my condBr [my eq $numBytes $0] $ret0 $checkTrim
label checkTrim:
my condBr [my eq $numTrim $0] $ret0 $outerLoop
label ret0:
my ret $0
label outerLoop:
set sources [list $checkTrim $nextOuter]
set p [my phi [list $p $pLoop] $sources "p"]
set numBytes [my phi [list $numBytes $nbLoop] $sources "numBytes"]
set p [$api Tcl_UtfPrev $p $bytes]
SetValueName $p "p"
set pInc [$api Tcl_UtfToUniChar $p $chVar]
SetValueName $pInc "pInc"
set ch1 [my load $chVar "ch1"]
set qLoop [my uniqueUndef char* "q"]
set blLoop [my uniqueUndef int "bl"]
my br $innerLoop
label innerLoop:
set sources [list $outerLoop $nextInner]
set q [my phi [list $trim $qLoop] $sources "q"]
set bytesLeft [my phi [list $numTrim $blLoop] $sources "bytesLeft"]
set qInc [$api Tcl_UtfToUniChar $q $chVar]
SetValueName $qInc "qInc"
set ch2 [my load $chVar "ch2"]
my condBr [my eq $ch1 $ch2] $doneInner $nextInner
label doneInner:
my condBr [my le $bytesLeft $0] $fixP $nextOuter
label nextInner:
ReplaceAllUsesWith $qLoop [my getelementptr $q [list $qInc] "q"]
ReplaceAllUsesWith $blLoop \
[set bytesLeft [my sub $bytesLeft $qInc "bytesLeft"]]
my condBr [my gt $bytesLeft $0] $innerLoop $fixP
label nextOuter:
ReplaceAllUsesWith $pLoop $p
ReplaceAllUsesWith $nbLoop $numBytes
my condBr [my gt $p $bytes] $outerLoop $doneOuter
label fixP:
set p0 [my phi [list $p $p] [list $doneInner $nextInner] "p"]
set p2 [my getelementptr $p0 [list $pInc] "p"]
my br $doneOuter
label doneOuter:
set p [my phi [list $p $p2] [list $nextOuter $fixP] "p"]
my ret [my sub $numBytes [my cast(int) [my diff $p $bytes]]]
}
##### Function tcl.impl.isAscii #####
# Replacement for non-exposed UniCharIsAscii
#
# Type signature: ch:int16 -> int1
#
................................................................................
# character class given by 'class' (enumeration encoded as int32).
set f [$m local "tcl.strclass" ZEROONE<-STRING,int]
params objPtr class
build {
nonnull $objPtr
lassign [my GetUnicode $objPtr obj] length string
set p0 [my uniqueUndef int16* "p"]
set p1 [my uniqueUndef int16* "p"]
set p2 [my uniqueUndef int16* "p"]
set p3 [my uniqueUndef int16* "p"]
set p4 [my uniqueUndef int16* "p"]
set p5 [my uniqueUndef int16* "p"]
set p6 [my uniqueUndef int16* "p"]
set p7 [my uniqueUndef int16* "p"]
set p8 [my uniqueUndef int16* "p"]
set p9 [my uniqueUndef int16* "p"]
set p10 [my uniqueUndef int16* "p"]
set p11 [my uniqueUndef int16* "p"]
set p12 [my uniqueUndef int16* "p"]
my condBr [my gt $length $0] $test $match
label test:
set end [my getelementptr $string [list $length]]
my switch $class $xdigit \
0 $alnum 1 $alpha 2 $ascii 3 $control \
4 $digit 5 $graph 6 $lower 7 $print \
8 $punct 9 $space 10 $upper 11 $word
set n [list $1]
label alnum:
set p [my phi [list $string $p0] [list $test $alnumNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsAlnum [my load $p]] $0] \
$alnumNext $fail
label alnumNext "alnum.next"
ReplaceAllUsesWith $p0 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $alnum $match
label alpha:
set p [my phi [list $string $p1] [list $test $alphaNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsAlpha [my load $p]] $0] \
$alphaNext $fail
label alphaNext "alpha.next"
ReplaceAllUsesWith $p1 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $alpha $match
label ascii:
set p [my phi [list $string $p2] [list $test $asciiNext] "p"]
my condBr [my Call tcl.impl.isAscii [my load $p]] \
$asciiNext $fail
label asciiNext "ascii.next"
ReplaceAllUsesWith $p2 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $ascii $match
label control:
set p [my phi [list $string $p3] [list $test $controlNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsControl [my load $p]] $0] \
$controlNext $fail
label controlNext "control.next"
ReplaceAllUsesWith $p3 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $control $match
label digit:
set p [my phi [list $string $p4] [list $test $digitNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsDigit [my load $p]] $0] \
$digitNext $fail
label digitNext "digit.next"
ReplaceAllUsesWith $p4 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $digit $match
label graph:
set p [my phi [list $string $p5] [list $test $graphNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsGraph [my load $p]] $0] \
$graphNext $fail
label graphNext "graph.next"
ReplaceAllUsesWith $p5 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $graph $match
label lower:
set p [my phi [list $string $p6] [list $test $lowerNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsLower [my load $p]] $0] \
$lowerNext $fail
label lowerNext "lower.next"
ReplaceAllUsesWith $p6 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $lower $match
label print:
set p [my phi [list $string $p7] [list $test $printNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsPrint [my load $p]] $0] \
$printNext $fail
label printNext "print.next"
ReplaceAllUsesWith $p7 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $print $match
label punct:
set p [my phi [list $string $p8] [list $test $punctNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsPunct [my load $p]] $0] \
$punctNext $fail
label punctNext "punct.next"
ReplaceAllUsesWith $p8 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $punct $match
label space:
set p [my phi [list $string $p9] [list $test $spaceNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsSpace [my load $p]] $0] \
$spaceNext $fail
label spaceNext "space.next"
ReplaceAllUsesWith $p9 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $space $match
label upper:
set p [my phi [list $string $p10] [list $test $upperNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsUpper [my load $p]] $0] \
$upperNext $fail
label upperNext "upper.next"
ReplaceAllUsesWith $p10 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $upper $match
label word:
set p [my phi [list $string $p11] [list $test $wordNext] "p"]
my condBr [my neq [$api Tcl_UniCharIsWordChar [my load $p]] $0] \
$wordNext $fail
label wordNext "word.next"
ReplaceAllUsesWith $p11 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $word $match
label xdigit:
set p [my phi [list $string $p12] [list $test $xdigitNext] "p"]
my condBr [my Call tcl.impl.isXdigit [my load $p]] \
$xdigitNext $fail
label xdigitNext "xdigit.next"
ReplaceAllUsesWith $p12 [set p [my getelementptr $p $n "p"]]
my condBr [my lt $p $end] $xdigit $match
label match:
my ret [Const true bool]
label fail:
my ret [Const false bool]
}
##### Function tcl.impl.getIndex #####
................................................................................
[my mult $strLen $sizeof(Tcl_UniChar)]]
set wsres [my select [my eq $cmp $0] $targetObj $stringObj]
my br $done
label map:
lassign [my GetUnicode $targetObj "target"] tgtLen tgtPtr
set result [$api Tcl_NewUnicodeObj $strPtr $0]
set srcPtr0 [my load $srcPtr]
set prevLoop [my uniqueUndef [TypeOf $strPtr] "prev"]
set curLoop [my uniqueUndef [TypeOf $strPtr] "cur"]
set end [my getelementptr $strPtr [list $strLen]]
my br $maplooptest1
label maplooptest1 "map.loop.test"
set sources [list $map $maploopnext]
set cur [my phi [list $strPtr $curLoop] $sources "cur"]
set prev [my phi [list $strPtr $prevLoop] $sources "prev"]
my condBr [my lt $cur $end] $maplooptest2 $mapdone
label maplooptest2 "map.loop.test"
my condBr [my eq [my load $cur] $srcPtr0] \
$maplooptest3 $maploopnext
label maplooptest3 "map.loop.test"
my condBr [my eq $srcLen $1] $maplooptest5 $maplooptest4
label maplooptest4 "map.loop.test"
................................................................................
set cur2 [my getelementptr $prev3 [list ${-1}] "cur"]
$api Tcl_AppendUnicodeToObj $result $tgtPtr $tgtLen
my br $maploopnext
label maploopnext "map.loop.next"
set sources [list $maplooptest2 $maplooptest4 $maploopbody3]
set prev4 [my phi [list $prev $prev $prev3] $sources "prev"]
set cur3 [my phi [list $cur $cur $cur2] $sources "cur"]
ReplaceAllUsesWith $prevLoop $prev4
ReplaceAllUsesWith $curLoop \
[my getelementptr $cur3 [list $1] "cur"]
my br $maplooptest1
label mapdone "map.done"
my assume [my not [my shared $result]]
my condBr [my eq $prev $cur] $done $maplast
label maplast "map.addLast"
$api Tcl_AppendUnicodeToObj $result $prev \
[my cast(int) [my diff $cur $prev] "len"]
................................................................................
set listPtr [my load [my cast(ptr) \
[my gep $list 0 Tcl_Obj.internalRep 0] \
TclList*] "listPtr"]
my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
$sublistInplace $sublistNew
label sublistInplace "sublist.inPlace"
set onePast [my add $to $1 "onePast"]
set loopIndex [my uniqueUndef int "index"]
my br $sublistInplaceFreeTest
label sublistInplaceFreeTest "sublist.inPlace.loop.test"
set sources [list $sublistInplace $sublistInplaceFree]
set index [my phi [list $onePast $loopIndex] $sources "index"]
my condBr [my lt $index $objc] \
$sublistInplaceFree $sublistInplaceDone
label sublistInplaceFree "sublist.inPlace.loop.body"
ReplaceAllUsesWith $loopIndex [my add $index $1 "index"]
set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
my dropReference $obj
my br $sublistInplaceFreeTest
label sublistInplaceDone "sublist.inPlace.done"
my storeInStruct $listPtr TclList.elemCount $onePast
my storeInStruct $listPtr TclList.canonicalFlag $1
$api TclInvalidateStringRep $list
................................................................................
set listPtr [my load [my cast(ptr) \
[my gep $list 0 Tcl_Obj.internalRep 0] \
TclList*] "listPtr"]
my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
$sublistInplace $sublistNew
label sublistInplace "sublist.inPlace"
set onePast [my add $to $1 "onePast"]
set loopIndex [my uniqueUndef int "index"]
my br $sublistInplaceFreeTest
label sublistInplaceFreeTest "sublist.inPlace.free.test"
set sources [list $sublistInplace $sublistInplaceFree]
set index [my phi [list $onePast $loopIndex] $sources "index"]
my condBr [my lt $index $objc] \
$sublistInplaceFree $sublistInplaceDone
label sublistInplaceFree "sublist.inPlace.free"
ReplaceAllUsesWith $loopIndex [my add $index $1 "index"]
set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
my dropReference $obj
my br $sublistInplaceFreeTest
label sublistInplaceDone "sublist.inPlace.done"
my storeInStruct $listPtr TclList.elemCount $onePast
my storeInStruct $listPtr TclList.canonicalFlag $1
$api TclInvalidateStringRep $list
................................................................................
set lenVar [my alloc int]
set objvVar [my alloc STRING*]
set code [$api Tcl_ListObjGetElements $interp $list $lenVar $objvVar]
my condBr [my eq $code $0] $realCheck $fail
label realCheck:
set objc [my load $lenVar "objc"]
set objv [my load $objvVar "objv"]
set iLoop [my uniqueUndef int "i"]
my condBr [my gt $objc $0] $loop $done
label loop:
set i [my phi [list $0 $iLoop] [list $realCheck $loopNext] "i"]
set obj [my load [my getelementptr $objv [list $i]] "obj"]
lassign [my GetString $obj "element"] len2 bytes2
my condBr [my eq $len1 $len2] $loopCompare $loopNext
label loopCompare:
my condBr [my eq [my memcmp $bytes1 $bytes2 $len1] $0] \
$done $loopNext
label loopNext:
ReplaceAllUsesWith $iLoop [set i [my add $i $1 "i"]]
my condBr [my lt $i $objc] $loop $done
label fail:
my store $1 $ecVar
my ret [my fail ZEROONE]
label done:
set flag [my phi [list [Const false bool] [Const false bool] [Const true bool]] \
[list $realCheck $loopNext $loopCompare] "flag"]
|
< < | | | > < < | | > | < | < | < < > | < < | | | > | | | < < | | > | | | | | | | | | | | < < < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | | | | < | < | < > | < | < > | < < > | |
982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 .... 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 .... 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 .... 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 .... 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 .... 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 .... 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 .... 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 |
# trimmed are in the string 'trim' (length 'numTrim'). Works on UTF-8.
set f [$m local "tcl.impl.trimleft" int<-char*,int,char*,int readonly]
params bytes numBytes trim numTrim
build {
nonnull $bytes $trim
set chVar [my alloc int16]
my condBr [my eq $numBytes $0] $ret0 $checkTrim
label checkTrim:
my condBr [my eq $numTrim $0] $ret0 $outerLoop
label ret0:
my ret $0
label outerLoop:
set sources {$checkTrim $nextOuter}
set p [PHI [Type char*] {$bytes $pLoop} $sources "p"]
set numBytes2 [PHI [Type int] {$numBytes $nbLoop} $sources \
"numBytes.2"]
set pInc [$api Tcl_UtfToUniChar $p $chVar]
SetValueName $pInc "pInc"
set ch1 [my load $chVar "ch1"]
my br $innerLoop
label innerLoop:
set sources [list $outerLoop $nextInner]
set q [PHI [Type char*] {$trim $qLoop} $sources "q"]
set bytesLeft [PHI [Type int] {$numTrim $blLoop} $sources \
"bytesLeft"]
set qInc [$api Tcl_UtfToUniChar $q $chVar]
SetValueName $qInc "qInc"
set ch2 [my load $chVar "ch2"]
my condBr [my eq $ch1 $ch2] $doneInner $nextInner
label nextInner:
set qLoop [my getelementptr $q [list $qInc] "q"]
set blLoop [set bytesLeft2 [my sub $bytesLeft $qInc "bytesLeft"]]
my condBr [my gt $bytesLeft2 $0] $innerLoop $doneInner
label doneInner:
set sources [list $innerLoop $nextInner]
set bytesLeft [my phi [list $bytesLeft $bytesLeft2] $sources "bytesLeft"]
my condBr [my le $bytesLeft $0] $doneOuter $nextOuter
label nextOuter:
set pLoop [set p2 [my getelementptr $p [list $pInc] "p"]]
set nbLoop [set numBytes3 [my sub $numBytes2 $pInc "numBytes.3"]]
my condBr [my gt $numBytes3 $0] $outerLoop $doneOuter
label doneOuter:
set p [my phi [list $p $p2] [list $doneInner $nextOuter] "p"]
my ret [my cast(int) [my diff $p $bytes]]
}
##### Function tcl.impl.trimright #####
# Replacement for non-exposed TclTrimRight
................................................................................
# in the string 'trim' (length 'numTrim'). Works on UTF-8.
set f [$m local "tcl.impl.trimright" int<-char*,int,char*,int readonly]
params bytes numBytes trim numTrim
build {
nonnull $bytes $trim
set chVar [my alloc int16]
set p0 [my getelementptr $bytes [list $numBytes] "p.0"]
my condBr [my eq $numBytes $0] $ret0 $checkTrim
label checkTrim:
my condBr [my eq $numTrim $0] $ret0 $outerLoop
label ret0:
my ret $0
label outerLoop:
set sources [list $checkTrim $nextOuter]
set p1 [PHI [Type char*] {$p0 $pLoop} $sources "p.1"]
set numBytes1 [PHI [Type int] {$numBytes $nbLoop} $sources \
"numBytes.1"]
set p2 [$api Tcl_UtfPrev $p1 $bytes]
SetValueName $p2 "p.2"
set pInc [$api Tcl_UtfToUniChar $p2 $chVar]
SetValueName $pInc "pInc"
set ch1 [my load $chVar "ch1"]
my br $innerLoop
label innerLoop:
set sources [list $outerLoop $nextInner]
set q [PHI [Type char*] {$trim $qLoop} $sources "q"]
set bytesLeft [PHI [Type int] {$numTrim $blLoop} $sources \
"bytesLeft"]
set qInc [$api Tcl_UtfToUniChar $q $chVar]
SetValueName $qInc "qInc"
set ch2 [my load $chVar "ch2"]
my condBr [my eq $ch1 $ch2] $doneInner $nextInner
label doneInner:
my condBr [my le $bytesLeft $0] $fixP $nextOuter
label nextInner:
set qLoop [my getelementptr $q [list $qInc] "q"]
set blLoop \
[set bytesLeft1 [my sub $bytesLeft $qInc "bytesLeft.1"]]
my condBr [my gt $bytesLeft1 $0] $innerLoop $fixP
label nextOuter:
set pLoop $p2
set nbLoop $numBytes1
my condBr [my gt $p2 $bytes] $outerLoop $doneOuter
label fixP:
set p3 [my phi [list $p2 $p2] [list $doneInner $nextInner] "p.3"]
set p4 [my getelementptr $p3 [list $pInc] "p.4"]
my br $doneOuter
label doneOuter:
set p5 [my phi [list $p2 $p4] [list $nextOuter $fixP] "p.5"]
my ret [my sub $numBytes1 [my cast(int) [my diff $p5 $bytes]]]
}
##### Function tcl.impl.isAscii #####
# Replacement for non-exposed UniCharIsAscii
#
# Type signature: ch:int16 -> int1
#
................................................................................
# character class given by 'class' (enumeration encoded as int32).
set f [$m local "tcl.strclass" ZEROONE<-STRING,int]
params objPtr class
build {
nonnull $objPtr
lassign [my GetUnicode $objPtr obj] length string
my condBr [my gt $length $0] $test $match
label test:
set end [my getelementptr $string [list $length]]
my switch $class $xdigit \
0 $alnum 1 $alpha 2 $ascii 3 $control \
4 $digit 5 $graph 6 $lower 7 $print \
8 $punct 9 $space 10 $upper 11 $word
set n [list $1]
label alnum:
set p [PHI [Type int16*] {$string $p0} {$test $alnumNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsAlnum [my load $p]] $0] \
$alnumNext $fail
label alnumNext "alnum.next"
set p0 [my getelementptr $p $n "p.0"]
my condBr [my lt $p0 $end] $alnum $match
label alpha:
set p [PHI [Type int16*] {$string $p1} {$test $alphaNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsAlpha [my load $p]] $0] \
$alphaNext $fail
label alphaNext "alpha.next"
set p1 [my getelementptr $p $n "p.1"]
my condBr [my lt $p1 $end] $alpha $match
label ascii:
set p [PHI [Type int16*] {$string $p2} {$test $asciiNext} "p"]
my condBr [my Call tcl.impl.isAscii [my load $p]] \
$asciiNext $fail
label asciiNext "ascii.next"
set p2 [my getelementptr $p $n "p.2"]
my condBr [my lt $p2 $end] $ascii $match
label control:
set p [PHI [Type int16*] {$string $p3} {$test $controlNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsControl [my load $p]] $0] \
$controlNext $fail
label controlNext "control.next"
set p3 [my getelementptr $p $n "p.3"]
my condBr [my lt $p3 $end] $control $match
label digit:
set p [PHI [Type int16*] {$string $p4} {$test $digitNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsDigit [my load $p]] $0] \
$digitNext $fail
label digitNext "digit.next"
set p4 [my getelementptr $p $n "p.4"]
my condBr [my lt $p4 $end] $digit $match
label graph:
set p [PHI [Type int16*] {$string $p5} {$test $graphNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsGraph [my load $p]] $0] \
$graphNext $fail
label graphNext "graph.next"
set p5 [my getelementptr $p $n "p.5"]
my condBr [my lt $p5 $end] $graph $match
label lower:
set p [PHI [Type int16*] {$string $p6} {$test $lowerNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsLower [my load $p]] $0] \
$lowerNext $fail
label lowerNext "lower.next"
set p6 [my getelementptr $p $n "p.6"]
my condBr [my lt $p6 $end] $lower $match
label print:
set p [PHI [Type int16*] {$string $p7} {$test $printNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsPrint [my load $p]] $0] \
$printNext $fail
label printNext "print.next"
set p7 [my getelementptr $p $n "p.7"]
my condBr [my lt $p7 $end] $print $match
label punct:
set p [PHI [Type int16*] {$string $p8} {$test $punctNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsPunct [my load $p]] $0] \
$punctNext $fail
label punctNext "punct.next"
set p8 [my getelementptr $p $n "p.8"]
my condBr [my lt $p8 $end] $punct $match
label space:
set p [PHI [Type int16*] {$string $p9} {$test $spaceNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsSpace [my load $p]] $0] \
$spaceNext $fail
label spaceNext "space.next"
set p9 [my getelementptr $p $n "p.9"]
my condBr [my lt $p9 $end] $space $match
label upper:
set p [PHI [Type int16*] {$string $p10} {$test $upperNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsUpper [my load $p]] $0] \
$upperNext $fail
label upperNext "upper.next"
set p10 [my getelementptr $p $n "p.10"]
my condBr [my lt $p10 $end] $upper $match
label word:
set p [PHI [Type int16*] {$string $p11} {$test $wordNext} "p"]
my condBr [my neq [$api Tcl_UniCharIsWordChar [my load $p]] $0] \
$wordNext $fail
label wordNext "word.next"
set p11 [my getelementptr $p $n "p.11"]
my condBr [my lt $p11 $end] $word $match
label xdigit:
set p [PHI [Type int16*] {$string $p12} {$test $xdigitNext} "p"]
my condBr [my Call tcl.impl.isXdigit [my load $p]] \
$xdigitNext $fail
label xdigitNext "xdigit.next"
set p12 [my getelementptr $p $n "p.12"]
my condBr [my lt $p12 $end] $xdigit $match
label match:
my ret [Const true bool]
label fail:
my ret [Const false bool]
}
##### Function tcl.impl.getIndex #####
................................................................................
[my mult $strLen $sizeof(Tcl_UniChar)]]
set wsres [my select [my eq $cmp $0] $targetObj $stringObj]
my br $done
label map:
lassign [my GetUnicode $targetObj "target"] tgtLen tgtPtr
set result [$api Tcl_NewUnicodeObj $strPtr $0]
set srcPtr0 [my load $srcPtr]
set end [my getelementptr $strPtr [list $strLen]]
my br $maplooptest1
label maplooptest1 "map.loop.test"
set sources {$map $maploopnext}
set cur [PHI [TypeOf $strPtr] {$strPtr $curLoop} $sources "cur"]
set prev [PHI [TypeOf $strPtr] {$strPtr $prevLoop} $sources "prev"]
my condBr [my lt $cur $end] $maplooptest2 $mapdone
label maplooptest2 "map.loop.test"
my condBr [my eq [my load $cur] $srcPtr0] \
$maplooptest3 $maploopnext
label maplooptest3 "map.loop.test"
my condBr [my eq $srcLen $1] $maplooptest5 $maplooptest4
label maplooptest4 "map.loop.test"
................................................................................
set cur2 [my getelementptr $prev3 [list ${-1}] "cur"]
$api Tcl_AppendUnicodeToObj $result $tgtPtr $tgtLen
my br $maploopnext
label maploopnext "map.loop.next"
set sources [list $maplooptest2 $maplooptest4 $maploopbody3]
set prev4 [my phi [list $prev $prev $prev3] $sources "prev"]
set cur3 [my phi [list $cur $cur $cur2] $sources "cur"]
set prevLoop $prev4
set curLoop [my getelementptr $cur3 [list $1] "cur"]
my br $maplooptest1
label mapdone "map.done"
my assume [my not [my shared $result]]
my condBr [my eq $prev $cur] $done $maplast
label maplast "map.addLast"
$api Tcl_AppendUnicodeToObj $result $prev \
[my cast(int) [my diff $cur $prev] "len"]
................................................................................
set listPtr [my load [my cast(ptr) \
[my gep $list 0 Tcl_Obj.internalRep 0] \
TclList*] "listPtr"]
my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
$sublistInplace $sublistNew
label sublistInplace "sublist.inPlace"
set onePast [my add $to $1 "onePast"]
my br $sublistInplaceFreeTest
label sublistInplaceFreeTest "sublist.inPlace.loop.test"
set sources {$sublistInplace $sublistInplaceFree}
set index [PHI [Type int32] {$onePast $loopIndex} $sources "index"]
my condBr [my lt $index $objc] \
$sublistInplaceFree $sublistInplaceDone
label sublistInplaceFree "sublist.inPlace.loop.body"
set loopIndex [my add $index $1 "index"]
set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
my dropReference $obj
my br $sublistInplaceFreeTest
label sublistInplaceDone "sublist.inPlace.done"
my storeInStruct $listPtr TclList.elemCount $onePast
my storeInStruct $listPtr TclList.canonicalFlag $1
$api TclInvalidateStringRep $list
................................................................................
set listPtr [my load [my cast(ptr) \
[my gep $list 0 Tcl_Obj.internalRep 0] \
TclList*] "listPtr"]
my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
$sublistInplace $sublistNew
label sublistInplace "sublist.inPlace"
set onePast [my add $to $1 "onePast"]
my br $sublistInplaceFreeTest
label sublistInplaceFreeTest "sublist.inPlace.free.test"
set sources {$sublistInplace $sublistInplaceFree}
set index [PHI [Type int32] {$onePast $loopIndex} $sources "index"]
my condBr [my lt $index $objc] \
$sublistInplaceFree $sublistInplaceDone
label sublistInplaceFree "sublist.inPlace.free"
set loopIndex [my add $index $1 "index"]
set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
my dropReference $obj
my br $sublistInplaceFreeTest
label sublistInplaceDone "sublist.inPlace.done"
my storeInStruct $listPtr TclList.elemCount $onePast
my storeInStruct $listPtr TclList.canonicalFlag $1
$api TclInvalidateStringRep $list
................................................................................
set lenVar [my alloc int]
set objvVar [my alloc STRING*]
set code [$api Tcl_ListObjGetElements $interp $list $lenVar $objvVar]
my condBr [my eq $code $0] $realCheck $fail
label realCheck:
set objc [my load $lenVar "objc"]
set objv [my load $objvVar "objv"]
my condBr [my gt $objc $0] $loop $done
label loop:
set i [PHI [Type int32] {$0 $iLoop} {$realCheck $loopNext} "i"]
set obj [my load [my getelementptr $objv [list $i]] "obj"]
lassign [my GetString $obj "element"] len2 bytes2
my condBr [my eq $len1 $len2] $loopCompare $loopNext
label loopCompare:
my condBr [my eq [my memcmp $bytes1 $bytes2 $len1] $0] \
$done $loopNext
label loopNext:
set iLoop [set i [my add $i $1 "i"]]
my condBr [my lt $i $objc] $loop $done
label fail:
my store $1 $ecVar
my ret [my fail ZEROONE]
label done:
set flag [my phi [list [Const false bool] [Const false bool] [Const true bool]] \
[list $realCheck $loopNext $loopCompare] "flag"]
|
Changes to codegen/struct.tcl.
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
....
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
|
# Results: # Returns a reference to the phi node # # Side effects: # Stores data regarding the fixup in the variable '@[email protected]' # in the caller proc PHI {type sources values {name {}}} { upvar 1 @[email protected] phis set phi [uplevel 1 [list my phiStub $type $name]] lappend phis $phi $sources $values return $phi } # FixupPhis -- ................................................................................ if {[TypeOf $v] ne [TypeOf $phi]} { return -code error \ "Expected a value of type\ [PrintTypeToString [TypeOf $phi]]\ for [PrintValueTosString $phi] but found\ [PrintTypeToString [TypeOf $v]]" } set label [uplevel 1 [list my LABEL $source]] AddIncoming $phi $value $label } } } } } # Class LLVMBuilder -- |
|
|
|
|
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
....
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
|
# Results: # Returns a reference to the phi node # # Side effects: # Stores data regarding the fixup in the variable '@[email protected]' # in the caller proc PHI {type values sources {name {}}} { upvar 1 @[email protected] phis set phi [uplevel 1 [list my phiStub $type $name]] lappend phis $phi $sources $values return $phi } # FixupPhis -- ................................................................................ if {[TypeOf $v] ne [TypeOf $phi]} { return -code error \ "Expected a value of type\ [PrintTypeToString [TypeOf $phi]]\ for [PrintValueTosString $phi] but found\ [PrintTypeToString [TypeOf $v]]" } set label [uplevel 1 [list my LABEL $s]] AddIncoming $phi $v $label } } } } } # Class LLVMBuilder -- |