| \ n has the ss-offset already applied (see ...-access1) |
\ n has the ss-offset already applied (see ...-access1) |
| n stack stack-access-transform @ execute ." [" 0 .r ." ]" ; |
n stack stack-access-transform @ execute ." [" 0 .r ." ]" ; |
| |
|
| |
: state-ss { stack state -- ss } |
| |
state state-sss stack stack-number @ th @ ; |
| |
|
| |
: stack-reg { n stack state -- reg } |
| |
\ n is the index (TOS=0); reg is 0 if the access is to memory |
| |
stack state state-ss ss-registers 2@ n u> if ( addr ) \ in ss-registers? |
| |
n th @ |
| |
else |
| |
drop 0 |
| |
endif ; |
| |
|
| : normal-stack-access1 { n stack state -- } |
: normal-stack-access1 { n stack state -- } |
| state state-sss stack stack-number @ th @ { ss } |
n stack state stack-reg ?dup-if |
| ss ss-registers 2@ n u> if ( addr ) \ in ss-registers? |
|
| n th @ dup if ( register ) \ and is ss-registers[n] a register? |
|
| \ then use the register |
|
| register-name 2@ type exit |
register-name 2@ type exit |
| endif |
endif |
| endif |
|
| drop |
|
| stack stack-pointer 2@ type |
stack stack-pointer 2@ type |
| n ss ss-offset @ - stack normal-stack-access0 ; |
n stack state state-ss ss-offset @ - stack normal-stack-access0 ; |
| |
|
| : normal-stack-access ( n stack state -- ) |
: normal-stack-access ( n stack state -- ) |
| over inst-stream-f = if |
over inst-stream-f = if |
| rdrop ; |
rdrop ; |
| |
|
| : item-out-index ( item -- n ) |
: item-out-index ( item -- n ) |
| \ n is the index of item (in the in-effect) |
\ n is the index of item (in the out-effect) |
| >r r@ item-stack @ stack-out @ r> item-offset @ - 1- ; |
>r r@ item-stack @ stack-out @ r> item-offset @ - 1- ; |
| |
|
| : really-store-single ( item -- ) |
: really-store-single ( item -- ) |
| r@ item-out-index r@ item-stack @ stack-write ." );" |
r@ item-out-index r@ item-stack @ stack-write ." );" |
| rdrop ; |
rdrop ; |
| |
|
| : store-single ( item -- ) |
: store-single { item -- } |
| >r |
item item-stack @ { stack } |
| store-optimization @ in-part @ 0= and r@ same-as-in? and if |
store-optimization @ in-part @ 0= and item same-as-in? and |
| r@ item-in-index 0= r@ item-out-index 0= xor if |
item item-in-index stack state-in stack-reg 0= and \ in in memory? |
| ." IF_" r@ item-stack @ stack-pointer 2@ type |
item item-out-index stack state-out stack-reg 0= and \ out in memory? |
| ." TOS(" r@ really-store-single ." );" cr |
0= if |
| endif |
item really-store-single cr |
| else |
endif ; |
| r@ really-store-single cr |
|
| endif |
|
| rdrop ; |
|
| |
|
| : store-double ( item -- ) |
: store-double ( item -- ) |
| \ !! store optimization is not performed, because it is not yet needed |
\ !! store optimization is not performed, because it is not yet needed |
