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

compiler.cfg.tco: teach TCO about safepoints

db4
Joe Groff 2011-10-19 13:04:43 -07:00
parent e449fef4e3
commit 6f75e84d93
1 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
basis/compiler/cfg/tco/tco.factor
View File

@ -15,9 +15,14 @@ IN: compiler.cfg.tco
: return? ( bb -- ? ) : return? ( bb -- ? )
skip-empty-blocks skip-empty-blocks
instructions>> { instructions>> {
[ length 2 = ] [ length 3 = ]
[ first ##epilogue? ] [ first ##safepoint? ]
[ second ##return? ] [ second ##epilogue? ]
[ third ##return? ]
! [ length 2 = ]
! [ first ##epilogue? ]
! [ second ##return? ]
} 1&& ; } 1&& ;
: tail-call? ( bb -- ? ) : tail-call? ( bb -- ? )
@ -33,8 +38,9 @@ IN: compiler.cfg.tco
'[ '[
instructions>> instructions>>
[ pop* ] [ pop ] [ ] tri [ pop* ] [ pop ] [ ] tri
[ [ \ ##safepoint new-insn ] dip push ]
[ [ \ ##epilogue new-insn ] dip push ] [ [ \ ##epilogue new-insn ] dip push ]
[ _ dip push ] bi [ _ dip push ] tri
] ]
[ successors>> delete-all ] [ successors>> delete-all ]
bi ; inline bi ; inline
@ -48,7 +54,14 @@ IN: compiler.cfg.tco
: convert-loop-tail-call ( bb -- ) : convert-loop-tail-call ( bb -- )
! If a word calls itself, this becomes a loop in the CFG. ! If a word calls itself, this becomes a loop in the CFG.
[ instructions>> [ pop* ] [ pop* ] [ [ \ ##branch new-insn ] dip push ] tri ] [
instructions>> {
[ pop* ]
[ pop* ]
[ [ \ ##safepoint new-insn ] dip push ]
[ [ \ ##branch new-insn ] dip push ]
} cleave
]
[ successors>> delete-all ] [ successors>> delete-all ]
[ [ cfg get entry>> successors>> first ] dip successors>> push ] [ [ cfg get entry>> successors>> first ] dip successors>> push ]
tri ; tri ;