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

Got scratch registers working; PowerPC backend fully operational, x86 in progress

slava 2006-04-29 21:13:02 +00:00
parent 906fea6508
commit f684243e2f
7 changed files with 280 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
TODO.FACTOR.txt
View File

@ -1,8 +1,8 @@
should fix in 0.82:
- type inference busted for tuple constructors
- constant branch folding
- getenv, setenv, fast-slot stuff
- more flexible fixnum intrinsics
- fast-slot stuff
- compile if-intrinsic even if there is no #if there
- 3 >n fep
- amd64 %box-struct
@ -13,7 +13,6 @@ should fix in 0.82:
- speed up ideas:
- only do clipping for certain gadgets
- use glRect
- cocoa: global menu bar with useful commands
+ portability:

8
library/compiler/generator/generator.factor
View File

@ -117,7 +117,7 @@ M: #label generate-node ( node -- next )
M: #if generate-node ( node -- next )
[
end-basic-block
<label> dup "flag" get %jump-t
<label> dup %jump-t
] H{
{ +input { { 0 "flag" } } }
} with-template generate-if ;
@ -153,8 +153,10 @@ M: #call-label generate-node ( node -- next )
: dispatch-head ( node -- label/node )
#! Output the jump table insn and return a list of
#! label/branch pairs.
[ end-basic-block "n" get %dispatch ]
H{ { +input { { 0 "n" } } } } with-template
[ end-basic-block %dispatch ] H{
{ +input { { f "n" } } }
{ +scratch { { f "scratch" } } }
} with-template
node-children [ <label> dup target-label 2array ] map ;
: dispatch-body ( label/node -- )

56
library/compiler/generator/templates.factor
View File

@ -4,8 +4,27 @@ IN: compiler
USING: arrays generic hashtables inference io kernel math
namespaces prettyprint sequences vectors words ;
! Register allocation
SYMBOL: free-vregs
: alloc-reg ( -- n )
free-vregs get pop ;
: alloc-reg# ( n -- regs )
free-vregs [ cut ] change ;
: requested-vregs ( template -- n )
0 [ [ 1+ ] unless ] reduce ;
: template-vreg# ( template template -- n )
[ requested-vregs ] 2apply + ;
: alloc-vregs ( template -- template )
[ first [ alloc-reg ] unless* ] map ;
: adjust-free-vregs ( seq -- )
free-vregs [ diff ] change ;
! A data stack location.
TUPLE: ds-loc n ;
@ -86,8 +105,6 @@ SYMBOL: phantom-r
: finalize-heights ( -- )
phantoms [ finalize-height ] 2apply ;
: alloc-reg ( -- n ) free-vregs get pop ;
: stack>vreg ( vreg# loc -- operand )
>r <vreg> dup r> %peek ;
@ -143,18 +160,6 @@ SYMBOL: phantom-r
used-vregs vregs length reverse diff
>vector free-vregs set ;
: requested-vregs ( template -- n )
0 [ [ 1+ ] unless ] reduce ;
: template-vreg# ( template template -- n )
[ requested-vregs ] 2apply + ;
: alloc-regs ( template -- template )
[ [ alloc-reg ] unless* ] map ;
: alloc-reg# ( n -- regs )
free-vregs [ cut ] change ;
: additional-vregs# ( seq seq -- n )
2array phantoms 2array [ [ length ] map ] 2apply v-
0 [ 0 max + ] reduce ;
@ -176,8 +181,7 @@ SYMBOL: phantom-r
: stack>vregs ( phantom template -- values )
[
[ first ] map alloc-regs
dup length rot phantom-locs
alloc-vregs dup length rot phantom-locs
[ stack>vreg ] 2map
] 2keep length neg swap adjust-phantom ;
@ -226,8 +230,6 @@ SYMBOL: +clobber
{ +clobber { } }
} swap hash-union ;
: adjust-free-vregs ( seq -- ) free-vregs [ diff ] change ;
: output-vregs ( -- seq seq )
+output +clobber [ get [ get ] map ] 2apply ;
@ -236,7 +238,11 @@ SYMBOL: +clobber
[ swap member? ] contains-with? ;
: slow-input ( template -- )
! Are we loading stuff from the stack? Then flush out
! remaining vregs, not slurped in by fast-input.
dup empty? [ finalize-contents ] unless
! Do the outputs clash with vregs on the phantom stacks?
! Then we must flush them first.
outputs-clash? [ finalize-contents ] when
phantom-d get swap [ stack>vregs ] keep phantom-vregs ;
@ -244,11 +250,23 @@ SYMBOL: +clobber
+input +scratch [ get [ second get vreg-n ] map ] 2apply
append ;
: guess-vregs ( -- n )
+input get dup { } additional-vregs# +scratch get length + ;
: alloc-scratch ( -- )
+scratch get [ alloc-vregs [ <vreg> ] map ] keep
phantom-vregs ;
: template-inputs ( -- )
+input get dup { } additional-vregs# ensure-vregs
! Ensure we have enough to hold any new stack elements we
! will read (if any), and scratch.
guess-vregs ensure-vregs
! Split the template into available (fast) parts and those
! that require allocating registers and reading the stack
match-template fast-input
used-vregs adjust-free-vregs
slow-input
alloc-scratch
input-vregs adjust-free-vregs ;
: template-outputs ( -- )

150
library/compiler/intrinsics.factor
View File

@ -1,150 +0,0 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: arrays assembler generic hashtables
inference kernel kernel-internals lists math math-internals
namespaces sequences words ;
\ slot [
[
"obj" get %untag ,
"n" get "obj" get %slot ,
] H{
{ +input { { f "obj" } { f "n" } } }
{ +output { "obj" } }
} with-template
] "intrinsic" set-word-prop
\ set-slot [
[
"obj" get %untag ,
"val" get "obj" get "slot" get %set-slot ,
finalize-contents
"obj" get %write-barrier ,
] H{
{ +input { { f "val" } { f "obj" } { f "slot" } } }
{ +clobber { "obj" } }
} with-template
] "intrinsic" set-word-prop
\ char-slot [
[
"n" get "str" get %char-slot ,
] H{
{ +input { { f "n" } { f "str" } } }
{ +output { "str" } }
} with-template
] "intrinsic" set-word-prop
\ set-char-slot [
[
"ch" get "str" get "n" get %set-char-slot ,
] H{
{ +input { { f "ch" } { f "n" } { f "str" } } }
} with-template
] "intrinsic" set-word-prop
\ type [
[ finalize-contents "in" get %type , ] H{
{ +input { { f "in" } } }
{ +output { "in" } }
} with-template
] "intrinsic" set-word-prop
\ tag [
[ "in" get %tag , ] H{
{ +input { { f "in" } } }
{ +output { "in" } }
} with-template
] "intrinsic" set-word-prop
: binary-op ( op -- )
[
finalize-contents >r "y" get "x" get dup r> execute ,
] H{
{ +input { { 0 "x" } { 1 "y" } } }
{ +output { "x" } }
} with-template ; inline
{
{ fixnum+ %fixnum+ }
{ fixnum- %fixnum- }
{ fixnum/i %fixnum/i }
{ fixnum* %fixnum* }
} [
first2 [ binary-op ] curry
"intrinsic" set-word-prop
] each
: binary-op-fast ( op -- )
[
>r "y" get "x" get dup r> execute ,
] H{
{ +input { { f "x" } { f "y" } } }
{ +output { "x" } }
} with-template ; inline
{
{ fixnum-bitand %fixnum-bitand }
{ fixnum-bitor %fixnum-bitor }
{ fixnum-bitxor %fixnum-bitxor }
{ fixnum+fast %fixnum+fast }
{ fixnum-fast %fixnum-fast }
} [
first2 [ binary-op-fast ] curry
"intrinsic" set-word-prop
] each
: binary-jump ( label op -- )
[
end-basic-block >r >r "y" get "x" get r> r> execute ,
] H{
{ +input { { f "x" } { f "y" } } }
} with-template ; inline
{
{ fixnum<= %jump-fixnum<= }
{ fixnum< %jump-fixnum< }
{ fixnum>= %jump-fixnum>= }
{ fixnum> %jump-fixnum> }
{ eq? %jump-eq? }
} [
first2 [ binary-jump ] curry
"if-intrinsic" set-word-prop
] each
\ fixnum-mod [
! This is not clever. Because of x86, %fixnum-mod is
! hard-coded to put its output in vreg 2, which happends to
! be EDX there.
[
finalize-contents
T{ vreg f 2 } "out" set
"y" get "x" get "out" get %fixnum-mod ,
] H{
{ +input { { 0 "x" } { 1 "y" } } }
! { +scratch { { 2 "out" } } }
{ +output { "out" } }
} with-template
] "intrinsic" set-word-prop
\ fixnum/mod [
! See the remark on fixnum-mod for vreg usage
[
finalize-contents
T{ vreg f 2 } "rem" set
"y" get "x" get 2array
"rem" get "x" get 2array %fixnum/mod ,
] H{
{ +input { { 0 "x" } { 1 "y" } } }
! { +scratch { { 2 "rem" } } }
{ +output { "x" "rem" } }
} with-template
] "intrinsic" set-word-prop
\ fixnum-bitnot [
[ "x" get dup %fixnum-bitnot , ] H{
{ +input { { f "x" } } }
{ +output { "x" } }
} with-template
] "intrinsic" set-word-prop

17
library/compiler/ppc/architecture.factor
View File

@ -69,17 +69,18 @@ M: object load-literal ( literal vreg -- )
: %jump ( label -- )
%epilogue dup postpone-word %jump-label ;
: %jump-t ( label vreg -- )
0 swap v>operand f address CMPI BNE ;
: %jump-t ( label -- )
0 "flag" operand f address CMPI BNE ;
: %dispatch ( vreg -- )
v>operand dup dup 1 SRAWI
: %dispatch ( -- )
"n" operand dup 1 SRAWI
! The value 24 is a magic number. It is the length of the
! instruction sequence that follows to be generated.
compiled-offset 24 + 11 LOAD32 rel-2/2 rel-address
dup dup 11 ADD
dup dup 0 LWZ
MTLR
compiled-offset 24 + "scratch" operand LOAD32
rel-2/2 rel-address
"n" operand dup "scratch" operand ADD
"n" operand dup 0 LWZ
"n" operand MTLR
BLR ;
: %return ( -- ) %epilogue BLR ;

364
library/compiler/ppc/intrinsics.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: assembler kernel kernel-internals math math-internals
namespaces sequences ;
USING: alien assembler kernel kernel-internals math
math-internals namespaces sequences words ;
: untag ( dest src -- ) 0 0 31 tag-bits - RLWINM ;
@ -11,11 +11,12 @@ namespaces sequences ;
: untag-fixnum ( src dest -- ) tag-bits SRAWI ;
\ tag [
"in" operand dup tag-mask ANDI
"in" operand dup tag-fixnum
"in" operand "out" operand tag-mask ANDI
"out" operand dup tag-fixnum
] H{
{ +input { { f "in" } } }
{ +output { "in" } }
{ +scratch { { f "out" } } }
{ +output { "out" } }
} define-intrinsic
: generate-slot ( size quot -- )
@ -43,6 +44,42 @@ namespaces sequences ;
{ +output { "obj" } }
} define-intrinsic
: generate-set-slot ( size quot -- )
>r >r
! turn tagged fixnum slot # into an offset, multiple of 4
"slot" operand dup tag-bits r> - SRAWI
! compute slot address in 1st input
"slot" operand dup "obj" operand ADD
! store new slot value
"val" operand "slot" operand r> call ; inline
: generate-write-barrier ( -- )
#! Mark the card pointed to by vreg.
"obj" operand dup card-bits SRAWI
"obj" operand dup 16 ADD
"x" operand "obj" operand 0 LBZ
"x" operand dup card-mark ORI
"x" operand "obj" operand 0 STB ;
\ set-slot [
"obj" operand dup untag
cell log2 [ 0 STW ] generate-set-slot generate-write-barrier
] H{
{ +input { { f "val" } { f "obj" } { f "slot" } } }
{ +scratch { { f "x" } } }
{ +clobber { "obj" } }
} define-intrinsic
\ set-char-slot [
! untag the new value in 0th input
"val" operand dup untag-fixnum
1 [ string-offset STH ] generate-set-slot
] H{
{ +input { { f "val" } { f "slot" } { f "obj" } } }
{ +scratch { { f "x" } } }
{ +clobber { "obj" } }
} define-intrinsic
: define-binary-op ( word op -- )
[ [ "x" operand "y" operand "x" operand ] % , ] [ ] make H{
{ +input { { f "x" } { f "y" } } }
@ -59,6 +96,23 @@ namespaces sequences ;
first2 define-binary-op
] each
: generate-fixnum-mod
#! PowerPC doesn't have a MOD instruction; so we compute
#! x-(x/y)*y. Puts the result in "s" operand.
"s" operand "r" operand "y" operand MULLW
"s" operand "s" operand "x" operand SUBF ;
\ fixnum-mod [
! divide x by y, store result in x
"r" operand "x" operand "y" operand DIVW
generate-fixnum-mod
"x" operand "s" operand MR
] H{
{ +input { { f "x" } { f "y" } } }
{ +scratch { { f "r" } { f "s" } } }
{ +output { "x" } }
} define-intrinsic
\ fixnum-bitnot [
"x" operand dup NOT
"x" operand dup untag
@ -83,143 +137,163 @@ namespaces sequences ;
first2 define-binary-jump
] each
! M: %type generate-node ( vop -- )
! drop
! <label> "f" set
! <label> "end" set
! ! Get the tag
! 0 input-operand 1 scratch tag-mask ANDI
! ! Tag the tag
! 1 scratch 0 scratch tag-fixnum
! ! Compare with object tag number (3).
! 0 1 scratch object-tag CMPI
! ! Jump if the object doesn't store type info in its header
! "end" get BNE
! ! It does store type info in its header
! ! Is the pointer itself equal to 3? Then its F_TYPE (9).
! 0 0 input-operand object-tag CMPI
! "f" get BEQ
! ! The pointer is not equal to 3. Load the object header.
! 0 scratch 0 input-operand object-tag neg LWZ
! 0 scratch dup untag
! "end" get B
! "f" get save-xt
! ! The pointer is equal to 3. Load F_TYPE (9).
! f type tag-bits shift 0 scratch LI
! "end" get save-xt
! 0 output-operand 0 scratch MR ;
!
! : generate-set-slot ( size quot -- )
! >r >r
! ! turn tagged fixnum slot # into an offset, multiple of 4
! 2 input-operand dup tag-bits r> - SRAWI
! ! compute slot address in 1st input
! 2 input-operand dup 1 input-operand ADD
! ! store new slot value
! 0 input-operand 2 input-operand r> call ; inline
!
! M: %set-slot generate-node ( vop -- )
! drop cell log2 [ 0 STW ] generate-set-slot ;
!
! M: %write-barrier generate-node ( vop -- )
! #! Mark the card pointed to by vreg.
! drop
! 0 input-operand dup card-bits SRAWI
! 0 input-operand dup 16 ADD
! 0 scratch 0 input-operand 0 LBZ
! 0 scratch dup card-mark ORI
! 0 scratch 0 input-operand 0 STB ;
!
! : simple-overflow ( inv word -- )
! >r >r
! <label> "end" set
! "end" get BNO
! >3-vop< r> execute
! 0 input-operand dup untag-fixnum
! 1 input-operand dup untag-fixnum
! >3-vop< r> execute
! "s48_long_to_bignum" f compile-c-call
! ! An untagged pointer to the bignum is now in r3; tag it
! 0 output-operand dup bignum-tag ORI
! "end" get save-xt ; inline
!
! M: %fixnum+ generate-node ( vop -- )
! drop 0 MTXER >3-vop< ADDO. \ SUBF \ ADD simple-overflow ;
!
! M: %fixnum- generate-node ( vop -- )
! drop 0 MTXER >3-vop< SUBFO. \ ADD \ SUBF simple-overflow ;
!
! M: %fixnum* generate-node ( vop -- )
! #! Note that this assumes the output will be in r3.
! drop
! <label> "end" set
! 1 input-operand dup untag-fixnum
! 0 MTXER
! 0 scratch 0 input-operand 1 input-operand MULLWO.
! "end" get BNO
! 1 scratch 0 input-operand 1 input-operand MULHW
! 4 1 scratch MR
! 3 0 scratch MR
! "s48_fixnum_pair_to_bignum" f compile-c-call
! ! now we have to shift it by three bits to remove the second
! ! tag
! tag-bits neg 4 LI
! "s48_bignum_arithmetic_shift" f compile-c-call
! ! An untagged pointer to the bignum is now in r3; tag it
! 0 output-operand 0 scratch bignum-tag ORI
! "end" get save-xt
! 0 output-operand 0 scratch MR ;
!
! : generate-fixnum/i
! #! This VOP is funny. If there is an overflow, it falls
! #! through to the end, and the result is in 0 output-operand.
! #! Otherwise it jumps to the "no-overflow" label and the
! #! result is in 0 scratch.
! 0 scratch 1 input-operand 0 input-operand DIVW
! ! if the result is greater than the most positive fixnum,
! ! which can only ever happen if we do
! ! most-negative-fixnum -1 /i, then the result is a bignum.
! <label> "end" set
! <label> "no-overflow" set
! most-positive-fixnum 1 scratch LOAD
! 0 scratch 0 1 scratch CMP
! "no-overflow" get BLE
! most-negative-fixnum neg 3 LOAD
! "s48_long_to_bignum" f compile-c-call
! 3 dup bignum-tag ORI ;
!
! M: %fixnum/i generate-node ( vop -- )
! #! This has specific vreg requirements.
! drop
! generate-fixnum/i
! "end" get B
! "no-overflow" get save-xt
! 0 scratch 0 output-operand tag-fixnum
! "end" get save-xt ;
!
! : generate-fixnum-mod
! #! PowerPC doesn't have a MOD instruction; so we compute
! #! x-(x/y)*y. Puts the result in 1 scratch.
! 1 scratch 0 scratch 0 input-operand MULLW
! 1 scratch 1 scratch 1 input-operand SUBF ;
!
! M: %fixnum-mod generate-node ( vop -- )
! drop
! ! divide in2 by in1, store result in out1
! 0 scratch 1 input-operand 0 input-operand DIVW
! generate-fixnum-mod
! 0 output-operand 1 scratch MR ;
!
! M: %fixnum/mod generate-node ( vop -- )
! #! This has specific vreg requirements. Note: if there's an
! #! overflow, (most-negative-fixnum 1 /mod) the modulus is
! #! always zero.
! drop
! generate-fixnum/i
! 0 0 output-operand LI
! "end" get B
! "no-overflow" get save-xt
! generate-fixnum-mod
! 0 scratch 1 output-operand tag-fixnum
! 0 output-operand 1 scratch MR
! "end" get save-xt ;
\ type [
<label> "f" set
<label> "end" set
! Get the tag
"obj" operand "y" operand tag-mask ANDI
! Tag the tag
"y" operand "x" operand tag-fixnum
! Compare with object tag number (3).
0 "y" operand object-tag CMPI
! Jump if the object doesn't store type info in its header
"end" get BNE
! It does store type info in its header
! Is the pointer itself equal to 3? Then its F_TYPE (9).
0 "obj" operand object-tag CMPI
"f" get BEQ
! The pointer is not equal to 3. Load the object header.
"x" operand "obj" operand object-tag neg LWZ
"x" operand dup untag
"end" get B
"f" get save-xt
! The pointer is equal to 3. Load F_TYPE (9).
f type tag-bits shift "x" operand LI
"end" get save-xt
] H{
{ +input { { f "obj" } } }
{ +scratch { { f "x" } { f "y" } } }
{ +output { "x" } }
} define-intrinsic
: simple-overflow ( word -- )
>r
<label> "end" set
"end" get BNO
{ "x" "y" } [ operand ] map prune [ dup untag-fixnum ] each
3 "y" operand "x" operand r> execute
"s48_long_to_bignum" f %alien-invoke
! An untagged pointer to the bignum is now in r3; tag it
3 "r" operand bignum-tag ORI
"end" get save-xt ; inline
\ fixnum+ [
finalize-contents
0 MTXER
"r" operand "y" operand "x" operand ADDO.
\ ADD simple-overflow
] H{
{ +input { { f "x" } { f "y" } } }
{ +scratch { { f "r" } } }
{ +output { "r" } }
} define-intrinsic
\ fixnum- [
finalize-contents
0 MTXER
"r" operand "y" operand "x" operand SUBFO.
\ SUBF simple-overflow
] H{
{ +input { { f "x" } { f "y" } } }
{ +scratch { { f "r" } } }
{ +output { "r" } }
} define-intrinsic
: ?MR 2dup = [ 2drop ] [ MR ] if ;
\ fixnum* [
finalize-contents
<label> "end" set
"r" operand "x" operand untag-fixnum
0 MTXER
11 "y" operand "r" operand MULLWO.
"end" get BNO
4 "y" operand "r" operand MULHW
3 11 ?MR
"s48_fixnum_pair_to_bignum" f %alien-invoke
! now we have to shift it by three bits to remove the second
! tag
tag-bits neg 4 LI
"s48_bignum_arithmetic_shift" f %alien-invoke
! An untagged pointer to the bignum is now in r3; tag it
3 11 bignum-tag ORI
"end" get save-xt
"s" operand 11 MR
] H{
{ +input { { f "x" } { f "y" } } }
{ +scratch { { f "r" } { f "s" } } }
{ +output { "s" } }
} define-intrinsic
: generate-fixnum/i
#! This VOP is funny. If there is an overflow, it falls
#! through to the end, and the result is in "x" operand.
#! Otherwise it jumps to the "no-overflow" label and the
#! result is in "r" operand.
<label> "end" set
<label> "no-overflow" set
"r" operand "x" operand "y" operand DIVW
! if the result is greater than the most positive fixnum,
! which can only ever happen if we do
! most-negative-fixnum -1 /i, then the result is a bignum.
most-positive-fixnum "s" operand LOAD
"r" operand 0 "s" operand CMP
"no-overflow" get BLE
most-negative-fixnum neg 3 LOAD
"s48_long_to_bignum" f %alien-invoke
"x" operand 3 bignum-tag ORI ;
\ fixnum/i [
finalize-contents
generate-fixnum/i
"end" get B
"no-overflow" get save-xt
"r" operand "x" operand tag-fixnum
"end" get save-xt
] H{
{ +input { { f "x" } { f "y" } } }
{ +scratch { { f "r" } { f "s" } } }
{ +output { "x" } }
} define-intrinsic
\ fixnum/mod [
finalize-contents
generate-fixnum/i
0 "s" operand LI
"end" get B
"no-overflow" get save-xt
generate-fixnum-mod
"r" operand "x" operand tag-fixnum
"end" get save-xt
] H{
{ +input { { f "x" } { f "y" } } }
{ +scratch { { f "r" } { f "s" } } }
{ +output { "x" "s" } }
} define-intrinsic
: userenv ( reg -- )
#! Load the userenv pointer in a register.
"userenv" f dlsym swap LOAD32 0 rel-2/2 rel-userenv ;
\ getenv [
"n" operand dup 1 SRAWI
"x" operand userenv
"x" operand "n" operand "x" operand ADD
"x" operand dup 0 LWZ
] H{
{ +input { { f "n" } } }
{ +scratch { { f "x" } } }
{ +output { "x" } }
{ +clobber { "n" } }
} define-intrinsic
\ setenv [
"n" operand dup 1 SRAWI
"x" operand userenv
"x" operand "n" operand "x" operand ADD
"val" operand "x" operand 0 STW
] H{
{ +input { { f "val" } { f "n" } } }
{ +scratch { { f "x" } } }
{ +clobber { "n" } }
} define-intrinsic

17
library/compiler/x86/architecture.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: alien arrays assembler generic kernel kernel-internals
math sequences words ;
math namespaces sequences words ;
! x86 register assignments
! EAX, ECX, EDX vregs
@ -59,24 +59,23 @@ M: object load-literal ( dest literal -- )
: %jump-label ( label -- ) JMP ;
: %jump-t ( label vreg -- )
v>operand f v>operand CMP JNE ;
: %jump-t ( label -- )
"flag" operand f v>operand CMP JNE ;
: %dispatch ( vreg -- )
: %dispatch ( -- )
#! Compile a piece of code that jumps to an offset in a
#! jump table indexed by the fixnum at the top of the stack.
#! The jump table must immediately follow this macro.
drop
<label> "end" set
! Untag and multiply to get a jump table offset
dup fixnum>slot@
"n" operand fixnum>slot@
! Add to jump table base. We use a temporary register since
! on AMD4 we have to load a 64-bit immediate. On x86, this
! is redundant.
0 scratch HEX: ffffffff MOV "end" get absolute-cell
dup 0 scratch ADD
"scratch" get HEX: ffffffff MOV "end" get absolute-cell
"n" operand "scratch" get ADD
! Jump to jump table entry
dup [] JMP
"n" operand [] JMP
! Align for better performance
compile-aligned
! Fix up jump table pointer