From cee5862b69425b48752f3a382f2b0951ad1cb184 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 21:10:11 -0500 Subject: [PATCH] update a bunch of alien-callbacks and alien-indirects to use c-type words --- .../compiler/cfg/builder/builder-tests.factor | 4 +- basis/compiler/tests/alien.factor | 50 +++++++++---------- .../core-foundation/fsevents/fsevents.factor | 4 +- .../core-foundation/run-loop/run-loop.factor | 2 +- basis/db/sqlite/ffi/ffi.factor | 4 +- .../multiplexers/run-loop/run-loop.factor | 5 +- basis/tools/deploy/test/9/9.factor | 6 +-- basis/tools/profiler/profiler-tests.factor | 4 +- basis/ui/backend/windows/windows.factor | 2 +- core/alien/alien-docs.factor | 4 +- extra/benchmark/fib6/fib6.factor | 6 +-- extra/noise/noise.factor | 2 +- 12 files changed, 47 insertions(+), 46 deletions(-) diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index e3ad8e6074..a4651b87b5 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -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 ] diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index cc835a8a8f..ef8cb5f0a4 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -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 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 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 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 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 diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 6f5484fb77..24ac24bb6a 100755 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -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 diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 7b454266f2..0b61274b22 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -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 ( -- ) diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor index 2f7bec1b54..c180df9bf5 100644 --- a/basis/db/sqlite/ffi/ffi.factor +++ b/basis/db/sqlite/ffi/ffi.factor @@ -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 diff --git a/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor b/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor index 84a609643a..276949a99f 100644 --- a/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor +++ b/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor @@ -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 diff --git a/basis/tools/deploy/test/9/9.factor b/basis/tools/deploy/test/9/9.factor index a1cbd5bc66..642ee48e67 100644 --- a/basis/tools/deploy/test/9/9.factor +++ b/basis/tools/deploy/test/9/9.factor @@ -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 diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index dda531faee..f7da0d1636 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -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 ( -- ) ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 0e07ff6611..7dbe3a3c48 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -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 diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 9fb9c042ee..6787d3714b 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -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." } ; diff --git a/extra/benchmark/fib6/fib6.factor b/extra/benchmark/fib6/fib6.factor index 7ddd58468a..561110d941 100755 --- a/extra/benchmark/fib6/fib6.factor +++ b/extra/benchmark/fib6/fib6.factor @@ -1,13 +1,13 @@ -USING: math kernel alien ; +USING: math kernel alien alien.c-types ; IN: benchmark.fib6 : fib ( x -- y ) - "int" { "int" } "cdecl" [ + int { int } "cdecl" [ dup 1 <= [ drop 1 ] [ 1 - dup fib swap 1 - fib + ] if ] alien-callback - "int" { "int" } "cdecl" alien-indirect ; + int { int } "cdecl" alien-indirect ; : fib-main ( -- ) 32 fib drop ; diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index 1ea5b95157..91e040d35f 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -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