Merge branch 'master' of factorcode.org:/git/factor
commit
eb89311bcd
|
@ -1,6 +1,6 @@
|
||||||
USING: arrays compiler.cfg.alias-analysis compiler.cfg.instructions
|
USING: arrays compiler.cfg.alias-analysis compiler.cfg.instructions
|
||||||
compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons
|
compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons
|
||||||
cpu.architecture tools.test ;
|
cpu.architecture tools.test byte-arrays layouts literals alien ;
|
||||||
IN: compiler.cfg.alias-analysis.tests
|
IN: compiler.cfg.alias-analysis.tests
|
||||||
|
|
||||||
! Redundant load elimination
|
! Redundant load elimination
|
||||||
|
@ -242,3 +242,22 @@ IN: compiler.cfg.alias-analysis.tests
|
||||||
T{ ##compare f 2 0 1 cc= }
|
T{ ##compare f 2 0 1 cc= }
|
||||||
} alias-analysis-step
|
} alias-analysis-step
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! Make sure that input to ##box-displaced-alien becomes heap-ac
|
||||||
|
[
|
||||||
|
V{
|
||||||
|
T{ ##allot f 1 16 byte-array }
|
||||||
|
T{ ##load-reference f 2 10 }
|
||||||
|
T{ ##box-displaced-alien f 3 2 1 4 byte-array }
|
||||||
|
T{ ##slot-imm f 5 3 1 $[ alien type-number ] }
|
||||||
|
T{ ##compare f 6 5 1 cc= }
|
||||||
|
}
|
||||||
|
] [
|
||||||
|
V{
|
||||||
|
T{ ##allot f 1 16 byte-array }
|
||||||
|
T{ ##load-reference f 2 10 }
|
||||||
|
T{ ##box-displaced-alien f 3 2 1 4 byte-array }
|
||||||
|
T{ ##slot-imm f 5 3 1 $[ alien type-number ] }
|
||||||
|
T{ ##compare f 6 5 1 cc= }
|
||||||
|
} alias-analysis-step
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -255,6 +255,10 @@ M: ##allocation analyze-aliases*
|
||||||
#! object.
|
#! object.
|
||||||
dup dst>> set-new-ac ;
|
dup dst>> set-new-ac ;
|
||||||
|
|
||||||
|
M: ##box-displaced-alien analyze-aliases*
|
||||||
|
[ call-next-method ]
|
||||||
|
[ base>> heap-ac get merge-acs ] bi ;
|
||||||
|
|
||||||
M: ##read analyze-aliases*
|
M: ##read analyze-aliases*
|
||||||
call-next-method
|
call-next-method
|
||||||
dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
|
dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
|
||||||
|
|
|
@ -13,7 +13,7 @@ V{ } clone insn-classes set-global
|
||||||
|
|
||||||
: new-insn ( ... class -- insn ) f swap boa ; inline
|
: new-insn ( ... class -- insn ) f swap boa ; inline
|
||||||
|
|
||||||
! Virtual CPU instructions, used by CFG and machine IRs
|
! Virtual CPU instructions, used by CFG IR
|
||||||
TUPLE: insn ;
|
TUPLE: insn ;
|
||||||
|
|
||||||
! Instructions which are referentially transparent; used for
|
! Instructions which are referentially transparent; used for
|
||||||
|
@ -364,12 +364,6 @@ use: src1
|
||||||
temp: temp/int-rep
|
temp: temp/int-rep
|
||||||
literal: rep vcc ;
|
literal: rep vcc ;
|
||||||
|
|
||||||
INSN: _test-vector-branch
|
|
||||||
literal: label
|
|
||||||
use: src1
|
|
||||||
temp: temp/int-rep
|
|
||||||
literal: rep vcc ;
|
|
||||||
|
|
||||||
PURE-INSN: ##add-vector
|
PURE-INSN: ##add-vector
|
||||||
def: dst
|
def: dst
|
||||||
use: src1 src2
|
use: src1 src2
|
||||||
|
|
|
@ -472,3 +472,10 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
[ ] [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test
|
[ ] [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test
|
||||||
|
|
||||||
|
! Alias analysis bug
|
||||||
|
[ t ] [
|
||||||
|
[
|
||||||
|
10 10 <byte-array> [ <displaced-alien> underlying>> ] keep eq?
|
||||||
|
] compile-call
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -272,6 +272,11 @@ generic-comparison-ops [
|
||||||
2drop alien \ f class-or <class-info>
|
2drop alien \ f class-or <class-info>
|
||||||
] "outputs" set-word-prop
|
] "outputs" set-word-prop
|
||||||
|
|
||||||
|
\ <displaced-alien> [
|
||||||
|
[ interval>> 0 swap interval-contains? ] dip
|
||||||
|
class>> alien class-or alien ? <class-info>
|
||||||
|
] "outputs" set-word-prop
|
||||||
|
|
||||||
{ <tuple> <tuple-boa> } [
|
{ <tuple> <tuple-boa> } [
|
||||||
[
|
[
|
||||||
literal>> dup array? [ first ] [ drop tuple ] if <class-info>
|
literal>> dup array? [ first ] [ drop tuple ] if <class-info>
|
||||||
|
|
|
@ -976,3 +976,22 @@ M: tuple-with-read-only-slot clone
|
||||||
! Should actually be 0 23 2^ 1 - [a,b]
|
! Should actually be 0 23 2^ 1 - [a,b]
|
||||||
[ string-nth ] final-info first interval>> 0 23 2^ [a,b] =
|
[ string-nth ] final-info first interval>> 0 23 2^ [a,b] =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! Non-zero displacement for <displaced-alien> restricts the output type
|
||||||
|
[ t ] [
|
||||||
|
[ { byte-array } declare <displaced-alien> ] final-classes
|
||||||
|
first byte-array alien class-or class=
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ V{ alien } ] [
|
||||||
|
[ { alien } declare <displaced-alien> ] final-classes
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
[ { POSTPONE: f } declare <displaced-alien> ] final-classes
|
||||||
|
first \ f alien class-or class=
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ V{ alien } ] [
|
||||||
|
[ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes
|
||||||
|
] unit-test
|
||||||
|
|
Loading…
Reference in New Issue