\ kstack.fth  provides a third stack capability, the K (for keep) stack,
\ to temporarily keep data while not interfering with the data and return
\ stacks. The K stack is available in both interpreter and compilation modes.

\ Copyright (C) Gerry Jackson 2009

\ This software is free; you can redistribute it and/or modify it in
\ any way provided you acknowledge the original source and copyright

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
\ ------------------------------------------------------------------------------
0 [if]
It uses the bottom of the data stack as the K stack and, therefore, may be
rather slow. It is intended primarily for interpreter mode (but can be used
in compiled code) where stack depths are usually low and where performance
is less important, but the facility may be used at run-time. The point is to
stop the system interfering with user use of the data stack when interpreting.
One use is to provide looping and other control words for interpretation
(see control.fth available on this site). The performance depends on the
depth of the data stack at the time the commands are used, the deeper the
slower as ROLL is used to push/pop items on the K stack (i.e. the bottom of
the data stack).

Words provided are (note that the K stack refers to the bottom of the
data stack). In the stack diagrams the top of the K stack is at the left
hand side of the data stack and grows to the left):

   >k  ( i*x x1 -- x1 i*x )
       Move the top of the data stack onto the K stack

   k>  ( x1 i*x -- i*x x1 )
       Move the top of the K stack onto the data stack

   k@  ( x1 i*x -- x1 i*x x1 )
       Copy the top of the K stack onto the data stack

   n>k ( i*x xu ... x1 u -- u xu ... x1 i*x )
       Move u items from the data stack onto the K stack where u is read
       from the top of the data stack. Push u onto the K stack.

   nk> ( u xu ... x1 i*x -- i*x xu ... x1 u )
       Move u items from the K stack onto the data stack where u is read
       from the top of the K stack. Push u onto the data stack.

   nk@ ( u xu ... x1 i*x -- u xu ... x1 i*x xu ... x1 u )
       Copy u items from the K stack to the data stack where u is read
       from the top of the K stack. Push u onto the data stack.

   kdrop  ( x i*x -- i*x )
       Drop the top of the K stack

   nkdrop  ( u xu ... x1 i*x -- i*x )
       Drop u items from the K stack
   
[then]

\ ------------------------------------------------------------------------------

.( kstack.fth loading ...) cr

\ ---[ Helpers ]----------------------------------------------------------------

[undefined] -roll [if]  \ opposite of ROLL
: -roll  ( xu ... x0 u -- x0 xu ... x1 )
   ?dup if rot >r 1- recurse r>  then 
;

\ Non-recursive version but much slower
\ : -roll  ( xu ... x0 u -- x0 xu ... x1 )
\   dup 0 ?do dup >r roll r> loop drop
\ ;
[then]

[undefined] ndrop [if]
: ndrop  ( xu ... x1 u -- )
   0 ?do drop loop
;
[then]

\ ------------------------------------------------------------------------------

: >k  ( i*x x1 -- x1 i*x ) \ Move x1 onto the K stack
   depth 1- 0 max -roll
;

: k>  (  x1 i*x -- i*x x1 ) \ Move x1 from the K stack onto the data stack
   depth 1- 0 max roll
;

: k@  ( x1 i*x -- x1 i*x x1 ) \ Copy x1 from the K stack to the data stack
   depth ?dup if 1- pick then
;

: n>k  ( i*x xu ... x1 u -- u xu ... x1 i*x ) \ Move u items onto the K stack
   dup dup >r -roll
   depth 1- dup r> - 0 max 0
   ?do dup >r roll r> loop
   drop
;

: nk>  ( u xu ... x1 i*x -- i*x xu ... x1 u ) \ Move u items to the data stack
   depth 2 - k> dup >r 0
   ?do dup >r roll r> loop
   drop r>
;

\ Copy u  items from the K stack to the data stack
: nk@  ( u xu ... x1 i*x -- u xu ... x1 i*x xu ... x1 u )
   depth 2 - k@ dup >r 0
   ?do dup >r pick r> loop
   drop r>
;

: kdrop  ( u i*x -- i*x )  k> drop ;

: nkdrop  ( u xu ... x1 i*x -- i*x )  nk> ndrop ;

.( kstack.fth loaded. ) .s