change CALLBACK: to use the ABI of the current LIBRARY: and get rid of STDCALL-CALLBACK:
parent
bab0e23a30
commit
44f393771b
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types arrays assocs classes
|
||||
combinators combinators.short-circuit compiler.units effects
|
||||
grouping kernel parser sequences splitting words fry locals
|
||||
lexer namespaces summary math vocabs.parser ;
|
||||
USING: accessors alien alien.c-types alien.parser
|
||||
alien.libraries arrays assocs classes combinators
|
||||
combinators.short-circuit compiler.units effects grouping
|
||||
kernel parser sequences splitting words fry locals lexer
|
||||
namespaces summary math vocabs.parser ;
|
||||
IN: alien.parser
|
||||
|
||||
: parse-c-type-name ( name -- word )
|
||||
|
|
@ -27,7 +28,12 @@ IN: alien.parser
|
|||
: reset-c-type ( word -- )
|
||||
dup "struct-size" word-prop
|
||||
[ dup [ forget-class ] [ { "struct-size" } reset-props ] bi ] when
|
||||
{ "c-type" "pointer-c-type" "callback-effect" "callback-abi" } reset-props ;
|
||||
{
|
||||
"c-type"
|
||||
"pointer-c-type"
|
||||
"callback-effect"
|
||||
"callback-library"
|
||||
} reset-props ;
|
||||
|
||||
: CREATE-C-TYPE ( -- word )
|
||||
scan current-vocab create {
|
||||
|
|
@ -74,17 +80,21 @@ IN: alien.parser
|
|||
: callback-quot ( return types abi -- quot )
|
||||
[ [ ] 3curry dip alien-callback ] 3curry ;
|
||||
|
||||
:: make-callback-type ( abi return! type-name! parameters -- word quot effect )
|
||||
: library-abi ( lib -- abi )
|
||||
library [ abi>> ] [ "cdecl" ] if* ;
|
||||
|
||||
:: make-callback-type ( lib return! type-name! parameters -- word quot effect )
|
||||
return type-name normalize-c-arg type-name! return!
|
||||
type-name current-vocab create :> type-word
|
||||
type-word [ reset-generic ] [ reset-c-type ] bi
|
||||
void* type-word typedef
|
||||
parameters return parse-arglist :> callback-effect :> types
|
||||
type-word callback-effect "callback-effect" set-word-prop
|
||||
type-word abi "callback-abi" set-word-prop
|
||||
type-word return types abi callback-quot (( quot -- alien )) ;
|
||||
type-word lib "callback-library" set-word-prop
|
||||
type-word return types lib library-abi callback-quot (( quot -- alien )) ;
|
||||
|
||||
: (CALLBACK:) ( abi -- word quot effect )
|
||||
: (CALLBACK:) ( -- word quot effect )
|
||||
"c-library" get
|
||||
scan scan parse-arg-tokens make-callback-type ;
|
||||
|
||||
PREDICATE: alien-function-word < word
|
||||
|
|
|
|||
|
|
@ -45,13 +45,16 @@ M: typedef-word synopsis*
|
|||
first2 pprint-function-arg
|
||||
] if-empty ;
|
||||
|
||||
: pprint-library ( library -- )
|
||||
[ \ LIBRARY: [ text ] pprint-prefix ] when* ;
|
||||
|
||||
M: alien-function-word definer
|
||||
drop \ FUNCTION: \ ; ;
|
||||
M: alien-function-word definition drop f ;
|
||||
M: alien-function-word synopsis*
|
||||
{
|
||||
[ seeing-word ]
|
||||
[ def>> second [ \ LIBRARY: [ text ] pprint-prefix ] when* ]
|
||||
[ def>> second pprint-library ]
|
||||
[ definer. ]
|
||||
[ def>> first pprint-c-type ]
|
||||
[ pprint-word ]
|
||||
|
|
@ -64,13 +67,12 @@ M: alien-function-word synopsis*
|
|||
} cleave ;
|
||||
|
||||
M: alien-callback-type-word definer
|
||||
"callback-abi" word-prop "stdcall" =
|
||||
\ STDCALL-CALLBACK: \ CALLBACK: ?
|
||||
f ;
|
||||
drop \ CALLBACK: \ ; ;
|
||||
M: alien-callback-type-word definition drop f ;
|
||||
M: alien-callback-type-word synopsis*
|
||||
{
|
||||
[ seeing-word ]
|
||||
[ "callback-library" word-prop pprint-library ]
|
||||
[ definer. ]
|
||||
[ def>> first pprint-c-type ]
|
||||
[ pprint-word ]
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ STRUCT: forward { x backward* } ; """ } }
|
|||
HELP: CALLBACK:
|
||||
{ $syntax "CALLBACK: return type ( parameters ) ;" }
|
||||
{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
|
||||
{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters with the " { $snippet "\"cdecl\"" } " ABI." }
|
||||
{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters. The ABI of the callback is decided from the ABI of the active " { $link POSTPONE: LIBRARY: } " declaration." }
|
||||
{ $examples
|
||||
{ $code
|
||||
"CALLBACK: bool FakeCallback ( int message, void* payload ) ;"
|
||||
|
|
@ -92,25 +92,6 @@ HELP: CALLBACK:
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: STDCALL-CALLBACK:
|
||||
{ $syntax "STDCALL-CALLBACK: return type ( parameters ) ;" }
|
||||
{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
|
||||
{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters with the " { $snippet "\"stdcall\"" } " ABI." }
|
||||
{ $examples
|
||||
{ $code
|
||||
"STDCALL-CALLBACK: bool FakeCallback ( int message, void* payload ) ;"
|
||||
": MyFakeCallback ( -- alien )"
|
||||
" [| message payload |"
|
||||
" \"message #\" write"
|
||||
" message number>string write"
|
||||
" \" received\" write nl"
|
||||
" t"
|
||||
" ] FakeCallback ;"
|
||||
}
|
||||
} ;
|
||||
|
||||
{ POSTPONE: CALLBACK: POSTPONE: STDCALL-CALLBACK: } related-words
|
||||
|
||||
HELP: &:
|
||||
{ $syntax "&: symbol" }
|
||||
{ $values { "symbol" "A C library symbol name" } }
|
||||
|
|
|
|||
|
|
@ -19,10 +19,7 @@ SYNTAX: FUNCTION:
|
|||
(FUNCTION:) define-declared ;
|
||||
|
||||
SYNTAX: CALLBACK:
|
||||
"cdecl" (CALLBACK:) define-inline ;
|
||||
|
||||
SYNTAX: STDCALL-CALLBACK:
|
||||
"stdcall" (CALLBACK:) define-inline ;
|
||||
(CALLBACK:) define-inline ;
|
||||
|
||||
SYNTAX: TYPEDEF:
|
||||
scan-c-type CREATE-C-TYPE typedef ;
|
||||
|
|
|
|||
|
|
@ -297,23 +297,23 @@ STRUCT: DIJOYSTATE2
|
|||
TYPEDEF: DIJOYSTATE2* LPDIJOYSTATE2
|
||||
TYPEDEF: DIJOYSTATE2* LPCDIJOYSTATE2
|
||||
|
||||
STDCALL-CALLBACK: BOOL LPDIENUMDEVICESCALLBACKW (
|
||||
CALLBACK: BOOL LPDIENUMDEVICESCALLBACKW (
|
||||
LPCDIDEVICEINSTANCEW lpddi,
|
||||
LPVOID pvRef
|
||||
) ;
|
||||
STDCALL-CALLBACK: BOOL LPDICONFIGUREDEVICESCALLBACK (
|
||||
CALLBACK: BOOL LPDICONFIGUREDEVICESCALLBACK (
|
||||
IUnknown* lpDDSTarget,
|
||||
LPVOID pvRef
|
||||
) ;
|
||||
STDCALL-CALLBACK: BOOL LPDIENUMEFFECTSCALLBACKW (
|
||||
CALLBACK: BOOL LPDIENUMEFFECTSCALLBACKW (
|
||||
LPCDIEFFECTINFOW pdei,
|
||||
LPVOID pvRef
|
||||
) ;
|
||||
STDCALL-CALLBACK: BOOL LPDIENUMEFFECTSINFILECALLBACK (
|
||||
CALLBACK: BOOL LPDIENUMEFFECTSINFILECALLBACK (
|
||||
LPCDIFILEEFFECT lpDiFileEf,
|
||||
LPVOID pvRef
|
||||
) ;
|
||||
STDCALL-CALLBACK: BOOL LPDIENUMDEVICEOBJECTSCALLBACKW (
|
||||
CALLBACK: BOOL LPDIENUMDEVICEOBJECTSCALLBACKW (
|
||||
LPCDIDEVICEOBJECTINSTANCEW lpddoi,
|
||||
LPVOID pvRef
|
||||
) ;
|
||||
|
|
@ -330,7 +330,7 @@ COM-INTERFACE: IDirectInputEffect IUnknown {E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35
|
|||
HRESULT Unload ( )
|
||||
HRESULT Escape ( LPDIEFFESCAPE pesc ) ;
|
||||
|
||||
STDCALL-CALLBACK: BOOL LPDIENUMCREATEDEFFECTOBJECTSCALLBACK (
|
||||
CALLBACK: BOOL LPDIENUMCREATEDEFFECTOBJECTSCALLBACK (
|
||||
IDirectInputEffect* peff,
|
||||
LPVOID pvRef
|
||||
) ;
|
||||
|
|
@ -366,7 +366,7 @@ COM-INTERFACE: IDirectInputDevice8W IUnknown {54D41081-DC15-4833-A41B-748F73A381
|
|||
HRESULT SetActionMap ( LPDIACTIONFORMATW lpdiActionFormat, LPCWSTR lpwszUserName, DWORD dwFlags )
|
||||
HRESULT GetImageInfo ( LPDIDEVICEIMAGEINFOHEADERW lpdiDeviceImageInfoHeader ) ;
|
||||
|
||||
STDCALL-CALLBACK: BOOL LPDIENUMDEVICESBYSEMANTICSCBW (
|
||||
CALLBACK: BOOL LPDIENUMDEVICESBYSEMANTICSCBW (
|
||||
LPCDIDEVICEINSTANCEW lpddi,
|
||||
IDirectInputDevice8W* lpdid,
|
||||
DWORD dwFlags,
|
||||
|
|
|
|||
|
|
@ -176,7 +176,6 @@ ARTICLE: "alien-callback" "Calling Factor from C"
|
|||
"Callbacks can be defined and passed to C code as function pointers; the C code can then invoke the callback and run Factor code:"
|
||||
{ $subsection alien-callback }
|
||||
{ $subsection POSTPONE: CALLBACK: }
|
||||
{ $subsection POSTPONE: STDCALL-CALLBACK: }
|
||||
"There are some caveats concerning the conversion of Factor objects to C values, and vice versa. See " { $link "c-data" } "."
|
||||
{ $subsection "alien-callback-gc" }
|
||||
{ $see-also "byte-arrays-gc" } ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue