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

Specialized arrays can now be passed to alien functions directly, without calling underlying>> first

db4
Slava Pestov 2009-02-06 04:36:17 -06:00
parent 7bb0e78314
commit 7ffbbb13e0
3 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/arrays/arrays.factor
View File

@ -28,7 +28,7 @@ M: array stack-size drop "void*" stack-size ;
M: array c-type-boxer-quot drop f ; M: array c-type-boxer-quot drop f ;
M: array c-type-unboxer-quot drop f ; M: array c-type-unboxer-quot drop [ >c-ptr ] ;
M: value-type c-type-reg-class drop int-regs ; M: value-type c-type-reg-class drop int-regs ;

9
basis/alien/c-types/c-types.factor
View File

@ -201,13 +201,13 @@ M: byte-array byte-length length ;
1 swap malloc-array ; inline 1 swap malloc-array ; inline
: malloc-byte-array ( byte-array -- alien ) : malloc-byte-array ( byte-array -- alien )
dup length [ nip malloc dup ] 2keep memcpy ; dup byte-length [ nip malloc dup ] 2keep memcpy ;
: memory>byte-array ( alien len -- byte-array ) : memory>byte-array ( alien len -- byte-array )
[ nip (byte-array) dup ] 2keep memcpy ; [ nip (byte-array) dup ] 2keep memcpy ;
: byte-array>memory ( byte-array base -- ) : byte-array>memory ( byte-array base -- )
swap dup length memcpy ; swap dup byte-length memcpy ;
: array-accessor ( type quot -- def ) : array-accessor ( type quot -- def )
[ [
@ -263,7 +263,7 @@ M: long-long-type box-return ( type -- )
] when ; ] when ;
: malloc-file-contents ( path -- alien len ) : malloc-file-contents ( path -- alien len )
binary file-contents dup malloc-byte-array swap length ; binary file-contents [ malloc-byte-array ] [ length ] bi ;
: if-void ( type true false -- ) : if-void ( type true false -- )
pick "void" = [ drop nip call ] [ nip call ] if ; inline pick "void" = [ drop nip call ] [ nip call ] if ; inline
@ -283,9 +283,10 @@ M: long-long-type box-return ( type -- )
<c-type> <c-type>
c-ptr >>class c-ptr >>class
[ alien-cell ] >>getter [ alien-cell ] >>getter
[ set-alien-cell ] >>setter [ [ >c-ptr ] 2dip set-alien-cell ] >>setter
bootstrap-cell >>size bootstrap-cell >>size
bootstrap-cell >>align bootstrap-cell >>align
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer "box_alien" >>boxer
"alien_offset" >>unboxer "alien_offset" >>unboxer
"void*" define-primitive-type "void*" define-primitive-type

10
core/alien/alien.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences system USING: accessors assocs kernel math namespaces sequences system
kernel.private byte-arrays arrays init ; kernel.private byte-arrays arrays init ;
@ -18,6 +18,14 @@ PREDICATE: pinned-alien < alien underlying>> pinned-c-ptr? ;
UNION: pinned-c-ptr UNION: pinned-c-ptr
pinned-alien POSTPONE: f ; pinned-alien POSTPONE: f ;
GENERIC: >c-ptr ( obj -- c-ptr )
M: c-ptr >c-ptr ;
SLOT: underlying
M: object >c-ptr underlying>> ;
GENERIC: expired? ( c-ptr -- ? ) flushable GENERIC: expired? ( c-ptr -- ? ) flushable
M: alien expired? expired>> ; M: alien expired? expired>> ;