From 757842969255009581ff81d00ca4e12806fbad99 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 22 Feb 2010 21:31:41 +1300 Subject: [PATCH 1/4] alien.c-types: remove void? word --- basis/alien/c-types/c-types.factor | 8 +++----- basis/alien/parser/parser.factor | 4 ++-- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index a929cba954..c25f465600 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 - void* bool - void ; + void* bool ; + +SINGLETON: void DEFER: DEFER: *char @@ -57,9 +58,6 @@ GENERIC: resolve-pointer-type ( name -- c-type ) << \ void \ void* "pointer-c-type" set-word-prop >> -: void? ( c-type -- ? ) - { void "void" } member? ; - M: word resolve-pointer-type dup "pointer-c-type" word-prop [ ] [ drop void* ] ?if ; diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index d706446799..dc0a1701f2 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 @@ -66,7 +66,7 @@ IN: alien.parser 2 group [ first2 normalize-c-arg 2array ] map unzip [ "," ?tail drop ] map ] - [ [ { } ] [ 1array ] if-void ] + [ dup "void" = [ drop { } ] [ 1array ] if ] bi* ; : function-quot ( return library function types -- quot ) From eb3f8632dd347cc1a1364b4a5388257335884c8b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 22 Feb 2010 21:32:41 +1300 Subject: [PATCH 2/4] stack-checker.alien: now that C types are words, the compiler can add dependencies on them when compiling alien words. This triggers the necessary recompilation when C types are redefined --- basis/compiler/tests/redefine24.factor | 39 ++++++++++ basis/stack-checker/alien/alien.factor | 76 +++++++++++++------ .../dependencies/dependencies.factor | 2 + 3 files changed, 92 insertions(+), 25 deletions(-) create mode 100644 basis/compiler/tests/redefine24.factor 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..09121488ef 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 + ! 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 1bd7cdcd31..25fe12cbc5 100644 --- a/basis/stack-checker/dependencies/dependencies.factor +++ b/basis/stack-checker/dependencies/dependencies.factor @@ -40,6 +40,8 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ; GENERIC: depends-on-c-type ( c-type -- ) +M: void depends-on-c-type drop ; + M: c-type-word depends-on-c-type depends-on-definition ; M: array depends-on-c-type From 869e95717c44ff2042769218cd1c1d83bf95d3c3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 23 Feb 2010 00:23:30 +1300 Subject: [PATCH 3/4] windows.ddk.hid: add platforms.txt --- basis/windows/ddk/hid/platforms.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 basis/windows/ddk/hid/platforms.txt 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 From 23a1f0ed8c11f8e7ddc0d4a71ca76c30744c1c10 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 23 Feb 2010 01:28:56 +1300 Subject: [PATCH 4/4] alien: some code cleanups and fixes --- basis/alien/c-types/c-types.factor | 8 -------- basis/alien/libraries/authors.txt | 1 + basis/alien/libraries/libraries.factor | 15 ++++++++++++--- basis/alien/parser/parser.factor | 16 ++++++---------- basis/stack-checker/alien/alien.factor | 2 +- 5 files changed, 20 insertions(+), 22 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index c25f465600..fff49a4480 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -69,14 +69,6 @@ M: array resolve-pointer-type 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 dc0a1701f2..8385bfb97f 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -66,16 +66,16 @@ IN: alien.parser 2 group [ first2 normalize-c-arg 2array ] map unzip [ "," ?tail drop ] map ] - [ dup "void" = [ drop { } ] [ 1array ] if ] + [ [ { } ] [ 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 ) @@ -88,13 +88,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 @@ -115,4 +112,3 @@ PREDICATE: alien-function-word < word PREDICATE: alien-callback-type-word < typedef-word "callback-effect" word-prop ; - diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 09121488ef..81d8a93240 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -59,7 +59,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; 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