steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg: Rename <##foo> to ##foo, in the low-level IR

db4
Doug Coleman 2011-11-11 19:48:38 -08:00
parent 1d84f5e190
commit 6cca0ea468
23 changed files with 96 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/compiler/cfg/builder/alien/alien.factor
View File

@ -112,7 +112,7 @@ M: #alien-invoke emit-node
[ caller-stack-frame ]
[ caller-linkage ]
} cleave
<gc-map> <##alien-invoke>
<gc-map> ##alien-invoke,
]
[ caller-return ]
bi ;
@ -124,7 +124,7 @@ M: #alien-indirect emit-node ( node -- )
[ caller-parameters ]
[ prepare-caller-return ]
[ caller-stack-frame ] tri
<gc-map> <##alien-indirect>
<gc-map> ##alien-indirect,
]
[ caller-return ]
bi ;
@ -137,7 +137,7 @@ M: #alien-assembly emit-node
[ prepare-caller-return ]
[ caller-stack-frame ]
[ quot>> ]
} cleave <gc-map> <##alien-assembly>
} cleave <gc-map> ##alien-assembly,
]
[ caller-return ]
bi ;
@ -183,7 +183,7 @@ M: #alien-assembly emit-node
[ last #return? t assert= ] [ but-last emit-nodes ] bi ;
: emit-callback-return ( params -- )
basic-block get [ callee-return <##callback-outputs> ] [ drop ] if ;
basic-block get [ callee-return ##callback-outputs, ] [ drop ] if ;
M: #alien-callback emit-node
dup params>> xt>> dup
@ -193,7 +193,7 @@ M: #alien-callback emit-node
begin-word
{
[ params>> callee-parameters <##callback-inputs> ]
[ params>> callee-parameters ##callback-inputs, ]
[ params>> box-parameters ]
[ child>> emit-callback-body ]
[ params>> emit-callback-return ]

4
basis/compiler/cfg/builder/alien/boxing/boxing.factor
View File

@ -52,7 +52,7 @@ M: object flatten-struct-type-return
:: implode-struct ( src vregs reps -- )
vregs reps dup component-offsets
[| vreg rep offset | vreg src offset rep f <##store-memory-imm> ] 3each ;
[| vreg rep offset | vreg src offset rep f ##store-memory-imm, ] 3each ;
GENERIC: unbox ( src c-type -- vregs reps )
@ -75,7 +75,7 @@ M: c-type unbox
[ drop f f 3array 1array ] 2bi ;
M: long-long-type unbox
[ next-vreg next-vreg 2dup ] 2dip unboxer>> <##unbox-long-long> 2array
[ next-vreg next-vreg 2dup ] 2dip unboxer>> ##unbox-long-long, 2array
int-rep long-long-on-stack? long-long-odd-register? 3array
int-rep long-long-on-stack? f 3array 2array ;

8
basis/compiler/cfg/builder/blocks/blocks.factor
View File

@ -27,9 +27,9 @@ IN: compiler.cfg.builder.blocks
(begin-basic-block) ;
: emit-trivial-block ( quot -- )
<##branch> begin-basic-block
##branch, begin-basic-block
call
<##branch> begin-basic-block ; inline
##branch, begin-basic-block ; inline
: make-kill-block ( -- )
basic-block get t >>kill-block? drop ;
@ -39,7 +39,7 @@ IN: compiler.cfg.builder.blocks
: emit-primitive ( node -- )
[
[ word>> <##call> ]
[ word>> ##call, ]
[ call-height adjust-d ] bi
make-kill-block
] emit-trivial-block ;
@ -49,7 +49,7 @@ IN: compiler.cfg.builder.blocks
: end-branch ( -- pair/f )
! pair is { final-bb final-height }
basic-block get dup [
<##branch>
##branch,
end-local-analysis
current-height get clone 2array
] when ;

26
basis/compiler/cfg/builder/builder.factor
View File

@ -57,8 +57,8 @@ GENERIC: emit-node ( node -- )
: begin-word ( -- )
make-kill-block
<##prologue>
<##branch>
##prologue,
##branch,
begin-basic-block ;
: (build-cfg) ( nodes word label -- )
@ -75,8 +75,8 @@ GENERIC: emit-node ( node -- )
] keep ;
: emit-loop-call ( basic-block -- )
<##safepoint>
<##branch>
##safepoint,
##branch,
basic-block get successors>> push
end-basic-block ;
@ -85,7 +85,7 @@ GENERIC: emit-node ( node -- )
[ drop loops get at emit-loop-call ]
[
[
[ <##call> ] [ adjust-d ] bi*
[ ##call, ] [ adjust-d ] bi*
make-kill-block
] emit-trivial-block
] if ;
@ -102,7 +102,7 @@ GENERIC: emit-node ( node -- )
basic-block get swap loops get set-at ;
: emit-loop ( node -- )
<##branch>
##branch,
begin-basic-block
[ label>> id>> remember-loop ] [ child>> emit-nodes ] bi ;
@ -142,7 +142,7 @@ M: #recursive emit-node
: emit-actual-if ( #if -- )
! Inputs to the final instruction need to be copied because of
! loc>vreg sync
ds-pop any-rep ^^copy f cc/= <##compare-imm-branch> emit-if ;
ds-pop any-rep ^^copy f cc/= ##compare-imm-branch, emit-if ;
M: #if emit-node
{
@ -156,7 +156,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 next-vreg <##dispatch> emit-if ;
ds-pop ^^offset>slot next-vreg ##dispatch, emit-if ;
! #call
M: #call emit-node
@ -200,12 +200,12 @@ M: #shuffle emit-node
! #return
: end-word ( -- )
<##branch>
##branch,
begin-basic-block
make-kill-block
<##safepoint>
<##epilogue>
<##return> ;
##safepoint,
##epilogue,
##return, ;
M: #return emit-node drop end-word ;
@ -213,7 +213,7 @@ M: #return-recursive emit-node
label>> id>> loops get key? [ end-word ] unless ;
! #terminate
M: #terminate emit-node drop <##no-tco> end-basic-block ;
M: #terminate emit-node drop ##no-tco, end-basic-block ;
! No-op nodes
M: #introduce emit-node drop ;

2
basis/compiler/cfg/gc-checks/gc-checks.factor
View File

@ -85,7 +85,7 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
: <gc-call> ( -- bb )
<basic-block>
[ <gc-map> <##call-gc> <##branch> ] V{ } make
[ <gc-map> ##call-gc, ##branch, ] V{ } make
>>instructions t >>unlikely? ;
:: connect-gc-checks ( bbs -- )

2
basis/compiler/cfg/instructions/syntax/syntax.factor
View File

@ -72,7 +72,7 @@ TUPLE: insn-slot-spec type name rep ;
[ name>> ] map "insn#" suffix define-tuple-class ;
: insn-ctor-name ( word -- name )
name>> "<" ">" surround ;
name>> "," append ;
: define-insn-ctor ( class specs -- )
[ [ insn-ctor-name create-in ] [ '[ _ ] [ f ] [ boa , ] surround ] bi ] dip

2
basis/compiler/cfg/intrinsics/alien/alien.factor
View File

@ -61,7 +61,7 @@ IN: compiler.cfg.intrinsics.alien
:: (emit-store-memory) ( node rep c-type prepare-quot test-quot -- )
node
[ prepare-quot call rep c-type <##store-memory-imm> ]
[ prepare-quot call rep c-type ##store-memory-imm, ]
[ test-quot call inline-store-memory? ]
inline-accessor ; inline

14
basis/compiler/cfg/intrinsics/allot/allot.factor
View File

@ -8,13 +8,13 @@ compiler.cfg.utilities compiler.cfg.builder.blocks
compiler.constants cpu.architecture alien.c-types ;
IN: compiler.cfg.intrinsics.allot
: <##set-slots> ( regs obj class -- )
'[ _ swap 1 + _ type-number <##set-slot-imm> ] each-index ;
: ##set-slots, ( regs obj class -- )
'[ _ swap 1 + _ type-number ##set-slot-imm, ] each-index ;
: emit-simple-allot ( node -- )
[ in-d>> length ] [ node-output-infos first class>> ] bi
[ drop ds-load ] [ [ 1 + cells ] dip ^^allot ] [ nip ] 2tri
[ <##set-slots> ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi ;
[ ##set-slots, ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi ;
: tuple-slot-regs ( layout -- vregs )
[ second ds-load ] [ ^^load-literal ] bi prefix ;
@ -28,14 +28,14 @@ IN: compiler.cfg.intrinsics.allot
nip
ds-drop
[ tuple-slot-regs ] [ second ^^allot-tuple ] bi
[ tuple <##set-slots> ] [ ds-push drop ] 2bi
[ tuple ##set-slots, ] [ ds-push drop ] 2bi
] [ drop emit-primitive ] if ;
: store-length ( len reg class -- )
[ [ ^^load-literal ] dip 1 ] dip type-number <##set-slot-imm> ;
[ [ ^^load-literal ] dip 1 ] dip type-number ##set-slot-imm, ;
:: store-initial-element ( len reg elt class -- )
len [ [ elt reg ] dip 2 + class type-number <##set-slot-imm> ] each-integer ;
len [ [ elt reg ] dip 2 + class type-number ##set-slot-imm, ] each-integer ;
: expand-<array>? ( obj -- ? )
dup integer? [ 0 8 between? ] [ drop f ] if ;
@ -76,7 +76,7 @@ IN: compiler.cfg.intrinsics.allot
0 ^^load-literal :> elt
reg ^^tagged>integer :> reg
len cell align cell /i iota [
[ elt reg ] dip cells byte-array-offset + int-rep f <##store-memory-imm>
[ elt reg ] dip cells byte-array-offset + int-rep f ##store-memory-imm,
] each ;
:: emit-<byte-array> ( node -- )

4
basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
View File

@ -32,7 +32,7 @@ IN: compiler.cfg.intrinsics.fixnum
] binary-op ;
: emit-fixnum-shift-general ( -- )
ds-peek 0 cc> <##compare-integer-imm-branch>
ds-peek 0 cc> ##compare-integer-imm-branch,
[ emit-fixnum-left-shift ] with-branch
[ emit-fixnum-right-shift ] with-branch
2array emit-conditional ;
@ -52,7 +52,7 @@ IN: compiler.cfg.intrinsics.fixnum
: emit-overflow-case ( word -- final-bb )
[
<##call>
##call,
-1 adjust-d
make-kill-block
] with-branch ;

4
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -33,7 +33,7 @@ IN: compiler.cfg.intrinsics.misc
: emit-set-special-object ( node -- )
dup node-input-infos second literal>> [
ds-drop
[ ds-pop ] dip special-object-offset <##set-vm-field>
[ ds-pop ] dip special-object-offset ##set-vm-field,
] [ emit-primitive ] ?if ;
: context-object-offset ( n -- n )
@ -60,4 +60,4 @@ IN: compiler.cfg.intrinsics.misc
if ;
: emit-cleanup-allot ( -- )
[ <##no-tco> ] emit-trivial-block ;
[ ##no-tco, ] emit-trivial-block ;

2
basis/compiler/cfg/intrinsics/simd/simd.factor
View File

@ -632,7 +632,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
dup [
'[
ds-drop prepare-store-memory
_ f <##store-memory-imm>
_ f ##store-memory-imm,
]
[ byte-array inline-store-memory? ]
inline-accessor

8
basis/compiler/cfg/intrinsics/slots/slots.factor
View File

@ -52,10 +52,10 @@ IN: compiler.cfg.intrinsics.slots
infos second value-tag :> tag
slot tag slot-indexing :> ( slot scale tag )
src obj slot scale tag <##set-slot>
src obj slot scale tag ##set-slot,
infos emit-write-barrier?
[ obj slot scale tag next-vreg next-vreg <##write-barrier> ] when ;
[ obj slot scale tag next-vreg next-vreg ##write-barrier, ] when ;
:: (emit-set-slot-imm) ( infos -- )
ds-drop
@ -65,10 +65,10 @@ IN: compiler.cfg.intrinsics.slots
infos third literal>> :> slot
infos second value-tag :> tag
src obj slot tag <##set-slot-imm>
src obj slot tag ##set-slot-imm,
infos emit-write-barrier?
[ obj slot tag next-vreg next-vreg <##write-barrier-imm> ] when ;
[ obj slot tag next-vreg next-vreg ##write-barrier-imm, ] when ;
: emit-set-slot ( node -- )
dup node-input-infos

2
basis/compiler/cfg/intrinsics/strings/strings.factor
View File

@ -12,4 +12,4 @@ IN: compiler.cfg.intrinsics.strings
2inputs (string-nth) ^^load-memory-imm ds-push ;
: emit-set-string-nth-fast ( -- )
3inputs (string-nth) <##store-memory-imm> ;
3inputs (string-nth) ##store-memory-imm, ;

4
basis/compiler/cfg/linear-scan/assignment/assignment.factor
View File

@ -97,7 +97,7 @@ SYMBOL: machine-live-outs
init-unhandled ;
: insert-spill ( live-interval -- )
[ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri <##spill> ;
[ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri ##spill, ;
: handle-spill ( live-interval -- )
dup spill-to>> [ insert-spill ] [ drop ] if ;
@ -117,7 +117,7 @@ SYMBOL: machine-live-outs
pending-interval-heap get (expire-old-intervals) ;
: insert-reload ( live-interval -- )
[ reg>> ] [ reload-rep>> ] [ reload-from>> ] tri <##reload> ;
[ reg>> ] [ reload-rep>> ] [ reload-from>> ] tri ##reload, ;
: handle-reload ( live-interval -- )
dup reload-from>> [ insert-reload ] [ drop ] if ;

12
basis/compiler/cfg/linear-scan/resolve/resolve.factor
View File

@ -60,19 +60,19 @@ SYMBOL: spill-temps
] if ;
: memory->register ( from to -- )
swap [ reg>> ] [ [ rep>> ] [ reg>> ] bi ] bi* <##reload> ;
swap [ reg>> ] [ [ rep>> ] [ reg>> ] bi ] bi* ##reload, ;
: register->memory ( from to -- )
[ [ reg>> ] [ rep>> ] bi ] [ reg>> ] bi* <##spill> ;
[ [ reg>> ] [ rep>> ] bi ] [ reg>> ] bi* ##spill, ;
: temp->register ( from to -- )
nip [ reg>> ] [ rep>> ] [ rep>> spill-temp ] tri <##reload> ;
nip [ reg>> ] [ rep>> ] [ rep>> spill-temp ] tri ##reload, ;
: register->temp ( from to -- )
drop [ [ reg>> ] [ rep>> ] bi ] [ rep>> spill-temp ] bi <##spill> ;
drop [ [ reg>> ] [ rep>> ] bi ] [ rep>> spill-temp ] bi ##spill, ;
: register->register ( from to -- )
swap [ reg>> ] [ [ reg>> ] [ rep>> ] bi ] bi* <##copy> ;
swap [ reg>> ] [ [ reg>> ] [ rep>> ] bi ] bi* ##copy, ;
SYMBOL: temp
@ -87,7 +87,7 @@ SYMBOL: temp
: mapping-instructions ( alist -- insns )
[ swap ] H{ } assoc-map-as
[ temp [ swap >insn ] parallel-mapping <##branch> ] { } make ;
[ temp [ swap >insn ] parallel-mapping ##branch, ] { } make ;
: perform-mappings ( bb to mappings -- )
dup empty? [ 3drop ] [

2
basis/compiler/cfg/parallel-copy/parallel-copy.factor
View File

@ -58,4 +58,4 @@ PRIVATE>
] with-scope ; inline
: parallel-copy ( mapping -- )
next-vreg [ any-rep <##copy> ] parallel-mapping ;
next-vreg [ any-rep ##copy, ] parallel-mapping ;

40
basis/compiler/cfg/representations/conversion/conversion.factor
View File

@ -11,73 +11,73 @@ GENERIC: rep>tagged ( dst src rep -- )
GENERIC: tagged>rep ( dst src rep -- )
M: int-rep rep>tagged ( dst src rep -- )
drop tag-bits get <##shl-imm> ;
drop tag-bits get ##shl-imm, ;
M: int-rep tagged>rep ( dst src rep -- )
drop tag-bits get <##sar-imm> ;
drop tag-bits get ##sar-imm, ;
M:: float-rep rep>tagged ( dst src rep -- )
double-rep next-vreg-rep :> temp
temp src <##single>double-float>
temp src ##single>double-float,
dst temp double-rep rep>tagged ;
M:: float-rep tagged>rep ( dst src rep -- )
double-rep next-vreg-rep :> temp
temp src double-rep tagged>rep
dst temp <##double>single-float> ;
dst temp ##double>single-float, ;
M:: double-rep rep>tagged ( dst src rep -- )
dst 16 float int-rep next-vreg-rep <##allot>
src dst float-offset double-rep f <##store-memory-imm> ;
dst 16 float int-rep next-vreg-rep ##allot,
src dst float-offset double-rep f ##store-memory-imm, ;
M: double-rep tagged>rep
drop float-offset double-rep f <##load-memory-imm> ;
drop float-offset double-rep f ##load-memory-imm, ;
M:: vector-rep rep>tagged ( dst src rep -- )
tagged-rep next-vreg-rep :> temp
dst 16 2 cells + byte-array int-rep next-vreg-rep <##allot>
temp 16 tag-fixnum <##load-tagged>
temp dst 1 byte-array type-number <##set-slot-imm>
src dst byte-array-offset rep f <##store-memory-imm> ;
dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot,
temp 16 tag-fixnum ##load-tagged,
temp dst 1 byte-array type-number ##set-slot-imm,
src dst byte-array-offset rep f ##store-memory-imm, ;
M: vector-rep tagged>rep
[ byte-array-offset ] dip f <##load-memory-imm> ;
[ byte-array-offset ] dip f ##load-memory-imm, ;
M:: scalar-rep rep>tagged ( dst src rep -- )
tagged-rep next-vreg-rep :> temp
temp src rep <##scalar>integer>
temp src rep ##scalar>integer,
dst temp int-rep rep>tagged ;
M:: scalar-rep tagged>rep ( dst src rep -- )
tagged-rep next-vreg-rep :> temp
temp src int-rep tagged>rep
dst temp rep <##integer>scalar> ;
dst temp rep ##integer>scalar, ;
GENERIC: rep>int ( dst src rep -- )
GENERIC: int>rep ( dst src rep -- )
M: scalar-rep rep>int ( dst src rep -- )
<##scalar>integer> ;
##scalar>integer, ;
M: scalar-rep int>rep ( dst src rep -- )
<##integer>scalar> ;
##integer>scalar, ;
: emit-conversion ( dst src dst-rep src-rep -- )
{
{ [ 2dup eq? ] [ drop <##copy> ] }
{ [ 2dup eq? ] [ drop ##copy, ] }
{ [ dup tagged-rep? ] [ drop tagged>rep ] }
{ [ over tagged-rep? ] [ nip rep>tagged ] }
{ [ dup int-rep? ] [ drop int>rep ] }
{ [ over int-rep? ] [ nip rep>int ] }
[
2dup 2array {
{ { double-rep float-rep } [ 2drop <##single>double-float> ] }
{ { float-rep double-rep } [ 2drop <##double>single-float> ] }
{ { double-rep float-rep } [ 2drop ##single>double-float, ] }
{ { float-rep double-rep } [ 2drop ##double>single-float, ] }
! Punning SIMD vector types? Naughty naughty! But
! it is allowed... otherwise bail out.
[
drop 2dup [ reg-class-of ] bi@ eq?
[ drop <##copy> ] [ bad-conversion ] if
[ drop ##copy, ] [ bad-conversion ] if
]
} case
]

24
basis/compiler/cfg/representations/peephole/peephole.factor
View File

@ -37,7 +37,7 @@ M: ##load-integer optimize-insn
{
{
[ dup dst>> rep-of tagged-rep? ]
[ [ dst>> ] [ val>> tag-fixnum ] bi <##load-tagged> here ]
[ [ dst>> ] [ val>> tag-fixnum ] bi ##load-tagged, here ]
}
[ call-next-method ]
} cond ;
@ -84,23 +84,23 @@ M: ##load-reference optimize-insn
{
{
[ dup convert-to-load-float? ]
[ [ dst>> ] [ obj>> ] bi <##load-float> here ]
[ [ dst>> ] [ obj>> ] bi ##load-float, here ]
}
{
[ dup convert-to-load-double? ]
[ [ dst>> ] [ obj>> ] bi <##load-double> here ]
[ [ dst>> ] [ obj>> ] bi ##load-double, here ]
}
{
[ dup convert-to-zero-vector? ]
[ dst>> dup rep-of <##zero-vector> here ]
[ dst>> dup rep-of ##zero-vector, here ]
}
{
[ dup convert-to-fill-vector? ]
[ dst>> dup rep-of <##fill-vector> here ]
[ dst>> dup rep-of ##fill-vector, here ]
}
{
[ dup convert-to-load-vector? ]
[ [ dst>> ] [ obj>> ] [ dst>> rep-of ] tri <##load-vector> here ]
[ [ dst>> ] [ obj>> ] [ dst>> rep-of ] tri ##load-vector, here ]
}
[ call-next-method ]
} cond ;
@ -113,9 +113,9 @@ M: ##load-reference optimize-insn
! ##sar-imm by tag-bits - X.
: combine-shl-imm-input ( insn -- )
[ dst>> ] [ src1>> ] [ src2>> ] tri tag-bits get {
{ [ 2dup < ] [ swap - <##sar-imm> here ] }
{ [ 2dup > ] [ - <##shl-imm> here ] }
[ 2drop int-rep <##copy> here ]
{ [ 2dup < ] [ swap - ##sar-imm, here ] }
{ [ 2dup > ] [ - ##shl-imm, here ] }
[ 2drop int-rep ##copy, here ]
} cond ;
: dst-tagged? ( insn -- ? ) dst>> rep-of tagged-rep? ;
@ -260,7 +260,7 @@ M: ##test-branch optimize-insn
[ dst>> ] [ src>> ] bi [ rep-of tagged-rep? ] both? ;
: combine-neg-tag ( insn -- )
[ dst>> ] [ src>> ] bi tag-bits get 2^ neg <##mul-imm> here ;
[ dst>> ] [ src>> ] bi tag-bits get 2^ neg ##mul-imm, here ;
M: ##neg optimize-insn
{
@ -276,8 +276,8 @@ M: ##neg optimize-insn
! tag(not(untag(x))) = not(x) xor tag-mask
:: emit-tagged-not ( insn -- )
tagged-rep next-vreg-rep :> temp
temp insn src>> <##not>
insn dst>> temp tag-mask get <##xor-imm> here ;
temp insn src>> ##not,
insn dst>> temp tag-mask get ##xor-imm, here ;
M: ##not optimize-insn
{

2
basis/compiler/cfg/ssa/cssa/cssa.factor
View File

@ -23,7 +23,7 @@ IN: compiler.cfg.ssa.cssa
:: insert-copy ( bb src rep -- bb dst )
bb src insert-copy? [
rep next-vreg-rep :> dst
bb [ dst src rep <##copy> ] add-instructions
bb [ dst src rep ##copy, ] add-instructions
bb dst
] [ bb src ] if ;

6
basis/compiler/cfg/stacks/finalize/finalize.factor
View File

@ -34,17 +34,17 @@ ERROR: bad-peek dst loc ;
: insert-peeks ( from to -- )
[ inserting-peeks ] keep
[ dup n>> 0 < [ bad-peek ] [ <##peek> ] if ] each-insertion ;
[ dup n>> 0 < [ bad-peek ] [ ##peek, ] if ] each-insertion ;
: insert-replaces ( from to -- )
[ inserting-replaces ] keep
[ dup n>> 0 < [ 2drop ] [ <##replace> ] if ] each-insertion ;
[ dup n>> 0 < [ 2drop ] [ ##replace, ] if ] each-insertion ;
: visit-edge ( from to -- )
! If both blocks are subroutine calls, don't bother
! computing anything.
2dup [ kill-block?>> ] both? [ 2drop ] [
2dup [ [ insert-replaces ] [ insert-peeks ] 2bi <##branch> ] V{ } make
2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ##branch, ] V{ } make
[ 2drop ] [ insert-basic-block ] if-empty
] if ;

4
basis/compiler/cfg/stacks/local/local.factor
View File

@ -45,8 +45,8 @@ M: rs-loc translate-local-loc n>> current-height get r>> - <rs-loc> ;
: emit-height-changes ( -- )
current-height get
[ emit-d>> dup 0 = [ drop ] [ <##inc-d> ] if ]
[ emit-r>> dup 0 = [ drop ] [ <##inc-r> ] if ] bi ;
[ emit-d>> dup 0 = [ drop ] [ ##inc-d, ] if ]
[ emit-r>> dup 0 = [ drop ] [ ##inc-r, ] if ] bi ;
: emit-changes ( -- )
! Insert height and stack changes prior to the last instruction

2
basis/compiler/cfg/value-numbering/alien/alien.factor
View File

@ -31,7 +31,7 @@ M: ##box-displaced-alien rewrite
[ dst>> ]
[ [ base>> ] [ base-class>> ] [ displacement>> ] tri ] bi*
[ ^^unbox-c-ptr ] dip
<##add>
##add,
] { } make ;
: rewrite-unbox-any-c-ptr ( insn -- insn/f )

8
basis/compiler/cfg/value-numbering/math/math.factor
View File

@ -136,8 +136,8 @@ M: ##mul-imm rewrite
{ [ dup mul-to-neg? ] [ mul-to-neg ] }
{ [ dup mul-to-shl? ] [ mul-to-shl ] }
{ [ dup src1>> vreg>insn ##mul-imm? ] [ \ ##mul-imm reassociate-arithmetic ] }
{ [ dup distribute-over-add? ] [ \ <##add-imm> \ <##mul-imm> distribute ] }
{ [ dup distribute-over-sub? ] [ \ <##sub-imm> \ <##mul-imm> distribute ] }
{ [ dup distribute-over-add? ] [ \ ##add-imm, \ ##mul-imm, distribute ] }
{ [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##mul-imm, distribute ] }
[ drop f ]
} cond ;
@ -173,8 +173,8 @@ M: ##shl-imm rewrite
{ [ dup src2>> 0 = ] [ identity ] }
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup src1>> vreg>insn ##shl-imm? ] [ \ ##shl-imm reassociate-shift ] }
{ [ dup distribute-over-add? ] [ \ <##add-imm> \ <##shl-imm> distribute ] }
{ [ dup distribute-over-sub? ] [ \ <##sub-imm> \ <##shl-imm> distribute ] }
{ [ dup distribute-over-add? ] [ \ ##add-imm, \ ##shl-imm, distribute ] }
{ [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##shl-imm, distribute ] }
[ drop f ]
} cond ;