steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg: merge all alien accessors into ##load-memory-imm and ##store-memory-imm

db4
Slava Pestov 2010-04-23 18:42:09 -04:00
parent 0ddaba8adb
commit 913b95192e
18 changed files with 221 additions and 288 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -172,17 +172,29 @@ IN: compiler.cfg.builder.tests
[ t ] [ [ t ] [
[ { fixnum byte-array fixnum } declare set-alien-unsigned-1 ] [ { fixnum byte-array fixnum } declare set-alien-unsigned-1 ]
[ ##set-alien-integer-1? ] contains-insn? [ ##store-memory-imm? ] contains-insn?
] unit-test ] unit-test
[ t ] [ [ t ] [
[ { fixnum byte-array fixnum } declare [ dup * dup * ] 2dip set-alien-unsigned-1 ] [ { fixnum byte-array fixnum } declare [ dup * dup * ] 2dip set-alien-unsigned-1 ]
[ ##set-alien-integer-1? ] contains-insn? [ ##store-memory-imm? ] contains-insn?
] unit-test ] unit-test
[ f ] [ [ f ] [
[ { byte-array fixnum } declare set-alien-unsigned-1 ] [ { byte-array fixnum } declare set-alien-unsigned-1 ]
[ ##set-alien-integer-1? ] contains-insn? [ ##store-memory-imm? ] contains-insn?
] unit-test
[ t t ] [
[ { byte-array fixnum } declare alien-cell ]
[ [ ##load-memory-imm? ] contains-insn? ]
[ [ ##box-alien? ] contains-insn? ]
bi
] unit-test
[ f ] [
[ { byte-array integer } declare alien-cell ]
[ ##load-memory-imm? ] contains-insn?
] unit-test ] unit-test
[ f ] [ [ f ] [
@ -209,7 +221,7 @@ IN: compiler.cfg.builder.tests
[ [ ##allot? ] contains-insn? ] bi [ [ ##allot? ] contains-insn? ] bi
] unit-test ] unit-test
[ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test [ 1 ] [ [ dup float+ ] [ ##load-memory-imm? ] count-insns ] unit-test
] when ] when
! Regression. Make sure everything is inlined correctly ! Regression. Make sure everything is inlined correctly

91
basis/compiler/cfg/instructions/instructions.factor
View File

@ -550,92 +550,15 @@ PURE-INSN: ##unbox-alien
def: dst/int-rep def: dst/int-rep
use: src/tagged-rep ; use: src/tagged-rep ;
! Alien accessors ! Raw memory accessors
INSN: ##alien-unsigned-1 INSN: ##load-memory-imm
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-unsigned-2
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-unsigned-4
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-signed-1
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-signed-2
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-signed-4
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-cell
def: dst/int-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-float
def: dst/float-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-double
def: dst/double-rep
use: src/int-rep
literal: offset ;
INSN: ##alien-vector
def: dst def: dst
use: src/int-rep use: base/int-rep
literal: offset rep ; literal: offset rep c-type ;
INSN: ##set-alien-integer-1 INSN: ##store-memory-imm
use: src/int-rep use: src base/int-rep
literal: offset literal: offset rep c-type ;
use: value/int-rep ;
INSN: ##set-alien-integer-2
use: src/int-rep
literal: offset
use: value/int-rep ;
INSN: ##set-alien-integer-4
use: src/int-rep
literal: offset
use: value/int-rep ;
INSN: ##set-alien-cell
use: src/int-rep
literal: offset
use: value/int-rep ;
INSN: ##set-alien-float
use: src/int-rep
literal: offset
use: value/float-rep ;
INSN: ##set-alien-double
use: src/int-rep
literal: offset
use: value/double-rep ;
INSN: ##set-alien-vector
use: src/int-rep
literal: offset
use: value
literal: rep ;
! Memory allocation ! Memory allocation
INSN: ##allot INSN: ##allot

116
basis/compiler/cfg/intrinsics/alien/alien.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences alien math classes.algebra fry USING: accessors kernel sequences alien math classes.algebra fry
locals combinators combinators.short-circuit cpu.architecture locals combinators combinators.short-circuit cpu.architecture
@ -22,96 +22,66 @@ IN: compiler.cfg.intrinsics.alien
] binary-op ] binary-op
] [ emit-primitive ] if ; ] [ emit-primitive ] if ;
:: inline-alien ( node quot test -- ) :: inline-accessor ( node quot test -- )
node node-input-infos :> infos node node-input-infos :> infos
infos test call infos test call
[ infos quot call ] [ infos quot call ]
[ node emit-primitive ] if ; inline [ node emit-primitive ] if ; inline
: inline-alien-getter? ( infos -- ? ) : inline-load-memory? ( infos -- ? )
[ first class>> c-ptr class<= ] [ first class>> c-ptr class<= ]
[ second class>> fixnum class<= ] [ second class>> fixnum class<= ]
bi and ; bi and ;
: prepare-alien-accessor ( info -- ptr-vreg offset ) : prepare-accessor ( base offset info -- base offset )
class>> [ 2inputs swap ] dip ^^unbox-c-ptr ^^add 0 ; class>> swap [ ^^unbox-c-ptr ] dip ^^add 0 ;
: prepare-alien-getter ( infos -- ptr-vreg offset ) : prepare-load-memory ( infos -- base offset )
first prepare-alien-accessor ; [ 2inputs ] dip first prepare-accessor ;
: inline-alien-getter ( node quot -- ) : (emit-load-memory) ( node rep c-type quot -- )
'[ prepare-alien-getter @ ds-push ] '[ prepare-load-memory _ _ ^^load-memory-imm @ ds-push ]
[ inline-alien-getter? ] inline-alien ; inline [ inline-load-memory? ]
inline-accessor ; inline
: inline-alien-setter? ( infos class -- ? ) : emit-load-memory ( node rep c-type -- )
[ ] (emit-load-memory) ;
: emit-alien-cell ( node -- )
int-rep f [ ^^box-alien ] (emit-load-memory) ;
: inline-store-memory? ( infos class -- ? )
'[ first class>> _ class<= ] '[ first class>> _ class<= ]
[ second class>> c-ptr class<= ] [ second class>> c-ptr class<= ]
[ third class>> fixnum class<= ] [ third class>> fixnum class<= ]
tri and and ; tri and and ;
: prepare-alien-setter ( infos -- ptr-vreg offset ) : prepare-store-memory ( infos -- value base offset )
second prepare-alien-accessor ; [ 3inputs ] dip second prepare-accessor ;
: inline-alien-integer-setter ( node quot -- ) :: (emit-store-memory) ( node rep c-type prepare-quot test-quot -- )
'[ prepare-alien-setter ds-pop @ ] node
[ fixnum inline-alien-setter? ] [ prepare-quot call rep c-type ##store-memory-imm ]
inline-alien ; inline [ test-quot call inline-store-memory? ]
inline-accessor ; inline
: inline-alien-float-setter ( node quot -- ) :: emit-store-memory ( node rep c-type -- )
'[ prepare-alien-setter ds-pop @ ] node rep c-type
[ float inline-alien-setter? ] [ prepare-store-memory ]
inline-alien ; inline [
rep {
: inline-alien-cell-setter ( node quot -- ) { int-rep [ fixnum ] }
'[ [ prepare-alien-setter ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ] { float-rep [ float ] }
[ pinned-c-ptr inline-alien-setter? ] { double-rep [ float ] }
inline-alien ; inline
: emit-alien-unsigned-getter ( node n -- )
'[
_ {
{ 1 [ ^^alien-unsigned-1 ] }
{ 2 [ ^^alien-unsigned-2 ] }
{ 4 [ ^^alien-unsigned-4 ] }
} case } case
] inline-alien-getter ; ]
(emit-store-memory) ;
: emit-alien-signed-getter ( node n -- ) : emit-set-alien-cell ( node -- )
'[ int-rep f
_ { [
{ 1 [ ^^alien-signed-1 ] } [ first class>> ] [ prepare-store-memory ] bi
{ 2 [ ^^alien-signed-2 ] } [ swap ^^unbox-c-ptr ] 2dip
{ 4 [ ^^alien-signed-4 ] } ]
} case [ pinned-c-ptr ]
] inline-alien-getter ; (emit-store-memory) ;
: emit-alien-integer-setter ( node n -- )
'[
_ {
{ 1 [ ##set-alien-integer-1 ] }
{ 2 [ ##set-alien-integer-2 ] }
{ 4 [ ##set-alien-integer-4 ] }
} case
] inline-alien-integer-setter ;
: emit-alien-cell-getter ( node -- )
[ ^^alien-cell ^^box-alien ] inline-alien-getter ;
: emit-alien-cell-setter ( node -- )
[ ##set-alien-cell ] inline-alien-cell-setter ;
: emit-alien-float-getter ( node rep -- )
'[
_ {
{ float-rep [ ^^alien-float ] }
{ double-rep [ ^^alien-double ] }
} case
] inline-alien-getter ;
: emit-alien-float-setter ( node rep -- )
'[
_ {
{ float-rep [ ##set-alien-float ] }
{ double-rep [ ##set-alien-double ] }
} case
] inline-alien-float-setter ;

37
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -14,6 +14,7 @@ compiler.cfg.intrinsics.misc
compiler.cfg.comparisons ; compiler.cfg.comparisons ;
QUALIFIED: alien QUALIFIED: alien
QUALIFIED: alien.accessors QUALIFIED: alien.accessors
QUALIFIED: alien.c-types
QUALIFIED: kernel QUALIFIED: kernel
QUALIFIED: arrays QUALIFIED: arrays
QUALIFIED: byte-arrays QUALIFIED: byte-arrays
@ -63,24 +64,24 @@ IN: compiler.cfg.intrinsics
{ byte-arrays:(byte-array) [ emit-(byte-array) ] } { byte-arrays:(byte-array) [ emit-(byte-array) ] }
{ kernel:<wrapper> [ emit-simple-allot ] } { kernel:<wrapper> [ emit-simple-allot ] }
{ alien:<displaced-alien> [ emit-<displaced-alien> ] } { alien:<displaced-alien> [ emit-<displaced-alien> ] }
{ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] } { alien.accessors:alien-unsigned-1 [ int-rep alien.c-types:uchar emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] } { alien.accessors:set-alien-unsigned-1 [ int-rep alien.c-types:uchar emit-store-memory ] }
{ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] } { alien.accessors:alien-signed-1 [ int-rep alien.c-types:char emit-load-memory ] }
{ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] } { alien.accessors:set-alien-signed-1 [ int-rep alien.c-types:char emit-store-memory ] }
{ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] } { alien.accessors:alien-unsigned-2 [ int-rep alien.c-types:ushort emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] } { alien.accessors:set-alien-unsigned-2 [ int-rep alien.c-types:ushort emit-store-memory ] }
{ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] } { alien.accessors:alien-signed-2 [ int-rep alien.c-types:short emit-load-memory ] }
{ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] } { alien.accessors:set-alien-signed-2 [ int-rep alien.c-types:short emit-store-memory ] }
{ alien.accessors:alien-cell [ emit-alien-cell-getter ] } { alien.accessors:alien-cell [ emit-alien-cell ] }
{ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] } { alien.accessors:set-alien-cell [ emit-set-alien-cell ] }
} enable-intrinsics } enable-intrinsics
: enable-alien-4-intrinsics ( -- ) : enable-alien-4-intrinsics ( -- )
{ {
{ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] } { alien.accessors:alien-signed-4 [ int-rep alien.c-types:int emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] } { alien.accessors:set-alien-signed-4 [ int-rep alien.c-types:int emit-store-memory ] }
{ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] } { alien.accessors:alien-unsigned-4 [ int-rep alien.c-types:uint emit-load-memory ] }
{ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] } { alien.accessors:set-alien-unsigned-4 [ int-rep alien.c-types:uint emit-store-memory ] }
} enable-intrinsics ; } enable-intrinsics ;
: enable-float-intrinsics ( -- ) : enable-float-intrinsics ( -- )
@ -101,10 +102,10 @@ IN: compiler.cfg.intrinsics
{ math.private:float>fixnum [ drop [ ^^float>integer ] unary-op ] } { math.private:float>fixnum [ drop [ ^^float>integer ] unary-op ] }
{ math.private:fixnum>float [ drop [ ^^integer>float ] unary-op ] } { math.private:fixnum>float [ drop [ ^^integer>float ] unary-op ] }
{ math.floats.private:float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] } { math.floats.private:float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] }
{ alien.accessors:alien-float [ float-rep emit-alien-float-getter ] } { alien.accessors:alien-float [ float-rep f emit-load-memory ] }
{ alien.accessors:set-alien-float [ float-rep emit-alien-float-setter ] } { alien.accessors:set-alien-float [ float-rep f emit-store-memory ] }
{ alien.accessors:alien-double [ double-rep emit-alien-float-getter ] } { alien.accessors:alien-double [ double-rep f emit-load-memory ] }
{ alien.accessors:set-alien-double [ double-rep emit-alien-float-setter ] } { alien.accessors:set-alien-double [ double-rep f emit-store-memory ] }
} enable-intrinsics ; } enable-intrinsics ;
: enable-fsqrt ( -- ) : enable-fsqrt ( -- )

5
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2010 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes.algebra layouts kernel math namespaces USING: accessors classes.algebra layouts kernel math namespaces
sequences sequences cpu.architecture
compiler.tree.propagation.info compiler.tree.propagation.info
compiler.cfg.stacks compiler.cfg.stacks
compiler.cfg.hats compiler.cfg.hats
@ -10,6 +10,7 @@ compiler.cfg.instructions
compiler.cfg.builder.blocks compiler.cfg.builder.blocks
compiler.cfg.utilities ; compiler.cfg.utilities ;
FROM: vm => context-field-offset vm-field-offset ; FROM: vm => context-field-offset vm-field-offset ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.cfg.intrinsics.misc IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- ) : emit-tag ( -- )
@ -48,6 +49,6 @@ IN: compiler.cfg.intrinsics.misc
[ [
^^tagged>integer ^^tagged>integer
tag-mask get bitnot ^^load-integer ^^and tag-mask get bitnot ^^load-integer ^^and
0 ^^alien-cell 0 int-rep f ^^load-memory-imm
hashcode-shift ^^shr-imm hashcode-shift ^^shr-imm
] unary-op ; ] unary-op ;

2
basis/compiler/cfg/intrinsics/simd/backend/backend.factor
View File

@ -19,7 +19,7 @@ M: ##zero-vector insn-available? rep>> %zero-vector-reps member? ;
M: ##fill-vector insn-available? rep>> %fill-vector-reps member? ; M: ##fill-vector insn-available? rep>> %fill-vector-reps member? ;
M: ##gather-vector-2 insn-available? rep>> %gather-vector-2-reps member? ; M: ##gather-vector-2 insn-available? rep>> %gather-vector-2-reps member? ;
M: ##gather-vector-4 insn-available? rep>> %gather-vector-4-reps member? ; M: ##gather-vector-4 insn-available? rep>> %gather-vector-4-reps member? ;
M: ##alien-vector insn-available? rep>> %alien-vector-reps member? ; M: ##store-memory-imm insn-available? rep>> %alien-vector-reps member? ;
M: ##shuffle-vector insn-available? rep>> %shuffle-vector-reps member? ; M: ##shuffle-vector insn-available? rep>> %shuffle-vector-reps member? ;
M: ##shuffle-vector-imm insn-available? rep>> %shuffle-vector-imm-reps member? ; M: ##shuffle-vector-imm insn-available? rep>> %shuffle-vector-imm-reps member? ;
M: ##merge-vector-head insn-available? rep>> %merge-vector-reps member? ; M: ##merge-vector-head insn-available? rep>> %merge-vector-reps member? ;

14
basis/compiler/cfg/intrinsics/simd/simd.factor
View File

@ -587,20 +587,20 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
: emit-alien-vector ( node -- ) : emit-alien-vector ( node -- )
dup [ dup [
'[ '[
ds-drop prepare-alien-getter ds-drop prepare-load-memory
_ ^^alien-vector ds-push _ f ^^load-memory-imm ds-push
] ]
[ inline-alien-getter? ] inline-alien [ inline-load-memory? ] inline-accessor
] with { [ %alien-vector-reps member? ] } if-literals-match ; ] with { [ %alien-vector-reps member? ] } if-literals-match ;
: emit-set-alien-vector ( node -- ) : emit-set-alien-vector ( node -- )
dup [ dup [
'[ '[
ds-drop prepare-alien-setter ds-pop ds-drop prepare-store-memory
_ ##set-alien-vector _ f ##store-memory-imm
] ]
[ byte-array inline-alien-setter? ] [ byte-array inline-store-memory? ]
inline-alien inline-accessor
] with { [ %alien-vector-reps member? ] } if-literals-match ; ] with { [ %alien-vector-reps member? ] } if-literals-match ;
: enable-simd ( -- ) : enable-simd ( -- )

8
basis/compiler/cfg/intrinsics/strings/strings.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2010 Slava Pestov. ! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel compiler.constants compiler.cfg.hats USING: alien.c-types kernel compiler.constants compiler.cfg.hats
compiler.cfg.instructions compiler.cfg.registers compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.stacks ; compiler.cfg.stacks cpu.architecture ;
IN: compiler.cfg.intrinsics.strings IN: compiler.cfg.intrinsics.strings
: emit-string-nth ( -- ) : emit-string-nth ( -- )
2inputs swap ^^string-nth ds-push ; 2inputs swap ^^string-nth ds-push ;
: emit-set-string-nth-fast ( -- ) : emit-set-string-nth-fast ( -- )
3inputs ^^tagged>integer ^^add swap [ string-offset ] dip 3inputs ^^tagged>integer ^^add string-offset
##set-alien-integer-1 ; int-rep uchar ##store-memory-imm ;

14
basis/compiler/cfg/representations/conversion/conversion.factor
View File

@ -26,24 +26,22 @@ M:: float-rep tagged>rep ( dst src rep -- )
temp src double-rep tagged>rep temp src double-rep tagged>rep
dst temp ##double>single-float ; dst temp ##double>single-float ;
M: double-rep rep>tagged M:: double-rep rep>tagged ( dst src rep -- )
drop dst 16 float int-rep next-vreg-rep ##allot
[ drop 16 float int-rep next-vreg-rep ##allot ] src dst float-offset double-rep f ##store-memory-imm ;
[ float-offset swap ##set-alien-double ]
2bi ;
M: double-rep tagged>rep M: double-rep tagged>rep
drop float-offset ##alien-double ; drop float-offset double-rep f ##load-memory-imm ;
M:: vector-rep rep>tagged ( dst src rep -- ) M:: vector-rep rep>tagged ( dst src rep -- )
tagged-rep next-vreg-rep :> temp tagged-rep next-vreg-rep :> temp
dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
temp 16 tag-fixnum ##load-tagged temp 16 tag-fixnum ##load-tagged
temp dst 1 byte-array type-number ##set-slot-imm temp dst 1 byte-array type-number ##set-slot-imm
dst byte-array-offset src rep ##set-alien-vector ; src dst byte-array-offset rep f ##store-memory-imm ;
M: vector-rep tagged>rep M: vector-rep tagged>rep
[ byte-array-offset ] dip ##alien-vector ; [ byte-array-offset ] dip f ##load-memory-imm ;
M:: scalar-rep rep>tagged ( dst src rep -- ) M:: scalar-rep rep>tagged ( dst src rep -- )
tagged-rep next-vreg-rep :> temp tagged-rep next-vreg-rep :> temp

34
basis/compiler/cfg/representations/representations-tests.factor
View File

@ -2,7 +2,8 @@ USING: accessors compiler.cfg compiler.cfg.debugger
compiler.cfg.instructions compiler.cfg.registers compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.representations.preferred cpu.architecture kernel compiler.cfg.representations.preferred cpu.architecture kernel
namespaces tools.test sequences arrays system literals layouts namespaces tools.test sequences arrays system literals layouts
math ; math compiler.constants compiler.cfg.representations.conversion
compiler.cfg.representations.rewrite make ;
IN: compiler.cfg.representations IN: compiler.cfg.representations
[ { double-rep double-rep } ] [ [ { double-rep double-rep } ] [
@ -14,12 +15,39 @@ IN: compiler.cfg.representations
] unit-test ] unit-test
[ double-rep ] [ [ double-rep ] [
T{ ##alien-double T{ ##load-memory-imm
{ dst 5 } { dst 5 }
{ src 3 } { base 3 }
{ offset 0 }
{ rep double-rep }
} defs-vreg-rep } defs-vreg-rep
] unit-test ] unit-test
H{ } clone representations set
3 \ vreg-counter set-global
[
{
T{ ##allot f 2 16 float 4 }
T{ ##store-memory-imm f 1 2 $[ float-offset ] double-rep f }
}
] [
[
2 1 tagged-rep double-rep emit-conversion
] { } make
] unit-test
[
{
T{ ##load-memory-imm f 2 1 $[ float-offset ] double-rep f }
}
] [
[
2 1 double-rep tagged-rep emit-conversion
] { } make
] unit-test
: test-representations ( -- ) : test-representations ( -- )
cfg new 0 get >>entry dup cfg set select-representations drop ; cfg new 0 get >>entry dup cfg set select-representations drop ;

19
basis/compiler/cfg/value-numbering/alien/alien.factor
View File

@ -30,21 +30,10 @@ M: ##unbox-any-c-ptr rewrite
! More efficient addressing for alien intrinsics ! More efficient addressing for alien intrinsics
: rewrite-alien-addressing ( insn -- insn' ) : rewrite-alien-addressing ( insn -- insn' )
dup src>> vreg>expr dup add-imm-expr? [ dup base>> vreg>expr dup add-imm-expr? [
[ src1>> vn>vreg ] [ src2>> vn>integer ] bi [ src1>> vn>vreg ] [ src2>> vn>integer ] bi
[ >>src ] [ '[ _ + ] change-offset ] bi* [ >>base ] [ '[ _ + ] change-offset ] bi*
] [ 2drop f ] if ; ] [ 2drop f ] if ;
M: ##alien-unsigned-1 rewrite rewrite-alien-addressing ; M: ##load-memory-imm rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-2 rewrite rewrite-alien-addressing ; M: ##store-memory-imm rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-4 rewrite rewrite-alien-addressing ;
M: ##alien-signed-1 rewrite rewrite-alien-addressing ;
M: ##alien-signed-2 rewrite rewrite-alien-addressing ;
M: ##alien-signed-4 rewrite rewrite-alien-addressing ;
M: ##alien-float rewrite rewrite-alien-addressing ;
M: ##alien-double rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-1 rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-2 rewrite rewrite-alien-addressing ;
M: ##set-alien-integer-4 rewrite rewrite-alien-addressing ;
M: ##set-alien-float rewrite rewrite-alien-addressing ;
M: ##set-alien-double rewrite rewrite-alien-addressing ;

3
basis/compiler/cfg/value-numbering/simd/simd.factor
View File

@ -16,9 +16,6 @@ compiler.cfg.value-numbering.rewrite
compiler.cfg.value-numbering.simplify ; compiler.cfg.value-numbering.simplify ;
IN: compiler.cfg.value-numbering.simd IN: compiler.cfg.value-numbering.simd
M: ##alien-vector rewrite rewrite-alien-addressing ;
M: ##set-alien-vector rewrite rewrite-alien-addressing ;
! Some lame constant folding for SIMD intrinsics. Eventually this ! Some lame constant folding for SIMD intrinsics. Eventually this
! should be redone completely. ! should be redone completely.

38
basis/compiler/cfg/value-numbering/value-numbering-tests.factor
View File

@ -6,6 +6,7 @@ compiler.cfg.ssa.destruction compiler.cfg.loop-detection
compiler.cfg.representations compiler.cfg assocs vectors arrays compiler.cfg.representations compiler.cfg assocs vectors arrays
layouts literals namespaces alien compiler.cfg.value-numbering.simd layouts literals namespaces alien compiler.cfg.value-numbering.simd
system ; system ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.cfg.value-numbering.tests IN: compiler.cfg.value-numbering.tests
: trim-temps ( insns -- insns ) : trim-temps ( insns -- insns )
@ -2207,3 +2208,40 @@ V{
] unit-test ] unit-test
[ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test [ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test
! Alien addressing optimization
[
V{
T{ ##peek f 1 D 0 }
T{ ##tagged>integer f 2 1 }
T{ ##add-imm f 3 2 10 }
T{ ##load-memory-imm f 4 2 10 int-rep c:uchar }
}
] [
V{
T{ ##peek f 1 D 0 }
T{ ##tagged>integer f 2 1 }
T{ ##add-imm f 3 2 10 }
T{ ##load-memory-imm f 4 3 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-imm f 4 3 10 }
T{ ##store-memory-imm f 2 3 10 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 10 }
T{ ##store-memory-imm f 2 4 0 int-rep c:uchar }
} value-numbering-step
] unit-test

2
basis/compiler/cfg/value-numbering/value-numbering.factor
View File

@ -20,7 +20,7 @@ IN: compiler.cfg.value-numbering
! Local value numbering. ! Local value numbering.
: >copy ( insn -- insn/##copy ) : >copy ( insn -- insn/##copy )
dup defs-vreg dup vreg>vn vn>vreg dup dst>> dup vreg>vn vn>vreg
2dup eq? [ 2drop ] [ any-rep \ ##copy new-insn nip ] if ; 2dup eq? [ 2drop ] [ any-rep \ ##copy new-insn nip ] if ;
GENERIC: process-instruction ( insn -- insn' ) GENERIC: process-instruction ( insn -- insn' )

19
basis/compiler/codegen/codegen.factor
View File

@ -187,23 +187,8 @@ CODEGEN: ##box-alien %box-alien
CODEGEN: ##box-displaced-alien %box-displaced-alien CODEGEN: ##box-displaced-alien %box-displaced-alien
CODEGEN: ##unbox-alien %unbox-alien CODEGEN: ##unbox-alien %unbox-alien
CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
CODEGEN: ##alien-unsigned-1 %alien-unsigned-1 CODEGEN: ##load-memory-imm %load-memory-imm
CODEGEN: ##alien-unsigned-2 %alien-unsigned-2 CODEGEN: ##store-memory-imm %store-memory-imm
CODEGEN: ##alien-unsigned-4 %alien-unsigned-4
CODEGEN: ##alien-signed-1 %alien-signed-1
CODEGEN: ##alien-signed-2 %alien-signed-2
CODEGEN: ##alien-signed-4 %alien-signed-4
CODEGEN: ##alien-cell %alien-cell
CODEGEN: ##alien-float %alien-float
CODEGEN: ##alien-double %alien-double
CODEGEN: ##alien-vector %alien-vector
CODEGEN: ##set-alien-integer-1 %set-alien-integer-1
CODEGEN: ##set-alien-integer-2 %set-alien-integer-2
CODEGEN: ##set-alien-integer-4 %set-alien-integer-4
CODEGEN: ##set-alien-cell %set-alien-cell
CODEGEN: ##set-alien-float %set-alien-float
CODEGEN: ##set-alien-double %set-alien-double
CODEGEN: ##set-alien-vector %set-alien-vector
CODEGEN: ##allot %allot CODEGEN: ##allot %allot
CODEGEN: ##write-barrier %write-barrier CODEGEN: ##write-barrier %write-barrier
CODEGEN: ##write-barrier-imm %write-barrier-imm CODEGEN: ##write-barrier-imm %write-barrier-imm

4
basis/compiler/tests/low-level-ir.factor
View File

@ -3,7 +3,7 @@ compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.mr
compiler.cfg.registers compiler.codegen compiler.units compiler.cfg.registers compiler.codegen compiler.units
cpu.architecture hashtables kernel namespaces sequences cpu.architecture hashtables kernel namespaces sequences
tools.test vectors words layouts literals math arrays tools.test vectors words layouts literals math arrays
alien.syntax math.private ; alien.c-types alien.syntax math.private ;
IN: compiler.tests.low-level-ir IN: compiler.tests.low-level-ir
: compile-cfg ( cfg -- word ) : compile-cfg ( cfg -- word )
@ -92,7 +92,7 @@ IN: compiler.tests.low-level-ir
V{ V{
T{ ##load-reference f 1 B{ 31 67 52 } } T{ ##load-reference f 1 B{ 31 67 52 } }
T{ ##unbox-any-c-ptr f 0 1 } T{ ##unbox-any-c-ptr f 0 1 }
T{ ##alien-unsigned-1 f 0 0 0 } T{ ##load-memory-imm f 0 0 0 int-rep uchar }
T{ ##shl-imm f 0 0 4 } T{ ##shl-imm f 0 0 4 }
} compile-test-bb } compile-test-bb
] unit-test ] unit-test

20
basis/cpu/architecture/architecture.factor
View File

@ -430,24 +430,8 @@ HOOK: %unbox-any-c-ptr cpu ( dst src -- )
HOOK: %box-alien cpu ( dst src temp -- ) HOOK: %box-alien cpu ( dst src temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- ) HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- )
HOOK: %alien-unsigned-1 cpu ( dst src offset -- ) HOOK: %load-memory-imm cpu ( dst base offset rep c-type -- )
HOOK: %alien-unsigned-2 cpu ( dst src offset -- ) HOOK: %store-memory-imm cpu ( value base offset rep c-type -- )
HOOK: %alien-unsigned-4 cpu ( dst src offset -- )
HOOK: %alien-signed-1 cpu ( dst src offset -- )
HOOK: %alien-signed-2 cpu ( dst src offset -- )
HOOK: %alien-signed-4 cpu ( dst src offset -- )
HOOK: %alien-cell cpu ( dst src offset -- )
HOOK: %alien-float cpu ( dst src offset -- )
HOOK: %alien-double cpu ( dst src offset -- )
HOOK: %alien-vector cpu ( dst src offset rep -- )
HOOK: %set-alien-integer-1 cpu ( ptr offset value -- )
HOOK: %set-alien-integer-2 cpu ( ptr offset value -- )
HOOK: %set-alien-integer-4 cpu ( ptr offset value -- )
HOOK: %set-alien-cell cpu ( ptr offset value -- )
HOOK: %set-alien-float cpu ( ptr offset value -- )
HOOK: %set-alien-double cpu ( ptr offset value -- )
HOOK: %set-alien-vector cpu ( ptr offset value rep -- )
HOOK: %alien-global cpu ( dst symbol library -- ) HOOK: %alien-global cpu ( dst symbol library -- )
HOOK: %vm-field cpu ( dst offset -- ) HOOK: %vm-field cpu ( dst offset -- )

63
basis/cpu/x86/x86.factor
View File

@ -12,6 +12,7 @@ compiler.cfg.intrinsics
compiler.cfg.comparisons compiler.cfg.comparisons
compiler.cfg.stack-frame compiler.cfg.stack-frame
compiler.codegen.fixup ; compiler.codegen.fixup ;
QUALIFIED-WITH: alien.c-types c
FROM: layouts => cell ; FROM: layouts => cell ;
FROM: math => float ; FROM: math => float ;
IN: cpu.x86 IN: cpu.x86
@ -66,7 +67,10 @@ HOOK: pic-tail-reg cpu ( -- reg )
M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ; M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ;
M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-literal ; M: x86 %load-reference
[ swap 0 MOV rc-absolute-cell rel-literal ]
[ \ f type-number MOV ]
if* ;
HOOK: ds-reg cpu ( -- reg ) HOOK: ds-reg cpu ( -- reg )
HOOK: rs-reg cpu ( -- reg ) HOOK: rs-reg cpu ( -- reg )
@ -354,45 +358,48 @@ M:: x86 %string-nth ( dst src index temp -- )
dst new-dst int-rep %copy dst new-dst int-rep %copy
] with-small-register ; ] with-small-register ;
:: %alien-integer-getter ( dst src offset size quot -- ) :: %alien-integer-getter ( dst base offset bits quot -- )
dst { src } size [| new-dst | dst { base } bits [| new-dst |
new-dst dup size n-bit-version-of dup src offset [+] MOV new-dst dup bits n-bit-version-of dup base offset [+] MOV
quot call quot call
dst new-dst int-rep %copy dst new-dst int-rep %copy
] with-small-register ; inline ] with-small-register ; inline
: %alien-unsigned-getter ( dst src offset size -- ) : %alien-unsigned-getter ( dst base offset bits -- )
[ MOVZX ] %alien-integer-getter ; inline [ MOVZX ] %alien-integer-getter ; inline
: %alien-signed-getter ( dst src offset size -- ) : %alien-signed-getter ( dst base offset bits -- )
[ MOVSX ] %alien-integer-getter ; inline [ MOVSX ] %alien-integer-getter ; inline
:: %alien-integer-setter ( ptr offset value size -- ) :: %alien-integer-setter ( value base offset bits -- )
value { ptr } size [| new-value | value { base } bits [| new-value |
new-value value int-rep %copy new-value value int-rep %copy
ptr offset [+] new-value size n-bit-version-of MOV base offset [+] new-value bits n-bit-version-of MOV
] with-small-register ; inline ] with-small-register ; inline
M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ; M: x86 %load-memory-imm ( dst base offset rep c-type -- )
M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ; [
M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ; {
{ c:char [ 8 %alien-signed-getter ] }
{ c:uchar [ 8 %alien-unsigned-getter ] }
{ c:short [ 16 %alien-signed-getter ] }
{ c:ushort [ 16 %alien-unsigned-getter ] }
{ c:int [ 32 [ 2drop ] %alien-integer-getter ] }
{ c:uint [ 32 %alien-signed-getter ] }
} case
] [ [ [+] ] dip %copy ] ?if ;
M: x86 %alien-signed-1 8 %alien-signed-getter ; M: x86 %store-memory-imm ( src base offset rep c-type -- )
M: x86 %alien-signed-2 16 %alien-signed-getter ; [
M: x86 %alien-signed-4 32 %alien-signed-getter ; {
{ c:char [ 8 %alien-integer-setter ] }
M: x86 %alien-cell [+] MOV ; { c:uchar [ 8 %alien-integer-setter ] }
M: x86 %alien-float [+] MOVSS ; { c:short [ 16 %alien-integer-setter ] }
M: x86 %alien-double [+] MOVSD ; { c:ushort [ 16 %alien-integer-setter ] }
M: x86 %alien-vector [ [+] ] dip %copy ; { c:int [ 32 %alien-integer-setter ] }
{ c:uint [ 32 %alien-integer-setter ] }
M: x86 %set-alien-integer-1 8 %alien-integer-setter ; } case
M: x86 %set-alien-integer-2 16 %alien-integer-setter ; ] [ [ [+] swap ] dip %copy ] ?if ;
M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
M: x86 %set-alien-cell [ [+] ] dip MOV ;
M: x86 %set-alien-float [ [+] ] dip MOVSS ;
M: x86 %set-alien-double [ [+] ] dip MOVSD ;
M: x86 %set-alien-vector [ [+] ] 2dip %copy ;
: shift-count? ( reg -- ? ) { ECX RCX } member-eq? ; : shift-count? ( reg -- ? ) { ECX RCX } member-eq? ;