Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-09-30 18:52:18 -05:00
commit e8db7b62a4
2 changed files with 12 additions and 12 deletions

View File

@ -37,13 +37,13 @@ TUPLE: test-implementation x ;
C: <test-implementation> test-implementation
{
{ "IInherited" {
{ IInherited {
[ drop S_OK ] ! ISimple::returnOK
[ drop E_FAIL ] ! ISimple::returnError
[ x>> ] ! IInherited::getX
[ >>x drop ] ! IInherited::setX
} }
{ "IUnrelated" {
{ IUnrelated {
[ swap x>> + ] ! IUnrelated::xPlus
[ spin x>> * + ] ! IUnrelated::xMulAdd
} }
@ -85,7 +85,7 @@ dup +test-wrapper+ set [
+guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release
] unit-test
"void*" heap-size +guinea-pig-implementation+ get <displaced-alien>
void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get
2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface

View File

@ -52,13 +52,13 @@ unless
swap GUID memory>struct
_ case
[
"void*" heap-size * rot <displaced-alien> com-add-ref
void* heap-size * rot <displaced-alien> com-add-ref
swap 0 set-alien-cell S_OK
] [ nip f swap 0 set-alien-cell E_NOINTERFACE ] if*
] ;
: (make-add-ref) ( interfaces -- quot )
length "void*" heap-size * '[
length void* heap-size * '[
_
[ alien-unsigned-4 1 + dup ]
[ set-alien-unsigned-4 ]
@ -66,7 +66,7 @@ unless
] ;
: (make-release) ( interfaces -- quot )
length "void*" heap-size * '[
length void* heap-size * '[
_
[ drop ]
[ alien-unsigned-4 1 - dup ]
@ -84,7 +84,7 @@ unless
: (thunk) ( n -- quot )
dup 0 =
[ drop [ ] ]
[ "void*" heap-size neg * '[ _ swap <displaced-alien> ] ]
[ void* heap-size neg * '[ _ swap <displaced-alien> ] ]
if ;
: (thunked-quots) ( quots iunknown-methods thunk -- {thunk,quot}s )
@ -97,15 +97,15 @@ unless
[ [ (( -- alien )) define-declared ] pick [ call ] dip ]
with-compilation-unit ;
: (callback-word) ( function-name interface-name counter -- word )
[ "::" rot 3append "-callback-" ] dip number>string 3append
: (callback-word) ( function-name interface counter -- word )
[ name>> "::" rot 3append "-callback-" ] dip number>string 3append
"windows.com.wrapper.callbacks" create ;
: (finish-thunk) ( param-count thunk quot -- thunked-quot )
[ [ drop [ ] ] [ swap 1 - '[ _ _ ndip ] ] if-empty ]
dip compose ;
: (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )
: (make-interface-callbacks) ( interface quots iunknown-methods n -- words )
(thunk) (thunked-quots)
swap [ find-com-interface-definition family-tree-functions ]
keep (next-vtbl-counter) '[
@ -128,8 +128,8 @@ unless
curry map-index ;
: (malloc-wrapped-object) ( wrapper -- wrapped-object )
vtbls>> length "void*" heap-size *
[ "ulong" heap-size + malloc ] keep
vtbls>> length void* heap-size *
[ ulong heap-size + malloc ] keep
[ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
: (callbacks>vtbl) ( callbacks -- vtbl )