diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 9db6ac7f4a..a9392b03d7 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -17,8 +17,9 @@ SYMBOLS: long ulong longlong ulonglong float double - bool void* - void ; + void* bool ; + +SINGLETON: void DEFER: DEFER: *char @@ -48,9 +49,6 @@ ERROR: no-c-type name ; ! C type protocol GENERIC: c-type ( name -- c-type ) foldable -: void? ( c-type -- ? ) - void = ; inline - PREDICATE: c-type-word < word "c-type" word-prop ; @@ -64,14 +62,6 @@ UNION: c-type-name dup void? [ no-c-type ] when dup c-type-name? [ c-type ] when ; -number ] map ] dip ; - -PRIVATE> - M: word c-type dup "c-type" word-prop resolve-typedef [ ] [ no-c-type ] ?if ; diff --git a/basis/alien/libraries/authors.txt b/basis/alien/libraries/authors.txt index 1901f27a24..580f882c8d 100644 --- a/basis/alien/libraries/authors.txt +++ b/basis/alien/libraries/authors.txt @@ -1 +1,2 @@ Slava Pestov +Joe Groff diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor index 6f80900da0..47e34fe5ff 100644 --- a/basis/alien/libraries/libraries.factor +++ b/basis/alien/libraries/libraries.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.strings assocs io.backend kernel namespaces destructors sequences system io.pathnames ; @@ -9,10 +9,8 @@ IN: alien.libraries : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ; SYMBOL: libraries -SYMBOL: deploy-libraries libraries [ H{ } clone ] initialize -deploy-libraries [ V{ } clone ] initialize TUPLE: library path abi dll ; @@ -37,18 +35,29 @@ M: library dispose dll>> [ dispose ] when* ; [ 2drop remove-library ] [ swap libraries get set-at ] 3bi ; +: library-abi ( library -- abi ) + library [ abi>> ] [ "cdecl" ] if* ; + +SYMBOL: deploy-libraries + +deploy-libraries [ V{ } clone ] initialize + : deploy-library ( name -- ) dup libraries get key? [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ] [ no-library ] if ; deployed-library-path os ( path -- path' ) M: windows >deployed-library-path file-name ; + M: unix >deployed-library-path file-name "$ORIGIN" prepend-path ; + M: macosx >deployed-library-path file-name "@executable_path/../Frameworks" prepend-path ; + PRIVATE> diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 837c2e3bdc..474bb77dc6 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. +! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types alien.parser alien.libraries arrays assocs classes combinators @@ -67,16 +67,16 @@ IN: alien.parser 2 group [ first2 normalize-c-arg 2array ] map unzip [ "," ?tail drop ] map ] - [ [ { } ] [ 1array ] if-void ] + [ [ { } ] [ name>> 1array ] if-void ] bi* ; : function-quot ( return library function types -- quot ) '[ _ _ _ _ alien-invoke ] ; :: make-function ( return library function parameters -- word quot effect ) - return function normalize-c-arg :> ( return-c-type function ) + return function normalize-c-arg :> ( return function ) function create-in dup reset-generic - return-c-type library function + return library function parameters return parse-arglist [ function-quot ] dip ; : parse-arg-tokens ( -- tokens ) @@ -89,13 +89,10 @@ IN: alien.parser make-function define-declared ; : callback-quot ( return types abi -- quot ) - [ [ ] 3curry dip alien-callback ] 3curry ; + '[ [ _ _ _ ] dip alien-callback ] ; -: 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! +:: make-callback-type ( lib return type-name parameters -- word quot effect ) + return type-name normalize-c-arg :> ( return type-name ) type-name current-vocab create :> type-word type-word [ reset-generic ] [ reset-c-type ] bi void* type-word typedef @@ -116,4 +113,3 @@ PREDICATE: alien-function-word < word PREDICATE: alien-callback-type-word < typedef-word "callback-effect" word-prop ; - diff --git a/basis/compiler/tests/redefine24.factor b/basis/compiler/tests/redefine24.factor new file mode 100644 index 0000000000..391102102e --- /dev/null +++ b/basis/compiler/tests/redefine24.factor @@ -0,0 +1,39 @@ +USING: alien alien.syntax eval math tools.test ; +QUALIFIED: alien.c-types +IN: compiler.tests.redefine24 + +TYPEDEF: alien.c-types:int type-1 + +TYPEDEF: alien.c-types:int type-3 + +: callback ( -- ptr ) + type-3 { type-1 type-1 } "cdecl" [ + >integer ] alien-callback ; + +TYPEDEF: alien.c-types:float type-2 + +: indirect ( x y ptr -- z ) + type-3 { type-2 type-2 } "cdecl" alien-indirect ; + +[ ] [ + "USING: alien.c-types alien.syntax ; + IN: compiler.tests.redefine24 TYPEDEF: int type-2" eval( -- ) +] unit-test + +[ 3 ] [ 1 2 callback indirect ] unit-test + +[ ] [ + "USING: alien.c-types alien.syntax ; + IN: compiler.tests.redefine24 + TYPEDEF: float type-1 + TYPEDEF: float type-2" eval( -- ) +] unit-test + +[ 3 ] [ 1.0 2.0 callback indirect ] unit-test + +[ ] [ + "USING: alien.c-types alien.syntax ; + IN: compiler.tests.redefine24 + TYPEDEF: float type-3" eval( -- ) +] unit-test + +[ 3.0 ] [ 1.0 2.0 callback indirect ] unit-test diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index fdfda6dd9e..81d8a93240 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -3,7 +3,7 @@ USING: kernel sequences accessors combinators math namespaces init sets words assocs alien.libraries alien alien.c-types cpu.architecture fry stack-checker.backend stack-checker.errors -stack-checker.visitor ; +stack-checker.visitor stack-checker.dependencies ; IN: stack-checker.alien TUPLE: alien-node-params return parameters abi in-d out-d ; @@ -16,65 +16,91 @@ TUPLE: alien-assembly-params < alien-node-params quot ; TUPLE: alien-callback-params < alien-node-params quot xt ; -: param-prep-quot ( node -- quot ) +: param-prep-quot ( params -- quot ) parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ; +: infer-params ( params -- ) + param-prep-quot infer-quot-here ; + : alien-stack ( params extra -- ) over parameters>> length + consume-d >>in-d dup return>> void? 0 1 ? produce-d >>out-d drop ; -: return-prep-quot ( node -- quot ) +: return-prep-quot ( params -- quot ) return>> [ [ ] ] [ c-type c-type-boxer-quot ] if-void ; +: infer-return ( params -- ) + return-prep-quot infer-quot-here ; + +: pop-return ( params -- params ) + pop-literal [ depends-on-c-type ] [ nip >>return ] bi ; + +: pop-library ( params -- params ) + pop-literal nip >>library ; + +: pop-function ( params -- params ) + pop-literal nip >>function ; + +: pop-params ( params -- params ) + pop-literal [ [ depends-on-c-type ] each ] [ nip >>parameters ] bi ; + +: pop-abi ( params -- params ) + pop-literal nip >>abi ; + +: pop-quot ( params -- params ) + pop-literal nip >>quot ; + : infer-alien-invoke ( -- ) alien-invoke-params new ! Compile-time parameters - pop-literal nip >>parameters - pop-literal nip >>function - pop-literal nip >>library - pop-literal nip >>return - ! Quotation which coerces parameters to required types - dup param-prep-quot infer-quot-here + pop-params + pop-function + pop-library + pop-return ! Set ABI - dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi + dup library>> library-abi >>abi + ! Quotation which coerces parameters to required types + dup infer-params ! Magic #: consume exactly the number of inputs dup 0 alien-stack ! Add node to IR dup #alien-invoke, ! Quotation which coerces return value to required type - return-prep-quot infer-quot-here ; + infer-return ; : infer-alien-indirect ( -- ) alien-indirect-params new ! Compile-time parameters - pop-literal nip >>abi - pop-literal nip >>parameters - pop-literal nip >>return + pop-abi + pop-params + pop-return ! Quotation which coerces parameters to required types - dup param-prep-quot '[ _ dip ] infer-quot-here + 1 infer->r + dup infer-params + 1 infer-r> ! Magic #: consume the function pointer, too dup 1 alien-stack ! Add node to IR dup #alien-indirect, ! Quotation which coerces return value to required type - return-prep-quot infer-quot-here ; + infer-return ; : infer-alien-assembly ( -- ) alien-assembly-params new ! Compile-time parameters - pop-literal nip >>quot - pop-literal nip >>abi - pop-literal nip >>parameters - pop-literal nip >>return + pop-quot + pop-abi + pop-params + pop-return ! Quotation which coerces parameters to required types - dup param-prep-quot infer-quot-here + dup infer-params ! Magic #: consume exactly the number of inputs dup 0 alien-stack ! Add node to IR dup #alien-assembly, ! Quotation which coerces return value to required type - return-prep-quot infer-quot-here ; + infer-return ; : callback-xt ( word return-rewind -- alien ) [ callbacks get ] dip '[ _ ] cache ; @@ -85,10 +111,10 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; : infer-alien-callback ( -- ) alien-callback-params new - pop-literal nip >>quot - pop-literal nip >>abi - pop-literal nip >>parameters - pop-literal nip >>return + pop-quot + pop-abi + pop-params + pop-return "( callback )" >>xt dup callback-bottom #alien-callback, ; diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor index ffa021c9f6..e2f7c57593 100644 --- a/basis/stack-checker/dependencies/dependencies.factor +++ b/basis/stack-checker/dependencies/dependencies.factor @@ -40,7 +40,9 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ; GENERIC: depends-on-c-type ( c-type -- ) -M: word depends-on-c-type depends-on-definition ; +M: void depends-on-c-type drop ; + +M: c-type-word depends-on-c-type depends-on-definition ; M: array depends-on-c-type [ word? ] filter [ depends-on-definition ] each ; diff --git a/basis/windows/ddk/hid/platforms.txt b/basis/windows/ddk/hid/platforms.txt new file mode 100644 index 0000000000..205e64323d --- /dev/null +++ b/basis/windows/ddk/hid/platforms.txt @@ -0,0 +1 @@ +winnt