diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index a1d89ed75e..a255c00f4c 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -17,7 +17,6 @@ - we need to optimize [ dup array? [ array? ] [ array? ] if ] - better way of dealing with compiler errors - track individual method usages -- track a list of assets loaded from each module's file - variable width word wrap - add-gadget, model-changed, set-model should compile - graphical module manager tool @@ -28,9 +27,11 @@ space - we have trouble drawing rectangles - UI dataflow visualizer -- tool help - browser: show currently selected vocab & words + - doc sweep +- tool help +- perhaps commands window should sort by gesture + ui: @@ -38,7 +39,6 @@ because of grafting and ungrafting - set-model set-model* and control-changed: its a hack, clean it up - x11: scroll up/down wiggles caret -- perhaps commands window should sort by gesture - roundoff is still not quite right with tracks - fix top level window positioning - merge keyboard help with help in some way @@ -71,10 +71,11 @@ - horizontal wheel scrolling - polish OS X menu bar code - structure editor -- loading space invaders slows the UI down + module system: +- convention for main entry point of a module +- track a list of assets loaded from each module's file - generic 'define ( asset def -- )' - C types should be words - TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp @@ -85,6 +86,7 @@ + compiler/ffi: +- stdcall callbacks - see if alien calls can be made faster - [ r> ] infer should throw an inference error - compiler tests are not as reliable now because of try-compile usage diff --git a/library/compiler/alien/alien-indirect.factor b/library/compiler/alien/alien-indirect.factor new file mode 100644 index 0000000000..2c7b953c6f --- /dev/null +++ b/library/compiler/alien/alien-indirect.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: alien +USING: compiler errors generic hashtables inference +kernel namespaces sequences strings words parser prettyprint ; + +TUPLE: alien-indirect return parameters abi ; +C: alien-indirect make-node ; + +TUPLE: alien-indirect-error ; + +: alien-indirect ( funcptr args... return parameters abi -- ) + throw ; + +M: alien-indirect-error summary + drop "Words calling ``alien-indirect'' cannot run in the interpreter. Compile the caller word and try again." ; + +\ alien-indirect [ string object string ] [ ] +"infer-effect" set-word-prop + +\ alien-indirect [ + empty-node + pop-literal nip over set-alien-indirect-abi + pop-literal nip over set-alien-indirect-parameters + pop-literal nip over set-alien-indirect-return + node, +] "infer" set-word-prop + +: generate-indirect-cleanup ( node -- ) + dup alien-indirect-abi "stdcall" = [ + drop + ] [ + alien-indirect-parameters stack-space %cleanup + ] if ; + +: %shuffle "shuffle" word-prop phantom-shuffle end-basic-block ; + +M: alien-indirect generate-node + end-basic-block compile-gc + dup alien-indirect-parameters objects>registers + %alien-indirect + dup generate-indirect-cleanup + alien-indirect-return box-return + iterate-next ; + +M: alien-indirect stack-reserve* + alien-indirect-parameters stack-space ; diff --git a/library/compiler/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor index ccb3b460d9..3e3f675f6c 100644 --- a/library/compiler/alien/alien-invoke.factor +++ b/library/compiler/alien/alien-invoke.factor @@ -52,10 +52,10 @@ M: alien-invoke-error summary dup unbox-parameters "save_stacks" f %alien-invoke \ %stack>freg move-parameters ; -: box-return ( node -- ) - alien-invoke-return [ ] [ f swap box-parameter ] if-void ; +: box-return ( ctype -- ) + [ ] [ f swap box-parameter ] if-void ; -: generate-cleanup ( node -- ) +: generate-invoke-cleanup ( node -- ) dup alien-invoke-library library-abi "stdcall" = [ drop ] [ @@ -66,7 +66,8 @@ M: alien-invoke generate-node end-basic-block compile-gc dup alien-invoke-parameters objects>registers dup alien-invoke-dlsym %alien-invoke - dup generate-cleanup box-return + dup generate-invoke-cleanup + alien-invoke-return box-return iterate-next ; M: alien-invoke stack-reserve* diff --git a/library/compiler/alien/compiler.factor b/library/compiler/alien/compiler.factor index 3345e01907..9eecc2d221 100644 --- a/library/compiler/alien/compiler.factor +++ b/library/compiler/alien/compiler.factor @@ -23,9 +23,6 @@ kernel-internals math namespaces sequences words ; [ dup class get swap inc-reg-class ] keep ; : alloc-parameter ( parameter -- reg reg-class ) - #! Allocate a register and stack frame location. - #! n is a stack location, and the value of the class - #! variable is a register number. c-type "reg-class" swap hash dup reg-class-full? [ spill-param ] [ fastcall-param ] if [ fastcall-regs nth ] keep ; diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor index 3d00bdbfa4..8aaec60244 100644 --- a/library/compiler/amd64/alien.factor +++ b/library/compiler/amd64/alien.factor @@ -48,6 +48,9 @@ M: stack-params %freg>stack : %alien-invoke ( symbol dll -- ) reset-sse compile-c-call ; +: %alien-indirect ( -- ) + "unbox_alien" f %alien-invoke RAX CALL ; + : %alien-callback ( quot -- ) RDI load-indirect "run_callback" f compile-c-call ; diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor index af3cb2582f..9b3595fedc 100644 --- a/library/compiler/generator/architecture.factor +++ b/library/compiler/generator/architecture.factor @@ -112,6 +112,8 @@ DEFER: %alien-callback ( quot -- ) DEFER: %callback-value ( reg-class func -- ) +DEFER: %alien-indirect ( -- ) + M: stack-params fastcall-regs drop 0 ; GENERIC: reg-size ( register-class -- n ) diff --git a/library/compiler/inference/stack.factor b/library/compiler/inference/stack.factor index 02562f9817..19e1e51442 100644 --- a/library/compiler/inference/stack.factor +++ b/library/compiler/inference/stack.factor @@ -25,6 +25,7 @@ sequences words parser ; dup shuffle-in-d swap shuffle-out-d ; : define-shuffle ( word shuffle -- ) + [ "shuffle" set-word-prop ] 2keep [ shuffle>effect "infer-effect" set-word-prop ] 2keep [ , \ infer-shuffle , ] [ ] make "infer" set-word-prop ; diff --git a/library/compiler/load.factor b/library/compiler/load.factor index a6649c561d..14c7dbc095 100644 --- a/library/compiler/load.factor +++ b/library/compiler/load.factor @@ -29,6 +29,7 @@ PROVIDE: library/compiler { "alien/compiler.factor" "alien/alien-invoke.factor" "alien/alien-callback.factor" + "alien/alien-indirect.factor" "alien/syntax.factor" "alien/alien-callback.facts" diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor index 8b4024813d..70472d786c 100644 --- a/library/compiler/ppc/architecture.factor +++ b/library/compiler/ppc/architecture.factor @@ -195,6 +195,9 @@ M: stack-params %freg>stack : %alien-callback ( quot -- ) 0 load-literal "run_callback" f %alien-invoke ; +: %alien-indirect ( -- ) + "unbox_alien" f %alien-invoke 3 MTLR BLRL ; + : save-return 0 swap [ return-reg ] keep %freg>stack ; : load-return 0 swap [ return-reg ] keep %stack>freg ; diff --git a/library/compiler/test/alien.factor b/library/compiler/test/alien.factor index f32a923c1e..1a46e1f20d 100644 --- a/library/compiler/test/alien.factor +++ b/library/compiler/test/alien.factor @@ -73,3 +73,15 @@ FUNCTION: foo ffi_test_14 int x int y ; cpu "x86" = macosx? and [ [ 11 6 ] [ 11 6 ffi_test_14 dup foo-x swap foo-y ] unit-test ] when + +: indirect-test-1 + "int" { } "cdecl" alien-indirect ; + +[ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test + +: indirect-test-2 + "int" { "int" "int" } "cdecl" alien-indirect ; + +[ 5 ] +[ 2 3 "ffi_test_2" f dlsym indirect-test-2 ] +unit-test diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor index b6b3462fdb..ff1a53e881 100644 --- a/library/compiler/x86/alien.factor +++ b/library/compiler/x86/alien.factor @@ -55,4 +55,7 @@ kernel-internals math memory namespaces words ; ! Restore return register pop-return-reg ; +: %alien-indirect ( -- ) + "unbox_alien" f %alien-invoke EAX CALL ; + : %cleanup ( n -- ) dup zero? [ drop ] [ ESP swap ADD ] if ;