preliminary work on PowerPC FFI

TODO.FACTOR.txt

@@ -1,5 +1,6 @@
 + plugin:
 
+- if external factor is down, don't add tons of random shit to the dictionary
 - extract word: if selection empty, move caret to new word after
 - introduce quotation command
 - set 'end' of artifacts/assets accurately
@@ -67,6 +68,7 @@
 
 + kernel:
 
+- get all-tests to run with -no-compile
 - powerpc has weird callstack residue
 - .factor-rc loading errors are not reported properly
 - instances: do not use make-list
@@ -86,6 +88,7 @@
 
 + i/o:
 
+- review errno
 - separate words for writing characters and strings
 - perhaps:
   GENERIC: set-style ( style stream -- )

library/alien/compiler.factor

@@ -26,12 +26,17 @@ namespaces sequences stdio strings words ;
 SYMBOL: #cleanup ( unwind stack by parameter )
 
 SYMBOL: #unbox ( move top of datastack to C stack )
+
+! for register parameter passing; move top of C stack to a
+! register. no-op on x86, generates code on PowerPC.
+SYMBOL: #parameter
+
+! for increasing stack space on PowerPC; unused on x86.
+SYMBOL: #parameters
+
 SYMBOL: #box ( move EAX to datastack )
 
-SYMBOL: #alien-invoke
-SYMBOL: #alien-global
-
-! These are set in the #alien-invoke dataflow IR node.
+! These are set in the alien-invoke dataflow IR node.
 SYMBOL: alien-returns
 SYMBOL: alien-parameters
 
@@ -53,7 +58,7 @@ SYMBOL: alien-parameters
     #! compilation does not keep trying to compile FFI words
     #! over and over again if the library is not loaded.
     2dup ensure-dlsym
-    cons #alien-invoke dataflow,
+    cons \ alien-invoke dataflow,
     [ set-alien-parameters ] keep
     set-alien-returns ;
 
@@ -69,7 +74,7 @@ DEFER: alien-invoke
 
 : alien-global-node ( type name library -- )
     2dup ensure-dlsym
-    cons #alien-global dataflow,
+    cons \ alien-global dataflow,
     set-alien-returns ;
 
 DEFER: alien-global
@@ -81,18 +86,26 @@ DEFER: alien-global
     pop-literal -rot
     alien-global-node ;
 
-: box-parameter
-    c-type [
-        "width" get cell align
-        "unboxer" get
-    ] bind #unbox swons , ;
+: parameters [ alien-parameters get reverse ] bind ;
 
-: linearize-parameters ( params -- count )
-    #! Generate code for boxing a list of C types.
+: stack-space ( parameters -- n )
+    0 swap [ c-size cell align + ] each ;
+
+: unbox-parameter ( n parameter -- )
+    c-type [ "unboxer" get ] bind cons #unbox swons , ;
+
+: linearize-parameters ( node -- count )
+    #! Generate code for boxing a list of C types, then generate
+    #! code for moving these parameters to register on
+    #! architectures where parameters are passed in registers
+    #! (PowerPC).
+    #!
     #! Return amount stack must be unwound by.
-    [ alien-parameters get reverse ] bind 0 swap [
-        box-parameter +
-    ] each ;
+    parameters
+    dup stack-space
+    dup #parameters swons , >r
+    dup 0 swap [ dupd unbox-parameter 1 + ] each drop
+    length [ #parameter swons ] project % r> ;
 
 : linearize-returns ( returns -- )
     [ alien-returns get ] bind dup "void" = [
@@ -103,18 +116,18 @@ DEFER: alien-global
 
 : linearize-alien-invoke ( node -- )
     dup linearize-parameters >r
-    dup [ node-param get ] bind #alien-invoke swons ,
+    dup [ node-param get ] bind \ alien-invoke swons ,
     dup [ node-param get cdr library-abi "stdcall" = ] bind
     r> swap [ drop ] [ #cleanup swons , ] ifte
     linearize-returns ;
 
-#alien-invoke [ linearize-alien-invoke ] "linearizer" set-word-prop
+\ alien-invoke [ linearize-alien-invoke ] "linearizer" set-word-prop
 
 : linearize-alien-global ( node -- )
-    dup [ node-param get ] bind #alien-global swons ,
+    dup [ node-param get ] bind \ alien-global swons ,
     linearize-returns ;
 
-#alien-global [ linearize-alien-global ] "linearizer" set-word-prop
+\ alien-global [ linearize-alien-global ] "linearizer" set-word-prop
 
 TUPLE: alien-error lib ;
 

library/bootstrap/boot-stage2.factor

@@ -1,12 +1,10 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-USING: command-line command-line kernel lists parser stdio words ;
+USING: kernel lists parser stdio words ;
 
 "Bootstrap stage 2..." print
 
 recrossref
-default-cli-args
-parse-command-line
 
 : pull-in ( ? list -- )
     swap [
@@ -23,7 +21,7 @@ t [
     
     ! This has to be loaded here because it overloads sequence
     ! generics, and we don't want to compile twice.
-!    "/library/math/matrices.factor"
+    "/library/math/matrices.factor"
 
     "/library/tools/debugger.factor"
     "/library/tools/gensym.factor"

library/bootstrap/boot-stage3.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-USING: alien assembler compiler io-internals kernel lists
-namespaces parser sequences stdio unparser words ;
+USING: alien assembler command-line compiler io-internals kernel
+lists namespaces parser sequences stdio unparser words ;
 
 "Bootstrap stage 3..." print
 
@@ -23,6 +23,9 @@ os "win32" = [
     "/library/bootstrap/win32-io.factor" run-resource
 ] when
 
+default-cli-args
+parse-command-line
+
 "/library/io/buffer.factor" run-resource
 
 "compile" get supported-cpu? and [
@@ -80,7 +83,7 @@ t [
     "/library/bootstrap/image.factor"
 ] pull-in
 
-"compile" get "mini" get not and [
+"compile" get supported-cpu? and "mini" get not and [
     "/library/io/logging.factor"
 
     "/library/tools/telnetd.factor"

library/bootstrap/primitives.factor

@@ -203,7 +203,7 @@ vocabularies get [
     [ "die" "kernel"                          [ [ ] [ ] ] ]
     [ "flush-icache" "assembler"              f ]
     [ "fopen"  "io-internals"                 [ [ string string ] [ alien ] ] ]
-    [ "fgetln" "io-internals"                 [ [ alien ] [ string ] ] ]
+    [ "fgets" "io-internals"                  [ [ alien ] [ string ] ] ]
     [ "fwrite" "io-internals"                 [ [ string alien ] [ ] ] ]
     [ "fflush" "io-internals"                 [ [ alien ] [ ] ] ]
     [ "fclose" "io-internals"                 [ [ alien ] [ ] ] ]

library/compiler/ppc/alien.factor

@@ -0,0 +1,30 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: compiler
+USING: alien assembler inference kernel kernel-internals lists
+math memory namespaces words ;
+
+\ alien-invoke [
+    uncons load-dll dlsym compile-call-far
+] "generator" set-word-prop
+
+#parameters [
+    dup 0 = [ drop ] [ 1 1 rot SUBI ] ifte
+] "generator" set-word-prop
+
+#unbox [
+    uncons f dlsym compile-call-far
+    3 1 rot neg 4 - STW
+] "generator" set-word-prop
+
+#parameter [
+    dup 3 + 1 rot cell * neg 4 - LWZ
+] "generator" set-word-prop
+
+#box [
+    f dlsym compile-call-far
+] "generator" set-word-prop
+
+#cleanup [
+    dup 0 = [ drop ] [ 1 1 rot ADDI ] ifte
+] "generator" set-word-prop

library/compiler/ppc/generator.factor

@@ -40,13 +40,13 @@ words ;
 ! IR node is being generated. No forward reference far
 ! calls are possible.
 : compile-call-far ( word -- )
-    dup word-xt 19 LOAD32 rel-primitive-16/16
+    19 LOAD32
     19 MTLR
     BLRL ;
 
 : compile-call-label ( label -- )
     dup primitive? [
-        compile-call-far
+        dup rel-primitive-16/16 word-xt compile-call-far
     ] [
         0 BL relative-24
     ] ifte ;
@@ -60,13 +60,13 @@ words ;
 ] "generator" set-word-prop
 
 : compile-jump-far ( word -- )
-    dup word-xt 19 LOAD32 rel-primitive-16/16
+    19 LOAD32
     19 MTCTR
     BCTR ;
 
 : compile-jump-label ( label -- )
     dup primitive? [
-        compile-jump-far
+        dup rel-primitive-16/16 word-xt compile-jump-far
     ] [
         0 B relative-24
     ] ifte ;

library/compiler/x86/alien.factor

@@ -0,0 +1,37 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: compiler
+USING: alien assembler inference kernel kernel-internals lists
+math memory namespaces words ;
+
+\ alien-invoke [
+    uncons load-dll 2dup dlsym CALL t rel-dlsym
+] "generator" set-word-prop
+
+\ alien-global [
+    uncons load-dll 2dup dlsym EAX swap unit MOV f rel-dlsym
+] "generator" set-word-prop
+
+#parameters [
+    drop
+] "generator" set-word-prop
+
+#unbox [
+    dup f dlsym CALL f t rel-dlsym
+    EAX PUSH
+] "generator" set-word-prop
+
+#parameter [
+    #! x86 does not pass parameters in registers
+    drop
+] "generator" set-word-prop
+
+#box [
+    EAX PUSH
+    dup f dlsym CALL f t rel-dlsym
+    ESP 4 ADD
+] "generator" set-word-prop
+
+#cleanup [
+    dup 0 = [ drop ] [ ESP swap ADD ] ifte
+] "generator" set-word-prop

library/compiler/x86/generator.factor

@@ -54,26 +54,3 @@ math memory namespaces words ;
     compile-aligned
     compiled-offset swap set-compiled-cell ( fixup -- )
 ] "generator" set-word-prop
-
-#alien-invoke [
-    uncons load-dll 2dup dlsym CALL t rel-dlsym
-] "generator" set-word-prop
-
-#alien-global [
-    uncons load-dll 2dup dlsym EAX swap unit MOV f rel-dlsym
-] "generator" set-word-prop
-
-#unbox [
-    dup f dlsym CALL f t rel-dlsym
-    EAX PUSH
-] "generator" set-word-prop
-
-#box [
-    EAX PUSH
-    dup f dlsym CALL f t rel-dlsym
-    ESP 4 ADD
-] "generator" set-word-prop
-
-#cleanup [
-    dup 0 = [ drop ] [ ESP swap ADD ] ifte
-] "generator" set-word-prop

library/compiler/xt.factor

@@ -32,7 +32,11 @@ SYMBOL: relocation-table
 ! PowerPC relocations
 
 : rel-primitive-16/16 ( word -- )
-    5 rel, relocating word-primitive rel, ;
+    #! This is called before a sequence like
+    #! 19 LOAD32
+    #! 19 MTCTR
+    #! BCTR
+    5 rel, compiled-offset rel, word-primitive rel, ;
 
 : rel-address-16/16 ( -- )
     6 rel, relocating 0 rel, ;

native/io.h

@@ -4,4 +4,4 @@ void primitive_fopen(void);
 void primitive_fwrite(void);
 void primitive_fflush(void);
 void primitive_fclose(void);
-void primitive_fgetln(void);
+void primitive_fgets(void);

native/primitives.c

@@ -169,7 +169,7 @@ void* primitives[] = {
 	primitive_die,
 	primitive_flush_icache,
 	primitive_fopen,
-	primitive_fgetln,
+	primitive_fgets,
 	primitive_fwrite,
 	primitive_fflush,
 	primitive_fclose