From 55f21855320825ecd57b16fcb3f7503cd62f7a6a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 10 Jun 2009 09:45:48 -0500 Subject: [PATCH 01/57] add an iota --- basis/compiler/tree/dead-code/branches/branches.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor index fd1b2d5adb..f027ccdb61 100644 --- a/basis/compiler/tree/dead-code/branches/branches.factor +++ b/basis/compiler/tree/dead-code/branches/branches.factor @@ -32,7 +32,7 @@ M: #branch remove-dead-code* pad-with-bottom >>phi-in-d drop ; : live-value-indices ( values -- indices ) - [ length ] keep live-values get + [ length iota ] keep live-values get '[ _ nth _ key? ] filter ; inline : drop-indexed-values ( values indices -- node ) From 21a89bab0e9d033a6aae0d813924017c282c9808 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 2 Sep 2009 12:06:38 +0200 Subject: [PATCH 02/57] Make "divisors" work with 1 as well --- basis/math/primes/factors/factors-tests.factor | 1 + basis/math/primes/factors/factors.factor | 8 ++++++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/basis/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor index eea59b6f9b..02610e941e 100644 --- a/basis/math/primes/factors/factors-tests.factor +++ b/basis/math/primes/factors/factors-tests.factor @@ -10,3 +10,4 @@ USING: math.primes.factors sequences tools.test ; { { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test { { 1 2 3 4 6 8 12 24 } } [ 24 divisors ] unit-test { 24 } [ 360 divisors length ] unit-test +{ { 1 } } [ 1 divisors ] unit-test diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor index da1c36196b..c71fa18ab2 100644 --- a/basis/math/primes/factors/factors.factor +++ b/basis/math/primes/factors/factors.factor @@ -43,5 +43,9 @@ PRIVATE> } cond ; foldable : divisors ( n -- seq ) - group-factors [ first2 [0,b] [ ^ ] with map ] map - [ product ] product-map natural-sort ; + dup 1 = [ + 1array + ] [ + group-factors [ first2 [0,b] [ ^ ] with map ] map + [ product ] product-map natural-sort + ] if ; From 389f47086af25e5708c39f052086b47098801c40 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 2 Sep 2009 05:19:20 -0500 Subject: [PATCH 03/57] classes.tuple: don't run out of memory inside 'instances' quotation if optimizing compiler is off --- core/classes/tuple/tuple.factor | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 5f24417c4b..44eae9038f 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -201,16 +201,14 @@ SYMBOL: outdated-tuples slots>tuple ; : outdated-tuple? ( tuple assoc -- ? ) - over tuple? [ - [ [ layout-of ] dip key? ] - [ drop class "forgotten" word-prop not ] - 2bi and - ] [ 2drop f ] if ; + [ [ layout-of ] dip key? ] + [ drop class "forgotten" word-prop not ] + 2bi and ; : update-tuples ( -- ) outdated-tuples get dup assoc-empty? [ drop ] [ - [ outdated-tuple? ] curry instances + [ [ tuple? ] instances ] dip [ outdated-tuple? ] curry filter dup [ update-tuple ] map become ] if ; From 85a2bfab6cfb8bd56af677b6b43908f6313be109 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 2 Sep 2009 06:22:37 -0500 Subject: [PATCH 04/57] compiler: eliminate boilerplate by centralizing info in declarative INSN: syntax --- .../cfg/alias-analysis/alias-analysis.factor | 15 +- basis/compiler/cfg/builder/builder.factor | 2 +- basis/compiler/cfg/checker/checker.factor | 3 +- basis/compiler/cfg/dce/dce.factor | 30 +- basis/compiler/cfg/def-use/def-use.factor | 80 +- basis/compiler/cfg/hats/hats.factor | 125 ++- .../cfg/instructions/instructions.factor | 716 ++++++++++++------ .../cfg/instructions/syntax/syntax.factor | 76 +- .../cfg/intrinsics/fixnum/fixnum.factor | 3 +- .../cfg/intrinsics/slots/slots.factor | 2 +- .../linear-scan/assignment/assignment.factor | 2 +- .../cfg/renaming/functor/functor.factor | 167 +--- .../preferred/preferred.factor | 84 +- .../cfg/two-operand/two-operand.factor | 4 +- .../expressions/expressions.factor | 109 +-- .../cfg/value-numbering/graph/graph.factor | 5 +- .../value-numbering/rewrite/rewrite.factor | 57 +- .../value-numbering/simplify/simplify.factor | 79 +- .../value-numbering/value-numbering.factor | 15 +- basis/compiler/codegen/codegen.factor | 306 +++----- basis/cpu/architecture/architecture.factor | 6 +- basis/cpu/ppc/ppc.factor | 26 +- basis/cpu/x86/x86.factor | 27 +- 23 files changed, 969 insertions(+), 970 deletions(-) diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 526df79cb3..fcfc89ea52 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math namespaces assocs hashtables sequences arrays -accessors vectors combinators sets classes cpu.architecture compiler.cfg -compiler.cfg.registers compiler.cfg.instructions -compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.liveness ; +accessors vectors combinators sets classes cpu.architecture +compiler.cfg compiler.cfg.registers compiler.cfg.instructions +compiler.cfg.def-use compiler.cfg.copy-prop compiler.cfg.rpo +compiler.cfg.liveness ; IN: compiler.cfg.alias-analysis ! We try to eliminate redundant slot operations using some simple heuristics. @@ -211,12 +212,12 @@ M: ##alien-global insn-object drop \ ##alien-global ; GENERIC: analyze-aliases* ( insn -- insn' ) +M: insn analyze-aliases* + dup defs-vreg [ set-heap-ac ] when* ; + M: ##load-immediate analyze-aliases* dup [ val>> ] [ dst>> ] bi constants get set-at ; -M: ##flushable analyze-aliases* - dup dst>> set-heap-ac ; - M: ##allocation analyze-aliases* #! A freshly allocated object is distinct from any other #! object. @@ -246,8 +247,6 @@ M: ##copy analyze-aliases* #! vreg, since they both contain the same value. dup record-copy ; -M: insn analyze-aliases* ; - : analyze-aliases ( insns -- insns' ) [ insn# set analyze-aliases* ] map-index sift ; diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 7b74d1c258..8f52071e22 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -131,7 +131,7 @@ M: #recursive emit-node : emit-actual-if ( #if -- ) ! Inputs to the final instruction need to be copied because of ! loc>vreg sync - ds-pop ^^copy \ f tag-number cc/= ##compare-imm-branch emit-if ; + ds-pop any-rep ^^copy \ f tag-number cc/= ##compare-imm-branch emit-if ; M: #if emit-node { diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 07e6cc8cea..cf15d68b59 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -21,8 +21,9 @@ ERROR: last-insn-not-a-jump bb ; dup instructions>> last { [ ##branch? ] [ ##dispatch? ] - [ ##conditional-branch? ] + [ ##compare-branch? ] [ ##compare-imm-branch? ] + [ ##compare-float-branch? ] [ ##fixnum-add? ] [ ##fixnum-sub? ] [ ##fixnum-mul? ] diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor index dd42475a13..363cea7852 100644 --- a/basis/compiler/cfg/dce/dce.factor +++ b/basis/compiler/cfg/dce/dce.factor @@ -42,14 +42,11 @@ M: ##set-slot-imm build-liveness-graph M: ##write-barrier build-liveness-graph dup src>> setter-liveness-graph ; -M: ##flushable build-liveness-graph - dup dst>> add-edges ; - M: ##allot build-liveness-graph - [ dst>> allocations get conjoin ] - [ call-next-method ] bi ; + [ dst>> allocations get conjoin ] [ call-next-method ] bi ; -M: insn build-liveness-graph drop ; +M: insn build-liveness-graph + dup defs-vreg dup [ add-edges ] [ 2drop ] if ; GENERIC: compute-live-vregs ( insn -- ) @@ -77,24 +74,35 @@ M: ##set-slot-imm compute-live-vregs M: ##write-barrier compute-live-vregs dup src>> setter-live-vregs ; -M: ##flushable compute-live-vregs drop ; +M: ##fixnum-add compute-live-vregs record-live ; + +M: ##fixnum-sub compute-live-vregs record-live ; + +M: ##fixnum-mul compute-live-vregs record-live ; M: insn compute-live-vregs - record-live ; + dup defs-vreg [ drop ] [ record-live ] if ; GENERIC: live-insn? ( insn -- ? ) -M: ##flushable live-insn? dst>> live-vreg? ; - M: ##set-slot live-insn? obj>> live-vreg? ; M: ##set-slot-imm live-insn? obj>> live-vreg? ; M: ##write-barrier live-insn? src>> live-vreg? ; -M: insn live-insn? drop t ; +M: ##fixnum-add live-insn? drop t ; + +M: ##fixnum-sub live-insn? drop t ; + +M: ##fixnum-mul live-insn? drop t ; + +M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ; : eliminate-dead-code ( cfg -- cfg' ) + ! Even though we don't use predecessors directly, we depend + ! on the predecessors pass updating phi nodes to remove dead + ! inputs. needs-predecessors init-dead-code diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index 3102d75a4e..559160408d 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -1,55 +1,49 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel assocs sequences namespaces fry -sets compiler.cfg.rpo compiler.cfg.instructions locals ; +USING: accessors assocs classes combinators compiler.units fry +generalizations generic kernel locals namespaces quotations +sequences sets slots words compiler.cfg.instructions +compiler.cfg.instructions.syntax compiler.cfg.rpo ; IN: compiler.cfg.def-use GENERIC: defs-vreg ( insn -- vreg/f ) GENERIC: temp-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq ) -M: ##flushable defs-vreg dst>> ; -M: ##fixnum-overflow defs-vreg dst>> ; -M: _fixnum-overflow defs-vreg dst>> ; -M: insn defs-vreg drop f ; - -M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ; -M: ##unary/temp temp-vregs temp>> 1array ; -M: ##allot temp-vregs temp>> 1array ; -M: ##dispatch temp-vregs temp>> 1array ; -M: ##slot temp-vregs temp>> 1array ; -M: ##set-slot temp-vregs temp>> 1array ; -M: ##string-nth temp-vregs temp>> 1array ; -M: ##set-string-nth-fast temp-vregs temp>> 1array ; -M: ##box-displaced-alien temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ; -M: ##compare temp-vregs temp>> 1array ; -M: ##compare-imm temp-vregs temp>> 1array ; -M: ##compare-float temp-vregs temp>> 1array ; -M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ; -M: _dispatch temp-vregs temp>> 1array ; -M: insn temp-vregs drop f ; - -M: ##unary uses-vregs src>> 1array ; -M: ##binary uses-vregs [ src1>> ] [ src2>> ] bi 2array ; -M: ##binary-imm uses-vregs src1>> 1array ; -M: ##effect uses-vregs src>> 1array ; -M: ##slot uses-vregs [ obj>> ] [ slot>> ] bi 2array ; -M: ##slot-imm uses-vregs obj>> 1array ; -M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ; -M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ; -M: ##string-nth uses-vregs [ obj>> ] [ index>> ] bi 2array ; -M: ##set-string-nth-fast uses-vregs [ src>> ] [ obj>> ] [ index>> ] tri 3array ; -M: ##conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ; -M: ##compare-imm-branch uses-vregs src1>> 1array ; -M: ##dispatch uses-vregs src>> 1array ; -M: ##alien-getter uses-vregs src>> 1array ; -M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ; -M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ; M: ##phi uses-vregs inputs>> values ; -M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ; -M: _compare-imm-branch uses-vregs src1>> 1array ; -M: _dispatch uses-vregs src>> 1array ; -M: insn uses-vregs drop f ; + +> reader-word 1quotation ] [ [ drop f ] ] if* ] bi + define ; + +: define-uses-vregs-method ( insn -- ) + [ \ uses-vregs create-method ] + [ insn-use-slots [ name>> ] map slot-array-quot ] bi + define ; + +: define-temp-vregs-method ( insn -- ) + [ \ temp-vregs create-method ] + [ insn-temp-slots [ name>> ] map slot-array-quot ] bi + define ; + +PRIVATE> + +[ + insn-classes get + [ [ define-defs-vreg-method ] each ] + [ { ##phi } diff [ define-uses-vregs-method ] each ] + [ [ define-temp-vregs-method ] each ] + tri +] with-compilation-unit ! Computing def-use chains. diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 2d79cbebc3..469ba37703 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -1,83 +1,60 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays byte-arrays kernel layouts math namespaces -sequences classes.tuple cpu.architecture compiler.cfg.registers -compiler.cfg.instructions ; +USING: accessors arrays byte-arrays kernel layouts math +namespaces sequences combinators splitting parser effects +words cpu.architecture compiler.cfg.registers +compiler.cfg.instructions compiler.cfg.instructions.syntax ; IN: compiler.cfg.hats -: ^^r ( -- vreg vreg ) next-vreg dup ; inline -: ^^r1 ( obj -- vreg vreg obj ) [ ^^r ] dip ; inline -: ^^r2 ( obj obj -- vreg vreg obj obj ) [ ^^r ] 2dip ; inline -: ^^r3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^r ] 3dip ; inline +<< + +> "##" ?head drop "^^" prepend create-in ; + +: hat-quot ( insn -- quot ) + [ + "insn-slots" word-prop [ ] [ + type>> { + { def [ [ next-vreg dup ] ] } + { temp [ [ next-vreg ] ] } + [ drop [ ] ] + } case swap [ dip ] curry compose + ] reduce + ] keep suffix ; + +: hat-effect ( insn -- effect ) + "insn-slots" word-prop + [ type>> { def temp } memq? not ] filter [ name>> ] map + { "vreg" } ; + +: define-hat ( insn -- ) + [ hat-name ] [ hat-quot ] [ hat-effect ] tri define-inline ; + +PRIVATE> + +insn-classes get [ + dup [ insn-def-slot ] [ name>> "##" head? ] bi and + [ define-hat ] [ drop ] if +] each + +>> + +: ^^load-literal ( obj -- dst ) + [ next-vreg dup ] dip { + { [ dup not ] [ drop \ f tag-number ##load-immediate ] } + { [ dup fixnum? ] [ tag-fixnum ##load-immediate ] } + [ ##load-reference ] + } cond ; inline + +: ^^unbox-c-ptr ( src class -- dst ) + [ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ; inline -: ^^load-literal ( obj -- dst ) ^^r1 ##load-literal ; inline -: ^^copy ( src -- dst ) ^^r1 any-rep ##copy ; inline -: ^^slot ( obj slot tag -- dst ) ^^r3 next-vreg ##slot ; inline -: ^^slot-imm ( obj slot tag -- dst ) ^^r3 ##slot-imm ; inline -: ^^set-slot ( src obj slot tag -- ) next-vreg ##set-slot ; inline -: ^^string-nth ( obj index -- dst ) ^^r2 next-vreg ##string-nth ; inline -: ^^add ( src1 src2 -- dst ) ^^r2 ##add ; inline -: ^^add-imm ( src1 src2 -- dst ) ^^r2 ##add-imm ; inline -: ^^sub ( src1 src2 -- dst ) ^^r2 ##sub ; inline -: ^^sub-imm ( src1 src2 -- dst ) ^^r2 ##sub-imm ; inline : ^^neg ( src -- dst ) [ 0 ^^load-literal ] dip ^^sub ; inline -: ^^mul ( src1 src2 -- dst ) ^^r2 ##mul ; inline -: ^^mul-imm ( src1 src2 -- dst ) ^^r2 ##mul-imm ; inline -: ^^and ( input mask -- output ) ^^r2 ##and ; inline -: ^^and-imm ( input mask -- output ) ^^r2 ##and-imm ; inline -: ^^or ( src1 src2 -- dst ) ^^r2 ##or ; inline -: ^^or-imm ( src1 src2 -- dst ) ^^r2 ##or-imm ; inline -: ^^xor ( src1 src2 -- dst ) ^^r2 ##xor ; inline -: ^^xor-imm ( src1 src2 -- dst ) ^^r2 ##xor-imm ; inline -: ^^shl ( src1 src2 -- dst ) ^^r2 ##shl ; inline -: ^^shl-imm ( src1 src2 -- dst ) ^^r2 ##shl-imm ; inline -: ^^shr ( src1 src2 -- dst ) ^^r2 ##shr ; inline -: ^^shr-imm ( src1 src2 -- dst ) ^^r2 ##shr-imm ; inline -: ^^sar ( src1 src2 -- dst ) ^^r2 ##sar ; inline -: ^^sar-imm ( src1 src2 -- dst ) ^^r2 ##sar-imm ; inline -: ^^min ( src1 src2 -- dst ) ^^r2 ##min ; inline -: ^^max ( src1 src2 -- dst ) ^^r2 ##max ; inline -: ^^not ( src -- dst ) ^^r1 ##not ; inline -: ^^log2 ( src -- dst ) ^^r1 ##log2 ; inline -: ^^bignum>integer ( src -- dst ) ^^r1 next-vreg ##bignum>integer ; inline -: ^^integer>bignum ( src -- dst ) ^^r1 next-vreg ##integer>bignum ; inline -: ^^add-float ( src1 src2 -- dst ) ^^r2 ##add-float ; inline -: ^^sub-float ( src1 src2 -- dst ) ^^r2 ##sub-float ; inline -: ^^mul-float ( src1 src2 -- dst ) ^^r2 ##mul-float ; inline -: ^^div-float ( src1 src2 -- dst ) ^^r2 ##div-float ; inline -: ^^max-float ( src1 src2 -- dst ) ^^r2 ##max-float ; inline -: ^^min-float ( src1 src2 -- dst ) ^^r2 ##min-float ; inline -: ^^unary-float-function ( src func -- dst ) ^^r2 ##unary-float-function ; inline -: ^^binary-float-function ( src1 src2 func -- dst ) ^^r3 ##binary-float-function ; inline -: ^^sqrt ( src -- dst ) ^^r1 ##sqrt ; inline -: ^^float>integer ( src -- dst ) ^^r1 ##float>integer ; inline -: ^^integer>float ( src -- dst ) ^^r1 ##integer>float ; inline -: ^^allot ( size class -- dst ) ^^r2 next-vreg ##allot ; inline : ^^allot-tuple ( n -- dst ) 2 + cells tuple ^^allot ; inline : ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline : ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline -: ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline -: ^^box-displaced-alien ( base displacement base-class -- dst ) - ^^r3 [ next-vreg next-vreg ] dip ##box-displaced-alien ; inline -: ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline -: ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ; -: ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline -: ^^alien-unsigned-2 ( src -- dst ) ^^r1 ##alien-unsigned-2 ; inline -: ^^alien-unsigned-4 ( src -- dst ) ^^r1 ##alien-unsigned-4 ; inline -: ^^alien-signed-1 ( src -- dst ) ^^r1 ##alien-signed-1 ; inline -: ^^alien-signed-2 ( src -- dst ) ^^r1 ##alien-signed-2 ; inline -: ^^alien-signed-4 ( src -- dst ) ^^r1 ##alien-signed-4 ; inline -: ^^alien-cell ( src -- dst ) ^^r1 ##alien-cell ; inline -: ^^alien-float ( src -- dst ) ^^r1 ##alien-float ; inline -: ^^alien-double ( src -- dst ) ^^r1 ##alien-double ; inline -: ^^alien-global ( symbol library -- dst ) ^^r2 ##alien-global ; inline -: ^^compare ( src1 src2 cc -- dst ) ^^r3 next-vreg ##compare ; inline -: ^^compare-imm ( src1 src2 cc -- dst ) ^^r3 next-vreg ##compare-imm ; inline -: ^^compare-float ( src1 src2 cc -- dst ) ^^r3 next-vreg ##compare-float ; inline -: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ ^^copy ] if ; inline -: ^^tag-fixnum ( src -- dst ) ^^r1 ##tag-fixnum ; inline -: ^^untag-fixnum ( src -- dst ) ^^r1 ##untag-fixnum ; inline -: ^^fixnum-add ( src1 src2 -- dst ) ^^r2 ##fixnum-add ; inline -: ^^fixnum-sub ( src1 src2 -- dst ) ^^r2 ##fixnum-sub ; inline -: ^^fixnum-mul ( src1 src2 -- dst ) ^^r2 ##fixnum-mul ; inline -: ^^phi ( inputs -- dst ) ^^r1 ##phi ; inline \ No newline at end of file +: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline +: ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline +: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline \ No newline at end of file diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index a7cc2e0603..aac76c835a 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -1,132 +1,284 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors arrays kernel sequences namespaces words -math math.order layouts classes.algebra alien byte-arrays -compiler.constants combinators compiler.cfg.registers -compiler.cfg.instructions.syntax ; +math math.order layouts classes.algebra classes.union +compiler.units alien byte-arrays compiler.constants combinators +compiler.cfg.registers compiler.cfg.instructions.syntax ; IN: compiler.cfg.instructions +<< +SYMBOL: insn-classes +V{ } clone insn-classes set-global +>> + : new-insn ( ... class -- insn ) f swap boa ; inline ! Virtual CPU instructions, used by CFG and machine IRs TUPLE: insn ; -! Instruction with no side effects; if 'out' is never read, we -! can eliminate it. -TUPLE: ##flushable < insn dst ; - -! Instruction which is referentially transparent; we can replace -! repeated computation with a reference to a previous value -TUPLE: ##pure < ##flushable ; - -TUPLE: ##unary < ##pure src ; -TUPLE: ##unary/temp < ##unary temp ; -TUPLE: ##binary < ##pure src1 src2 ; -TUPLE: ##binary-imm < ##pure src1 { src2 integer } ; -TUPLE: ##commutative < ##binary ; -TUPLE: ##commutative-imm < ##binary-imm ; - -! Instruction only used for its side effect, produces no values -TUPLE: ##effect < insn src ; - -! Read/write ops: candidates for alias analysis -TUPLE: ##read < ##flushable ; -TUPLE: ##write < ##effect ; - -TUPLE: ##alien-getter < ##flushable src ; -TUPLE: ##alien-setter < ##effect value ; +! Instructions which are referentially transparent; used for +! value numbering +TUPLE: pure-insn < insn ; ! Stack operations -INSN: ##load-immediate < ##pure { val integer } ; -INSN: ##load-reference < ##pure obj ; +INSN: ##load-immediate +def: dst/int-rep +constant: val ; -GENERIC: ##load-literal ( dst value -- ) +INSN: ##load-reference +def: dst/int-rep +constant: obj ; -M: fixnum ##load-literal tag-fixnum ##load-immediate ; -M: f ##load-literal drop \ f tag-number ##load-immediate ; -M: object ##load-literal ##load-reference ; +INSN: ##peek +def: dst/int-rep +literal: loc ; -INSN: ##peek < ##flushable { loc loc } ; -INSN: ##replace < ##effect { loc loc } ; -INSN: ##inc-d { n integer } ; -INSN: ##inc-r { n integer } ; +INSN: ##replace +use: src/int-rep +literal: loc ; + +INSN: ##inc-d +literal: n ; + +INSN: ##inc-r +literal: n ; ! Subroutine calls -INSN: ##call word ; -INSN: ##jump word ; +INSN: ##call +literal: word ; + +INSN: ##jump +literal: word ; + INSN: ##return ; ! Dummy instruction that simply inhibits TCO INSN: ##no-tco ; ! Jump tables -INSN: ##dispatch src temp ; +INSN: ##dispatch +use: src/int-rep +temp: temp/int-rep ; ! Slot access -INSN: ##slot < ##read obj slot { tag integer } temp ; -INSN: ##slot-imm < ##read obj { slot integer } { tag integer } ; -INSN: ##set-slot < ##write obj slot { tag integer } temp ; -INSN: ##set-slot-imm < ##write obj { slot integer } { tag integer } ; +INSN: ##slot +def: dst/int-rep +use: obj/int-rep slot/int-rep +literal: tag +temp: temp/int-rep ; + +INSN: ##slot-imm +def: dst/int-rep +use: obj/int-rep +literal: slot tag ; + +INSN: ##set-slot +use: src/int-rep obj/int-rep slot/int-rep +literal: tag +temp: temp/int-rep ; + +INSN: ##set-slot-imm +use: src/int-rep obj/int-rep +literal: slot tag ; ! String element access -INSN: ##string-nth < ##flushable obj index temp ; -INSN: ##set-string-nth-fast < ##effect obj index temp ; +INSN: ##string-nth +def: dst/int-rep +use: obj/int-rep index/int-rep +temp: temp/int-rep ; + +INSN: ##set-string-nth-fast +use: src/int-rep obj/int-rep index/int-rep +temp: temp/int-rep ; ! Integer arithmetic -INSN: ##add < ##commutative ; -INSN: ##add-imm < ##commutative-imm ; -INSN: ##sub < ##binary ; -INSN: ##sub-imm < ##binary-imm ; -INSN: ##mul < ##commutative ; -INSN: ##mul-imm < ##commutative-imm ; -INSN: ##and < ##commutative ; -INSN: ##and-imm < ##commutative-imm ; -INSN: ##or < ##commutative ; -INSN: ##or-imm < ##commutative-imm ; -INSN: ##xor < ##commutative ; -INSN: ##xor-imm < ##commutative-imm ; -INSN: ##shl < ##binary ; -INSN: ##shl-imm < ##binary-imm ; -INSN: ##shr < ##binary ; -INSN: ##shr-imm < ##binary-imm ; -INSN: ##sar < ##binary ; -INSN: ##sar-imm < ##binary-imm ; -INSN: ##min < ##binary ; -INSN: ##max < ##binary ; -INSN: ##not < ##unary ; -INSN: ##log2 < ##unary ; +PURE-INSN: ##add +def: dst/int-rep +use: src1/int-rep src2/int-rep ; -: ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline -: ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline +PURE-INSN: ##add-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##sub +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##sub-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##mul +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##mul-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##and +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##and-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##or +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##or-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##xor +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##xor-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##shl +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##shl-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##shr +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##shr-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##sar +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##sar-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 ; + +PURE-INSN: ##min +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##max +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +PURE-INSN: ##not +def: dst/int-rep +use: src/int-rep ; + +PURE-INSN: ##log2 +def: dst/int-rep +use: src/int-rep ; ! Bignum/integer conversion -INSN: ##integer>bignum < ##unary/temp ; -INSN: ##bignum>integer < ##unary/temp ; +PURE-INSN: ##integer>bignum +def: dst/int-rep +use: src/int-rep +temp: temp/int-rep ; + +PURE-INSN: ##bignum>integer +def: dst/int-rep +use: src/int-rep +temp: temp/int-rep ; ! Float arithmetic -INSN: ##add-float < ##commutative ; -INSN: ##sub-float < ##binary ; -INSN: ##mul-float < ##commutative ; -INSN: ##div-float < ##binary ; -INSN: ##min-float < ##binary ; -INSN: ##max-float < ##binary ; -INSN: ##sqrt < ##unary ; +PURE-INSN: ##add-float +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep ; + +PURE-INSN: ##sub-float +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep ; + +PURE-INSN: ##mul-float +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep ; + +PURE-INSN: ##div-float +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep ; + +PURE-INSN: ##min-float +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep ; + +PURE-INSN: ##max-float +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep ; + +PURE-INSN: ##sqrt +def: dst/double-float-rep +use: src/double-float-rep ; ! libc intrinsics -INSN: ##unary-float-function < ##unary func ; -INSN: ##binary-float-function < ##binary func ; +PURE-INSN: ##unary-float-function +def: dst/double-float-rep +use: src/double-float-rep +literal: func ; + +PURE-INSN: ##binary-float-function +def: dst/double-float-rep +use: src1/double-float-rep src2/double-float-rep +literal: func ; ! Float/integer conversion -INSN: ##float>integer < ##unary ; -INSN: ##integer>float < ##unary ; +PURE-INSN: ##float>integer +def: dst/int-rep +use: src/double-float-rep ; + +PURE-INSN: ##integer>float +def: dst/double-float-rep +use: src/int-rep ; ! Boxing and unboxing -INSN: ##copy < ##unary rep ; -INSN: ##unbox-float < ##unary ; -INSN: ##unbox-any-c-ptr < ##unary/temp ; -INSN: ##box-float < ##unary/temp ; -INSN: ##box-alien < ##unary/temp ; -INSN: ##box-displaced-alien < ##binary temp1 temp2 base-class ; +PURE-INSN: ##copy +def: dst +use: src +literal: rep ; + +PURE-INSN: ##unbox-float +def: dst/double-float-rep +use: src/int-rep ; + +PURE-INSN: ##unbox-any-c-ptr +def: dst/int-rep +use: src/int-rep +temp: temp/int-rep ; + +PURE-INSN: ##box-float +def: dst/int-rep +use: src/double-float-rep +temp: temp/int-rep ; + +PURE-INSN: ##box-alien +def: dst/int-rep +use: src/int-rep +temp: temp/int-rep ; + +PURE-INSN: ##box-displaced-alien +def: dst/int-rep +use: displacement/int-rep base/int-rep +temp: temp1/int-rep temp2/int-rep +literal: base-class ; : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ; : ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ; @@ -141,25 +293,219 @@ INSN: ##box-displaced-alien < ##binary temp1 temp2 base-class ; } cond ; ! Alien accessors -INSN: ##alien-unsigned-1 < ##alien-getter ; -INSN: ##alien-unsigned-2 < ##alien-getter ; -INSN: ##alien-unsigned-4 < ##alien-getter ; -INSN: ##alien-signed-1 < ##alien-getter ; -INSN: ##alien-signed-2 < ##alien-getter ; -INSN: ##alien-signed-4 < ##alien-getter ; -INSN: ##alien-cell < ##alien-getter ; -INSN: ##alien-float < ##alien-getter ; -INSN: ##alien-double < ##alien-getter ; +INSN: ##alien-unsigned-1 +def: dst/int-rep +use: src/int-rep ; -INSN: ##set-alien-integer-1 < ##alien-setter ; -INSN: ##set-alien-integer-2 < ##alien-setter ; -INSN: ##set-alien-integer-4 < ##alien-setter ; -INSN: ##set-alien-cell < ##alien-setter ; -INSN: ##set-alien-float < ##alien-setter ; -INSN: ##set-alien-double < ##alien-setter ; +INSN: ##alien-unsigned-2 +def: dst/int-rep +use: src/int-rep ; + +INSN: ##alien-unsigned-4 +def: dst/int-rep +use: src/int-rep ; + +INSN: ##alien-signed-1 +def: dst/int-rep +use: src/int-rep ; + +INSN: ##alien-signed-2 +def: dst/int-rep +use: src/int-rep ; + +INSN: ##alien-signed-4 +def: dst/int-rep +use: src/int-rep ; + +INSN: ##alien-cell +def: dst/int-rep +use: src/int-rep ; + +INSN: ##alien-float +def: dst/double-float-rep +use: src/int-rep ; + +INSN: ##alien-double +def: dst/double-float-rep +use: src/int-rep ; + +INSN: ##set-alien-integer-1 +use: src/int-rep value/int-rep ; + +INSN: ##set-alien-integer-2 +use: src/int-rep value/int-rep ; + +INSN: ##set-alien-integer-4 +use: src/int-rep value/int-rep ; + +INSN: ##set-alien-cell +use: src/int-rep value/int-rep ; + +INSN: ##set-alien-float +use: src/int-rep value/double-float-rep ; + +INSN: ##set-alien-double +use: src/int-rep value/double-float-rep ; ! Memory allocation -INSN: ##allot < ##flushable size class temp ; +INSN: ##allot +def: dst/int-rep +literal: size class +temp: temp/int-rep ; + +INSN: ##write-barrier +use: src/int-rep +temp: card#/int-rep table/int-rep ; + +INSN: ##alien-global +def: dst/int-rep +literal: symbol library ; + +! FFI +INSN: ##alien-invoke +literal: params stack-frame ; + +INSN: ##alien-indirect +literal: params stack-frame ; + +INSN: ##alien-callback +literal: params stack-frame ; + +INSN: ##callback-return +literal: params ; + +! Instructions used by CFG IR only. +INSN: ##prologue ; +INSN: ##epilogue ; + +INSN: ##branch ; + +INSN: ##phi +def: dst +literal: inputs ; + +! Conditionals +INSN: ##compare-branch +use: src1/int-rep src2/int-rep +literal: cc ; + +INSN: ##compare-imm-branch +use: src1/int-rep +constant: src2 +literal: cc ; + +PURE-INSN: ##compare +def: dst/int-rep +use: src1/int-rep src2/int-rep +literal: cc +temp: temp/int-rep ; + +PURE-INSN: ##compare-imm +def: dst/int-rep +use: src1/int-rep +constant: src2 +literal: cc +temp: temp/int-rep ; + +INSN: ##compare-float-branch +use: src1/double-float-rep src2/double-float-rep +literal: cc ; + +PURE-INSN: ##compare-float +def: dst/int-rep +use: src1/double-float-rep src2/double-float-rep +literal: cc +temp: temp/int-rep ; + +! Overflowing arithmetic +INSN: ##fixnum-add +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +INSN: ##fixnum-sub +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +INSN: ##fixnum-mul +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +INSN: ##gc +temp: temp1/int-rep temp2/int-rep +literal: data-values tagged-values uninitialized-locs ; + +! Instructions used by machine IR only. +INSN: _prologue +literal: stack-frame ; + +INSN: _epilogue +literal: stack-frame ; + +INSN: _label +literal: label ; + +INSN: _branch +literal: label ; + +INSN: _loop-entry ; + +INSN: _dispatch +use: src/int-rep +temp: temp ; + +INSN: _dispatch-label +literal: label ; + +INSN: _compare-branch +literal: label +use: src1/int-rep src2/int-rep +literal: cc ; + +INSN: _compare-imm-branch +literal: label +use: src1/int-rep +constant: src2 +literal: cc ; + +INSN: _compare-float-branch +literal: label +use: src1/int-rep src2/int-rep +literal: cc ; + +! Overflowing arithmetic +INSN: _fixnum-add +literal: label +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +INSN: _fixnum-sub +literal: label +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +INSN: _fixnum-mul +literal: label +def: dst/int-rep +use: src1/int-rep src2/int-rep ; + +TUPLE: spill-slot n ; C: spill-slot + +INSN: _gc +temp: temp1 temp2 +literal: data-values tagged-values uninitialized-locs ; + +! These instructions operate on machine registers and not +! virtual registers +INSN: _spill +use: src +literal: rep n ; + +INSN: _reload +def: dst +literal: rep n ; + +INSN: _spill-area-size +literal: n ; UNION: ##allocation ##allot @@ -168,149 +514,37 @@ UNION: ##allocation ##box-displaced-alien ##integer>bignum ; -INSN: ##write-barrier < ##effect card# table ; - -INSN: ##alien-global < ##flushable symbol library ; - -! FFI -INSN: ##alien-invoke params stack-frame ; -INSN: ##alien-indirect params stack-frame ; -INSN: ##alien-callback params stack-frame ; -INSN: ##callback-return params ; - -! Instructions used by CFG IR only. -INSN: ##prologue ; -INSN: ##epilogue ; - -INSN: ##branch ; - -INSN: ##phi < ##pure inputs ; - -! Conditionals -TUPLE: ##conditional-branch < insn src1 src2 cc ; - -INSN: ##compare-branch < ##conditional-branch ; -INSN: ##compare-imm-branch src1 { src2 integer } cc ; - -INSN: ##compare < ##binary cc temp ; -INSN: ##compare-imm < ##binary-imm cc temp ; - -INSN: ##compare-float-branch < ##conditional-branch ; -INSN: ##compare-float < ##binary cc temp ; - -! Overflowing arithmetic -TUPLE: ##fixnum-overflow < insn dst src1 src2 ; -INSN: ##fixnum-add < ##fixnum-overflow ; -INSN: ##fixnum-sub < ##fixnum-overflow ; -INSN: ##fixnum-mul < ##fixnum-overflow ; - -INSN: ##gc temp1 temp2 data-values tagged-values uninitialized-locs ; - -! Instructions used by machine IR only. -INSN: _prologue stack-frame ; -INSN: _epilogue stack-frame ; - -INSN: _label id ; - -INSN: _branch label ; -INSN: _loop-entry ; - -INSN: _dispatch src temp ; -INSN: _dispatch-label label ; - -TUPLE: _conditional-branch < insn label src1 src2 cc ; - -INSN: _compare-branch < _conditional-branch ; -INSN: _compare-imm-branch label src1 { src2 integer } cc ; - -INSN: _compare-float-branch < _conditional-branch ; - -! Overflowing arithmetic -TUPLE: _fixnum-overflow < insn label dst src1 src2 ; -INSN: _fixnum-add < _fixnum-overflow ; -INSN: _fixnum-sub < _fixnum-overflow ; -INSN: _fixnum-mul < _fixnum-overflow ; - -TUPLE: spill-slot n ; C: spill-slot - -INSN: _gc temp1 temp2 data-values tagged-values uninitialized-locs ; - -! These instructions operate on machine registers and not -! virtual registers -INSN: _spill src rep n ; -INSN: _reload dst rep n ; -INSN: _spill-area-size n ; - -! Instructions that use vregs -UNION: vreg-insn - ##flushable - ##write-barrier - ##dispatch - ##effect - ##fixnum-overflow - ##conditional-branch - ##compare-imm-branch - ##phi - ##gc - _conditional-branch - _compare-imm-branch - _dispatch ; +! For alias analysis +UNION: ##read ##slot ##slot-imm ; +UNION: ##write ##set-slot ##set-slot-imm ; ! Instructions that kill all live vregs but cannot trigger GC UNION: partial-sync-insn - ##unary-float-function - ##binary-float-function ; +##unary-float-function +##binary-float-function ; ! Instructions that kill all live vregs UNION: kill-vreg-insn - ##call - ##prologue - ##epilogue - ##alien-invoke - ##alien-indirect - ##alien-callback ; - -! Instructions that output floats -UNION: output-float-insn - ##add-float - ##sub-float - ##mul-float - ##div-float - ##min-float - ##max-float - ##sqrt - ##unary-float-function - ##binary-float-function - ##integer>float - ##unbox-float - ##alien-float - ##alien-double ; - -! Instructions that take floats as inputs -UNION: input-float-insn - ##add-float - ##sub-float - ##mul-float - ##div-float - ##min-float - ##max-float - ##sqrt - ##unary-float-function - ##binary-float-function - ##float>integer - ##box-float - ##set-alien-float - ##set-alien-double - ##compare-float - ##compare-float-branch ; - -! Smackdown -INTERSECTION: ##unary-float ##unary input-float-insn ; -INTERSECTION: ##binary-float ##binary input-float-insn ; +##call +##prologue +##epilogue +##alien-invoke +##alien-indirect +##alien-callback ; ! Instructions that have complex expansions and require that the ! output registers are not equal to any of the input registers UNION: def-is-use-insn - ##integer>bignum - ##bignum>integer - ##unbox-any-c-ptr ; \ No newline at end of file +##integer>bignum +##bignum>integer +##unbox-any-c-ptr ; + +SYMBOL: vreg-insn + +[ + vreg-insn + insn-classes get [ + "insn-slots" word-prop [ type>> { def use temp } memq? ] any? + ] filter + define-union-class +] with-compilation-unit \ No newline at end of file diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor index ab1c9599e5..c4876866a3 100644 --- a/basis/compiler/cfg/instructions/syntax/syntax.factor +++ b/basis/compiler/cfg/instructions/syntax/syntax.factor @@ -1,22 +1,74 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes.tuple classes.tuple.parser kernel words -make fry sequences parser accessors effects ; +make fry sequences parser accessors effects namespaces +combinators splitting classes.parser lexer ; IN: compiler.cfg.instructions.syntax +SYMBOLS: def use temp literal constant ; + +TUPLE: insn-slot-spec type name rep ; + +: parse-insn-slot-spec ( type string -- spec ) + over [ "Missing type" throw ] unless + "/" split1 dup [ "cpu.architecture" lookup ] when + insn-slot-spec boa ; + +: parse-insn-slot-specs ( seq -- specs ) + [ + f [ + { + { "def:" [ drop def ] } + { "use:" [ drop use ] } + { "temp:" [ drop temp ] } + { "literal:" [ drop literal ] } + { "constant:" [ drop constant ] } + [ dupd parse-insn-slot-spec , ] + } case + ] reduce drop + ] { } make ; + +: insn-def-slot ( class -- slot/f ) + "insn-slots" word-prop + [ type>> def eq? ] find nip ; + +: insn-use-slots ( class -- slot/f ) + "insn-slots" word-prop + [ type>> use eq? ] filter ; + +: insn-temp-slots ( class -- slot/f ) + "insn-slots" word-prop + [ type>> temp eq? ] filter ; + +! We cannot reference words in compiler.cfg.instructions directly +! since that would create circularity. +: insn-classes-word ( -- word ) + "insn-classes" "compiler.cfg.instructions" lookup ; + : insn-word ( -- word ) - #! We want to put the insn tuple in compiler.cfg.instructions, - #! but we cannot have circularity between that vocabulary and - #! this one. "insn" "compiler.cfg.instructions" lookup ; +: pure-insn-word ( -- word ) + "pure-insn" "compiler.cfg.instructions" lookup ; + : insn-effect ( word -- effect ) boa-effect in>> but-last f ; -SYNTAX: INSN: - parse-tuple-definition "insn#" suffix - [ dup tuple eq? [ drop insn-word ] when ] dip - [ define-tuple-class ] - [ 2drop save-location ] - [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ] - 3tri ; +: define-insn-tuple ( class superclass specs -- ) + [ name>> ] map "insn#" suffix define-tuple-class ; + +: define-insn-ctor ( class specs -- ) + [ dup '[ f _ boa , ] ] dip [ name>> ] map f define-declared ; + +: define-insn ( class superclass specs -- ) + parse-insn-slot-specs { + [ nip "insn-slots" set-word-prop ] + [ 2drop insn-classes-word get push ] + [ define-insn-tuple ] + [ 2drop save-location ] + [ nip define-insn-ctor ] + } 3cleave ; + +SYNTAX: INSN: CREATE-CLASS insn-word ";" parse-tokens define-insn ; + +SYNTAX: PURE-INSN: CREATE-CLASS pure-insn-word ";" parse-tokens define-insn ; diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index d4b9db58c8..2e2bfd5f09 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: sequences accessors layouts kernel math math.intervals namespaces combinators fry arrays +cpu.architecture compiler.tree.propagation.info compiler.cfg.hats compiler.cfg.stacks @@ -71,7 +72,7 @@ IN: compiler.cfg.intrinsics.fixnum : emit-fixnum-overflow-op ( quot word -- ) ! Inputs to the final instruction need to be copied because ! of loc>vreg sync - [ [ (2inputs) [ ^^copy ] bi@ ] dip call ] dip + [ [ (2inputs) [ any-rep ^^copy ] bi@ ] dip call ] dip [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array emit-conditional ; inline diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index 79e56c08ad..5ae51a28e2 100644 --- a/basis/compiler/cfg/intrinsics/slots/slots.factor +++ b/basis/compiler/cfg/intrinsics/slots/slots.factor @@ -29,7 +29,7 @@ IN: compiler.cfg.intrinsics.slots : (emit-set-slot) ( infos -- obj-reg ) [ 3inputs ^^offset>slot ] [ second value-tag ] bi* - pick [ ^^set-slot ] dip ; + pick [ next-vreg ##set-slot ] dip ; : (emit-set-slot-imm) ( infos -- obj-reg ) ds-drop diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 03df2d9747..8754b65475 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -135,7 +135,7 @@ M: vreg-insn assign-registers-in-insn [ [ 2dup spill-on-gc? - [ swap [ vreg-spill-slot ] [ rep-of ] bi 3array , ] [ 2drop ] if + [ swap [ rep-of ] [ vreg-spill-slot ] bi 3array , ] [ 2drop ] if ] assoc-each ] { } make ; diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor index b307155091..2af68e9175 100644 --- a/basis/compiler/cfg/renaming/functor/functor.factor +++ b/basis/compiler/cfg/renaming/functor/functor.factor @@ -1,9 +1,15 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: functors assocs kernel accessors compiler.cfg.instructions -lexer parser ; +USING: accessors arrays assocs fry functors generic.parser +kernel lexer namespaces parser sequences slots words sets +compiler.cfg.def-use compiler.cfg.instructions +compiler.cfg.instructions.syntax ; IN: compiler.cfg.renaming.functor +: slot-change-quot ( slots quot -- quot' ) + '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join + [ drop ] append ; + FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- ) rename-insn-defs DEFINES ${NAME}-insn-defs @@ -14,155 +20,30 @@ WHERE GENERIC: rename-insn-defs ( insn -- ) -M: ##flushable rename-insn-defs - DEF-QUOT change-dst - drop ; - -M: ##fixnum-overflow rename-insn-defs - DEF-QUOT change-dst - drop ; - -M: _fixnum-overflow rename-insn-defs - DEF-QUOT change-dst - drop ; - -M: insn rename-insn-defs drop ; +insn-classes get [ + [ \ rename-insn-defs create-method-in ] + [ insn-def-slot dup [ name>> 1array ] when DEF-QUOT slot-change-quot ] bi + define +] each GENERIC: rename-insn-uses ( insn -- ) -M: ##effect rename-insn-uses - USE-QUOT change-src - drop ; - -M: ##unary rename-insn-uses - USE-QUOT change-src - drop ; - -M: ##binary rename-insn-uses - USE-QUOT change-src1 - USE-QUOT change-src2 - drop ; - -M: ##binary-imm rename-insn-uses - USE-QUOT change-src1 - drop ; - -M: ##slot rename-insn-uses - USE-QUOT change-obj - USE-QUOT change-slot - drop ; - -M: ##slot-imm rename-insn-uses - USE-QUOT change-obj - drop ; - -M: ##set-slot rename-insn-uses - dup call-next-method - USE-QUOT change-obj - USE-QUOT change-slot - drop ; - -M: ##string-nth rename-insn-uses - USE-QUOT change-obj - USE-QUOT change-index - drop ; - -M: ##set-string-nth-fast rename-insn-uses - dup call-next-method - USE-QUOT change-obj - USE-QUOT change-index - drop ; - -M: ##set-slot-imm rename-insn-uses - dup call-next-method - USE-QUOT change-obj - drop ; - -M: ##alien-getter rename-insn-uses - dup call-next-method - USE-QUOT change-src - drop ; - -M: ##alien-setter rename-insn-uses - dup call-next-method - USE-QUOT change-value - drop ; - -M: ##conditional-branch rename-insn-uses - USE-QUOT change-src1 - USE-QUOT change-src2 - drop ; - -M: ##compare-imm-branch rename-insn-uses - USE-QUOT change-src1 - drop ; - -M: ##dispatch rename-insn-uses - USE-QUOT change-src - drop ; - -M: ##fixnum-overflow rename-insn-uses - USE-QUOT change-src1 - USE-QUOT change-src2 - drop ; +insn-classes get { ##phi } diff [ + [ \ rename-insn-uses create-method-in ] + [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi + define +] each M: ##phi rename-insn-uses - [ USE-QUOT assoc-map ] change-inputs - drop ; - -M: insn rename-insn-uses drop ; + [ USE-QUOT assoc-map ] change-inputs drop ; GENERIC: rename-insn-temps ( insn -- ) -M: ##write-barrier rename-insn-temps - TEMP-QUOT change-card# - TEMP-QUOT change-table - drop ; - -M: ##unary/temp rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##allot rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##dispatch rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##slot rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##set-slot rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##string-nth rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##set-string-nth-fast rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##box-displaced-alien rename-insn-temps - TEMP-QUOT change-temp1 - TEMP-QUOT change-temp2 - drop ; - -M: ##compare rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##compare-imm rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##compare-float rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: ##gc rename-insn-temps - TEMP-QUOT change-temp1 - TEMP-QUOT change-temp2 - drop ; - -M: _dispatch rename-insn-temps - TEMP-QUOT change-temp drop ; - -M: insn rename-insn-temps drop ; +insn-classes get [ + [ \ rename-insn-temps create-method-in ] + [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi + define +] each ;FUNCTOR diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor index 4b071ba5e2..2e72e56584 100644 --- a/basis/compiler/cfg/representations/preferred/preferred.factor +++ b/basis/compiler/cfg/representations/preferred/preferred.factor @@ -1,66 +1,46 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors sequences arrays fry namespaces -cpu.architecture compiler.cfg.utilities compiler.cfg compiler.cfg.rpo -compiler.cfg.instructions compiler.cfg.def-use ; +USING: kernel accessors sequences arrays fry namespaces generic +words sets cpu.architecture compiler.units +compiler.cfg.utilities compiler.cfg compiler.cfg.rpo +compiler.cfg.instructions compiler.cfg.instructions.syntax +compiler.cfg.def-use ; IN: compiler.cfg.representations.preferred GENERIC: defs-vreg-rep ( insn -- rep/f ) GENERIC: temp-vreg-reps ( insn -- reps ) GENERIC: uses-vreg-reps ( insn -- reps ) -M: ##flushable defs-vreg-rep drop int-rep ; -M: ##copy defs-vreg-rep rep>> ; -M: output-float-insn defs-vreg-rep drop double-float-rep ; -M: ##fixnum-overflow defs-vreg-rep drop int-rep ; -M: _fixnum-overflow defs-vreg-rep drop int-rep ; -M: ##phi defs-vreg-rep drop "##phi must be special-cased" throw ; -M: insn defs-vreg-rep drop f ; +> ] when '[ drop _ ] ] bi + define ; + +: define-uses-vreg-reps-method ( insn -- ) + [ \ uses-vreg-reps create-method ] + [ insn-use-slots [ rep>> ] map '[ drop _ ] ] bi + define ; + +: define-temp-vreg-reps-method ( insn -- ) + [ \ temp-vreg-reps create-method ] + [ insn-temp-slots [ rep>> ] map '[ drop _ ] ] bi + define ; + +PRIVATE> + +[ + insn-classes get + [ { ##copy } diff [ define-defs-vreg-rep-method ] each ] + [ { ##copy ##phi } diff [ define-uses-vreg-reps-method ] each ] + [ [ define-temp-vreg-reps-method ] each ] + tri +] with-compilation-unit + +M: ##copy defs-vreg-rep rep>> ; M: ##copy uses-vreg-reps rep>> 1array ; -M: ##unary uses-vreg-reps drop { int-rep } ; -M: ##unary-float uses-vreg-reps drop { double-float-rep } ; -M: ##binary uses-vreg-reps drop { int-rep int-rep } ; -M: ##binary-imm uses-vreg-reps drop { int-rep } ; -M: ##binary-float uses-vreg-reps drop { double-float-rep double-float-rep } ; -M: ##effect uses-vreg-reps drop { int-rep } ; -M: ##slot uses-vreg-reps drop { int-rep int-rep } ; -M: ##slot-imm uses-vreg-reps drop { int-rep } ; -M: ##set-slot uses-vreg-reps drop { int-rep int-rep int-rep } ; -M: ##set-slot-imm uses-vreg-reps drop { int-rep int-rep } ; -M: ##string-nth uses-vreg-reps drop { int-rep int-rep } ; -M: ##set-string-nth-fast uses-vreg-reps drop { int-rep int-rep int-rep } ; -M: ##compare-branch uses-vreg-reps drop { int-rep int-rep } ; -M: ##compare-imm-branch uses-vreg-reps drop { int-rep } ; -M: ##compare-float-branch uses-vreg-reps drop { double-float-rep double-float-rep } ; -M: ##dispatch uses-vreg-reps drop { int-rep } ; -M: ##alien-getter uses-vreg-reps drop { int-rep } ; -M: ##alien-setter uses-vreg-reps drop { int-rep int-rep } ; -M: ##set-alien-float uses-vreg-reps drop { int-rep double-float-rep } ; -M: ##set-alien-double uses-vreg-reps drop { int-rep double-float-rep } ; -M: ##fixnum-overflow uses-vreg-reps drop { int-rep int-rep } ; -M: _compare-imm-branch uses-vreg-reps drop { int-rep } ; -M: _compare-branch uses-vreg-reps drop { int-rep int-rep } ; -M: _compare-float-branch uses-vreg-reps drop { double-float-rep double-float-rep } ; -M: _dispatch uses-vreg-reps drop { int-rep } ; -M: ##phi uses-vreg-reps drop "##phi must be special-cased" throw ; -M: insn uses-vreg-reps drop f ; : each-def-rep ( insn vreg-quot: ( vreg rep -- ) -- ) [ [ defs-vreg ] [ defs-vreg-rep ] bi ] dip with when* ; inline diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor index 15151ff9e6..a6c5688bba 100644 --- a/basis/compiler/cfg/two-operand/two-operand.factor +++ b/basis/compiler/cfg/two-operand/two-operand.factor @@ -37,7 +37,9 @@ UNION: two-operand-insn ##sar-imm ##min ##max - ##fixnum-overflow + ##fixnum-add + ##fixnum-sub + ##fixnum-mul ##add-float ##sub-float ##mul-float diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index e8488b8afb..f869f64fb1 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -1,23 +1,16 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors classes kernel math namespaces combinators -combinators.short-circuit compiler.cfg.instructions +USING: accessors classes classes.algebra classes.parser +classes.tuple combinators combinators.short-circuit fry +generic.parser kernel math namespaces quotations sequences slots +splitting words compiler.cfg.instructions +compiler.cfg.instructions.syntax compiler.cfg.value-numbering.graph ; IN: compiler.cfg.value-numbering.expressions -! Referentially-transparent expressions -TUPLE: unary-expr < expr in ; -TUPLE: binary-expr < expr in1 in2 ; -TUPLE: commutative-expr < binary-expr ; -TUPLE: compare-expr < binary-expr cc ; TUPLE: constant-expr < expr value ; -TUPLE: reference-expr < expr value ; -TUPLE: unary-float-function-expr < expr in func ; -TUPLE: binary-float-function-expr < expr in1 in2 func ; -TUPLE: box-displaced-alien-expr < expr displacement base base-class ; -: ( constant -- expr ) - f swap constant-expr boa ; inline +C: constant-expr M: constant-expr equal? over constant-expr? [ @@ -27,8 +20,9 @@ M: constant-expr equal? } 2&& ] [ 2drop f ] if ; -: ( constant -- expr ) - f swap reference-expr boa ; inline +TUPLE: reference-expr < expr value ; + +C: reference-expr M: reference-expr equal? over reference-expr? [ @@ -43,73 +37,42 @@ M: reference-expr equal? GENERIC: >expr ( insn -- expr ) +M: insn >expr drop next-input-expr ; + M: ##load-immediate >expr val>> ; M: ##load-reference >expr obj>> ; -M: ##unary >expr - [ class ] [ src>> vreg>vn ] bi unary-expr boa ; +<< -M: ##binary >expr - [ class ] [ src1>> vreg>vn ] [ src2>> vreg>vn ] tri - binary-expr boa ; +: input-values ( slot-specs -- slot-specs' ) + [ type>> { use literal constant } memq? ] filter ; -M: ##binary-imm >expr - [ class ] [ src1>> vreg>vn ] [ src2>> constant>vn ] tri - binary-expr boa ; +: expr-class ( insn -- expr ) + name>> "##" ?head drop "-expr" append create-class-in ; -M: ##commutative >expr - [ class ] [ src1>> vreg>vn ] [ src2>> vreg>vn ] tri - commutative-expr boa ; +: define-expr-class ( insn expr slot-specs -- ) + [ nip expr ] dip [ name>> ] map define-tuple-class ; -M: ##commutative-imm >expr - [ class ] [ src1>> vreg>vn ] [ src2>> constant>vn ] tri - commutative-expr boa ; +: >expr-quot ( expr slot-specs -- quot ) + [ + [ name>> reader-word 1quotation ] + [ + type>> { + { use [ [ vreg>vn ] ] } + { literal [ [ ] ] } + { constant [ [ constant>vn ] ] } + } case + ] bi append + ] map swap '[ _ cleave _ boa ] ; -: compare>expr ( insn -- expr ) - { - [ class ] - [ src1>> vreg>vn ] - [ src2>> vreg>vn ] - [ cc>> ] - } cleave compare-expr boa ; inline +: define->expr-method ( insn expr slot-specs -- ) + [ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ; -M: ##compare >expr compare>expr ; +: handle-pure-insn ( insn -- ) + [ ] [ expr-class ] [ "insn-slots" word-prop input-values ] tri + [ define-expr-class ] [ define->expr-method ] 3bi ; -: compare-imm>expr ( insn -- expr ) - { - [ class ] - [ src1>> vreg>vn ] - [ src2>> constant>vn ] - [ cc>> ] - } cleave compare-expr boa ; inline +insn-classes get [ pure-insn class<= ] filter [ handle-pure-insn ] each -M: ##compare-imm >expr compare-imm>expr ; - -M: ##compare-float >expr compare>expr ; - -M: ##box-displaced-alien >expr - { - [ class ] - [ src1>> vreg>vn ] - [ src2>> vreg>vn ] - [ base-class>> ] - } cleave box-displaced-alien-expr boa ; - -M: ##unary-float-function >expr - [ class ] [ src>> vreg>vn ] [ func>> ] tri - unary-float-function-expr boa ; - -M: ##binary-float-function >expr - { - [ class ] - [ src1>> vreg>vn ] - [ src2>> vreg>vn ] - [ func>> ] - } cleave - binary-float-function-expr boa ; - -M: ##flushable >expr drop next-input-expr ; - -: init-expressions ( -- ) - 0 input-expr-counter set ; +>> diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor index 77b75bd3ac..f380ecd02f 100644 --- a/basis/compiler/cfg/value-numbering/graph/graph.factor +++ b/basis/compiler/cfg/value-numbering/graph/graph.factor @@ -10,7 +10,7 @@ SYMBOL: vn-counter ! biassoc mapping expressions to value numbers SYMBOL: exprs>vns -TUPLE: expr op ; +TUPLE: expr ; : expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ; @@ -22,7 +22,7 @@ TUPLE: input-expr < expr n ; SYMBOL: input-expr-counter : next-input-expr ( -- expr ) - f input-expr-counter counter input-expr boa ; + input-expr-counter counter input-expr boa ; SYMBOL: vregs>vns @@ -41,5 +41,6 @@ SYMBOL: vregs>vns : init-value-graph ( -- ) 0 vn-counter set + 0 input-expr-counter set exprs>vns set vregs>vns set ; diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 2662dc4665..cf3baf27eb 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -32,27 +32,30 @@ M: insn rewrite drop f ; } 1&& ] [ drop f ] if ; inline +: general-compare-expr? ( insn -- ? ) + { [ compare-expr? ] [ compare-imm-expr? ] [ compare-float-expr? ] } 1|| ; + : rewrite-boolean-comparison? ( insn -- ? ) dup ##branch-t? [ - src1>> vreg>expr compare-expr? + src1>> vreg>expr general-compare-expr? ] [ drop f ] if ; inline : >compare-expr< ( expr -- in1 in2 cc ) - [ in1>> vn>vreg ] [ in2>> vn>vreg ] [ cc>> ] tri ; inline + [ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline : >compare-imm-expr< ( expr -- in1 in2 cc ) - [ in1>> vn>vreg ] [ in2>> vn>constant ] [ cc>> ] tri ; inline + [ src1>> vn>vreg ] [ src2>> vn>constant ] [ cc>> ] tri ; inline : rewrite-boolean-comparison ( expr -- insn ) - src1>> vreg>expr dup op>> { - { \ ##compare [ >compare-expr< \ ##compare-branch new-insn ] } - { \ ##compare-imm [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] } - { \ ##compare-float [ >compare-expr< \ ##compare-float-branch new-insn ] } - } case ; + src1>> vreg>expr { + { [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] } + { [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] } + { [ dup compare-float-expr? ] [ >compare-expr< \ ##compare-float-branch new-insn ] } + } cond ; : tag-fixnum-expr? ( expr -- ? ) - dup op>> \ ##shl-imm eq? - [ in2>> vn>constant tag-bits get = ] [ drop f ] if ; + dup shl-imm-expr? + [ src2>> vn>constant tag-bits get = ] [ drop f ] if ; : rewrite-tagged-comparison? ( insn -- ? ) #! Are we comparing two tagged fixnums? Then untag them. @@ -65,7 +68,7 @@ M: insn rewrite drop f ; tag-bits get neg shift ; inline : (rewrite-tagged-comparison) ( insn -- src1 src2 cc ) - [ src1>> vreg>expr in1>> vn>vreg ] + [ src1>> vreg>expr src1>> vn>vreg ] [ src2>> tagged>constant ] [ cc>> ] tri ; inline @@ -81,17 +84,17 @@ M: ##compare-imm rewrite-tagged-comparison : rewrite-redundant-comparison? ( insn -- ? ) { - [ src1>> vreg>expr compare-expr? ] + [ src1>> vreg>expr general-compare-expr? ] [ src2>> \ f tag-number = ] [ cc>> { cc= cc/= } memq? ] } 1&& ; inline : rewrite-redundant-comparison ( insn -- insn' ) - [ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri { - { \ ##compare [ >compare-expr< next-vreg \ ##compare new-insn ] } - { \ ##compare-imm [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] } - { \ ##compare-float [ >compare-expr< next-vreg \ ##compare-float new-insn ] } - } case + [ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri { + { [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] } + { [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] } + { [ dup compare-float-expr? ] [ >compare-expr< next-vreg \ ##compare-float new-insn ] } + } cond swap cc= eq? [ [ negate-cc ] change-cc ] when ; ERROR: bad-comparison ; @@ -220,14 +223,11 @@ M: ##shl-imm constant-fold* drop shift ; [ [ src1>> vreg>constant ] [ src2>> ] [ ] tri constant-fold* ] bi \ ##load-immediate new-insn ; inline -: reassociate? ( insn -- ? ) - [ src1>> vreg>expr op>> ] [ class ] bi = ; inline - : reassociate ( insn op -- insn ) [ { [ dst>> ] - [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] + [ src1>> vreg>expr [ src1>> vn>vreg ] [ src2>> vn>constant ] bi ] [ src2>> ] [ ] } cleave constant-fold* @@ -237,7 +237,7 @@ M: ##shl-imm constant-fold* drop shift ; M: ##add-imm rewrite { { [ dup constant-fold? ] [ constant-fold ] } - { [ dup reassociate? ] [ \ ##add-imm reassociate ] } + { [ dup src1>> vreg>expr add-imm-expr? ] [ \ ##add-imm reassociate ] } [ drop f ] } cond ; @@ -261,28 +261,28 @@ M: ##mul-imm rewrite { { [ dup constant-fold? ] [ constant-fold ] } { [ dup strength-reduce-mul? ] [ strength-reduce-mul ] } - { [ dup reassociate? ] [ \ ##mul-imm reassociate ] } + { [ dup src1>> vreg>expr mul-imm-expr? ] [ \ ##mul-imm reassociate ] } [ drop f ] } cond ; M: ##and-imm rewrite { { [ dup constant-fold? ] [ constant-fold ] } - { [ dup reassociate? ] [ \ ##and-imm reassociate ] } + { [ dup src1>> vreg>expr and-imm-expr? ] [ \ ##and-imm reassociate ] } [ drop f ] } cond ; M: ##or-imm rewrite { { [ dup constant-fold? ] [ constant-fold ] } - { [ dup reassociate? ] [ \ ##or-imm reassociate ] } + { [ dup src1>> vreg>expr or-imm-expr? ] [ \ ##or-imm reassociate ] } [ drop f ] } cond ; M: ##xor-imm rewrite { { [ dup constant-fold? ] [ constant-fold ] } - { [ dup reassociate? ] [ \ ##xor-imm reassociate ] } + { [ dup src1>> vreg>expr xor-imm-expr? ] [ \ ##xor-imm reassociate ] } [ drop f ] } cond ; @@ -351,9 +351,6 @@ M: ##shr rewrite \ ##shr-imm rewrite-arithmetic ; M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ; -: box-displaced-alien? ( expr -- ? ) - op>> \ ##box-displaced-alien eq? ; - ! ##box-displaced-alien f 1 2 3 ! ##unbox-c-ptr 4 1 ! => @@ -369,5 +366,5 @@ M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ; ] { } make ; M: ##unbox-any-c-ptr rewrite - dup src>> vreg>expr dup box-displaced-alien? + dup src>> vreg>expr dup box-displaced-alien-expr? [ rewrite-unbox-displaced-alien ] [ 2drop f ] if ; diff --git a/basis/compiler/cfg/value-numbering/simplify/simplify.factor b/basis/compiler/cfg/value-numbering/simplify/simplify.factor index 6508801840..c370ac3f0a 100644 --- a/basis/compiler/cfg/value-numbering/simplify/simplify.factor +++ b/basis/compiler/cfg/value-numbering/simplify/simplify.factor @@ -1,33 +1,29 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors combinators classes math layouts compiler.cfg.instructions compiler.cfg.value-numbering.graph -compiler.cfg.value-numbering.expressions locals ; +compiler.cfg.value-numbering.expressions ; IN: compiler.cfg.value-numbering.simplify ! Return value of f means we didn't simplify. GENERIC: simplify* ( expr -- vn/expr/f ) -: simplify-unbox-alien ( in -- vn/expr/f ) - dup op>> \ ##box-alien eq? [ in>> ] [ drop f ] if ; inline +M: copy-expr simplify* src>> ; -M: unary-expr simplify* - #! Note the copy propagation: a copy always simplifies to - #! its source VN. - [ in>> vn>expr ] [ op>> ] bi { - { \ ##copy [ ] } - { \ ##unbox-alien [ simplify-unbox-alien ] } - { \ ##unbox-any-c-ptr [ simplify-unbox-alien ] } - [ 2drop f ] - } case ; +: simplify-unbox-alien ( expr -- vn/expr/f ) + src>> vn>expr dup box-alien-expr? [ src>> ] [ drop f ] if ; -: expr-zero? ( expr -- ? ) T{ constant-expr f f 0 } = ; inline +! M: unbox-alien-expr simplify* simplify-unbox-alien ; -: expr-one? ( expr -- ? ) T{ constant-expr f f 1 } = ; inline +M: unbox-any-c-ptr-expr simplify* simplify-unbox-alien ; + +: expr-zero? ( expr -- ? ) T{ constant-expr f 0 } = ; inline + +: expr-one? ( expr -- ? ) T{ constant-expr f 1 } = ; inline : >binary-expr< ( expr -- in1 in2 ) - [ in1>> vn>expr ] [ in2>> vn>expr ] bi ; inline + [ src1>> vn>expr ] [ src2>> vn>expr ] bi ; inline : simplify-add ( expr -- vn/expr/f ) >binary-expr< { @@ -36,12 +32,18 @@ M: unary-expr simplify* [ 2drop f ] } cond ; inline +M: add-expr simplify* simplify-add ; +M: add-imm-expr simplify* simplify-add ; + : simplify-sub ( expr -- vn/expr/f ) >binary-expr< { { [ dup expr-zero? ] [ drop ] } [ 2drop f ] } cond ; inline +M: sub-expr simplify* simplify-sub ; +M: sub-imm-expr simplify* simplify-sub ; + : simplify-mul ( expr -- vn/expr/f ) >binary-expr< { { [ over expr-one? ] [ drop ] } @@ -49,12 +51,18 @@ M: unary-expr simplify* [ 2drop f ] } cond ; inline +M: mul-expr simplify* simplify-mul ; +M: mul-imm-expr simplify* simplify-mul ; + : simplify-and ( expr -- vn/expr/f ) >binary-expr< { { [ 2dup eq? ] [ drop ] } [ 2drop f ] } cond ; inline +M: and-expr simplify* simplify-and ; +M: and-imm-expr simplify* simplify-and ; + : simplify-or ( expr -- vn/expr/f ) >binary-expr< { { [ 2dup eq? ] [ drop ] } @@ -63,6 +71,9 @@ M: unary-expr simplify* [ 2drop f ] } cond ; inline +M: or-expr simplify* simplify-or ; +M: or-imm-expr simplify* simplify-or ; + : simplify-xor ( expr -- vn/expr/f ) >binary-expr< { { [ over expr-zero? ] [ nip ] } @@ -70,45 +81,31 @@ M: unary-expr simplify* [ 2drop f ] } cond ; inline +M: xor-expr simplify* simplify-xor ; +M: xor-imm-expr simplify* simplify-xor ; + : useless-shr? ( in1 in2 -- ? ) - over op>> \ ##shl-imm eq? - [ [ in2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline + over shl-imm-expr? + [ [ src2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline : simplify-shr ( expr -- vn/expr/f ) >binary-expr< { - { [ 2dup useless-shr? ] [ drop in1>> ] } + { [ 2dup useless-shr? ] [ drop src1>> ] } { [ dup expr-zero? ] [ drop ] } [ 2drop f ] } cond ; inline +M: shr-expr simplify* simplify-shr ; +M: shr-imm-expr simplify* simplify-shr ; + : simplify-shl ( expr -- vn/expr/f ) >binary-expr< { { [ dup expr-zero? ] [ drop ] } [ 2drop f ] } cond ; inline -M: binary-expr simplify* - dup op>> { - { \ ##add [ simplify-add ] } - { \ ##add-imm [ simplify-add ] } - { \ ##sub [ simplify-sub ] } - { \ ##sub-imm [ simplify-sub ] } - { \ ##mul [ simplify-mul ] } - { \ ##mul-imm [ simplify-mul ] } - { \ ##and [ simplify-and ] } - { \ ##and-imm [ simplify-and ] } - { \ ##or [ simplify-or ] } - { \ ##or-imm [ simplify-or ] } - { \ ##xor [ simplify-xor ] } - { \ ##xor-imm [ simplify-xor ] } - { \ ##shr [ simplify-shr ] } - { \ ##shr-imm [ simplify-shr ] } - { \ ##sar [ simplify-shr ] } - { \ ##sar-imm [ simplify-shr ] } - { \ ##shl [ simplify-shl ] } - { \ ##shl-imm [ simplify-shl ] } - [ 2drop f ] - } case ; +M: shl-expr simplify* simplify-shl ; +M: shl-imm-expr simplify* simplify-shl ; M: box-displaced-alien-expr simplify* [ base>> ] [ displacement>> ] bi { diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor index 6874f2c001..96ca3efcf2 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering.factor @@ -6,6 +6,7 @@ cpu.architecture sequences.deep compiler.cfg compiler.cfg.rpo +compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.expressions @@ -16,29 +17,21 @@ IN: compiler.cfg.value-numbering ! Local value numbering. : >copy ( insn -- insn/##copy ) - dup dst>> dup vreg>vn vn>vreg + dup defs-vreg dup vreg>vn vn>vreg 2dup eq? [ 2drop ] [ any-rep \ ##copy new-insn nip ] if ; -: rewrite-loop ( insn -- insn' ) - dup rewrite [ rewrite-loop ] [ ] ?if ; - GENERIC: process-instruction ( insn -- insn' ) -M: ##flushable process-instruction - dup rewrite - [ process-instruction ] - [ dup number-values >copy ] ?if ; - M: insn process-instruction dup rewrite - [ process-instruction ] [ ] ?if ; + [ process-instruction ] + [ dup defs-vreg [ dup number-values >copy ] when ] ?if ; M: array process-instruction [ process-instruction ] map ; : value-numbering-step ( insns -- insns' ) init-value-graph - init-expressions [ process-instruction ] map flatten ; : value-numbering ( cfg -- cfg' ) diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 00a36cc55f..c8ce4f38e8 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -5,7 +5,7 @@ kernel kernel.private layouts assocs words summary arrays combinators classes.algebra alien alien.c-types alien.structs alien.strings alien.arrays alien.complex alien.libraries sets libc continuations.private fry cpu.architecture classes locals -source-files.errors +source-files.errors slots parser generic.parser compiler.errors compiler.alien compiler.constants @@ -67,170 +67,136 @@ SYMBOL: labels : lookup-label ( id -- label ) labels get [ drop