compiler.cfg: add ##load-memory and ##store-memory instructions implementing complex addressing modes, and associated value numbering optimizations
							parent
							
								
									b8d556514c
								
							
						
					
					
						commit
						378c2b2a46
					
				| 
						 | 
				
			
			@ -553,11 +553,20 @@ def: dst/int-rep
 | 
			
		|||
use: src/tagged-rep ;
 | 
			
		||||
 | 
			
		||||
! Raw memory accessors
 | 
			
		||||
INSN: ##load-memory
 | 
			
		||||
def: dst
 | 
			
		||||
use: base/int-rep displacement/int-rep
 | 
			
		||||
literal: scale offset rep c-type ;
 | 
			
		||||
 | 
			
		||||
INSN: ##load-memory-imm
 | 
			
		||||
def: dst
 | 
			
		||||
use: base/int-rep
 | 
			
		||||
literal: offset rep c-type ;
 | 
			
		||||
 | 
			
		||||
INSN: ##store-memory
 | 
			
		||||
use: src base/int-rep displacement/int-rep
 | 
			
		||||
literal: scale offset rep c-type ;
 | 
			
		||||
 | 
			
		||||
INSN: ##store-memory-imm
 | 
			
		||||
use: src base/int-rep
 | 
			
		||||
literal: offset rep c-type ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,7 @@
 | 
			
		|||
! Copyright (C) 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors fry kernel make math
 | 
			
		||||
USING: accessors combinators combinators.short-circuit fry
 | 
			
		||||
kernel make math sequences
 | 
			
		||||
compiler.cfg.hats
 | 
			
		||||
compiler.cfg.instructions
 | 
			
		||||
compiler.cfg.registers
 | 
			
		||||
| 
						 | 
				
			
			@ -28,12 +29,81 @@ M: ##unbox-any-c-ptr rewrite
 | 
			
		|||
    dup src>> vreg>expr dup box-displaced-alien-expr?
 | 
			
		||||
    [ rewrite-unbox-displaced-alien ] [ 2drop f ] if ;
 | 
			
		||||
 | 
			
		||||
! More efficient addressing for alien intrinsics
 | 
			
		||||
: rewrite-alien-addressing ( insn -- insn' )
 | 
			
		||||
    dup base>> vreg>expr dup add-imm-expr? [
 | 
			
		||||
        [ src1>> vn>vreg ] [ src2>> vn>integer ] bi
 | 
			
		||||
        [ >>base ] [ '[ _ + ] change-offset ] bi*
 | 
			
		||||
    ] [ 2drop f ] if ;
 | 
			
		||||
! Fuse ##add-imm into ##load-memory(-imm) and ##store-memory(-imm)
 | 
			
		||||
! just update the offset in the instruction
 | 
			
		||||
: fuse-base-offset? ( insn -- ? )
 | 
			
		||||
    base>> vreg>expr add-imm-expr? ;
 | 
			
		||||
 | 
			
		||||
M: ##load-memory-imm rewrite rewrite-alien-addressing ;
 | 
			
		||||
M: ##store-memory-imm rewrite rewrite-alien-addressing ;
 | 
			
		||||
: fuse-base-offset ( insn -- insn' )
 | 
			
		||||
    dup base>> vreg>expr
 | 
			
		||||
    [ src1>> vn>vreg ] [ src2>> vn>integer ] bi
 | 
			
		||||
    [ >>base ] [ '[ _ + ] change-offset ] bi* ;
 | 
			
		||||
 | 
			
		||||
! Fuse ##add-imm into ##load-memory and ##store-memory
 | 
			
		||||
! just update the offset in the instruction
 | 
			
		||||
: fuse-displacement-offset? ( insn -- ? )
 | 
			
		||||
    { [ scale>> 0 = ] [ displacement>> vreg>expr add-imm-expr? ] } 1&& ;
 | 
			
		||||
 | 
			
		||||
: fuse-displacement-offset ( insn -- insn' )
 | 
			
		||||
    dup displacement>> vreg>expr
 | 
			
		||||
    [ src1>> vn>vreg ] [ src2>> vn>integer ] bi
 | 
			
		||||
    [ >>displacement ] [ '[ _ + ] change-offset ] bi* ;
 | 
			
		||||
 | 
			
		||||
! Fuse ##add into ##load-memory-imm and ##store-memory-imm
 | 
			
		||||
! construct a new ##load-memory or ##store-memory with the
 | 
			
		||||
! ##add's operand as the displacement
 | 
			
		||||
: fuse-displacement? ( insn -- ? )
 | 
			
		||||
    base>> vreg>expr add-expr? ;
 | 
			
		||||
 | 
			
		||||
GENERIC: alien-insn-value ( insn -- value )
 | 
			
		||||
 | 
			
		||||
M: ##load-memory-imm alien-insn-value dst>> ;
 | 
			
		||||
M: ##store-memory-imm alien-insn-value src>> ;
 | 
			
		||||
 | 
			
		||||
GENERIC: new-alien-insn ( value base displacement scale offset rep c-type insn -- insn )
 | 
			
		||||
 | 
			
		||||
M: ##load-memory-imm new-alien-insn drop \ ##load-memory new-insn ;
 | 
			
		||||
M: ##store-memory-imm new-alien-insn drop \ ##store-memory new-insn ;
 | 
			
		||||
 | 
			
		||||
: fuse-displacement ( insn -- insn' )
 | 
			
		||||
    {
 | 
			
		||||
        [ alien-insn-value ]
 | 
			
		||||
        [ base>> vreg>expr [ src1>> vn>vreg ] [ src2>> vn>vreg ] bi ]
 | 
			
		||||
        [ drop 0 ]
 | 
			
		||||
        [ offset>> ]
 | 
			
		||||
        [ rep>> ]
 | 
			
		||||
        [ c-type>> ]
 | 
			
		||||
        [ ]
 | 
			
		||||
    } cleave new-alien-insn ;
 | 
			
		||||
 | 
			
		||||
! Fuse ##shl-imm into ##load-memory or ##store-memory
 | 
			
		||||
: scale-expr? ( expr -- ? )
 | 
			
		||||
    { [ shl-imm-expr? ] [ src2>> vn>integer { 1 2 3 } member? ] } 1&& ;
 | 
			
		||||
 | 
			
		||||
: fuse-scale? ( insn -- ? )
 | 
			
		||||
    { [ scale>> 0 = ] [ displacement>> vreg>expr scale-expr? ] } 1&& ;
 | 
			
		||||
 | 
			
		||||
: fuse-scale ( insn -- insn' )
 | 
			
		||||
    dup displacement>> vreg>expr
 | 
			
		||||
    [ src1>> vn>vreg ] [ src2>> vn>integer ] bi
 | 
			
		||||
    [ >>displacement ] [ >>scale ] bi* ;
 | 
			
		||||
 | 
			
		||||
: rewrite-memory-op ( insn -- insn/f )
 | 
			
		||||
    {
 | 
			
		||||
        { [ dup fuse-base-offset? ] [ fuse-base-offset ] }
 | 
			
		||||
        { [ dup fuse-displacement-offset? ] [ fuse-displacement-offset ] }
 | 
			
		||||
        { [ dup fuse-scale? ] [ fuse-scale ] }
 | 
			
		||||
        [ drop f ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
 | 
			
		||||
: rewrite-memory-imm-op ( insn -- insn/f )
 | 
			
		||||
    {
 | 
			
		||||
        { [ dup fuse-base-offset? ] [ fuse-base-offset ] }
 | 
			
		||||
        { [ dup fuse-displacement? ] [ fuse-displacement ] }
 | 
			
		||||
        [ drop f ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
 | 
			
		||||
M: ##load-memory rewrite rewrite-memory-op ;
 | 
			
		||||
M: ##load-memory-imm rewrite rewrite-memory-imm-op ;
 | 
			
		||||
M: ##store-memory rewrite rewrite-memory-op ;
 | 
			
		||||
M: ##store-memory-imm rewrite rewrite-memory-imm-op ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2229,6 +2229,8 @@ cpu x86? [
 | 
			
		|||
] when
 | 
			
		||||
 | 
			
		||||
! Alien addressing optimization
 | 
			
		||||
 | 
			
		||||
! Base offset fusion on ##load/store-memory-imm
 | 
			
		||||
[
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 1 D 0 }
 | 
			
		||||
| 
						 | 
				
			
			@ -2264,3 +2266,144 @@ cpu x86? [
 | 
			
		|||
        T{ ##store-memory-imm f 2 4 0 int-rep c:uchar }
 | 
			
		||||
    } value-numbering-step
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Displacement fusion on ##load/store-memory-imm
 | 
			
		||||
[
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add f 4 2 3 }
 | 
			
		||||
        T{ ##load-memory f 5 2 3 0 0 int-rep c:uchar }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add f 4 2 3 }
 | 
			
		||||
        T{ ##load-memory-imm f 5 4 0 int-rep c:uchar }
 | 
			
		||||
    } value-numbering-step
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add f 4 2 3 }
 | 
			
		||||
        T{ ##store-memory f 5 2 3 0 0 int-rep c:uchar }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add f 4 2 3 }
 | 
			
		||||
        T{ ##store-memory-imm f 5 4 0 int-rep c:uchar }
 | 
			
		||||
    } value-numbering-step
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Base offset fusion on ##load/store-memory
 | 
			
		||||
[
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add-imm f 4 2 31337 }
 | 
			
		||||
        T{ ##load-memory f 5 2 3 0 31337 int-rep c:uchar }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add-imm f 4 2 31337 }
 | 
			
		||||
        T{ ##load-memory f 5 4 3 0 0 int-rep c:uchar }
 | 
			
		||||
    } value-numbering-step
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Displacement offset fusion on ##load/store-memory
 | 
			
		||||
[
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add-imm f 4 3 31337 }
 | 
			
		||||
        T{ ##load-memory f 5 2 3 0 31338 int-rep c:uchar }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add-imm f 4 3 31337 }
 | 
			
		||||
        T{ ##load-memory f 5 2 4 0 1 int-rep c:uchar }
 | 
			
		||||
    } value-numbering-step
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Displacement offset fusion should not occur on
 | 
			
		||||
! ##load/store-memory with non-zero scale
 | 
			
		||||
[ ] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##add-imm f 4 3 10 }
 | 
			
		||||
        T{ ##load-memory f 5 2 4 1 1 int-rep c:uchar }
 | 
			
		||||
    } dup value-numbering-step assert=
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Scale fusion on ##load/store-memory
 | 
			
		||||
[
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##shl-imm f 4 3 2 }
 | 
			
		||||
        T{ ##load-memory f 5 2 3 2 0 int-rep c:uchar }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##shl-imm f 4 3 2 }
 | 
			
		||||
        T{ ##load-memory f 5 2 4 0 0 int-rep c:uchar }
 | 
			
		||||
    } value-numbering-step
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Don't do scale fusion if there's already a scale
 | 
			
		||||
[ ] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##shl-imm f 4 3 2 }
 | 
			
		||||
        T{ ##load-memory f 5 2 4 1 0 int-rep c:uchar }
 | 
			
		||||
    } dup value-numbering-step assert=
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Don't do scale fusion if the scale factor is out of range
 | 
			
		||||
[ ] [
 | 
			
		||||
    V{
 | 
			
		||||
        T{ ##peek f 0 D 0 }
 | 
			
		||||
        T{ ##peek f 1 D 1 }
 | 
			
		||||
        T{ ##tagged>integer f 2 0 }
 | 
			
		||||
        T{ ##tagged>integer f 3 1 }
 | 
			
		||||
        T{ ##shl-imm f 4 3 4 }
 | 
			
		||||
        T{ ##load-memory f 5 2 4 0 0 int-rep c:uchar }
 | 
			
		||||
    } dup value-numbering-step assert=
 | 
			
		||||
] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -187,7 +187,9 @@ CODEGEN: ##box-alien %box-alien
 | 
			
		|||
CODEGEN: ##box-displaced-alien %box-displaced-alien
 | 
			
		||||
CODEGEN: ##unbox-alien %unbox-alien
 | 
			
		||||
CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
 | 
			
		||||
CODEGEN: ##load-memory %load-memory
 | 
			
		||||
CODEGEN: ##load-memory-imm %load-memory-imm
 | 
			
		||||
CODEGEN: ##store-memory %store-memory
 | 
			
		||||
CODEGEN: ##store-memory-imm %store-memory-imm
 | 
			
		||||
CODEGEN: ##allot %allot
 | 
			
		||||
CODEGEN: ##write-barrier %write-barrier
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -435,7 +435,9 @@ HOOK: %unbox-any-c-ptr cpu ( dst src -- )
 | 
			
		|||
HOOK: %box-alien cpu ( dst src temp -- )
 | 
			
		||||
HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- )
 | 
			
		||||
 | 
			
		||||
HOOK: %load-memory cpu ( dst base displacement scale offset rep c-type -- )
 | 
			
		||||
HOOK: %load-memory-imm cpu ( dst base offset rep c-type -- )
 | 
			
		||||
HOOK: %store-memory cpu ( value base displacement scale offset rep c-type -- )
 | 
			
		||||
HOOK: %store-memory-imm cpu ( value base offset rep c-type -- )
 | 
			
		||||
 | 
			
		||||
HOOK: %alien-global cpu ( dst symbol library -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -354,26 +354,32 @@ M:: x86 %string-nth ( dst src index temp -- )
 | 
			
		|||
        dst new-dst int-rep %copy
 | 
			
		||||
    ] with-small-register ;
 | 
			
		||||
 | 
			
		||||
:: %alien-integer-getter ( dst base offset bits quot -- )
 | 
			
		||||
    dst { base } bits [| new-dst |
 | 
			
		||||
        new-dst dup bits n-bit-version-of dup base offset [+] MOV
 | 
			
		||||
:: %alien-integer-getter ( dst exclude address bits quot -- )
 | 
			
		||||
    dst exclude bits [| new-dst |
 | 
			
		||||
        new-dst dup bits n-bit-version-of dup address MOV
 | 
			
		||||
        quot call
 | 
			
		||||
        dst new-dst int-rep %copy
 | 
			
		||||
    ] with-small-register ; inline
 | 
			
		||||
 | 
			
		||||
: %alien-unsigned-getter ( dst base offset bits -- )
 | 
			
		||||
: %alien-unsigned-getter ( dst exclude address bits -- )
 | 
			
		||||
    [ MOVZX ] %alien-integer-getter ; inline
 | 
			
		||||
 | 
			
		||||
: %alien-signed-getter ( dst base offset bits -- )
 | 
			
		||||
: %alien-signed-getter ( dst exclude address bits -- )
 | 
			
		||||
    [ MOVSX ] %alien-integer-getter ; inline
 | 
			
		||||
 | 
			
		||||
:: %alien-integer-setter ( value base offset bits -- )
 | 
			
		||||
    value { base } bits [| new-value |
 | 
			
		||||
:: %alien-integer-setter ( value exclude address bits -- )
 | 
			
		||||
    value exclude bits [| new-value |
 | 
			
		||||
        new-value value int-rep %copy
 | 
			
		||||
        base offset [+] new-value bits n-bit-version-of MOV
 | 
			
		||||
        address new-value bits n-bit-version-of MOV
 | 
			
		||||
    ] with-small-register ; inline
 | 
			
		||||
 | 
			
		||||
M: x86 %load-memory-imm ( dst base offset rep c-type -- )
 | 
			
		||||
: (%memory) ( base displacement scale offset rep c-type -- exclude address rep c-type )
 | 
			
		||||
    [ [ [ 2array ] 2keep ] 2dip <indirect> ] 2dip ;
 | 
			
		||||
 | 
			
		||||
: (%memory-imm) ( base offset rep c-type -- exclude address rep c-type )
 | 
			
		||||
    [ [ drop 1array ] [ [+] ] 2bi ] 2dip ;
 | 
			
		||||
 | 
			
		||||
: (%load-memory) ( dst exclude address rep c-type -- )
 | 
			
		||||
    [
 | 
			
		||||
        {
 | 
			
		||||
            { c:char   [ 8 %alien-signed-getter ] }
 | 
			
		||||
| 
						 | 
				
			
			@ -383,9 +389,15 @@ M: x86 %load-memory-imm ( dst base offset rep c-type -- )
 | 
			
		|||
            { c:int    [ 32 [ 2drop ] %alien-integer-getter ] }
 | 
			
		||||
            { c:uint   [ 32 %alien-signed-getter ] }
 | 
			
		||||
        } case
 | 
			
		||||
    ] [ [ [+] ] dip %copy ] ?if ;
 | 
			
		||||
    ] [ [ drop ] 2dip %copy ] ?if ;
 | 
			
		||||
 | 
			
		||||
M: x86 %store-memory-imm ( src base offset rep c-type -- )
 | 
			
		||||
M: x86 %load-memory ( dst base displacement scale offset rep c-type -- )
 | 
			
		||||
    (%memory) (%load-memory) ;
 | 
			
		||||
 | 
			
		||||
M: x86 %load-memory-imm ( dst base offset rep c-type -- )
 | 
			
		||||
    (%memory-imm) (%load-memory) ;
 | 
			
		||||
 | 
			
		||||
: (%store-memory) ( src exclude address rep c-type -- )
 | 
			
		||||
    [
 | 
			
		||||
        {
 | 
			
		||||
            { c:char   [ 8 %alien-integer-setter ] }
 | 
			
		||||
| 
						 | 
				
			
			@ -395,7 +407,13 @@ M: x86 %store-memory-imm ( src base offset rep c-type -- )
 | 
			
		|||
            { c:int    [ 32 %alien-integer-setter ] }
 | 
			
		||||
            { c:uint   [ 32 %alien-integer-setter ] }
 | 
			
		||||
        } case
 | 
			
		||||
    ] [ [ [+] swap ] dip %copy ] ?if ;
 | 
			
		||||
    ] [ [ nip swap ] dip %copy ] ?if ;
 | 
			
		||||
 | 
			
		||||
M: x86 %store-memory ( src base displacement scale offset rep c-type -- )
 | 
			
		||||
    (%memory) (%store-memory) ;
 | 
			
		||||
 | 
			
		||||
M: x86 %store-memory-imm ( src base offset rep c-type -- )
 | 
			
		||||
    (%memory-imm) (%store-memory) ;
 | 
			
		||||
 | 
			
		||||
: shift-count? ( reg -- ? ) { ECX RCX } member-eq? ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue