Forth-eV Wiki

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
===== Cooperative multitasker =====


==== The idea ====

A simple cooperative multitasker for use in Forth systems.\\
For the purpose of defining multiple independently running background program(s).\\

Characteristics of such a cooperative multitasker:
  * **Simple**
  * **Compact**
  * **Fast**
  * **Tasks in a circular list**
  * **You determine the task change with** ''%%PAUSE%%''
  * **The basic word set:** ''%%TASK%%'' ''%%TASK:%%'' ''%%START-TASK%%'' ''%%WAKE%%'' ''%%SLEEP%%'' ''%%STOP%%'' ''%%PAUSE%%''

{{ :pfw:multitasker_memory_use.gif?direct&400 |}}

A picture of three installed tasks, task3 is asleep.\\
All the tasks link to each other so they form a circular list.\\
Note that the number of task variables may vary for an other implementation.\\
The clue is to find out what's the most efficient method is for a given CPU & Forth implementation.\\
^  TCB  ^  Task1  ^  Task2  ^  Task3  ^  Function  ^
|  **Link**  |  task2  |  task3  |  task1  | Tasks link chain |
|  **Tstate**  |  true  |  true  |  false  | Active flag, true = active |
|  **Error#**  |  0  |  0  |  0  | Error number, 0 = no error |
|  **TRP**  |  ptr1  |  ptr2  |  ptr3  | Return stack pointer |
|  **TR0**  |  adr1  |  adr2  |  adr3  | Return stack bottom |
|  **TS0**  |  adr1  |  adr2  |  adr3  | Data stack bottom |

<html>
<!--
|  **BASE**  |  10  |  0A  |  02  |
|  **RP0**  |  adr1  |  adr2  |  adr3  |  
|  **SP0**  |  adr-1  |  adr-2  |  adr-3  |
-->
</html>
===== Pseudo code =====

<code>
0 value TP   \ Task Pointer, points to the current active task control block

Define: TVARIABLE
    Define: ,        \ TCB offset
    Action: @ tp + ; \ Calculate TCB address

\ The main Task Control Block at creation this task links to itself
\ Note: When the main task is put asleep we no longer have the interpreter available
Define: MAIN      \ Pointer to the main tasks control block

0 cells tvariable TLINK   \ A data cell, it links to the next task in the list
1 cells tvariable TSTATE  \ A data cell with this tasks state
2 cells tvariable TERR?   \ Tasks error code
3 cells tvariable TRP     \ Return stack pointer at the time of the task switch
4 cells tvariable TR0     \ Bottom of return stack
5 cells tvariable TS0     \ Bottom of data stack
6 cells constant #CONTROL \ Size of task control block

Function: PAUSE  ( -- )
    Save current tasks the TOS register (if any), stack pointer (SP), 
    instruction pointer (IP) and finally return stack pointer (RP)
    Replace to the task pointer TP with the address of the next active task
    Restore this tasks RP, SP, & TOS if any

Function: WAKE  ( task -- )
    Change the state of 'task' to active, making the task run

Function: SLEEP  ( task -- )
    Change the state of 'task' to inactive, preventing a task to run

Function: STOP  ( -- )
    Put current task in sleep mode and give control to next active task

Function: >TASK ( ip xt task -- )       \ Set task ready on it's R-stack
    Setup 'xt' as the background 'task' on the return stack for this task
    'ip' is the address of the tasks safe execution environment
    The return stack is filled like this: xt ip tos sp
    Where 'sp' is on top of this stack, the stack pointer

Function: TASK  ( +d +r "name" -- )
    Define a new task with "name" and +d cells of data stack space
    and +r cells of return stack space. Also define & initialize a 
    task control block and install a default task on the tasks return stack

Function: TASK:  ( "name" -- )
    Perform the function of TASK creating a task "name" with a data stack
    of 16 cells and a return stack of 32 cells

Function: RUN-TASK    ( -- )
    Build a safe execution environment where a tasks XT is executed
    When an error occurred the task is stopped and the error is noted in tasks TERR?

Function: START-TASK  ( xt task -- )
    Make task run the token xt by placing it in a return stack frame 
    with >TASK it is setup with the correct parameters for PAUSE
    Reset it's error flag and make the task active with WAKE
</code>

===== Pseudo code for a tasker tool set =====

<code>
Function: TASKS  ( -- )
    Show the state of all the tasks in the task list
    For example showing it's name, status, stacks usage, 
    error state and the attached action

Function: RDEPTH  ( task -- +n )
    Calculate the tasks return stack usage in cells '+n'

Function: TDEPTH  ( task -- +n )
    Calculate the tasks data stack usage in cells '+n'

Function:  .STK  ( task -- )
    Calculate & show the tasks data stack usage, like .S

Function: PASS  ( x0 .. xn +n task -- )
    Move the stack items x0 to xn to tasks 'task' data stack

Function: LOCK  ( sema -- )
   Do nothing when the current task already owns the semaphore
   Wait until the task is unlocked while giving control to the next task
   When the task is unlocked grab it by storing my tasks id in it

Function: UNLOCK  ( sema -- )
   Perform the function of UNLOCK and when i own it,
   free the semaphore by storing zero in it
</code>

===== Generic Forth code =====

<code>
Non standard but commonly used words: SP@ SP!  RP@ RP!
0 value TP   \ Task pointer

: TVARIABLE  \ Leave active tasks variable address
    create ,       ( offset "name" -- )
    does> @ tp + ; ( -- addr )

: HIS  ( task addr1 -- -- addr2 )  tp -  + ; \ Convert addr1 to variable address for task = addr2

\ The task variables in the task control block (TCB)
0 cells tvariable TLINK     \ Task-link chain
1 cells tvariable TSTATE    \ Task awake or not
2 cells tvariable TERR?     \ Error condition 0 = non
3 cells tvariable TRP       \ Return stack pointer
4 cells tvariable TR0       \ Return stack bottom
5 cells tvariable TS0       \ Data stack bottom
6 cells  constant #CONTROL  \ Size of task control block

create MAIN  \ Define main task control block
    main ,  true ,  false ,  0 ,  0 ,  0 ,

main    to tp \ Init task pointer

\ Note this sample code uses the return stack to save the tasks environment
\ It is also possible to do this on the data stack
: PAUSE  ( -- )
    false >r  sp@ >r  rp@ trp !          \ Save Forth environment
    begin  tlink @ to tp  tstate @ until \ Find active task
    trp @ rp!  r> sp!  r> drop ;         \ Restore next tasks environment

: WAKE   ( task -- )    true   swap tstate his ! ;
: SLEEP  ( task -- )    false  swap tstate his ! ;
: STOP   ( -- )         tp sleep  pause ;

: >TASK         ( ip xt task -- )       \ Set task ready on it's R-stack
    >r  r@ tr0 his @ cell-  tuck !      \ Setup task
    cell-  tuck !                       \ Setup IP
    0  swap cell-  tuck !               \ Setup TOS
    r@ ts0 his @  swap cell-  tuck !    \ Setup SP
    r> trp his ! ;                      \ Set tasks RP

create RUN-TASK   ( -- )
    ]  begin  r@ catch terr? !  stop  again  [

: START-TASK      ( xt task -- )       \ Install & start 'task' with 'xt'
    >r  false r@ terr? his !           \ Reset tasks error flag
    run-task swap r@ >task  r> wake ;  \ Set task ready and start it

\ TCB: tlink, tstate, terr?, trp, tr0, ts0.
\ R-stack: sp tos ip xt
: TASK     ( +d +r "name" -- )      \ Build new named task
    here >r  #control allot         \ Allocate TCB
    align  r@ #control 0 fill       \ TCB starts with all zeros
    tlink @  r@ !   r@ tlink !      \ Extend the task link
    cells allot  here r@ tr0 his !  \ Save R0
    cells allot  here r@ ts0 his !  \ Save S0
    run-task  ['] noop  r@ >task    \ Set tasks RP
    r> constant ;                   \ Task name

hex
\ Basic task with 20 cells return stack & 10 cells data stack
: TASK:    ( "name" -- )    20 10 task ;
</code>

==== Implementation specific and example ====

This part is system specific (noForth t) and it's just a sample implementation:\\
<code forth>
\ Redefine teminal I/O and MS to include multitasker
: T-KEY?    ( -- f )    key?) dup ?exit  pause ;
: T-KEY     ( -- c )    begin  t-key? until  key) ;
: T-EMIT    ( c -- )    emit)  pause ;

: MS        ( u -- )
    3E8 *  40054028 @ >r ( ticker ) \ 1000 us for each step
    begin   pause  40054028 @ r@ -  \ us diff
    over u< 0= until  r> 2drop ;    \ Done when diff U>= us

\ Multitasker on/off
: MULTI     ( -- )          \ Start multitasker
    main to tp  false terr? ! \ Initialise main task to TP, no errors yet
    ['] t-emit to 'emit  ['] t-key?  to 'key?  ['] t-key to 'key ;

: SINGLE    ( -- )          \ Leave multitasker
   ['] emit) to 'emit  ['] key?) to 'key?  ['] key) to 'key ;
</code>

Now a simple example, a counter as background task:\\
<code forth>
task: one
0 value CNT  decimal
: COUNTER  1 2 3  begin  1 +to cnt  50 ms  again ;
' counter  one start-task  
multi
</code>

Final example a very simple tool to view the tasks.\\
You could make it much more fancy by decoding the data to a more usefull form:\\
<code forth>
Uses: @+

: .WORD     ( u -- ) \ Type the word 'u' with 8-digits
    0 <# # # # # # # # # #> type space ;

: TASKS     ( -- )  \ Show all eight data cells from the TCB
    main
    begin
        cr dup .word  space dup @+ .word  @+ .word  @+ .word  @+ .word  @ .word
    @ dup main = until  drop ;
</code>

When a Forth system has a DOES> that can be used interactive, the words 
RUN-TASK and START-TASK can be written as one word like this:

<code forth>
create START-TASK   ( xt task -- )  \ Install & start 'task' with 'xt'
    ]  begin  r@ catch terr? !  stop  again  [
DOES>      ( xt task ip -- )
    swap >r  false r@ terr? his !   \ Reset tasks error flag
    swap r@ >task  r> wake ;        \ Set task ready and start it
</code>

==== Semaphores ====

Semaphores are a way to make part of the processor (temporary) your own.
When several tasks need the same device it is not very handy that they
access this device at about the same time. That's where semaphores can be used.

<code forth>
: LOCK      ( sema -- )
    dup @ TP = IF  drop exit  THEN  \ Do nothing when i own it
    BEGIN  dup @ WHILE pause REPEAT \ Semaphore not mine, to next task
    TP swap ! ;                     \ Semaphore free, grab it!

: UNLOCK    ( sema -- )     dup lock  false swap ! ; \ Free semaphore
</code>

==== Contributions ====

<html><h2 style="background-color:yellow">Implementations</h2></html>

**Primitives for noForth t on the RP2040**

Note that this is code directly from the noForth t metacompiler listing.\\
So take there there are some meta specific words in it like ''>box'', ''box>'' & ''tp>''.\\

<code forth>
code PAUSE      ( -- ) \ 29 machine cycles, is 0.232 microsec. at 125 MHz
    { ip sp tos } push,     \ 4 - Save Forth environment
    sun TP mov,             \ 1 - TCB address to SUN
    day rp mov,             \ 1 - RP to DAY
    day  sun 0C #) str,     \ 2 - DAY to RP
    begin, >box
    begin,                  \ An inactive task takes 7 cycles extra = 0.056 µs
        sun  sun ) ldr,     \ 2 - Fetch next link to SUN
        day  sun 4 #) ldr,  \ 2 - Next TSTATE @ to DAY
        day 0 # cmp,        \ 1 -
    =? no until,            \ 2 - Not zero?
    TP sun mov,             \ 1 - Next link address = new TCB
    day  sun 0C #) ldr,     \ 2 - RP @ to DAY
    rp day mov,             \ 1 - DAY to RP
    { ip sp tos } pop,      \ 4 - Restore Forth environment
    begin, >box
    next,                   \ 6
end-code

code STOP   ( -- )
    tp> ,  ( Address of main TCB )
code>
    w  w ) ldr,             \ 2 - main to W
    sun TP mov,             \ 1 - Task to DAY
    sun w cmp,              \ 1 - main = task?
    box> =? no until,       \ 2 - No = continue, yes = ready
    day 0 # movs,           \ 1 - False flag
    day  sun 4 #) str,      \ 2 - Store in TSTATE of myself
    { ip sp tos } push,     \ 4 - Save this tasks Forth environment
    w rp mov,               \ 1 - RP to W
    w  sun 0C #) str,       \ 2 - W to RP
  box> again,               \ 2 - Switch to next task
end-code

code SLEEP  ( task -- )
    tp> ,  ( Address of main TCB )
code>
    w  w ) ldr,             \ 2 - main to W
    tos w cmp,              \ 1 - main = task?
    =? no if, >box          \ 2 - No = continue, yes = ready
    day 0 # movs,           \ 1
  ahead, >box               \ 10 + 2
end-code

code WAKE   ( task -- )
    day 0 # movs,           \ 1 - Build true flag
    day day mvns,           \ 1
    box> then,              \     Resolve jump
    day  tos 4 #) str,      \ 2 - Store in TSTATE of task
    box> then,
    tos sp )+ ldr,          \ 2 - Drop task
    next,                   \ 6
end-code

code >TASK ( ip xt task -- )
    sp  { hop sun } ldm,    \ XT to HOP, IP to SUN
    { ip sp } push,         \ Save noForth registers
    moon rp mov,            \ Save RP
    ip sun mov,             \ Ip to IP
    day tos 20 #) ldr,      \ Read R0 to DAY
    rp day mov,             \ Use R0 as tasks RP
    sp tos 24 #) ldr,       \ Set SP to S0
    { ip sp tos hop } push, \ Initialise tasks return stack
    day rp mov,             \ Copy RP to DAY
    day  tos 0C #) str,     \ Set tasks RP too
    rp moon mov,            \ Restore noForth registers
    { ip sp } pop,
    tos  sp )+ ldr,         \ Pop stack
    next,
end-code
</code>