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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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