( -*-forth-*- )

( TODO: make this use the task stuff )

( coroutines
they differ from tasks in that they do their own context
saving/creating and are generally not independent of each
other

this might act strange in combination with does> because
of the multiple entry/exit points.

note that coroutines are instances.

words: are valid after a 'couroutine' word is called
to initialize a coroutine. also valid outside of
a word's definition

cr: tranfer caller's context to word
cr-yield: transfer control back to caller
cr-got-rrroom: check if there's room left to recurse
)



( macro compiles context swap with variable on tos )
: swap-rsp ( var -- )
    postpone dup
    postpone @
    postpone rsp@
    postpone swap
    postpone rsp!
    postpone swap
    postpone ! ; immediate


here ] ( cxt.var -- ) swap-rsp ;
constant cr-swap-context

variable last-cr-context
variable last-cr-xt
variable last-cr-entry
variable last-cr-swapper

: cr-pass-context ( cxt.var -- )
    r @ swap     ( get next execution token from calling thread )
    r> cell+ >r  ( adjust return address )
    swap-rsp pass execute ; ( this should be a tail call )

: install-swapper
    postpone jmp ( compile jmp to swapper )
    cr-swap-context compile 
;

: old-install-coroutine-context ( -- )
    here last-cr-context !
    here >r stack.comma          ( create stack )
    here r> stack.push           ( save entry point )
    here last-cr-entry !
    latestxt last-cr-xt !
;    

( yield to caller )
: enter-thread ip! ;
: cr-yield    last-cr-swapper @ postpone literal postpone enter-thread ; immediate

: install-coroutine-context ( -- )
    here last-cr-context !
    here >r stack.comma                ( create stack )
    here r>  stack.push                ( save entry address )
    here last-cr-entry !
;    

( compile a coroutine setup stub
  can be used as modifier inserted after name of newly compiled word )
: coroutine ( stacksize -- )
    here last-cr-swapper !
    compile-patchable-literal    ( create a patchable literal to store stack address )
    install-swapper              ( compile jump to swapper )
    !here                        ( patch stack address )
    install-coroutine-context
    
; immediate



( perform a coroutine call
this saves current context and passes on saved
caller context )
: cr
    last-cr-context @ postpone literal
    postpone cr-pass-context ; immediate

( do the rrr thing:
check if there is stack space left to recurse )

( check if there's still room on return stack )
: got-rrroom ( nb.cells stack -- bool.room )
    rsp@ swap sub swap 2 add cells gt ;

: cr-got-rrroom
    last-cr-context @ postpone literal
    postpone got-rrroom ; immediate




defer een  (  -- ) defer een-helper ( depth -- )
defer twee (  -- )

:noname ( -- ) [ 10 ] coroutine
    begin een-helper again
;

<is> een 

:noname
    [s] entering.een.helper .s
    123 .d cr-yield
    3 for 2 cr-got-rrroom if een-helper then next
    [s] leaving.een.helper .s
;
<is> een-helper ;