From e67745aabab4b2e7ebcc17d15b721edbddde496c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Thu, 4 Aug 2016 18:21:54 +0200 Subject: [PATCH] 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. --- .../cfg/builder/alien/alien-tests.factor | 2 +- basis/compiler/tree/tree.factor | 33 ++++---------- basis/stack-checker/alien/alien.factor | 43 ++++++++----------- .../stack-checker/visitor/dummy/dummy.factor | 6 +-- basis/stack-checker/visitor/visitor.factor | 6 +-- 5 files changed, 34 insertions(+), 56 deletions(-) diff --git a/basis/compiler/cfg/builder/alien/alien-tests.factor b/basis/compiler/cfg/builder/alien/alien-tests.factor index 6b1bef45c0..0b38f05db4 100644 --- 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 2a4fe77945..62b651f827 100644 --- 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 ; -TUPLE: #alien-invoke < #alien-node in-d out-d ; +TUPLE: #alien-indirect < #alien-node ; -: <#alien-invoke> ( params -- node ) - #alien-invoke new-alien-node ; - -TUPLE: #alien-indirect < #alien-node in-d out-d ; - -: <#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 cf0e32bdef..bcd577a733 100644 --- 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 5ff00afa14..02f41ae154 100644 --- 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 5871f73a4a..13472e8ff8 100644 --- 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 -- )