Working on alien-indirect

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

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 -- )
+    <alien-indirect-error> 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 ] [ ] <effect>
+"infer-effect" set-word-prop
+
+\ alien-indirect [
+    empty-node <alien-indirect>
+    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 ;

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 -- )
+: box-return ( ctype -- )
-    alien-invoke-return [ ] [ f swap box-parameter ] if-void ;
+    [ ] [ 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*

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 ;

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 ;
 

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 )

library/compiler/inference/stack.factor

@@ -25,6 +25,7 @@ sequences words parser ;
     dup shuffle-in-d swap shuffle-out-d <effect> ;
 
 : define-shuffle ( word shuffle -- )
+    [ "shuffle" set-word-prop ] 2keep
     [ shuffle>effect "infer-effect" set-word-prop ] 2keep
     [ , \ infer-shuffle , ] [ ] make "infer" set-word-prop ;
 

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"

library/compiler/ppc/architecture.factor

@@ -195,6 +195,9 @@ M: stack-params %freg>stack
 : %alien-callback ( quot -- )
     0 <int-vreg> 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 ;
 

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 <alien> indirect-test-1 ] unit-test
+
+: indirect-test-2
+    "int" { "int" "int" } "cdecl" alien-indirect ;
+
+[ 5 ]
+[ 2 3 "ffi_test_2" f dlsym <alien> indirect-test-2 ]
+unit-test

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 ;