home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / tasking.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  5.2 KB  |  174 lines
  1. \ Multitasking
  2.  
  3. \ TODO:
  4. \   Make booting equivalent to task activation
  5. \   This may involve putting some of the task activation words in code
  6.  
  7. \ Low level multi-tasking words
  8. \ The low-level "name" of a task is the address of its user area
  9.  
  10. code (pause  (s -- )   \ go see if anybody else wants service
  11.    th e000 #  'user saved-ip  movem   \ save ip, rp, sp
  12.  
  13.    forth ' link assembler >user#  up  d)  up  move  \ get up for new task
  14.    'user entry   a0  move                           \ get pc for new task
  15.    a0 ) jmp
  16. end-code
  17.  
  18. create to-next-task  (s -- address-of-"next-task"-code )
  19.    assembler long
  20.    forth ' link assembler >user#  up  d)  up  move  \ get up for new task
  21.    'user entry   a0  move                           \ get pc for new task
  22.    a0 ) jmp
  23. end-code
  24.  
  25. \ Called with up set to the user area address of the task to run
  26. create task-resume (s -- )          \ start a task
  27.    assembler long
  28.    'user saved-ip  th e000 #  movem  \ restore ip,rp,sp
  29. c;
  30.  
  31. up@ link token!  \ point the current task to itself
  32.  
  33. : local (s task-base user-var-addr -- user-var-addr-in-tasks-space )
  34.    up@ - +
  35. ;
  36. : sleep (s task-addr -- )  to-next-task swap entry local token! ;
  37. : wake  (s task-addr -- )  task-resume  swap entry local token! ;
  38.  
  39. : stop  (s -- )  \ put current task to sleep
  40.    up@ sleep (pause
  41. ;
  42. \ single is already defined in the kernel
  43. \ : single (s -- ) \ disable pausing - current task gains exclusive control
  44. \   ['] noop ['] pause (is
  45. \ ;
  46. : multi (s -- )  \ initialize multitasking
  47. \  init-malloc
  48.    up@ wake       \ Make sure the main task is awake
  49.    ['] (pause ['] pause (is
  50. ;
  51.  
  52. \ Layout of private storage for a new task:
  53. \ Space             Size
  54. \ -----             ----
  55. \ User Area         user-size
  56. \ Dictionary        variable
  57. \ Parameter Stack   variable
  58. \ Tib               task-rs-size
  59. \ Return Stack      task-rs-size
  60. \ .
  61. \ The dictionary and the Parameter Stack share an area equal
  62. \ to the task storage area size minus user-size minus task-rs-size
  63. \
  64. \ The terminal input buffer and the Return Stack share an area of
  65. \ size task-rs-size.  Tib grows up, Return Stack grows down.
  66.  
  67. 80  20 /n*  + constant task-rs-size
  68.  
  69. \ Before the new task has been forked, invoking the task name will
  70. \ return its pfa.  After it has been forked, it will return the
  71. \ address of its user area
  72. \ Pfa of task contains the address and size
  73.  
  74. : "task: ( size name -- ) \ name and allocate a new task
  75.    "create  ( size )
  76.    here token, , does> @
  77. ;
  78. : default-task-size ( -- size )
  79.    user-size th 200 +
  80. ;
  81. : task:  \ name  ( -- name ) \ name and allocate a new task using default size
  82.    default-task-size bl word  "task:
  83. ;
  84.  
  85. nuser task-size
  86. nuser task-word
  87. \ Allocate and initialize the user area for the new task, schedule it
  88. : tfork ( task-pfa -- task-user-area )
  89.  \ Allocate run-time space
  90.    dup na1+ @        ( task-pfa task-size)
  91.    dup alloc-mem     ( task-pfa task-size task-address)
  92.  
  93.  \ Initialize the user area with a copy of the current task's user area
  94.    up@  over  #user @  cmove     ( task-pfa  task-size  task-address)
  95.  
  96.  \ Since we copied the user area, his link already points to my successor.
  97.  \ Now make him my new successor in the task queue.
  98.    dup link token!
  99.  
  100.  \ Save my UP and switch to his user area
  101.    up@ >r  up!                    ( task-pfa  task-size)
  102.  
  103.  \ Fix the parameter field of the task word so it points to the new
  104.  \ user area instead of to itself
  105.    up@ rot token!                 ( task-pfa )
  106.  
  107.  \ Set the task address and task size user variables
  108.    dup task-size !
  109.    up@ +                         ( top-of-task-data-area )
  110.    dup rp0 token!                ( top-of-task-data-area )
  111.    task-rs-size -   sp0 token!
  112.    up@  up0 !
  113.    up@  user-size +  dp token!
  114.  
  115.  \ Put him to sleep
  116.    up@ sleep
  117.  
  118.  \ Restore my up
  119.    up@   r> up!
  120. ;
  121.  
  122. \ Restart the task using its word to execute
  123. : set-task ( ip task -- )
  124.    up@ -rot   up!    ( my-up ip )
  125.  
  126.   \ Initialize ip,rp,sp for the task
  127.    saved-ip !        ( my-up )
  128.    sp0 @  saved-sp token! ( my-up )
  129.    rp0 @  saved-rp token! ( my-up )
  130.  
  131.    up!
  132. ;
  133.  
  134. \ Establish a word for the task to execute
  135. : start ( cfa task -- )
  136.    swap >body swap  ( ip task )
  137.    set-task
  138. ;
  139.  
  140. \ The test for already-forked relies on the fact that the task pfa
  141. \ initially contains its own address.  After forking, the task pfa
  142. \ contains the address of the tasks-user area.  Obviously, this
  143. \ test wouldn't work if the first user variable pointed to itself,
  144. \ but it doesn't, so its okay
  145.  
  146. : fork (s cfa task-pfa -- )  \ give the task a word to execute
  147.   \ Make sure the world is set up for multitaking
  148.    multi
  149.   \ Don't fork if we've already done so
  150.    dup dup @ =  if  tfork  then  ( cfa task )
  151.    start
  152. ;
  153.  
  154. \ Defining word for a task and its action.  Example:
  155. \  variable counts
  156. \  background counter   begin pause 1 counts +! again  ;
  157.  
  158. : background ( -- )
  159.    default-task-size task:
  160.    multi
  161.    last @ name> >body
  162.    dup dup @ =  if  tfork  then  ( task )
  163.    here swap set-task
  164.    !csp ]
  165. ;
  166.  
  167. \ Compiled inside a definition to change the behavior of an
  168. \ existing task, for example (assuming the previous definition of counter):
  169. \  : countdown   counter activate  begin pause -1 counts +! again ;
  170.  
  171. : activate ( -- )
  172.    r> over set-task wake
  173. ;
  174.