compiler.cfg.intrinsics.fixnum: don't generate -imm forms anymore since value numbering does it
							parent
							
								
									73a2222541
								
							
						
					
					
						commit
						a75d558b30
					
				| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: sequences accessors layouts kernel math namespaces
 | 
			
		||||
combinators fry locals
 | 
			
		||||
combinators fry
 | 
			
		||||
compiler.tree.propagation.info
 | 
			
		||||
compiler.cfg.hats
 | 
			
		||||
compiler.cfg.stacks
 | 
			
		||||
| 
						 | 
				
			
			@ -21,32 +21,8 @@ IN: compiler.cfg.intrinsics.fixnum
 | 
			
		|||
: tag-literal ( n -- tagged )
 | 
			
		||||
    literal>> [ tag-fixnum ] [ \ f tag-number ] if* ;
 | 
			
		||||
 | 
			
		||||
: emit-fixnum-imm-op1 ( infos insn -- dst )
 | 
			
		||||
    [ ds-pop ds-drop ] [ first tag-literal ] [ ] tri* call ; inline
 | 
			
		||||
 | 
			
		||||
: emit-fixnum-imm-op2 ( infos insn -- dst )
 | 
			
		||||
    [ ds-drop ds-pop ] [ second tag-literal ] [ ] tri* call ; inline
 | 
			
		||||
 | 
			
		||||
: (emit-fixnum-op) ( insn -- dst )
 | 
			
		||||
    [ 2inputs ] dip call ; inline
 | 
			
		||||
 | 
			
		||||
:: emit-fixnum-op ( node insn imm-insn -- )
 | 
			
		||||
    [let | infos [ node node-input-infos ] |
 | 
			
		||||
        infos second value-info-small-tagged?
 | 
			
		||||
        [ infos imm-insn emit-fixnum-imm-op2 ]
 | 
			
		||||
        [ insn (emit-fixnum-op) ] if
 | 
			
		||||
        ds-push
 | 
			
		||||
    ] ; inline
 | 
			
		||||
 | 
			
		||||
:: emit-commutative-fixnum-op ( node insn imm-insn -- )
 | 
			
		||||
    [let | infos [ node node-input-infos ] |
 | 
			
		||||
        {
 | 
			
		||||
            { [ infos first value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op1 ] }
 | 
			
		||||
            { [ infos second value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op2 ] }
 | 
			
		||||
            [ insn (emit-fixnum-op) ]
 | 
			
		||||
        } cond
 | 
			
		||||
        ds-push
 | 
			
		||||
    ] ; inline
 | 
			
		||||
: emit-fixnum-op ( insn -- dst )
 | 
			
		||||
    [ 2inputs ] dip call ds-push ; inline
 | 
			
		||||
 | 
			
		||||
: emit-fixnum-shift-fast ( node -- )
 | 
			
		||||
    dup node-input-infos dup second value-info-small-fixnum? [
 | 
			
		||||
| 
						 | 
				
			
			@ -66,34 +42,11 @@ IN: compiler.cfg.intrinsics.fixnum
 | 
			
		|||
: emit-fixnum-log2 ( -- )
 | 
			
		||||
    ds-pop ^^log2 tag-bits get ^^sub-imm ^^tag-fixnum ds-push ;
 | 
			
		||||
 | 
			
		||||
: (emit-fixnum*fast) ( -- dst )
 | 
			
		||||
    2inputs ^^untag-fixnum ^^mul ;
 | 
			
		||||
: emit-fixnum*fast ( -- )
 | 
			
		||||
    2inputs ^^untag-fixnum ^^mul ds-push ;
 | 
			
		||||
 | 
			
		||||
: (emit-fixnum*fast-imm1) ( infos -- dst )
 | 
			
		||||
    [ ds-pop ds-drop ] [ first literal>> ] bi* ^^mul-imm ;
 | 
			
		||||
 | 
			
		||||
: (emit-fixnum*fast-imm2) ( infos -- dst )
 | 
			
		||||
    [ ds-drop ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
 | 
			
		||||
 | 
			
		||||
: emit-fixnum*fast ( node -- )
 | 
			
		||||
    node-input-infos
 | 
			
		||||
    dup first value-info-small-fixnum? drop f
 | 
			
		||||
    [
 | 
			
		||||
        (emit-fixnum*fast-imm1)
 | 
			
		||||
    ] [
 | 
			
		||||
        dup second value-info-small-fixnum?
 | 
			
		||||
        [ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if
 | 
			
		||||
    ] if
 | 
			
		||||
    ds-push ;
 | 
			
		||||
 | 
			
		||||
: (emit-fixnum-comparison) ( cc -- quot1 quot2 )
 | 
			
		||||
    [ ^^compare ] [ ^^compare-imm ] bi-curry ; inline
 | 
			
		||||
 | 
			
		||||
: emit-eq ( node -- )
 | 
			
		||||
    cc= (emit-fixnum-comparison) emit-commutative-fixnum-op ;
 | 
			
		||||
 | 
			
		||||
: emit-fixnum-comparison ( node cc -- )
 | 
			
		||||
    (emit-fixnum-comparison) emit-fixnum-op ;
 | 
			
		||||
: emit-fixnum-comparison ( cc -- )
 | 
			
		||||
    '[ _ ^^compare ] emit-fixnum-op ;
 | 
			
		||||
 | 
			
		||||
: emit-bignum>fixnum ( -- )
 | 
			
		||||
    ds-pop ^^bignum>integer ^^tag-fixnum ds-push ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -103,20 +103,20 @@ IN: compiler.cfg.intrinsics
 | 
			
		|||
        { \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] }
 | 
			
		||||
        { \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] }
 | 
			
		||||
        { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] }
 | 
			
		||||
        { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-commutative-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-commutative-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-commutative-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-commutative-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
 | 
			
		||||
        { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
 | 
			
		||||
        { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
 | 
			
		||||
        { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
 | 
			
		||||
        { \ math.private:fixnum*fast [ emit-fixnum*fast ] }
 | 
			
		||||
        { \ math.private:fixnum< [ cc< emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:fixnum> [ cc> emit-fixnum-comparison ] }
 | 
			
		||||
        { \ kernel:eq? [ emit-eq ] }
 | 
			
		||||
        { \ math.private:fixnum*fast [ drop emit-fixnum*fast ] }
 | 
			
		||||
        { \ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
 | 
			
		||||
        { \ kernel:eq? [ drop cc= emit-fixnum-comparison ] }
 | 
			
		||||
        { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] }
 | 
			
		||||
        { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] }
 | 
			
		||||
        { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue