===== Cooperative multitasker =====
Under construction
==== 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 |
===== Pseudo 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
===== Pseudo code for a tasker tool set =====
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
===== Generic Forth 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 ;
==== Implementation specific and example ====
This part is system specific (noForth t) and it's just an sample implementation:\\
\ 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 ;
Now a simple example, a counter as background task:\\
task: one
0 value CNT decimal
: COUNTER 1 2 3 begin 1 +to cnt 50 ms again ;
' counter one start-task
multi
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:\\
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 ;
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:
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
==== 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.
: 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
==== Contributions ====
Implementations