Simpler compilation of dispatch
parent
f655a25762
commit
93e10566be
|
@ -60,9 +60,7 @@ HOOK: %jump-label compiler-backend ( label -- )
|
|||
! Test if vreg is 'f' or not
|
||||
HOOK: %jump-t compiler-backend ( label -- )
|
||||
|
||||
HOOK: %call-dispatch compiler-backend ( -- label )
|
||||
|
||||
HOOK: %jump-dispatch compiler-backend ( -- )
|
||||
HOOK: %dispatch compiler-backend ( -- )
|
||||
|
||||
HOOK: %dispatch-label compiler-backend ( word -- )
|
||||
|
||||
|
|
|
@ -111,20 +111,15 @@ M: ppc-backend %jump-label ( label -- ) B ;
|
|||
M: ppc-backend %jump-t ( label -- )
|
||||
0 "flag" operand f v>operand CMPI BNE ;
|
||||
|
||||
: (%dispatch) ( len -- )
|
||||
0 11 LOAD32 rc-absolute-ppc-2/2 rel-here
|
||||
"offset" operand "n" operand 1 SRAWI
|
||||
11 11 "offset" operand ADD
|
||||
11 dup rot cells LWZ ;
|
||||
|
||||
M: ppc-backend %call-dispatch ( word-table# -- )
|
||||
[ 7 (%dispatch) (%call) <label> dup B ] H{
|
||||
{ +input+ { { f "n" } } }
|
||||
{ +scratch+ { { f "offset" } } }
|
||||
} with-template ;
|
||||
|
||||
M: ppc-backend %jump-dispatch ( -- )
|
||||
[ %epilogue-later 6 (%dispatch) (%jump) ] H{
|
||||
M: ppc-backend %dispatch ( -- )
|
||||
[
|
||||
%epilogue-later
|
||||
0 11 LOAD32 rc-absolute-ppc-2/2 rel-here
|
||||
"offset" operand "n" operand 1 SRAWI
|
||||
11 11 "offset" operand ADD
|
||||
11 dup 6 cells LWZ
|
||||
(%jump)
|
||||
] H{
|
||||
{ +input+ { { f "n" } } }
|
||||
{ +scratch+ { { f "offset" } } }
|
||||
} with-template ;
|
||||
|
|
|
@ -77,26 +77,29 @@ M: x86-backend %jump-label ( label -- ) JMP ;
|
|||
M: x86-backend %jump-t ( label -- )
|
||||
"flag" operand f v>operand CMP JNE ;
|
||||
|
||||
: (%dispatch) ( n -- operand )
|
||||
! Load jump table base. We use a temporary register
|
||||
! since on AMD64 we have to load a 64-bit immediate. On
|
||||
! x86, this is redundant.
|
||||
! Untag and multiply to get a jump table offset
|
||||
"n" operand fixnum>slot@
|
||||
! Add jump table base
|
||||
"offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
|
||||
"n" operand "offset" operand ADD
|
||||
"n" operand swap bootstrap-cell 8 = 14 9 ? + [+] ;
|
||||
: code-alignment ( -- n )
|
||||
building get length dup cell align swap - ;
|
||||
|
||||
M: x86-backend %call-dispatch ( word-table# -- )
|
||||
[ 5 (%dispatch) CALL <label> dup JMP ] H{
|
||||
{ +input+ { { f "n" } } }
|
||||
{ +scratch+ { { f "offset" } } }
|
||||
{ +clobber+ { "n" } }
|
||||
} with-template ;
|
||||
: align-code ( n -- )
|
||||
0 <repetition> % ;
|
||||
|
||||
M: x86-backend %jump-dispatch ( -- )
|
||||
[ %epilogue-later 0 (%dispatch) JMP ] H{
|
||||
M: x86-backend %dispatch ( -- )
|
||||
[
|
||||
%epilogue-later
|
||||
! Load jump table base. We use a temporary register
|
||||
! since on AMD64 we have to load a 64-bit immediate. On
|
||||
! x86, this is redundant.
|
||||
! Untag and multiply to get a jump table offset
|
||||
"n" operand fixnum>slot@
|
||||
! Add jump table base
|
||||
"offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
|
||||
"n" operand "offset" operand ADD
|
||||
"n" operand HEX: 7f [+] JMP
|
||||
! Fix up the displacement above
|
||||
code-alignment dup bootstrap-cell 8 = 14 9 ? +
|
||||
building get dup pop* push
|
||||
align-code
|
||||
] H{
|
||||
{ +input+ { { f "n" } } }
|
||||
{ +scratch+ { { f "offset" } } }
|
||||
{ +clobber+ { "n" } }
|
||||
|
|
|
@ -56,13 +56,16 @@ GENERIC: generate-node ( node -- next )
|
|||
: generate-nodes ( node -- )
|
||||
[ node@ generate-node ] iterate-nodes end-basic-block ;
|
||||
|
||||
: init-generate-nodes ( -- )
|
||||
init-templates
|
||||
%save-word-xt
|
||||
%prologue-later
|
||||
current-label-start define-label
|
||||
current-label-start resolve-label ;
|
||||
|
||||
: generate ( word label node -- )
|
||||
[
|
||||
init-templates
|
||||
%save-word-xt
|
||||
%prologue-later
|
||||
current-label-start define-label
|
||||
current-label-start resolve-label
|
||||
init-generate-nodes
|
||||
[ generate-nodes ] with-node-iterator
|
||||
] generate-1 ;
|
||||
|
||||
|
@ -168,17 +171,23 @@ M: #if generate-node
|
|||
] if %dispatch-label
|
||||
] each ;
|
||||
|
||||
: generate-dispatch ( node -- )
|
||||
%dispatch dispatch-branches init-templates ;
|
||||
|
||||
M: #dispatch generate-node
|
||||
#! The order here is important, dispatch-branches must
|
||||
#! run after %dispatch, so that each branch gets the
|
||||
#! correct register state
|
||||
tail-call? [
|
||||
%jump-dispatch dispatch-branches
|
||||
generate-dispatch iterate-next
|
||||
] [
|
||||
0 frame-required
|
||||
%call-dispatch >r dispatch-branches r> resolve-label
|
||||
] if
|
||||
init-templates iterate-next ;
|
||||
compiling-word get gensym [
|
||||
rot [
|
||||
init-generate-nodes
|
||||
generate-dispatch
|
||||
] generate-1
|
||||
] keep generate-call
|
||||
] if ;
|
||||
|
||||
! #call
|
||||
: define-intrinsics ( word intrinsics -- )
|
||||
|
|
Loading…
Reference in New Issue