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.
char-rename
Björn Lindqvist 2016-08-04 18:21:54 +02:00
parent 8d982780f5
commit e67745aaba
5 changed files with 34 additions and 56 deletions

View File

@ -52,7 +52,7 @@ cpu x86.64? [
} }
V{ } V{ }
} [ } [
void { int float double char } cdecl { } { } f "func" void { int float double char } cdecl f "func"
alien-invoke-params boa caller-parameters alien-invoke-params boa caller-parameters
] cfg-unit-test ] cfg-unit-test
] when ] when

View File

@ -127,35 +127,18 @@ TUPLE: #copy < #renaming in-d out-d ;
swap >>out-d swap >>out-d
swap >>in-d ; swap >>in-d ;
TUPLE: #alien-node < node params ; TUPLE: #alien-node < node params in-d out-d ;
: new-alien-node ( params class -- node ) TUPLE: #alien-invoke < #alien-node ;
new
over in-d>> >>in-d
over out-d>> >>out-d
swap >>params ; inline
TUPLE: #alien-invoke < #alien-node in-d out-d ; TUPLE: #alien-indirect < #alien-node ;
: <#alien-invoke> ( params -- node ) TUPLE: #alien-assembly < #alien-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-callback < node params child ; TUPLE: #alien-callback < node params child ;
: <#alien-callback> ( params child -- node ) : <#alien-callback> ( params child -- node )
#alien-callback new #alien-callback boa ;
swap >>child
swap >>params ;
: node, ( node -- ) stack-visitor get push ; : node, ( node -- ) stack-visitor get push ;
@ -187,7 +170,7 @@ M: vector #phi, <#phi> node, ;
M: vector #declare, <#declare> node, ; M: vector #declare, <#declare> node, ;
M: vector #recursive, <#recursive> node, ; M: vector #recursive, <#recursive> node, ;
M: vector #copy, <#copy> node, ; M: vector #copy, <#copy> node, ;
M: vector #alien-invoke, <#alien-invoke> node, ; M: vector #alien-invoke, #alien-invoke boa node, ;
M: vector #alien-indirect, <#alien-indirect> node, ; M: vector #alien-indirect, #alien-indirect boa node, ;
M: vector #alien-assembly, <#alien-assembly> node, ; M: vector #alien-assembly, #alien-assembly boa node, ;
M: vector #alien-callback, <#alien-callback> node, ; M: vector #alien-callback, <#alien-callback> node, ;

View File

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

View File

@ -22,7 +22,7 @@ M: f #declare, drop ;
M: f #recursive, 3drop ; M: f #recursive, 3drop ;
M: f #copy, 2drop ; M: f #copy, 2drop ;
M: f #drop, drop ; M: f #drop, drop ;
M: f #alien-invoke, drop ; M: f #alien-invoke, 3drop ;
M: f #alien-indirect, drop ; M: f #alien-indirect, 3drop ;
M: f #alien-assembly, drop ; M: f #alien-assembly, 3drop ;
M: f #alien-callback, 2drop ; M: f #alien-callback, 2drop ;

View File

@ -27,7 +27,7 @@ HOOK: #enter-recursive, stack-visitor ( label inputs outputs -- )
HOOK: #return-recursive, stack-visitor ( label inputs outputs -- ) HOOK: #return-recursive, stack-visitor ( label inputs outputs -- )
HOOK: #recursive, stack-visitor ( label inputs visitor -- ) HOOK: #recursive, stack-visitor ( label inputs visitor -- )
HOOK: #copy, stack-visitor ( inputs outputs -- ) HOOK: #copy, stack-visitor ( inputs outputs -- )
HOOK: #alien-invoke, stack-visitor ( params -- ) HOOK: #alien-invoke, stack-visitor ( params in-d out-d -- )
HOOK: #alien-indirect, stack-visitor ( params -- ) HOOK: #alien-indirect, stack-visitor ( params in-d out-d -- )
HOOK: #alien-assembly, stack-visitor ( params -- ) HOOK: #alien-assembly, stack-visitor ( params in-d out-d -- )
HOOK: #alien-callback, stack-visitor ( params child -- ) HOOK: #alien-callback, stack-visitor ( params child -- )