compiler.cfg.builder: Fix construction of ##return instructions from #return-recursive nodes
parent
091d2d07f2
commit
d29c275089
|
@ -9,6 +9,15 @@ byte-arrays kernel.private math slots.private ;
|
||||||
: unit-test-cfg ( quot -- )
|
: unit-test-cfg ( quot -- )
|
||||||
'[ _ test-cfg [ compute-predecessors check-cfg ] each ] [ ] swap unit-test ;
|
'[ _ test-cfg [ compute-predecessors check-cfg ] each ] [ ] swap unit-test ;
|
||||||
|
|
||||||
|
: blahblah ( nodes -- ? )
|
||||||
|
{ fixnum } declare [
|
||||||
|
dup 3 bitand 1 = [ drop t ] [
|
||||||
|
dup 3 bitand 2 = [
|
||||||
|
blahblah
|
||||||
|
] [ drop f ] if
|
||||||
|
] if
|
||||||
|
] any? ; inline recursive
|
||||||
|
|
||||||
{
|
{
|
||||||
[ ]
|
[ ]
|
||||||
[ dup ]
|
[ dup ]
|
||||||
|
@ -52,6 +61,7 @@ byte-arrays kernel.private math slots.private ;
|
||||||
[ "int" { "int" } "cdecl" [ ] alien-callback ]
|
[ "int" { "int" } "cdecl" [ ] alien-callback ]
|
||||||
[ swap - + * ]
|
[ swap - + * ]
|
||||||
[ swap slot ]
|
[ swap slot ]
|
||||||
|
[ blahblah ]
|
||||||
} [
|
} [
|
||||||
unit-test-cfg
|
unit-test-cfg
|
||||||
] each
|
] each
|
||||||
|
|
|
@ -160,12 +160,13 @@ M: #shuffle emit-node
|
||||||
[ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi ;
|
[ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi ;
|
||||||
|
|
||||||
! #return
|
! #return
|
||||||
M: #return emit-node
|
: emit-return ( -- )
|
||||||
drop ##branch begin-basic-block ##epilogue ##return ;
|
##branch begin-basic-block ##epilogue ##return ;
|
||||||
|
|
||||||
|
M: #return emit-node drop emit-return ;
|
||||||
|
|
||||||
M: #return-recursive emit-node
|
M: #return-recursive emit-node
|
||||||
label>> id>> loops get key?
|
label>> id>> loops get key? [ emit-return ] unless ;
|
||||||
[ ##epilogue ##return ] unless ;
|
|
||||||
|
|
||||||
! #terminate
|
! #terminate
|
||||||
M: #terminate emit-node drop ##no-tco basic-block off ;
|
M: #terminate emit-node drop ##no-tco basic-block off ;
|
||||||
|
|
Loading…
Reference in New Issue