umouse

umouse.git
git clone git://git.lenczewski.org/umouse.git
Log | Files | Refs | Submodules | README

MultiCM0lite.fth (14635B)


      1 \ MultiCM0lite.fth - ARM Cortex-M0 v7 Lite Multi-Tasker
      2 
      3 ((
      4 Copyright (c) 2010, 2011, 2014
      5 MicroProcessor Engineering
      6 133 Hill Lane
      7 Southampton SO15 5AF
      8 England
      9 
     10 tel: +44 (0)23 8063 1441
     11 fax: +44 (0)23 8033 9691
     12 net: mpe@mpeforth.com
     13      tech-support@mpeforth.com
     14 web: www.mpeforth.com
     15 
     16 From North America, our telephone and fax numbers are:
     17   011 44 23 8063 1441
     18   011 44 23 8033 9691
     19 
     20 
     21 To do
     22 =====
     23 
     24 Change history
     25 ==============
     26 20140210 MPE002 Conversion for Lite kernel
     27 20110627 MPE001 Cortex-M0/M1 conversion.
     28 
     29 
     30 ********************
     31 Resource definitions
     32 ********************
     33 
     34   For Cortex-M0/M1 the following register usage is the default:
     35   r15         pc      program counter
     36   r14         link    link register; bit0=1=Thumb, usually set
     37   r13         rsp     return stack pointer
     38   r12         --
     39   r11         up      user area pointer
     40   r10         --
     41   r9          lp      locals pointer
     42   r8          --
     43   r7          tos     cached top of stack
     44   r6          psp     data stack pointer
     45   r0-r5       scratch
     46 ))
     47 
     48 \ ===========
     49 \ *! multicortex
     50 \ *T ARM Cortex-M0/M1 multitasker
     51 \ ===========
     52 \ *P The ARM Cortex multitasker follows the model introduced
     53 \ ** with the v6.1 compilers.
     54 
     55 
     56 \ ****************************
     57 \ *S TCB data structure layout
     58 \ ****************************
     59 \ *E cell       LINK    link to next task
     60 \ ** cell       SSP     Saved Stack Pointer
     61 \ ** cell       STAT    Bit 0     1 = running, 0 = halted
     62 \ **                    Bit 1     1 = message pending
     63 \ **                    Bit 2     1 = event triggered
     64 \ **                    Bit 3     1 = event handler run
     65 \ **                    Bit 4..7  Reserved
     66 \ ** 	        others  1 = set to run task, available to user
     67 \ ** cell       TASK    Task that sent message here
     68 \ ** cell       MESG    Message address
     69 \ ** cell       EVNTw   CFA of word run as event handler
     70 \ *P This structure is allocated at the start of the *\fo{USER}
     71 \ ** area. Consequently the *\fo{TCB} of the current task is given
     72 \ ** by *\fo{UP}.
     73 
     74 struct /TCB	\ -- size
     75 \ *G The structure used by the code that matches the
     76 \ ** description above.
     77   ptr tcb.link		\ link to next task ; MUST BE FIRST
     78   ptr tcb.ssp	        \ Saved Stack Pointer
     79   int tcb.status	\ status word
     80   int tcb.msrc		\ message source
     81   int tcb.mesg		\ message
     82   ptr tcb.event		\ xt of word which is event handler
     83 end-struct
     84 
     85 \ bit masks for the status cell
     86 $0001 equ run-mask  run-mask invert equ ~run-mask	\ running
     87   0 equ run-bit#
     88 $0002 equ msg-mask  msg-mask invert equ ~msg-mask	\ message available
     89   1 equ msg-bit#
     90 $0004 equ trg-mask  trg-mask invert equ ~trg-mask	\ event triggered
     91   2 equ trg-bit#
     92 $0008 equ evt-mask  evt-mask invert equ ~evt-mask	\ event run
     93   3 equ evt-bit#
     94 
     95 
     96 \ ******************
     97 \ Consistency checks
     98 \ ******************
     99 
    100 /tcb tcb-size <> [if]
    101   cr ." Control file and tasker disagree as to TCB size"  abort
    102 [endif]
    103 
    104 
    105 \ ***************************
    106 \ *S Task handling primitives
    107 \ ***************************
    108 
    109 cdata		\ so that comma is to code space
    110 
    111 init-u0 constant main	\ -- addr ; tcb of main task
    112 \ *G Returns the base address of the main task's *\fo{USER} area.
    113 l: main-link
    114   0 ,					\ end of task chain
    115 
    116 CODE (pause)	\ -- ; the scheduler itself
    117 \ *G The software scheduler itself.
    118 l: [schedule]
    119 \
    120 \ save previously running task ip, rp, up, sp
    121 \ can use with interrupts if we stack everything
    122 \
    123   push    { r6, r7, link }		\ PSP and TOS
    124   mov     r0, rsp
    125   mov     r1, up
    126   str     r0, [ r1, # 0 tcb.ssp ]	\ save SP in TCB
    127 \
    128 \ select next task to run
    129 \
    130 l: [schedule]1
    131   ldr     r1, [ r1, # 0 tcb.link ]	\ get next task
    132   ldr     r0, [ r1, # 0 tcb.status ]	\ inspect status
    133   cmp     r0, # 0			\ 0 = not running
    134   b .eq   [schedule]1
    135 \
    136 \ run selected task - sp, up, rp, ip
    137 \
    138   mov     up, r1
    139   ldr     r0, [ r1, # 0 tcb.ssp ]	\ restore SSP
    140   mov     rsp, r0
    141   pop     { r6, r7 }			\ restore registers
    142   pop     { r0 }
    143   mov     link, r0
    144 
    145   next,
    146 end-code
    147 
    148 0 value multi?	\ -- flag
    149 \ *G Returns true if the tasker is enabled.
    150 
    151 : single	\ --
    152 \ *G Disable scheduler.
    153   ['] noop to-do pause  0 to multi?  ;
    154 
    155 : multi		\ --
    156 \ *G Enable scheduler.
    157   ['] (pause) to-do pause  -1 to multi?  ;
    158 
    159 
    160 : status	\ -- task-status
    161 \ *G Returns the current task's status cell, but with the run
    162 \ ** bit masked out.
    163   up@ tcb.status @ run-mask invert and  ;
    164 
    165 : restart	\ task -- ; mark task TCB as running
    166 \ *G Sets the RUN bit in the task's status cell.
    167   run-mask swap tcb.status or!  ;
    168 
    169 : halt		\ task -- ; reset running bit in TCB
    170 \ *G Clears the RUN bit in the task's status cell.
    171   run-mask swap tcb.status bic!  ;
    172 
    173 : stop          \ -- ; halt oneself
    174 \ *G *\fo{HALT}s the current task, and executes *\fo{PAUSE}.
    175   self halt  pause
    176 ;
    177 
    178 
    179 \ *************************
    180 \ *S Task structure management
    181 \ *************************
    182 
    183 internal
    184 
    185 (( Extract from scheduler save
    186   push    { r6, r7, link }		\ PSP and TOS
    187   mov     r0, rsp
    188   mov     r1, up
    189   str     r0, [ r1, # 0 tcb.ssp ]	\ save SP in TCB
    190 ))
    191 code init-task	\ xt task -- ; Initialise a task stack
    192 \ *G Initialise a task's stack before running it and
    193 \ ** set it to execute the word whose XT is given.
    194   ldmia   psp ! { r1 }			\ get execution address
    195   mov .s  r3, # 1
    196   orr .s  r1, r1, r3			\ set Thumb bit
    197   mov     r2, rsp			\ save return stack pointer
    198 
    199 \ Generate the RSP of the new task
    200 \ the middle line works because TASK-U0 is greater than TASK-R0
    201   mov     r0, tos
    202   sub .s  r0, r0, # task-u0 task-r0 -	\ generate new task RSP
    203   mov     rsp, r0
    204 
    205   str     r0, [ tos, # r0-offset ]	\ save new R0 (taskID=UP)
    206   mov .s  r0, # 0			\ will need this many times
    207   str     r0, [ tos, # 0 tcb.status ]	\ clear new task status
    208 
    209   push    { r1 }			\ R14 LINK, push xt=link
    210   push    { r0 }			\ R7, new TOS for ARM
    211 \ the next but one line works because TASK-U0 is greater than TASK-S0
    212   mov     r1, tos
    213   sub .s  r1, r1, # task-u0 task-s0 -	\ calculate new PSP
    214   sub .s  r1, r1, # sp-guard cells	\ generate new PSP
    215   push    { r1 }			\ R6, new PSP
    216   sub .s  r1, r1, # tos-cached? cells	\ generate new S0
    217   str     r1, [ tos, # s0-offset ]	\ that is compatible with SP!
    218   mov     r0, rsp
    219   str     r0, [ tos, # 0 tcb.ssp ]	\ save RSP
    220 
    221   mov     rsp, r2			\ restore RSP
    222   ldmia   psp ! { tos }			\ restore TOS
    223   next,
    224 end-code
    225 
    226 : add-task      \ task -- ; insert into list
    227 \ *G Add the task to the list of tasks after the current task.
    228   self tcb.link @			\ save task currently pointed to
    229   over tcb.link !			\ and make new task point to it
    230   self tcb.link !			\ current task points to new task
    231 ;
    232 
    233 : sub-task      \ task -- ; remove task from chain
    234 \ *G Remove the task from the task list.
    235 \ look for task which points to required task
    236   self					\ head of chain ; -- target current
    237   begin  2dup tcb.link @ <>		\ while curr. does not point to target
    238    while				\ step through chain
    239     tcb.link @  dup self =		\ but if task not in list, check for end
    240     if  2drop  exit  endif		\ and get out
    241   repeat                                \ -- target points-to-it
    242 \ set task that points to target to point to task pointed to by the target
    243   swap tcb.link @			\ task pointed to by target
    244   swap tcb.link !			\ set into link field
    245 ;
    246 
    247 external
    248 
    249 : initiate	\ xt task -- ; start task from scratch
    250 \ *G Start the given task executing the word whose XT is given, e.g.
    251 \ *C   ['] <name> <task> INITIATE
    252   tuck init-task			\ reset TCB
    253   dup add-task                          \ add to chain
    254   run-mask swap tcb.status !		\ mark as running
    255   pause					\ let it run
    256 ;
    257 
    258 : terminate	\ task --
    259 \ *G Stop a task, and remove it from the list.
    260   sub-task pause			\ halt task, and remove from chain
    261 ;
    262 
    263 : init-multi    \ --
    264 \ *G Initialise the multitasker and start it.
    265   single				\ tasker disabled
    266   main /tcb erase			\ clean TCB
    267   main dup tcb.link !			\ initialise MAIN to point to itself
    268   run-mask main tcb.status !		\ and reset status field
    269   multi					\ mark tasker enabled
    270 ;  ' init-multi AtCold
    271 
    272 : his		\ task uservar -- addr
    273 \ *G Given a task id and a *\fo{USER} variable, returns the
    274 \ ** address of that variable in the given task. This word is
    275 \ ** used to set up *\fo{USER} variables in other tasks.
    276   self - +
    277 ;
    278 
    279 
    280 \ **********
    281 \ *S Semaphores
    282 \ **********
    283 \ *P The semaphore code is only compiled if the equate
    284 \ ** *\fo{SEMAPHORES?} is set non-zero in the control
    285 \ ** file.
    286 
    287 \ *P A *\fo{SEMAPHORE} is an extended variable used for signalling
    288 \ ** between tasks, and for resource allocation. It contains two
    289 \ ** cells, a *\b{counter} and an *\b{arbiter}. The counter field
    290 \ ** is used as a count of the number of times the resource may
    291 \ ** be used, and the arbiter field contains the TCB of the task
    292 \ ** that currently owns it. This field can be used for priority
    293 \ ** arbitration and deadlock detection/arbitration. The count
    294 \ ** field allows the semaphore to be used as a*\b{counted}
    295 \ ** semaphore or as an exclusive access semaphore.
    296 
    297 \ *P For example a character buffer may be used where the semaphore
    298 \ ** counter contains the number of available characters.
    299 
    300 \ *P An exclusive access semaphore is used to share resources.
    301 \ ** The semaphore is initialised to one, usually by *\fo{SIGNAL}.
    302 \ ** The first task to *\fo{REQUEST} it gains access, and all
    303 \ ** other tasks must wait until the accessing task *\fo{SIGNAL}s
    304 \ ** that it has finished with the resource.
    305 
    306 interpreter
    307 : semaphore     \ -- ; -- addr [child]
    308 \ *G Creates a semaphore which returns its address at runtime.
    309 \ ** The count field is initialised to zero for use as counted
    310 \ ** semaphore. Use in the form:
    311 \ *C Semaphore <name>
    312 \ *P If you want this to be an exclusive access semaphore, follow
    313 \ ** this with:
    314 \ *C   1 <name> !
    315   idata create
    316     0 ,  0 ,				\ count and arbiter fields
    317   cdata
    318 ;
    319 target
    320 
    321 : semaphore	\ -- ; -- addr [child]
    322   2 cells buffer:
    323   0 0 last @ name> execute 2!
    324 ;
    325 
    326 : signal        \ addr --
    327 \ *G *\fo{SIGNAL} increments the counter field of a semaphore, indicating
    328 \ ** either that another item has been allocated to the resource, or
    329 \ ** that it is available for use again, 0 indicating in use by a task.
    330   [I					\ must be interrupt safe
    331     dup incr  cell+ off			\ inc. counter, release
    332   I]
    333 ;
    334 
    335 : request       \ sem -- ; get access to resource, wait if count = 0
    336 \ *G *\fo{REQUEST} waits until the counter field of a semaphore
    337 \ ** is non-zero, and then decrements the counter field by one.
    338   begin
    339     [I  dup @ 0=			\ n.b. test and set
    340    while
    341     I]  pause				\ operations must be
    342   repeat                                \ non-interruptible and indivisible
    343   dup decr				\ got it, decrement counter
    344   self swap cell+ !			\ mark resource as mine
    345   I]					\ re-enable interrupts
    346 ;
    347 
    348 
    349 \ ******************
    350 \ *S TASK and START:
    351 \ ******************
    352 \ *P *\fo{TASK <name>} builds a named task user area.
    353 \ ** The action of a task is assigned and the task started
    354 \ ** by the word *\fo{INITIATE}
    355 \ *C   ['] <action> <task> INITIATE
    356 
    357 \ *P *\fo{START:} is used inside a colon definition. The code
    358 \ ** before *\fo{START:} is the task's initialisation, performed
    359 \ ** by the current task. The code after *\fo{START:} up to the
    360 \ ** closing *\fo{;} is the action of the task. For example:
    361 
    362 \ *E   TASK FOO
    363 \ **   : RUN-FOO
    364 \ **     ...
    365 \ **     FOO START:
    366 \ **     ...
    367 \ **     begin ... pause again
    368 \ **   ;
    369 
    370 \ *P All tasks must run in an endless loop, except for initialisation
    371 \ ** code.
    372 \ ** When *\fo{RUN-FOO} is executed, the code after *\fo{START:}
    373 \ ** is set up as the action of task *\fo{FOO} and started.
    374 \ ** *\fo{RUN-FOO} then exits.
    375 
    376 \ *P If you want to perform additional actions after starting the task, you
    377 \ ** should use *\fo{INITIATE} to start the task.
    378 
    379 variable task-chain	\ -- addr
    380 \ *G Anchors list of all tasks created by *\fo{TASK} and friends.
    381   main-link task-chain !		\ MAIN already defined
    382 
    383 interpreter	\ host version
    384 : task		\ -- ; -- task ; TASK <name> builds a task
    385 \ *G Note that the cross-interpreter's version of *\fo{TASK} has
    386 \ ** been modified from v6.2 onwards to leave the current
    387 \ ** section as *\fo{CDATA}.
    388   udata
    389   task-size reserve task-u0 + constant	\ build pointer
    390   cdata
    391   here  task-chain @ ,  task-chain !	\ link task
    392 ;
    393 target
    394 
    395 heads? [if]	\ target version
    396 : task		\ -- ; -- task ; TASK <name> builds a task
    397 \ *G Creates a new task and data area, returning the address
    398 \ ** of the user area at run time. The task is also linked into
    399 \ ** the task chain anchored by *\fo{TASK-CHAIN}.
    400   rp @ task-u0 +			\ task's user area
    401   task-size rallot
    402   constant				\ build pointer
    403   here  task-chain @ ,  task-chain !	\ link task
    404 ;
    405 [then]
    406 
    407 : start:	\ task -- ; exits from caller
    408 \ *G Used inside a colon definition. The code following
    409 \ ** *\fo{START:} up to the ending semi-colon forms the action
    410 \ ** of the task. The word containing *\fo{START:} finishes at
    411 \ ** *\fo{START:}.
    412   r> swap initiate
    413 ;
    414 
    415 
    416 \ ******************
    417 \ *S Debugging tools
    418 \ ******************
    419 
    420 : .task		\ task --
    421 \ *G Display task's name if it has one, otherwise display its
    422 \ ** address.
    423   task-chain
    424   begin					\ -- task link
    425     @ dup
    426    while				\ -- task link
    427     2dup cell - @ = if
    428       nip  #12 - >name .name space	\ ARM specific
    429       exit
    430     endif
    431   repeat
    432   drop .dword ."  is not in TASK chain"
    433 ;
    434 
    435 : .tasks	\ task -- ; display all task names
    436 \ *G Display all the tasks anchored by *\fo{TASK-CHAIN}.
    437   task-chain
    438   begin
    439     @ dup
    440    while
    441     dup #12 - >name .name space		\ ARM specific
    442   repeat
    443   drop
    444 ;
    445 
    446 : .running	\ --
    447 \ *G Display all the running tasks.
    448   main
    449   begin
    450     cr dup .task
    451     tcb.link @
    452     dup main =
    453   until
    454   drop
    455 ;
    456 
    457 
    458 \ ********
    459 \ all done
    460 \ ********
    461 
    462 decimal
    463 
    464 
    465 \ *********
    466 \ Test code
    467 \ *********
    468 
    469 0 [if]
    470 
    471 task task1	\ -- addr ; build task area
    472 
    473 500000 value rate1	\ -- n ; number of idle iterations
    474 
    475 : action1	\ -- ; action of task1
    476   hex  console opvec !
    477   begin
    478     [char] * emit
    479     rate1 0 do pause loop
    480   again
    481 ;
    482 
    483 \ To start task use:
    484 \   ' action1 task1 initiate
    485 
    486 task task2	\ -- addr ; build task area
    487 
    488 900000 value rate2	\ -- n ; number of idle iterations
    489 
    490 : run-task2	\ -- ; example of using START:
    491   task2 start:
    492     console opvec !
    493     begin
    494       [char] / emit
    495       rate2 0 do pause loop
    496     again
    497 ;
    498 
    499 \ To start task use:
    500 \   run-task2
    501 
    502 [then]
    503 
    504 
    505 \ ======
    506 \ *> ###
    507 \ ======
    508