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
parent
8d982780f5
commit
e67745aaba
|
@ -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
|
||||||
|
|
|
@ -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, ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 -- )
|
||||||
|
|
Loading…
Reference in New Issue