stack-checker.*: removes the in-d and out-d slots from the alien-node-params tuple

That data is already on the #alien-node tuple so it doesn't need to be
stored twice.

diff --git a/basis/compiler/cfg/builder/alien/alien-tests.factor b/basis/compiler/cfg/builder/alien/alien-tests.factor
index 6b1bef45c09704529f1decc2b13589052f4dd0fa..0b38f05db412a2138350bfa5651b5faa4026715e 100644 (file)
--- a/basis/compiler/cfg/builder/alien/alien-tests.factor
+++ b/basis/compiler/cfg/builder/alien/alien-tests.factor
@@ -52,7 +52,7 @@ cpu x86.64? [
         }
         V{ }
     } [
-        void { int float double char } cdecl { } { } f "func"
+        void { int float double char } cdecl f "func"
         alien-invoke-params boa caller-parameters
     ] cfg-unit-test
 ] when

diff --git a/basis/compiler/tree/tree.factor b/basis/compiler/tree/tree.factor
index 2a4fe779459ece62644c2e5deeae046461a47bfe..62b651f8271253fe33741a695e9f9b9867cc050e 100644 (file)
--- a/basis/compiler/tree/tree.factor
+++ b/basis/compiler/tree/tree.factor
@@ -127,35 +127,18 @@ TUPLE: #copy < #renaming in-d out-d ;
         swap >>out-d
         swap >>in-d ;
 
-TUPLE: #alien-node < node params ;
+TUPLE: #alien-node < node params in-d out-d ;
 
-: new-alien-node ( params class -- node )
-    new
-        over in-d>> >>in-d
-        over out-d>> >>out-d
-        swap >>params ; inline
-
-TUPLE: #alien-invoke < #alien-node in-d out-d ;
-
-: <#alien-invoke> ( params -- node )
-    #alien-invoke new-alien-node ;
+TUPLE: #alien-invoke < #alien-node ;
 
-TUPLE: #alien-indirect < #alien-node in-d out-d ;
+TUPLE: #alien-indirect < #alien-node ;
 
-: <#alien-indirect> ( params -- node )
-    #alien-indirect new-alien-node ;
-
-TUPLE: #alien-assembly < #alien-node in-d out-d ;
-
-: <#alien-assembly> ( params -- node )
-    #alien-assembly new-alien-node ;
+TUPLE: #alien-assembly < #alien-node ;
 
 TUPLE: #alien-callback < node params child ;
 
 : <#alien-callback> ( params child -- node )
-    #alien-callback new
-        swap >>child
-        swap >>params ;
+    #alien-callback boa ;
 
 : node, ( node -- ) stack-visitor get push ;
 
@@ -187,7 +170,7 @@ M: vector #phi, <#phi> node, ;
 M: vector #declare, <#declare> node, ;
 M: vector #recursive, <#recursive> node, ;
 M: vector #copy, <#copy> node, ;
-M: vector #alien-invoke, <#alien-invoke> node, ;
-M: vector #alien-indirect, <#alien-indirect> node, ;
-M: vector #alien-assembly, <#alien-assembly> node, ;
+M: vector #alien-invoke, #alien-invoke boa node, ;
+M: vector #alien-indirect, #alien-indirect boa node, ;
+M: vector #alien-assembly, #alien-assembly boa node, ;
 M: vector #alien-callback, <#alien-callback> node, ;

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index cf0e32bdefca3381752a9da7fe1b96d7ae2c7602..bcd577a7332b11984149117abc45a3934d2885ea 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -8,27 +8,28 @@ stack-checker.visitor strings words ;
 FROM: kernel.private => declare ;
 IN: stack-checker.alien
 
-TUPLE: alien-node-params
-return parameters
-{ abi abi initial: cdecl }
-in-d
-out-d ;
+TUPLE: alien-node-params return parameters { abi abi initial: cdecl } ;
 
-TUPLE: alien-invoke-params < alien-node-params library { function string } ;
+TUPLE: alien-invoke-params < alien-node-params
+    library
+    { function string } ;
 
 TUPLE: alien-indirect-params < alien-node-params ;
 
-TUPLE: alien-assembly-params < alien-node-params { quot callable } ;
+TUPLE: alien-assembly-params < alien-node-params
+    { quot callable } ;
 
-TUPLE: alien-callback-params < alien-node-params xt ;
+TUPLE: alien-callback-params < alien-node-params
+    xt ;
 
 : param-prep-quot ( params -- quot )
     parameters>> [ lookup-c-type c-type-unboxer-quot ] map deep-spread>quot ;
 
-: alien-stack ( params extra -- )
-    over parameters>> length + consume-d >>in-d
-    dup return>> void? 0 1 ? produce-d >>out-d
-    drop ;
+: alien-inputs/outputs ( params -- in-d out-d )
+    [
+        [ parameters>> length ]
+        [ alien-indirect-params? 1 0 ? ] bi + consume-d
+    ] [ return>> void? 0 1 ? produce-d ] bi ;
 
 : return-prep-quot ( params -- quot )
     return>> [ [ ] ] [ lookup-c-type c-type-boxer-quot ] if-void ;
@@ -65,10 +66,8 @@ TUPLE: alien-callback-params < alien-node-params xt ;
     dup library>> library-abi >>abi
     ! Quotation which coerces parameters to required types
     dup param-prep-quot infer-quot-here
-    ! Magic #: consume exactly the number of inputs
-    dup 0 alien-stack
-    ! Add node to IR
-    dup #alien-invoke,
+    ! Consume inputs and outputs and add node to IR
+    dup dup alien-inputs/outputs #alien-invoke,
     ! Quotation which coerces return value to required type
     infer-return ;
 
@@ -80,10 +79,8 @@ TUPLE: alien-callback-params < alien-node-params xt ;
     pop-return
     ! Coerce parameters to required types
     dup param-prep-quot '[ _ [ >c-ptr ] bi* ] infer-quot-here
-    ! Magic #: consume the function pointer, too
-    dup 1 alien-stack
-    ! Add node to IR
-    dup #alien-indirect,
+    ! Consume inputs and outputs and add node to IR
+    dup dup alien-inputs/outputs #alien-indirect,
     ! Quotation which coerces return value to required type
     infer-return ;
 
@@ -96,10 +93,8 @@ TUPLE: alien-callback-params < alien-node-params xt ;
     pop-return
     ! Quotation which coerces parameters to required types
     dup param-prep-quot infer-quot-here
-    ! Magic #: consume exactly the number of inputs
-    dup 0 alien-stack
-    ! Add node to IR
-    dup #alien-assembly,
+    ! Consume inputs and outputs and add node to IR
+    dup dup alien-inputs/outputs #alien-assembly,
     ! Quotation which coerces return value to required type
     infer-return ;
 

diff --git a/basis/stack-checker/visitor/dummy/dummy.factor b/basis/stack-checker/visitor/dummy/dummy.factor
index 5ff00afa14a695e691a2304b78f20de762baf36c..02f41ae154ff89b1e36cf88532d78b17805ec1ad 100644 (file)
--- a/basis/stack-checker/visitor/dummy/dummy.factor
+++ b/basis/stack-checker/visitor/dummy/dummy.factor
@@ -22,7 +22,7 @@ M: f #declare, drop ;
 M: f #recursive, 3drop ;
 M: f #copy, 2drop ;
 M: f #drop, drop ;
-M: f #alien-invoke, drop ;
-M: f #alien-indirect, drop ;
-M: f #alien-assembly, drop ;
+M: f #alien-invoke, 3drop ;
+M: f #alien-indirect, 3drop ;
+M: f #alien-assembly, 3drop ;
 M: f #alien-callback, 2drop ;

diff --git a/basis/stack-checker/visitor/visitor.factor b/basis/stack-checker/visitor/visitor.factor
index 5871f73a4a0fbdf91de410651627d4fdbb71bd3b..13472e8ff8f38ddbb0697fa0add6aad00b3a881a 100644 (file)
--- a/basis/stack-checker/visitor/visitor.factor
+++ b/basis/stack-checker/visitor/visitor.factor
@@ -27,7 +27,7 @@ HOOK: #enter-recursive, stack-visitor ( label inputs outputs -- )
 HOOK: #return-recursive, stack-visitor ( label inputs outputs -- )
 HOOK: #recursive, stack-visitor ( label inputs visitor -- )
 HOOK: #copy, stack-visitor ( inputs outputs -- )
-HOOK: #alien-invoke, stack-visitor ( params -- )
-HOOK: #alien-indirect, stack-visitor ( params -- )
-HOOK: #alien-assembly, stack-visitor ( params -- )
+HOOK: #alien-invoke, stack-visitor ( params in-d out-d -- )
+HOOK: #alien-indirect, stack-visitor ( params in-d out-d -- )
+HOOK: #alien-assembly, stack-visitor ( params in-d out-d -- )
 HOOK: #alien-callback, stack-visitor ( params child -- )