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

Fix loop compilation

db4
Slava Pestov 2008-10-10 02:33:32 -05:00
parent 67dd303d27
commit 3e29808f17
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -40,6 +40,7 @@ SYMBOL: procedures
SYMBOL: current-word SYMBOL: current-word
SYMBOL: current-label SYMBOL: current-label
SYMBOL: loops SYMBOL: loops
SYMBOL: first-basic-block
! Basic block after prologue, makes recursion faster ! Basic block after prologue, makes recursion faster
SYMBOL: current-label-start SYMBOL: current-label-start
@ -68,9 +69,6 @@ GENERIC: emit-node ( node -- next )
[ current-node emit-node check-basic-block ] iterate-nodes [ current-node emit-node check-basic-block ] iterate-nodes
finalize-phantoms ; finalize-phantoms ;
: remember-loop ( label -- )
basic-block get swap loops get set-at ;
: begin-word ( -- ) : begin-word ( -- )
#! We store the basic block after the prologue as a loop #! We store the basic block after the prologue as a loop
#! labelled by the current word, so that self-recursive #! labelled by the current word, so that self-recursive
@ -79,7 +77,7 @@ GENERIC: emit-node ( node -- next )
##prologue ##prologue
##branch ##branch
begin-basic-block begin-basic-block
current-label get remember-loop ; basic-block get first-basic-block set ;
: (build-cfg) ( nodes word label -- ) : (build-cfg) ( nodes word label -- )
[ [
@ -108,8 +106,9 @@ SYMBOL: +if-intrinsics+
: emit-call ( word -- next ) : emit-call ( word -- next )
finalize-phantoms finalize-phantoms
{ {
{ [ tail-call? not ] [ ##simple-stack-frame ##call iterate-next ] }
{ [ dup loops get key? ] [ loops get at local-recursive-call ] } { [ dup loops get key? ] [ loops get at local-recursive-call ] }
{ [ tail-call? not ] [ ##simple-stack-frame ##call iterate-next ] }
{ [ dup current-label get eq? ] [ drop first-basic-block get local-recursive-call ] }
[ ##epilogue ##jump stop-iterating ] [ ##epilogue ##jump stop-iterating ]
} cond ; } cond ;
@ -118,6 +117,9 @@ SYMBOL: +if-intrinsics+
[ label>> id>> emit-call ] [ label>> id>> emit-call ]
[ [ child>> ] [ label>> word>> ] [ label>> id>> ] tri (build-cfg) ] bi ; [ [ child>> ] [ label>> word>> ] [ label>> id>> ] tri (build-cfg) ] bi ;
: remember-loop ( label -- )
basic-block get swap loops get set-at ;
: compile-loop ( node -- next ) : compile-loop ( node -- next )
finalize-phantoms finalize-phantoms
begin-basic-block begin-basic-block
@ -299,7 +301,7 @@ M: #return emit-node
M: #return-recursive emit-node M: #return-recursive emit-node
finalize-phantoms finalize-phantoms
label>> id>> loops get key? label>> id>> loops get key?
[ ##epilogue ##return ] unless stop-iterating ; [ iterate-next ] [ ##epilogue ##return stop-iterating ] if ;
! #terminate ! #terminate
M: #terminate emit-node M: #terminate emit-node