| |
|
| struct% |
struct% |
| cell% 2* field ss-registers \ addr u; ss-registers[0] is TOS |
cell% 2* field ss-registers \ addr u; ss-registers[0] is TOS |
| |
\ 0 means: use memory |
| cell% field ss-offset \ stack pointer offset: sp[-offset] is TOS |
cell% field ss-offset \ stack pointer offset: sp[-offset] is TOS |
| end-struct ss% \ stack-state |
end-struct ss% \ stack-state |
| |
|
| 0 value combined \ in combined prims the combined prim |
0 value combined \ in combined prims the combined prim |
| variable in-part \ true if processing a part |
variable in-part \ true if processing a part |
| in-part off |
in-part off |
| |
0 value state-in \ state on entering prim |
| |
0 value state-out \ state on exiting prim |
| |
|
| : prim-context ( ... p xt -- ... ) |
: prim-context ( ... p xt -- ... ) |
| \ execute xt with prim set to p |
\ execute xt with prim set to p |
| \ stack access stuff |
\ stack access stuff |
| |
|
| : normal-stack-access0 { n stack -- } |
: normal-stack-access0 { n stack -- } |
| |
\ 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 ." ]" ; |
| |
|
| : normal-stack-access1 { n stack -- } |
: normal-stack-access1 { n stack state -- } |
| |
state state-sss stack stack-number @ th @ { ss } |
| |
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 |
| |
endif |
| |
endif |
| |
drop |
| stack stack-pointer 2@ type |
stack stack-pointer 2@ type |
| n if |
n ss ss-offset @ - stack normal-stack-access0 ; |
| n stack normal-stack-access0 |
|
| else |
|
| ." TOS" |
|
| endif ; |
|
| |
|
| : normal-stack-access ( n stack -- ) |
: normal-stack-access ( n stack state -- ) |
| dup inst-stream-f = if |
over inst-stream-f = if |
| ." IMM_ARG(" normal-stack-access1 ." ," immarg ? ." )" |
." IMM_ARG(" normal-stack-access1 ." ," immarg ? ." )" |
| 1 immarg +! |
1 immarg +! |
| else |
else |
| stack stack-number @ part-num @ s-c-max-depth @ |
stack stack-number @ part-num @ s-c-max-depth @ |
| \ max-depth stack stack-number @ th @ ( ndepth nmaxdepth ) |
\ max-depth stack stack-number @ th @ ( ndepth nmaxdepth ) |
| over <= if ( ndepth ) \ load from memory |
over <= if ( ndepth ) \ load from memory |
| stack normal-stack-access |
stack state-in normal-stack-access |
| else |
else |
| drop n stack part-stack-access |
drop n stack part-stack-access |
| endif ; |
endif ; |
| stack stack-number @ part-num @ s-c-max-back-depth @ |
stack stack-number @ part-num @ s-c-max-back-depth @ |
| over <= if ( ndepth ) |
over <= if ( ndepth ) |
| stack combined ['] stack-diff prim-context - |
stack combined ['] stack-diff prim-context - |
| stack normal-stack-access |
stack state-out normal-stack-access |
| else |
else |
| drop n stack part-stack-access |
drop n stack part-stack-access |
| endif ; |
endif ; |
| in-part @ if |
in-part @ if |
| part-stack-read |
part-stack-read |
| else |
else |
| normal-stack-access |
state-in normal-stack-access |
| endif ; |
endif ; |
| |
|
| : stack-write ( n stack -- ) |
: stack-write ( n stack -- ) |
| in-part @ if |
in-part @ if |
| part-stack-write |
part-stack-write |
| else |
else |
| normal-stack-access |
state-out normal-stack-access |
| endif ; |
endif ; |
| |
|
| : item-in-index { item -- n } |
: item-in-index { item -- n } |
