ffi works

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 830a8f9b656edfb995243d4b55f390277d969897..a1ff857d308335fdb3cdabf3eb0d8775130a2e29 100644 (file)
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -57,6 +57,11 @@ USE: stdio
     "/library/errors.factor"\r
     "/library/continuations.factor"\r
     "/library/threads.factor"\r
+    "/library/generic/generic.factor"\r
+    "/library/generic/object.factor"\r
+    "/library/generic/builtin.factor"\r
+    "/library/generic/predicate.factor"\r
+    "/library/generic/traits.factor"\r
     "/library/io/stream.factor"\r
     "/library/io/stdio.factor"\r
     "/library/io/io-internals.factor"\r
@@ -65,11 +70,6 @@ USE: stdio
     "/library/syntax/parse-numbers.factor"\r
     "/library/syntax/parser.factor"\r
     "/library/syntax/parse-stream.factor"\r
-    "/library/generic/generic.factor"\r
-    "/library/generic/object.factor"\r
-    "/library/generic/builtin.factor"\r
-    "/library/generic/predicate.factor"\r
-    "/library/generic/traits.factor"\r
     "/library/bootstrap/init.factor"\r
     "/library/syntax/parse-syntax.factor"\r
 \r

diff --git a/library/bootstrap/boot.factor b/library/bootstrap/boot.factor
index e39c467513135b197289f848567aa367218557de..5bc37dfbc7648f3ac9199a992a90a3ea9d1b71c8 100644 (file)
--- a/library/bootstrap/boot.factor
+++ b/library/bootstrap/boot.factor
@@ -78,6 +78,7 @@ vocabularies get [
 "/library/generic/predicate.factor" run-resource
 "/library/generic/traits.factor" run-resource
 
+! init.factor leaves a boot quotation on the stack
 "/library/bootstrap/init.factor" run-resource
 
 ! A bootstrapping trick. See doc/bootstrap.txt.

diff --git a/library/compiler/alien.factor b/library/compiler/alien.factor
index 35aa35cbd0e76a620131541d6297db083aaa7e65..45b5e73bbeda93be3ea781e1fcfcfc7957556550 100644 (file)
--- a/library/compiler/alien.factor
+++ b/library/compiler/alien.factor
@@ -85,7 +85,7 @@ SYMBOL: alien-parameters
 : linearize-parameters ( params -- count )
     #! Generate code for boxing a list of C types.
     #! Return amount stack must be unwound by.
-    [ alien-parameters get ] bind 0 swap [
+    [ alien-parameters get reverse ] bind 0 swap [
         c-type [
             "width" get cell align +
             "unboxer" get

diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index e8d638c287b5e853fd8eecea5a27f4321a0c0a33..384316ec8d2efa3b2ba4e0da3fd4f1ed5e64008a 100644 (file)
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -76,12 +76,15 @@ USE: words
         drop
     ] ifte ;
 
+: try-compile ( word -- )
+    [ compile ] [ [ cannot-compile ] when ] catch ;
+
 : compile-all ( -- )
     #! Compile all words.
     [
-        dup "infer-effect" word-property [
-            [ compile ] [ [ cannot-compile ] when ] catch
-        ] [
-            drop
-        ] ifte
+       ! dup "infer-effect" word-property [
+            try-compile
+       ! ] [
+       !     drop
+       ! ] ifte
     ] each-word ;

diff --git a/library/compiler/generator-x86.factor b/library/compiler/generator-x86.factor
index e44f4f3ed6082dc39f0b168ba986867af3a0dc56..577a48e3408433d341b865e1195e45148c5d5d12 100644 (file)
--- a/library/compiler/generator-x86.factor
+++ b/library/compiler/generator-x86.factor
@@ -57,10 +57,20 @@ USE: words
 ] "generator" set-word-property
 
 #call [
+    dup postpone-word
     CALL compiled-offset defer-xt
 ] "generator" set-word-property
 
 #jump [
+    dup postpone-word
+    JUMP compiled-offset defer-xt
+] "generator" set-word-property
+
+#call-label [
+    CALL compiled-offset defer-xt
+] "generator" set-word-property
+
+#jump-label [
     JUMP compiled-offset defer-xt
 ] "generator" set-word-property
 
@@ -96,16 +106,19 @@ USE: words
     compiled-offset 0 compile-cell 0 defer-xt
 ] "generator" set-word-property
 
-! TODO: to complete alien compilation, must provide generators
-! for #c-call, #box, #unbox and #cleanup.
-! 
-! : UNBOX ( name -- )
-!     #! Move top of datastack to C stack.
-!     SELF-CALL  EAX PUSH-R ;
-! 
-! : BOX ( name -- )
-!     #! Move EAX to datastack.
-!     EAX PUSH-R  SELF-CALL  4 ESP R+I ;
-! 
-! : CLEANUP ( amount -- )
-!     dup 0 = [ drop ] [ ESP R+I ] ifte ;
+#c-call [ CALL JUMP-FIXUP ] "generator" set-word-property
+
+#unbox [
+    CALL JUMP-FIXUP
+    EAX PUSH-R
+] "generator" set-word-property
+
+#box [
+    EAX PUSH-R
+    CALL JUMP-FIXUP
+    4 ESP R+I
+] "generator" set-word-property
+
+#cleanup [
+    dup 0 = [ drop ] [ ESP R+I ] ifte
+] "generator" set-word-property

diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index f9b2b05c7e95a56ff733c24c62ed37afd78b2517..2198c80490a3e96e3285216bed8c04fe5c8667c9 100644 (file)
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -46,6 +46,7 @@ SYMBOL: #push-immediate
 SYMBOL: #push-indirect
 SYMBOL: #jump-t ( branch if top of stack is true )
 SYMBOL: #jump ( tail-call )
+SYMBOL: #jump-label ( tail-call )
 SYMBOL: #return-to ( push addr on C stack )
 
 ! #dispatch is linearized as #dispatch followed by a #target
@@ -86,15 +87,6 @@ SYMBOL: #target ( part of jump table )
     swons ,
 ] "linearizer" set-word-property
 
-#call [
-    dup [ node-param get ] bind postpone-word
-    linear,
-] "linearizer" set-word-property
-
-#call-label [
-    [ node-param get ] bind #call swons ,
-] "linearizer" set-word-property
-
 : <label> ( -- label )
     gensym  dup t "label" set-word-property ;
 

diff --git a/library/compiler/simplifier.factor b/library/compiler/simplifier.factor
index ca2bca7397f0a82db216ba03f8af9a0af8b2ed4d..d1aa097c7571d79dcc79789da1941822d50aa174 100644 (file)
--- a/library/compiler/simplifier.factor
+++ b/library/compiler/simplifier.factor
@@ -82,12 +82,16 @@ USE: words
 : follows? ( op list -- ? ) dup [ car car = ] [ 2drop f ] ifte ;
 
 GENERIC: call-simplifier ( node rest -- rest ? )
-
 M: cons call-simplifier ( node rest -- ? )
     swap , f ;
 
 PREDICATE: cons return-follows #return swap follows? ;
 M: return-follows call-simplifier ( node rest -- rest ? )
-    cdr swap cdr #jump swons , t ;
+    >r
+    unswons [
+        [ #call | #jump ]
+        [ #call-label | #jump-label ]
+    ] assoc swons , r> t ;
 
 #call [ call-simplifier ] "simplifier" set-word-property
+#call-label [ call-simplifier ] "simplifier" set-word-property

diff --git a/library/compiler/xt.factor b/library/compiler/xt.factor
index 3355c067d80bbeec8d1e6141e75d935c6242a2a3..b3b510bbeb0384bcb88c490c5afc8bc673962608 100644 (file)
--- a/library/compiler/xt.factor
+++ b/library/compiler/xt.factor
@@ -109,11 +109,7 @@ SYMBOL: compile-words
     deferred-xts off ;
 
 : with-compiler ( quot -- )
-    [
-        call
-        fixup-deferred-xts
-        commit-xts
-    ] with-scope ;
+    [ call  fixup-deferred-xts  commit-xts ] with-scope ;
 
 : postpone-word ( word -- )
     dup compiling? [ drop ] [ compile-words unique@ ] ifte ;

diff --git a/library/kernel.factor b/library/kernel.factor
index 28f700640cfb9b41cded1969eaa1c7d46d38296d..99aeaf52c4134cddb248100018268157597f926c 100644 (file)
--- a/library/kernel.factor
+++ b/library/kernel.factor
@@ -38,6 +38,10 @@ IN: lists
 DEFER: cons=
 DEFER: cons-hashcode
 
+IN: math
+DEFER: >rect
+DEFER: bitxor
+
 IN: kernel
 USE: lists
 USE: math

diff --git a/library/sdl/hsv.factor b/library/sdl/hsv.factor
index 79c1843d98b30c289b216059ab0c391903f38371..fbaf8c14242ae1a2cdc552e9ddc2810f5d41fdd3 100644 (file)
--- a/library/sdl/hsv.factor
+++ b/library/sdl/hsv.factor
@@ -22,7 +22,7 @@ USE: vectors
     #! Call p mod q'th entry of the vector of quotations, where
     #! q is the length of the vector. The value q remains on the
     #! stack.
-    [ dupd length mod ] keep vector-nth call ;
+    [ dupd vector-length mod ] keep vector-nth call ;
 
 : hsv>rgb ( h s v -- r g b )
     pick 6 * >fixnum {

diff --git a/library/test/dataflow.factor b/library/test/dataflow.factor
index 44a73cee9d2c94b2a61f4e572929d4373af6d219..2c31aae44157c401669f1358f08e8f662f145051 100644 (file)
--- a/library/test/dataflow.factor
+++ b/library/test/dataflow.factor
@@ -61,14 +61,14 @@ USE: generic
     dataflow-ifte-node-consume-d length 1 =
 ] unit-test
 
-[ t ] [
-    [ { [ drop ] [ undefined-method ] [ drop ] [ undefined-method ] } generic ] dataflow
-    #dispatch swap dataflow-contains-op? car [
-        node-param get [
-            [ [ node-param get \ undefined-method = ] bind ] some?
-        ] some?
-    ] bind >boolean
-] unit-test
+! [ t ] [
+!     [ { [ drop ] [ undefined-method ] [ drop ] [ undefined-method ] } generic ] dataflow
+!     #dispatch swap dataflow-contains-op? car [
+!         node-param get [
+!             [ [ node-param get \ undefined-method = ] bind ] some?
+!         ] some?
+!     ] bind >boolean
+! ] unit-test
 
 SYMBOL: #test