fix bug in rewriting #add -- wasn't checking small-enough?, and change negative adds to subtractions/negative subtractions to adds
							parent
							
								
									2cb94598b3
								
							
						
					
					
						commit
						80eb5068e2
					
				| 
						 | 
				
			
			@ -1,11 +1,11 @@
 | 
			
		|||
! Copyright (C) 2008 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2008 Slava Pestov, Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors combinators combinators.short-circuit
 | 
			
		||||
compiler.cfg.hats compiler.cfg.instructions
 | 
			
		||||
arrays compiler.cfg.hats compiler.cfg.instructions
 | 
			
		||||
compiler.cfg.value-numbering.expressions
 | 
			
		||||
compiler.cfg.value-numbering.graph
 | 
			
		||||
compiler.cfg.value-numbering.simplify fry kernel layouts math
 | 
			
		||||
namespaces sequences cpu.architecture math.bitwise locals ;
 | 
			
		||||
namespaces sequences cpu.architecture math.bitwise ;
 | 
			
		||||
IN: compiler.cfg.value-numbering.rewrite
 | 
			
		||||
 | 
			
		||||
GENERIC: rewrite ( insn -- insn' )
 | 
			
		||||
| 
						 | 
				
			
			@ -113,38 +113,45 @@ M: ##compare-imm rewrite
 | 
			
		|||
        ] when
 | 
			
		||||
    ] when ;
 | 
			
		||||
 | 
			
		||||
: (new-imm-insn) ( insn dst src1 n op -- new-insn/insn )
 | 
			
		||||
    [ cell-bits bits ] dip over small-enough? [
 | 
			
		||||
        new-insn dup number-values nip
 | 
			
		||||
    ] [
 | 
			
		||||
        2drop 2drop
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
 | 
			
		||||
: new-imm-insn ( insn dst src n op -- n' op' )
 | 
			
		||||
    2dup [ sgn ] dip 2array
 | 
			
		||||
    {
 | 
			
		||||
        { { -1 ##add-imm } [ drop neg \ ##sub-imm (new-imm-insn) ] }
 | 
			
		||||
        { { -1 ##sub-imm } [ drop neg \ ##add-imm (new-imm-insn) ] }
 | 
			
		||||
        [ drop (new-imm-insn) ]
 | 
			
		||||
    } case ; inline
 | 
			
		||||
 | 
			
		||||
: combine-imm? ( insn op -- ? )
 | 
			
		||||
    [ src1>> vreg>expr op>> ] dip = ;
 | 
			
		||||
 | 
			
		||||
:: combine-imm ( insn quot op -- insn )
 | 
			
		||||
    insn
 | 
			
		||||
: combine-imm ( insn quot op -- insn )
 | 
			
		||||
    [
 | 
			
		||||
        {
 | 
			
		||||
            [ ]
 | 
			
		||||
            [ dst>> ]
 | 
			
		||||
            [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
 | 
			
		||||
    [ src2>> ] tri
 | 
			
		||||
 | 
			
		||||
    quot call cell-bits bits
 | 
			
		||||
 | 
			
		||||
    dup small-enough? [
 | 
			
		||||
        op new-insn dup number-values
 | 
			
		||||
    ] [
 | 
			
		||||
        3drop insn
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
            [ src2>> ]
 | 
			
		||||
        } cleave
 | 
			
		||||
    ] [ call ] [ ] tri* new-imm-insn ; inline
 | 
			
		||||
 | 
			
		||||
M: ##add-imm rewrite
 | 
			
		||||
    {
 | 
			
		||||
        { [ dup \ ##add-imm combine-imm? ]
 | 
			
		||||
            [ [ + ] \ ##add-imm combine-imm ] }
 | 
			
		||||
        { [ dup \ ##sub-imm combine-imm? ]
 | 
			
		||||
            [ [ - ] \ ##sub-imm combine-imm ] }
 | 
			
		||||
        { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm combine-imm ] }
 | 
			
		||||
        { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm combine-imm ] }
 | 
			
		||||
        [ ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
 | 
			
		||||
M: ##sub-imm rewrite
 | 
			
		||||
    {
 | 
			
		||||
        { [ dup \ ##add-imm combine-imm? ]
 | 
			
		||||
            [ [ - ] \ ##add-imm combine-imm ] }
 | 
			
		||||
        { [ dup \ ##sub-imm combine-imm? ]
 | 
			
		||||
            [ [ + ] \ ##sub-imm combine-imm ] }
 | 
			
		||||
        { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm combine-imm ] }
 | 
			
		||||
        { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm combine-imm ] }
 | 
			
		||||
        [ ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -169,8 +176,14 @@ M: ##xor-imm rewrite
 | 
			
		|||
    dup \ ##xor-imm combine-imm?
 | 
			
		||||
    [ [ bitxor ] \ ##xor-imm combine-imm ] when ;
 | 
			
		||||
 | 
			
		||||
: rewrite-add>add-imm? ( insn -- ? )
 | 
			
		||||
    src2>> {
 | 
			
		||||
        [ vreg>expr constant-expr? ]
 | 
			
		||||
        [ vreg>constant small-enough? ]
 | 
			
		||||
    } 1&& ;
 | 
			
		||||
 | 
			
		||||
M: ##add rewrite
 | 
			
		||||
    dup src2>> vreg>expr constant-expr? [
 | 
			
		||||
    dup rewrite-add>add-imm? [
 | 
			
		||||
        [ dst>> ]
 | 
			
		||||
        [ src1>> ]
 | 
			
		||||
        [ src2>> vreg>constant ] tri \ ##add-imm new-insn
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue