Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Timelines: | family | ancestors | descendants | both | inline |
Files: | files | file ages | folders |
SHA3-256: |
c0e88e91be075156c5681e53409061dc |
User & Date: | kbk 2018-03-27 01:40:39.992 |
Context
2018-04-17
| ||
00:13 | Merge trunk Leaf check-in: 25e63838cd user: kbk tags: inline | |
2018-03-27
| ||
01:40 | merge trunk check-in: c0e88e91be user: kbk tags: inline | |
01:36 | Merge changes: complete type checking of Boolean args to 'jumpTrue', 'jumpFalse', 'not', 'land', and 'lor' check-in: 0b62f38ede user: kbk tags: trunk | |
2018-03-18
| ||
22:30 | merge trunk check-in: 1cbcf74c81 user: kbk tags: inline | |
Changes
Changes to codegen/build.tcl.
︙ | ︙ | |||
43 44 45 46 47 48 49 50 51 52 53 54 55 56 | # Results: # A boolean (int1) LLVM value reference. method isNumericInt {NUMERIC {name ""}} { my eq [my extract $NUMERIC NUMERIC.kind] \ [Const ${::LLVM::NUMERIC.type.int} int1] $name } # Builder:packInt32 -- # # Generate code to convert an int32 to an INT. # # Parameters: # value - The 32-bit integer LLVM value reference. | > > > > > > > > > > > > > > > | 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 | # Results: # A boolean (int1) LLVM value reference. method isNumericInt {NUMERIC {name ""}} { my eq [my extract $NUMERIC NUMERIC.kind] \ [Const ${::LLVM::NUMERIC.type.int} int1] $name } # Builder: getNumericBooleanKind # # Generate code to return the kind of a NUMERIC BOOLEAN # # Parameters: # nb - The NUMERIC BOOLEAN vlaue reference # name (optional) - A name to give to the result # # Results: # An int(3) LLVM value reference: 0 = INT, 1 = DOUBLE 2 = BOOLEAN method getNumericBooleanKind {nb {name ""}} { my extract $nb NUMERIC_BOOLEAN.kind } # Builder:packInt32 -- # # Generate code to convert an int32 to an INT. # # Parameters: # value - The 32-bit integer LLVM value reference. |
︙ | ︙ | |||
115 116 117 118 119 120 121 122 123 124 125 126 127 128 | # The NUMERIC LLVM value reference. method packNumericDouble {value {name ""}} { my insert [my insert [my undef NUMERIC] \ [Const ${::LLVM::NUMERIC.type.double} int1] NUMERIC.kind] \ $value NUMERIC.double $name } # Builder:int.32 -- # # Generate code to extract the int32 from an INT. Caller MUST guarantee # that the size was tested for first. # # Parameters: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | # The NUMERIC LLVM value reference. method packNumericDouble {value {name ""}} { my insert [my insert [my undef NUMERIC] \ [Const ${::LLVM::NUMERIC.type.double} int1] NUMERIC.kind] \ $value NUMERIC.double $name } # Builder:packNumericOrBooleanInt -- # # Generate code to convert an integer to a NUMERIC BOOLEAN # # Parameters: # value - The integer LLVM value reference # name (optional) - A name to give to the result value # # Results: # The NUMERIC BOOLEAN LLVM value reference method packNumericOrBooleanInt {value {name ""}} { my insert [my insert [my undef "NUMERIC_BOOLEAN"] \ [Const ${::LLVM::NUMERIC_BOOLEAN.type.int} int3] \ NUMERIC_BOOLEAN.kind] \ $value NUMERIC_BOOLEAN.int $name } # Builder:packNumericOrBooleanDouble -- # # Generate code to convert a double to a NUMERIC BOOLEAN # # Parameters: # value - The DOUBLE LLVM value reference # name (optional) - A name to give to the result value # # Results: # The NUMERIC BOOLEAN LLVM value reference method packNumericOrBooleanDouble {value {name ""}} { my insert [my insert [my undef "NUMERIC_BOOLEAN"] \ [Const ${::LLVM::NUMERIC_BOOLEAN.type.double} int3] \ NUMERIC_BOOLEAN.kind] \ $value NUMERIC_BOOLEAN.double $name } # Builder:packNumericOrBooleanBoolean -- # # Generate code to convert a Boolean to a NUMERIC BOOLEAN # # Parameters: # value - The bool LLVM value reference # name (optional) - A name to give to the result value # # Results: # The NUMERIC BOOLEAN LLVM value reference method packNumericOrBooleanBoolean {value {name ""}} { my insert [my insert [my undef "NUMERIC_BOOLEAN"] \ [Const ${::LLVM::NUMERIC_BOOLEAN.type.bool} int3] \ NUMERIC_BOOLEAN.kind] \ $value NUMERIC_BOOLEAN.bool $name } # Builder:int.32 -- # # Generate code to extract the int32 from an INT. Caller MUST guarantee # that the size was tested for first. # # Parameters: |
︙ | ︙ | |||
185 186 187 188 189 190 191 192 193 194 195 196 197 198 | # # Results: # A DOUBLE LLVM value reference. method numeric.double {NUMERIC {name ""}} { my extract $NUMERIC NUMERIC.double $name } # Builder:NumToDbl -- # # Generate code to convert a NUMERIC to a DOUBLE. The value inside the # NUMERIC might be INT or DOUBLE; this handles both cases. # # Parameters: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | # # Results: # A DOUBLE LLVM value reference. method numeric.double {NUMERIC {name ""}} { my extract $NUMERIC NUMERIC.double $name } # Builder:numericOrBoolean.int -- # # Generate code to extract the INT from a NUMERIC BOOLEAN. Caller MUST # guarantee that the kind was tested for first. # # Parameters: # nb - LLVM NUMERIC BOOLEAN value reference # name (optional) - A name to give to the result # # Results: # An INT LLVM value reference method numericOrBoolean.int {nb {name ""}} { my extract $nb NUMERIC_BOOLEAN.int $name } # Builder:numericOrBoolean.double -- # # Generate code to extract the DOUBLE from a NUMERIC BOOLEAN. Caller MUST # guarantee that the kind was tested for first. # # Parameters: # nb - LLVM NUMERIC BOOLEAN value reference # name (optional) - A name to give to the result # # Results: # A DOUBLE LLVM value reference method numericOrBoolean.double {nb {name ""}} { my extract $nb NUMERIC_BOOLEAN.double $name } # Builder:numericOrBoolean.bool -- # # Generate code to extract the BOOLEAN from a NUMERIC BOOLEAN. Caller MUST # guarantee that the kind was tested for first. # # Parameters: # nb - LLVM NUMERIC BOOLEAN value reference # name (optional) - A name to give to the result # # Results: # An int1 LLVM value reference method numericOrBoolean.bool {nb {name ""}} { my extract $nb NUMERIC_BOOLEAN.bool $name } # Builder:NumToDbl -- # # Generate code to convert a NUMERIC to a DOUBLE. The value inside the # NUMERIC might be INT or DOUBLE; this handles both cases. # # Parameters: |
︙ | ︙ | |||
4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 | method instanceOf.NUMERIC(STRING) {value {name ""}} { my call ${tcl.isNumeric} [list $value [Const false bool]] $name } method instanceOf.IMPURE_NUMERIC(STRING) {value {name ""}} { my call ${tcl.isNumeric} [list $value [Const false bool]] $name } # Builder:int -- # # Generate code to create an integer "literal". # # Parameters: # value - The Tcl integer that we are converting to an LLVM INT. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 | method instanceOf.NUMERIC(STRING) {value {name ""}} { my call ${tcl.isNumeric} [list $value [Const false bool]] $name } method instanceOf.IMPURE_NUMERIC(STRING) {value {name ""}} { my call ${tcl.isNumeric} [list $value [Const false bool]] $name } # Builder:instanceOf.NUMERIC_OR_BOOLEAN -- # # Generate code to check if the given STRING contains something that # can be parsed to get either a NUMERIC or a BOOLEAN (suitable, in # other words, for a conditional. Quadcode implementation ('jumpFalse', # 'jumpTrue', 'land', 'lor', 'not') method instanceOf.NUMERIC_OR_BOOLEAN(STRING) {value {name ""}} { my call ${tcl.isNumericOrBoolean} [list $value] $name } method instanceOf.IMPURE_NUMERIC_OR_BOOLEAN(STRING) {value {name ""}} { my call ${tcl.isNumericOrBoolean} [list $value] $name } # Builder:instanceOf.ZEROONE_BOOLEAN -- # # Generate code to check if the given STRING contains something that # can be parsed to get a ZEROONE or a BOOLEAN (suitable, in # other words, for a conditional. Quadcode implementation ('jumpFalse', # 'jumpTrue', 'land', 'lor', 'not') method instanceOf.ZEROONE_BOOLEAN(STRING) {value {name ""}} { my call ${tcl.isZeroOneBoolean} [list $value [Const false bool]] $name } method instanceOf.IMPURE_ZEROONE_BOOLEAN(STRING) {value {name ""}} { my call ${tcl.isZeroOneBoolean} [list $value [Const false bool]] $name } # Builder:int -- # # Generate code to create an integer "literal". # # Parameters: # value - The Tcl integer that we are converting to an LLVM INT. |
︙ | ︙ | |||
4342 4343 4344 4345 4346 4347 4348 | # name (optional) - # A name to give to the result value. # # Results: # An LLVM INT value reference containing a boolean value. method isBoolean(STRING) {value {name ""}} { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 | # name (optional) - # A name to give to the result value. # # Results: # An LLVM INT value reference containing a boolean value. method isBoolean(STRING) {value {name ""}} { my call ${tcl.isBoolean} [list $value [Const false bool]] $name } # Builder:isTrue(INT BOOLEAN) -- # # Tests whether a given value will cause 'jumpTrue' to jump; # Quadcode implementation('jumpTrue', 'jumpFalse') # # Parameters: # value - The value to test, as an LLVM value reference. # name (optional) - A name to give to the result value. # # Results: # An LLVM ZEROONE value reference. method isTrue(INT\040BOOLEAN) {value {name ""}} { my eq $value [Const 0 int64] } # Builder:isTrue(DOUBLE) -- # # Tests whether a given value will cause 'jumpTrue' to jump; # Quadcode implementation('jumpTrue', 'jumpFalse') # # Parameters: # value - The value to test, as an LLVM value reference. # name (optional) - A name to give to the result value. # # Results: # An LLVM ZEROONE value reference. method isTrue(DOUBLE) {value {name ""}} { my eq $value [Const 0.0 double] } # Builder:isTrue(NUMERIC) -- # # Tests whether a given value will cause 'jumpTrue' to jump; # Quadcode implementation('jumpTrue', 'jumpFalse') # # Parameters: # value - The value to test, as an LLVM value reference. # name (optional) - A name to give to the result value. # # Results: # An LLVM ZEROONE value reference. method isTrue(NUMERIC) {value name} { my call ${tcl.isTrue.numeric} [list $value] $name } # Builder:isTrue(NUMERIC BOOLEAN) -- # # Tests whether a given value will cause 'jumpTrue' to jump; # Quadcode implementation('jumpTrue', 'jumpFalse') # # Parameters: # value - The value to test, as an LLVM value reference. # name (optional) - A name to give to the result value. # # Results: # An LLVM ZEROONE value reference. method isTrue(NUMERIC\040BOOLEAN) {value name} { my call ${tcl.isTrue.numericOrBoolean} [list $value] $name } # Builder:isTrue(ZEROONE BOOLEAN) -- # # Tests whether a given value will cause 'jumpTrue' to jump; # Quadcode implementation('jumpTrue', 'jumpFalse') # # Parameters: # value - The value to test, as an LLVM value reference. # name (optional) - A name to give to the result value. # # Results: # An LLVM ZEROONE value reference. method isTrue(ZEROONE) {value name} { return $value } method isTrue(ZEROONE\040BOOLEAN) {value name} { return $value } # Builder:land(INT,INT) -- # # Generate code to compute the logical and of two INTs. Quadcode # implementation ('land'). # |
︙ | ︙ | |||
4547 4548 4549 4550 4551 4552 4553 | set idx -1 foreach value $values type $types { if {[lindex $type 0] eq "IMPURE"} { set value [my stringify($type) $value] } else { switch -exact -- $type { "INT" - "INT BOOLEAN" - "ZEROONE" - "DOUBLE" - | | | 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 | set idx -1 foreach value $values type $types { if {[lindex $type 0] eq "IMPURE"} { set value [my stringify($type) $value] } else { switch -exact -- $type { "INT" - "INT BOOLEAN" - "ZEROONE" - "DOUBLE" - "ENTIER" - "NUMERIC" - "NUMERIC BOOLEAN" { set value [my stringify($type) $value] } } } my store $value [my gep $vlist [incr idx]] } } else { |
︙ | ︙ | |||
5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 | method narrowToType.IMPURE_BOOLEAN(IMPURE\040ZEROONE\040BOOLEAN) {value {name ""}} { my addReference(STRING) [my impure.string $value] if {$name ne "" && [string match {[0-9]*} [GetValueName $value]]} { SetValueName $value $name } return $value } # Builder:narrowToType.IMPURE_ZEROONE(IMPURE ZEROONE BOOLEAN) -- # # Generate code to extract IMPURE ZEROONE from IMPURE ZEROONE BOOLEAN. # The extracton does nothing except bump the reference count, the two # types have the same internal representation # | > > > > > > > > > > > > > > > > > | 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 | method narrowToType.IMPURE_BOOLEAN(IMPURE\040ZEROONE\040BOOLEAN) {value {name ""}} { my addReference(STRING) [my impure.string $value] if {$name ne "" && [string match {[0-9]*} [GetValueName $value]]} { SetValueName $value $name } return $value } # Builder:narrowToType.IMPURE_NUMERIC_BOOLEAN(STRING) -- # # Generate code to extract IMPURE NUMERIC BOOLEAN from a STRING. # # Parameters: # value - The STRING to parse # name (optional) - A name to give to the result # # Results: # An IMPURE NUMERIC BOOLEAN value reference. method narrowToType.IMPURE_NUMERIC_BOOLEAN(STRING) {value {name ""}} { set nbval [my Call ${tcl.extractNumericOrBoolean} $value] my addReference(STRING) $value return [my impure NUMERIC_BOOLEAN $value $nbval $name] } # Builder:narrowToType.IMPURE_ZEROONE(IMPURE ZEROONE BOOLEAN) -- # # Generate code to extract IMPURE ZEROONE from IMPURE ZEROONE BOOLEAN. # The extracton does nothing except bump the reference count, the two # types have the same internal representation # |
︙ | ︙ | |||
5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 | # # Results: # A NUMERIC LLVM value reference. method not(NUMERIC) {value errVar {name ""}} { my call ${tcl.not.numeric} [list $value] $name } # Builder:not(STRING) -- # # Generate code to create the logical not of a STRING. Quadcode # implementation ('not'). # # Parameters: | > > > > > > > > > > > > > > > > > > > > | 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 | # # Results: # A NUMERIC LLVM value reference. method not(NUMERIC) {value errVar {name ""}} { my call ${tcl.not.numeric} [list $value] $name } # Builder:not(NUMERIC BOOLEAN) -- # # Generate code to create the logical not of a NUMERIC BOOLEAN. Quadcode # implementation ('not'). # # Parameters: # value - The NUMERIC LLVM value reference for the operand. # errVar - # Location to write the Tcl return code into, as an LLVM int* # reference. (unused) # name (optional) - # A name to give to the result value. # # Results: # A NUMERIC LLVM value reference. method not(NUMERIC\040BOOLEAN) {value errVar {name ""}} { my call ${tcl.not.numericOrBoolean} [list $value] $name } # Builder:not(STRING) -- # # Generate code to create the logical not of a STRING. Quadcode # implementation ('not'). # # Parameters: |
︙ | ︙ | |||
6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 | # # Results: # A STRING LLVM value reference. method stringify(IMPURE\040INT) {value {name ""}} { my stringifyImpure $value $name } # Builder:stringify(NUMERIC) -- # # Generate a STRING representation of a NUMERIC. WARNING: caller is # entirely responsible for reference count management; this method does # not handle that. This method is used by the type promotion code. # | > > > > > > > > > > > > > > > > > > | 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 | # # Results: # A STRING LLVM value reference. method stringify(IMPURE\040INT) {value {name ""}} { my stringifyImpure $value $name } # Builder:stringify(NUMERIC BOOLEAN) -- # # Generate a STRING representation of a NUMERIC. WARNING: caller is # entirely responsible for reference count management; this method does # not handle that. This method is used by the type promotion code. # # Parameters: # value - The NUMERIC LLVM value reference for the operand. # name (optional) - # A name to give to the result value. # # Results: # A STRING LLVM value reference. method stringify(NUMERIC\040BOOLEAN) {value {name ""}} { my call ${tcl.stringify.numericOrBoolean} [list $value] $name } # Builder:stringify(NUMERIC) -- # # Generate a STRING representation of a NUMERIC. WARNING: caller is # entirely responsible for reference count management; this method does # not handle that. This method is used by the type promotion code. # |
︙ | ︙ |
Changes to codegen/compile.tcl.
︙ | ︙ | |||
479 480 481 482 483 484 485 486 487 488 489 490 491 492 | [$b maybe [$b frame.value $res]] } my StoreResult $tgt $res } "bitor" - "bitxor" - "bitand" - "lshift" - "rshift" - "add" - "sub" - "mult" - "uminus" - "uplus" - "land" - "lor" - "isBoolean" - "eq" - "neq" - "lt" - "gt" - "le" - "ge" - "streq" - "bitnot" - "strcase" - "strclass" - "strcmp" - "strfind" - "strlen" - "strmap" - "strmatch" - "strrfind" - "strtrim" - "resolveCmd" - "arrayExists" - "directExists" - "arrayElementExists" - "directArrayExists" - "initArrayIfNotExists" - "extractScalar" - "extractArray" - "arraySet" - "arrayUnset" - "arrayGet" { set srcs [lassign $l opcode tgt] | > | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 | [$b maybe [$b frame.value $res]] } my StoreResult $tgt $res } "bitor" - "bitxor" - "bitand" - "lshift" - "rshift" - "add" - "sub" - "mult" - "uminus" - "uplus" - "land" - "lor" - "isBoolean" - "eq" - "neq" - "lt" - "gt" - "le" - "ge" - "not" - "streq" - "bitnot" - "strcase" - "strclass" - "strcmp" - "strfind" - "strlen" - "strmap" - "strmatch" - "strrfind" - "strtrim" - "resolveCmd" - "arrayExists" - "directExists" - "arrayElementExists" - "directArrayExists" - "initArrayIfNotExists" - "extractScalar" - "extractArray" - "arraySet" - "arrayUnset" - "arrayGet" { set srcs [lassign $l opcode tgt] |
︙ | ︙ | |||
537 538 539 540 541 542 543 | "directLappendList" - "directUnset" - "directArrayGet" - "directArraySet" - "directArrayAppend" - "directArrayLappend" - "directArrayLappendList" - "directArrayUnset" - "directIsArray" - "directMakeArray" - "regexp" - "listAppend" - "listConcat" - "listLength" - "listRange" - "listIn" - "listNotIn" - "dictIterStart" - "dictAppend" - "dictIncr" - "dictLappend" - "dictSize" - | | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | "directLappendList" - "directUnset" - "directArrayGet" - "directArraySet" - "directArrayAppend" - "directArrayLappend" - "directArrayLappendList" - "directArrayUnset" - "directIsArray" - "directMakeArray" - "regexp" - "listAppend" - "listConcat" - "listLength" - "listRange" - "listIn" - "listNotIn" - "dictIterStart" - "dictAppend" - "dictIncr" - "dictLappend" - "dictSize" - "div" - "expon" - "mod" - "verifyList" - "dictGetOrNexist" - "dictSetOrUnset" { set srcs [lassign $l opcode tgt] set name [my LocalVarName $tgt] append opcode ( [my ValueTypes {*}$srcs] ) set srcs [lmap s $srcs {my LoadOrLiteral $s}] set res [$b $opcode {*}$srcs $errorCode $name] if {"FAIL" in [my ValueTypes $tgt]} { |
︙ | ︙ | |||
743 744 745 746 747 748 749 | $b br $block($tgt) } } "jumpTrue" { lassign $l opcode tgt src set name [my LocalVarName $src] set tgt [lindex $tgt 1] | | | | | | 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 | $b br $block($tgt) } } "jumpTrue" { lassign $l opcode tgt src set name [my LocalVarName $src] set tgt [lindex $tgt 1] set mth isTrue([my ValueTypes $src]) set test [$b $mth [my LoadOrLiteral $src] test_$name] $b condBr $test $block($tgt) $ipath($pc) } "jumpFalse" { lassign $l opcode tgt src set name [my LocalVarName $src] set tgt [lindex $tgt 1] set mth isTrue([my ValueTypes $src]) set test [$b $mth [my LoadOrLiteral $src] test_$name] $b condBr $test $ipath($pc) $block($tgt) } "jump" { $b br $block([lindex $l 1 1]) } "return" { lassign $l opcode -> frame src |
︙ | ︙ |
Changes to codegen/mathlib.tcl.
︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 | variable tcl.div tcl.div.32 tcl.div.64 tcl.div.double tcl.mod variable tcl.shr tcl.and tcl.or tcl.xor variable tcl.eq tcl.ne tcl.lt tcl.le tcl.gt tcl.ge variable tcl.not tcl.neg tcl_div variable tcl.land tcl.land.double tcl.lor tcl.lor.double variable tcl.add.numeric tcl.sub.numeric tcl.mult.numeric tcl.div.numeric variable tcl.pow.numeric tcl.land.numeric tcl.lor.numeric tcl.not.numeric variable tcl.neg.numeric tcl.eq.numeric tcl.ne.numeric tcl.lt.numeric variable tcl.le.numeric tcl.gt.numeric tcl.ge.numeric | > > | > > | > | > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | variable tcl.div tcl.div.32 tcl.div.64 tcl.div.double tcl.mod variable tcl.shr tcl.and tcl.or tcl.xor variable tcl.eq tcl.ne tcl.lt tcl.le tcl.gt tcl.ge variable tcl.not tcl.neg tcl_div variable tcl.land tcl.land.double tcl.lor tcl.lor.double variable tcl.add.numeric tcl.sub.numeric tcl.mult.numeric tcl.div.numeric variable tcl.pow.numeric tcl.land.numeric tcl.lor.numeric tcl.not.numeric variable tcl.not.numericOrBoolean variable tcl.neg.numeric tcl.eq.numeric tcl.ne.numeric tcl.lt.numeric variable tcl.le.numeric tcl.gt.numeric tcl.ge.numeric variable tcl.isBoolean tcl.isInteger tcl.isDouble variable tcl.isNumeric tcl.isNumericOrBoolean variable tcl.isTrue.numerc tcl.isTrue.numericOrBoolean variable tcl.isZeroOneBoolean variable tcl.extractNumeric tcl.extractNumericOrBoolean variable tcl.extractDouble tcl.extractInteger variable tcl.stringify.double tcl.stringify.int variable tcl.stringify.numeric variable tcl.cmp.strstr tcl.cmp.strnum # Builder:GrowingBinaryFunction -- # # Generate a function that implements a (normal) mathematical operator # that can increase the width of its result relative to the width of its # input values. Only called from @supportFunctions method. |
︙ | ︙ | |||
654 655 656 657 658 659 660 661 662 663 664 665 666 667 | build { my condBr [my isNumericInt $value] $intNot $dblNot label intNot "int.not" my ret [my not(INT) [my numeric.int $value] [my null int]] label dblNot "double.not" my ret [my not(DOUBLE) [my numeric.double $value] [my null int]] } ##### Function tcl.neg.numeric ##### # # Type signature: x:NUMERIC -> NUMERIC # # Quadcode implementation ('neg'). # | > > > > > > > > > > > > > > > > > > > > > > > | 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 | build { my condBr [my isNumericInt $value] $intNot $dblNot label intNot "int.not" my ret [my not(INT) [my numeric.int $value] [my null int]] label dblNot "double.not" my ret [my not(DOUBLE) [my numeric.double $value] [my null int]] } ##### Function tcl.not.numericOrBoolean ##### # # Type signature: x:NUMERIC\040BOOLEAN -> ZEROONE # # Quadcode implementation ('not') # # Logical negation of 'x'. set f [$m local "tcl.not.numericOrBoolean" "ZEROONE<-NUMERIC BOOLEAN" \ readonly] params value build { my switch [my getNumericBooleanKind $value] \ $boolNot 0 $intNot 1 $dblNot label intNot "int.not" my ret [my not(INT) [my numericOrBoolean.int $value] [my null int]] label dblNot "double.not" my ret [my not(DOUBLE) [my numericOrBoolean.double $value] \ [my null int]] label boolNot "bool.not" my ret [my not [my numericOrBoolean.bool $value]] } ##### Function tcl.neg.numeric ##### # # Type signature: x:NUMERIC -> NUMERIC # # Quadcode implementation ('neg'). # |
︙ | ︙ | |||
1189 1190 1191 1192 1193 1194 1195 | my condBr [my isNumericInt $value] $int $double label int "op.int" my ret [my Call tcl.stringify.int [my numeric.int $value]] label double "op.double" my ret [my Call tcl.stringify.double [my numeric.double $value]] } | > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > | 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 | my condBr [my isNumericInt $value] $int $double label int "op.int" my ret [my Call tcl.stringify.int [my numeric.int $value]] label double "op.double" my ret [my Call tcl.stringify.double [my numeric.double $value]] } ##### tcl.stringify.numericOrBoolean ##### # # Type signature: value:NUMERIC BOOLEAN -> STRING # # Convert 'value' to a zero-refcount string (Tcl_Obj) # # Notes: # It is puzzling why this needs to happen; somewhere # someone wants one of these stringified and doesn't # have the string rep already? # TODO - Fill this in if it's actually needed? } method @numericConverterFunctions {api} { ##### Function tcl.impl.isBoolean ##### ##### Closure Build:isBoolean ##### # # Type signature objPtr:STRING -> int1 # # Tests if a STRING is already a wrapped Boolean word # (true/false, yes/no, on/off) set f [$m local "tcl.impl.isBoolean" int1<-STRING readonly] params objPtr build { nonnull $objPtr set boolType [$api tclBooleanType] set type [my dereference $objPtr 0 Tcl_Obj.typePtr] my ret [my and [my nonnull $type] [my eq $boolType $type]] } my closure isBoolean {STRING {name ""}} { my call ${tcl.impl.isBoolean} [list $STRING] $name } ##### Function tcl.impl.isDouble ##### ##### Closure Build:isDouble ##### # # Type signature: objPtr:STRING -> int1 # # Test if a STRING is actually already a wrapped double. |
︙ | ︙ | |||
1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 | set b2 [$api Tcl_GetString $value] SetValueName $b2 "bytes" my br $get label get: set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"] my ret [my eq [my dereference $bytes 0] [Const 0 int8]] } ##### Function tcl.isNumeric ##### # # Type signature: value:STRING -> ZEROONE # # Tests if a STRING can be parsed as a NUMERIC. Part of the # implementation of quadcode "instanceOf". | > | 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 | set b2 [$api Tcl_GetString $value] SetValueName $b2 "bytes" my br $get label get: set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"] my ret [my eq [my dereference $bytes 0] [Const 0 int8]] } ##### Function tcl.isNumeric ##### # # Type signature: value:STRING -> ZEROONE # # Tests if a STRING can be parsed as a NUMERIC. Part of the # implementation of quadcode "instanceOf". |
︙ | ︙ | |||
1277 1278 1279 1280 1281 1282 1283 | my condBr [my isInteger $value] $yes $checkEmptyOK label checkEmptyOK: my condBr $emptyOK $checkEmpty $checkDouble label checkEmpty: my condBr [my Call tcl.impl.strempty $value] $yes $checkDouble label checkDouble: set d [my GetDouble $value] | > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > | > > > > | | | | 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 | my condBr [my isInteger $value] $yes $checkEmptyOK label checkEmptyOK: my condBr $emptyOK $checkEmpty $checkDouble label checkEmpty: my condBr [my Call tcl.impl.strempty $value] $yes $checkDouble label checkDouble: set d [my GetDouble $value] my ret [my extract $d 0] label yes: my ret [Const true bool] } ##### Function: tcl.isNumericOrBoolean ##### # # Type signature: value:STRING -> ZEROONE # # Tests if a STRING can be parsed as either a NUMERIC or BOOLEAN # (and hence might be an argument to commands like 'if'). Part of # the implementation of quadcode 'instanceOf'. set f [$m local "tcl.isNumericOrBoolean" ZEROONE<-STRING] params value build { nonnull $value my condBr [my nonnull [my dereference $value 0 Tcl_Obj.typePtr]] \ $checkTypes $getDouble label checkTypes: my condBr [my isDouble $value] $yes $checkIntType label checkIntType: my condBr [my isInteger $value] $yes $checkBooleanType label checkBooleanType: my condBr [my isBoolean $value] $yes $getDouble label getDouble: set d [my GetDouble $value] my condBr [my extract $d 0] $yes $getBool label getBool: set b [my GetBoolean $value] my ret [my extract $b 0] label yes: my ret [Const true bool] } ##### Function tcl.isBoolean ##### # # Type signature: value:STRING->ZEROONE # # Tests if a STRING can be parsed as a BOOLEAN. Part of the # implementation of quadcodes 'instanceOf' and 'isBoolean'. set f [$m local "tcl.isBoolean" ZEROONE<-STRING,ZEROONE] params value emptyOK build { nonnull $value my condBr [my isBoolean $value] $yes $checkEmptyOK label checkEmptyOK: my condBr $emptyOK $checkEmpty $getBoolean label checkEmpty: my condBr [my Call ${tcl.impl.strempty} $value] $yes $getBoolean label getBoolean: set bv [my GetBoolean $value] my ret [my extract $bv 0] label yes: my ret [Const true bool] } ##### Function tcl.isDouble ##### # # Type signature: value:STRING -> ZEROONE # # Tests if a STRING can be parsed as a DOUBLE. Part of the # implementation of quadcode "instanceOf". set f [$m local "tcl.isDouble" ZEROONE<-STRING,ZEROONE] params value emptyOK build { nonnull $value my condBr [my isDouble $value] $yes $checkEmptyOK label checkEmptyOK: my condBr $emptyOK $checkEmpty $checkDouble label checkEmpty: my condBr [my Call ${tcl.impl.strempty} $value] $yes $checkDouble label checkDouble: set d [my GetDouble $value] my ret [my extract $d 0] label yes: my ret [Const true bool] } |
︙ | ︙ | |||
1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | my condBr [my Call tcl.impl.strempty $value] $yes $checkInt label checkInt: set i [my GetWide $value] my ret [my extract $i 0] label yes: my ret [Const true bool] } ##### Function tcl.extractNumeric ##### # # Type signature: value:STRING -> NUMERIC # # Parse a STRING as a NUMERIC; the value is known to be parseable. # Part of the implementation of quadcode "narrowToType". | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 | my condBr [my Call tcl.impl.strempty $value] $yes $checkInt label checkInt: set i [my GetWide $value] my ret [my extract $i 0] label yes: my ret [Const true bool] } ##### Function tcl.isZeroOneBoolean ##### # # Type signature: value:STRING -> ZEROONE # # Tests if a STRING can be parsed as a ZEROONE BOOLEAN. Part of the # implementation of quadcode "instanceOf" set f [$m local "tcl.isZeroOneBoolean" ZEROONE<-STRING,ZEROONE] params value emptyOK build { nonnull $value my br $checkInt label checkInt: my condBr [my isInteger $value] $checkZeroOne $checkEmptyOK label checkZeroOne: set gw [my GetWide $value] my condBr [my extract $gw 0] $testZeroOne $no label testZeroOne: set val [my extract $gw 1] my switch $val $no 0 $yes 1 $yes label checkEmptyOK: my condBr $emptyOK $checkEmpty $tryGetBoolean label checkEmpty: my condBr [my Call tcl.impl.strempty $value] $yes $tryGetBoolean label tryGetBoolean: set i [my GetBoolean $value] my condBr [my extract $i 0] $yes $tryGetInt label tryGetInt: set i [my GetWide $value] my condBr [my extract $i 0] $no $checkZeroOne label yes: my ret [Const true bool] label no: my ret [Const false bool] } ##### Function tcl.extractNumeric ##### # # Type signature: value:STRING -> NUMERIC # # Parse a STRING as a NUMERIC; the value is known to be parseable. # Part of the implementation of quadcode "narrowToType". |
︙ | ︙ | |||
1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 | label returnDouble: my ret [my packNumericDouble [my extract $d 1]] label extractInt: set i [my GetWide $value] my ret [my packNumericInt [my packInt64 [my extract $i 1]]] } ##### Function tcl.extractDouble ##### # # Type signature: value:STRING -> DOUBLE # # Parse a STRING as a DOUBLE; the value is known to be parseable. # Part of the implementation of quadcode "narrowToType". | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 | label returnDouble: my ret [my packNumericDouble [my extract $d 1]] label extractInt: set i [my GetWide $value] my ret [my packNumericInt [my packInt64 [my extract $i 1]]] } ##### Function: tcl.extractNumericOrBoolean ##### # # Type signature: value:STRING -> NUMERIC BOOLEAN # # Parse a STRING as a NUMERIC or Boolean; the value is known to # be parsable. Part of the implementation of quadcode 'narrowToType'. set f [$m local "tcl.extractNumericOrBoolean" "NUMERIC BOOLEAN<-STRING"] params value build { nonnull $value my br $testType label testType: set type [my dereference $value 0 Tcl_Obj.typePtr] my condBr [my nonnull $type] $testIsInt $testIsBoolean label testIsInt: my condBr [my isInteger $value] $returnInt $testIsDouble label returnInt: set i [my GetWide $value] my ret [my packNumericOrBooleanInt [my packInt64 [my extract $i 1]]] label testIsDouble: my condBr [my isDouble $value] $returnDouble $testIsBoolean label returnDouble: set d [my GetDouble $value] my ret [my packNumericOrBooleanDouble [my extract $d 1]] label testIsBoolean: set b [my GetBoolean $value] my condBr [my extract $b 0] $returnBoolean $getDouble label returnBoolean: my ret [my packNumericOrBooleanBoolean [my extract $b 1]] label getDouble: set i [my GetDouble $value] my br $testType } ##### Function tcl.extractDouble ##### # # Type signature: value:STRING -> DOUBLE # # Parse a STRING as a DOUBLE; the value is known to be parseable. # Part of the implementation of quadcode "narrowToType". |
︙ | ︙ | |||
1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 | set f [$m local "tcl.extractInteger" INT<-STRING] params value build { nonnull $value my ret [my packInt64 [my extract [my GetWide $value] 1]] } ##### Function tcl.cmp.strstr ##### # # Type signature: value1Ptr:STRING * value2Ptr:STRING -> int # # Returns the relationship between the two string arguments where # numeric comparisons are preferred; -1 if 'value1Ptr' precedes in # standard ordering, 1 if 'value2Ptr' precedes, and 0 if they are | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 | set f [$m local "tcl.extractInteger" INT<-STRING] params value build { nonnull $value my ret [my packInt64 [my extract [my GetWide $value] 1]] } ##### Function: tcl.isTrue.numeric ##### # # Type signature: value:STRING->ZEROONE # # Determines whether a given NUMERIC value represents a value # that will cause 'jumpTrue' to jump. Part of the implementation # of quadcodes 'jumpTrue' and 'jumpFalse' set f [$m local "tcl.isTrue.numeric" ZEROONE<-NUMERIC] params value build { my condBr [my isNumericInt $value] $doInteger $doDouble label doInteger: my ret [my neq(INT,INT) [my numeric.int $value] [my int 0]] label doDouble: my ret [my neq(DOUBLE,DOUBLE) \ [my numericOrBoolean.double $value] [Const 0.0 double]] } ##### Function: tcl.isTrue.numericOrBoolean ##### # # Type signature: value:STRING->ZEROONE # # Determines whether a given NUMERIC BOOLEAN value represents a value # that will cause 'jumpTrue' to jump. Part of the implementation # of quadcodes 'jumpTrue' and 'jumpFalse' set f [$m local "tcl.isTrue.numericOrBoolean" \ {ZEROONE<-NUMERIC BOOLEAN}] params value build { my switch [my getNumericBooleanKind $value] \ $doBoolean 0 $doInteger 1 $doDouble label doBoolean: my ret [my numericOrBoolean.bool $value] label doInteger: my ret [my neq(INT,INT) [my numericOrBoolean.int $value] [my int 0]] label doDouble: my ret [my neq(DOUBLE,DOUBLE) \ [my numericOrBoolean.double $value] [Const 0.0 double]] } ##### Function tcl.cmp.strstr ##### # # Type signature: value1Ptr:STRING * value2Ptr:STRING -> int # # Returns the relationship between the two string arguments where # numeric comparisons are preferred; -1 if 'value1Ptr' precedes in # standard ordering, 1 if 'value2Ptr' precedes, and 0 if they are |
︙ | ︙ |
Changes to codegen/stdlib.tcl.
︙ | ︙ | |||
201 202 203 204 205 206 207 208 209 210 211 212 213 214 | label decr "action.required" set value [my unmaybe $value "objPtr"] $api Tcl_DecrRefCount $value my ret label nothing "nothing.to.do" my ret } ##### tcl.addNExistReference ##### # # Type signature: objPtr:Tcl_Obj*! -> void # # Increment the reference count of a Tcl_Obj reference if the # object is supplied | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | label decr "action.required" set value [my unmaybe $value "objPtr"] $api Tcl_DecrRefCount $value my ret label nothing "nothing.to.do" my ret } ##### tcl.maybeAddReference ##### # # Type signature: maybe:bool,objPtr:Tcl_Obj* -> void # # Increment the reference count of a Tcl_Obj if the # object exists. set f [$m local "tcl.maybeAddReference" void<-bool,Tcl_Obj*] params maybe value build { my condBr $maybe $nothing $incr label incr "action.required" $api Tcl_IncrRefCount $value my ret label nothing "nothing.to.do" my ret } my closure impure.maybeAddReference {maybe value} { my call ${tcl.maybeAddReference} [list $maybe $value] } ##### tcl.maybeDropReference ##### # # Type signature: maybe:bool,objPtr:Tcl_Obj* -> void # # Decrement the reference count of a Tcl_Obj if the # object exists. set f [$m local "tcl.maybeDropReference" void<-bool,Tcl_Obj*] params maybe value build { my condBr $maybe $nothing $decr label decr "action.required" $api Tcl_DecrRefCount $value my ret label nothing "nothing.to.do" my ret } my closure impure.maybeDropReference {maybe value} { my call ${tcl.maybeDropReference} [list $maybe $value] } ##### tcl.addNExistReference ##### # # Type signature: objPtr:Tcl_Obj*! -> void # # Increment the reference count of a Tcl_Obj reference if the # object is supplied |
︙ | ︙ | |||
650 651 652 653 654 655 656 657 658 659 660 661 662 663 | set strType [$api tclStringType] set type [my dereference $objPtr 0 Tcl_Obj.typePtr] my ret [my eq $type $strType] } my closure isUnicodeString {STRING {name ""}} { my call ${tcl.isUnicodeString} [list $STRING] $name } ##### Function tcl.impl.getDouble ##### ##### MAPPED CALL TO METHOD: Build:GetDouble ##### # # Type signature: valueObj:STRING -> int * int8[] # # Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API | > > > > > > > > > > > > > > > > > > > > > > > > | 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 | set strType [$api tclStringType] set type [my dereference $objPtr 0 Tcl_Obj.typePtr] my ret [my eq $type $strType] } my closure isUnicodeString {STRING {name ""}} { my call ${tcl.isUnicodeString} [list $STRING] $name } ##### Function tcl.impl.getBoolean ##### ##### MAPPED CALL TO METHOD: Build:GetBoolean ##### # # Type signature: valueObj:STRING -> int1*int1 set f [$m local "tcl.impl.getBoolean" struct{int1,int1}<-STRING] params valueObj build { nonnull $valueObj set boolVar [my alloc int32 "boolPtr"] set str [$api Tcl_GetString $valueObj] set code [$api Tcl_GetBooleanFromObj {} $valueObj $boolVar] set res [my undef struct{int1,int1}] set res [my insert $res [my eq $code [Const 0]] 0] set res \ [my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1] my ret $res } my closure GetBoolean {valueObj} { my call ${tcl.impl.getBoolean} [list $valueObj] "result" } unset -nocomplain valueObj ##### Function tcl.impl.getDouble ##### ##### MAPPED CALL TO METHOD: Build:GetDouble ##### # # Type signature: valueObj:STRING -> int * int8[] # # Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API |
︙ | ︙ | |||
4211 4212 4213 4214 4215 4216 4217 | ##### Function tcl.booleanTest ##### # # Type signature: objPtr:Tcl_Obj* -> ZEROONE # # Part of quadcode implementation ('isBoolean') # | | > | 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 | ##### Function tcl.booleanTest ##### # # Type signature: objPtr:Tcl_Obj* -> ZEROONE # # Part of quadcode implementation ('isBoolean') # # Returns whether the string 'objPtr' is a Boolean bareword set f [$m local "tcl.booleanTest" ZEROONE<-Tcl_Obj*] params objPtr build { nonnull $objPtr set NULL [my null Interp*] set code [my setFromAny [$api tclBooleanType] $NULL $objPtr] my ret [my eq $code $0] } ##### Function tcl.invoke.command ##### # # Type signature: objc:int * objv:STRING* * ecvar:int* -> STRING? # # Calls the Tcl interpreter to invoke a Tcl command, and packs the # result into a STRING FAIL. |
︙ | ︙ |
Changes to codegen/struct.tcl.
︙ | ︙ | |||
679 680 681 682 683 684 685 686 687 688 689 690 691 692 | # # Results: # None. method InitTclTypes {} { # WARNING: int type may need to be larger on some platforms! Type NUMERIC; # Make sure we get this early, just in case # Debug-world delegates for the basic types DBTY void <- void void "void" DBTY ptr <- ClientData pointer "ClientData" $void DBTY chr <- char int "char" 8 DBTY chrs <- char* pointer "char*" $chr DBTY i16 <- int16 int "Tcl_UniChar" 16 | > | 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 | # # Results: # None. method InitTclTypes {} { # WARNING: int type may need to be larger on some platforms! Type NUMERIC; # Make sure we get this early, just in case Type "NUMERIC BOOLEAN" # Debug-world delegates for the basic types DBTY void <- void void "void" DBTY ptr <- ClientData pointer "ClientData" $void DBTY chr <- char int "char" 8 DBTY chrs <- char* pointer "char*" $chr DBTY i16 <- int16 int "Tcl_UniChar" 16 |
︙ | ︙ | |||
1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 | i32:int32 i64:int64 } struct NUMERIC { kind:bool int:INT double:double } struct FOREACH { val:int max:int } struct DICTFOR { search:DictSearch | > > > > > > | 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 | i32:int32 i64:int64 } struct NUMERIC { kind:bool int:INT double:double } struct NUMERIC_BOOLEAN { kind:int3 int:INT double:double bool:bool } struct FOREACH { val:int max:int } struct DICTFOR { search:DictSearch |
︙ | ︙ | |||
1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 | foreach {ty rt1} { i32 int32 i64 int64 ZON ZEROONE INT INT DBL DOUBLE NUMERIC NUMERIC STR STRING ARY ARRAY ASTR ARRAYSTRING } { upvar 0 $ty t set rt [linsert $rt1 0 IMPURE] DBTY impure <- $rt struct <$rt1> $Obj $t | > | 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 | foreach {ty rt1} { i32 int32 i64 int64 ZON ZEROONE INT INT DBL DOUBLE NUMERIC NUMERIC NUMERIC_BOOLEAN "NUMERIC BOOLEAN" STR STRING ARY ARRAY ASTR ARRAYSTRING } { upvar 0 $ty t set rt [linsert $rt1 0 IMPURE] DBTY impure <- $rt struct <$rt1> $Obj $t |
︙ | ︙ | |||
2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 | } {INT DOUBLE} { append body2 { [my cast(DOUBLE) $} [lindex $f 0] { cast]} } {{INT BOOLEAN} NUMERIC} { append body2 { [my packNumericInt $} [lindex $f 0] { cast]} } {ZEROONE NUMERIC} { append body2 { [my packNumericInt [my cast(BOOLEAN) $} [lindex $f 0] { cast]]} } {INT NUMERIC} { append body2 { [my packNumericInt $} [lindex $f 0] { cast]} } {DOUBLE NUMERIC} { append body2 { [my packNumericDouble $} [lindex $f 0] { cast]} } {{ZEROONE BOOLEAN} ZEROONE} { append body2 { $} [lindex $f 0] } {{ZEROONE BOOLEAN} STRING} { set var [lindex $f 0] append body1 ";" [string trim [subst -nocommands { lappend {string casts} [set $var [my {stringify($t)} $$var]] | > > > > > > > > > > > > > > > > | 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 | } {INT DOUBLE} { append body2 { [my cast(DOUBLE) $} [lindex $f 0] { cast]} } {{INT BOOLEAN} NUMERIC} { append body2 { [my packNumericInt $} [lindex $f 0] { cast]} } {{INT BOOLEAN} {NUMERIC BOOLEAN}} { append body2 { [my packNumericOrBooleanInt $} [lindex $f 0] { cast]} } {ZEROONE NUMERIC} { append body2 { [my packNumericInt [my cast(BOOLEAN) $} [lindex $f 0] { cast]]} } {ZEROONE {NUMERIC BOOLEAN}} { append body2 { [my packNumericOrBooleanInt $} [lindex $f 0] { cast]} } {INT NUMERIC} { append body2 { [my packNumericInt $} [lindex $f 0] { cast]} } {INT {NUMERIC BOOLEAN}} { append body2 { [my packNumericOrBooleanInt $} [lindex $f 0] { cast]} } {DOUBLE NUMERIC} { append body2 { [my packNumericDouble $} [lindex $f 0] { cast]} } {DOUBLE {NUMERIC BOOLEAN}} { append body2 { [my packNumericOrBooleanDouble $} [lindex $f 0] { cast]} } {BOOLEAN {NUMERIC BOOLEAN}} { append body2 { [my packNumericOrBooleanBoolean $} [lindex $f 0] { cast]} } {{ZEROONE BOOLEAN} ZEROONE} { append body2 { $} [lindex $f 0] } {{ZEROONE BOOLEAN} STRING} { set var [lindex $f 0] append body1 ";" [string trim [subst -nocommands { lappend {string casts} [set $var [my {stringify($t)} $$var]] |
︙ | ︙ | |||
2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 | set var [lindex $f 0] append body1 ";" [string trim [subst -nocommands { lappend {string casts} [set $var [my {stringify($t)} $$var]] my addReference(STRING) $$var }]] append body2 { $} [lindex $f 0] } {EMPTY STRING} { append body2 { $} [lindex $f 0] } {{IMPURE ZEROONE} {IMPURE INT}} { append body2 [format { [my upcastImpure.INT(ZEROONE) $%s]} [lindex $f 0]] } {{IMPURE ZEROONE} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC(ZEROONE) $%s]} [lindex $f 0]] } {{IMPURE INT} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC(INT) $%s]} [lindex $f 0]] } {{IMPURE DOUBLE} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC(DOUBLE) $%s]} [lindex $f 0]] } {NOTHING STRING} { append body2 { [my undef STRING]} } {{EXPANDED STRING} STRING} { append body2 { $} [lindex $f 0] } {{EXPANDED INT} INT} { append body2 { $} [lindex $f 0] } {{EXPANDED DOUBLE} DOUBLE} { append body2 { $} [lindex $f 0] } {{EXPANDED NUMERIC} NUMERIC} { append body2 { $} [lindex $f 0] } } foreach type { BOOLEAN ZEROONE {ZEROONE BOOLEAN} INT {INT BOOLEAN} DOUBLE NUMERIC } { set impureType [linsert $type 0 IMPURE] dict set TypeConversions [list $type $impureType] [string trim \ [string map [list @type $type] { set var [lindex $f 0] append body2 { [my {packImpure(@type)} $} $var {]} | > > > > > > > > > > > > > > > > > > > > > > > > | 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 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 2754 2755 2756 2757 2758 2759 2760 2761 2762 | set var [lindex $f 0] append body1 ";" [string trim [subst -nocommands { lappend {string casts} [set $var [my {stringify($t)} $$var]] my addReference(STRING) $$var }]] append body2 { $} [lindex $f 0] } {{NUMERIC BOOLEAN} STRING} { set var [lindex $f 0] append body1 ";" [string trim [subst -nocommands { lappend {string casts} [set $var [my {stringify($t)} $$var]] my addReference(STRING) $$var }]] append body2 { $} [lindex $f 0] } {EMPTY STRING} { append body2 { $} [lindex $f 0] } {{IMPURE ZEROONE} {IMPURE INT}} { append body2 [format { [my upcastImpure.INT(ZEROONE) $%s]} [lindex $f 0]] } {{IMPURE ZEROONE} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC(ZEROONE) $%s]} [lindex $f 0]] } {{IMPURE INT} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC(INT) $%s]} [lindex $f 0]] } {{IMPURE DOUBLE} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC(DOUBLE) $%s]} [lindex $f 0]] } {{IMPURE ZEROONE} {IMPURE {NUMERIC BOOLEAN}}} { append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(ZEROONE) $%s]} [lindex $f 0]] } {{IMPURE INT} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(INT) $%s]} [lindex $f 0]] } {{IMPURE DOUBLE} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(DOUBLE) $%s]} [lindex $f 0]] } {{IMPURE BOOLEAN} {IMPURE NUMERIC}} { append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(BOOLEAN) $%s]} [lindex $f 0]] } {NOTHING STRING} { append body2 { [my undef STRING]} } {{EXPANDED STRING} STRING} { append body2 { $} [lindex $f 0] } {{EXPANDED INT} INT} { append body2 { $} [lindex $f 0] } {{EXPANDED DOUBLE} DOUBLE} { append body2 { $} [lindex $f 0] } {{EXPANDED NUMERIC} NUMERIC} { append body2 { $} [lindex $f 0] } {{EXPANDED {NUMERIC BOOLEAN}} {NUMERIC BOOLEAN}} { append body2 { $} [lindex $f 0] } } foreach type { BOOLEAN ZEROONE {ZEROONE BOOLEAN} INT {INT BOOLEAN} DOUBLE NUMERIC {NUMERIC BOOLEAN} } { set impureType [linsert $type 0 IMPURE] dict set TypeConversions [list $type $impureType] [string trim \ [string map [list @type $type] { set var [lindex $f 0] append body2 { [my {packImpure(@type)} $} $var {]} |
︙ | ︙ | |||
2766 2767 2768 2769 2770 2771 2772 | # FOLLOWS STANDARD TclOO PROTOCOL # # Side effects: # May create a method. May perform a tailcall (beware if attempting to # wrap with a filter!) method unknown {methodName args} { | | > > > > > > > > > > | | < < < < < < > | 2814 2815 2816 2817 2818 2819 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 2846 2847 2848 2849 2850 2851 2852 2853 | # FOLLOWS STANDARD TclOO PROTOCOL # # Side effects: # May create a method. May perform a tailcall (beware if attempting to # wrap with a filter!) method unknown {methodName args} { if {[regexp {^addReference\(FAIL[ _]IMPURE (.*)\)$} \ $methodName -> utype]} { oo::objdefine [self] method $methodName {value} \ [string map [list @utype $utype] { set sval [my impure.string [my unmaybe $value]] my impure.maybeAddReference [my maybe $value] $sval }] tailcall my $methodName {*}$args } elseif {[regexp {^dropReference\(FAIL[ _]IMPURE[ _](.*)\)$} \ $methodName -> utype]} { oo::objdefine [self] method $methodName {value} \ [string map [list @utype $utype] { my select [my maybe $value] \ [Const false bool] \ [my addReference(STRING) \ [my impure.string [my unmaybe $value]]] }] tailcall my $methodName {*}$args } elseif {[regexp {^addReference\(IMPURE[ _](.*)\)$} \ $methodName -> utype]} { oo::objdefine [self] method $methodName {value} \ [string map [list @utype $utype] { my addReference(STRING) [my impure.string $value] }] tailcall my $methodName {*}$args } elseif {[regexp {^dropReference\(IMPURE[ _](.*)\)$} $methodName \ -> utype]} { oo::objdefine [self] method $methodName {value} \ [string map [list @utype $utype] { my dropReference(STRING) [my impure.string $value] # How to determine whether the underlying type is # itself a reference type? (Maybe never?) |
︙ | ︙ |
Changes to codegen/tclapi.tcl.
︙ | ︙ | |||
2368 2369 2370 2371 2372 2373 2374 | # Special "constants" my buildInSection APIvar { my APIVar tclIntType \ [set it [my Tcl_GetObjType [$b constString "int" "type.int"]]] my APIVar tclDoubleType \ [my Tcl_GetObjType [$b constString "double" "type.double"]] my APIVar tclBooleanType \ | | | 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 | # Special "constants" my buildInSection APIvar { my APIVar tclIntType \ [set it [my Tcl_GetObjType [$b constString "int" "type.int"]]] my APIVar tclDoubleType \ [my Tcl_GetObjType [$b constString "double" "type.double"]] my APIVar tclBooleanType \ [my Tcl_GetObjType [$b constString "booleanString" type.boolean"]] my APIVar tclByteArrayType \ [my Tcl_GetObjType [$b constString "bytearray" "type.bytes"]] my APIVar tclStringType \ [my Tcl_GetObjType [$b constString "string" "type.string"]] set wt [my Tcl_GetObjType [$b constString "wideInt" "type.wide"]] my APIVar tclWideIntType [$b select [$b nonnull $wt] $wt $it] my APIVar tclListType \ |
︙ | ︙ |
Changes to codegen/tycon.tcl.
︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # The actual flag values to use in the INT type variable INT.type.32bit 0 variable INT.type.64bit 1 # The actual flag values to use in the NUMERIC type variable NUMERIC.type.int 0 variable NUMERIC.type.double 1 # Named structure types need to be only created once variable NamedTypeCache {} variable NamedTypeCacheAhead {} # LLVM::Const -- # | > > > > > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # The actual flag values to use in the INT type variable INT.type.32bit 0 variable INT.type.64bit 1 # The actual flag values to use in the NUMERIC type variable NUMERIC.type.int 0 variable NUMERIC.type.double 1 # The actual flag values to use in the NUMERIC_BOOLEAN type variable NUMERIC_BOOLEAN.type.int 0 variable NUMERIC_BOOLEAN.type.double 1 variable NUMERIC_BOOLEAN.type.bool 2 # Named structure types need to be only created once variable NamedTypeCache {} variable NamedTypeCacheAhead {} # LLVM::Const -- # |
︙ | ︙ | |||
176 177 178 179 180 181 182 183 184 185 186 187 188 189 | } "^EXPANDED (.*)$" { return [Type [lindex $m 1]] } ^NUMERIC$ { return [Type named{NUMERIC,kind:int1,int:INT,double:DOUBLE}] } ^FOREACH$ { return [Type named{FOREACH,val:int,max:int}] } ^DICTITER$ { return [Type "named{DICTFOR, search:DictSearch, dict:STRING, | > > > | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | } "^EXPANDED (.*)$" { return [Type [lindex $m 1]] } ^NUMERIC$ { return [Type named{NUMERIC,kind:int1,int:INT,double:DOUBLE}] } "^NUMERIC BOOLEAN$" { return [Type named{NUMERIC_BOOLEAN,kind:int3,int:INT,double:DOUBLE,bool:bool}] } ^FOREACH$ { return [Type named{FOREACH,val:int,max:int}] } ^DICTITER$ { return [Type "named{DICTFOR, search:DictSearch, dict:STRING, |
︙ | ︙ |
Changes to demos/perftest/tester.tcl.
︙ | ︙ | |||
612 613 614 615 616 617 618 619 620 621 622 623 624 625 | return $result } proc concatenater {x} { set x [expr {int($x)}] concat [expr {$x - 1}] $x [expr {$x + 1.5}] "ok" } proc booltest {val} { set res {} if {[string is boolean -strict $val]} { lappend res ok } lappend res [string is boolean $val] | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | return $result } proc concatenater {x} { set x [expr {int($x)}] concat [expr {$x - 1}] $x [expr {$x + 1.5}] "ok" } proc nottest {val} { expr {!$val} } proc iftest {val} { if {$val} {return yes} {return no} } proc landtest {val} { expr {$val && $val} # Tcl 8.7 does not generate INST_LAND except when the bytecode assembler # requests it. If we wanted to test INST_LAND, we'd need a sequence like # # tcl::unsupported::assemble { # load val # load val # land # } } proc lortest {val} { expr {$val || $val} # Tcl 8.7 does not generate INST_LOR except when the bytecode assembler # requests it. If we wanted to test INST_LOR, we'd need a sequence like # # tcl::unsupported::assemble { # load val # load val # lor # } # # But that's not implemented in the code generator, and there's no # really good reason to implement it, since Tcl doesn't use it. } proc booltest {val} { set res {} if {[string is boolean -strict $val]} { lappend res ok } lappend res [string is boolean $val] |
︙ | ︙ | |||
1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 | {cmptest2 0e0 0x0} {trimtest ABCDABC} {trimtest DABCABCD} {casetest aBcDe} {strclasstest abc123} {strclasstest abc-123} {concatenater 7} {list [booltest on] [booltest no] [booltest ""] [booltest fruitbat]} {stristest ""} {stristest x} {stristest 0} {stristest 1.2} {stristest 0xAB} # List operations (also see some [try] tests) | > > > > > > > > > > > > > > > > > > > > > > > > > > | 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 | {cmptest2 0e0 0x0} {trimtest ABCDABC} {trimtest DABCABCD} {casetest aBcDe} {strclasstest abc123} {strclasstest abc-123} {concatenater 7} {nottest 1} {nottest 0} {nottest 2.0} {nottest true} {list [catch {nottest fruitbat} stat] $stat} {iftest yes} {iftest no} {iftest 1} {iftest 0} {iftest 0.0} {iftest 2.0} {list [catch {iftest fruitbat} stat] $stat} {landtest yes} {landtest no} {landtest 1} {landtest 0} {landtest 2.0} {landtest 0.0} {list [catch {landtest fruitbat} stat] $stat} {lortest yes} {lortest no} {lortest 1} {lortest 0} {lortest 2.0} {lortest 0.0} {list [catch {lortest fruitbat} stat] $stat} {list [booltest on] [booltest no] [booltest ""] [booltest fruitbat]} {stristest ""} {stristest x} {stristest 0} {stristest 1.2} {stristest 0xAB} # List operations (also see some [try] tests) |
︙ | ︙ | |||
2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 | cmptest cmptest2 matchtest replacing replacing2 replacing3 strclasstest jumptable concatenater booltest stristest regsubtest # Failure handling, [subst], [try] wideretest substtest substtest2 | > > > > | 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 | cmptest cmptest2 matchtest replacing replacing2 replacing3 strclasstest jumptable concatenater nottest iftest landtest lortest booltest stristest regsubtest # Failure handling, [subst], [try] wideretest substtest substtest2 |
︙ | ︙ |
Changes to quadcode/abbreviate.tcl.
︙ | ︙ | |||
224 225 226 227 228 229 230 231 232 233 234 235 236 237 | } # quadcode::bytecodeAbbreviator1 -- # # Singleton instance of the bytecode abbreviator. quadcode::bytecodeAbbreviator create quadcode::bytecodeAbbreviator1 { stringIsIntStrict { numericType dup jumpFalse1 +5 push1 {literal 1} eq | > > > > > > | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 | } # quadcode::bytecodeAbbreviator1 -- # # Singleton instance of the bytecode abbreviator. quadcode::bytecodeAbbreviator create quadcode::bytecodeAbbreviator1 { stringIsBooleanStrict { tryCvtToBoolean reverse 2 pop } stringIsIntStrict { numericType dup jumpFalse1 +5 push1 {literal 1} eq |
︙ | ︙ | |||
254 255 256 257 258 259 260 261 262 263 264 265 266 267 | } stringIsDoubleStrict { numericType jumpTrue1 +6 push1 {literal 0} jump1 +4 push1 {literal 1} } stringIsInt { dup numericType dup | > > > > > > > > > > | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 | } stringIsDoubleStrict { numericType jumpTrue1 +6 push1 {literal 0} jump1 +4 push1 {literal 1} } stringIsBoolean { tryCvtToBoolean jumpTrue1 +7 push {literal {}} streq jump1 +5 pop push1 {literal 1} } stringIsInt { dup numericType dup |
︙ | ︙ |
Changes to quadcode/bytecode.tcl.
︙ | ︙ | |||
465 466 467 468 469 470 471 472 473 474 475 476 477 478 | reverse - storeScalar1 - storeScalar4 - strcaseLower - strcaseTitle - strcaseUpper - strclass - stringIsDouble - stringIsDoubleStrict - stringIsEntier - stringIsEntierStrict - stringIsInt - stringIsIntStrict - stringIsWide - | > > | 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 | reverse - storeScalar1 - storeScalar4 - strcaseLower - strcaseTitle - strcaseUpper - strclass - stringIsBoolean - stringIsBooleanStrict - stringIsDouble - stringIsDoubleStrict - stringIsEntier - stringIsEntierStrict - stringIsInt - stringIsIntStrict - stringIsWide - |
︙ | ︙ |
Changes to quadcode/specializer.tcl.
︙ | ︙ | |||
167 168 169 170 171 172 173 | } my debug-specializer { puts "REGISTER: $procName" } set s [catch { | < | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | } my debug-specializer { puts "REGISTER: $procName" } set s [catch { # Convert the procedure to quadcode and perform the initial # quadcode-to-quadcode transformations. Add the quadcode database to # the 'database' dictionary. set ns [namespace qualifiers $origin] set bytecode [tcl::unsupported::getbytecode proc $origin] set db [quadcode::transformer new \ -origin $origin \ |
︙ | ︙ |
Changes to quadcode/ssa.tcl.
︙ | ︙ | |||
265 266 267 268 269 270 271 | } # Find places to insert phi nodes set phis [lrepeat [llength $bbcontent] {}] dict for {v -} $global { if {[dict exists $writers $v]} { | > > > > > | | 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | } # Find places to insert phi nodes set phis [lrepeat [llength $bbcontent] {}] dict for {v -} $global { if {[dict exists $writers $v]} { if {[dict exists $writers $v]} { set w [dict keys [dict get $writers $v]] } else { set w {} } foreach n [my bbfrontier+ $w] { set list [lindex $phis $n] lset phis $n {} lappend list [list phi $v] lset phis $n $list } } } |
︙ | ︙ |
Changes to quadcode/translate.tcl.
︙ | ︙ | |||
195 196 197 198 199 200 201 202 203 204 205 206 207 208 | set v1 [list temp [incr depth -1]] set v0 [list temp [incr depth -1]] set r $v0 my quads [lindex $insn 0] $r $v0 $v1 } uplus - uminus - bitnot { # Unary ops set value [list temp [incr depth -1]] set r [list temp $depth] my generate-arith-domain-check $pc [lindex $insn 0] $value my quads purify {temp opd0} $value set op [lindex $insn 0] my quads $op $r {temp opd0} | > | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | set v1 [list temp [incr depth -1]] set v0 [list temp [incr depth -1]] set r $v0 my quads [lindex $insn 0] $r $v0 $v1 } uplus - uminus - not - bitnot { # Unary ops set value [list temp [incr depth -1]] set r [list temp $depth] my generate-arith-domain-check $pc [lindex $insn 0] $value my quads purify {temp opd0} $value set op [lindex $insn 0] my quads $op $r {temp opd0} |
︙ | ︙ | |||
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 | jumpFalse1 - jumpFalse4 { # Conditional jump incr depth -1 switch -exact -- [lindex $insn 1 0] { pc { set to_pc [lindex $insn 1 1] set to_test [list temp $depth] my generate-jump $to_pc false $to_test } default { return -code error "I don't know what to do with\ [lindex $insn 1 0] as a jump target." } } } jumpTrue1 - jumpTrue4 { # Conditional jump incr depth -1 switch -exact -- [lindex $insn 1 0] { pc { set to_pc [lindex $insn 1 1] set to_test [list temp $depth] my generate-jump $to_pc true $to_test } default { return -code error "I don't know what to do with\ [lindex $insn 1 0] as a jump target." } } | > > | 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 | jumpFalse1 - jumpFalse4 { # Conditional jump incr depth -1 switch -exact -- [lindex $insn 1 0] { pc { set to_pc [lindex $insn 1 1] set to_test [list temp $depth] my generate-arith-domain-check $to_pc jumpFalse $to_test my generate-jump $to_pc false $to_test } default { return -code error "I don't know what to do with\ [lindex $insn 1 0] as a jump target." } } } jumpTrue1 - jumpTrue4 { # Conditional jump incr depth -1 switch -exact -- [lindex $insn 1 0] { pc { set to_pc [lindex $insn 1 1] set to_test [list temp $depth] my generate-arith-domain-check $pc jumpTrue $to_test my generate-jump $to_pc true $to_test } default { return -code error "I don't know what to do with\ [lindex $insn 1 0] as a jump target." } } |
︙ | ︙ | |||
1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | my quads [lindex $insn 0] $r $v0 } originCmd { set v0 [list temp [incr depth -1]] set r $v0 my error-quads $pc [lindex $insn 0] $r $v0 } stringIsDouble - stringIsDoubleStrict - stringIsEntier - stringIsEntierStrict - stringIsInt - stringIsIntStrict - stringIsWide - stringIsWideStrict { | > > > > | > > | > > > | 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 | my quads [lindex $insn 0] $r $v0 } originCmd { set v0 [list temp [incr depth -1]] set r $v0 my error-quads $pc [lindex $insn 0] $r $v0 } stringIsBoolean - stringIsBooleanStrict - stringIsDouble - stringIsDoubleStrict - stringIsEntier - stringIsEntierStrict - stringIsInt - stringIsIntStrict - stringIsWide - stringIsWideStrict { regexp -expanded { ^ stringIs(Boolean|Double|Entier|Int|Wide) ((?:Strict)?) $ } [lindex $insn 0] -> type strict switch -exact $type { Boolean { set typecode $quadcode::dataType::BOOLEAN } Double { set typecode $::quadcode::dataType::NUMERIC } Entier { set typecode $::quadcode::dataType::ENTIER } Wide { |
︙ | ︙ | |||
1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 | bitand [list & INT] \ bitor [list | INT] \ bitxor [list ^ INT] \ mod [list % INT] \ lshift [list << INT] \ rshift [list << INT] \ bitnot [list ~ INT] \ infoLevelArgs [list "info level" INT]] } oo::define quadcode::transformer method \ generate-arith-domain-check {pc operator args} { namespace upvar ::quadcode operator_info operator_info set target [my exception-target $pc catch] if {![dict exists $operator_info $operator]} return | > > > > > | 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 | bitand [list & INT] \ bitor [list | INT] \ bitxor [list ^ INT] \ mod [list % INT] \ lshift [list << INT] \ rshift [list << INT] \ bitnot [list ~ INT] \ jumpTrue [list "boolean test" NUMERIC_OR_BOOLEAN] \ jumpFalse [list "boolean test" NUMERIC_OR_BOOLEAN] \ land [list "&&" NUMERIC_OR_BOOLEAN] \ lor [list "||" NUMERIC_OR_BOOLEAN] \ not [list "!" NUMERIC_OR_BOOLEAN] \ infoLevelArgs [list "info level" INT]] } oo::define quadcode::transformer method \ generate-arith-domain-check {pc operator args} { namespace upvar ::quadcode operator_info operator_info set target [my exception-target $pc catch] if {![dict exists $operator_info $operator]} return |
︙ | ︙ |
Changes to quadcode/types.tcl.
︙ | ︙ | |||
115 116 117 118 119 120 121 122 123 124 125 126 127 128 | # NUMERIC - the value is a number of some sort. # A constant $x of this type will be pure iff either # {entier($x) eq $x} or {double($x) eq $x} - that is, # it is a number in canonical form. variable NUMERIC [expr {$DOUBLE | $ENTIER}] # FOREACH - the value represents the iterator of a [foreach] or [lmap]. # There are no constants of this type, and it is therefore # always pure. variable FOREACH [expr 0x10000] | > > > > > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | # NUMERIC - the value is a number of some sort. # A constant $x of this type will be pure iff either # {entier($x) eq $x} or {double($x) eq $x} - that is, # it is a number in canonical form. variable NUMERIC [expr {$DOUBLE | $ENTIER}] # NUMERIC_OR_BOOLEAN - the value is a number, or some spelling of # 'true' or 'false' variable NUMERIC_OR_BOOLEAN [expr {$NUMERIC | $BOOLEAN}] # FOREACH - the value represents the iterator of a [foreach] or [lmap]. # There are no constants of this type, and it is therefore # always pure. variable FOREACH [expr 0x10000] |
︙ | ︙ | |||
482 483 484 485 486 487 488 | # # Results: # Returns the deduced data type of q's left hand side oo::define quadcode::transformer method typeOfResult {q} { namespace upvar ::quadcode::dataType {*}{ DOUBLE DOUBLE INT INT STRING STRING FAIL FAIL EMPTY EMPTY | > > | | 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 | # # Results: # Returns the deduced data type of q's left hand side oo::define quadcode::transformer method typeOfResult {q} { namespace upvar ::quadcode::dataType {*}{ DOUBLE DOUBLE INT INT STRING STRING FAIL FAIL EMPTY EMPTY ZEROONE ZEROONE BOOL_INT BOOL BOOLWORD BOOLWORD ENTIER ENTIER NUMERIC NUMERIC IMPURE IMPURE VOID VOID CALLFRAME CALLFRAME DICTITER DICTITER FOREACH FOREACH ARRAY ARRAY NEXIST NEXIST EXPANDED EXPANDED } switch -exact -- [lindex $q 0 0] { debug-value { return [typeOfOperand $types [lindex $q 3]] |
︙ | ︙ | |||
616 617 618 619 620 621 622 | lor - lt - neq - strclass - streq - strmatch - strneq { | | | | > | | | 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 | lor - lt - neq - strclass - streq - strmatch - strneq { return $ZEROONE } not { set t [typeOfOperand $types [lindex $q 2]] if {istype($t,$NUMERIC|$BOOLWORD)} { return $ZEROONE } else { puts "which might FAIL" return [expr {$ZEROONE | $FAIL}] } } regexp - listIn { return [expr {$ZEROONE | $FAIL}] } listLength - dictSize { return [expr {$INT | $FAIL}] } phi { set r 0 foreach {from operand} [lrange $q 2 end] { |
︙ | ︙ |