\ -----------------------------------------------------------
\   Cooperative Multitasking
\ -----------------------------------------------------------

\ Configuration:

40 constant stackspace \ 40 stack elements for every task

\ Internal stucture of task memory:
\    0: Pointer to next task
\    1: Task currently active ?
\    2: Saved data stack depth
\    3: Parameter stack space
\  n+3: Saved return stack depth
\  n+4: Return stack space
\ 2n+4: Complete size of data structure.

create boot-task
  here , \ Boot Task
  true , \   is active.
     0 , \ Saved depth: 0
  stackspace allot
     0 , \ Saved rdepth: 0
  stackspace allot

boot-task variable up \ User Pointer
: next-task   ( -- task )    up @ ;
: task-state  ( -- state )   up @ 1 + ;
: task-data   ( -- data )    up @ 2 + ;
: task-return ( -- return )  up @ 3 stackspace + + ;

: (pause) ( stacks fly around )

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

  depth task-data !  \ Number of elements
  task-data 1 + >r    \ Begin with top of stack

  begin
    depth
  while
    r@ !
    r> 1 + >r
  repeat

  rdrop

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

  rdepth task-return !  \ Number of elements
  task-return 1 +        \ Begin with top of return stack

  begin
    rdepth
  while
    r> over !
    1 +
  repeat

  drop

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

  begin
    next-task @ up !     \ Switch to next running task
  task-state @ until

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

  task-return @  \ Number of elements
  task-return +   \ Begin with end of stack

  begin
    dup task-return <>
  while
    dup @ >r
    1 -
  repeat

  drop


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

  task-data @  \ Number of elements
  task-data +   \ Begin with end of return stack
  >r

  begin
    r@ task-data <>
  while
    r@ @
    r> 1 - >r
  repeat

  rdrop

  \ -----------------------------------------------------------
;

: wake ( task -- ) 1 +  true swap ! ; \ Wake a random task (IRQ safe)
: idle ( task -- ) 1 + false swap ! ;  \ Idle a random task (IRQ safe)

\ -------------------------------------------------------
\  Round-robin list task handling - do not use in IRQ !
\ -------------------------------------------------------

: stop ( -- ) false task-state ! pause ; \ Stop current task
: multitask  ( -- ) ['] (pause) 2 lshift &0- 3any ['] pause ! ;
: singletask ( -- ) [']  nop    2 lshift &0- 3any ['] pause ! ;

: task-in-list? ( task -- ? ) \ Checks if a task is currently inside of round-robin list (do not use in IRQ)
  next-task
  begin
    ( Task-Address )
    2dup = if 2drop true exit then
    @ dup next-task = \ Stop when end of circular list is reached
  until
  2drop false
;

: previous ( task -- addr-of-task-before )
  \ Find the task that has the desired one in its next field
  >r next-task begin dup @ r@ <> while @ repeat rdrop
;

: insert ( task -- ) \ Insert a task into the round-robin list
  dup task-in-list?  \ Is the desired task currently linked into ?
  if drop else next-task @ over ! next-task ! then
;

: remove ( task -- ) \ Remove a task from the round-robin list
  dup task-in-list?  \ Is the desired task currently linked into ?
  if dup @ ( task next )
     swap previous ( next previous ) !
  else drop then
;

\ -----------------------------------------
\ Create a new task - do not use in IRQ !
\ -----------------------------------------

: task: ( "name" -- )  create stackspace 2 * 4 + allot ;

: preparetask ( task continue -- )
  swap >r ( continue R: task )

    \ true  r@ 1 + ! \ Currently running
         0  r@ 2 + ! \ Empty data stack
         1  r@ 3 stackspace + + ! \ One element in return stack
            r@ 4 stackspace + + ! \ Store the desired entry address at top of the tasks return stack

  r> insert
;

: activate ( task --   R: continue -- )
  true over 1 + ! \ Currently running
  r> preparetask
;

: background ( task --   R: continue -- )
  false over 1 + ! \ Currently idling
  r> preparetask
;

\ --------------------------------------------------
\  Multitasking insight
\ --------------------------------------------------

: task. ( Address -- )  \ If the address is known as a "literal exit" opcode sequence, it gets named.

  1 lshift >r \ Transform address into literal opcode
  forth @
  begin
    dup 0<>
  while
    dup 2 + count + ( Dictionary Codestart )
      dup @ r@ = swap 1 + @ &00---0000-++ = and \ Check for "literal exit" opcode sequence
      if dup 2 + count type space then
    @
  repeat
  drop rdrop
;


: tasks ( -- ) \ Show tasks currently in round-robin list
  ['] pause @ singletask \ Stop multitasking as this list may be changed during printout.

  \ Start with current task.
  next-task cr

  begin
    ( Task-Address )
    dup                    ." Task Address: " .
    dup                  @ ." Next Task: " .
    dup 1              + @ ." State: " t.
    dup 2              + @ ." Stack depth: " .
    dup 3 stackspace + + @ ." Return depth: " .
    dup                    ." Name: " task. cr

    @ dup next-task = \ Stop when end of circular list is reached
  until
  drop

  ['] pause ! \ Restore old state of multitasking
;
