Merge branch 'master' of git://factorcode.org/git/factor
Joe Groff
commit
6fe7fe72c7
|
|
@ -1,6 +1,6 @@
|
|||
IN: alarms.tests
|
||||
USING: alarms alarms.private kernel calendar sequences
|
||||
tools.test threads concurrency.count-downs ;
|
||||
IN: alarms.tests
|
||||
|
||||
[ ] [
|
||||
1 <count-down>
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays calendar combinators generic init
|
||||
kernel math namespaces sequences heaps boxes threads
|
||||
quotations assocs math.order ;
|
||||
USING: accessors assocs boxes calendar
|
||||
combinators.short-circuit fry heaps init kernel math.order
|
||||
namespaces quotations threads ;
|
||||
IN: alarms
|
||||
|
||||
TUPLE: alarm
|
||||
|
|
@ -21,21 +21,21 @@ SYMBOL: alarm-thread
|
|||
|
||||
ERROR: bad-alarm-frequency frequency ;
|
||||
: check-alarm ( frequency/f -- frequency/f )
|
||||
dup [ duration? ] [ not ] bi or [ bad-alarm-frequency ] unless ;
|
||||
dup { [ duration? ] [ not ] } 1|| [ bad-alarm-frequency ] unless ;
|
||||
|
||||
: <alarm> ( quot time frequency -- alarm )
|
||||
check-alarm <box> alarm boa ;
|
||||
|
||||
: register-alarm ( alarm -- )
|
||||
dup dup time>> alarms get-global heap-push*
|
||||
swap entry>> >box
|
||||
[ dup time>> alarms get-global heap-push* ]
|
||||
[ entry>> >box ] bi
|
||||
notify-alarm-thread ;
|
||||
|
||||
: alarm-expired? ( alarm now -- ? )
|
||||
[ time>> ] dip before=? ;
|
||||
|
||||
: reschedule-alarm ( alarm -- )
|
||||
dup [ swap interval>> time+ now max ] change-time register-alarm ;
|
||||
dup '[ _ interval>> time+ now max ] change-time register-alarm ;
|
||||
|
||||
: call-alarm ( alarm -- )
|
||||
[ entry>> box> drop ]
|
||||
|
|
|
|||
|
|
@ -11,6 +11,8 @@ M: array c-type ;
|
|||
|
||||
M: array c-type-class drop object ;
|
||||
|
||||
M: array c-type-boxed-class drop object ;
|
||||
|
||||
M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
|
||||
|
||||
M: array c-type-align first c-type-align ;
|
||||
|
|
@ -31,7 +33,7 @@ M: array c-type-boxer-quot drop [ ] ;
|
|||
|
||||
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
||||
|
||||
M: value-type c-type-reg-class drop int-regs ;
|
||||
M: value-type c-type-rep drop int-rep ;
|
||||
|
||||
M: value-type c-type-getter
|
||||
drop [ swap <displaced-alien> ] ;
|
||||
|
|
@ -45,8 +47,9 @@ PREDICATE: string-type < pair
|
|||
|
||||
M: string-type c-type ;
|
||||
|
||||
M: string-type c-type-class
|
||||
drop object ;
|
||||
M: string-type c-type-class drop object ;
|
||||
|
||||
M: string-type c-type-boxed-class drop object ;
|
||||
|
||||
M: string-type heap-size
|
||||
drop "void*" heap-size ;
|
||||
|
|
@ -72,8 +75,8 @@ M: string-type box-return
|
|||
M: string-type stack-size
|
||||
drop "void*" stack-size ;
|
||||
|
||||
M: string-type c-type-reg-class
|
||||
drop int-regs ;
|
||||
M: string-type c-type-rep
|
||||
drop int-rep ;
|
||||
|
||||
M: string-type c-type-boxer
|
||||
drop "void*" c-type-boxer ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
IN: alien.c-types.tests
|
||||
USING: alien alien.syntax alien.c-types kernel tools.test
|
||||
sequences system libc alien.strings io.encodings.utf8 ;
|
||||
IN: alien.c-types.tests
|
||||
|
||||
CONSTANT: xyz 123
|
||||
|
||||
|
|
|
|||
|
|
@ -13,17 +13,20 @@ DEFER: *char
|
|||
|
||||
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
|
||||
|
||||
TUPLE: c-type
|
||||
TUPLE: abstract-c-type
|
||||
{ class class initial: object }
|
||||
boxer
|
||||
{ boxed-class class initial: object }
|
||||
{ boxer-quot callable }
|
||||
unboxer
|
||||
{ unboxer-quot callable }
|
||||
{ getter callable }
|
||||
{ setter callable }
|
||||
{ reg-class initial: int-regs }
|
||||
size
|
||||
align
|
||||
align ;
|
||||
|
||||
TUPLE: c-type < abstract-c-type
|
||||
boxer
|
||||
unboxer
|
||||
{ rep initial: int-rep }
|
||||
stack-align? ;
|
||||
|
||||
: <c-type> ( -- type )
|
||||
|
|
@ -70,10 +73,16 @@ M: string c-type ( name -- type )
|
|||
|
||||
GENERIC: c-type-class ( name -- class )
|
||||
|
||||
M: c-type c-type-class class>> ;
|
||||
M: abstract-c-type c-type-class class>> ;
|
||||
|
||||
M: string c-type-class c-type c-type-class ;
|
||||
|
||||
GENERIC: c-type-boxed-class ( name -- class )
|
||||
|
||||
M: abstract-c-type c-type-boxed-class boxed-class>> ;
|
||||
|
||||
M: string c-type-boxed-class c-type c-type-boxed-class ;
|
||||
|
||||
GENERIC: c-type-boxer ( name -- boxer )
|
||||
|
||||
M: c-type c-type-boxer boxer>> ;
|
||||
|
|
@ -82,7 +91,7 @@ M: string c-type-boxer c-type c-type-boxer ;
|
|||
|
||||
GENERIC: c-type-boxer-quot ( name -- quot )
|
||||
|
||||
M: c-type c-type-boxer-quot boxer-quot>> ;
|
||||
M: abstract-c-type c-type-boxer-quot boxer-quot>> ;
|
||||
|
||||
M: string c-type-boxer-quot c-type c-type-boxer-quot ;
|
||||
|
||||
|
|
@ -94,15 +103,15 @@ M: string c-type-unboxer c-type c-type-unboxer ;
|
|||
|
||||
GENERIC: c-type-unboxer-quot ( name -- quot )
|
||||
|
||||
M: c-type c-type-unboxer-quot unboxer-quot>> ;
|
||||
M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ;
|
||||
|
||||
M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
|
||||
|
||||
GENERIC: c-type-reg-class ( name -- reg-class )
|
||||
GENERIC: c-type-rep ( name -- rep )
|
||||
|
||||
M: c-type c-type-reg-class reg-class>> ;
|
||||
M: c-type c-type-rep rep>> ;
|
||||
|
||||
M: string c-type-reg-class c-type c-type-reg-class ;
|
||||
M: string c-type-rep c-type c-type-rep ;
|
||||
|
||||
GENERIC: c-type-getter ( name -- quot )
|
||||
|
||||
|
|
@ -118,7 +127,7 @@ M: string c-type-setter c-type c-type-setter ;
|
|||
|
||||
GENERIC: c-type-align ( name -- n )
|
||||
|
||||
M: c-type c-type-align align>> ;
|
||||
M: abstract-c-type c-type-align align>> ;
|
||||
|
||||
M: string c-type-align c-type c-type-align ;
|
||||
|
||||
|
|
@ -129,13 +138,11 @@ M: c-type c-type-stack-align? stack-align?>> ;
|
|||
M: string c-type-stack-align? c-type c-type-stack-align? ;
|
||||
|
||||
: c-type-box ( n type -- )
|
||||
dup c-type-reg-class
|
||||
swap c-type-boxer [ "No boxer" throw ] unless*
|
||||
[ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
|
||||
%box ;
|
||||
|
||||
: c-type-unbox ( n ctype -- )
|
||||
dup c-type-reg-class
|
||||
swap c-type-unboxer [ "No unboxer" throw ] unless*
|
||||
[ c-type-rep ] [ c-type-unboxer [ "No unboxer" throw ] unless* ] bi
|
||||
%unbox ;
|
||||
|
||||
GENERIC: box-parameter ( n ctype -- )
|
||||
|
|
@ -169,7 +176,7 @@ GENERIC: heap-size ( type -- size ) foldable
|
|||
|
||||
M: string heap-size c-type heap-size ;
|
||||
|
||||
M: c-type heap-size size>> ;
|
||||
M: abstract-c-type heap-size size>> ;
|
||||
|
||||
GENERIC: stack-size ( type -- size ) foldable
|
||||
|
||||
|
|
@ -300,6 +307,7 @@ CONSTANT: primitive-types
|
|||
[
|
||||
<c-type>
|
||||
c-ptr >>class
|
||||
c-ptr >>boxed-class
|
||||
[ alien-cell ] >>getter
|
||||
[ [ >c-ptr ] 2dip set-alien-cell ] >>setter
|
||||
bootstrap-cell >>size
|
||||
|
|
@ -311,6 +319,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<long-long-type>
|
||||
integer >>class
|
||||
integer >>boxed-class
|
||||
[ alien-signed-8 ] >>getter
|
||||
[ set-alien-signed-8 ] >>setter
|
||||
8 >>size
|
||||
|
|
@ -321,6 +330,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<long-long-type>
|
||||
integer >>class
|
||||
integer >>boxed-class
|
||||
[ alien-unsigned-8 ] >>getter
|
||||
[ set-alien-unsigned-8 ] >>setter
|
||||
8 >>size
|
||||
|
|
@ -331,6 +341,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
integer >>class
|
||||
integer >>boxed-class
|
||||
[ alien-signed-cell ] >>getter
|
||||
[ set-alien-signed-cell ] >>setter
|
||||
bootstrap-cell >>size
|
||||
|
|
@ -341,6 +352,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
integer >>class
|
||||
integer >>boxed-class
|
||||
[ alien-unsigned-cell ] >>getter
|
||||
[ set-alien-unsigned-cell ] >>setter
|
||||
bootstrap-cell >>size
|
||||
|
|
@ -351,6 +363,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
integer >>class
|
||||
integer >>boxed-class
|
||||
[ alien-signed-4 ] >>getter
|
||||
[ set-alien-signed-4 ] >>setter
|
||||
4 >>size
|
||||
|
|
@ -361,6 +374,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
integer >>class
|
||||
integer >>boxed-class
|
||||
[ alien-unsigned-4 ] >>getter
|
||||
[ set-alien-unsigned-4 ] >>setter
|
||||
4 >>size
|
||||
|
|
@ -371,6 +385,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
fixnum >>boxed-class
|
||||
[ alien-signed-2 ] >>getter
|
||||
[ set-alien-signed-2 ] >>setter
|
||||
2 >>size
|
||||
|
|
@ -381,6 +396,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
fixnum >>boxed-class
|
||||
[ alien-unsigned-2 ] >>getter
|
||||
[ set-alien-unsigned-2 ] >>setter
|
||||
2 >>size
|
||||
|
|
@ -391,6 +407,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
fixnum >>boxed-class
|
||||
[ alien-signed-1 ] >>getter
|
||||
[ set-alien-signed-1 ] >>setter
|
||||
1 >>size
|
||||
|
|
@ -401,6 +418,7 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
fixnum >>class
|
||||
fixnum >>boxed-class
|
||||
[ alien-unsigned-1 ] >>getter
|
||||
[ set-alien-unsigned-1 ] >>setter
|
||||
1 >>size
|
||||
|
|
@ -420,25 +438,27 @@ CONSTANT: primitive-types
|
|||
|
||||
<c-type>
|
||||
float >>class
|
||||
float >>boxed-class
|
||||
[ alien-float ] >>getter
|
||||
[ [ >float ] 2dip set-alien-float ] >>setter
|
||||
4 >>size
|
||||
4 >>align
|
||||
"box_float" >>boxer
|
||||
"to_float" >>unboxer
|
||||
single-float-regs >>reg-class
|
||||
single-float-rep >>rep
|
||||
[ >float ] >>unboxer-quot
|
||||
"float" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
float >>class
|
||||
float >>boxed-class
|
||||
[ alien-double ] >>getter
|
||||
[ [ >float ] 2dip set-alien-double ] >>setter
|
||||
8 >>size
|
||||
8 >>align
|
||||
"box_double" >>boxer
|
||||
"to_double" >>unboxer
|
||||
double-float-regs >>reg-class
|
||||
double-float-rep >>rep
|
||||
[ >float ] >>unboxer-quot
|
||||
"double" define-primitive-type
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test alien.complex kernel alien.c-types alien.syntax
|
||||
namespaces ;
|
||||
namespaces math ;
|
||||
IN: alien.complex.tests
|
||||
|
||||
C-STRUCT: complex-holder
|
||||
|
|
@ -16,3 +16,7 @@ C-STRUCT: complex-holder
|
|||
] unit-test
|
||||
|
||||
[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
|
||||
|
||||
[ number ] [ "complex-float" c-type-boxed-class ] unit-test
|
||||
|
||||
[ number ] [ "complex-double" c-type-boxed-class ] unit-test
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test alien.complex.functor ;
|
||||
IN: alien.complex.functor.tests
|
||||
|
|
@ -30,6 +30,7 @@ define-struct
|
|||
T c-type
|
||||
<T> 1quotation >>unboxer-quot
|
||||
*T 1quotation >>boxer-quot
|
||||
number >>boxed-class
|
||||
drop
|
||||
|
||||
;FUNCTOR
|
||||
|
|
|
|||
|
|
@ -1,4 +0,0 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test alien.destructors ;
|
||||
IN: alien.destructors.tests
|
||||
|
|
@ -365,7 +365,7 @@ M: character-type (<fortran-result>)
|
|||
] bi* ;
|
||||
|
||||
: (fortran-in-shuffle) ( ret par -- seq )
|
||||
[ [ second ] bi@ <=> ] sort append ;
|
||||
[ second ] sort-with append ;
|
||||
|
||||
: (fortran-out-shuffle) ( ret par -- seq )
|
||||
append ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: alien.libraries.tests
|
||||
USING: alien.libraries alien.syntax tools.test kernel ;
|
||||
IN: alien.libraries.tests
|
||||
|
||||
[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
IN: alien.structs.tests
|
||||
USING: alien alien.syntax alien.c-types kernel tools.test
|
||||
sequences system libc words vocabs namespaces layouts ;
|
||||
IN: alien.structs.tests
|
||||
|
||||
C-STRUCT: bar
|
||||
{ "int" "x" }
|
||||
|
|
|
|||
|
|
@ -6,30 +6,12 @@ alien.c-types alien.structs.fields cpu.architecture math.order
|
|||
quotations byte-arrays ;
|
||||
IN: alien.structs
|
||||
|
||||
TUPLE: struct-type
|
||||
size
|
||||
align
|
||||
fields
|
||||
{ boxer-quot callable }
|
||||
{ unboxer-quot callable }
|
||||
{ getter callable }
|
||||
{ setter callable }
|
||||
return-in-registers? ;
|
||||
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
||||
|
||||
M: struct-type c-type ;
|
||||
|
||||
M: struct-type heap-size size>> ;
|
||||
|
||||
M: struct-type c-type-class drop byte-array ;
|
||||
|
||||
M: struct-type c-type-align align>> ;
|
||||
|
||||
M: struct-type c-type-stack-align? drop f ;
|
||||
|
||||
M: struct-type c-type-boxer-quot boxer-quot>> ;
|
||||
|
||||
M: struct-type c-type-unboxer-quot unboxer-quot>> ;
|
||||
|
||||
: if-value-struct ( ctype true false -- )
|
||||
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||
|
||||
|
|
@ -56,6 +38,8 @@ M: struct-type stack-size
|
|||
: (define-struct) ( name size align fields -- )
|
||||
[ [ align ] keep ] dip
|
||||
struct-type new
|
||||
byte-array >>class
|
||||
byte-array >>boxed-class
|
||||
swap >>fields
|
||||
swap >>align
|
||||
swap >>size
|
||||
|
|
|
|||
|
|
@ -31,8 +31,10 @@ SYNTAX: C-ENUM:
|
|||
";" parse-tokens
|
||||
[ [ create-in ] dip define-constant ] each-index ;
|
||||
|
||||
ERROR: no-such-symbol name library ;
|
||||
|
||||
: address-of ( name library -- value )
|
||||
load-library dlsym [ "No such symbol" throw ] unless* ;
|
||||
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
|
||||
|
||||
SYNTAX: &:
|
||||
scan "c-library" get '[ _ _ address-of ] over push-all ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: biassocs.tests
|
||||
USING: biassocs assocs namespaces tools.test ;
|
||||
IN: biassocs.tests
|
||||
|
||||
<bihash> "h" set
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: binary-search.tests
|
||||
USING: binary-search math.order vectors kernel tools.test ;
|
||||
IN: binary-search.tests
|
||||
|
||||
[ f ] [ 3 { } [ <=> ] with search drop ] unit-test
|
||||
[ 0 ] [ 3 { 3 } [ <=> ] with search drop ] unit-test
|
||||
|
|
@ -9,7 +9,7 @@ USING: binary-search math.order vectors kernel tools.test ;
|
|||
[ 4 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
|
||||
[ 10 ] [ 10 20 >vector [ <=> ] with search drop ] unit-test
|
||||
|
||||
[ t ] [ "hello" { "alligrator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
|
||||
[ 3 ] [ "hey" { "alligrator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
|
||||
[ f ] [ "hello" { "alligrator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
|
||||
[ f ] [ "zebra" { "alligrator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
|
||||
[ t ] [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
|
||||
[ 3 ] [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
|
||||
[ f ] [ "hello" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
|
||||
[ f ] [ "zebra" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: bit-sets.tests
|
||||
USING: bit-sets tools.test bit-arrays ;
|
||||
IN: bit-sets.tests
|
||||
|
||||
[ ?{ t f t f t f } ] [
|
||||
?{ t f f f t f }
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: bit-vectors.tests
|
||||
USING: tools.test bit-vectors vectors sequences kernel math ;
|
||||
IN: bit-vectors.tests
|
||||
|
||||
[ 0 ] [ 123 <bit-vector> length ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,6 @@ grouping compression.lzw multiline byte-arrays io.encodings.binary
|
|||
io.streams.byte-array ;
|
||||
IN: bitstreams.tests
|
||||
|
||||
|
||||
[ BIN: 1111111111 ]
|
||||
[
|
||||
B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
|
||||
|
|
|
|||
|
|
@ -1,38 +1,42 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors compiler.cfg.builder compiler.cfg.linear-scan
|
||||
compiler.cfg.liveness compiler.cfg.mr compiler.cfg.optimizer
|
||||
compiler.cfg.stacks.finalize compiler.cfg.stacks.global
|
||||
compiler.codegen compiler.tree.builder compiler.tree.optimizer
|
||||
kernel make sequences tools.annotations tools.crossref ;
|
||||
USING: accessors kernel make sequences tools.annotations tools.crossref ;
|
||||
QUALIFIED: compiler.cfg.builder
|
||||
QUALIFIED: compiler.cfg.linear-scan
|
||||
QUALIFIED: compiler.cfg.mr
|
||||
QUALIFIED: compiler.cfg.optimizer
|
||||
QUALIFIED: compiler.cfg.stacks.finalize
|
||||
QUALIFIED: compiler.cfg.stacks.global
|
||||
QUALIFIED: compiler.codegen
|
||||
QUALIFIED: compiler.tree.builder
|
||||
QUALIFIED: compiler.tree.optimizer
|
||||
IN: bootstrap.compiler.timing
|
||||
|
||||
: passes ( word -- seq )
|
||||
def>> uses [ vocabulary>> "compiler." head? ] filter ;
|
||||
|
||||
: high-level-passes ( -- seq ) \ optimize-tree passes ;
|
||||
: high-level-passes ( -- seq ) \ compiler.tree.optimizer:optimize-tree passes ;
|
||||
|
||||
: low-level-passes ( -- seq ) \ optimize-cfg passes ;
|
||||
: low-level-passes ( -- seq ) \ compiler.cfg.optimizer:optimize-cfg passes ;
|
||||
|
||||
: machine-passes ( -- seq ) \ build-mr passes ;
|
||||
: machine-passes ( -- seq ) \ compiler.cfg.mr:build-mr passes ;
|
||||
|
||||
: linear-scan-passes ( -- seq ) \ (linear-scan) passes ;
|
||||
: linear-scan-passes ( -- seq ) \ compiler.cfg.linear-scan:(linear-scan) passes ;
|
||||
|
||||
: all-passes ( -- seq )
|
||||
[
|
||||
\ build-tree ,
|
||||
\ optimize-tree ,
|
||||
\ compiler.tree.builder:build-tree ,
|
||||
\ compiler.tree.optimizer:optimize-tree ,
|
||||
high-level-passes %
|
||||
\ build-cfg ,
|
||||
\ compute-global-sets ,
|
||||
\ finalize-stack-shuffling ,
|
||||
\ optimize-cfg ,
|
||||
\ compiler.cfg.builder:build-cfg ,
|
||||
\ compiler.cfg.stacks.global:compute-global-sets ,
|
||||
\ compiler.cfg.stacks.finalize:finalize-stack-shuffling ,
|
||||
\ compiler.cfg.optimizer:optimize-cfg ,
|
||||
low-level-passes %
|
||||
\ compute-live-sets ,
|
||||
\ build-mr ,
|
||||
\ compiler.cfg.mr:build-mr ,
|
||||
machine-passes %
|
||||
linear-scan-passes %
|
||||
\ generate ,
|
||||
\ compiler.codegen:generate ,
|
||||
] { } make ;
|
||||
|
||||
all-passes [ [ reset ] [ add-timing ] bi ] each
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
IN: bootstrap.image.tests
|
||||
USING: bootstrap.image bootstrap.image.private tools.test
|
||||
kernel math ;
|
||||
IN: bootstrap.image.tests
|
||||
|
||||
[ f ] [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: boxes.tests
|
||||
USING: boxes namespaces tools.test accessors ;
|
||||
IN: boxes.tests
|
||||
|
||||
[ ] [ <box> "b" set ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -8,4 +8,3 @@ SYNTAX: HEX{
|
|||
[ blank? not ] filter
|
||||
2 group [ hex> ] B{ } map-as
|
||||
parsed ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +0,0 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test cache ;
|
||||
IN: cache.tests
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
IN: cairo.tests
|
||||
USING: cairo tools.test math.rectangles accessors ;
|
||||
IN: cairo.tests
|
||||
|
||||
[ { 10 20 } ] [
|
||||
{ 10 20 } [
|
||||
|
|
|
|||
|
|
@ -20,14 +20,14 @@ HELP: <date>
|
|||
{ $values { "year" integer } { "month" integer } { "day" integer } { "timestamp" timestamp } }
|
||||
{ $description "Returns a timestamp object representing the start of the specified day in your current timezone." }
|
||||
{ $examples
|
||||
{ $example "USING: calendar prettyprint ;"
|
||||
"2010 12 25 <date> >gmt midnight ."
|
||||
{ $example "USING: accessors calendar prettyprint ;"
|
||||
"2010 12 25 <date> instant >>gmt-offset ."
|
||||
"T{ timestamp { year 2010 } { month 12 } { day 25 } }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: month-names
|
||||
{ $values { "array" array } }
|
||||
{ $values { "value" object } }
|
||||
{ $description "Returns an array with the English names of all the months." }
|
||||
{ $warning "Do not use this array for looking up a month name directly. Use month-name instead." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -34,22 +34,22 @@ C: <timestamp> timestamp
|
|||
: <date> ( year month day -- timestamp )
|
||||
0 0 0 gmt-offset-duration <timestamp> ;
|
||||
|
||||
ERROR: not-a-month n ;
|
||||
ERROR: not-a-month ;
|
||||
M: not-a-month summary
|
||||
drop "Months are indexed starting at 1" ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: check-month ( n -- n )
|
||||
dup zero? [ not-a-month ] when ;
|
||||
[ not-a-month ] when-zero ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: month-names ( -- array )
|
||||
CONSTANT: month-names
|
||||
{
|
||||
"January" "February" "March" "April" "May" "June"
|
||||
"July" "August" "September" "October" "November" "December"
|
||||
} ;
|
||||
}
|
||||
|
||||
: month-name ( n -- string )
|
||||
check-month 1 - month-names nth ;
|
||||
|
|
@ -186,9 +186,6 @@ GENERIC: +second ( timestamp x -- timestamp )
|
|||
{ [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&&
|
||||
[ 3 >>month 1 >>day ] when ;
|
||||
|
||||
: unless-zero ( n quot -- )
|
||||
[ dup zero? [ drop ] ] dip if ; inline
|
||||
|
||||
M: integer +year ( timestamp n -- timestamp )
|
||||
[ [ + ] curry change-year adjust-leap-year ] unless-zero ;
|
||||
|
||||
|
|
@ -196,7 +193,7 @@ M: real +year ( timestamp n -- timestamp )
|
|||
[ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ;
|
||||
|
||||
: months/years ( n -- months years )
|
||||
12 /rem dup zero? [ drop 1- 12 ] when swap ; inline
|
||||
12 /rem [ 1 - 12 ] when-zero swap ; inline
|
||||
|
||||
M: integer +month ( timestamp n -- timestamp )
|
||||
[ over month>> + months/years [ >>month ] dip +year ] unless-zero ;
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@ M: timestamp year. ( timestamp -- )
|
|||
|
||||
: read-rfc3339-seconds ( s -- s' ch )
|
||||
"+-Z" read-until [
|
||||
[ string>number ] [ length 10 swap ^ ] bi / +
|
||||
[ string>number ] [ length 10^ ] bi / +
|
||||
] dip ;
|
||||
|
||||
: (rfc3339>timestamp) ( -- timestamp )
|
||||
|
|
|
|||
|
|
@ -1,9 +1,7 @@
|
|||
! Copyright (C) 2009 Alaric Snell-Pym
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: checksums classes.singleton kernel math math.ranges
|
||||
math.vectors sequences ;
|
||||
|
||||
IN: checksums.fnv1
|
||||
|
||||
SINGLETON: fnv1-32
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: byte-arrays checksums checksums.md5 io.encodings.binary
|
||||
io.streams.byte-array kernel math namespaces tools.test ;
|
||||
|
||||
IN: checksums.md5.tests
|
||||
|
||||
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
! See http;//factorcode.org/license.txt for BSD license
|
||||
USING: arrays kernel tools.test sequences sequences.private
|
||||
circular strings ;
|
||||
IN: circular.tests
|
||||
|
||||
[ 0 ] [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test
|
||||
[ 2 ] [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005, 2006 Kevin Reid.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: cocoa.callbacks
|
||||
USING: assocs kernel namespaces cocoa cocoa.classes
|
||||
cocoa.subclassing debugger ;
|
||||
IN: cocoa.callbacks
|
||||
|
||||
SYMBOL: callbacks
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
IN: cocoa.tests
|
||||
USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
|
||||
compiler kernel namespaces cocoa.classes tools.test memory
|
||||
compiler.units math core-graphics.types ;
|
||||
IN: cocoa.tests
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
IN: cocoa.plists.tests
|
||||
USING: tools.test cocoa.plists colors kernel hashtables
|
||||
core-foundation.utilities core-foundation destructors
|
||||
assocs cocoa.enumeration ;
|
||||
IN: cocoa.plists.tests
|
||||
|
||||
[
|
||||
[ V{ } ] [ H{ } >cf &CFRelease [ ] NSFastEnumeration-map ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: colors.hsv.tests
|
||||
USING: accessors kernel colors colors.hsv tools.test math ;
|
||||
IN: colors.hsv.tests
|
||||
|
||||
: hsv>rgb ( h s v -- r g b )
|
||||
[ 360 * ] 2dip
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: columns.tests
|
||||
USING: columns sequences kernel namespaces arrays tools.test math ;
|
||||
IN: columns.tests
|
||||
|
||||
! Columns
|
||||
{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } [ clone ] map "seq" set
|
||||
|
|
|
|||
|
|
@ -13,27 +13,27 @@ HELP: 0||
|
|||
{ $description "If every quotation in the sequence outputs " { $link f } ", outputs " { $link f } ", otherwise outputs the result of the first quotation that did not yield " { $link f } "." } ;
|
||||
|
||||
HELP: 1&&
|
||||
{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
|
||||
{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
|
||||
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
|
||||
|
||||
HELP: 1||
|
||||
{ $values { "obj" object } { "quots" "a sequence of quotations" } { "?" "the first true result, or " { $link f } } }
|
||||
{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj -- )" } } { "?" "the first true result, or " { $link f } } }
|
||||
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same element from the datastack and must return a boolean." } ;
|
||||
|
||||
HELP: 2&&
|
||||
{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
|
||||
{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
|
||||
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
|
||||
|
||||
HELP: 2||
|
||||
{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations" } { "?" "the first true result, or " { $link f } } }
|
||||
{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 -- )" } } { "?" "the first true result, or " { $link f } } }
|
||||
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same two elements from the datastack and must return a boolean." } ;
|
||||
|
||||
HELP: 3&&
|
||||
{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
|
||||
{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 obj3 -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
|
||||
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
|
||||
|
||||
HELP: 3||
|
||||
{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations" } { "?" "the first true result, or " { $link f } } }
|
||||
{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 obj3 -- )" } } { "?" "the first true result, or " { $link f } } }
|
||||
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
|
||||
|
||||
HELP: n&&
|
||||
|
|
|
|||
|
|
@ -1,32 +1,18 @@
|
|||
|
||||
USING: kernel math tools.test combinators.short-circuit.smart ;
|
||||
|
||||
IN: combinators.short-circuit.smart.tests
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
[ t ] [ { [ 1 ] [ 2 ] [ 3 ] } && 3 = ] unit-test
|
||||
[ t ] [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } && 5 = ] unit-test
|
||||
[ t ] [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } && 30 = ] unit-test
|
||||
|
||||
: must-be-t ( in -- ) [ t ] swap unit-test ;
|
||||
: must-be-f ( in -- ) [ f ] swap unit-test ;
|
||||
[ f ] [ { [ 1 ] [ f ] [ 3 ] } && 3 = ] unit-test
|
||||
[ f ] [ 3 { [ 0 > ] [ even? ] [ 2 + ] } && ] unit-test
|
||||
[ f ] [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } && 30 = ] unit-test
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
[ t ] [ { [ 10 0 < ] [ f ] [ "factor" ] } || "factor" = ] unit-test
|
||||
|
||||
[ { [ 1 ] [ 2 ] [ 3 ] } && 3 = ] must-be-t
|
||||
[ 3 { [ 0 > ] [ odd? ] [ 2 + ] } && 5 = ] must-be-t
|
||||
[ 10 20 { [ + 0 > ] [ - even? ] [ + ] } && 30 = ] must-be-t
|
||||
[ t ] [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } || 11 = ] unit-test
|
||||
|
||||
[ { [ 1 ] [ f ] [ 3 ] } && 3 = ] must-be-f
|
||||
[ 3 { [ 0 > ] [ even? ] [ 2 + ] } && ] must-be-f
|
||||
[ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } && 30 = ] must-be-f
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
[ { [ 10 0 < ] [ f ] [ "factor" ] } || "factor" = ] must-be-t
|
||||
|
||||
[ 10 { [ odd? ] [ 100 > ] [ 1 + ] } || 11 = ] must-be-t
|
||||
|
||||
[ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } || 30 = ] must-be-t
|
||||
|
||||
[ { [ 10 0 < ] [ f ] [ 0 1 = ] } || ] must-be-f
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
[ t ] [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } || 30 = ] unit-test
|
||||
|
||||
[ f ] [ { [ 10 0 < ] [ f ] [ 0 1 = ] } || ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,12 +1,14 @@
|
|||
USING: kernel sequences math stack-checker effects accessors macros
|
||||
fry combinators.short-circuit ;
|
||||
USING: kernel sequences math stack-checker effects accessors
|
||||
macros fry combinators.short-circuit ;
|
||||
IN: combinators.short-circuit.smart
|
||||
|
||||
<PRIVATE
|
||||
|
||||
ERROR: cannot-determine-arity ;
|
||||
|
||||
: arity ( quots -- n )
|
||||
first infer
|
||||
dup terminated?>> [ "Cannot determine arity" throw ] when
|
||||
dup terminated?>> [ cannot-determine-arity ] when
|
||||
effect-height neg 1 + ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
IN: compiler.cfg.alias-analysis.tests
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
! 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 compiler.cfg
|
||||
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 ;
|
||||
IN: compiler.cfg.alias-analysis
|
||||
|
|
@ -226,7 +226,7 @@ M: ##read analyze-aliases*
|
|||
call-next-method
|
||||
dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
|
||||
2dup live-slot dup [
|
||||
2nip \ ##copy new-insn analyze-aliases* nip
|
||||
2nip any-rep \ ##copy new-insn analyze-aliases* nip
|
||||
] [
|
||||
drop remember-slot
|
||||
] if ;
|
||||
|
|
|
|||
|
|
@ -2,12 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators.short-circuit kernel sequences math
|
||||
compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
|
||||
compiler.cfg.utilities ;
|
||||
compiler.cfg.predecessors compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.block-joining
|
||||
|
||||
! Joining blocks that are not calls and are connected by a single CFG edge.
|
||||
! Predecessors must be recomputed after this. Also this pass does not
|
||||
! update ##phi nodes and should therefore only run before stack analysis.
|
||||
! This pass does not update ##phi nodes and should therefore only run
|
||||
! before stack analysis.
|
||||
: join-block? ( bb -- ? )
|
||||
{
|
||||
[ kill-block? not ]
|
||||
|
|
@ -27,8 +27,11 @@ IN: compiler.cfg.block-joining
|
|||
[ join-instructions ] [ update-successors ] 2bi ;
|
||||
|
||||
: join-blocks ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
|
||||
dup post-order [
|
||||
dup join-block?
|
||||
[ dup predecessor join-block ] [ drop ] if
|
||||
] each
|
||||
cfg-changed ;
|
||||
|
||||
cfg-changed predecessors-changed ;
|
||||
|
|
|
|||
|
|
@ -9,11 +9,11 @@ IN: compiler.cfg.branch-splitting.tests
|
|||
|
||||
: check-predecessors ( cfg -- )
|
||||
[ get-predecessors ]
|
||||
[ compute-predecessors drop ]
|
||||
[ needs-predecessors drop ]
|
||||
[ get-predecessors ] tri assert= ;
|
||||
|
||||
: check-branch-splitting ( cfg -- )
|
||||
compute-predecessors
|
||||
needs-predecessors
|
||||
split-branches
|
||||
check-predecessors ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators.short-circuit kernel math math.order
|
||||
sequences assocs namespaces vectors fry arrays splitting
|
||||
compiler.cfg.def-use compiler.cfg compiler.cfg.rpo
|
||||
compiler.cfg.def-use compiler.cfg compiler.cfg.rpo compiler.cfg.predecessors
|
||||
compiler.cfg.renaming compiler.cfg.instructions compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.branch-splitting
|
||||
|
||||
|
|
@ -81,7 +81,10 @@ UNION: irrelevant ##peek ##replace ##inc-d ##inc-r ;
|
|||
] if ;
|
||||
|
||||
: split-branches ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
|
||||
dup [
|
||||
dup split-branch? [ split-branch ] [ drop ] if
|
||||
] each-basic-block
|
||||
|
||||
cfg-changed ;
|
||||
|
|
|
|||
|
|
@ -1,15 +1,13 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces accessors math.order assocs kernel sequences
|
||||
combinators make classes words cpu.architecture
|
||||
combinators make classes words cpu.architecture layouts
|
||||
compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.stack-frame ;
|
||||
IN: compiler.cfg.build-stack-frame
|
||||
|
||||
SYMBOL: frame-required?
|
||||
|
||||
SYMBOL: spill-counts
|
||||
|
||||
GENERIC: compute-stack-frame* ( insn -- )
|
||||
|
||||
: request-stack-frame ( stack-frame -- )
|
||||
|
|
@ -30,11 +28,11 @@ M: ##call compute-stack-frame*
|
|||
|
||||
M: _gc compute-stack-frame*
|
||||
frame-required? on
|
||||
stack-frame new swap gc-root-size>> >>gc-root-size
|
||||
stack-frame new swap tagged-values>> length cells >>gc-root-size
|
||||
request-stack-frame ;
|
||||
|
||||
M: _spill-counts compute-stack-frame*
|
||||
counts>> stack-frame get (>>spill-counts) ;
|
||||
M: _spill-area-size compute-stack-frame*
|
||||
n>> stack-frame get (>>spill-area-size) ;
|
||||
|
||||
M: insn compute-stack-frame*
|
||||
class frame-required? word-prop [
|
||||
|
|
@ -45,7 +43,7 @@ M: insn compute-stack-frame*
|
|||
|
||||
: compute-stack-frame ( insns -- )
|
||||
frame-required? off
|
||||
T{ stack-frame } clone stack-frame set
|
||||
stack-frame new stack-frame set
|
||||
[ compute-stack-frame* ] each
|
||||
stack-frame get dup stack-frame-size >>total-size drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
IN: compiler.cfg.builder.tests
|
||||
USING: tools.test kernel sequences words sequences.private fry
|
||||
prettyprint alien alien.accessors math.private compiler.tree.builder
|
||||
compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
|
||||
compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
|
||||
arrays locals byte-arrays kernel.private math slots.private vectors sbufs
|
||||
strings math.partial-dispatch strings.private ;
|
||||
compiler.cfg arrays locals byte-arrays kernel.private math
|
||||
slots.private vectors sbufs strings math.partial-dispatch
|
||||
strings.private ;
|
||||
IN: compiler.cfg.builder.tests
|
||||
|
||||
! Just ensure that various CFGs build correctly.
|
||||
: unit-test-cfg ( quot -- )
|
||||
'[ _ test-cfg [ optimize-cfg check-cfg ] each ] [ ] swap unit-test ;
|
||||
'[ _ test-cfg [ [ optimize-cfg check-cfg ] with-cfg ] each ] [ ] swap unit-test ;
|
||||
|
||||
: blahblah ( nodes -- ? )
|
||||
{ fixnum } declare [
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@ compiler.cfg.instructions
|
|||
compiler.cfg.predecessors
|
||||
compiler.cfg.builder.blocks
|
||||
compiler.cfg.stacks
|
||||
compiler.cfg.stacks.local
|
||||
compiler.alien ;
|
||||
IN: compiler.cfg.builder
|
||||
|
||||
|
|
@ -144,7 +145,7 @@ M: #dispatch emit-node
|
|||
! Inputs to the final instruction need to be copied because of
|
||||
! loc>vreg sync. ^^offset>slot always returns a fresh vreg,
|
||||
! though.
|
||||
ds-pop ^^offset>slot i ##dispatch emit-if ;
|
||||
ds-pop ^^offset>slot next-vreg ##dispatch emit-if ;
|
||||
|
||||
! #call
|
||||
M: #call emit-node
|
||||
|
|
@ -159,14 +160,32 @@ M: #push emit-node
|
|||
literal>> ^^load-literal ds-push ;
|
||||
|
||||
! #shuffle
|
||||
|
||||
! Even though low level IR has its own dead code elimination pass,
|
||||
! we try not to introduce useless ##peeks here, since this reduces
|
||||
! the accuracy of global stack analysis.
|
||||
|
||||
: make-input-map ( #shuffle -- assoc )
|
||||
! Assoc maps high-level IR values to stack locations.
|
||||
[
|
||||
[ in-d>> <reversed> [ <ds-loc> swap set ] each-index ]
|
||||
[ in-r>> <reversed> [ <rs-loc> swap set ] each-index ] bi
|
||||
] H{ } make-assoc ;
|
||||
|
||||
: make-output-seq ( values mapping input-map -- vregs )
|
||||
'[ _ at _ at peek-loc ] map ;
|
||||
|
||||
: load-shuffle ( #shuffle mapping input-map -- ds-vregs rs-vregs )
|
||||
[ [ out-d>> ] 2dip make-output-seq ]
|
||||
[ [ out-r>> ] 2dip make-output-seq ] 3bi ;
|
||||
|
||||
: store-shuffle ( #shuffle ds-vregs rs-vregs -- )
|
||||
[ [ in-d>> length neg inc-d ] dip ds-store ]
|
||||
[ [ in-r>> length neg inc-r ] dip rs-store ]
|
||||
bi-curry* bi ;
|
||||
|
||||
M: #shuffle emit-node
|
||||
dup
|
||||
H{ } clone
|
||||
[ [ in-d>> [ length ds-load ] keep ] dip '[ _ set-at ] 2each ]
|
||||
[ [ in-r>> [ length rs-load ] keep ] dip '[ _ set-at ] 2each ]
|
||||
[ nip ] 2tri
|
||||
[ [ [ out-d>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map ds-store ]
|
||||
[ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi ;
|
||||
dup dup [ mapping>> ] [ make-input-map ] bi load-shuffle store-shuffle ;
|
||||
|
||||
! #return
|
||||
: emit-return ( -- )
|
||||
|
|
@ -227,3 +246,5 @@ M: #copy emit-node drop ;
|
|||
M: #enter-recursive emit-node drop ;
|
||||
|
||||
M: #phi emit-node drop ;
|
||||
|
||||
M: #declare emit-node drop ;
|
||||
|
|
@ -19,11 +19,28 @@ M: basic-block hashcode* nip id>> ;
|
|||
V{ } clone >>predecessors
|
||||
\ basic-block counter >>id ;
|
||||
|
||||
TUPLE: cfg { entry basic-block } word label spill-counts post-order ;
|
||||
TUPLE: cfg { entry basic-block } word label
|
||||
spill-area-size reps
|
||||
post-order linear-order
|
||||
predecessors-valid? dominance-valid? loops-valid? ;
|
||||
|
||||
: <cfg> ( entry word label -- cfg ) f f cfg boa ;
|
||||
: <cfg> ( entry word label -- cfg )
|
||||
cfg new
|
||||
swap >>label
|
||||
swap >>word
|
||||
swap >>entry ;
|
||||
|
||||
: cfg-changed ( cfg -- cfg ) f >>post-order ; inline
|
||||
: cfg-changed ( cfg -- cfg )
|
||||
f >>post-order
|
||||
f >>linear-order
|
||||
f >>dominance-valid?
|
||||
f >>loops-valid? ; inline
|
||||
|
||||
: predecessors-changed ( cfg -- cfg )
|
||||
f >>predecessors-valid? ;
|
||||
|
||||
: with-cfg ( cfg quot: ( cfg -- ) -- )
|
||||
[ dup cfg ] dip with-variable ; inline
|
||||
|
||||
TUPLE: mr { instructions array } word label ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces assocs accessors sequences grouping
|
||||
combinators compiler.cfg.rpo compiler.cfg.renaming
|
||||
compiler.cfg.instructions ;
|
||||
compiler.cfg.instructions compiler.cfg.predecessors ;
|
||||
IN: compiler.cfg.copy-prop
|
||||
|
||||
! The first three definitions are also used in compiler.cfg.alias-analysis.
|
||||
|
|
@ -70,6 +70,8 @@ M: insn update-insn rename-insn-uses t ;
|
|||
PRIVATE>
|
||||
|
||||
: copy-propagation ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
|
||||
[ collect-copies ]
|
||||
[ rename-copies ]
|
||||
[ ]
|
||||
|
|
|
|||
|
|
@ -1,37 +0,0 @@
|
|||
USING: accessors assocs compiler.cfg
|
||||
compiler.cfg.critical-edges compiler.cfg.debugger
|
||||
compiler.cfg.instructions compiler.cfg.predecessors
|
||||
compiler.cfg.registers cpu.architecture kernel namespaces
|
||||
sequences tools.test compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.critical-edges.tests
|
||||
|
||||
! Make sure we update phi nodes when splitting critical edges
|
||||
|
||||
: test-critical-edges ( -- )
|
||||
cfg new 0 get >>entry
|
||||
compute-predecessors
|
||||
split-critical-edges ;
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##phi f V int-regs 2 H{ { 0 V int-regs 0 } { 1 V int-regs 1 } } }
|
||||
T{ ##return }
|
||||
} 2 test-bb
|
||||
|
||||
0 { 1 2 } edges
|
||||
1 2 edge
|
||||
|
||||
[ ] [ test-critical-edges ] unit-test
|
||||
|
||||
[ t ] [ 0 get successors>> second successors>> first 2 get eq? ] unit-test
|
||||
|
||||
[ V int-regs 0 ] [ 2 get instructions>> first inputs>> 0 get successors>> second swap at ] unit-test
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math accessors sequences locals assocs fry
|
||||
compiler.cfg compiler.cfg.rpo compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.critical-edges
|
||||
|
||||
: critical-edge? ( from to -- ? )
|
||||
[ successors>> length 1 > ] [ predecessors>> length 1 > ] bi* and ;
|
||||
|
||||
: new-key ( new-key old-key assoc -- )
|
||||
[ delete-at* ] keep '[ swap _ set-at ] [ 2drop ] if ;
|
||||
|
||||
:: update-phis ( from to bb -- )
|
||||
! Any phi nodes in 'to' which reference 'from'
|
||||
! should now reference 'bb'.
|
||||
to [ [ bb from ] dip inputs>> new-key ] each-phi ;
|
||||
|
||||
: split-critical-edge ( from to -- )
|
||||
f <simple-block> [ insert-basic-block ] [ update-phis ] 3bi ;
|
||||
|
||||
: split-critical-edges ( cfg -- )
|
||||
dup [
|
||||
dup successors>> [
|
||||
2dup critical-edge?
|
||||
[ split-critical-edge ] [ 2drop ] if
|
||||
] with each
|
||||
] each-basic-block
|
||||
cfg-changed
|
||||
drop ;
|
||||
|
|
@ -2,10 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs deques dlists kernel locals sequences lexer
|
||||
namespaces functors compiler.cfg.rpo compiler.cfg.utilities
|
||||
compiler.cfg ;
|
||||
compiler.cfg.predecessors compiler.cfg ;
|
||||
IN: compiler.cfg.dataflow-analysis
|
||||
|
||||
GENERIC: join-sets ( sets dfa -- set )
|
||||
GENERIC: join-sets ( sets bb dfa -- set )
|
||||
GENERIC: transfer-set ( in-set bb dfa -- out-set )
|
||||
GENERIC: block-order ( cfg dfa -- bbs )
|
||||
GENERIC: successors ( bb dfa -- seq )
|
||||
|
|
@ -23,7 +23,7 @@ GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
|
|||
M: kill-block compute-in-set 3drop f ;
|
||||
|
||||
M:: basic-block compute-in-set ( bb out-sets dfa -- set )
|
||||
bb dfa predecessors [ out-sets at ] map dfa join-sets ;
|
||||
bb dfa predecessors [ out-sets at ] map bb dfa join-sets ;
|
||||
|
||||
:: update-in-set ( bb in-sets out-sets dfa -- ? )
|
||||
bb out-sets dfa compute-in-set
|
||||
|
|
@ -48,6 +48,7 @@ M:: basic-block compute-out-set ( bb in-sets dfa -- set )
|
|||
] when ; inline
|
||||
|
||||
:: run-dataflow-analysis ( cfg dfa -- in-sets out-sets )
|
||||
cfg needs-predecessors drop
|
||||
H{ } clone :> in-sets
|
||||
H{ } clone :> out-sets
|
||||
cfg dfa <dfa-worklist> :> work-list
|
||||
|
|
@ -55,7 +56,7 @@ M:: basic-block compute-out-set ( bb in-sets dfa -- set )
|
|||
in-sets
|
||||
out-sets ; inline
|
||||
|
||||
M: dataflow-analysis join-sets drop assoc-refine ;
|
||||
M: dataflow-analysis join-sets 2drop assoc-refine ;
|
||||
|
||||
FUNCTOR: define-analysis ( name -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -11,62 +11,62 @@ IN: compiler.cfg.dce.tests
|
|||
entry>> instructions>> ;
|
||||
|
||||
[ V{
|
||||
T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
|
||||
T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
|
||||
T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
|
||||
T{ ##replace { src V int-regs 3 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst 1 } { val 8 } }
|
||||
T{ ##load-immediate { dst 2 } { val 16 } }
|
||||
T{ ##add { dst 3 } { src1 1 } { src2 2 } }
|
||||
T{ ##replace { src 3 } { loc D 0 } }
|
||||
} ] [ V{
|
||||
T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
|
||||
T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
|
||||
T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
|
||||
T{ ##replace { src V int-regs 3 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst 1 } { val 8 } }
|
||||
T{ ##load-immediate { dst 2 } { val 16 } }
|
||||
T{ ##add { dst 3 } { src1 1 } { src2 2 } }
|
||||
T{ ##replace { src 3 } { loc D 0 } }
|
||||
} test-dce ] unit-test
|
||||
|
||||
[ V{ } ] [ V{
|
||||
T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
|
||||
T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
|
||||
T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
|
||||
T{ ##load-immediate { dst 1 } { val 8 } }
|
||||
T{ ##load-immediate { dst 2 } { val 16 } }
|
||||
T{ ##add { dst 3 } { src1 1 } { src2 2 } }
|
||||
} test-dce ] unit-test
|
||||
|
||||
[ V{ } ] [ V{
|
||||
T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##load-immediate { dst 3 } { val 8 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
} test-dce ] unit-test
|
||||
|
||||
[ V{ } ] [ V{
|
||||
T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
|
||||
T{ ##load-immediate { dst 3 } { val 8 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##set-slot-imm { obj 1 } { src 3 } }
|
||||
} test-dce ] unit-test
|
||||
|
||||
[ V{
|
||||
T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst 3 } { val 8 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##set-slot-imm { obj 1 } { src 3 } }
|
||||
T{ ##replace { src 1 } { loc D 0 } }
|
||||
} ] [ V{
|
||||
T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst 3 } { val 8 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##set-slot-imm { obj 1 } { src 3 } }
|
||||
T{ ##replace { src 1 } { loc D 0 } }
|
||||
} test-dce ] unit-test
|
||||
|
||||
[ V{
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 0 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##replace { src 1 } { loc D 0 } }
|
||||
} ] [ V{
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 0 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##replace { src 1 } { loc D 0 } }
|
||||
} test-dce ] unit-test
|
||||
|
||||
[ V{
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
|
||||
T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##replace { src 1 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst 3 } { val 8 } }
|
||||
T{ ##set-slot-imm { obj 1 } { src 3 } }
|
||||
} ] [ V{
|
||||
T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
|
||||
T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
|
||||
T{ ##allot { dst 1 } { temp 2 } }
|
||||
T{ ##replace { src 1 } { loc D 0 } }
|
||||
T{ ##load-immediate { dst 3 } { val 8 } }
|
||||
T{ ##set-slot-imm { obj 1 } { src 3 } }
|
||||
} test-dce ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs sets kernel namespaces sequences
|
||||
compiler.cfg.instructions compiler.cfg.def-use
|
||||
compiler.cfg.rpo ;
|
||||
compiler.cfg.rpo compiler.cfg.predecessors ;
|
||||
IN: compiler.cfg.dce
|
||||
|
||||
! Maps vregs to sequences of vregs
|
||||
|
|
@ -95,6 +95,8 @@ M: ##write-barrier live-insn? src>> live-vreg? ;
|
|||
M: insn live-insn? drop t ;
|
||||
|
||||
: eliminate-dead-code ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
|
||||
init-dead-code
|
||||
dup
|
||||
[ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ]
|
||||
|
|
|
|||
|
|
@ -4,11 +4,12 @@ USING: kernel words sequences quotations namespaces io vectors
|
|||
classes.tuple accessors prettyprint prettyprint.config assocs
|
||||
prettyprint.backend prettyprint.custom prettyprint.sections
|
||||
parser compiler.tree.builder compiler.tree.optimizer
|
||||
compiler.cfg.builder compiler.cfg.linearization
|
||||
cpu.architecture compiler.cfg.builder compiler.cfg.linearization
|
||||
compiler.cfg.registers compiler.cfg.stack-frame
|
||||
compiler.cfg.linear-scan compiler.cfg.two-operand
|
||||
compiler.cfg.optimizer compiler.cfg.instructions
|
||||
compiler.cfg.utilities compiler.cfg.mr compiler.cfg ;
|
||||
compiler.cfg.utilities compiler.cfg.def-use
|
||||
compiler.cfg.rpo compiler.cfg.mr compiler.cfg ;
|
||||
IN: compiler.cfg.debugger
|
||||
|
||||
GENERIC: test-cfg ( quot -- cfgs )
|
||||
|
|
@ -23,8 +24,10 @@ M: word test-cfg
|
|||
|
||||
: test-mr ( quot -- mrs )
|
||||
test-cfg [
|
||||
[
|
||||
optimize-cfg
|
||||
build-mr
|
||||
] with-cfg
|
||||
] map ;
|
||||
|
||||
: insn. ( insn -- )
|
||||
|
|
@ -41,11 +44,6 @@ M: word test-cfg
|
|||
] each ;
|
||||
|
||||
! Prettyprinting
|
||||
M: vreg pprint*
|
||||
<block
|
||||
\ V pprint-word [ reg-class>> pprint* ] [ n>> pprint* ] bi
|
||||
block> ;
|
||||
|
||||
: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
|
||||
|
||||
M: ds-loc pprint* \ D pprint-loc ;
|
||||
|
|
@ -72,3 +70,11 @@ M: rs-loc pprint* \ R pprint-loc ;
|
|||
1 { 2 3 } edges
|
||||
2 4 edge
|
||||
3 4 edge ;
|
||||
|
||||
: fake-representations ( cfg -- )
|
||||
post-order [
|
||||
instructions>>
|
||||
[ [ temp-vregs ] [ defs-vreg ] bi [ suffix ] when* ]
|
||||
map concat
|
||||
] map concat
|
||||
[ int-rep ] H{ } map>assoc representations set ;
|
||||
|
|
@ -8,30 +8,29 @@ compiler.cfg
|
|||
compiler.cfg.debugger
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.registers ;
|
||||
IN: compiler.cfg.def-use.tests
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##peek f V int-regs 2 D 0 }
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##peek f 1 D 0 }
|
||||
T{ ##peek f 2 D 0 }
|
||||
} 1 test-bb
|
||||
V{
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##replace f 2 D 0 }
|
||||
} 2 test-bb
|
||||
1 get 2 get 1vector >>successors drop
|
||||
1 2 edge
|
||||
V{
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##replace f 0 D 0 }
|
||||
} 3 test-bb
|
||||
2 get 3 get 1vector >>successors drop
|
||||
2 3 edge
|
||||
V{ } 4 test-bb
|
||||
V{ } 5 test-bb
|
||||
3 get 4 get 5 get V{ } 2sequence >>successors drop
|
||||
V int-regs 2
|
||||
2 get V int-regs 0 2array
|
||||
3 get V int-regs 1 2array
|
||||
2array \ ##phi new-insn 1vector
|
||||
6 test-bb
|
||||
4 get 6 get 1vector >>successors drop
|
||||
5 get 6 get 1vector >>successors drop
|
||||
3 { 4 5 } edges
|
||||
V{
|
||||
T{ ##phi f 2 H{ { 2 0 } { 3 1 } } }
|
||||
} 6 test-bb
|
||||
4 6 edge
|
||||
5 6 edge
|
||||
|
||||
cfg new 1 get >>entry 0 set
|
||||
[ ] [ 0 get compute-def-use ] unit-test
|
||||
[ ] [ 0 get [ compute-defs ] [ compute-uses ] bi ] unit-test
|
||||
|
|
|
|||
|
|
@ -92,6 +92,3 @@ SYMBOLS: defs insns uses ;
|
|||
] each
|
||||
] each-basic-block
|
||||
use [ keys ] assoc-map uses set ;
|
||||
|
||||
: compute-def-use ( cfg -- )
|
||||
[ compute-defs ] [ compute-uses ] [ compute-insns ] tri ;
|
||||
|
|
|
|||
|
|
@ -1,12 +1,11 @@
|
|||
IN: compiler.cfg.dominance.tests
|
||||
USING: tools.test sequences vectors namespaces kernel accessors assocs sets
|
||||
math.ranges arrays compiler.cfg compiler.cfg.dominance compiler.cfg.debugger
|
||||
compiler.cfg.predecessors ;
|
||||
IN: compiler.cfg.dominance.tests
|
||||
|
||||
: test-dominance ( -- )
|
||||
cfg new 0 get >>entry
|
||||
compute-predecessors
|
||||
compute-dominance ;
|
||||
needs-dominance drop ;
|
||||
|
||||
! Example with no back edges
|
||||
V{ } 0 test-bb
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs combinators sets math fry kernel math.order
|
||||
dlists deques vectors namespaces sequences sorting locals
|
||||
compiler.cfg.rpo ;
|
||||
compiler.cfg.rpo compiler.cfg.predecessors ;
|
||||
IN: compiler.cfg.dominance
|
||||
|
||||
! Reference:
|
||||
|
|
@ -83,10 +83,14 @@ PRIVATE>
|
|||
H{ } clone maxpreorder set
|
||||
[ 0 ] dip entry>> (compute-dfs) drop ;
|
||||
|
||||
: compute-dominance ( cfg -- cfg' )
|
||||
[ compute-dom-parents compute-dom-children ] [ compute-dfs ] [ ] tri ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: compute-dominance ( cfg -- )
|
||||
[ compute-dom-parents compute-dom-children ] [ compute-dfs ] bi ;
|
||||
: needs-dominance ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
dup dominance-valid?>> [ compute-dominance t >>dominance-valid? ] unless ;
|
||||
|
||||
: dominates? ( bb1 bb2 -- ? )
|
||||
swap [ pre-of ] [ [ pre-of ] [ maxpre-of ] bi ] bi* between? ;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,12 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors sequences combinators combinators.short-circuit
|
||||
classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
|
||||
USING: kernel accessors sequences namespaces combinators
|
||||
combinators.short-circuit classes vectors compiler.cfg
|
||||
compiler.cfg.instructions compiler.cfg.rpo ;
|
||||
IN: compiler.cfg.empty-blocks
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: update-predecessor ( bb -- )
|
||||
! We have to replace occurrences of bb with bb's successor
|
||||
! in bb's predecessor's list of successors.
|
||||
|
|
@ -22,8 +25,11 @@ IN: compiler.cfg.empty-blocks
|
|||
] with map
|
||||
] change-predecessors drop ;
|
||||
|
||||
SYMBOL: changed?
|
||||
|
||||
: delete-basic-block ( bb -- )
|
||||
[ update-predecessor ] [ update-successor ] bi ;
|
||||
[ update-predecessor ] [ update-successor ] bi
|
||||
changed? on ;
|
||||
|
||||
: delete-basic-block? ( bb -- ? )
|
||||
{
|
||||
|
|
@ -33,6 +39,9 @@ IN: compiler.cfg.empty-blocks
|
|||
[ instructions>> first ##branch? ]
|
||||
} 1&& ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: delete-empty-blocks ( cfg -- cfg' )
|
||||
changed? off
|
||||
dup [ dup delete-basic-block? [ delete-basic-block ] [ drop ] if ] each-basic-block
|
||||
cfg-changed ;
|
||||
changed? get [ cfg-changed ] when ;
|
||||
|
|
@ -1,22 +1,22 @@
|
|||
IN: compiler.cfg.gc-checks.tests
|
||||
USING: compiler.cfg.gc-checks compiler.cfg.debugger
|
||||
compiler.cfg.registers compiler.cfg.instructions compiler.cfg
|
||||
compiler.cfg.predecessors cpu.architecture tools.test kernel vectors
|
||||
namespaces accessors sequences ;
|
||||
IN: compiler.cfg.gc-checks.tests
|
||||
|
||||
: test-gc-checks ( -- )
|
||||
H{ } clone representations set
|
||||
cfg new 0 get >>entry
|
||||
compute-predecessors
|
||||
insert-gc-checks
|
||||
drop ;
|
||||
|
||||
V{
|
||||
T{ ##inc-d f 3 }
|
||||
T{ ##replace f V int-regs 0 D 1 }
|
||||
T{ ##replace f 0 D 1 }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##box-float f V int-regs 0 V int-regs 1 }
|
||||
T{ ##box-float f 0 1 }
|
||||
} 1 test-bb
|
||||
|
||||
0 1 edge
|
||||
|
|
|
|||
|
|
@ -1,13 +1,16 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences assocs fry
|
||||
cpu.architecture
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.hats
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.stacks.uninitialized ;
|
||||
IN: compiler.cfg.gc-checks
|
||||
|
||||
! Garbage collection check insertion. This pass runs after representation
|
||||
! selection, so it must keep track of representations.
|
||||
|
||||
: insert-gc-check? ( bb -- ? )
|
||||
instructions>> [ ##allocation? ] any? ;
|
||||
|
||||
|
|
@ -16,7 +19,9 @@ IN: compiler.cfg.gc-checks
|
|||
|
||||
: insert-gc-check ( bb -- )
|
||||
dup '[
|
||||
i i f _ uninitialized-locs \ ##gc new-insn
|
||||
int-rep next-vreg-rep
|
||||
int-rep next-vreg-rep
|
||||
f f _ uninitialized-locs \ ##gc new-insn
|
||||
prefix
|
||||
] change-instructions drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,83 +1,74 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays byte-arrays kernel layouts math namespaces
|
||||
USING: accessors arrays byte-arrays kernel layouts math namespaces
|
||||
sequences classes.tuple cpu.architecture compiler.cfg.registers
|
||||
compiler.cfg.instructions ;
|
||||
IN: compiler.cfg.hats
|
||||
|
||||
: i ( -- vreg ) int-regs next-vreg ; inline
|
||||
: ^^i ( -- vreg vreg ) i dup ; inline
|
||||
: ^^i1 ( obj -- vreg vreg obj ) [ ^^i ] dip ; inline
|
||||
: ^^i2 ( obj obj -- vreg vreg obj obj ) [ ^^i ] 2dip ; inline
|
||||
: ^^i3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^i ] 3dip ; inline
|
||||
: ^^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
|
||||
|
||||
: d ( -- vreg ) double-float-regs next-vreg ; inline
|
||||
: ^^d ( -- vreg vreg ) d dup ; inline
|
||||
: ^^d1 ( obj -- vreg vreg obj ) [ ^^d ] dip ; inline
|
||||
: ^^d2 ( obj obj -- vreg vreg obj obj ) [ ^^d ] 2dip ; inline
|
||||
: ^^d3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^d ] 3dip ; inline
|
||||
|
||||
: ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline
|
||||
: ^^copy ( src -- dst ) ^^i1 ##copy ; inline
|
||||
: ^^slot ( obj slot tag -- dst ) ^^i3 i ##slot ; inline
|
||||
: ^^slot-imm ( obj slot tag -- dst ) ^^i3 ##slot-imm ; inline
|
||||
: ^^set-slot ( src obj slot tag -- ) i ##set-slot ; inline
|
||||
: ^^string-nth ( obj index -- dst ) ^^i2 i ##string-nth ; inline
|
||||
: ^^add ( src1 src2 -- dst ) ^^i2 ##add ; inline
|
||||
: ^^add-imm ( src1 src2 -- dst ) ^^i2 ##add-imm ; inline
|
||||
: ^^sub ( src1 src2 -- dst ) ^^i2 ##sub ; inline
|
||||
: ^^sub-imm ( src1 src2 -- dst ) ^^i2 ##sub-imm ; 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 ) ^^i2 ##mul ; inline
|
||||
: ^^mul-imm ( src1 src2 -- dst ) ^^i2 ##mul-imm ; inline
|
||||
: ^^and ( input mask -- output ) ^^i2 ##and ; inline
|
||||
: ^^and-imm ( input mask -- output ) ^^i2 ##and-imm ; inline
|
||||
: ^^or ( src1 src2 -- dst ) ^^i2 ##or ; inline
|
||||
: ^^or-imm ( src1 src2 -- dst ) ^^i2 ##or-imm ; inline
|
||||
: ^^xor ( src1 src2 -- dst ) ^^i2 ##xor ; inline
|
||||
: ^^xor-imm ( src1 src2 -- dst ) ^^i2 ##xor-imm ; inline
|
||||
: ^^shl ( src1 src2 -- dst ) ^^i2 ##shl ; inline
|
||||
: ^^shl-imm ( src1 src2 -- dst ) ^^i2 ##shl-imm ; inline
|
||||
: ^^shr ( src1 src2 -- dst ) ^^i2 ##shr ; inline
|
||||
: ^^shr-imm ( src1 src2 -- dst ) ^^i2 ##shr-imm ; inline
|
||||
: ^^sar ( src1 src2 -- dst ) ^^i2 ##sar ; inline
|
||||
: ^^sar-imm ( src1 src2 -- dst ) ^^i2 ##sar-imm ; inline
|
||||
: ^^not ( src -- dst ) ^^i1 ##not ; inline
|
||||
: ^^log2 ( src -- dst ) ^^i1 ##log2 ; inline
|
||||
: ^^bignum>integer ( src -- dst ) ^^i1 i ##bignum>integer ; inline
|
||||
: ^^integer>bignum ( src -- dst ) ^^i1 i ##integer>bignum ; inline
|
||||
: ^^add-float ( src1 src2 -- dst ) ^^d2 ##add-float ; inline
|
||||
: ^^sub-float ( src1 src2 -- dst ) ^^d2 ##sub-float ; inline
|
||||
: ^^mul-float ( src1 src2 -- dst ) ^^d2 ##mul-float ; inline
|
||||
: ^^div-float ( src1 src2 -- dst ) ^^d2 ##div-float ; inline
|
||||
: ^^float>integer ( src -- dst ) ^^i1 ##float>integer ; inline
|
||||
: ^^integer>float ( src -- dst ) ^^d1 ##integer>float ; inline
|
||||
: ^^allot ( size class -- dst ) ^^i2 i ##allot ; 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
|
||||
: ^^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
|
||||
: ^^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-float ( src -- dst ) ^^i1 i ##box-float ; inline
|
||||
: ^^unbox-float ( src -- dst ) ^^d1 ##unbox-float ; inline
|
||||
: ^^box-alien ( src -- dst ) ^^i1 i ##box-alien ; inline
|
||||
: ^^unbox-alien ( src -- dst ) ^^i1 ##unbox-alien ; inline
|
||||
: ^^unbox-c-ptr ( src class -- dst ) ^^i2 i ##unbox-c-ptr ;
|
||||
: ^^alien-unsigned-1 ( src -- dst ) ^^i1 ##alien-unsigned-1 ; inline
|
||||
: ^^alien-unsigned-2 ( src -- dst ) ^^i1 ##alien-unsigned-2 ; inline
|
||||
: ^^alien-unsigned-4 ( src -- dst ) ^^i1 ##alien-unsigned-4 ; inline
|
||||
: ^^alien-signed-1 ( src -- dst ) ^^i1 ##alien-signed-1 ; inline
|
||||
: ^^alien-signed-2 ( src -- dst ) ^^i1 ##alien-signed-2 ; inline
|
||||
: ^^alien-signed-4 ( src -- dst ) ^^i1 ##alien-signed-4 ; inline
|
||||
: ^^alien-cell ( src -- dst ) ^^i1 ##alien-cell ; inline
|
||||
: ^^alien-float ( src -- dst ) ^^d1 ##alien-float ; inline
|
||||
: ^^alien-double ( src -- dst ) ^^d1 ##alien-double ; inline
|
||||
: ^^alien-global ( symbol library -- dst ) ^^i2 ##alien-global ; inline
|
||||
: ^^compare ( src1 src2 cc -- dst ) ^^i3 i ##compare ; inline
|
||||
: ^^compare-imm ( src1 src2 cc -- dst ) ^^i3 i ##compare-imm ; inline
|
||||
: ^^compare-float ( src1 src2 cc -- dst ) ^^i3 i ##compare-float ; inline
|
||||
: ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-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 ) ^^i1 ##tag-fixnum ; inline
|
||||
: ^^untag-fixnum ( src -- dst ) ^^i1 ##untag-fixnum ; inline
|
||||
: ^^fixnum-add ( src1 src2 -- dst ) ^^i2 ##fixnum-add ; inline
|
||||
: ^^fixnum-sub ( src1 src2 -- dst ) ^^i2 ##fixnum-sub ; inline
|
||||
: ^^fixnum-mul ( src1 src2 -- dst ) ^^i2 ##fixnum-mul ; inline
|
||||
: ^^phi ( inputs -- dst ) ^^i1 ##phi ; 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
|
||||
|
|
@ -112,8 +112,7 @@ INSN: ##float>integer < ##unary ;
|
|||
INSN: ##integer>float < ##unary ;
|
||||
|
||||
! Boxing and unboxing
|
||||
INSN: ##copy < ##unary ;
|
||||
INSN: ##copy-float < ##unary ;
|
||||
INSN: ##copy < ##unary rep ;
|
||||
INSN: ##unbox-float < ##unary ;
|
||||
INSN: ##unbox-any-c-ptr < ##unary/temp ;
|
||||
INSN: ##box-float < ##unary/temp ;
|
||||
|
|
@ -190,7 +189,7 @@ INSN: ##fixnum-add < ##fixnum-overflow ;
|
|||
INSN: ##fixnum-sub < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-mul < ##fixnum-overflow ;
|
||||
|
||||
INSN: ##gc temp1 temp2 live-values uninitialized-locs ;
|
||||
INSN: ##gc temp1 temp2 data-values tagged-values uninitialized-locs ;
|
||||
|
||||
! Instructions used by machine IR only.
|
||||
INSN: _prologue stack-frame ;
|
||||
|
|
@ -219,14 +218,13 @@ INSN: _fixnum-mul < _fixnum-overflow ;
|
|||
|
||||
TUPLE: spill-slot n ; C: <spill-slot> spill-slot
|
||||
|
||||
INSN: _gc temp1 temp2 gc-roots gc-root-count gc-root-size uninitialized-locs ;
|
||||
INSN: _gc temp1 temp2 data-values tagged-values uninitialized-locs ;
|
||||
|
||||
! These instructions operate on machine registers and not
|
||||
! virtual registers
|
||||
INSN: _spill src class n ;
|
||||
INSN: _reload dst class n ;
|
||||
INSN: _copy dst src class ;
|
||||
INSN: _spill-counts counts ;
|
||||
INSN: _spill src rep n ;
|
||||
INSN: _reload dst rep n ;
|
||||
INSN: _spill-area-size n ;
|
||||
|
||||
! Instructions that use vregs
|
||||
UNION: vreg-insn
|
||||
|
|
@ -252,6 +250,34 @@ UNION: kill-vreg-insn
|
|||
##alien-indirect
|
||||
##alien-callback ;
|
||||
|
||||
! Instructions that output floats
|
||||
UNION: output-float-insn
|
||||
##add-float
|
||||
##sub-float
|
||||
##mul-float
|
||||
##div-float
|
||||
##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
|
||||
##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 ;
|
||||
|
||||
! 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
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ IN: compiler.cfg.intrinsics.alien
|
|||
inline-alien ; inline
|
||||
|
||||
: inline-alien-float-setter ( node quot -- )
|
||||
'[ ds-pop ^^unbox-float @ ]
|
||||
'[ ds-pop @ ]
|
||||
[ float inline-alien-setter? ]
|
||||
inline-alien ; inline
|
||||
|
||||
|
|
@ -90,18 +90,18 @@ IN: compiler.cfg.intrinsics.alien
|
|||
: emit-alien-cell-setter ( node -- )
|
||||
[ ##set-alien-cell ] inline-alien-cell-setter ;
|
||||
|
||||
: emit-alien-float-getter ( node reg-class -- )
|
||||
: emit-alien-float-getter ( node rep -- )
|
||||
'[
|
||||
_ {
|
||||
{ single-float-regs [ ^^alien-float ] }
|
||||
{ double-float-regs [ ^^alien-double ] }
|
||||
} case ^^box-float
|
||||
{ single-float-rep [ ^^alien-float ] }
|
||||
{ double-float-rep [ ^^alien-double ] }
|
||||
} case
|
||||
] inline-alien-getter ;
|
||||
|
||||
: emit-alien-float-setter ( node reg-class -- )
|
||||
: emit-alien-float-setter ( node rep -- )
|
||||
'[
|
||||
_ {
|
||||
{ single-float-regs [ ##set-alien-float ] }
|
||||
{ double-float-regs [ ##set-alien-double ] }
|
||||
{ single-float-rep [ ##set-alien-float ] }
|
||||
{ double-float-rep [ ##set-alien-double ] }
|
||||
} case
|
||||
] inline-alien-float-setter ;
|
||||
|
|
|
|||
|
|
@ -1,19 +1,17 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel compiler.cfg.stacks compiler.cfg.hats
|
||||
compiler.cfg.instructions compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.intrinsics.float
|
||||
|
||||
: emit-float-op ( insn -- )
|
||||
[ 2inputs [ ^^unbox-float ] bi@ ] dip call ^^box-float
|
||||
ds-push ; inline
|
||||
[ 2inputs ] dip call ds-push ; inline
|
||||
|
||||
: emit-float-comparison ( cc -- )
|
||||
[ 2inputs [ ^^unbox-float ] bi@ ] dip ^^compare-float
|
||||
ds-push ; inline
|
||||
[ 2inputs ] dip ^^compare-float ds-push ; inline
|
||||
|
||||
: emit-float>fixnum ( -- )
|
||||
ds-pop ^^unbox-float ^^float>integer ^^tag-fixnum ds-push ;
|
||||
ds-pop ^^float>integer ^^tag-fixnum ds-push ;
|
||||
|
||||
: emit-fixnum>float ( -- )
|
||||
ds-pop ^^untag-fixnum ^^integer>float ^^box-float ds-push ;
|
||||
ds-pop ^^untag-fixnum ^^integer>float ds-push ;
|
||||
|
|
|
|||
|
|
@ -153,8 +153,8 @@ IN: compiler.cfg.intrinsics
|
|||
{ \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
|
||||
{ \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
|
||||
{ \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
|
||||
{ \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter ] }
|
||||
{ \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter ] }
|
||||
{ \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter ] }
|
||||
{ \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter ] }
|
||||
{ \ alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] }
|
||||
{ \ alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] }
|
||||
{ \ alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] }
|
||||
{ \ alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] }
|
||||
} case ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: layouts namespaces kernel accessors sequences
|
||||
classes.algebra compiler.tree.propagation.info
|
||||
compiler.cfg.stacks compiler.cfg.hats compiler.cfg.instructions
|
||||
USING: layouts namespaces kernel accessors sequences classes.algebra
|
||||
compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats
|
||||
compiler.cfg.registers compiler.cfg.instructions
|
||||
compiler.cfg.utilities compiler.cfg.builder.blocks ;
|
||||
IN: compiler.cfg.intrinsics.slots
|
||||
|
||||
|
|
@ -45,7 +45,7 @@ IN: compiler.cfg.intrinsics.slots
|
|||
dup third value-info-small-fixnum?
|
||||
[ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
|
||||
] [ first class>> immediate class<= ] bi
|
||||
[ drop ] [ i i ##write-barrier ] if
|
||||
[ drop ] [ next-vreg next-vreg ##write-barrier ] if
|
||||
] [ drop emit-primitive ] if ;
|
||||
|
||||
: emit-string-nth ( -- )
|
||||
|
|
@ -53,4 +53,4 @@ IN: compiler.cfg.intrinsics.slots
|
|||
|
||||
: emit-set-string-nth-fast ( -- )
|
||||
3inputs [ ^^untag-fixnum ] [ ^^untag-fixnum ] [ ] tri*
|
||||
swap i ##set-string-nth-fast ;
|
||||
swap next-vreg ##set-string-nth-fast ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
USING: accessors assocs heaps kernel namespaces sequences fry math
|
||||
math.order combinators arrays sorting compiler.utilities
|
||||
compiler.cfg.linear-scan.live-intervals
|
||||
compiler.cfg.linear-scan.allocation.coalescing
|
||||
compiler.cfg.linear-scan.allocation.spilling
|
||||
compiler.cfg.linear-scan.allocation.splitting
|
||||
compiler.cfg.linear-scan.allocation.state ;
|
||||
|
|
@ -29,13 +28,11 @@ IN: compiler.cfg.linear-scan.allocation
|
|||
second 0 = ; inline
|
||||
|
||||
: assign-register ( new -- )
|
||||
dup coalesce? [ coalesce ] [
|
||||
dup register-status {
|
||||
{ [ dup no-free-registers? ] [ drop assign-blocked-register ] }
|
||||
{ [ 2dup register-available? ] [ register-available ] }
|
||||
[ drop assign-blocked-register ]
|
||||
} cond
|
||||
] if ;
|
||||
} cond ;
|
||||
|
||||
: handle-interval ( live-interval -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -1,35 +0,0 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences namespaces assocs fry
|
||||
combinators.short-circuit
|
||||
compiler.cfg.linear-scan.live-intervals
|
||||
compiler.cfg.linear-scan.allocation.state ;
|
||||
IN: compiler.cfg.linear-scan.allocation.coalescing
|
||||
|
||||
: active-interval ( vreg -- live-interval )
|
||||
dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ;
|
||||
|
||||
: avoids-inactive-intervals? ( live-interval -- ? )
|
||||
dup vreg>> inactive-intervals-for
|
||||
[ intervals-intersect? not ] with all? ;
|
||||
|
||||
: coalesce? ( live-interval -- ? )
|
||||
{
|
||||
[ copy-from>> active-interval ]
|
||||
[ [ start>> ] [ copy-from>> active-interval end>> ] bi = ]
|
||||
[ avoids-inactive-intervals? ]
|
||||
} 1&& ;
|
||||
|
||||
: reuse-spill-slot ( old new -- )
|
||||
[ vreg>> spill-slots get at ] dip '[ _ vreg>> spill-slots get set-at ] when* ;
|
||||
|
||||
: reuse-register ( old new -- )
|
||||
reg>> >>reg drop ;
|
||||
|
||||
: (coalesce) ( old new -- )
|
||||
[ add-active ] [ [ delete-active ] [ add-handled ] bi ] bi* ;
|
||||
|
||||
: coalesce ( live-interval -- )
|
||||
dup copy-from>> active-interval
|
||||
[ reuse-spill-slot ] [ reuse-register ] [ (coalesce) ] 2tri ;
|
||||
|
||||
|
|
@ -45,7 +45,7 @@ ERROR: splitting-atomic-interval ;
|
|||
f >>spill-to ; inline
|
||||
|
||||
: split-after ( after -- after' )
|
||||
f >>copy-from f >>reg f >>reload-from ; inline
|
||||
f >>reg f >>reload-from ; inline
|
||||
|
||||
:: split-interval ( live-interval n -- before after )
|
||||
live-interval n check-split
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs combinators cpu.architecture fry heaps
|
||||
kernel math math.order namespaces sequences vectors
|
||||
compiler.cfg compiler.cfg.registers
|
||||
compiler.cfg.linear-scan.live-intervals ;
|
||||
IN: compiler.cfg.linear-scan.allocation.state
|
||||
|
||||
|
|
@ -26,7 +27,7 @@ SYMBOL: registers
|
|||
SYMBOL: active-intervals
|
||||
|
||||
: active-intervals-for ( vreg -- seq )
|
||||
reg-class>> active-intervals get at ;
|
||||
rep-of reg-class-of active-intervals get at ;
|
||||
|
||||
: add-active ( live-interval -- )
|
||||
dup vreg>> active-intervals-for push ;
|
||||
|
|
@ -41,7 +42,7 @@ SYMBOL: active-intervals
|
|||
SYMBOL: inactive-intervals
|
||||
|
||||
: inactive-intervals-for ( vreg -- seq )
|
||||
reg-class>> inactive-intervals get at ;
|
||||
rep-of reg-class-of inactive-intervals get at ;
|
||||
|
||||
: add-inactive ( live-interval -- )
|
||||
dup vreg>> inactive-intervals-for push ;
|
||||
|
|
@ -112,22 +113,18 @@ SYMBOL: unhandled-intervals
|
|||
[ dup start>> unhandled-intervals get heap-push ]
|
||||
bi ;
|
||||
|
||||
CONSTANT: reg-classes { int-regs double-float-regs }
|
||||
|
||||
: reg-class-assoc ( quot -- assoc )
|
||||
[ reg-classes ] dip { } map>assoc ; inline
|
||||
|
||||
! Mapping from register classes to spill counts
|
||||
SYMBOL: spill-counts
|
||||
|
||||
: next-spill-slot ( reg-class -- n )
|
||||
spill-counts get [ dup 1 + ] change-at ;
|
||||
: next-spill-slot ( rep -- n )
|
||||
rep-size cfg get
|
||||
[ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ;
|
||||
|
||||
! Mapping from vregs to spill slots
|
||||
SYMBOL: spill-slots
|
||||
|
||||
: assign-spill-slot ( vreg -- n )
|
||||
spill-slots get [ reg-class>> next-spill-slot ] cache ;
|
||||
spill-slots get [ rep-of next-spill-slot ] cache ;
|
||||
|
||||
: init-allocator ( registers -- )
|
||||
registers set
|
||||
|
|
@ -135,7 +132,7 @@ SYMBOL: spill-slots
|
|||
[ V{ } clone ] reg-class-assoc active-intervals set
|
||||
[ V{ } clone ] reg-class-assoc inactive-intervals set
|
||||
V{ } clone handled-intervals set
|
||||
[ 0 ] reg-class-assoc spill-counts set
|
||||
cfg get 0 >>spill-area-size drop
|
||||
H{ } clone spill-slots set
|
||||
-1 progress set ;
|
||||
|
||||
|
|
@ -145,7 +142,7 @@ SYMBOL: spill-slots
|
|||
|
||||
! A utility used by register-status and spill-status words
|
||||
: free-positions ( new -- assoc )
|
||||
vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
|
||||
vreg>> rep-of reg-class-of registers get at [ 1/0. ] H{ } map>assoc ;
|
||||
|
||||
: add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,15 +1,15 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math assocs namespaces sequences heaps
|
||||
fry make combinators sets locals
|
||||
fry make combinators sets locals arrays
|
||||
cpu.architecture
|
||||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.def-use
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.renaming.functor
|
||||
compiler.cfg.linearization.order
|
||||
compiler.cfg.linear-scan.allocation
|
||||
compiler.cfg.linear-scan.allocation.state
|
||||
compiler.cfg.linear-scan.live-intervals ;
|
||||
|
|
@ -52,7 +52,7 @@ SYMBOL: register-live-outs
|
|||
init-unhandled ;
|
||||
|
||||
: insert-spill ( live-interval -- )
|
||||
[ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
|
||||
[ reg>> ] [ vreg>> rep-of ] [ spill-to>> ] tri _spill ;
|
||||
|
||||
: handle-spill ( live-interval -- )
|
||||
dup spill-to>> [ insert-spill ] [ drop ] if ;
|
||||
|
|
@ -72,7 +72,7 @@ SYMBOL: register-live-outs
|
|||
pending-interval-heap get (expire-old-intervals) ;
|
||||
|
||||
: insert-reload ( live-interval -- )
|
||||
[ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
|
||||
[ reg>> ] [ vreg>> rep-of ] [ reload-from>> ] tri _reload ;
|
||||
|
||||
: handle-reload ( live-interval -- )
|
||||
dup reload-from>> [ insert-reload ] [ drop ] if ;
|
||||
|
|
@ -103,11 +103,36 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
|
|||
M: vreg-insn assign-registers-in-insn
|
||||
[ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;
|
||||
|
||||
! TODO: needs tagged-rep
|
||||
|
||||
: 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 ;
|
||||
|
||||
: spill-on-gc? ( vreg reg -- ? )
|
||||
[ rep-of int-rep? not ] [ spill-slot? not ] bi* and ;
|
||||
|
||||
: spill-on-gc ( assoc -- assoc' )
|
||||
! When a GC occurs, virtual registers which contain untagged data,
|
||||
! and are stored in physical registers, are saved to their spill
|
||||
! slots. Outputs sequence of triples:
|
||||
! - physical register
|
||||
! - spill slot
|
||||
! - representation
|
||||
[
|
||||
[
|
||||
2dup spill-on-gc?
|
||||
[ swap [ assign-spill-slot ] [ rep-of ] bi 3array , ] [ 2drop ] if
|
||||
] assoc-each
|
||||
] { } make ;
|
||||
|
||||
M: ##gc assign-registers-in-insn
|
||||
! This works because ##gc is always the first instruction
|
||||
! in a block.
|
||||
! Since ##gc is always the first instruction in a block, the set of
|
||||
! values live at the ##gc is just live-in.
|
||||
dup call-next-method
|
||||
basic-block get register-live-ins get at >>live-values
|
||||
basic-block get register-live-ins get at
|
||||
[ trace-on-gc >>tagged-values ] [ spill-on-gc >>data-values ] bi
|
||||
drop ;
|
||||
|
||||
M: insn assign-registers-in-insn drop ;
|
||||
|
|
@ -156,4 +181,4 @@ ERROR: bad-vreg vreg ;
|
|||
|
||||
: assign-registers ( live-intervals cfg -- )
|
||||
[ init-assignment ] dip
|
||||
[ assign-registers-in-block ] each-basic-block ;
|
||||
linearization-order [ assign-registers-in-block ] each ;
|
||||
|
|
|
|||
|
|
@ -18,9 +18,8 @@ IN: compiler.cfg.linear-scan.debugger
|
|||
|
||||
: interval-picture ( interval -- str )
|
||||
[ uses>> picture ]
|
||||
[ copy-from>> unparse ]
|
||||
[ vreg>> unparse ]
|
||||
tri 3array ;
|
||||
bi 2array ;
|
||||
|
||||
: live-intervals. ( seq -- )
|
||||
[ interval-picture ] map simple-table. ;
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -5,6 +5,7 @@ cpu.architecture
|
|||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.linear-scan.numbering
|
||||
compiler.cfg.linear-scan.live-intervals
|
||||
|
|
@ -37,8 +38,4 @@ IN: compiler.cfg.linear-scan
|
|||
cfg check-numbering ;
|
||||
|
||||
: linear-scan ( cfg -- cfg' )
|
||||
[
|
||||
dup machine-registers (linear-scan)
|
||||
spill-counts get >>spill-counts
|
||||
cfg-changed
|
||||
] with-scope ;
|
||||
dup machine-registers (linear-scan) ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces kernel assocs accessors sequences math math.order fry
|
||||
combinators binary-search compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.rpo
|
||||
compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.linearization.order
|
||||
compiler.cfg ;
|
||||
IN: compiler.cfg.linear-scan.live-intervals
|
||||
|
||||
|
|
@ -13,8 +13,7 @@ C: <live-range> live-range
|
|||
TUPLE: live-interval
|
||||
vreg
|
||||
reg spill-to reload-from
|
||||
start end ranges uses
|
||||
copy-from ;
|
||||
start end ranges uses ;
|
||||
|
||||
GENERIC: covers? ( insn# obj -- ? )
|
||||
|
||||
|
|
@ -102,15 +101,6 @@ M: vreg-insn compute-live-intervals*
|
|||
[ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
|
||||
3tri ;
|
||||
|
||||
: record-copy ( insn -- )
|
||||
[ dst>> live-intervals get at ] [ src>> ] bi >>copy-from drop ;
|
||||
|
||||
M: ##copy compute-live-intervals*
|
||||
[ call-next-method ] [ record-copy ] bi ;
|
||||
|
||||
M: ##copy-float compute-live-intervals*
|
||||
[ call-next-method ] [ record-copy ] bi ;
|
||||
|
||||
: handle-live-out ( bb -- )
|
||||
live-out keys
|
||||
basic-block get [ block-from ] [ block-to ] bi
|
||||
|
|
@ -147,7 +137,8 @@ ERROR: bad-live-interval live-interval ;
|
|||
: compute-live-intervals ( cfg -- live-intervals )
|
||||
H{ } clone [
|
||||
live-intervals set
|
||||
post-order [ compute-live-intervals-step ] each
|
||||
linearization-order <reversed>
|
||||
[ compute-live-intervals-step ] each
|
||||
] keep values dup finish-live-intervals ;
|
||||
|
||||
: relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
|
||||
|
|
|
|||
|
|
@ -1,15 +1,15 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors math sequences grouping namespaces
|
||||
compiler.cfg.rpo ;
|
||||
compiler.cfg.linearization.order ;
|
||||
IN: compiler.cfg.linear-scan.numbering
|
||||
|
||||
: number-instructions ( rpo -- )
|
||||
[ 0 ] dip [
|
||||
linearization-order 0 [
|
||||
instructions>> [
|
||||
[ (>>insn#) ] [ drop 2 + ] 2bi
|
||||
] each
|
||||
] each-basic-block drop ;
|
||||
] reduce drop ;
|
||||
|
||||
SYMBOL: check-numbering?
|
||||
|
||||
|
|
@ -20,4 +20,5 @@ ERROR: bad-numbering bb ;
|
|||
[ drop ] [ bad-numbering ] if ;
|
||||
|
||||
: check-numbering ( cfg -- )
|
||||
check-numbering? get [ [ check-block-numbering ] each-basic-block ] [ drop ] if ;
|
||||
check-numbering? get
|
||||
[ linearization-order [ check-block-numbering ] each ] [ drop ] if ;
|
||||
|
|
@ -1,65 +1,67 @@
|
|||
IN: compiler.cfg.linear-scan.resolve.tests
|
||||
USING: compiler.cfg.linear-scan.resolve tools.test kernel namespaces
|
||||
accessors
|
||||
compiler.cfg
|
||||
compiler.cfg.instructions cpu.architecture make sequences
|
||||
compiler.cfg.linear-scan.allocation.state ;
|
||||
IN: compiler.cfg.linear-scan.resolve.tests
|
||||
|
||||
[
|
||||
{
|
||||
{ { T{ spill-slot f 0 } int-regs } { 1 int-regs } }
|
||||
{ { T{ spill-slot f 0 } int-rep } { 1 int-rep } }
|
||||
}
|
||||
] [
|
||||
[
|
||||
0 <spill-slot> 1 int-regs add-mapping
|
||||
0 <spill-slot> 1 int-rep add-mapping
|
||||
] { } make
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ _reload { dst 1 } { class int-regs } { n 0 } }
|
||||
T{ _reload { dst 1 } { rep int-rep } { n 0 } }
|
||||
}
|
||||
] [
|
||||
[
|
||||
{ T{ spill-slot f 0 } int-regs } { 1 int-regs } >insn
|
||||
{ T{ spill-slot f 0 } int-rep } { 1 int-rep } >insn
|
||||
] { } make
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ _spill { src 1 } { class int-regs } { n 0 } }
|
||||
T{ _spill { src 1 } { rep int-rep } { n 0 } }
|
||||
}
|
||||
] [
|
||||
[
|
||||
{ 1 int-regs } { T{ spill-slot f 0 } int-regs } >insn
|
||||
{ 1 int-rep } { T{ spill-slot f 0 } int-rep } >insn
|
||||
] { } make
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ _copy { src 1 } { dst 2 } { class int-regs } }
|
||||
T{ ##copy { src 1 } { dst 2 } { rep int-rep } }
|
||||
}
|
||||
] [
|
||||
[
|
||||
{ 1 int-regs } { 2 int-regs } >insn
|
||||
{ 1 int-rep } { 2 int-rep } >insn
|
||||
] { } make
|
||||
] unit-test
|
||||
|
||||
H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set
|
||||
cfg new 8 >>spill-area-size cfg set
|
||||
H{ } clone spill-temps set
|
||||
|
||||
[
|
||||
t
|
||||
] [
|
||||
{ { { 0 int-regs } { 1 int-regs } } { { 1 int-regs } { 0 int-regs } } }
|
||||
{ { { 0 int-rep } { 1 int-rep } } { { 1 int-rep } { 0 int-rep } } }
|
||||
mapping-instructions {
|
||||
{
|
||||
T{ _spill { src 0 } { class int-regs } { n 10 } }
|
||||
T{ _copy { dst 0 } { src 1 } { class int-regs } }
|
||||
T{ _reload { dst 1 } { class int-regs } { n 10 } }
|
||||
T{ _spill { src 0 } { rep int-rep } { n 8 } }
|
||||
T{ ##copy { dst 0 } { src 1 } { rep int-rep } }
|
||||
T{ _reload { dst 1 } { rep int-rep } { n 8 } }
|
||||
}
|
||||
{
|
||||
T{ _spill { src 1 } { class int-regs } { n 10 } }
|
||||
T{ _copy { dst 1 } { src 0 } { class int-regs } }
|
||||
T{ _reload { dst 0 } { class int-regs } { n 10 } }
|
||||
T{ _spill { src 1 } { rep int-rep } { n 8 } }
|
||||
T{ ##copy { dst 1 } { src 0 } { rep int-rep } }
|
||||
T{ _reload { dst 0 } { rep int-rep } { n 8 } }
|
||||
}
|
||||
} member?
|
||||
] unit-test
|
||||
|
|
@ -3,10 +3,13 @@
|
|||
USING: accessors arrays assocs combinators
|
||||
combinators.short-circuit fry kernel locals namespaces
|
||||
make math sequences hashtables
|
||||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.utilities
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.predecessors
|
||||
compiler.cfg.parallel-copy
|
||||
compiler.cfg.linear-scan.assignment
|
||||
compiler.cfg.linear-scan.allocation.state ;
|
||||
|
|
@ -14,16 +17,16 @@ IN: compiler.cfg.linear-scan.resolve
|
|||
|
||||
SYMBOL: spill-temps
|
||||
|
||||
: spill-temp ( reg-class -- n )
|
||||
: spill-temp ( rep -- n )
|
||||
spill-temps get [ next-spill-slot ] cache ;
|
||||
|
||||
: add-mapping ( from to reg-class -- )
|
||||
: add-mapping ( from to rep -- )
|
||||
'[ _ 2array ] bi@ 2array , ;
|
||||
|
||||
:: resolve-value-data-flow ( bb to vreg -- )
|
||||
vreg bb vreg-at-end
|
||||
vreg to vreg-at-start
|
||||
2dup = [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
|
||||
2dup = [ 2drop ] [ vreg rep-of add-mapping ] if ;
|
||||
|
||||
: compute-mappings ( bb to -- mappings )
|
||||
dup live-in dup assoc-empty? [ 3drop f ] [
|
||||
|
|
@ -43,7 +46,7 @@ SYMBOL: spill-temps
|
|||
drop [ first2 ] [ second spill-temp ] bi _spill ;
|
||||
|
||||
: register->register ( from to -- )
|
||||
swap [ first ] [ first2 ] bi* _copy ;
|
||||
swap [ first ] [ first2 ] bi* ##copy ;
|
||||
|
||||
SYMBOL: temp
|
||||
|
||||
|
|
@ -62,8 +65,8 @@ SYMBOL: temp
|
|||
|
||||
: perform-mappings ( bb to mappings -- )
|
||||
dup empty? [ 3drop ] [
|
||||
mapping-instructions <simple-block>
|
||||
insert-basic-block
|
||||
mapping-instructions <simple-block> insert-basic-block
|
||||
cfg get cfg-changed drop
|
||||
] if ;
|
||||
|
||||
: resolve-edge-data-flow ( bb to -- )
|
||||
|
|
@ -73,5 +76,7 @@ SYMBOL: temp
|
|||
dup successors>> [ resolve-edge-data-flow ] with each ;
|
||||
|
||||
: resolve-data-flow ( cfg -- )
|
||||
needs-predecessors
|
||||
|
||||
H{ } clone spill-temps set
|
||||
[ resolve-block-data-flow ] each-basic-block ;
|
||||
|
|
|
|||
|
|
@ -1,4 +0,0 @@
|
|||
IN: compiler.cfg.linearization.tests
|
||||
USING: compiler.cfg.linearization tools.test ;
|
||||
|
||||
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math accessors sequences namespaces make
|
||||
combinators assocs arrays locals cpu.architecture
|
||||
combinators assocs arrays locals layouts hashtables
|
||||
cpu.architecture
|
||||
compiler.cfg
|
||||
compiler.cfg.comparisons
|
||||
compiler.cfg.stack-frame
|
||||
|
|
@ -10,6 +11,14 @@ compiler.cfg.utilities
|
|||
compiler.cfg.linearization.order ;
|
||||
IN: compiler.cfg.linearization
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: numbers
|
||||
|
||||
: block-number ( bb -- n ) numbers get at ;
|
||||
|
||||
: number-blocks ( bbs -- ) [ 2array ] map-index >hashtable numbers set ;
|
||||
|
||||
! Convert CFG IR to machine IR.
|
||||
GENERIC: linearize-insn ( basic-block insn -- )
|
||||
|
||||
|
|
@ -70,55 +79,32 @@ M: ##dispatch linearize-insn
|
|||
[ successors>> [ block-number _dispatch-label ] each ]
|
||||
bi* ;
|
||||
|
||||
: (compute-gc-roots) ( n live-values -- n )
|
||||
[
|
||||
[ nip 2array , ]
|
||||
[ drop reg-class>> reg-size + ]
|
||||
3bi
|
||||
] assoc-each ;
|
||||
|
||||
: oop-values ( regs -- regs' )
|
||||
[ drop reg-class>> int-regs eq? ] assoc-filter ;
|
||||
|
||||
: data-values ( regs -- regs' )
|
||||
[ drop reg-class>> double-float-regs eq? ] assoc-filter ;
|
||||
|
||||
: compute-gc-roots ( live-values -- alist )
|
||||
[
|
||||
[ 0 ] dip
|
||||
! we put float registers last; the GC doesn't actually scan them
|
||||
[ oop-values (compute-gc-roots) ]
|
||||
[ data-values (compute-gc-roots) ] bi
|
||||
drop
|
||||
] { } make ;
|
||||
|
||||
: count-gc-roots ( live-values -- n )
|
||||
! Size of GC root area, minus the float registers
|
||||
oop-values assoc-size ;
|
||||
: gc-root-offsets ( registers -- alist )
|
||||
! Outputs a sequence of { offset register/spill-slot } pairs
|
||||
[ length iota [ cell * ] map ] keep zip ;
|
||||
|
||||
M: ##gc linearize-insn
|
||||
nip
|
||||
{
|
||||
[ temp1>> ]
|
||||
[ temp2>> ]
|
||||
[
|
||||
live-values>>
|
||||
[ compute-gc-roots ]
|
||||
[ count-gc-roots ]
|
||||
[ gc-roots-size ]
|
||||
tri
|
||||
]
|
||||
[ data-values>> ]
|
||||
[ tagged-values>> gc-root-offsets ]
|
||||
[ uninitialized-locs>> ]
|
||||
} cleave
|
||||
_gc ;
|
||||
|
||||
: linearize-basic-blocks ( cfg -- insns )
|
||||
[
|
||||
[ linearization-order [ linearize-basic-block ] each ]
|
||||
[ spill-counts>> _spill-counts ]
|
||||
bi
|
||||
[
|
||||
linearization-order
|
||||
[ number-blocks ]
|
||||
[ [ linearize-basic-block ] each ] bi
|
||||
] [ spill-area-size>> _spill-area-size ] bi
|
||||
] { } make ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: flatten-cfg ( cfg -- mr )
|
||||
[ linearize-basic-blocks ] [ word>> ] [ label>> ] tri
|
||||
<mr> ;
|
||||
|
|
|
|||
|
|
@ -1,15 +1,16 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs deques dlists kernel make
|
||||
USING: accessors assocs deques dlists kernel make sorting
|
||||
namespaces sequences combinators combinators.short-circuit
|
||||
fry math sets compiler.cfg.rpo compiler.cfg.utilities ;
|
||||
fry math sets compiler.cfg.rpo compiler.cfg.utilities
|
||||
compiler.cfg.loop-detection ;
|
||||
IN: compiler.cfg.linearization.order
|
||||
|
||||
! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOLS: work-list loop-heads visited numbers next-number ;
|
||||
SYMBOLS: work-list loop-heads visited ;
|
||||
|
||||
: visited? ( bb -- ? ) visited get key? ;
|
||||
|
||||
|
|
@ -18,6 +19,11 @@ SYMBOLS: work-list loop-heads visited numbers next-number ;
|
|||
work-list get push-back
|
||||
] if ;
|
||||
|
||||
: init-linearization-order ( cfg -- )
|
||||
<dlist> work-list set
|
||||
H{ } clone visited set
|
||||
entry>> add-to-work-list ;
|
||||
|
||||
: (find-alternate-loop-head) ( bb -- bb' )
|
||||
dup {
|
||||
[ predecessor visited? not ]
|
||||
|
|
@ -46,28 +52,26 @@ SYMBOLS: work-list loop-heads visited numbers next-number ;
|
|||
add-to-work-list
|
||||
] [ drop ] if ;
|
||||
|
||||
: assign-number ( bb -- )
|
||||
next-number [ get ] [ inc ] bi swap numbers get set-at ;
|
||||
: sorted-successors ( bb -- seq )
|
||||
successors>> <reversed> [ loop-nesting-at ] sort-with ;
|
||||
|
||||
: process-block ( bb -- )
|
||||
{
|
||||
[ , ]
|
||||
[ assign-number ]
|
||||
[ visited get conjoin ]
|
||||
[ successors>> <reversed> [ process-successor ] each ]
|
||||
} cleave ;
|
||||
[ sorted-successors [ process-successor ] each ]
|
||||
tri ;
|
||||
|
||||
: (linearization-order) ( cfg -- bbs )
|
||||
init-linearization-order
|
||||
|
||||
[ work-list get [ process-block ] slurp-deque ] { } make ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: linearization-order ( cfg -- bbs )
|
||||
! We call 'post-order drop' to ensure blocks receive their
|
||||
! RPO numbers.
|
||||
<dlist> work-list set
|
||||
H{ } clone visited set
|
||||
H{ } clone numbers set
|
||||
0 next-number set
|
||||
[ post-order drop ]
|
||||
[ entry>> add-to-work-list ] bi
|
||||
[ work-list get [ process-block ] slurp-deque ] { } make ;
|
||||
needs-post-order needs-loops
|
||||
|
||||
: block-number ( bb -- n ) numbers get at ;
|
||||
dup linear-order>> [ ] [
|
||||
dup (linearization-order)
|
||||
>>linear-order linear-order>>
|
||||
] ?if ;
|
||||
|
|
@ -6,26 +6,25 @@ IN: compiler.cfg.liveness.tests
|
|||
|
||||
: test-liveness ( -- )
|
||||
cfg new 1 get >>entry
|
||||
compute-predecessors
|
||||
compute-live-sets ;
|
||||
|
||||
! Sanity check...
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##replace f V int-regs 1 D 1 }
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##replace f 0 D 0 }
|
||||
T{ ##replace f 1 D 1 }
|
||||
T{ ##peek f 1 D 1 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##replace f 2 D 0 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 3 D 0 }
|
||||
T{ ##replace f 3 D 0 }
|
||||
T{ ##return }
|
||||
} 3 test-bb
|
||||
|
||||
|
|
@ -35,9 +34,9 @@ test-liveness
|
|||
|
||||
[
|
||||
H{
|
||||
{ V int-regs 1 V int-regs 1 }
|
||||
{ V int-regs 2 V int-regs 2 }
|
||||
{ V int-regs 3 V int-regs 3 }
|
||||
{ 1 1 }
|
||||
{ 2 2 }
|
||||
{ 3 3 }
|
||||
}
|
||||
]
|
||||
[ 1 get live-in ]
|
||||
|
|
@ -46,12 +45,12 @@ unit-test
|
|||
! Tricky case; defs must be killed before uses
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##add-imm f V int-regs 0 V int-regs 0 10 }
|
||||
T{ ##add-imm f 0 0 10 }
|
||||
T{ ##return }
|
||||
} 2 test-bb
|
||||
|
||||
|
|
@ -59,4 +58,4 @@ V{
|
|||
|
||||
test-liveness
|
||||
|
||||
[ H{ { V int-regs 0 V int-regs 0 } } ] [ 2 get live-in ] unit-test
|
||||
[ H{ { 0 0 } } ] [ 2 get live-in ] unit-test
|
||||
|
|
@ -28,4 +28,4 @@ M: live-analysis transfer-set
|
|||
drop instructions>> transfer-liveness ;
|
||||
|
||||
M: live-analysis join-sets
|
||||
drop assoc-combine ;
|
||||
2drop assoc-combine ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,62 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces deques accessors sets sequences assocs fry
|
||||
hashtables dlists compiler.cfg.def-use compiler.cfg.instructions
|
||||
compiler.cfg.rpo compiler.cfg.liveness compiler.cfg.utilities
|
||||
compiler.cfg.predecessors ;
|
||||
IN: compiler.cfg.liveness.ssa
|
||||
|
||||
! TODO: merge with compiler.cfg.liveness
|
||||
|
||||
! Assoc mapping basic blocks to sequences of sets of vregs; each sequence
|
||||
! is in correspondence with a predecessor
|
||||
SYMBOL: phi-live-ins
|
||||
|
||||
: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ;
|
||||
|
||||
SYMBOL: work-list
|
||||
|
||||
: add-to-work-list ( basic-blocks -- )
|
||||
work-list get '[ _ push-front ] each ;
|
||||
|
||||
: compute-live-in ( basic-block -- live-in )
|
||||
[ live-out ] keep instructions>> transfer-liveness ;
|
||||
|
||||
: compute-phi-live-in ( basic-block -- phi-live-in )
|
||||
H{ } clone [
|
||||
'[ inputs>> [ swap _ conjoin-at ] assoc-each ] each-phi
|
||||
] keep ;
|
||||
|
||||
: update-live-in ( basic-block -- changed? )
|
||||
[ [ compute-live-in ] keep live-ins get maybe-set-at ]
|
||||
[ [ compute-phi-live-in ] keep phi-live-ins get maybe-set-at ]
|
||||
bi or ;
|
||||
|
||||
: compute-live-out ( basic-block -- live-out )
|
||||
[ successors>> [ live-in ] map ]
|
||||
[ dup successors>> [ phi-live-in ] with map ] bi
|
||||
append assoc-combine ;
|
||||
|
||||
: update-live-out ( basic-block -- changed? )
|
||||
[ compute-live-out ] keep
|
||||
live-outs get maybe-set-at ;
|
||||
|
||||
: liveness-step ( basic-block -- )
|
||||
dup update-live-out [
|
||||
dup update-live-in
|
||||
[ predecessors>> add-to-work-list ] [ drop ] if
|
||||
] [ drop ] if ;
|
||||
|
||||
: compute-ssa-live-sets ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
|
||||
<hashed-dlist> work-list set
|
||||
H{ } clone live-ins set
|
||||
H{ } clone phi-live-ins set
|
||||
H{ } clone live-outs set
|
||||
dup post-order add-to-work-list
|
||||
work-list get [ liveness-step ] slurp-deque ;
|
||||
|
||||
: live-in? ( vreg bb -- ? ) live-in key? ;
|
||||
|
||||
: live-out? ( vreg bb -- ? ) live-out key? ;
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
USING: compiler.cfg compiler.cfg.loop-detection
|
||||
compiler.cfg.predecessors
|
||||
compiler.cfg.debugger
|
||||
tools.test kernel namespaces accessors ;
|
||||
IN: compiler.cfg.loop-detection.tests
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ } 1 test-bb
|
||||
V{ } 2 test-bb
|
||||
|
||||
0 { 1 2 } edges
|
||||
2 0 edge
|
||||
|
||||
: test-loop-detection ( -- ) cfg new 0 get >>entry needs-loops drop ;
|
||||
|
||||
[ ] [ test-loop-detection ] unit-test
|
||||
|
||||
[ 1 ] [ 0 get loop-nesting-at ] unit-test
|
||||
[ 0 ] [ 1 get loop-nesting-at ] unit-test
|
||||
[ 1 ] [ 2 get loop-nesting-at ] unit-test
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs combinators deques dlists fry kernel
|
||||
namespaces sequences sets compiler.cfg compiler.cfg.predecessors ;
|
||||
IN: compiler.cfg.loop-detection
|
||||
|
||||
TUPLE: natural-loop header index ends blocks ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: loops
|
||||
|
||||
: <natural-loop> ( header index -- loop )
|
||||
H{ } clone H{ } clone natural-loop boa ;
|
||||
|
||||
: lookup-header ( header -- loop )
|
||||
loops get [
|
||||
loops get assoc-size <natural-loop>
|
||||
] cache ;
|
||||
|
||||
SYMBOLS: visited active ;
|
||||
|
||||
: record-back-edge ( from to -- )
|
||||
lookup-header ends>> conjoin ;
|
||||
|
||||
DEFER: find-loop-headers
|
||||
|
||||
: visit-edge ( from to -- )
|
||||
dup active get key?
|
||||
[ record-back-edge ]
|
||||
[ nip find-loop-headers ]
|
||||
if ;
|
||||
|
||||
: find-loop-headers ( bb -- )
|
||||
dup visited get key? [ drop ] [
|
||||
{
|
||||
[ visited get conjoin ]
|
||||
[ active get conjoin ]
|
||||
[ dup successors>> [ visit-edge ] with each ]
|
||||
[ active get delete-at ]
|
||||
} cleave
|
||||
] if ;
|
||||
|
||||
SYMBOL: work-list
|
||||
|
||||
: process-loop-block ( bb loop -- )
|
||||
2dup blocks>> key? [ 2drop ] [
|
||||
[ blocks>> conjoin ] [
|
||||
2dup header>> eq? [ 2drop ] [
|
||||
drop predecessors>> work-list get push-all-front
|
||||
] if
|
||||
] 2bi
|
||||
] if ;
|
||||
|
||||
: process-loop-ends ( loop -- )
|
||||
[ ends>> keys <dlist> [ push-all-front ] [ work-list set ] [ ] tri ] keep
|
||||
'[ _ process-loop-block ] slurp-deque ;
|
||||
|
||||
: process-loop-headers ( -- )
|
||||
loops get values [ process-loop-ends ] each ;
|
||||
|
||||
SYMBOL: loop-nesting
|
||||
|
||||
: compute-loop-nesting ( -- )
|
||||
loops get H{ } clone [
|
||||
[ values ] dip '[ blocks>> values [ _ inc-at ] each ] each
|
||||
] keep loop-nesting set ;
|
||||
|
||||
: detect-loops ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
H{ } clone loops set
|
||||
H{ } clone visited set
|
||||
H{ } clone active set
|
||||
H{ } clone loop-nesting set
|
||||
dup entry>> find-loop-headers process-loop-headers compute-loop-nesting ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: loop-nesting-at ( bb -- n ) loop-nesting get at 0 or ;
|
||||
|
||||
: needs-loops ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
dup loops-valid?>> [ detect-loops t >>loops-valid? ] unless ;
|
||||
|
|
@ -1,12 +1,11 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: compiler.cfg.linearization compiler.cfg.two-operand
|
||||
compiler.cfg.gc-checks compiler.cfg.linear-scan
|
||||
compiler.cfg.build-stack-frame compiler.cfg.rpo ;
|
||||
USING: kernel namespaces accessors compiler.cfg
|
||||
compiler.cfg.linearization compiler.cfg.gc-checks
|
||||
compiler.cfg.linear-scan compiler.cfg.build-stack-frame ;
|
||||
IN: compiler.cfg.mr
|
||||
|
||||
: build-mr ( cfg -- mr )
|
||||
convert-two-operand
|
||||
insert-gc-checks
|
||||
linear-scan
|
||||
flatten-cfg
|
||||
|
|
|
|||
|
|
@ -11,10 +11,10 @@ compiler.cfg.value-numbering
|
|||
compiler.cfg.copy-prop
|
||||
compiler.cfg.dce
|
||||
compiler.cfg.write-barrier
|
||||
compiler.cfg.representations
|
||||
compiler.cfg.two-operand
|
||||
compiler.cfg.ssa.destruction
|
||||
compiler.cfg.empty-blocks
|
||||
compiler.cfg.predecessors
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.checker ;
|
||||
IN: compiler.cfg.optimizer
|
||||
|
||||
|
|
@ -26,23 +26,18 @@ SYMBOL: check-optimizer?
|
|||
] when ;
|
||||
|
||||
: optimize-cfg ( cfg -- cfg' )
|
||||
! Note that compute-predecessors has to be called several times.
|
||||
! The passes that need this document it.
|
||||
[
|
||||
optimize-tail-calls
|
||||
delete-useless-conditionals
|
||||
compute-predecessors
|
||||
split-branches
|
||||
join-blocks
|
||||
compute-predecessors
|
||||
construct-ssa
|
||||
alias-analysis
|
||||
value-numbering
|
||||
compute-predecessors
|
||||
copy-propagation
|
||||
eliminate-dead-code
|
||||
eliminate-write-barriers
|
||||
select-representations
|
||||
convert-two-operand
|
||||
destruct-ssa
|
||||
delete-empty-blocks
|
||||
?check
|
||||
] with-scope ;
|
||||
?check ;
|
||||
|
|
|
|||
|
|
@ -11,53 +11,53 @@ SYMBOL: temp
|
|||
|
||||
[
|
||||
{
|
||||
T{ ##copy f V int-regs 4 V int-regs 2 }
|
||||
T{ ##copy f V int-regs 2 V int-regs 1 }
|
||||
T{ ##copy f V int-regs 1 V int-regs 4 }
|
||||
T{ ##copy f 4 2 any-rep }
|
||||
T{ ##copy f 2 1 any-rep }
|
||||
T{ ##copy f 1 4 any-rep }
|
||||
}
|
||||
] [
|
||||
H{
|
||||
{ V int-regs 1 V int-regs 2 }
|
||||
{ V int-regs 2 V int-regs 1 }
|
||||
{ 1 2 }
|
||||
{ 2 1 }
|
||||
} test-parallel-copy
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##copy f V int-regs 1 V int-regs 2 }
|
||||
T{ ##copy f V int-regs 3 V int-regs 4 }
|
||||
T{ ##copy f 1 2 any-rep }
|
||||
T{ ##copy f 3 4 any-rep }
|
||||
}
|
||||
] [
|
||||
H{
|
||||
{ V int-regs 1 V int-regs 2 }
|
||||
{ V int-regs 3 V int-regs 4 }
|
||||
{ 1 2 }
|
||||
{ 3 4 }
|
||||
} test-parallel-copy
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##copy f V int-regs 1 V int-regs 3 }
|
||||
T{ ##copy f V int-regs 2 V int-regs 1 }
|
||||
T{ ##copy f 1 3 any-rep }
|
||||
T{ ##copy f 2 1 any-rep }
|
||||
}
|
||||
] [
|
||||
H{
|
||||
{ V int-regs 1 V int-regs 3 }
|
||||
{ V int-regs 2 V int-regs 3 }
|
||||
{ 1 3 }
|
||||
{ 2 3 }
|
||||
} test-parallel-copy
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##copy f V int-regs 4 V int-regs 3 }
|
||||
T{ ##copy f V int-regs 3 V int-regs 2 }
|
||||
T{ ##copy f V int-regs 2 V int-regs 1 }
|
||||
T{ ##copy f V int-regs 1 V int-regs 4 }
|
||||
T{ ##copy f 4 3 any-rep }
|
||||
T{ ##copy f 3 2 any-rep }
|
||||
T{ ##copy f 2 1 any-rep }
|
||||
T{ ##copy f 1 4 any-rep }
|
||||
}
|
||||
] [
|
||||
{
|
||||
{ V int-regs 2 V int-regs 1 }
|
||||
{ V int-regs 3 V int-regs 2 }
|
||||
{ V int-regs 1 V int-regs 3 }
|
||||
{ V int-regs 4 V int-regs 3 }
|
||||
{ 2 1 }
|
||||
{ 3 2 }
|
||||
{ 1 3 }
|
||||
{ 4 3 }
|
||||
} test-parallel-copy
|
||||
] unit-test
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs compiler.cfg.hats compiler.cfg.instructions
|
||||
deques dlists fry kernel locals namespaces sequences
|
||||
hashtables ;
|
||||
USING: assocs cpu.architecture compiler.cfg.registers
|
||||
compiler.cfg.instructions deques dlists fry kernel locals namespaces
|
||||
sequences hashtables ;
|
||||
IN: compiler.cfg.parallel-copy
|
||||
|
||||
! Revisiting Out-of-SSA Translation for Correctness, Code Quality, and Efficiency
|
||||
|
|
@ -57,4 +57,5 @@ PRIVATE>
|
|||
] slurp-deque
|
||||
] with-scope ; inline
|
||||
|
||||
: parallel-copy ( mapping -- ) i [ ##copy ] parallel-mapping ;
|
||||
: parallel-copy ( mapping -- )
|
||||
next-vreg [ any-rep ##copy ] parallel-mapping ;
|
||||
|
|
@ -4,6 +4,8 @@ USING: kernel accessors combinators fry sequences assocs compiler.cfg.rpo
|
|||
compiler.cfg.instructions compiler.cfg.utilities ;
|
||||
IN: compiler.cfg.predecessors
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: update-predecessors ( bb -- )
|
||||
dup successors>> [ predecessors>> push ] with each ;
|
||||
|
||||
|
|
@ -23,3 +25,9 @@ IN: compiler.cfg.predecessors
|
|||
[ [ update-phis ] each-basic-block ]
|
||||
[ ]
|
||||
} cleave ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: needs-predecessors ( cfg -- cfg' )
|
||||
dup predecessors-valid?>>
|
||||
[ compute-predecessors t >>predecessors-valid? ] unless ;
|
||||
|
|
@ -1,18 +1,32 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors namespaces kernel arrays parser math math.order ;
|
||||
USING: accessors namespaces kernel parser assocs ;
|
||||
IN: compiler.cfg.registers
|
||||
|
||||
! Virtual registers, used by CFG and machine IRs
|
||||
TUPLE: vreg { reg-class read-only } { n fixnum read-only } ;
|
||||
|
||||
M: vreg equal? over vreg? [ [ n>> ] bi@ eq? ] [ 2drop f ] if ;
|
||||
|
||||
M: vreg hashcode* nip n>> ;
|
||||
|
||||
! Virtual registers, used by CFG and machine IRs, are just integers
|
||||
SYMBOL: vreg-counter
|
||||
|
||||
: next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
|
||||
: next-vreg ( -- vreg )
|
||||
! This word cannot be called AFTER representation selection has run;
|
||||
! use next-vreg-rep in that case
|
||||
\ vreg-counter counter ;
|
||||
|
||||
SYMBOL: representations
|
||||
|
||||
ERROR: bad-vreg vreg ;
|
||||
|
||||
: rep-of ( vreg -- rep )
|
||||
! This word cannot be called BEFORE representation selection has run;
|
||||
! use any-rep for ##copy instructions and so on
|
||||
representations get ?at [ bad-vreg ] unless ;
|
||||
|
||||
: set-rep-of ( rep vreg -- )
|
||||
representations get set-at ;
|
||||
|
||||
: next-vreg-rep ( rep -- vreg )
|
||||
! This word cannot be called BEFORE representation selection has run;
|
||||
! use next-vreg in that case
|
||||
next-vreg [ set-rep-of ] keep ;
|
||||
|
||||
! Stack locations -- 'n' is an index starting from the top of the stack
|
||||
! going down. So 0 is the top of the stack, 1 is what would be the top
|
||||
|
|
@ -28,6 +42,5 @@ C: <ds-loc> ds-loc
|
|||
TUPLE: rs-loc < loc ;
|
||||
C: <rs-loc> rs-loc
|
||||
|
||||
SYNTAX: V scan-word scan-word vreg boa parsed ;
|
||||
SYNTAX: D scan-word <ds-loc> parsed ;
|
||||
SYNTAX: R scan-word <rs-loc> parsed ;
|
||||
|
|
|
|||
|
|
@ -10,7 +10,4 @@ SYMBOL: renamings
|
|||
: rename-value ( vreg -- vreg' )
|
||||
renamings get ?at drop ;
|
||||
|
||||
: fresh-value ( vreg -- vreg' )
|
||||
reg-class>> next-vreg ;
|
||||
|
||||
RENAMING: rename [ rename-value ] [ rename-value ] [ fresh-value ]
|
||||
RENAMING: rename [ rename-value ] [ rename-value ] [ drop next-vreg ]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,83 @@
|
|||
! 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 ;
|
||||
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 ;
|
||||
|
||||
M: ##write-barrier temp-vreg-reps drop { int-rep int-rep } ;
|
||||
M: ##unary/temp temp-vreg-reps drop { int-rep } ;
|
||||
M: ##allot temp-vreg-reps drop { int-rep } ;
|
||||
M: ##dispatch temp-vreg-reps drop { int-rep } ;
|
||||
M: ##slot temp-vreg-reps drop { int-rep } ;
|
||||
M: ##set-slot temp-vreg-reps drop { int-rep } ;
|
||||
M: ##string-nth temp-vreg-reps drop { int-rep } ;
|
||||
M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ;
|
||||
M: ##compare temp-vreg-reps drop { int-rep } ;
|
||||
M: ##compare-imm temp-vreg-reps drop { int-rep } ;
|
||||
M: ##compare-float temp-vreg-reps drop { int-rep } ;
|
||||
M: ##gc temp-vreg-reps drop { int-rep int-rep } ;
|
||||
M: _dispatch temp-vreg-reps drop { int-rep } ;
|
||||
M: insn temp-vreg-reps drop f ;
|
||||
|
||||
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
|
||||
|
||||
: each-use-rep ( insn vreg-quot: ( vreg rep -- ) -- )
|
||||
[ [ uses-vregs ] [ uses-vreg-reps ] bi ] dip 2each ; inline
|
||||
|
||||
: each-temp-rep ( insn vreg-quot: ( vreg rep -- ) -- )
|
||||
[ [ temp-vregs ] [ temp-vreg-reps ] bi ] dip 2each ; inline
|
||||
|
||||
: with-vreg-reps ( cfg vreg-quot: ( vreg rep -- ) -- )
|
||||
'[
|
||||
[ basic-block set ] [
|
||||
[
|
||||
_
|
||||
[ each-def-rep ]
|
||||
[ each-use-rep ]
|
||||
[ each-temp-rep ] 2tri
|
||||
] each-non-phi
|
||||
] bi
|
||||
] each-basic-block ; inline
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
USING: tools.test cpu.architecture
|
||||
compiler.cfg.registers compiler.cfg.instructions
|
||||
compiler.cfg.representations.preferred ;
|
||||
IN: compiler.cfg.representations
|
||||
|
||||
[ { double-float-rep double-float-rep } ] [
|
||||
T{ ##add-float
|
||||
{ dst 5 }
|
||||
{ src1 3 }
|
||||
{ src2 4 }
|
||||
} uses-vreg-reps
|
||||
] unit-test
|
||||
|
||||
[ double-float-rep ] [
|
||||
T{ ##alien-double
|
||||
{ dst 5 }
|
||||
{ src 3 }
|
||||
} defs-vreg-rep
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,229 @@
|
|||
! Copyright (C) 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel fry accessors sequences assocs sets namespaces
|
||||
arrays combinators make locals deques dlists
|
||||
cpu.architecture compiler.utilities
|
||||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
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 ;
|
||||
IN: compiler.cfg.representations
|
||||
|
||||
! Virtual register representation selection.
|
||||
|
||||
: emit-conversion ( dst src dst-rep src-rep -- )
|
||||
2array {
|
||||
{ { int-rep int-rep } [ int-rep ##copy ] }
|
||||
{ { double-float-rep double-float-rep } [ double-float-rep ##copy ] }
|
||||
{ { double-float-rep int-rep } [ ##unbox-float ] }
|
||||
{ { int-rep double-float-rep } [ int-rep next-vreg-rep ##box-float ] }
|
||||
} case ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! For every vreg, compute possible representations.
|
||||
SYMBOL: possibilities
|
||||
|
||||
: possible ( vreg -- reps ) possibilities get at ;
|
||||
|
||||
: compute-possibilities ( cfg -- )
|
||||
H{ } clone [ '[ swap _ conjoin-at ] with-vreg-reps ] keep
|
||||
[ keys ] assoc-map possibilities set ;
|
||||
|
||||
! Compute vregs which must remain tagged for their lifetime.
|
||||
SYMBOL: always-boxed
|
||||
|
||||
:: (compute-always-boxed) ( vreg rep assoc -- )
|
||||
rep int-rep eq? [
|
||||
int-rep vreg assoc set-at
|
||||
] when ;
|
||||
|
||||
: compute-always-boxed ( cfg -- assoc )
|
||||
H{ } clone [
|
||||
'[
|
||||
[
|
||||
dup ##load-reference? [ 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 [ [ 0 ] H{ } map>assoc ] assoc-map costs set ;
|
||||
|
||||
: increase-cost ( rep vreg -- )
|
||||
! Increase cost of keeping vreg in rep, making a choice of rep less
|
||||
! likely.
|
||||
[ basic-block get loop-nesting-at ] 2dip costs get at at+ ;
|
||||
|
||||
: maybe-increase-cost ( possible vreg preferred -- )
|
||||
pick eq? [ 2drop ] [ 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 ;
|
||||
|
||||
: compute-costs ( cfg -- costs )
|
||||
init-costs [ representation-cost ] with-vreg-reps costs get ;
|
||||
|
||||
! For every vreg, compute preferred representation, that minimizes costs.
|
||||
: minimize-costs ( costs -- representations )
|
||||
[ >alist alist-min first ] assoc-map ;
|
||||
|
||||
: compute-representations ( cfg -- )
|
||||
[ compute-costs minimize-costs ]
|
||||
[ compute-always-boxed ]
|
||||
bi assoc-union
|
||||
representations set ;
|
||||
|
||||
! Insert conversions. This introduces new temporaries, so we need
|
||||
! to rename opearands too.
|
||||
|
||||
:: 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.
|
||||
required next-vreg-rep [ src required preferred emit-conversion ] keep ;
|
||||
|
||||
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 -- ) -- )
|
||||
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-here
|
||||
[ convert-insn-uses ] [ convert-insn-defs ] bi
|
||||
renaming-set get length 0 assert=
|
||||
] [ drop ] if ;
|
||||
|
||||
GENERIC: conversions-for-insn ( insn -- )
|
||||
|
||||
SYMBOL: phi-mappings
|
||||
|
||||
! compiler.cfg.cssa inserts conversions which convert phi inputs into
|
||||
! the representation of the output. However, we still have to do some
|
||||
! processing here, because if the only node that uses the output of
|
||||
! the phi instruction is another phi instruction then this phi node's
|
||||
! output won't have a representation assigned.
|
||||
M: ##phi conversions-for-insn
|
||||
[ , ] [ [ inputs>> values ] [ dst>> ] bi phi-mappings get set-at ] bi ;
|
||||
|
||||
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 ] [
|
||||
[
|
||||
[
|
||||
[ conversions-for-insn ] each
|
||||
] V{ } make
|
||||
] change-instructions drop
|
||||
] if ;
|
||||
|
||||
! 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: 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 ( -- )
|
||||
phi-mappings get keys rep-assigned add-to-work-list ;
|
||||
|
||||
: process-phi-mapping ( 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 phi-mappings get at* [
|
||||
[ rep-of ] [ rep-not-assigned ] bi*
|
||||
[ [ set-rep-of ] with each ] [ add-to-work-list ] bi
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: remaining-phi-mappings ( -- )
|
||||
phi-mappings get keys rep-not-assigned
|
||||
[ [ int-rep ] dip set-rep-of ] each ;
|
||||
|
||||
: process-phi-mappings ( -- )
|
||||
<hashed-dlist> work-list set
|
||||
add-ready-phis
|
||||
work-list get [ process-phi-mapping ] slurp-deque
|
||||
remaining-phi-mappings ;
|
||||
|
||||
: insert-conversions ( cfg -- )
|
||||
H{ } clone phi-mappings set
|
||||
[ conversions-for-block ] each-basic-block
|
||||
process-phi-mappings ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: select-representations ( cfg -- cfg' )
|
||||
needs-loops
|
||||
|
||||
{
|
||||
[ compute-possibilities ]
|
||||
[ compute-representations ]
|
||||
[ insert-conversions ]
|
||||
[ ]
|
||||
} cleave
|
||||
representations get cfg get (>>reps) ;
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue