change CALLBACK: to use the ABI of the current LIBRARY: and get rid of STDCALL-CALLBACK:

diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 89e83a1d9bf8532a0313e440a0c0e275dcf140c2..59607fa7813fdb09be7464b9cce6ef90afd44f09 100644 (file)
--- 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 eea3515c8f38cd2c55fd8b4f9005f3c73af11732..ded8f692cdf874da97dabefe3f57d2aab4c6eb19 100644 (file)
--- 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 dbfc067bc6284acdc94bc920a688b7d14dff28ac..070d06a8a1e1828e0352daaebe7620a4e26f8523 100644 (file)
--- 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 e27a5ef122e1664bc03779ab6d39fcb67c51e9cf..303a3914cbe2a1e6d68da0ab9795fd2c25d81541 100644 (file)
--- 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 157bde9dbd1a83a326a5ad29923f2a363b8dfd61..70d9500a7bb9728eee2f7517f86c220811182570 100755 (executable)
--- 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 70ce13b0e6748b3d34e8bde608b4af6ff1c2b7f5..6d0a2d96d136491dc0873d59d0600336af818570 100644 (file)
--- 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" } ;