]> gitweb.factorcode.org Git - factor.git/commitdiff
update a bunch of alien-callbacks and alien-indirects to use c-type words
authorJoe Groff <arcata@gmail.com>
Thu, 22 Oct 2009 02:10:11 +0000 (21:10 -0500)
committerJoe Groff <arcata@gmail.com>
Thu, 22 Oct 2009 02:10:11 +0000 (21:10 -0500)
12 files changed:
basis/compiler/cfg/builder/builder-tests.factor
basis/compiler/tests/alien.factor
basis/core-foundation/fsevents/fsevents.factor
basis/core-foundation/run-loop/run-loop.factor
basis/db/sqlite/ffi/ffi.factor
basis/io/backend/unix/multiplexers/run-loop/run-loop.factor
basis/tools/deploy/test/9/9.factor
basis/tools/profiler/profiler-tests.factor
basis/ui/backend/windows/windows.factor
core/alien/alien-docs.factor
extra/benchmark/fib6/fib6.factor
extra/noise/noise.factor

index e3ad8e607468f97f5273acc22506012c973f8b7f..a4651b87b56658b86b81a7ae1d7bf870cb58ef43 100644 (file)
@@ -68,8 +68,8 @@ IN: compiler.cfg.builder.tests
     [ [ dup ] loop ]
     [ [ 2 ] [ 3 throw ] if 4 ]
     [ int f "malloc" { int } alien-invoke ]
-    [ "int" { "int" } "cdecl" alien-indirect ]
-    [ "int" { "int" } "cdecl" [ ] alien-callback ]
+    [ int { int } "cdecl" alien-indirect ]
+    [ int { int } "cdecl" [ ] alien-callback ]
     [ swap - + * ]
     [ swap slot ]
     [ blahblah ]
index cc835a8a8f9b7f05cbdd6f68f2581adc96b338de..ef8cb5f0a4986ad72f2a829de564f76a46a4e964 100755 (executable)
@@ -90,14 +90,14 @@ FUNCTION: TINY ffi_test_17 int x ;
 [ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
 
 : indirect-test-1 ( ptr -- result )
-    "int" { } "cdecl" alien-indirect ;
+    int { } "cdecl" alien-indirect ;
 
 { 1 1 } [ indirect-test-1 ] must-infer-as
 
 [ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
 
 : indirect-test-1' ( ptr -- )
-    "int" { } "cdecl" alien-indirect drop ;
+    int { } "cdecl" alien-indirect drop ;
 
 { 1 0 } [ indirect-test-1' ] must-infer-as
 
@@ -106,7 +106,7 @@ FUNCTION: TINY ffi_test_17 int x ;
 [ -1 indirect-test-1 ] must-fail
 
 : indirect-test-2 ( x y ptr -- result )
-    "int" { "int" "int" } "cdecl" alien-indirect gc ;
+    int { int int } "cdecl" alien-indirect gc ;
 
 { 3 1 } [ indirect-test-2 ] must-infer-as
 
@@ -115,7 +115,7 @@ FUNCTION: TINY ffi_test_17 int x ;
 unit-test
 
 : indirect-test-3 ( a b c d ptr -- result )
-    "int" { "int" "int" "int" "int" } "stdcall" alien-indirect
+    int { int int int int } "stdcall" alien-indirect
     gc ;
 
 [ f ] [ "f-stdcall" load-library f = ] unit-test
@@ -312,21 +312,21 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
 
 ! Test callbacks
 
-: callback-1 ( -- callback ) "void" { } "cdecl" [ ] alien-callback ;
+: callback-1 ( -- callback ) void { } "cdecl" [ ] alien-callback ;
 
 [ 0 1 ] [ [ callback-1 ] infer [ in>> ] [ out>> ] bi ] unit-test
 
 [ t ] [ callback-1 alien? ] unit-test
 
-: callback_test_1 ( ptr -- ) "void" { } "cdecl" alien-indirect ;
+: callback_test_1 ( ptr -- ) void { } "cdecl" alien-indirect ;
 
 [ ] [ callback-1 callback_test_1 ] unit-test
 
-: callback-2 ( -- callback ) "void" { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
+: callback-2 ( -- callback ) void { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
 
 [ ] [ callback-2 callback_test_1 ] unit-test
 
-: callback-3 ( -- callback ) "void" { } "cdecl" [ 5 "x" set ] alien-callback ;
+: callback-3 ( -- callback ) void { } "cdecl" [ 5 "x" set ] alien-callback ;
 
 [ t ] [
     namestack*
@@ -341,7 +341,7 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
 ] unit-test
 
 : callback-4 ( -- callback )
-    "void" { } "cdecl" [ "Hello world" write ] alien-callback
+    void { } "cdecl" [ "Hello world" write ] alien-callback
     gc ;
 
 [ "Hello world" ] [
@@ -349,40 +349,40 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
 ] unit-test
 
 : callback-5 ( -- callback )
-    "void" { } "cdecl" [ gc ] alien-callback ;
+    void { } "cdecl" [ gc ] alien-callback ;
 
 [ "testing" ] [
     "testing" callback-5 callback_test_1
 ] unit-test
 
 : callback-5b ( -- callback )
-    "void" { } "cdecl" [ compact-gc ] alien-callback ;
+    void { } "cdecl" [ compact-gc ] alien-callback ;
 
 [ "testing" ] [
     "testing" callback-5b callback_test_1
 ] unit-test
 
 : callback-6 ( -- callback )
-    "void" { } "cdecl" [ [ continue ] callcc0 ] alien-callback ;
+    void { } "cdecl" [ [ continue ] callcc0 ] alien-callback ;
 
 [ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
 
 : callback-7 ( -- callback )
-    "void" { } "cdecl" [ 1000000 sleep ] alien-callback ;
+    void { } "cdecl" [ 1000000 sleep ] alien-callback ;
 
 [ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test
 
 [ f ] [ namespace global eq? ] unit-test
 
 : callback-8 ( -- callback )
-    "void" { } "cdecl" [
+    void { } "cdecl" [
         [ continue ] callcc0
     ] alien-callback ;
 
 [ ] [ callback-8 callback_test_1 ] unit-test
 
 : callback-9 ( -- callback )
-    "int" { "int" "int" "int" } "cdecl" [
+    int { int int int } "cdecl" [
         + + 1 +
     ] alien-callback ;
 
@@ -440,13 +440,13 @@ STRUCT: double-rect
     } cleave ;
 
 : double-rect-callback ( -- alien )
-    "void" { "void*" "void*" "double-rect" } "cdecl"
+    void { void* void* double-rect } "cdecl"
     [ "example" set-global 2drop ] alien-callback ;
 
 : double-rect-test ( arg -- arg' )
     f f rot
     double-rect-callback
-    "void" { "void*" "void*" "double-rect" } "cdecl" alien-indirect
+    void { void* void* double-rect } "cdecl" alien-indirect
     "example" get-global ;
 
 [ 1.0 2.0 3.0 4.0 ]
@@ -463,7 +463,7 @@ FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ;
 ] unit-test
 
 : callback-10 ( -- callback )
-    "test_struct_14" { "double" "double" } "cdecl"
+    test_struct_14 { double double } "cdecl"
     [
         test_struct_14 <struct>
             swap >>x2
@@ -471,7 +471,7 @@ FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ;
     ] alien-callback ;
 
 : callback-10-test ( x1 x2 callback -- result )
-    "test_struct_14" { "double" "double" } "cdecl" alien-indirect ;
+    test_struct_14 { double double } "cdecl" alien-indirect ;
 
 [ 1.0 2.0 ] [
     1.0 2.0 callback-10 callback-10-test
@@ -486,7 +486,7 @@ FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ;
 ] unit-test
 
 : callback-11 ( -- callback )
-    "test-struct-12" { "int" "double" } "cdecl"
+    test-struct-12 { int double } "cdecl"
     [
         test-struct-12 <struct>
             swap >>x
@@ -494,7 +494,7 @@ FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ;
     ] alien-callback ;
 
 : callback-11-test ( x1 x2 callback -- result )
-    "test-struct-12" { "int" "double" } "cdecl" alien-indirect ;
+    test-struct-12 { int double } "cdecl" alien-indirect ;
 
 [ 1 2.0 ] [
     1 2.0 callback-11 callback-11-test
@@ -510,7 +510,7 @@ FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ;
 [ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test
 
 : callback-12 ( -- callback )
-    "test_struct_15" { "float" "float" } "cdecl"
+    test_struct_15 { float float } "cdecl"
     [
         test_struct_15 <struct>
             swap >>y
@@ -518,7 +518,7 @@ FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ;
     ] alien-callback ;
 
 : callback-12-test ( x1 x2 callback -- result )
-    "test_struct_15" { "float" "float" } "cdecl" alien-indirect ;
+    test_struct_15 { float float } "cdecl" alien-indirect ;
 
 [ 1.0 2.0 ] [
     1.0 2.0 callback-12 callback-12-test [ x>> ] [ y>> ] bi
@@ -533,7 +533,7 @@ FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ;
 [ 1.0 2 ] [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test
 
 : callback-13 ( -- callback )
-    "test_struct_16" { "float" "int" } "cdecl"
+    test_struct_16 { float int } "cdecl"
     [
         test_struct_16 <struct>
             swap >>a
@@ -541,7 +541,7 @@ FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ;
     ] alien-callback ;
 
 : callback-13-test ( x1 x2 callback -- result )
-    "test_struct_16" { "float" "int" } "cdecl" alien-indirect ;
+    test_struct_16 { float int } "cdecl" alien-indirect ;
 
 [ 1.0 2 ] [
     1.0 2 callback-13 callback-13-test
index 6f5484fb77199198a60899a3882c2c60beb2f7eb..24ac24bb6aa9dd8114528e78b0c51a3260297688 100755 (executable)
@@ -36,8 +36,8 @@ STRUCT: FSEventStreamContext
     { release void* }
     { copyDescription void* } ;
 
-! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]);
-TYPEDEF: void* FSEventStreamCallback
+! callback(
+CALLBACK: void FSEventStreamCallback ( FSEventStreamRef streamRef, void* clientCallBackInfo, size_t numEvents, void* eventPaths, FSEventStreamEventFlags* eventFlags, FSEventStreamEventId* eventIds ) ;
 
 CONSTANT: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF
 
index 7b454266f26bdcbc8276e8cdd6b88c5786254d38..0b61274b22fc6debce7bf44ea8b416de8f565a89 100644 (file)
@@ -115,7 +115,7 @@ PRIVATE>
     [ fds>> [ enable-all-callbacks ] each ] bi ;
 
 : timer-callback ( -- callback )
-    "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
+    void { CFRunLoopTimerRef void* } "cdecl"
     [ 2drop reset-run-loop yield ] alien-callback ;
 
 : init-thread-timer ( -- )
index 2f7bec1b54e11645b7d1aaff830ff774c8871e9f..c180df9bf545f9deab319365946ad5c3980a61f1 100644 (file)
@@ -99,8 +99,8 @@ CONSTANT: SQLITE_OPEN_TEMP_JOURNAL     HEX: 00001000
 CONSTANT: SQLITE_OPEN_SUBJOURNAL       HEX: 00002000
 CONSTANT: SQLITE_OPEN_MASTER_JOURNAL   HEX: 00004000
 
-TYPEDEF: void sqlite3
-TYPEDEF: void sqlite3_stmt
+TYPEDEF: void* sqlite3*
+TYPEDEF: void* sqlite3_stmt*
 TYPEDEF: longlong sqlite3_int64
 TYPEDEF: ulonglong sqlite3_uint64
 
index 84a609643abde1514b9c7ba3c6349e81e4343467..276949a99fadcb501776a8981994e082ab117299 100644 (file)
@@ -3,13 +3,14 @@
 USING: kernel arrays namespaces math accessors alien locals
 destructors system threads io.backend.unix.multiplexers
 io.backend.unix.multiplexers.kqueue core-foundation
-core-foundation.run-loop ;
+core-foundation.run-loop core-foundation.file-descriptors ;
+FROM: alien.c-types => void void* ;
 IN: io.backend.unix.multiplexers.run-loop
 
 TUPLE: run-loop-mx kqueue-mx ;
 
 : file-descriptor-callback ( -- callback )
-    "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
+    void { CFFileDescriptorRef CFOptionFlags void* }
     "cdecl" [
         3drop
         0 mx get kqueue-mx>> wait-for-events
index a1cbd5bc668f3fa27bac0352ced9406bd8466a66..642ee48e6769a8b6f3a58e8154d5f198ff6ad6bc 100644 (file)
@@ -1,10 +1,10 @@
-USING: alien kernel math ;
+USING: alien alien.c-types kernel math ;
 IN: tools.deploy.test.9
 
 : callback-test ( -- callback )
-    "int" { "int" } "cdecl" [ 1 + ] alien-callback ;
+    int { int } "cdecl" [ 1 + ] alien-callback ;
 
 : indirect-test ( -- )
-    10 callback-test "int" { "int" } "cdecl" alien-indirect 11 assert= ;
+    10 callback-test int { int } "cdecl" alien-indirect 11 assert= ;
 
 MAIN: indirect-test
index dda531faeed1c0e3871806c2efb196b7c16b5cf5..f7da0d163691c4c4af47cea91a778b2180ce089d 100644 (file)
@@ -21,9 +21,9 @@ words ;
 
 [ ] [ \ + usage-profile. ] unit-test
 
-: callback-test ( -- callback ) "void" { } "cdecl" [ ] alien-callback ;
+: callback-test ( -- callback ) void { } "cdecl" [ ] alien-callback ;
 
-: indirect-test ( callback -- ) "void" { } "cdecl" alien-indirect ;
+: indirect-test ( callback -- ) void { } "cdecl" alien-indirect ;
 
 : foobar ( -- ) ;
 
index 0e07ff6611cac616fc2ac496c01e325db5f690ff..7dbe3a3c48ed3d6a98bb686b883e3094b5a9c0bc 100755 (executable)
@@ -596,7 +596,7 @@ SYMBOL: trace-messages?
 
 ! return 0 if you handle the message, else just let DefWindowProc return its val
 : ui-wndproc ( -- object )
-    "uint" { "void*" "uint" "long" "long" } "stdcall" [
+    uint { void* uint long long } "stdcall" [
         pick
         trace-messages? get-global [ dup windows-message-name name>> print flush ] when
         wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
index 9fb9c042eea605d96f7b73ffd4de267d7076f159..6787d3714b4f5f34cfebc62506639e92d697e33d 100644 (file)
@@ -79,7 +79,7 @@ HELP: alien-callback-error
 HELP: alien-callback
 { $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "quot" "a quotation" } { "alien" alien } }
 { $description
-    "Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller. A return type of " { $snippet "\"void\"" } " indicates that no value is to be returned."
+    "Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller. A return type of " { $snippet "void" } " indicates that no value is to be returned."
     $nl
     "When a compiled reference to this word is called, it pushes the callback's alien address on the data stack. This address can be passed to any C function expecting a C function pointer with the correct signature. The callback is actually generated when the word calling " { $link alien-callback } " is compiled."
     $nl
@@ -90,7 +90,7 @@ HELP: alien-callback
     "A simple example, showing a C function which returns the difference of two given integers:"
     { $code
         ": difference-callback ( -- alien )"
-        "    \"int\" { \"int\" \"int\" } \"cdecl\" [ - ] alien-callback ;"
+        "    int { int int } \"cdecl\" [ - ] alien-callback ;"
     }
 }
 { $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ;
index 7ddd58468abc87015d89059498146c34a864d084..561110d941d0624760c000a1a22e4f9cd8695008 100755 (executable)
@@ -1,13 +1,13 @@
-USING: math kernel alien ;\r
+USING: math kernel alien alien.c-types ;\r
 IN: benchmark.fib6\r
 \r
 : fib ( x -- y )\r
-    "int" { "int" } "cdecl" [\r
+    int { int } "cdecl" [\r
         dup 1 <= [ drop 1 ] [\r
             1 - dup fib swap 1 - fib +\r
         ] if\r
     ] alien-callback\r
-    "int" { "int" } "cdecl" alien-indirect ;\r
+    int { int } "cdecl" alien-indirect ;\r
 \r
 : fib-main ( -- ) 32 fib drop ;\r
 \r
index 1ea5b951573fb30c58b5029515676afd7657ad2b..91e040d35f28d614f9c0a46506887c94c88cbd1d 100644 (file)
@@ -56,7 +56,7 @@ ERROR: invalid-perlin-noise-table table ;
     dup { [ byte-array? ] [ length 512 >= ] } 1&&
     [ invalid-perlin-noise-table ] unless ;
 
-! XXX doesn't work for NaNs or floats > 2^31
+! XXX doesn't work when v is nan or |v| >= 2^31
 : floor-vector ( v -- v' )
     [ float-4 int-4 vconvert int-4 float-4 vconvert ]
     [ [ v> -1.0 float-4-with vand ] curry keep v+ ] bi ; inline