From 06b99c31eec7254cc5793483e3170bc0a6f9cf30 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 3 Nov 2008 20:59:48 -0600 Subject: [PATCH 01/14] Fix regression. If a parsing word called the compiler, it might compile a caller of a generic before the generic gets built, which would throw an error since the inferred effect of the generic might have less inputs than the combination's dispatch# --- basis/compiler/tests/peg-regression.factor | 26 +++++++++++++++++++ .../tree/propagation/inlining/inlining.factor | 9 +++++++ 2 files changed, 35 insertions(+) create mode 100644 basis/compiler/tests/peg-regression.factor diff --git a/basis/compiler/tests/peg-regression.factor b/basis/compiler/tests/peg-regression.factor new file mode 100644 index 0000000000..a0262fdc81 --- /dev/null +++ b/basis/compiler/tests/peg-regression.factor @@ -0,0 +1,26 @@ +! Calling the compiler at parse time and having it compile +! generic words defined in the current compilation unit would +! fail. This is a regression from the 'remake-generic' +! optimization, which would batch generic word updates at the +! end of a compilation unit. + +USING: kernel accessors peg.ebnf ; +IN: compiler.tests + +TUPLE: pipeline-expr background ; + +GENERIC: blah ( a -- b ) + +M: pipeline-expr blah ; + +: ast>pipeline-expr ( -- obj ) + pipeline-expr new blah ; + +EBNF: expr +pipeline = "hello" => [[ ast>pipeline-expr ]] +;EBNF + +USE: tools.test + +[ t ] [ \ expr compiled>> ] unit-test +[ t ] [ \ ast>pipeline-expr compiled>> ] unit-test diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 197d1820bf..130b94cf6b 100644 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -164,7 +164,16 @@ SYMBOL: history first object swap eliminate-dispatch ; : do-inlining ( #call word -- ? ) + #! If the generic was defined in an outer compilation unit, + #! then it doesn't have a definition yet; the definition + #! is built at the end of the compilation unit. We do not + #! attempt inlining at this stage since the stack discipline + #! is not finalized yet, so dispatch# might return an out + #! of bounds value. This case comes up if a parsing word + #! calls the compiler at parse time (doing so is + #! discouraged, but it should still work.) { + { [ dup deferred? ] [ 2drop f ] } { [ dup custom-inlining? ] [ inline-custom ] } { [ dup always-inline-word? ] [ inline-word ] } { [ dup standard-generic? ] [ inline-standard-method ] } From 3e75e0f8b5d309059a521e8bcb6404c8710afe52 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 3 Nov 2008 21:00:27 -0600 Subject: [PATCH 02/14] Update word naming conventions --- basis/help/handbook/handbook.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index c1505705da..6aa19d43d5 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -4,7 +4,8 @@ prettyprint.backend kernel.private io generic math system strings sbufs vectors byte-arrays quotations io.streams.byte-array classes.builtin parser lexer classes.predicate classes.union classes.intersection -classes.singleton classes.tuple tools.vocabs.browser ; +classes.singleton classes.tuple tools.vocabs.browser math.parser +accessors ; IN: help.handbook ARTICLE: "conventions" "Conventions" @@ -26,12 +27,14 @@ $nl { { $snippet { $emphasis "foo" } "?" } "outputs a boolean" { { $link empty? } } } { { $snippet "?" { $emphasis "foo" } } { "conditionally performs " { $snippet { $emphasis "foo" } } } { { $links ?nth } } } { { $snippet "<" { $emphasis "foo" } ">" } { "creates a new " { $snippet "foo" } } { { $link } } } + { { $snippet ">" { $emphasis "foo" } } { "converts the top of the stack into a " { $snippet "foo" } } { { $link >array } } } + { { $snippet { $emphasis "foo" } ">" { $emphasis "bar" } } { "converts a " { $snippet "foo" } " into a " { $snippet "bar" } } { { $link number>string } } } { { $snippet "new-" { $emphasis "foo" } } { "creates a new " { $snippet "foo" } ", taking some kind of parameter from the stack which determines the type of the object to be created" } { { $link new-sequence } ", " { $link new-lexer } ", " { $link new } } } { { $snippet { $emphasis "foo" } "*" } { "alternative form of " { $snippet "foo" } ", or a generic word called by " { $snippet "foo" } } { { $links at* pprint* } } } { { $snippet "(" { $emphasis "foo" } ")" } { "implementation detail word used by " { $snippet "foo" } } { { $link (clone) } } } { { $snippet "set-" { $emphasis "foo" } } { "sets " { $snippet "foo" } " to a new value" } { $links set-length } } - { { $snippet { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple accessors) outputs the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } } - { { $snippet "set-" { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple mutators) sets the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } } + { { $snippet { $emphasis "foo" } ">>" } { "gets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link >>name } } } + { { $snippet ">>" { $emphasis "foo" } } { "sets the " { $snippet "foo" } " slot of the tuple at the top of the stack; see " { $link "accessors" } } { { $link name>> } } } { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-input-stream with-output-stream } } { { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } } } From b4d3473d5eb2a01e1707be0c2af757224a302927 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 3 Nov 2008 21:01:50 -0600 Subject: [PATCH 03/14] Tuple parsing didn't handle line breaks properly; if scan returns f, must throw unexpected-eof --- core/classes/tuple/parser/parser-tests.factor | 33 +++++++++++++++++++ core/classes/tuple/parser/parser.factor | 11 +++++-- 2 files changed, 41 insertions(+), 3 deletions(-) diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 6b9a953ab9..22b5784269 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/core/classes/tuple/parser/parser-tests.factor @@ -109,3 +109,36 @@ TUPLE: parsing-corner-case x ; "}" } "\n" join eval ] unit-test + +[ T{ parsing-corner-case f 3 } ] [ + { + "USE: classes.tuple.parser.tests" + "T{ parsing-corner-case" + " { x 3 }" + "}" + } "\n" join eval +] unit-test + +[ T{ parsing-corner-case f 3 } ] [ + { + "USE: classes.tuple.parser.tests" + "T{ parsing-corner-case {" + " x 3 }" + "}" + } "\n" join eval +] unit-test + + +[ + { + "USE: classes.tuple.parser.tests T{ parsing-corner-case" + " { x 3 }" + } "\n" join eval +] [ error>> unexpected-eof? ] must-fail-with + +[ + { + "USE: classes.tuple.parser.tests T{ parsing-corner-case {" + " x 3 }" + } "\n" join eval +] [ error>> unexpected-eof? ] must-fail-with diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 7888635641..659195edbf 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -60,14 +60,19 @@ ERROR: invalid-slot-name name ; dup check-duplicate-slots 3dup check-slot-shadowing ; -: parse-slot-value ( -- ) - scan scan-object 2array , scan "}" assert= ; - ERROR: bad-literal-tuple ; +: parse-slot-value ( -- ) + scan scan-object 2array , scan { + { f [ unexpected-eof ] } + { "}" [ ] } + [ bad-literal-tuple ] + } case ; + : (parse-slot-values) ( -- ) parse-slot-value scan { + { f [ unexpected-eof ] } { "{" [ (parse-slot-values) ] } { "}" [ ] } [ bad-literal-tuple ] From efcb916e35df0890d8ef67870d807134d3abc147 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 3 Nov 2008 21:02:34 -0600 Subject: [PATCH 04/14] Handle a jump to a jump by cloning the block, in the same way we optimize jumps to returns --- basis/compiler/cfg/linearization/linearization.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index d8f5d35ed4..d397c9d448 100644 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -20,16 +20,17 @@ M: insn linearize-insn , drop ; #! don't need to branch. [ number>> ] bi@ 1- = ; inline -: branch-to-return? ( successor -- ? ) - #! A branch to a block containing just a return is cloned. +: branch-to-branch? ( successor -- ? ) + #! A branch to a block containing just a jump return is cloned. instructions>> dup length 2 = [ - [ first ##epilogue? ] [ second ##return? ] bi and + [ first ##epilogue? ] + [ second [ ##return? ] [ ##jump? ] bi or ] bi and ] [ drop f ] if ; : emit-branch ( basic-block successor -- ) { { [ 2dup useless-branch? ] [ 2drop ] } - { [ dup branch-to-return? ] [ nip linearize-insns ] } + { [ dup branch-to-branch? ] [ nip linearize-insns ] } [ nip number>> _branch ] } cond ; From 72b34c7b476b3c7d15f91edd6b055b069aab11af Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Tue, 4 Nov 2008 00:04:18 -0600 Subject: [PATCH 05/14] Fix visibility of check_sse2 symbol; DDLEXPORT doesn't work in gas source --- vm/cpu-x86.32.S | 5 +++++ vm/cpu-x86.32.h | 2 -- 2 files changed, 5 insertions(+), 2 deletions(-) mode change 100644 => 100755 vm/cpu-x86.32.S mode change 100644 => 100755 vm/cpu-x86.32.h diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S old mode 100644 new mode 100755 index 3e7e5c20e1..d903f8013d --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -51,3 +51,8 @@ DEF(bool,check_sse2,(void)): ret #include "cpu-x86.S" + +#ifdef WINDOWS + .section .drectve + .ascii " -export:check_sse2" +#endif diff --git a/vm/cpu-x86.32.h b/vm/cpu-x86.32.h old mode 100644 new mode 100755 index 1d516c4703..21f07cf2b4 --- a/vm/cpu-x86.32.h +++ b/vm/cpu-x86.32.h @@ -4,5 +4,3 @@ register CELL ds asm("esi"); register CELL rs asm("edi"); #define F_FASTCALL __attribute__ ((regparm (2))) - -DLLEXPORT bool check_sse2(void); From 1af3b8ed656afedc1b31b2fbd62627f69295eb9c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 00:32:56 -0600 Subject: [PATCH 06/14] If a register is spilled and the reload location is also a copy, we chicken out and don't coalesce. This is suboptimal but it's not clear to me how to implement it cleanly, and SSA graph coloring will solve this problem eventually anyway --- .../linear-scan/allocation/allocation.factor | 6 +- .../cfg/linear-scan/linear-scan-tests.factor | 848 ++++++++++++++++++ 2 files changed, 851 insertions(+), 3 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 7944415cbc..d75d5649cb 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -58,11 +58,11 @@ SYMBOL: progress ! Coalescing : active-interval ( vreg -- live-interval ) - dup active-intervals-for [ vreg>> = ] with find nip ; + dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ; : coalesce? ( live-interval -- ? ) - [ start>> ] [ copy-from>> ] bi - dup [ active-interval end>> = ] [ 2drop f ] if ; + [ start>> ] [ copy-from>> active-interval ] bi + dup [ end>> = ] [ 2drop f ] if ; : coalesce ( live-interval -- ) dup copy-from>> active-interval diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index af2e81b767..948302c74b 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -355,3 +355,851 @@ USING: math.private compiler.cfg.debugger ; { { int-regs { 0 1 2 3 } } } allocate-registers drop ] unit-test + +[ ] [ + { + T{ live-interval + { vreg V int-regs 3687168 } + { start 106 } + { end 112 } + { uses V{ 106 112 } } + } + T{ live-interval + { vreg V int-regs 3687169 } + { start 107 } + { end 113 } + { uses V{ 107 113 } } + } + T{ live-interval + { vreg V int-regs 3687727 } + { start 190 } + { end 198 } + { uses V{ 190 195 198 } } + } + T{ live-interval + { vreg V int-regs 3686445 } + { start 43 } + { end 44 } + { uses V{ 43 44 } } + } + T{ live-interval + { vreg V int-regs 3686195 } + { start 5 } + { end 11 } + { uses V{ 5 11 } } + } + T{ live-interval + { vreg V int-regs 3686449 } + { start 44 } + { end 56 } + { uses V{ 44 45 45 46 56 } } + { copy-from V int-regs 3686445 } + } + T{ live-interval + { vreg V int-regs 3686198 } + { start 8 } + { end 10 } + { uses V{ 8 9 10 } } + } + T{ live-interval + { vreg V int-regs 3686454 } + { start 46 } + { end 49 } + { uses V{ 46 47 47 49 } } + { copy-from V int-regs 3686449 } + } + T{ live-interval + { vreg V int-regs 3686196 } + { start 6 } + { end 12 } + { uses V{ 6 12 } } + } + T{ live-interval + { vreg V int-regs 3686197 } + { start 7 } + { end 14 } + { uses V{ 7 13 14 } } + } + T{ live-interval + { vreg V int-regs 3686455 } + { start 48 } + { end 51 } + { uses V{ 48 51 } } + } + T{ live-interval + { vreg V int-regs 3686463 } + { start 52 } + { end 53 } + { uses V{ 52 53 } } + } + T{ live-interval + { vreg V int-regs 3686460 } + { start 49 } + { end 52 } + { uses V{ 49 50 50 52 } } + { copy-from V int-regs 3686454 } + } + T{ live-interval + { vreg V int-regs 3686461 } + { start 51 } + { end 71 } + { uses V{ 51 52 64 68 71 } } + } + T{ live-interval + { vreg V int-regs 3686464 } + { start 53 } + { end 54 } + { uses V{ 53 54 } } + } + T{ live-interval + { vreg V int-regs 3686465 } + { start 54 } + { end 76 } + { uses V{ 54 55 55 76 } } + { copy-from V int-regs 3686464 } + } + T{ live-interval + { vreg V int-regs 3686470 } + { start 58 } + { end 60 } + { uses V{ 58 59 59 60 } } + { copy-from V int-regs 3686469 } + } + T{ live-interval + { vreg V int-regs 3686469 } + { start 56 } + { end 58 } + { uses V{ 56 57 57 58 } } + { copy-from V int-regs 3686449 } + } + T{ live-interval + { vreg V int-regs 3686473 } + { start 60 } + { end 62 } + { uses V{ 60 61 61 62 } } + { copy-from V int-regs 3686470 } + } + T{ live-interval + { vreg V int-regs 3686479 } + { start 62 } + { end 64 } + { uses V{ 62 63 63 64 } } + { copy-from V int-regs 3686473 } + } + T{ live-interval + { vreg V int-regs 3686735 } + { start 78 } + { end 96 } + { uses V{ 78 79 79 96 } } + { copy-from V int-regs 3686372 } + } + T{ live-interval + { vreg V int-regs 3686482 } + { start 64 } + { end 65 } + { uses V{ 64 65 } } + } + T{ live-interval + { vreg V int-regs 3686483 } + { start 65 } + { end 66 } + { uses V{ 65 66 } } + } + T{ live-interval + { vreg V int-regs 3687510 } + { start 168 } + { end 171 } + { uses V{ 168 171 } } + } + T{ live-interval + { vreg V int-regs 3687511 } + { start 169 } + { end 176 } + { uses V{ 169 176 } } + } + T{ live-interval + { vreg V int-regs 3686484 } + { start 66 } + { end 75 } + { uses V{ 66 67 67 75 } } + { copy-from V int-regs 3686483 } + } + T{ live-interval + { vreg V int-regs 3687509 } + { start 162 } + { end 163 } + { uses V{ 162 163 } } + } + T{ live-interval + { vreg V int-regs 3686491 } + { start 68 } + { end 69 } + { uses V{ 68 69 } } + } + T{ live-interval + { vreg V int-regs 3687512 } + { start 170 } + { end 178 } + { uses V{ 170 177 178 } } + } + T{ live-interval + { vreg V int-regs 3687515 } + { start 172 } + { end 173 } + { uses V{ 172 173 } } + } + T{ live-interval + { vreg V int-regs 3686492 } + { start 69 } + { end 74 } + { uses V{ 69 70 70 74 } } + { copy-from V int-regs 3686491 } + } + T{ live-interval + { vreg V int-regs 3687778 } + { start 202 } + { end 208 } + { uses V{ 202 208 } } + } + T{ live-interval + { vreg V int-regs 3686499 } + { start 71 } + { end 72 } + { uses V{ 71 72 } } + } + T{ live-interval + { vreg V int-regs 3687520 } + { start 174 } + { end 175 } + { uses V{ 174 175 } } + } + T{ live-interval + { vreg V int-regs 3687779 } + { start 203 } + { end 209 } + { uses V{ 203 209 } } + } + T{ live-interval + { vreg V int-regs 3687782 } + { start 206 } + { end 207 } + { uses V{ 206 207 } } + } + T{ live-interval + { vreg V int-regs 3686503 } + { start 74 } + { end 75 } + { uses V{ 74 75 } } + } + T{ live-interval + { vreg V int-regs 3686500 } + { start 72 } + { end 74 } + { uses V{ 72 73 73 74 } } + { copy-from V int-regs 3686499 } + } + T{ live-interval + { vreg V int-regs 3687780 } + { start 204 } + { end 210 } + { uses V{ 204 210 } } + } + T{ live-interval + { vreg V int-regs 3686506 } + { start 75 } + { end 76 } + { uses V{ 75 76 } } + } + T{ live-interval + { vreg V int-regs 3687530 } + { start 185 } + { end 192 } + { uses V{ 185 192 } } + } + T{ live-interval + { vreg V int-regs 3687528 } + { start 183 } + { end 198 } + { uses V{ 183 198 } } + } + T{ live-interval + { vreg V int-regs 3687529 } + { start 184 } + { end 197 } + { uses V{ 184 197 } } + } + T{ live-interval + { vreg V int-regs 3687781 } + { start 205 } + { end 211 } + { uses V{ 205 211 } } + } + T{ live-interval + { vreg V int-regs 3687535 } + { start 187 } + { end 194 } + { uses V{ 187 194 } } + } + T{ live-interval + { vreg V int-regs 3686252 } + { start 9 } + { end 17 } + { uses V{ 9 15 17 } } + } + T{ live-interval + { vreg V int-regs 3686509 } + { start 76 } + { end 90 } + { uses V{ 76 87 90 } } + } + T{ live-interval + { vreg V int-regs 3687532 } + { start 186 } + { end 196 } + { uses V{ 186 196 } } + } + T{ live-interval + { vreg V int-regs 3687538 } + { start 188 } + { end 193 } + { uses V{ 188 193 } } + } + T{ live-interval + { vreg V int-regs 3687827 } + { start 217 } + { end 219 } + { uses V{ 217 219 } } + } + T{ live-interval + { vreg V int-regs 3687825 } + { start 215 } + { end 218 } + { uses V{ 215 216 218 } } + } + T{ live-interval + { vreg V int-regs 3687831 } + { start 218 } + { end 219 } + { uses V{ 218 219 } } + } + T{ live-interval + { vreg V int-regs 3686296 } + { start 16 } + { end 18 } + { uses V{ 16 18 } } + } + T{ live-interval + { vreg V int-regs 3686302 } + { start 29 } + { end 31 } + { uses V{ 29 31 } } + } + T{ live-interval + { vreg V int-regs 3687838 } + { start 231 } + { end 232 } + { uses V{ 231 232 } } + } + T{ live-interval + { vreg V int-regs 3686300 } + { start 26 } + { end 27 } + { uses V{ 26 27 } } + } + T{ live-interval + { vreg V int-regs 3686301 } + { start 27 } + { end 30 } + { uses V{ 27 28 28 30 } } + { copy-from V int-regs 3686300 } + } + T{ live-interval + { vreg V int-regs 3686306 } + { start 37 } + { end 93 } + { uses V{ 37 82 93 } } + } + T{ live-interval + { vreg V int-regs 3686307 } + { start 38 } + { end 88 } + { uses V{ 38 85 88 } } + } + T{ live-interval + { vreg V int-regs 3687837 } + { start 222 } + { end 223 } + { uses V{ 222 223 } } + } + T{ live-interval + { vreg V int-regs 3686305 } + { start 36 } + { end 81 } + { uses V{ 36 42 77 81 } } + } + T{ live-interval + { vreg V int-regs 3686310 } + { start 39 } + { end 95 } + { uses V{ 39 84 95 } } + } + T{ live-interval + { vreg V int-regs 3687836 } + { start 227 } + { end 228 } + { uses V{ 227 228 } } + } + T{ live-interval + { vreg V int-regs 3687839 } + { start 239 } + { end 246 } + { uses V{ 239 245 246 } } + } + T{ live-interval + { vreg V int-regs 3687841 } + { start 240 } + { end 241 } + { uses V{ 240 241 } } + } + T{ live-interval + { vreg V int-regs 3687845 } + { start 241 } + { end 243 } + { uses V{ 241 243 } } + } + T{ live-interval + { vreg V int-regs 3686315 } + { start 40 } + { end 94 } + { uses V{ 40 83 94 } } + } + T{ live-interval + { vreg V int-regs 3687846 } + { start 242 } + { end 245 } + { uses V{ 242 245 } } + } + T{ live-interval + { vreg V int-regs 3687849 } + { start 243 } + { end 245 } + { uses V{ 243 244 244 245 } } + { copy-from V int-regs 3687845 } + } + T{ live-interval + { vreg V int-regs 3687850 } + { start 245 } + { end 245 } + { uses V{ 245 } } + } + T{ live-interval + { vreg V int-regs 3687851 } + { start 246 } + { end 246 } + { uses V{ 246 } } + } + T{ live-interval + { vreg V int-regs 3687852 } + { start 246 } + { end 246 } + { uses V{ 246 } } + } + T{ live-interval + { vreg V int-regs 3687853 } + { start 247 } + { end 248 } + { uses V{ 247 248 } } + } + T{ live-interval + { vreg V int-regs 3687854 } + { start 249 } + { end 250 } + { uses V{ 249 250 } } + } + T{ live-interval + { vreg V int-regs 3687855 } + { start 258 } + { end 259 } + { uses V{ 258 259 } } + } + T{ live-interval + { vreg V int-regs 3687080 } + { start 280 } + { end 285 } + { uses V{ 280 285 } } + } + T{ live-interval + { vreg V int-regs 3687081 } + { start 281 } + { end 286 } + { uses V{ 281 286 } } + } + T{ live-interval + { vreg V int-regs 3687082 } + { start 282 } + { end 287 } + { uses V{ 282 287 } } + } + T{ live-interval + { vreg V int-regs 3687083 } + { start 283 } + { end 288 } + { uses V{ 283 288 } } + } + T{ live-interval + { vreg V int-regs 3687085 } + { start 284 } + { end 299 } + { uses V{ 284 285 286 287 288 296 299 } } + } + T{ live-interval + { vreg V int-regs 3687086 } + { start 284 } + { end 284 } + { uses V{ 284 } } + } + T{ live-interval + { vreg V int-regs 3687087 } + { start 289 } + { end 293 } + { uses V{ 289 293 } } + } + T{ live-interval + { vreg V int-regs 3687088 } + { start 290 } + { end 294 } + { uses V{ 290 294 } } + } + T{ live-interval + { vreg V int-regs 3687089 } + { start 291 } + { end 297 } + { uses V{ 291 297 } } + } + T{ live-interval + { vreg V int-regs 3687090 } + { start 292 } + { end 298 } + { uses V{ 292 298 } } + } + T{ live-interval + { vreg V int-regs 3687363 } + { start 118 } + { end 119 } + { uses V{ 118 119 } } + } + T{ live-interval + { vreg V int-regs 3686599 } + { start 77 } + { end 89 } + { uses V{ 77 86 89 } } + } + T{ live-interval + { vreg V int-regs 3687370 } + { start 131 } + { end 132 } + { uses V{ 131 132 } } + } + T{ live-interval + { vreg V int-regs 3687371 } + { start 138 } + { end 143 } + { uses V{ 138 143 } } + } + T{ live-interval + { vreg V int-regs 3687368 } + { start 127 } + { end 128 } + { uses V{ 127 128 } } + } + T{ live-interval + { vreg V int-regs 3687369 } + { start 122 } + { end 123 } + { uses V{ 122 123 } } + } + T{ live-interval + { vreg V int-regs 3687373 } + { start 139 } + { end 140 } + { uses V{ 139 140 } } + } + T{ live-interval + { vreg V int-regs 3686352 } + { start 41 } + { end 91 } + { uses V{ 41 43 79 91 } } + } + T{ live-interval + { vreg V int-regs 3687377 } + { start 140 } + { end 141 } + { uses V{ 140 141 } } + } + T{ live-interval + { vreg V int-regs 3687382 } + { start 143 } + { end 143 } + { uses V{ 143 } } + } + T{ live-interval + { vreg V int-regs 3687383 } + { start 144 } + { end 161 } + { uses V{ 144 159 161 } } + } + T{ live-interval + { vreg V int-regs 3687380 } + { start 141 } + { end 143 } + { uses V{ 141 142 142 143 } } + { copy-from V int-regs 3687377 } + } + T{ live-interval + { vreg V int-regs 3687381 } + { start 143 } + { end 160 } + { uses V{ 143 160 } } + } + T{ live-interval + { vreg V int-regs 3687384 } + { start 145 } + { end 158 } + { uses V{ 145 158 } } + } + T{ live-interval + { vreg V int-regs 3687385 } + { start 146 } + { end 157 } + { uses V{ 146 157 } } + } + T{ live-interval + { vreg V int-regs 3687640 } + { start 189 } + { end 191 } + { uses V{ 189 191 } } + } + T{ live-interval + { vreg V int-regs 3687388 } + { start 147 } + { end 152 } + { uses V{ 147 152 } } + } + T{ live-interval + { vreg V int-regs 3687393 } + { start 148 } + { end 153 } + { uses V{ 148 153 } } + } + T{ live-interval + { vreg V int-regs 3687398 } + { start 149 } + { end 154 } + { uses V{ 149 154 } } + } + T{ live-interval + { vreg V int-regs 3686372 } + { start 42 } + { end 92 } + { uses V{ 42 45 78 80 92 } } + } + T{ live-interval + { vreg V int-regs 3687140 } + { start 293 } + { end 295 } + { uses V{ 293 294 294 295 } } + { copy-from V int-regs 3687087 } + } + T{ live-interval + { vreg V int-regs 3687403 } + { start 150 } + { end 155 } + { uses V{ 150 155 } } + } + T{ live-interval + { vreg V int-regs 3687150 } + { start 304 } + { end 306 } + { uses V{ 304 306 } } + } + T{ live-interval + { vreg V int-regs 3687151 } + { start 305 } + { end 307 } + { uses V{ 305 307 } } + } + T{ live-interval + { vreg V int-regs 3687408 } + { start 151 } + { end 156 } + { uses V{ 151 156 } } + } + T{ live-interval + { vreg V int-regs 3687153 } + { start 312 } + { end 313 } + { uses V{ 312 313 } } + } + T{ live-interval + { vreg V int-regs 3686902 } + { start 267 } + { end 272 } + { uses V{ 267 272 } } + } + T{ live-interval + { vreg V int-regs 3686903 } + { start 268 } + { end 273 } + { uses V{ 268 273 } } + } + T{ live-interval + { vreg V int-regs 3686900 } + { start 265 } + { end 270 } + { uses V{ 265 270 } } + } + T{ live-interval + { vreg V int-regs 3686901 } + { start 266 } + { end 271 } + { uses V{ 266 271 } } + } + T{ live-interval + { vreg V int-regs 3687162 } + { start 100 } + { end 119 } + { uses V{ 100 114 117 119 } } + } + T{ live-interval + { vreg V int-regs 3687163 } + { start 101 } + { end 118 } + { uses V{ 101 115 116 118 } } + } + T{ live-interval + { vreg V int-regs 3686904 } + { start 269 } + { end 274 } + { uses V{ 269 274 } } + } + T{ live-interval + { vreg V int-regs 3687166 } + { start 104 } + { end 110 } + { uses V{ 104 110 } } + } + T{ live-interval + { vreg V int-regs 3687167 } + { start 105 } + { end 111 } + { uses V{ 105 111 } } + } + T{ live-interval + { vreg V int-regs 3687164 } + { start 102 } + { end 108 } + { uses V{ 102 108 } } + } + T{ live-interval + { vreg V int-regs 3687165 } + { start 103 } + { end 109 } + { uses V{ 103 109 } } + } + } + { { int-regs { 0 1 2 3 4 } } } + allocate-registers drop +] unit-test + +! A reduction of the above +[ ] [ + { + T{ live-interval + { vreg V int-regs 6449 } + { start 44 } + { end 56 } + { uses V{ 44 45 46 56 } } + } + T{ live-interval + { vreg V int-regs 6454 } + { start 46 } + { end 49 } + { uses V{ 46 47 49 } } + } + T{ live-interval + { vreg V int-regs 6455 } + { start 48 } + { end 51 } + { uses V{ 48 51 } } + } + T{ live-interval + { vreg V int-regs 6460 } + { start 49 } + { end 52 } + { uses V{ 49 50 52 } } + } + T{ live-interval + { vreg V int-regs 6461 } + { start 51 } + { end 71 } + { uses V{ 51 52 64 68 71 } } + } + T{ live-interval + { vreg V int-regs 6464 } + { start 53 } + { end 54 } + { uses V{ 53 54 } } + } + T{ live-interval + { vreg V int-regs 6470 } + { start 58 } + { end 60 } + { uses V{ 58 59 60 } } + } + T{ live-interval + { vreg V int-regs 6469 } + { start 56 } + { end 58 } + { uses V{ 56 57 58 } } + } + T{ live-interval + { vreg V int-regs 6473 } + { start 60 } + { end 62 } + { uses V{ 60 61 62 } } + } + T{ live-interval + { vreg V int-regs 6479 } + { start 62 } + { end 64 } + { uses V{ 62 63 64 } } + } + T{ live-interval + { vreg V int-regs 6735 } + { start 78 } + { end 96 } + { uses V{ 78 79 96 } } + { copy-from V int-regs 6372 } + } + T{ live-interval + { vreg V int-regs 6483 } + { start 65 } + { end 66 } + { uses V{ 65 66 } } + } + T{ live-interval + { vreg V int-regs 7845 } + { start 91 } + { end 93 } + { uses V{ 91 93 } } + } + T{ live-interval + { vreg V int-regs 6372 } + { start 42 } + { end 92 } + { uses V{ 42 45 78 80 92 } } + } + } + { { int-regs { 0 1 2 3 } } } + allocate-registers drop +] unit-test From 4a37bcb7572b83bc4838a2d86d64592e214c8a42 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 00:36:16 -0600 Subject: [PATCH 07/14] Strip out remake-generics-hook, since otherwise it slurps in a lot of meta-programming machinery, increasing deployed image size by about 200kb for hello-world --- basis/tools/deploy/shaker/shaker.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index d9348bedd5..a7332ea9ea 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -256,6 +256,7 @@ IN: tools.deploy.shaker compiled-generic-crossref recompile-hook update-tuples-hook + remake-generics-hook definition-observers definitions:crossref interactive-vocabs From 46830bb38d3f81c770b710786b5f23687cc1efed Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 00:46:06 -0600 Subject: [PATCH 08/14] Fix another name clash in tests; putting all compiler tests in compiler.tests vocab is probably not good --- basis/compiler/tests/redefine2.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor index c20a6d6233..d6e90187fe 100644 --- a/basis/compiler/tests/redefine2.factor +++ b/basis/compiler/tests/redefine2.factor @@ -3,16 +3,16 @@ USING: compiler compiler.units tools.test math parser kernel sequences sequences.private classes.mixin generic definitions arrays words assocs eval ; -DEFER: blah +DEFER: redefine2-test -[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: blah ; M: blah nth 2drop 3 ; INSTANCE: blah sequence" eval ] unit-test +[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test -[ t ] [ blah new sequence? ] unit-test +[ t ] [ redefine2-test new sequence? ] unit-test -[ 3 ] [ 0 blah new nth-unsafe ] unit-test +[ 3 ] [ 0 redefine2-test new nth-unsafe ] unit-test -[ ] [ [ blah sequence remove-mixin-instance ] with-compilation-unit ] unit-test +[ ] [ [ redefine2-test sequence remove-mixin-instance ] with-compilation-unit ] unit-test -[ f ] [ blah new sequence? ] unit-test +[ f ] [ redefine2-test new sequence? ] unit-test -[ 0 blah new nth-unsafe ] must-fail +[ 0 redefine2-test new nth-unsafe ] must-fail From 88d5dac02ff3b93f76b1190601cc76526885c033 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 00:54:57 -0600 Subject: [PATCH 09/14] Remove obsolete code from unfinished --- unfinished/cpu/x86/syntax/syntax.factor | 16 - unfinished/cpu/x86/syntax/tags.txt | 1 - unfinished/cpu/x86/x86.factor | 470 ------------------------ 3 files changed, 487 deletions(-) delete mode 100644 unfinished/cpu/x86/syntax/syntax.factor delete mode 100644 unfinished/cpu/x86/syntax/tags.txt delete mode 100755 unfinished/cpu/x86/x86.factor diff --git a/unfinished/cpu/x86/syntax/syntax.factor b/unfinished/cpu/x86/syntax/syntax.factor deleted file mode 100644 index 061cf0defe..0000000000 --- a/unfinished/cpu/x86/syntax/syntax.factor +++ /dev/null @@ -1,16 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel words sequences lexer parser fry ; -IN: cpu.x86.syntax - -: define-register ( name num size -- ) - [ "cpu.x86" create dup define-symbol ] - [ dupd "register" set-word-prop ] - [ "register-size" set-word-prop ] - tri* ; - -: define-registers ( names size -- ) - [ dup length ] dip '[ _ define-register ] 2each ; - -: REGISTERS: ( -- ) - scan-word ";" parse-tokens swap define-registers ; parsing diff --git a/unfinished/cpu/x86/syntax/tags.txt b/unfinished/cpu/x86/syntax/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unfinished/cpu/x86/syntax/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unfinished/cpu/x86/x86.factor b/unfinished/cpu/x86/x86.factor deleted file mode 100755 index 97003cae66..0000000000 --- a/unfinished/cpu/x86/x86.factor +++ /dev/null @@ -1,470 +0,0 @@ -! Copyright (C) 2005, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays compiler.constants compiler.backend -compiler.codegen.fixup io.binary kernel combinators -kernel.private math namespaces make sequences words system -layouts math.order accessors cpu.x86.syntax ; -IN: cpu.x86 - -! A postfix assembler for x86 and AMD64. - -! In 32-bit mode, { 1234 } is absolute indirect addressing. -! In 64-bit mode, { 1234 } is RIP-relative. -! Beware! - -! Register operands -- eg, ECX -REGISTERS: 8 AL CL DL BL ; - -REGISTERS: 16 AX CX DX BX SP BP SI DI ; - -REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI ; - -REGISTERS: 64 -RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ; - -REGISTERS: 128 -XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 -XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ; - -TUPLE: byte value ; - -C: byte - - ; - -! Addressing modes -TUPLE: indirect base index scale displacement ; - -M: indirect extended? base>> extended? ; - -: canonicalize-EBP ( indirect -- indirect ) - #! { EBP } ==> { EBP 0 } - dup base>> { EBP RBP R13 } member? [ - dup displacement>> [ 0 >>displacement ] unless - ] when ; - -: canonicalize-ESP ( indirect -- indirect ) - #! { ESP } ==> { ESP ESP } - dup base>> { ESP RSP R12 } member? [ ESP >>index ] when ; - -: canonicalize ( indirect -- indirect ) - #! Modify the indirect to work around certain addressing mode - #! quirks. - canonicalize-EBP canonicalize-ESP ; - -: ( base index scale displacement -- indirect ) - indirect boa canonicalize ; - -: reg-code ( reg -- n ) "register" word-prop 7 bitand ; - -: indirect-base* ( op -- n ) base>> EBP or reg-code ; - -: indirect-index* ( op -- n ) index>> ESP or reg-code ; - -: indirect-scale* ( op -- n ) scale>> 0 or ; - -GENERIC: sib-present? ( op -- ? ) - -M: indirect sib-present? - [ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ; - -M: register sib-present? drop f ; - -GENERIC: r/m ( operand -- n ) - -M: indirect r/m - dup sib-present? - [ drop ESP reg-code ] [ indirect-base* ] if ; - -M: register r/m reg-code ; - -! Immediate operands -UNION: immediate byte integer ; - -GENERIC: fits-in-byte? ( value -- ? ) - -M: byte fits-in-byte? drop t ; - -M: integer fits-in-byte? -128 127 between? ; - -GENERIC: modifier ( op -- n ) - -M: indirect modifier - dup base>> [ - displacement>> { - { [ dup not ] [ BIN: 00 ] } - { [ dup fits-in-byte? ] [ BIN: 01 ] } - { [ dup immediate? ] [ BIN: 10 ] } - } cond nip - ] [ - drop BIN: 00 - ] if ; - -M: register modifier drop BIN: 11 ; - -GENERIC# n, 1 ( value n -- ) - -M: integer n, >le % ; -M: byte n, >r value>> r> n, ; -: 1, ( n -- ) 1 n, ; inline -: 4, ( n -- ) 4 n, ; inline -: 2, ( n -- ) 2 n, ; inline -: cell, ( n -- ) bootstrap-cell n, ; inline - -: mod-r/m, ( reg# indirect -- ) - [ 3 shift ] [ [ modifier 6 shift ] [ r/m ] bi ] bi* bitor bitor , ; - -: sib, ( indirect -- ) - dup sib-present? [ - [ indirect-base* ] - [ indirect-index* 3 shift ] - [ indirect-scale* 6 shift ] tri bitor bitor , - ] [ - drop - ] if ; - -GENERIC: displacement, ( op -- ) - -M: indirect displacement, - dup displacement>> dup [ - swap base>> - [ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if - ] [ - 2drop - ] if ; - -M: register displacement, drop ; - -: addressing ( reg# indirect -- ) - [ mod-r/m, ] [ sib, ] [ displacement, ] tri ; - -! Utilities -UNION: operand register indirect ; - -GENERIC: operand-64? ( operand -- ? ) - -M: indirect operand-64? - [ base>> ] [ index>> ] bi [ operand-64? ] either? ; - -M: register-64 operand-64? drop t ; - -M: object operand-64? drop f ; - -: rex.w? ( rex.w reg r/m -- ? ) - { - { [ dup register-128? ] [ drop operand-64? ] } - { [ dup not ] [ drop operand-64? ] } - [ nip operand-64? ] - } cond and ; - -: rex.r ( m op -- n ) - extended? [ BIN: 00000100 bitor ] when ; - -: rex.b ( m op -- n ) - [ extended? [ BIN: 00000001 bitor ] when ] keep - dup indirect? [ - index>> extended? [ BIN: 00000010 bitor ] when - ] [ - drop - ] if ; - -: rex-prefix ( reg r/m rex.w -- ) - #! Compile an AMD64 REX prefix. - 2over rex.w? BIN: 01001000 BIN: 01000000 ? - swap rex.r swap rex.b - dup BIN: 01000000 = [ drop ] [ , ] if ; - -: 16-prefix ( reg r/m -- ) - [ register-16? ] either? [ HEX: 66 , ] when ; - -: prefix ( reg r/m rex.w -- ) 2over 16-prefix rex-prefix ; - -: prefix-1 ( reg rex.w -- ) f swap prefix ; - -: short-operand ( reg rex.w n -- ) - #! Some instructions encode their single operand as part of - #! the opcode. - >r dupd prefix-1 reg-code r> + , ; - -: opcode, ( opcode -- ) dup array? [ % ] [ , ] if ; - -: extended-opcode ( opcode -- opcode' ) OCT: 17 swap 2array ; - -: extended-opcode, ( opcode -- ) extended-opcode opcode, ; - -: opcode-or ( opcode mask -- opcode' ) - swap dup array? - [ unclip-last rot bitor suffix ] [ bitor ] if ; - -: 1-operand ( op reg,rex.w,opcode -- ) - #! The 'reg' is not really a register, but a value for the - #! 'reg' field of the mod-r/m byte. - first3 >r >r over r> prefix-1 r> opcode, swap addressing ; - -: immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode ) - pick integer? [ first3 BIN: 1 opcode-or 3array ] when ; - -: immediate-1 ( imm dst reg,rex.w,opcode -- ) - immediate-operand-size-bit 1-operand 1, ; - -: immediate-4 ( imm dst reg,rex.w,opcode -- ) - immediate-operand-size-bit 1-operand 4, ; - -: immediate-fits-in-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode ) - pick integer? [ first3 BIN: 10 opcode-or 3array ] when ; - -: immediate-1/4 ( imm dst reg,rex.w,opcode -- ) - #! If imm is a byte, compile the opcode and the byte. - #! Otherwise, set the 8-bit operand flag in the opcode, and - #! compile the cell. The 'reg' is not really a register, but - #! a value for the 'reg' field of the mod-r/m byte. - pick fits-in-byte? [ - immediate-fits-in-size-bit immediate-1 - ] [ - immediate-4 - ] if ; - -: (2-operand) ( dst src op -- ) - >r 2dup t rex-prefix r> opcode, - reg-code swap addressing ; - -: direction-bit ( dst src op -- dst' src' op' ) - pick register? [ BIN: 10 opcode-or swapd ] when ; - -: operand-size-bit ( dst src op -- dst' src' op' ) - over register-8? [ BIN: 1 opcode-or ] unless ; - -: 2-operand ( dst src op -- ) - #! Sets the opcode's direction bit. It is set if the - #! destination is a direct register operand. - 2over 16-prefix - direction-bit - operand-size-bit - (2-operand) ; - -PRIVATE> - -: [] ( reg/displacement -- indirect ) - dup integer? [ >r f f f r> ] [ f f f ] if ; - -: [+] ( reg displacement -- indirect ) - dup integer? - [ dup zero? [ drop f ] when >r f f r> ] - [ f f ] if - ; - -! Moving stuff -GENERIC: PUSH ( op -- ) -M: register PUSH f HEX: 50 short-operand ; -M: immediate PUSH HEX: 68 , 4, ; -M: operand PUSH { BIN: 110 f HEX: ff } 1-operand ; - -GENERIC: POP ( op -- ) -M: register POP f HEX: 58 short-operand ; -M: operand POP { BIN: 000 f HEX: 8f } 1-operand ; - -! MOV where the src is immediate. -GENERIC: (MOV-I) ( src dst -- ) -M: register (MOV-I) t HEX: b8 short-operand cell, ; -M: operand (MOV-I) - { BIN: 000 t HEX: c6 } - pick byte? [ immediate-1 ] [ immediate-4 ] if ; - -GENERIC: MOV ( dst src -- ) -M: immediate MOV swap (MOV-I) ; -M: word MOV 0 rot (MOV-I) rc-absolute-cell rel-word ; -M: operand MOV HEX: 88 2-operand ; - -: LEA ( dst src -- ) swap HEX: 8d 2-operand ; - -! Control flow -GENERIC: JMP ( op -- ) -: (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ; -M: word JMP (JMP) rel-word ; -M: label JMP (JMP) label-fixup ; -M: operand JMP { BIN: 100 t HEX: ff } 1-operand ; - -GENERIC: CALL ( op -- ) -: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ; -M: word CALL (CALL) rel-word ; -M: label CALL (CALL) label-fixup ; -M: operand CALL { BIN: 010 t HEX: ff } 1-operand ; - -GENERIC# JUMPcc 1 ( addr opcode -- ) -: (JUMPcc) ( n -- rel-class ) extended-opcode, 0 4, rc-relative ; -M: word JUMPcc (JUMPcc) rel-word ; -M: label JUMPcc (JUMPcc) label-fixup ; - -: JO ( dst -- ) HEX: 80 JUMPcc ; -: JNO ( dst -- ) HEX: 81 JUMPcc ; -: JB ( dst -- ) HEX: 82 JUMPcc ; -: JAE ( dst -- ) HEX: 83 JUMPcc ; -: JE ( dst -- ) HEX: 84 JUMPcc ; ! aka JZ -: JNE ( dst -- ) HEX: 85 JUMPcc ; -: JBE ( dst -- ) HEX: 86 JUMPcc ; -: JA ( dst -- ) HEX: 87 JUMPcc ; -: JS ( dst -- ) HEX: 88 JUMPcc ; -: JNS ( dst -- ) HEX: 89 JUMPcc ; -: JP ( dst -- ) HEX: 8a JUMPcc ; -: JNP ( dst -- ) HEX: 8b JUMPcc ; -: JL ( dst -- ) HEX: 8c JUMPcc ; -: JGE ( dst -- ) HEX: 8d JUMPcc ; -: JLE ( dst -- ) HEX: 8e JUMPcc ; -: JG ( dst -- ) HEX: 8f JUMPcc ; - -: LEAVE ( -- ) HEX: c9 , ; -: NOP ( -- ) HEX: 90 , ; - -: RET ( n -- ) - dup zero? [ drop HEX: c3 , ] [ HEX: C2 , 2, ] if ; - -! Arithmetic - -GENERIC: ADD ( dst src -- ) -M: immediate ADD swap { BIN: 000 t HEX: 80 } immediate-1/4 ; -M: operand ADD OCT: 000 2-operand ; - -GENERIC: OR ( dst src -- ) -M: immediate OR swap { BIN: 001 t HEX: 80 } immediate-1/4 ; -M: operand OR OCT: 010 2-operand ; - -GENERIC: ADC ( dst src -- ) -M: immediate ADC swap { BIN: 010 t HEX: 80 } immediate-1/4 ; -M: operand ADC OCT: 020 2-operand ; - -GENERIC: SBB ( dst src -- ) -M: immediate SBB swap { BIN: 011 t HEX: 80 } immediate-1/4 ; -M: operand SBB OCT: 030 2-operand ; - -GENERIC: AND ( dst src -- ) -M: immediate AND swap { BIN: 100 t HEX: 80 } immediate-1/4 ; -M: operand AND OCT: 040 2-operand ; - -GENERIC: SUB ( dst src -- ) -M: immediate SUB swap { BIN: 101 t HEX: 80 } immediate-1/4 ; -M: operand SUB OCT: 050 2-operand ; - -GENERIC: XOR ( dst src -- ) -M: immediate XOR swap { BIN: 110 t HEX: 80 } immediate-1/4 ; -M: operand XOR OCT: 060 2-operand ; - -GENERIC: CMP ( dst src -- ) -M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ; -M: operand CMP OCT: 070 2-operand ; - -: NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ; -: NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ; -: MUL ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ; -: IMUL ( src -- ) { BIN: 101 t HEX: f7 } 1-operand ; -: DIV ( dst -- ) { BIN: 110 t HEX: f7 } 1-operand ; -: IDIV ( src -- ) { BIN: 111 t HEX: f7 } 1-operand ; - -: CDQ ( -- ) HEX: 99 , ; -: CQO ( -- ) HEX: 48 , CDQ ; - -: ROL ( dst n -- ) swap { BIN: 000 t HEX: c0 } immediate-1 ; -: ROR ( dst n -- ) swap { BIN: 001 t HEX: c0 } immediate-1 ; -: RCL ( dst n -- ) swap { BIN: 010 t HEX: c0 } immediate-1 ; -: RCR ( dst n -- ) swap { BIN: 011 t HEX: c0 } immediate-1 ; -: SHL ( dst n -- ) swap { BIN: 100 t HEX: c0 } immediate-1 ; -: SHR ( dst n -- ) swap { BIN: 101 t HEX: c0 } immediate-1 ; -: SAR ( dst n -- ) swap { BIN: 111 t HEX: c0 } immediate-1 ; - -GENERIC: IMUL2 ( dst src -- ) -M: immediate IMUL2 swap dup reg-code t HEX: 68 3array immediate-1/4 ; -M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ; - -: MOVSX ( dst src -- ) - dup register-32? OCT: 143 OCT: 276 extended-opcode ? - over register-16? [ BIN: 1 opcode-or ] when - swapd - (2-operand) ; - -! Conditional move -: MOVcc ( dst src cc -- ) extended-opcode swapd (2-operand) ; - -: CMOVO ( dst src -- ) HEX: 40 MOVcc ; -: CMOVNO ( dst src -- ) HEX: 41 MOVcc ; -: CMOVB ( dst src -- ) HEX: 42 MOVcc ; -: CMOVAE ( dst src -- ) HEX: 43 MOVcc ; -: CMOVE ( dst src -- ) HEX: 44 MOVcc ; ! aka CMOVZ -: CMOVNE ( dst src -- ) HEX: 45 MOVcc ; -: CMOVBE ( dst src -- ) HEX: 46 MOVcc ; -: CMOVA ( dst src -- ) HEX: 47 MOVcc ; -: CMOVS ( dst src -- ) HEX: 48 MOVcc ; -: CMOVNS ( dst src -- ) HEX: 49 MOVcc ; -: CMOVP ( dst src -- ) HEX: 4a MOVcc ; -: CMOVNP ( dst src -- ) HEX: 4b MOVcc ; -: CMOVL ( dst src -- ) HEX: 4c MOVcc ; -: CMOVGE ( dst src -- ) HEX: 4d MOVcc ; -: CMOVLE ( dst src -- ) HEX: 4e MOVcc ; -: CMOVG ( dst src -- ) HEX: 4f MOVcc ; - -! CPU Identification - -: CPUID ( -- ) HEX: a2 extended-opcode, ; - -! x87 Floating Point Unit - -: FSTPS ( operand -- ) { BIN: 011 f HEX: d9 } 1-operand ; -: FSTPL ( operand -- ) { BIN: 011 f HEX: dd } 1-operand ; - -: FLDS ( operand -- ) { BIN: 000 f HEX: d9 } 1-operand ; -: FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ; - -! SSE multimedia instructions - - - -: MOVSS ( dest src -- ) HEX: 10 HEX: f3 2-operand-sse ; -: MOVSD ( dest src -- ) HEX: 10 HEX: f2 2-operand-sse ; -: ADDSD ( dest src -- ) HEX: 58 HEX: f2 2-operand-sse ; -: MULSD ( dest src -- ) HEX: 59 HEX: f2 2-operand-sse ; -: SUBSD ( dest src -- ) HEX: 5c HEX: f2 2-operand-sse ; -: DIVSD ( dest src -- ) HEX: 5e HEX: f2 2-operand-sse ; -: SQRTSD ( dest src -- ) HEX: 51 HEX: f2 2-operand-sse ; -: UCOMISD ( dest src -- ) HEX: 2e HEX: 66 2-operand-sse ; -: COMISD ( dest src -- ) HEX: 2f HEX: 66 2-operand-sse ; - -: CVTSS2SD ( dest src -- ) HEX: 5a HEX: f3 2-operand-sse ; -: CVTSD2SS ( dest src -- ) HEX: 5a HEX: f2 2-operand-sse ; - -: CVTSI2SD ( dest src -- ) HEX: 2a HEX: f2 2-operand-int/sse ; -: CVTSD2SI ( dest src -- ) HEX: 2d HEX: f2 2-operand-int/sse ; -: CVTTSD2SI ( dest src -- ) HEX: 2c HEX: f2 2-operand-int/sse ; From 7134fad54cfe4365ac0ff9e23246cc712a524874 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 02:17:22 -0600 Subject: [PATCH 10/14] Add more unit tests highlighting the problem: predicate -vs- union comparison is broken --- core/classes/predicate/predicate-tests.factor | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/core/classes/predicate/predicate-tests.factor b/core/classes/predicate/predicate-tests.factor index 9f3b3e2141..3de073f774 100644 --- a/core/classes/predicate/predicate-tests.factor +++ b/core/classes/predicate/predicate-tests.factor @@ -1,9 +1,16 @@ -USING: math tools.test ; +USING: math tools.test classes.algebra ; IN: classes.predicate PREDICATE: negative < integer 0 < ; PREDICATE: positive < integer 0 > ; +[ t ] [ negative integer class< ] unit-test +[ t ] [ positive integer class< ] unit-test +[ f ] [ integer negative class< ] unit-test +[ f ] [ integer positive class< ] unit-test +[ f ] [ negative negative class< ] unit-test +[ f ] [ positive negative class< ] unit-test + GENERIC: abs ( n -- n ) M: integer abs ; M: negative abs -1 * ; From 9b492b55e0b4f5b944974f71c6bbdc8c2f668cfb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 02:17:37 -0600 Subject: [PATCH 11/14] Fix minor leak: class-caches were not reset if a class was forgotten --- core/classes/classes-tests.factor | 13 ++++++++++++- core/classes/classes.factor | 3 ++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 1dee6a095c..dd12674cc4 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -3,7 +3,8 @@ kernel math namespaces parser prettyprint sequences strings tools.test vectors words quotations classes classes.private classes.union classes.mixin classes.predicate classes.algebra vectors definitions source-files -compiler.units kernel.private sorting vocabs ; +compiler.units kernel.private sorting vocabs memory eval +accessors ; IN: classes.tests [ t ] [ 3 object instance? ] unit-test @@ -27,3 +28,13 @@ M: method-forget-class method-forget-test ; implementors-map get keys [ natural-sort ] bi@ = ] unit-test + +! Minor leak +[ ] [ "IN: classes.tests TUPLE: forget-me ;" eval ] unit-test +[ ] [ f \ word set-global ] unit-test +[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval ] unit-test +[ ] [ "IN: classes.tests FORGET: forget-me" eval ] unit-test +[ 0 ] [ + [ word? ] instances + [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count +] unit-test diff --git a/core/classes/classes.factor b/core/classes/classes.factor index dcb69c9149..70fb869c5c 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -176,7 +176,8 @@ GENERIC: class-forgotten ( use class -- ) [ implementors-map- ] [ update-map- ] [ reset-class ] - } cleave ; + } cleave + reset-caches ; M: class class-forgotten nip forget-class ; From cc94894441c876a406212d6c5ad05d4d01637f1a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 03:38:44 -0600 Subject: [PATCH 12/14] Fix notorious classes-intersect? bug, or at least one manifestation thereof. Turns out that we may temporarily end up with forgotten classes in the compiled-generic-crossref table. This is not a problem, since subsequently the words that reference forgotten classes will presumably be redefined and recompiled, but it does mean that (compiled-generic-usage) does need to handle this case --- core/classes/classes-tests.factor | 51 ++++++++++++++++++++++++++++--- core/compiler/units/units.factor | 9 +++--- 2 files changed, 51 insertions(+), 9 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index dd12674cc4..c7900da316 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -1,10 +1,9 @@ USING: alien arrays definitions generic assocs hashtables io -kernel math namespaces parser prettyprint sequences strings -tools.test vectors words quotations classes +io.streams.string kernel math namespaces parser prettyprint +sequences strings tools.test vectors words quotations classes classes.private classes.union classes.mixin classes.predicate -classes.algebra vectors definitions source-files -compiler.units kernel.private sorting vocabs memory eval -accessors ; +classes.algebra vectors definitions source-files compiler.units +kernel.private sorting vocabs memory eval accessors ; IN: classes.tests [ t ] [ 3 object instance? ] unit-test @@ -38,3 +37,45 @@ M: method-forget-class method-forget-test ; [ word? ] instances [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count ] unit-test + +! Long-standing problem +USE: multiline + +! So the user has some code... +[ ] [ + <" IN: classes.test.a + GENERIC: g ( a -- b ) + TUPLE: x ; + M: x g ; + TUPLE: z < x ;"> + "class-intersect-no-method-a" parse-stream drop +] unit-test + +! Note that q inlines M: x g ; +[ ] [ + <" IN: classes.test.b + USE: classes.test.a + USE: kernel + : q ( -- b ) z new g ;"> + "class-intersect-no-method-b" parse-stream drop +] unit-test + +! Now, the user removes the z class and adds a method, +[ ] [ + <" IN: classes.test.a + GENERIC: g ( a -- b ) + TUPLE: x ; + M: x g ; + TUPLE: j ; + M: j g ;"> + "class-intersect-no-method-a" parse-stream drop +] unit-test + +! And changes the definition of q +[ ] [ + <" IN: classes.test.b + USE: classes.test.a + USE: kernel + : q ( -- b ) j new g ;"> + "class-intersect-no-method-b" parse-stream drop +] unit-test diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 973d9b5c00..1b6b934dae 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -109,10 +109,11 @@ SYMBOL: remake-generics-hook compiled-generic-crossref get at ; : (compiled-generic-usages) ( generic class -- assoc ) - dup class? [ - [ compiled-generic-usage ] dip - [ classes-intersect? nip ] curry assoc-filter - ] [ 2drop f ] if ; + [ compiled-generic-usage ] dip + [ + 2dup [ class? ] both? + [ classes-intersect? ] [ 2drop f ] if nip + ] curry assoc-filter ; : compiled-generic-usages ( assoc -- assocs ) [ (compiled-generic-usages) ] { } assoc>map ; From fb64c1cb4560b2081da832b6528029b1465be8cf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 04:59:54 -0600 Subject: [PATCH 13/14] Fix class<=; a predicate class derived from a union was not reported as being contained in the union --- core/classes/algebra/algebra.factor | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index b32bac3a18..51dad033a9 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -55,7 +55,7 @@ DEFER: (class-or) class-or-cache get [ (class-or) ] 2cache ; : superclass<= ( first second -- ? ) - >r superclass r> class<= ; + swap superclass dup [ swap class<= ] [ 2drop f ] if ; : left-anonymous-union<= ( first second -- ? ) >r members>> r> [ class<= ] curry all? ; @@ -103,19 +103,20 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ; : (class<=) ( first second -- -1/0/1 ) 2dup eq? [ 2drop t ] [ - [ normalize-class ] bi@ { - { [ dup empty-intersection? ] [ 2drop t ] } - { [ over empty-union? ] [ 2drop t ] } - { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] } - { [ over anonymous-union? ] [ left-anonymous-union<= ] } - { [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] } - { [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] } - { [ dup anonymous-union? ] [ right-anonymous-union<= ] } - { [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] } - { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] } - { [ over superclass ] [ superclass<= ] } - [ 2drop f ] - } cond + 2dup superclass<= [ 2drop t ] [ + [ normalize-class ] bi@ { + { [ dup empty-intersection? ] [ 2drop t ] } + { [ over empty-union? ] [ 2drop t ] } + { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] } + { [ over anonymous-union? ] [ left-anonymous-union<= ] } + { [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] } + { [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] } + { [ dup anonymous-union? ] [ right-anonymous-union<= ] } + { [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] } + { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] } + [ 2drop f ] + } cond + ] if ] if ; M: anonymous-union (classes-intersect?) From d8345b5eda090cc5abef7b94e4d4e9388a928764 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 06:07:19 -0600 Subject: [PATCH 14/14] Update PPC non-optimizing compiler backend: there are three new sub-primitives to support --- basis/cpu/ppc/bootstrap.factor | 43 +++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 99bcfae92a..47c31111a9 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -3,7 +3,7 @@ USING: bootstrap.image.private kernel kernel.private namespaces system cpu.ppc.assembler compiler.codegen.fixup compiler.units compiler.constants math math.private layouts words words.private -vocabs slots.private ; +vocabs slots.private locals.backend ; IN: bootstrap.ppc 4 \ cell set @@ -305,4 +305,45 @@ big-endian on 3 ds-reg 0 STW ] f f f \ fixnum-bitnot define-sub-primitive +[ + 3 ds-reg 0 LWZ + 3 3 tag-bits get SRAWI + ds-reg ds-reg 4 SUBI + 4 ds-reg 0 LWZ + 5 4 3 SLW + 6 3 NEG + 7 4 6 SRAW + 7 7 0 0 31 tag-bits get - RLWINM + 0 3 0 CMPI + 2 BGT + 5 7 MR + 5 ds-reg 0 STW +] f f f \ fixnum-shift-fast define-sub-primitive + +[ + 3 ds-reg 0 LWZ + ds-reg ds-reg 4 SUBI + 4 ds-reg 0 LWZ + 5 4 3 DIVW + 6 5 3 MULLW + 7 6 4 SUBF + 7 ds-reg 0 STW +] f f f \ fixnum-mod define-sub-primitive + +[ + 3 ds-reg 0 LWZ + 3 3 1 SRAWI + 4 4 LI + 4 3 4 SUBF + rs-reg 3 4 LWZX + 3 ds-reg 0 STW +] f f f \ get-local define-sub-primitive + +[ + 3 ds-reg 0 LWZ + ds-reg ds-reg 4 SUBI + 3 3 1 SRAWI + rs-reg 3 rs-reg SUBF +] f f f \ drop-locals define-sub-primitive + [ "bootstrap.ppc" forget-vocab ] with-compilation-unit