diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index dca9d01fa9..c3049b8d0f 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -112,7 +112,7 @@ M: #alien-invoke emit-node [ caller-stack-frame ] [ caller-linkage ] } cleave - ##alien-invoke + <##alien-invoke> ] [ caller-return ] bi ; @@ -124,7 +124,7 @@ M: #alien-indirect emit-node ( node -- ) [ caller-parameters ] [ prepare-caller-return ] [ caller-stack-frame ] tri - ##alien-indirect + <##alien-indirect> ] [ caller-return ] bi ; @@ -137,7 +137,7 @@ M: #alien-assembly emit-node [ prepare-caller-return ] [ caller-stack-frame ] [ quot>> ] - } cleave ##alien-assembly + } cleave <##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 ] diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor index b336d302f5..0239b7e5db 100644 --- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor +++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor @@ -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 ; diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor index a480b2799a..aebc799451 100644 --- a/basis/compiler/cfg/builder/blocks/blocks.factor +++ b/basis/compiler/cfg/builder/blocks/blocks.factor @@ -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 ; diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 5f933e096b..e820962397 100644 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -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 ; diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor index 8213c577e1..f309db51e3 100644 --- a/basis/compiler/cfg/gc-checks/gc-checks.factor +++ b/basis/compiler/cfg/gc-checks/gc-checks.factor @@ -85,7 +85,7 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ; : ( -- bb ) - [ ##call-gc ##branch ] V{ } make + [ <##call-gc> <##branch> ] V{ } make >>instructions t >>unlikely? ; :: connect-gc-checks ( bbs -- ) diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index bed856ab9b..0c4239f826 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -23,7 +23,7 @@ IN: compiler.cfg.hats [ drop [ ] ] } case swap [ dip ] curry compose ] reduce - ] keep suffix ; + ] keep insn-ctor-name "compiler.cfg.instructions" lookup-word suffix ; : hat-effect ( insn -- effect ) "insn-slots" word-prop diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor index e52b8d5878..c5109908dc 100644 --- a/basis/compiler/cfg/instructions/syntax/syntax.factor +++ b/basis/compiler/cfg/instructions/syntax/syntax.factor @@ -71,8 +71,11 @@ TUPLE: insn-slot-spec type name rep ; : define-insn-tuple ( class superclass specs -- ) [ name>> ] map "insn#" suffix define-tuple-class ; +: insn-ctor-name ( word -- name ) + name>> "<" ">" surround ; + : define-insn-ctor ( class specs -- ) - [ dup '[ _ ] [ f ] [ boa , ] surround ] dip + [ [ insn-ctor-name create-in ] [ '[ _ ] [ f ] [ boa , ] surround ] bi ] dip [ name>> ] map { } define-declared ; : define-insn ( class superclass specs -- ) diff --git a/basis/compiler/cfg/intrinsics/alien/alien.factor b/basis/compiler/cfg/intrinsics/alien/alien.factor index 23143b2f86..c58b71cc21 100644 --- a/basis/compiler/cfg/intrinsics/alien/alien.factor +++ b/basis/compiler/cfg/intrinsics/alien/alien.factor @@ -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 diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor index 72816bde7f..1683144fa2 100644 --- a/basis/compiler/cfg/intrinsics/allot/allot.factor +++ b/basis/compiler/cfg/intrinsics/allot/allot.factor @@ -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-? ( 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- ( node -- ) diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index 6b87ca8fd6..6de6d51d19 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -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 ; @@ -77,4 +77,4 @@ IN: compiler.cfg.intrinsics.fixnum [ ^^fixnum-sub ] \ fixnum-overflow emit-fixnum-overflow-op ; : emit-fixnum* ( -- ) - [ ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ; \ No newline at end of file + [ ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ; diff --git a/basis/compiler/cfg/intrinsics/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor index 62bb15f953..fae7bf68de 100644 --- a/basis/compiler/cfg/intrinsics/misc/misc.factor +++ b/basis/compiler/cfg/intrinsics/misc/misc.factor @@ -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 ; diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor index 9d15feb96f..5054b4f148 100644 --- a/basis/compiler/cfg/intrinsics/simd/simd.factor +++ b/basis/compiler/cfg/intrinsics/simd/simd.factor @@ -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 diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index a3f532b4db..280d060908 100644 --- a/basis/compiler/cfg/intrinsics/slots/slots.factor +++ b/basis/compiler/cfg/intrinsics/slots/slots.factor @@ -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 diff --git a/basis/compiler/cfg/intrinsics/strings/strings.factor b/basis/compiler/cfg/intrinsics/strings/strings.factor index 70d8442a2b..f8ca02d3d6 100644 --- a/basis/compiler/cfg/intrinsics/strings/strings.factor +++ b/basis/compiler/cfg/intrinsics/strings/strings.factor @@ -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> ; diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 96235b6807..12d41704fe 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -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 ; diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index 564c2978f5..f659261ecb 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -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 ] [ diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.factor index ef4bada633..ee7a3c1889 100644 --- a/basis/compiler/cfg/parallel-copy/parallel-copy.factor +++ b/basis/compiler/cfg/parallel-copy/parallel-copy.factor @@ -58,4 +58,4 @@ PRIVATE> ] with-scope ; inline : parallel-copy ( mapping -- ) - next-vreg [ any-rep ##copy ] parallel-mapping ; \ No newline at end of file + next-vreg [ any-rep <##copy> ] parallel-mapping ; diff --git a/basis/compiler/cfg/representations/conversion/conversion.factor b/basis/compiler/cfg/representations/conversion/conversion.factor index b8346fed6a..d3b220e94c 100644 --- a/basis/compiler/cfg/representations/conversion/conversion.factor +++ b/basis/compiler/cfg/representations/conversion/conversion.factor @@ -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 ] diff --git a/basis/compiler/cfg/representations/peephole/peephole.factor b/basis/compiler/cfg/representations/peephole/peephole.factor index d86259971f..1db344f848 100644 --- a/basis/compiler/cfg/representations/peephole/peephole.factor +++ b/basis/compiler/cfg/representations/peephole/peephole.factor @@ -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 { diff --git a/basis/compiler/cfg/ssa/cssa/cssa.factor b/basis/compiler/cfg/ssa/cssa/cssa.factor index ed2046bdaa..b42f0c7051 100644 --- a/basis/compiler/cfg/ssa/cssa/cssa.factor +++ b/basis/compiler/cfg/ssa/cssa/cssa.factor @@ -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 ; @@ -31,4 +31,4 @@ IN: compiler.cfg.ssa.cssa dup dst>> rep-of '[ [ _ insert-copy ] assoc-map ] change-inputs drop ; : construct-cssa ( cfg -- ) - [ [ convert-phi ] each-phi ] each-basic-block ; \ No newline at end of file + [ [ convert-phi ] each-phi ] each-basic-block ; diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor index a35d82bbb5..230995f039 100644 --- a/basis/compiler/cfg/stacks/finalize/finalize.factor +++ b/basis/compiler/cfg/stacks/finalize/finalize.factor @@ -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 ; diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor index 95feb4c034..508a91cb68 100644 --- a/basis/compiler/cfg/stacks/local/local.factor +++ b/basis/compiler/cfg/stacks/local/local.factor @@ -45,8 +45,8 @@ M: rs-loc translate-local-loc n>> current-height get r>> - ; : 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 diff --git a/basis/compiler/cfg/value-numbering/alien/alien.factor b/basis/compiler/cfg/value-numbering/alien/alien.factor index 58674602d9..5695aff0d2 100644 --- a/basis/compiler/cfg/value-numbering/alien/alien.factor +++ b/basis/compiler/cfg/value-numbering/alien/alien.factor @@ -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 ) diff --git a/basis/compiler/cfg/value-numbering/math/math.factor b/basis/compiler/cfg/value-numbering/math/math.factor index c2f63692ac..1fb37f8705 100644 --- a/basis/compiler/cfg/value-numbering/math/math.factor +++ b/basis/compiler/cfg/value-numbering/math/math.factor @@ -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 ;