diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 89e83a1d9b..59607fa781 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -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 diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index eea3515c8f..ded8f692cd 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -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 ] diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor index dbfc067bc6..070d06a8a1 100644 --- a/basis/alien/syntax/syntax-docs.factor +++ b/basis/alien/syntax/syntax-docs.factor @@ -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" } } diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index e27a5ef122..303a3914cb 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -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 ; diff --git a/basis/windows/dinput/dinput.factor b/basis/windows/dinput/dinput.factor index 157bde9dbd..70d9500a7b 100755 --- a/basis/windows/dinput/dinput.factor +++ b/basis/windows/dinput/dinput.factor @@ -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, diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 70ce13b0e6..6d0a2d96d1 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -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" } ;