\ Do not use this file except in compliance with the License. You may \ obtain a copy of the License at http://www.microcore.org/License/ \ Software distributed under the License is distributed on an "AS IS" basis, \ WITHOUT WARRANTY OF ANY KIND, either express or implied. \ See the License for the specific language governing rights and limitations \ under the License. \ \ The Original Code is: MULTITASK.FS \ \ Last change: KS 16.10.2015 09:44:36 \ \ The Initial Developer of the Original Code is Klaus.Schleisiek AT hamburg.de. \ \ A multitasker for uCore. To use the multitasker, \ tasks_addr_width must be > 0 in CONSTANTS.VHD \ Host Variable TaskVariables TaskVariables off \ counter for task variables Target Host: Taskvariable ( -- ) TaskVariables @ T Constant H 1 TaskVariables +! ; Host: Task ( -- ) TaskVariables @ T Create allot H ; Host: Semaphore ( -- ) T Create 3 allot H ; Taskvariable #t_link \ link to next task Taskvariable #t_exec \ task execution vector Taskvariable #t_dsp \ data stack address Taskvariable #t_pause \ where to go after PAUSE Taskvariable #t_sema \ waiting on semaphore Taskvariable #t_time \ waiting on timer Taskvariable #t_poll \ waiting on specific polling routine Taskvariable #t_catch \ holds address of latest catch frame or zero \ 0 1 2 3 4 Create Priority 5 allot \ | link | do_priority | time | longest | task | 2 Constant #p_time 3 Constant #p_longest 4 Constant #p_task Create RoundRobin 2 allot \ | link | do_robin | 2 3 4 5 6 7 Task Terminal \ | link | go_next | dsp | pause_link | sema | time | poll | catch | \ do_wake Variable Sema_link 0 Constant #s_task \ must remain 0! 1 Constant #s_count 2 Constant #s_link \ semaphore: | owner_task | count | sema_link | : link-semaphore ( sema -- ) >r 0 dup r@ st 1 + ! Sema_link @ r@ #s_link + ! r> Sema_link ! ; \ defined in Constants.fs: \ tasks_addr_width 2** Constant #tasks \ rs_addr_width 2** Constant #rstack \ rs_base_width 2** Constant #rbase \ ds_addr_width 2** Constant #dstack : dsp>task ( dsp -- task_nr ) [ ds_addr_width negate ] Literal shift ; : task>dsp ( task_nr -- dsp ) WITH_MULT [IF] #dstack * ; [ELSE] ds_addr_width shift ; [THEN] : task>rsp ( task_nr -- rsp ) WITH_MULT [IF] 1+ #rstack * [ELSE] rs_addr_width 1+ shift [THEN] [ #rbase #rstack #tasks * - ] Literal + 1- ; \ : rsp>task ( rsp -- task_nr ) \ [ #rbase #rstack #tasks * - ] Literal - \ rs_addr_width ?FOR u2/ NEXT \ ; Macro: do_next_task ( taddr -- R: exec_addr ) T #t_exec + ld >r BRANCH H ; ] Label go_next ( R: exec_addr1 -- exec_addr2 ) r> -1 + @ do_next_task Label do_poti ( R: exec_addr1 -- exec_addr2 ) r@ [ #t_poll #t_exec - ] Literal + @ execute 0= IF \ jump forward to do_wake routine Label do_time ( R: exec_addr1 -- exec_addr2 ) r@ [ #t_time #t_exec - ] Literal + @ time? 0= IF r> 1- @ do_next_task THEN 0 r@ [ #t_time #t_exec - ] Literal + ! \ reset #t_time field Label do_wake ( R: exec_addr -- ) THEN \ destination from do_poti IF go_next r> st 1 tld nip over - \ is it a different task, or myself? IF #t_exec - >r \ different, do a task switch rsp@ dup dsp@ #t_dsp t! \ store my rsp on stack and save dsp in my task variable r@ task! \ switch task #t_dsp t@ dsp! drop \ restore dsp, fill TOS, NOS rsp! r> \ restore rsp, fill TOR THEN drop EXIT \ if myself nothing else to do Label do_poll ( R: exec_addr1 -- R: exec_addr2 ) r@ [ #t_poll #t_exec - ] Literal + @ execute [ H source> T do_wake H #begin T ] 0= UNTIL r> 1- @ do_next_task Label do_roundrobin ( R: exec_addr1 -- R: exec_addr2 ) r> -1 + ld swap ( robin 1st ) ld swap priority = IF nip do_next_task THEN ( robin 1st ) \ only one single roundrobin task in existence dup dup BEGIN nip ld swap ld swap priority = UNTIL ( robin 1st last-1 last ) swap >r st ( robin last R: last-1 ) tuck swap ! ( last R: last-1 ) priority r> ! ( last ) do_next_task Label do_priority ( R: exec_addr1 -- exec_addr2 ) \ performance measurement: store task with maximum run time r> -1 + ld ( next a_priority ) \ kick_watchdog \ here the watchdog would be kicked in a real system #p_time + ld >r ( next count ) ( R: a_count ) timer @ dup r@ ! swap - ( next delta_t ) ( R: a_count ) r> [ #p_longest #p_time - ] Literal + ld >r ( next delta_t max ) ( R: a_max ) over - carry? IF 2drop rdrop do_next_task THEN ( next delta_t delta ) ( R: a_max ) drop r> st ( next a_max ) myself swap [ #p_task #p_longest - ] Literal + ! ( next ) do_next_task [ : exceptionService ( R: caddr+1 -- R: exec_addr ) r> 1- >r \ back to the instruction that caused the exception ;noexit : pause ( R: caddr -- R: exec_addr ) do_wake #t_exec tst \ write do_wake into exec field of my task [ #t_pause #t_exec - ] literal + @ \ go to task in my taskPause field do_next_task ; : halt ( -- R: exec_addr ) #t_pause t@ do_next_task \ goto task in my #t_pause field ; : wake ( task -- ) do_wake swap #t_exec + ! ; : message ( n -- ) myself Terminal = IF message EXIT THEN #t_sema t! halt ; : task_used? ( task_number -- f ) >r Priority #t_link + @ BEGIN dup RoundRobin = IF #t_link + @ THEN #t_dsp + ld swap dsp>task r@ = IF rdrop EXIT THEN [ #t_link #t_dsp - ] Literal + @ dup Priority = UNTIL drop rdrop False ; : get_task_number ( -- task_number ) 0 BEGIN dup task_used? WHILE 1+ dup #tasks = IF #all_tasks_busy message THEN REPEAT ; : prioritized? ( task -- f ) >r Priority #t_link + @ BEGIN dup RoundRobin - WHILE dup r@ = IF rdrop EXIT THEN #t_link + @ REPEAT 0= rdrop ; : schedule ( task newtask -- ) >r go_next r@ #t_exec + ! get_task_number task>dsp r@ #t_dsp + ! dup #t_link + @ r@ #t_link + ! r@ swap #t_link + ! \ link newtask into task list after task r@ prioritized? IF r@ #t_link + @ ELSE Priority THEN r@ #t_pause + ! 0 r> #t_sema + ! ; : activate ( task xt -- ) over >r r@ #t_dsp + @ dsp>task \ determine task number dup task>dsp 2 + r@ #t_dsp + ! \ initialise dsp task>rsp ['] halt swap st \ put a "halt" into the bottom position of the return stack -1 + st >r \ and the word to be executed above #t_dsp + @ 2 - \ compute "empty" dsp of new task dsp@ >r dsp! \ save dsp and switch into stack of new task r> r> dup rot dsp! drop \ initialise its stack with 2 elements and switch back to own stack 0 r@ #t_catch + ! \ initialize t_catch field do_wake r> #t_exec + ! \ wake new task ; : spawn ( task newtask service_xt -- ) >r tuck schedule r> activate ; : lock ( sema -- ) BEGIN ld swap dup IF myself - THEN WHILE dup #t_sema t! halt REPEAT myself swap #s_task + st [ #s_count #s_task - ] Literal + inc ; : semaphore_available ( sema -- ) >r Priority #t_link + @ BEGIN dup RoundRobin = IF #t_link + @ THEN dup #t_sema + @ r@ = IF dup wake 0 over #t_sema + ! THEN #t_link + @ dup Priority = UNTIL drop 0 r> #s_task + ! ; : unlock ( sema -- ) dup @ myself - IF #not_my_semaphore message THEN ;noexit : force_unlock ( sema -- ) dup 1+ dup dec @ IF drop EXIT THEN semaphore_available pause ; : wait ( sema -- ) \ this wait works with SIGNAL executed inside interrupt servers \ interrupts disabled for 9 cycles BEGIN status@ swap \ save interrupt status di #s_count + ld swap ?dup IF 1- swap ! IRET THEN \ decrement count field when successful myself swap #s_count - st \ insert task-address when not successful swap status! \ restore interrupt status halt 0 swap st REPEAT ;noexit : signal ( sema -- ) dup #s_count + inc @ ?dup 0= ?EXIT wake ; : unlock_semaphores ( task -- ) >r Sema_link @ BEGIN ?dup WHILE dup #s_task + @ r@ = IF 1 over #s_count + ! dup force_unlock THEN #s_link + @ REPEAT rdrop ; : deactivate ( task -- ) go_next over #t_exec + ! dup unlock_semaphores 0 over #t_sema + ! myself - ?EXIT myself #t_link + @ do_next_task ; : previous_task ( task -- task-1 ) >r Priority BEGIN #t_link + ld over r@ = IF rdrop nip EXIT THEN drop dup Priority = UNTIL rdrop drop #task_not_linked message ; : cancel ( task -- ) dup previous_task over #t_link + @ swap #t_link + ! \ link task out of task list deactivate ; : continue ( time -- ) #t_time t! do_time #t_exec t! halt ; : sleep ( ticks -- ) ahead continue ; : poll ( xt -- ) do_poll #t_exec tst [ #t_poll #t_exec - ] Literal + ! halt ; : poll_timed ( xt ticks -- f ) timer @ + ;noexit : poll_until ( xt time -- f ) #t_time t! do_poti #t_exec tst [ #t_poll #t_exec - ] Literal + ! halt #t_time t@ 0<> ; \ RoundRobin Priority ! do_priority Priority #t_exec + ! \ Terminal RoundRobin ! do_roundrobin RoundRobin #t_exec + ! \ Priority Terminal ! go_next Terminal #t_exec + ! Priority Terminal #t_pause + ! : init ( -- ) 0 0 timer @ do_priority RoundRobin Priority st 1 + st 1 + st 1 + st 1 + ! do_roundrobin Terminal RoundRobin st 1 + ! 0 Priority 0 task>dsp go_next Priority Terminal st 1 + st 1 + st 1 + st 1 + ! Terminal task! Sema_link off init ; : catch ( xt -- error# | 0 ) \ Return address is already on rstack dsp@ >r ( xt ) \ Save data stack pointer, xt fills NOS slot #t_catch t@ >r ( xt ) \ Save previous #t_catch 0 >r rsp@ #t_catch t! ( xt ) \ Fill TOR and set #t_catch to RSP rdrop execute ( ) \ Execute the word passed on the stack r> #t_catch t! ( ) \ Restore previous #t_catch rdrop ( ) \ Discard saved stack pointer 0 ( 0 ) \ Signify normal completion ; : throw ( error# -- error# ) \ Returns to context saved by CATCH ?dup 0= ?EXIT \ Don't throw 0 #t_catch t@ ?dup 0= IF #catch_not_initialized message THEN rsp! rdrop ( err# ) \ Return to saved return stack context r> #t_catch t! ( err# ) \ Restore previous #t_catch r> swap >r ( saved-dsp ) \ save err# temporarily on rstack dsp! drop r> ( err# ) \ Change stack pointer \ EXIT will return to the caller of CATCH, because the return stack has been restored to the state that existed when CATCH was executed. ; \ ------------------------------------------------------------------ \ TASKS prints task status \ \ please note that the status of single tasks changes, while \ they are printed. Only the sequence of tasks is a momentary \ snapshot, because of task-links \ ------------------------------------------------------------------ Host: .task ( addr -- ) dup Variables .listname &15 position \ print taskname [ T RoundRobin H ] Literal case? IF ." --------------------------" EXIT THEN dup [ T Priority H ] Literal = IF \ | link | do_priority | time | longest | task | dup [ T #t_exec H ] Literal + t_@ [ T do_priority H ] Literal - IF drop EXIT THEN dup [ T #p_longest H ] Literal + t_@ . ." ticks consumed by " [ T #p_task H ] Literal + t_@ variables .listname EXIT THEN \ all other tasks \ | link | go_next | dsp | pause_link | sema | dup [ T #t_exec H ] Literal + t_@ Labels .listname &25 position \ print task exec dup [ T #t_dsp H ] Literal + t_@ ." last DSP " .hex &40 position [ T #t_sema H ] Literal + t_@ ?dup 0= ?EXIT ." waiting on " variables .listname ; : task-links ( -- t1 .. tn n ) Priority 1 BEGIN over @ Priority - WHILE >r dup @ r> 1+ REPEAT ; Host: .semas ( -- ) [ T Sema_link H ] Literal BEGIN cr t_@ ?dup WHILE dup Variables .listname &15 position dup t_@ ?dup IF Variables .listname ELSE ." free " THEN dup 1+ t_@ u. ." counts" [ T #s_link H ] Literal + REPEAT ; Host Commands: : tasks ( -- ) dis_output [t'] task-links t_execute t> ( #tasks ) dup >r 0 ?DO t> LOOP r> 0 ?DO cr T .task H LOOP std_output ; : semas ( -- ) dis_output T .semas H std_output ; Target