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

Fix #dispatch generation

db4
Slava Pestov 2008-10-12 16:46:59 -05:00
parent 37047a3b8e
commit 5f93ab74e4
3 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -82,7 +82,8 @@ GENERIC: emit-node ( node -- next )
: (build-cfg) ( nodes word label -- ) : (build-cfg) ( nodes word label -- )
[ [
begin-word begin-word
[ emit-nodes ] with-node-iterator V{ } clone node-stack set
emit-nodes
] with-cfg-builder ; ] with-cfg-builder ;
: build-cfg ( nodes word -- procedures ) : build-cfg ( nodes word -- procedures )
@ -152,14 +153,17 @@ M: #if emit-node
! #dispatch ! #dispatch
: dispatch-branch ( nodes word -- label ) : dispatch-branch ( nodes word -- label )
#! The order here is important, dispatch-branches must
#! run after ##dispatch, so that each branch gets the
#! correct register state
gensym [ gensym [
[ [
V{ } clone node-stack set
init-phantoms init-phantoms
##prologue ##prologue
[ emit-nodes ] with-node-iterator emit-nodes
basic-block get [
##epilogue
##return
end-basic-block
] when
] with-cfg-builder ] with-cfg-builder
] keep ; ] keep ;

3
basis/compiler/cfg/iterator/iterator.factor
View File

@ -19,9 +19,6 @@ SYMBOL: node-stack
[ swap >node call node> drop ] keep iterate-nodes [ swap >node call node> drop ] keep iterate-nodes
] if ; inline recursive ] if ; inline recursive
: with-node-iterator ( quot -- )
>r V{ } clone node-stack r> with-variable ; inline
DEFER: (tail-call?) DEFER: (tail-call?)
: tail-phi? ( cursor -- ? ) : tail-phi? ( cursor -- ? )

15
basis/stack-checker/branches/branches.factor
View File

@ -78,22 +78,21 @@ SYMBOL: quotations
V{ } clone meta-r set V{ } clone meta-r set
d-in [ ] change ; d-in [ ] change ;
: infer-branch ( literal quot -- namespace ) : infer-branch ( literal -- namespace )
[ [
copy-inference copy-inference
nest-visitor nest-visitor
[ [ value>> quotation set ] [ infer-literal-quot ] bi ] dip [ value>> quotation set ] [ infer-literal-quot ] bi
check->r check->r
call
] H{ } make-assoc ; inline ] H{ } make-assoc ; inline
: infer-branches ( branches quot -- input children data ) : infer-branches ( branches -- input children data )
[ pop-d ] 2dip [ pop-d ] dip
[ infer-branch ] curry map [ infer-branch ] map
[ stack-visitor branch-variable ] keep ; inline [ stack-visitor branch-variable ] keep ; inline
: (infer-if) ( branches -- ) : (infer-if) ( branches -- )
[ ] infer-branches infer-branches
[ first2 #if, ] dip compute-phi-function ; [ first2 #if, ] dip compute-phi-function ;
: infer-if ( -- ) : infer-if ( -- )
@ -108,5 +107,5 @@ SYMBOL: quotations
: infer-dispatch ( -- ) : infer-dispatch ( -- )
pop-literal nip [ <literal> ] map pop-literal nip [ <literal> ] map
[ f #return, ] infer-branches infer-branches
[ #dispatch, ] dip compute-phi-function ; [ #dispatch, ] dip compute-phi-function ;