diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 8754b65475..572107be6c 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -28,10 +28,12 @@ SYMBOL: pending-interval-assoc : remove-pending ( live-interval -- ) vreg>> pending-interval-assoc get delete-at ; +ERROR: bad-vreg vreg ; + : (vreg>reg) ( vreg pending -- reg ) ! If a live vreg is not in the pending set, then it must ! have been spilled. - ?at [ spill-slots get at ] unless ; + ?at [ spill-slots get ?at [ ] [ bad-vreg ] if ] unless ; : vreg>reg ( vreg -- reg ) pending-interval-assoc get (vreg>reg) ; @@ -157,8 +159,6 @@ M: insn assign-registers-in-insn drop ; : end-block ( bb -- ) [ live-out vregs>regs ] keep register-live-outs get set-at ; -ERROR: bad-vreg vreg ; - : vreg-at-start ( vreg bb -- state ) register-live-ins get at ?at [ bad-vreg ] unless ; diff --git a/basis/compiler/cfg/linear-scan/numbering/numbering.factor b/basis/compiler/cfg/linear-scan/numbering/numbering.factor index 6fd97c64da..44b2ff907a 100644 --- a/basis/compiler/cfg/linear-scan/numbering/numbering.factor +++ b/basis/compiler/cfg/linear-scan/numbering/numbering.factor @@ -4,12 +4,18 @@ USING: kernel accessors math sequences grouping namespaces compiler.cfg.linearization.order ; IN: compiler.cfg.linear-scan.numbering -: number-instructions ( rpo -- ) - linearization-order 0 [ - instructions>> [ - [ (>>insn#) ] [ drop 2 + ] 2bi - ] each - ] reduce drop ; +ERROR: already-numbered insn ; + +: number-instruction ( n insn -- n' ) + [ nip dup insn#>> [ already-numbered ] [ drop ] if ] + [ (>>insn#) ] + [ drop 2 + ] + 2tri ; + +: number-instructions ( cfg -- ) + linearization-order + 0 [ instructions>> [ number-instruction ] each ] reduce + drop ; SYMBOL: check-numbering? diff --git a/basis/compiler/cfg/linearization/order/order-tests.factor b/basis/compiler/cfg/linearization/order/order-tests.factor new file mode 100644 index 0000000000..34eaeffd9a --- /dev/null +++ b/basis/compiler/cfg/linearization/order/order-tests.factor @@ -0,0 +1,14 @@ +USING: compiler.cfg.debugger compiler.cfg compiler.cfg.linearization.order +kernel accessors sequences sets tools.test ; +IN: compiler.cfg.linearization.order.tests + +V{ } 0 test-bb + +V{ } 1 test-bb + +V{ } 2 test-bb + +0 { 1 1 } edges +1 2 edge + +[ t ] [ cfg new 0 get >>entry linearization-order [ id>> ] map all-unique? ] unit-test diff --git a/basis/compiler/cfg/linearization/order/order.factor b/basis/compiler/cfg/linearization/order/order.factor index 703db8e516..1fcc137c60 100644 --- a/basis/compiler/cfg/linearization/order/order.factor +++ b/basis/compiler/cfg/linearization/order/order.factor @@ -3,7 +3,7 @@ USING: accessors assocs deques dlists kernel make sorting namespaces sequences combinators combinators.short-circuit fry math sets compiler.cfg.rpo compiler.cfg.utilities -compiler.cfg.loop-detection ; +compiler.cfg.loop-detection compiler.cfg.predecessors ; IN: compiler.cfg.linearization.order ! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp @@ -56,10 +56,12 @@ SYMBOLS: work-list loop-heads visited ; successors>> [ loop-nesting-at ] sort-with ; : process-block ( bb -- ) - [ , ] - [ visited get conjoin ] - [ sorted-successors [ process-successor ] each ] - tri ; + dup visited? [ drop ] [ + [ , ] + [ visited get conjoin ] + [ sorted-successors [ process-successor ] each ] + tri + ] if ; : (linearization-order) ( cfg -- bbs ) init-linearization-order @@ -69,7 +71,7 @@ SYMBOLS: work-list loop-heads visited ; PRIVATE> : linearization-order ( cfg -- bbs ) - needs-post-order needs-loops + needs-post-order needs-loops needs-predecessors dup linear-order>> [ ] [ dup (linearization-order) diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 56e368e320..14ed2294c7 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -416,3 +416,18 @@ cell 4 = [ [ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test [ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test + +! Bug in linearization +[ 283686952174081 ] [ + B{ 1 1 1 1 } [ + { byte-array } declare + [ 0 2 ] dip + [ + [ drop ] 2dip + [ + swap 1 < [ [ ] dip ] [ [ ] dip ] if + 0 alien-signed-4 + ] curry dup bi * + ] curry each-integer + ] compile-call +] unit-test