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

compiler.cfg.intrinsics: fix type detection on the alien type for vector accessors

db4
Slava Pestov 2009-09-04 02:22:54 -05:00
parent 1fc809b643
commit c92e54b560
2 changed files with 18 additions and 15 deletions
basis/compiler/cfg/intrinsics

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

@ -20,10 +20,6 @@ IN: compiler.cfg.intrinsics.alien
^^box-displaced-alien ds-push
] [ emit-primitive ] if ;
: prepare-alien-accessor ( infos -- offset-vreg )
<reversed> second class>>
[ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add ;
:: inline-alien ( node quot test -- )
[let | infos [ node node-input-infos ] |
infos test call
@ -37,8 +33,14 @@ IN: compiler.cfg.intrinsics.alien
[ second class>> fixnum class<= ]
bi and ;
: prepare-alien-accessor ( info -- offset-vreg )
class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add ;
: prepare-alien-getter ( infos -- offset-vreg )
first prepare-alien-accessor ;
: inline-alien-getter ( node quot -- )
'[ prepare-alien-accessor @ ds-push ]
'[ prepare-alien-getter @ ds-push ]
[ inline-alien-getter? ] inline-alien ; inline
: inline-alien-setter? ( infos class -- ? )
@ -47,18 +49,21 @@ IN: compiler.cfg.intrinsics.alien
[ third class>> fixnum class<= ]
tri and and ;
: prepare-alien-setter ( infos -- offset-vreg )
second prepare-alien-accessor ;
: inline-alien-integer-setter ( node quot -- )
'[ prepare-alien-accessor ds-pop ^^untag-fixnum @ ]
'[ prepare-alien-setter ds-pop ^^untag-fixnum @ ]
[ fixnum inline-alien-setter? ]
inline-alien ; inline
: inline-alien-cell-setter ( node quot -- )
'[ [ prepare-alien-accessor ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
'[ [ prepare-alien-setter ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
[ pinned-c-ptr inline-alien-setter? ]
inline-alien ; inline
: inline-alien-float-setter ( node quot -- )
'[ prepare-alien-accessor ds-pop @ ]
'[ prepare-alien-setter ds-pop @ ]
[ float inline-alien-setter? ]
inline-alien ; inline

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

@ -35,15 +35,10 @@ IN: compiler.cfg.intrinsics.simd
ds-push
] emit-vector-op ;
: inline-alien-vector-setter ( node quot -- )
'[ ds-drop prepare-alien-accessor ds-pop @ ]
[ byte-array inline-alien-setter? ]
inline-alien ; inline
: emit-alien-vector ( node -- )
dup [
'[
ds-drop prepare-alien-accessor
ds-drop prepare-alien-getter
_ ^^alien-vector ds-push
]
[ inline-alien-getter? ] inline-alien
@ -52,6 +47,9 @@ IN: compiler.cfg.intrinsics.simd
: emit-set-alien-vector ( node -- )
dup [
'[
ds-drop prepare-alien-setter ds-pop
_ ##set-alien-vector
] inline-alien-vector-setter
]
[ byte-array inline-alien-setter? ]
inline-alien
] with emit-vector-op ;