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 ] [
[ { fixnum byte-array fixnum } declare set-alien-unsigned-1 ]
[ ##set-alien-integer-1? ] contains-insn?
[ ##store-memory-imm? ] contains-insn?
] unit-test
[ t ] [
[ { 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
[ f ] [
[ { 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
[ f ] [
@ -209,7 +221,7 @@ IN: compiler.cfg.builder.tests
[ [ ##allot? ] contains-insn? ] bi
] unit-test
[ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test
[ 1 ] [ [ dup float+ ] [ ##load-memory-imm? ] count-insns ] unit-test
] when
! 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
use: src/tagged-rep ;
! Alien accessors
INSN: ##alien-unsigned-1
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
! Raw memory accessors
INSN: ##load-memory-imm
def: dst
use: src/int-rep
literal: offset rep ;
use: base/int-rep
literal: offset rep c-type ;
INSN: ##set-alien-integer-1
use: src/int-rep
literal: offset
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 ;
INSN: ##store-memory-imm
use: src base/int-rep
literal: offset rep c-type ;
! Memory allocation
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.
USING: accessors kernel sequences alien math classes.algebra fry
locals combinators combinators.short-circuit cpu.architecture
@ -22,96 +22,66 @@ IN: compiler.cfg.intrinsics.alien
] binary-op
] [ emit-primitive ] if ;
:: inline-alien ( node quot test -- )
:: inline-accessor ( node quot test -- )
node node-input-infos :> infos
infos test call
[ infos quot call ]
[ node emit-primitive ] if ; inline
: inline-alien-getter? ( infos -- ? )
: inline-load-memory? ( infos -- ? )
[ first class>> c-ptr class<= ]
[ second class>> fixnum class<= ]
bi and ;
: prepare-alien-accessor ( info -- ptr-vreg offset )
class>> [ 2inputs swap ] dip ^^unbox-c-ptr ^^add 0 ;
: prepare-accessor ( base offset info -- base offset )
class>> swap [ ^^unbox-c-ptr ] dip ^^add 0 ;
: prepare-alien-getter ( infos -- ptr-vreg offset )
first prepare-alien-accessor ;
: prepare-load-memory ( infos -- base offset )
[ 2inputs ] dip first prepare-accessor ;
: inline-alien-getter ( node quot -- )
'[ prepare-alien-getter @ ds-push ]
[ inline-alien-getter? ] inline-alien ; inline
: (emit-load-memory) ( node rep c-type quot -- )
'[ prepare-load-memory _ _ ^^load-memory-imm @ ds-push ]
[ 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<= ]
[ second class>> c-ptr class<= ]
[ third class>> fixnum class<= ]
tri and and ;
: prepare-alien-setter ( infos -- ptr-vreg offset )
second prepare-alien-accessor ;
: prepare-store-memory ( infos -- value base offset )
[ 3inputs ] dip second prepare-accessor ;
: inline-alien-integer-setter ( node quot -- )
'[ prepare-alien-setter ds-pop @ ]
[ fixnum inline-alien-setter? ]
inline-alien ; inline
:: (emit-store-memory) ( node rep c-type prepare-quot test-quot -- )
node
[ prepare-quot call rep c-type ##store-memory-imm ]
[ test-quot call inline-store-memory? ]
inline-accessor ; inline
: inline-alien-float-setter ( node quot -- )
'[ prepare-alien-setter ds-pop @ ]
[ float inline-alien-setter? ]
inline-alien ; inline
: inline-alien-cell-setter ( node quot -- )
'[ [ prepare-alien-setter ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
[ pinned-c-ptr inline-alien-setter? ]
inline-alien ; inline
: emit-alien-unsigned-getter ( node n -- )
'[
_ {
{ 1 [ ^^alien-unsigned-1 ] }
{ 2 [ ^^alien-unsigned-2 ] }
{ 4 [ ^^alien-unsigned-4 ] }
:: emit-store-memory ( node rep c-type -- )
node rep c-type
[ prepare-store-memory ]
[
rep {
{ int-rep [ fixnum ] }
{ float-rep [ float ] }
{ double-rep [ float ] }
} case
] inline-alien-getter ;
]
(emit-store-memory) ;
: emit-alien-signed-getter ( node n -- )
'[
_ {
{ 1 [ ^^alien-signed-1 ] }
{ 2 [ ^^alien-signed-2 ] }
{ 4 [ ^^alien-signed-4 ] }
} case
] inline-alien-getter ;
: 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 ;
: emit-set-alien-cell ( node -- )
int-rep f
[
[ first class>> ] [ prepare-store-memory ] bi
[ swap ^^unbox-c-ptr ] 2dip
]
[ pinned-c-ptr ]
(emit-store-memory) ;

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

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

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

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes.algebra layouts kernel math namespaces
sequences
sequences cpu.architecture
compiler.tree.propagation.info
compiler.cfg.stacks
compiler.cfg.hats
@ -10,6 +10,7 @@ compiler.cfg.instructions
compiler.cfg.builder.blocks
compiler.cfg.utilities ;
FROM: vm => context-field-offset vm-field-offset ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- )
@ -48,6 +49,6 @@ IN: compiler.cfg.intrinsics.misc
[
^^tagged>integer
tag-mask get bitnot ^^load-integer ^^and
0 ^^alien-cell
0 int-rep f ^^load-memory-imm
hashcode-shift ^^shr-imm
] 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: ##gather-vector-2 insn-available? rep>> %gather-vector-2-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-imm insn-available? rep>> %shuffle-vector-imm-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 -- )
dup [
'[
ds-drop prepare-alien-getter
_ ^^alien-vector ds-push
ds-drop prepare-load-memory
_ f ^^load-memory-imm ds-push
]
[ inline-alien-getter? ] inline-alien
[ inline-load-memory? ] inline-accessor
] with { [ %alien-vector-reps member? ] } if-literals-match ;
: emit-set-alien-vector ( node -- )
dup [
'[
ds-drop prepare-alien-setter ds-pop
_ ##set-alien-vector
ds-drop prepare-store-memory
_ f ##store-memory-imm
]
[ byte-array inline-alien-setter? ]
inline-alien
[ byte-array inline-store-memory? ]
inline-accessor
] with { [ %alien-vector-reps member? ] } if-literals-match ;
: enable-simd ( -- )

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

@ -1,13 +1,13 @@
! Copyright (C) 2010 Slava Pestov.
! 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.stacks ;
compiler.cfg.stacks cpu.architecture ;
IN: compiler.cfg.intrinsics.strings
: emit-string-nth ( -- )
2inputs swap ^^string-nth ds-push ;
: emit-set-string-nth-fast ( -- )
3inputs ^^tagged>integer ^^add swap [ string-offset ] dip
##set-alien-integer-1 ;
3inputs ^^tagged>integer ^^add string-offset
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
dst temp ##double>single-float ;
M: double-rep rep>tagged
drop
[ drop 16 float int-rep next-vreg-rep ##allot ]
[ float-offset swap ##set-alien-double ]
2bi ;
M:: double-rep rep>tagged ( dst src rep -- )
dst 16 float int-rep next-vreg-rep ##allot
src dst float-offset double-rep f ##store-memory-imm ;
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 -- )
tagged-rep next-vreg-rep :> temp
dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
temp 16 tag-fixnum ##load-tagged
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
[ byte-array-offset ] dip ##alien-vector ;
[ byte-array-offset ] dip f ##load-memory-imm ;
M:: scalar-rep rep>tagged ( dst src rep -- )
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.representations.preferred cpu.architecture kernel
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
[ { double-rep double-rep } ] [
@ -14,12 +15,39 @@ IN: compiler.cfg.representations
] unit-test
[ double-rep ] [
T{ ##alien-double
T{ ##load-memory-imm
{ dst 5 }
{ src 3 }
{ base 3 }
{ offset 0 }
{ rep double-rep }
} defs-vreg-rep
] 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 ( -- )
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
: 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
[ >>src ] [ '[ _ + ] change-offset ] bi*
[ >>base ] [ '[ _ + ] change-offset ] bi*
] [ 2drop f ] if ;
M: ##alien-unsigned-1 rewrite rewrite-alien-addressing ;
M: ##alien-unsigned-2 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 ;
M: ##load-memory-imm rewrite rewrite-alien-addressing ;
M: ##store-memory-imm 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 ;
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
! 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
layouts literals namespaces alien compiler.cfg.value-numbering.simd
system ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.cfg.value-numbering.tests
: trim-temps ( insns -- insns )
@ -2207,3 +2208,40 @@ V{
] 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.
: >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 ;
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: ##unbox-alien %unbox-alien
CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
CODEGEN: ##alien-unsigned-1 %alien-unsigned-1
CODEGEN: ##alien-unsigned-2 %alien-unsigned-2
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: ##load-memory-imm %load-memory-imm
CODEGEN: ##store-memory-imm %store-memory-imm
CODEGEN: ##allot %allot
CODEGEN: ##write-barrier %write-barrier
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
cpu.architecture hashtables kernel namespaces sequences
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
: compile-cfg ( cfg -- word )
@ -92,7 +92,7 @@ IN: compiler.tests.low-level-ir
V{
T{ ##load-reference f 1 B{ 31 67 52 } }
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 }
} compile-test-bb
] 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-displaced-alien cpu ( dst displacement base temp base-class -- )
HOOK: %alien-unsigned-1 cpu ( dst src offset -- )
HOOK: %alien-unsigned-2 cpu ( dst src offset -- )
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: %load-memory-imm cpu ( dst base offset rep c-type -- )
HOOK: %store-memory-imm cpu ( value base offset rep c-type -- )
HOOK: %alien-global cpu ( dst symbol library -- )
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.stack-frame
compiler.codegen.fixup ;
QUALIFIED-WITH: alien.c-types c
FROM: layouts => cell ;
FROM: math => float ;
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-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: rs-reg cpu ( -- reg )
@ -354,45 +358,48 @@ M:: x86 %string-nth ( dst src index temp -- )
dst new-dst int-rep %copy
] with-small-register ;
:: %alien-integer-getter ( dst src offset size quot -- )
dst { src } size [| new-dst |
new-dst dup size n-bit-version-of dup src offset [+] MOV
:: %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
quot call
dst new-dst int-rep %copy
] with-small-register ; inline
: %alien-unsigned-getter ( dst src offset size -- )
: %alien-unsigned-getter ( dst base offset bits -- )
[ MOVZX ] %alien-integer-getter ; inline
: %alien-signed-getter ( dst src offset size -- )
: %alien-signed-getter ( dst base offset bits -- )
[ MOVSX ] %alien-integer-getter ; inline
:: %alien-integer-setter ( ptr offset value size -- )
value { ptr } size [| new-value |
:: %alien-integer-setter ( value base offset bits -- )
value { base } bits [| new-value |
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
M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
M: x86 %load-memory-imm ( dst base offset rep c-type -- )
[
{
{ 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 %alien-signed-2 16 %alien-signed-getter ;
M: x86 %alien-signed-4 32 %alien-signed-getter ;
M: x86 %alien-cell [+] MOV ;
M: x86 %alien-float [+] MOVSS ;
M: x86 %alien-double [+] MOVSD ;
M: x86 %alien-vector [ [+] ] dip %copy ;
M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
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 ;
M: x86 %store-memory-imm ( src base offset rep c-type -- )
[
{
{ c:char [ 8 %alien-integer-setter ] }
{ c:uchar [ 8 %alien-integer-setter ] }
{ c:short [ 16 %alien-integer-setter ] }
{ c:ushort [ 16 %alien-integer-setter ] }
{ c:int [ 32 %alien-integer-setter ] }
{ c:uint [ 32 %alien-integer-setter ] }
} case
] [ [ [+] swap ] dip %copy ] ?if ;
: shift-count? ( reg -- ? ) { ECX RCX } member-eq? ;