steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix callbacks and non-tailcalls to dispatch

db4
Slava Pestov 2008-10-12 17:37:26 -05:00
parent 2f4f86d288
commit b2ade7f556
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/compiler/cfg/builder/builder.factor
View File

@ -178,11 +178,14 @@ M: #if emit-node
[ finalize-phantoms ##epilogue ] 2dip ##dispatch [ finalize-phantoms ##epilogue ] 2dip ##dispatch
dispatch-branches init-phantoms ; dispatch-branches init-phantoms ;
: <dispatch-block> ( -- word )
gensym dup t "inlined-block" set-word-prop ;
M: #dispatch emit-node M: #dispatch emit-node
tail-call? [ tail-call? [
emit-dispatch stop-iterating emit-dispatch stop-iterating
] [ ] [
current-word get gensym [ current-word get <dispatch-block> [
[ [
begin-word begin-word
emit-dispatch emit-dispatch
@ -329,12 +332,9 @@ M: #terminate emit-node
[ alien-parameters parameter-sizes drop >>params ] bi [ alien-parameters parameter-sizes drop >>params ] bi
dup [ params>> ] [ return>> ] bi + >>size ; dup [ params>> ] [ return>> ] bi + >>size ;
: alien-stack-frame ( node -- )
params>> <alien-stack-frame> ##stack-frame ;
: emit-alien-node ( node quot -- next ) : emit-alien-node ( node quot -- next )
[ drop alien-stack-frame ] [ params>> ] dip
[ [ params>> ] dip call ] 2bi [ drop <alien-stack-frame> ##stack-frame ] [ call ] 2bi
iterate-next ; inline iterate-next ; inline
M: #alien-invoke emit-node M: #alien-invoke emit-node
@ -344,7 +344,7 @@ M: #alien-indirect emit-node
[ ##alien-indirect ] emit-alien-node ; [ ##alien-indirect ] emit-alien-node ;
M: #alien-callback emit-node M: #alien-callback emit-node
params>> dup xt>> dup dup params>> xt>> dup
[ [
init-phantoms init-phantoms
[ ##alien-callback ] emit-alien-node drop [ ##alien-callback ] emit-alien-node drop