72 lines
		
	
	
		
			1.8 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			72 lines
		
	
	
		
			1.8 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2009 Slava Pestov.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: assocs compiler.cfg.instructions compiler.cfg.registers
 | 
						|
compiler.cfg.ssa.destruction.leaders cpu.architecture deques
 | 
						|
dlists fry kernel locals make namespaces sequences ;
 | 
						|
QUALIFIED: sets
 | 
						|
IN: compiler.cfg.parallel-copy
 | 
						|
 | 
						|
<PRIVATE
 | 
						|
 | 
						|
SYMBOLS: locs preds to-do ready ;
 | 
						|
 | 
						|
: init-to-do ( bs -- )
 | 
						|
    to-do get push-all-back ;
 | 
						|
 | 
						|
: init-ready ( bs -- )
 | 
						|
    locs get '[ _ key? ] reject ready get push-all-front ;
 | 
						|
 | 
						|
: init ( mapping -- )
 | 
						|
    <dlist> to-do set
 | 
						|
    <dlist> ready set
 | 
						|
    [ preds set ]
 | 
						|
    [ [ nip dup ] H{ } assoc-map-as locs set ]
 | 
						|
    [ keys [ init-to-do ] [ init-ready ] bi ] tri ;
 | 
						|
 | 
						|
:: process-ready ( b quot: ( dst src -- ) -- )
 | 
						|
    b preds get at :> a
 | 
						|
    a locs get at :> c
 | 
						|
    b c quot call
 | 
						|
    b a locs get set-at
 | 
						|
    a c = a preds get at and [ a ready get push-front ] when ; inline
 | 
						|
 | 
						|
:: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- )
 | 
						|
    b locs get at b = [
 | 
						|
        b temp call :> temp
 | 
						|
        temp b quot call
 | 
						|
        temp b locs get set-at
 | 
						|
        b ready get push-front
 | 
						|
    ] when ; inline
 | 
						|
 | 
						|
PRIVATE>
 | 
						|
 | 
						|
:: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
 | 
						|
    [
 | 
						|
        mapping init
 | 
						|
        to-do get [
 | 
						|
            ready get [
 | 
						|
                quot process-ready
 | 
						|
            ] slurp-deque
 | 
						|
            temp quot process-to-do
 | 
						|
        ] slurp-deque
 | 
						|
    ] with-scope ; inline
 | 
						|
 | 
						|
: parallel-copy ( mapping -- insns )
 | 
						|
    [ next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ] { } make ;
 | 
						|
 | 
						|
<PRIVATE
 | 
						|
 | 
						|
SYMBOL: temp-vregs
 | 
						|
 | 
						|
: temp-vreg ( rep -- vreg )
 | 
						|
    temp-vregs get [ next-vreg-rep ] cache
 | 
						|
    [ leader-map get sets:conjoin ] keep ;
 | 
						|
 | 
						|
PRIVATE>
 | 
						|
 | 
						|
: parallel-copy-rep ( mapping -- insns )
 | 
						|
    [
 | 
						|
        H{ } clone temp-vregs set
 | 
						|
        [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping
 | 
						|
    ] { } make ;
 |