diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor index 289581a929..ae8ef62c16 100644 --- a/basis/windows/com/com-tests.factor +++ b/basis/windows/com/com-tests.factor @@ -37,13 +37,13 @@ TUPLE: test-implementation x ; C: 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 + void* heap-size +guinea-pig-implementation+ get +guinea-pig-implementation+ get 2array [ +guinea-pig-implementation+ get IUnrelated-iid com-query-interface diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index e4f0ef0654..27672df833 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -52,13 +52,13 @@ unless swap GUID memory>struct _ case [ - "void*" heap-size * rot com-add-ref + void* heap-size * rot 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 ] ] + [ void* heap-size neg * '[ _ swap ] ] 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 )