From 503c0fcfde968d1604e90aa4837bf4e2188b498e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Apr 2010 14:05:55 -0500 Subject: [PATCH] compiler: Start using tagged-rep for stuff, and split up compiler.cfg.representations into several sub-vocabularies --- .../cfg/alias-analysis/alias-analysis.factor | 2 +- basis/compiler/cfg/gc-checks/gc-checks.factor | 4 +- .../cfg/instructions/instructions.factor | 266 ++++++------- .../linear-scan/assignment/assignment.factor | 4 +- .../representations/conversion/authors.txt | 1 + .../conversion/conversion.factor | 75 ++++ .../representations/representations.factor | 360 +----------------- .../cfg/representations/rewrite/authors.txt | 1 + .../representations/rewrite/rewrite.factor | 149 ++++++++ .../cfg/representations/selection/authors.txt | 1 + .../selection/selection.factor | 143 +++++++ .../cfg/save-contexts/save-contexts.factor | 4 +- basis/cpu/ppc/ppc.factor | 1 + basis/cpu/x86/64/64.factor | 4 +- 14 files changed, 516 insertions(+), 499 deletions(-) create mode 100644 basis/compiler/cfg/representations/conversion/authors.txt create mode 100644 basis/compiler/cfg/representations/conversion/conversion.factor create mode 100644 basis/compiler/cfg/representations/rewrite/authors.txt create mode 100644 basis/compiler/cfg/representations/rewrite/rewrite.factor create mode 100644 basis/compiler/cfg/representations/selection/authors.txt create mode 100644 basis/compiler/cfg/representations/selection/selection.factor diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 2e0684c5d0..d34d40f341 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -238,7 +238,7 @@ M: insn analyze-aliases* ! a new value, except boxing instructions haven't been ! inserted yet. dup defs-vreg [ - over defs-vreg-rep int-rep eq? + over defs-vreg-rep { int-rep tagged-rep } member? [ set-heap-ac ] [ set-new-ac ] if ] when* ; diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor index 6d192ec54a..d151c725e2 100644 --- a/basis/compiler/cfg/gc-checks/gc-checks.factor +++ b/basis/compiler/cfg/gc-checks/gc-checks.factor @@ -32,8 +32,8 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ; : insert-gc-check ( bb -- ) dup dup '[ - int-rep next-vreg-rep - int-rep next-vreg-rep + tagged-rep next-vreg-rep + tagged-rep next-vreg-rep _ allocation-size f f diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 5ddf7b4db5..6d18b05740 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -22,15 +22,15 @@ TUPLE: pure-insn < insn ; ! Stack operations INSN: ##load-immediate -def: dst/int-rep +def: dst/tagged-rep constant: val ; INSN: ##load-reference -def: dst/int-rep +def: dst/tagged-rep constant: obj ; INSN: ##load-constant -def: dst/int-rep +def: dst/tagged-rep constant: obj ; INSN: ##load-double @@ -38,11 +38,11 @@ def: dst/double-rep constant: val ; INSN: ##peek -def: dst/int-rep +def: dst/tagged-rep literal: loc ; INSN: ##replace -use: src/int-rep +use: src/tagged-rep literal: loc ; INSN: ##inc-d @@ -65,34 +65,34 @@ INSN: ##no-tco ; ! Jump tables INSN: ##dispatch -use: src/int-rep +use: src/tagged-rep temp: temp/int-rep ; ! Slot access INSN: ##slot -def: dst/int-rep -use: obj/int-rep slot/int-rep ; +def: dst/tagged-rep +use: obj/tagged-rep slot/tagged-rep ; INSN: ##slot-imm -def: dst/int-rep -use: obj/int-rep +def: dst/tagged-rep +use: obj/tagged-rep literal: slot tag ; INSN: ##set-slot -use: src/int-rep obj/int-rep slot/int-rep ; +use: src/tagged-rep obj/tagged-rep slot/tagged-rep ; INSN: ##set-slot-imm -use: src/int-rep obj/int-rep +use: src/tagged-rep obj/tagged-rep literal: slot tag ; ! String element access INSN: ##string-nth -def: dst/int-rep -use: obj/int-rep index/int-rep +def: dst/tagged-rep +use: obj/tagged-rep index/tagged-rep temp: temp/int-rep ; INSN: ##set-string-nth-fast -use: src/int-rep obj/int-rep index/int-rep +use: src/tagged-rep obj/tagged-rep index/tagged-rep temp: temp/int-rep ; PURE-INSN: ##copy @@ -102,105 +102,105 @@ literal: rep ; ! Integer arithmetic PURE-INSN: ##add -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##add-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##sub -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##sub-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##mul -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##mul-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##and -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##and-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##or -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##or-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##xor -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##xor-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##shl -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##shl-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##shr -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##shr-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##sar -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##sar-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 ; PURE-INSN: ##min -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##max -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; PURE-INSN: ##not -def: dst/int-rep -use: src/int-rep ; +def: dst/tagged-rep +use: src/tagged-rep ; PURE-INSN: ##neg -def: dst/int-rep -use: src/int-rep ; +def: dst/tagged-rep +use: src/tagged-rep ; PURE-INSN: ##log2 -def: dst/int-rep -use: src/int-rep ; +def: dst/tagged-rep +use: src/tagged-rep ; ! Float arithmetic PURE-INSN: ##add-float @@ -253,12 +253,12 @@ use: src/double-rep ; ! Float/integer conversion PURE-INSN: ##float>integer -def: dst/int-rep +def: dst/tagged-rep use: src/double-rep ; PURE-INSN: ##integer>float def: dst/double-rep -use: src/int-rep ; +use: src/tagged-rep ; ! SIMD operations PURE-INSN: ##zero-vector @@ -340,7 +340,7 @@ use: src1 src2 literal: rep cc ; PURE-INSN: ##test-vector -def: dst/int-rep +def: dst/tagged-rep use: src1 temp: temp/int-rep literal: rep vcc ; @@ -508,13 +508,13 @@ literal: rep ; ! Scalar/vector conversion PURE-INSN: ##scalar>integer -def: dst/int-rep +def: dst/tagged-rep use: src literal: rep ; PURE-INSN: ##integer>scalar def: dst -use: src/int-rep +use: src/tagged-rep literal: rep ; PURE-INSN: ##vector>scalar @@ -529,26 +529,26 @@ literal: rep ; ! Boxing and unboxing aliens PURE-INSN: ##box-alien -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep temp: temp/int-rep ; PURE-INSN: ##box-displaced-alien -def: dst/int-rep -use: displacement/int-rep base/int-rep +def: dst/tagged-rep +use: displacement/tagged-rep base/tagged-rep temp: temp/int-rep literal: base-class ; PURE-INSN: ##unbox-any-c-ptr -def: dst/int-rep -use: src/int-rep ; +def: dst/tagged-rep +use: src/tagged-rep ; : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ; : ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ; PURE-INSN: ##unbox-alien -def: dst/int-rep -use: src/int-rep ; +def: dst/tagged-rep +use: src/tagged-rep ; : ##unbox-c-ptr ( dst src class -- ) { @@ -560,116 +560,116 @@ use: src/int-rep ; ! Alien accessors INSN: ##alien-unsigned-1 -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-unsigned-2 -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-unsigned-4 -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-signed-1 -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-signed-2 -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-signed-4 -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-cell -def: dst/int-rep -use: src/int-rep +def: dst/tagged-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-float def: dst/float-rep -use: src/int-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-double def: dst/double-rep -use: src/int-rep +use: src/tagged-rep literal: offset ; INSN: ##alien-vector def: dst -use: src/int-rep +use: src/tagged-rep literal: offset rep ; INSN: ##set-alien-integer-1 -use: src/int-rep +use: src/tagged-rep literal: offset -use: value/int-rep ; +use: value/tagged-rep ; INSN: ##set-alien-integer-2 -use: src/int-rep +use: src/tagged-rep literal: offset -use: value/int-rep ; +use: value/tagged-rep ; INSN: ##set-alien-integer-4 -use: src/int-rep +use: src/tagged-rep literal: offset -use: value/int-rep ; +use: value/tagged-rep ; INSN: ##set-alien-cell -use: src/int-rep +use: src/tagged-rep literal: offset -use: value/int-rep ; +use: value/tagged-rep ; INSN: ##set-alien-float -use: src/int-rep +use: src/tagged-rep literal: offset use: value/float-rep ; INSN: ##set-alien-double -use: src/int-rep +use: src/tagged-rep literal: offset use: value/double-rep ; INSN: ##set-alien-vector -use: src/int-rep +use: src/tagged-rep literal: offset use: value literal: rep ; ! Memory allocation INSN: ##allot -def: dst/int-rep +def: dst/tagged-rep literal: size class temp: temp/int-rep ; INSN: ##write-barrier -use: src/int-rep slot/int-rep +use: src/tagged-rep slot/tagged-rep temp: temp1/int-rep temp2/int-rep ; INSN: ##write-barrier-imm -use: src/int-rep +use: src/tagged-rep literal: slot temp: temp1/int-rep temp2/int-rep ; INSN: ##alien-global -def: dst/int-rep +def: dst/tagged-rep literal: symbol library ; INSN: ##vm-field -def: dst/int-rep +def: dst/tagged-rep literal: offset ; INSN: ##set-vm-field -use: src/int-rep +use: src/tagged-rep literal: offset ; ! FFI @@ -697,23 +697,23 @@ literal: inputs ; ! Conditionals INSN: ##compare-branch -use: src1/int-rep src2/int-rep +use: src1/tagged-rep src2/tagged-rep literal: cc ; INSN: ##compare-imm-branch -use: src1/int-rep +use: src1/tagged-rep constant: src2 literal: cc ; PURE-INSN: ##compare -def: dst/int-rep -use: src1/int-rep src2/int-rep +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep literal: cc temp: temp/int-rep ; PURE-INSN: ##compare-imm -def: dst/int-rep -use: src1/int-rep +def: dst/tagged-rep +use: src1/tagged-rep constant: src2 literal: cc temp: temp/int-rep ; @@ -727,29 +727,29 @@ use: src1/double-rep src2/double-rep literal: cc ; PURE-INSN: ##compare-float-ordered -def: dst/int-rep +def: dst/tagged-rep use: src1/double-rep src2/double-rep literal: cc temp: temp/int-rep ; PURE-INSN: ##compare-float-unordered -def: dst/int-rep +def: dst/tagged-rep use: src1/double-rep src2/double-rep literal: cc temp: temp/int-rep ; ! Overflowing arithmetic INSN: ##fixnum-add -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; INSN: ##fixnum-sub -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; INSN: ##fixnum-mul -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; INSN: ##gc temp: temp1/int-rep temp2/int-rep @@ -774,7 +774,7 @@ literal: label ; INSN: _loop-entry ; INSN: _dispatch -use: src/int-rep +use: src/tagged-rep temp: temp ; INSN: _dispatch-label @@ -782,40 +782,40 @@ literal: label ; INSN: _compare-branch literal: label -use: src1/int-rep src2/int-rep +use: src1/tagged-rep src2/tagged-rep literal: cc ; INSN: _compare-imm-branch literal: label -use: src1/int-rep +use: src1/tagged-rep constant: src2 literal: cc ; INSN: _compare-float-unordered-branch literal: label -use: src1/int-rep src2/int-rep +use: src1/tagged-rep src2/tagged-rep literal: cc ; INSN: _compare-float-ordered-branch literal: label -use: src1/int-rep src2/int-rep +use: src1/tagged-rep src2/tagged-rep literal: cc ; ! Overflowing arithmetic INSN: _fixnum-add literal: label -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; INSN: _fixnum-sub literal: label -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; INSN: _fixnum-mul literal: label -def: dst/int-rep -use: src1/int-rep src2/int-rep ; +def: dst/tagged-rep +use: src1/tagged-rep src2/tagged-rep ; TUPLE: spill-slot { n integer } ; C: spill-slot diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 6acb9169ec..c79aa36af1 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -121,10 +121,10 @@ M: vreg-insn assign-registers-in-insn : trace-on-gc ( assoc -- assoc' ) ! When a GC occurs, virtual registers which contain tagged data ! are traced by the GC. Outputs a sequence physical registers. - [ drop rep-of int-rep eq? ] { } assoc-filter-as values ; + [ drop rep-of tagged-rep eq? ] { } assoc-filter-as values ; : spill-on-gc? ( vreg reg -- ? ) - [ rep-of int-rep? not ] [ spill-slot? not ] bi* and ; + [ rep-of tagged-rep? not ] [ spill-slot? not ] bi* and ; : spill-on-gc ( assoc -- assoc' ) ! When a GC occurs, virtual registers which contain untagged data, diff --git a/basis/compiler/cfg/representations/conversion/authors.txt b/basis/compiler/cfg/representations/conversion/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/compiler/cfg/representations/conversion/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/compiler/cfg/representations/conversion/conversion.factor b/basis/compiler/cfg/representations/conversion/conversion.factor new file mode 100644 index 0000000000..071adea76d --- /dev/null +++ b/basis/compiler/cfg/representations/conversion/conversion.factor @@ -0,0 +1,75 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays byte-arrays combinators compiler.cfg.instructions +compiler.cfg.registers compiler.constants cpu.architecture +kernel layouts locals math namespaces ; +IN: compiler.cfg.representations.conversion + +ERROR: bad-conversion dst src dst-rep src-rep ; + +GENERIC: emit-box ( dst src rep -- ) +GENERIC: emit-unbox ( dst src rep -- ) + +M: int-rep emit-box ( dst src rep -- ) + drop tag-bits get ##shl-imm ; + +M: int-rep emit-unbox ( dst src rep -- ) + drop tag-bits get ##sar-imm ; + +M:: float-rep emit-box ( dst src rep -- ) + double-rep next-vreg-rep :> temp + temp src ##single>double-float + dst temp double-rep emit-box ; + +M:: float-rep emit-unbox ( dst src rep -- ) + double-rep next-vreg-rep :> temp + temp src double-rep emit-unbox + dst temp ##double>single-float ; + +M: double-rep emit-box + drop + [ drop 16 float tagged-rep next-vreg-rep ##allot ] + [ float-offset swap ##set-alien-double ] + 2bi ; + +M: double-rep emit-unbox + drop float-offset ##alien-double ; + +M:: vector-rep emit-box ( dst src rep -- ) + tagged-rep next-vreg-rep :> temp + dst 16 2 cells + byte-array tagged-rep next-vreg-rep ##allot + temp 16 tag-fixnum ##load-immediate + temp dst 1 byte-array type-number ##set-slot-imm + dst byte-array-offset src rep ##set-alien-vector ; + +M: vector-rep emit-unbox + [ byte-array-offset ] dip ##alien-vector ; + +M:: scalar-rep emit-box ( dst src rep -- ) + tagged-rep next-vreg-rep :> temp + temp src rep ##scalar>integer + dst temp int-rep emit-box ; + +M:: scalar-rep emit-unbox ( dst src rep -- ) + tagged-rep next-vreg-rep :> temp + temp src int-rep emit-unbox + dst temp rep ##integer>scalar ; + +: emit-conversion ( dst src dst-rep src-rep -- ) + { + { [ 2dup eq? ] [ drop ##copy ] } + { [ dup tagged-rep eq? ] [ drop emit-unbox ] } + { [ over tagged-rep eq? ] [ nip emit-box ] } + [ + 2dup 2array { + { { double-rep float-rep } [ 2drop ##single>double-float ] } + { { float-rep double-rep } [ 2drop ##double>single-float ] } + ! Punning SIMD vector types? Naughty naughty! But + ! it is allowed... otherwise bail out. + [ + drop 2dup [ reg-class-of ] bi@ eq? + [ drop ##copy ] [ bad-conversion ] if + ] + } case + ] + } cond ; diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor index f202dc4c6a..d4c500291e 100644 --- a/basis/compiler/cfg/representations/representations.factor +++ b/basis/compiler/cfg/representations/representations.factor @@ -1,365 +1,13 @@ ! Copyright (C) 2009, 2010 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: kernel fry accessors sequences assocs sets namespaces -arrays combinators combinators.short-circuit math make locals -deques dlists layouts byte-arrays cpu.architecture -compiler.utilities -compiler.constants -compiler.cfg -compiler.cfg.rpo -compiler.cfg.hats -compiler.cfg.registers -compiler.cfg.instructions -compiler.cfg.def-use -compiler.cfg.utilities -compiler.cfg.loop-detection -compiler.cfg.renaming.functor -compiler.cfg.representations.preferred ; -FROM: namespaces => set ; +USING: accessors combinators compiler.cfg +compiler.cfg.loop-detection compiler.cfg.registers +compiler.cfg.representations.rewrite +compiler.cfg.representations.selection namespaces ; IN: compiler.cfg.representations ! Virtual register representation selection. -ERROR: bad-conversion dst src dst-rep src-rep ; - -GENERIC: emit-box ( dst src rep -- ) -GENERIC: emit-unbox ( dst src rep -- ) - -M:: float-rep emit-box ( dst src rep -- ) - double-rep next-vreg-rep :> temp - temp src ##single>double-float - dst temp double-rep emit-box ; - -M:: float-rep emit-unbox ( dst src rep -- ) - double-rep next-vreg-rep :> temp - temp src double-rep emit-unbox - dst temp ##double>single-float ; - -M: double-rep emit-box - drop - [ drop 16 float int-rep next-vreg-rep ##allot ] - [ float-offset swap ##set-alien-double ] - 2bi ; - -M: double-rep emit-unbox - drop float-offset ##alien-double ; - -M:: vector-rep emit-box ( dst src rep -- ) - int-rep next-vreg-rep :> temp - dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot - temp 16 tag-fixnum ##load-immediate - temp dst 1 byte-array type-number ##set-slot-imm - dst byte-array-offset src rep ##set-alien-vector ; - -M: vector-rep emit-unbox - [ byte-array-offset ] dip ##alien-vector ; - -M:: scalar-rep emit-box ( dst src rep -- ) - int-rep next-vreg-rep :> temp - temp src rep ##scalar>integer - dst temp tag-bits get ##shl-imm ; - -M:: scalar-rep emit-unbox ( dst src rep -- ) - int-rep next-vreg-rep :> temp - temp src tag-bits get ##sar-imm - dst temp rep ##integer>scalar ; - -: emit-conversion ( dst src dst-rep src-rep -- ) - { - { [ 2dup eq? ] [ drop ##copy ] } - { [ dup int-rep eq? ] [ drop emit-unbox ] } - { [ over int-rep eq? ] [ nip emit-box ] } - [ - 2dup 2array { - { { double-rep float-rep } [ 2drop ##single>double-float ] } - { { float-rep double-rep } [ 2drop ##double>single-float ] } - ! Punning SIMD vector types? Naughty naughty! But - ! it is allowed... otherwise bail out. - [ - drop 2dup [ reg-class-of ] bi@ eq? - [ drop ##copy ] [ bad-conversion ] if - ] - } case - ] - } cond ; - -alist alist-min first ] assoc-map ; - -: compute-representations ( cfg -- ) - [ compute-costs minimize-costs ] - [ compute-always-boxed ] - bi assoc-union - representations set ; - -! PHI nodes require special treatment -! If the output of a phi instruction is only used as the input to another -! phi instruction, then we want to use the same representation for both -! if possible. -SYMBOL: phis - -: collect-phis ( cfg -- ) - H{ } clone phis set - [ - phis get - '[ [ inputs>> values ] [ dst>> ] bi _ set-at ] each-phi - ] each-basic-block ; - -SYMBOL: work-list - -: add-to-work-list ( vregs -- ) - work-list get push-all-front ; - -: rep-assigned ( vregs -- vregs' ) - representations get '[ _ key? ] filter ; - -: rep-not-assigned ( vregs -- vregs' ) - representations get '[ _ key? not ] filter ; - -: add-ready-phis ( -- ) - phis get keys rep-assigned add-to-work-list ; - -: process-phi ( dst -- ) - ! If dst = phi(src1,src2,...) and dst's representation has been - ! determined, assign that representation to each one of src1,... - ! that does not have a representation yet, and process those, too. - dup phis get at* [ - [ rep-of ] [ rep-not-assigned ] bi* - [ [ set-rep-of ] with each ] [ add-to-work-list ] bi - ] [ 2drop ] if ; - -: remaining-phis ( -- ) - phis get keys rep-not-assigned { } assert-sequence= ; - -: process-phis ( -- ) - work-list set - add-ready-phis - work-list get [ process-phi ] slurp-deque - remaining-phis ; - -: compute-phi-representations ( cfg -- ) - collect-phis process-phis ; - -! Insert conversions. This introduces new temporaries, so we need -! to rename opearands too. - -! Mapping from vreg,rep pairs to vregs -SYMBOL: alternatives - -:: emit-def-conversion ( dst preferred required -- new-dst' ) - ! If an instruction defines a register with representation 'required', - ! but the register has preferred representation 'preferred', then - ! we rename the instruction's definition to a new register, which - ! becomes the input of a conversion instruction. - dst required next-vreg-rep [ preferred required emit-conversion ] keep ; - -:: emit-use-conversion ( src preferred required -- new-src' ) - ! If an instruction uses a register with representation 'required', - ! but the register has preferred representation 'preferred', then - ! we rename the instruction's input to a new register, which - ! becomes the output of a conversion instruction. - preferred required eq? [ src ] [ - src required alternatives get [ - required next-vreg-rep :> new-src - [ new-src ] 2dip preferred emit-conversion - new-src - ] 2cache - ] if ; - -SYMBOLS: renaming-set needs-renaming? ; - -: init-renaming-set ( -- ) - needs-renaming? off - V{ } clone renaming-set set ; - -: no-renaming ( vreg -- ) - dup 2array renaming-set get push ; - -: record-renaming ( from to -- ) - 2array renaming-set get push needs-renaming? on ; - -:: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- new-vreg ) -- ) - vreg rep-of :> preferred - preferred required eq? - [ vreg no-renaming ] - [ vreg vreg preferred required quot call record-renaming ] if ; inline - -: compute-renaming-set ( insn -- ) - ! temp vregs don't need conversions since they're always in their - ! preferred representation - init-renaming-set - [ [ [ emit-use-conversion ] (compute-renaming-set) ] each-use-rep ] - [ , ] - [ [ [ emit-def-conversion ] (compute-renaming-set) ] each-def-rep ] - tri ; - -: converted-value ( vreg -- vreg' ) - renaming-set get pop first2 [ assert= ] dip ; - -RENAMING: convert [ converted-value ] [ converted-value ] [ ] - -: perform-renaming ( insn -- ) - needs-renaming? get [ - renaming-set get reverse! drop - [ convert-insn-uses ] [ convert-insn-defs ] bi - renaming-set get length 0 assert= - ] [ drop ] if ; - -GENERIC: conversions-for-insn ( insn -- ) - -M: ##phi conversions-for-insn , ; - -! When a float is unboxed, we replace the ##load-constant with a ##load-double -! if the architecture supports it -: convert-to-load-double? ( insn -- ? ) - { - [ drop load-double? ] - [ dst>> rep-of double-rep? ] - [ obj>> float? ] - } 1&& ; - -! When a literal zeroes/ones vector is unboxed, we replace the ##load-reference -! with a ##zero-vector or ##fill-vector instruction since this is more efficient. -: convert-to-zero-vector? ( insn -- ? ) - { - [ dst>> rep-of vector-rep? ] - [ obj>> B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } = ] - } 1&& ; - -: convert-to-fill-vector? ( insn -- ? ) - { - [ dst>> rep-of vector-rep? ] - [ obj>> B{ 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 } = ] - } 1&& ; - -: (convert-to-load-double) ( insn -- dst val ) - [ dst>> ] [ obj>> ] bi ; inline - -: (convert-to-zero/fill-vector) ( insn -- dst rep ) - dst>> dup rep-of ; inline - -: conversions-for-load-insn ( insn -- ?insn ) - { - { - [ dup convert-to-load-double? ] - [ (convert-to-load-double) ##load-double f ] - } - { - [ dup convert-to-zero-vector? ] - [ (convert-to-zero/fill-vector) ##zero-vector f ] - } - { - [ dup convert-to-fill-vector? ] - [ (convert-to-zero/fill-vector) ##fill-vector f ] - } - [ ] - } cond ; - -M: ##load-reference conversions-for-insn - conversions-for-load-insn [ call-next-method ] when* ; - -M: ##load-constant conversions-for-insn - conversions-for-load-insn [ call-next-method ] when* ; - -M: vreg-insn conversions-for-insn - [ compute-renaming-set ] [ perform-renaming ] bi ; - -M: insn conversions-for-insn , ; - -: conversions-for-block ( bb -- ) - dup kill-block? [ drop ] [ - [ - [ - H{ } clone alternatives set - [ conversions-for-insn ] each - ] V{ } make - ] change-instructions drop - ] if ; - -: insert-conversions ( cfg -- ) - [ conversions-for-block ] each-basic-block ; - -PRIVATE> - : select-representations ( cfg -- cfg' ) needs-loops diff --git a/basis/compiler/cfg/representations/rewrite/authors.txt b/basis/compiler/cfg/representations/rewrite/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/compiler/cfg/representations/rewrite/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/compiler/cfg/representations/rewrite/rewrite.factor b/basis/compiler/cfg/representations/rewrite/rewrite.factor new file mode 100644 index 0000000000..7b9164ce78 --- /dev/null +++ b/basis/compiler/cfg/representations/rewrite/rewrite.factor @@ -0,0 +1,149 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators +combinators.short-circuit compiler.cfg.instructions +compiler.cfg.registers compiler.cfg.renaming.functor +compiler.cfg.representations.conversion +compiler.cfg.representations.preferred compiler.cfg.rpo +compiler.cfg.utilities cpu.architecture kernel locals make math +namespaces sequences ; +IN: compiler.cfg.representations.rewrite + +! Insert conversions. This introduces new temporaries, so we need +! to rename opearands too. + +! Mapping from vreg,rep pairs to vregs +SYMBOL: alternatives + +:: emit-def-conversion ( dst preferred required -- new-dst' ) + ! If an instruction defines a register with representation 'required', + ! but the register has preferred representation 'preferred', then + ! we rename the instruction's definition to a new register, which + ! becomes the input of a conversion instruction. + dst required next-vreg-rep [ preferred required emit-conversion ] keep ; + +:: emit-use-conversion ( src preferred required -- new-src' ) + ! If an instruction uses a register with representation 'required', + ! but the register has preferred representation 'preferred', then + ! we rename the instruction's input to a new register, which + ! becomes the output of a conversion instruction. + preferred required eq? [ src ] [ + src required alternatives get [ + required next-vreg-rep :> new-src + [ new-src ] 2dip preferred emit-conversion + new-src + ] 2cache + ] if ; + +SYMBOLS: renaming-set needs-renaming? ; + +: init-renaming-set ( -- ) + needs-renaming? off + V{ } clone renaming-set set ; + +: no-renaming ( vreg -- ) + dup 2array renaming-set get push ; + +: record-renaming ( from to -- ) + 2array renaming-set get push needs-renaming? on ; + +:: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- new-vreg ) -- ) + vreg rep-of :> preferred + preferred required eq? + [ vreg no-renaming ] + [ vreg vreg preferred required quot call record-renaming ] if ; inline + +: compute-renaming-set ( insn -- ) + ! temp vregs don't need conversions since they're always in their + ! preferred representation + init-renaming-set + [ [ [ emit-use-conversion ] (compute-renaming-set) ] each-use-rep ] + [ , ] + [ [ [ emit-def-conversion ] (compute-renaming-set) ] each-def-rep ] + tri ; + +: converted-value ( vreg -- vreg' ) + renaming-set get pop first2 [ assert= ] dip ; + +RENAMING: convert [ converted-value ] [ converted-value ] [ ] + +: perform-renaming ( insn -- ) + needs-renaming? get [ + renaming-set get reverse! drop + [ convert-insn-uses ] [ convert-insn-defs ] bi + renaming-set get length 0 assert= + ] [ drop ] if ; + +GENERIC: conversions-for-insn ( insn -- ) + +M: ##phi conversions-for-insn , ; + +! When a float is unboxed, we replace the ##load-constant with a ##load-double +! if the architecture supports it +: convert-to-load-double? ( insn -- ? ) + { + [ drop load-double? ] + [ dst>> rep-of double-rep? ] + [ obj>> float? ] + } 1&& ; + +! When a literal zeroes/ones vector is unboxed, we replace the ##load-reference +! with a ##zero-vector or ##fill-vector instruction since this is more efficient. +: convert-to-zero-vector? ( insn -- ? ) + { + [ dst>> rep-of vector-rep? ] + [ obj>> B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } = ] + } 1&& ; + +: convert-to-fill-vector? ( insn -- ? ) + { + [ dst>> rep-of vector-rep? ] + [ obj>> B{ 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 } = ] + } 1&& ; + +: (convert-to-load-double) ( insn -- dst val ) + [ dst>> ] [ obj>> ] bi ; inline + +: (convert-to-zero/fill-vector) ( insn -- dst rep ) + dst>> dup rep-of ; inline + +: conversions-for-load-insn ( insn -- ?insn ) + { + { + [ dup convert-to-load-double? ] + [ (convert-to-load-double) ##load-double f ] + } + { + [ dup convert-to-zero-vector? ] + [ (convert-to-zero/fill-vector) ##zero-vector f ] + } + { + [ dup convert-to-fill-vector? ] + [ (convert-to-zero/fill-vector) ##fill-vector f ] + } + [ ] + } cond ; + +M: ##load-reference conversions-for-insn + conversions-for-load-insn [ call-next-method ] when* ; + +M: ##load-constant conversions-for-insn + conversions-for-load-insn [ call-next-method ] when* ; + +M: vreg-insn conversions-for-insn + [ compute-renaming-set ] [ perform-renaming ] bi ; + +M: insn conversions-for-insn , ; + +: conversions-for-block ( bb -- ) + dup kill-block? [ drop ] [ + [ + [ + H{ } clone alternatives set + [ conversions-for-insn ] each + ] V{ } make + ] change-instructions drop + ] if ; + +: insert-conversions ( cfg -- ) + [ conversions-for-block ] each-basic-block ; diff --git a/basis/compiler/cfg/representations/selection/authors.txt b/basis/compiler/cfg/representations/selection/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/compiler/cfg/representations/selection/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/compiler/cfg/representations/selection/selection.factor b/basis/compiler/cfg/representations/selection/selection.factor new file mode 100644 index 0000000000..4178101ddd --- /dev/null +++ b/basis/compiler/cfg/representations/selection/selection.factor @@ -0,0 +1,143 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs compiler.cfg compiler.cfg.instructions +compiler.cfg.loop-detection compiler.cfg.registers +compiler.cfg.representations.preferred compiler.cfg.rpo +compiler.cfg.utilities compiler.utilities cpu.architecture +deques dlists fry kernel locals math namespaces sequences sets ; +FROM: namespaces => set ; +IN: compiler.cfg.representations.selection + +! For every vreg, compute possible representations. +SYMBOL: possibilities + +: possible ( vreg -- reps ) possibilities get at ; + +: compute-possibilities ( cfg -- ) + H{ } clone [ '[ swap _ adjoin-at ] with-vreg-reps ] keep + [ members ] assoc-map possibilities set ; + +! Compute vregs which must remain tagged for their lifetime. +SYMBOL: always-boxed + +:: (compute-always-boxed) ( vreg rep assoc -- ) + rep tagged-rep eq? [ + tagged-rep vreg assoc set-at + ] when ; + +: compute-always-boxed ( cfg -- assoc ) + H{ } clone [ + '[ + [ + dup [ ##load-reference? ] [ ##load-constant? ] bi or + [ drop ] [ [ _ (compute-always-boxed) ] each-def-rep ] if + ] each-non-phi + ] each-basic-block + ] keep ; + +! For every vreg, compute the cost of keeping it in every possible +! representation. + +! Cost map maps vreg to representation to cost. +SYMBOL: costs + +: init-costs ( -- ) + possibilities get [ drop H{ } clone ] assoc-map costs set ; + +: record-possibility ( rep vreg -- ) + costs get at [ 0 or ] change-at ; + +: increase-cost ( rep vreg -- ) + ! Increase cost of keeping vreg in rep, making a choice of rep less + ! likely. + costs get at [ 0 or basic-block get loop-nesting-at 1 + + ] change-at ; + +: maybe-increase-cost ( possible vreg preferred -- ) + pick eq? [ record-possibility ] [ increase-cost ] if ; + +: representation-cost ( vreg preferred -- ) + ! 'preferred' is a representation that the instruction can accept with no cost. + ! So, for each representation that's not preferred, increase the cost of keeping + ! the vreg in that representation. + [ drop possible ] + [ '[ _ _ maybe-increase-cost ] ] + 2bi each ; + +GENERIC: compute-insn-costs ( insn -- ) + +M: ##load-constant compute-insn-costs + ! There's no cost to unboxing the result of a ##load-constant + drop ; + +M: insn compute-insn-costs [ representation-cost ] each-rep ; + +: compute-costs ( cfg -- costs ) + init-costs + [ + [ basic-block set ] + [ + [ + compute-insn-costs + ] each-non-phi + ] bi + ] each-basic-block + costs get ; + +! For every vreg, compute preferred representation, that minimizes costs. +: minimize-costs ( costs -- representations ) + [ nip assoc-empty? not ] assoc-filter + [ >alist alist-min first ] assoc-map ; + +: compute-representations ( cfg -- ) + [ compute-costs minimize-costs ] + [ compute-always-boxed ] + bi assoc-union + representations set ; + +! PHI nodes require special treatment +! If the output of a phi instruction is only used as the input to another +! phi instruction, then we want to use the same representation for both +! if possible. +SYMBOL: phis + +: collect-phis ( cfg -- ) + H{ } clone phis set + [ + phis get + '[ [ inputs>> values ] [ dst>> ] bi _ set-at ] each-phi + ] each-basic-block ; + +SYMBOL: work-list + +: add-to-work-list ( vregs -- ) + work-list get push-all-front ; + +: rep-assigned ( vregs -- vregs' ) + representations get '[ _ key? ] filter ; + +: rep-not-assigned ( vregs -- vregs' ) + representations get '[ _ key? not ] filter ; + +: add-ready-phis ( -- ) + phis get keys rep-assigned add-to-work-list ; + +: process-phi ( dst -- ) + ! If dst = phi(src1,src2,...) and dst's representation has been + ! determined, assign that representation to each one of src1,... + ! that does not have a representation yet, and process those, too. + dup phis get at* [ + [ rep-of ] [ rep-not-assigned ] bi* + [ [ set-rep-of ] with each ] [ add-to-work-list ] bi + ] [ 2drop ] if ; + +: remaining-phis ( -- ) + phis get keys rep-not-assigned { } assert-sequence= ; + +: process-phis ( -- ) + work-list set + add-ready-phis + work-list get [ process-phi ] slurp-deque + remaining-phis ; + +: compute-phi-representations ( cfg -- ) + collect-phis process-phis ; diff --git a/basis/compiler/cfg/save-contexts/save-contexts.factor b/basis/compiler/cfg/save-contexts/save-contexts.factor index c7b6db0671..e2ccf943ad 100644 --- a/basis/compiler/cfg/save-contexts/save-contexts.factor +++ b/basis/compiler/cfg/save-contexts/save-contexts.factor @@ -20,8 +20,8 @@ IN: compiler.cfg.save-contexts : insert-save-context ( bb -- ) dup instructions>> dup needs-save-context? [ - int-rep next-vreg-rep - int-rep next-vreg-rep + tagged-rep next-vreg-rep + tagged-rep next-vreg-rep \ ##save-context new-insn prefix >>instructions drop ] [ 2drop ] if ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 8adae2ae99..6f9354a767 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -224,6 +224,7 @@ M:: ppc %float>integer ( dst src -- ) M: ppc %copy ( dst src rep -- ) 2over eq? [ 3drop ] [ { + { tagged-rep [ MR ] } { int-rep [ MR ] } { double-rep [ FMR ] } } case diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 432d210bec..d1c71f3cd4 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -168,9 +168,7 @@ M:: x86.64 %box ( n rep func -- ) ] [ rep load-return-value ] if - rep int-rep? - cpu x86.64? os windows? and or - param-reg-1 param-reg-0 ? %mov-vm-ptr + rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr func f %alien-invoke ; : box-struct-field@ ( i -- operand ) 1 + cells param@ ;