home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / LIB / TILE / multi_tasking.f83 < prev    next >
Text File  |  1989-12-23  |  11KB  |  269 lines
  1. \
  2. \  MULTI-TASKING DEFINITIONS
  3. \
  4. \  Copyright (c) 1989 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 6 December 1989
  17. \
  18. \  Dependencies:
  19. \       (forth) enumerates, structures, queues
  20. \
  21. \  Description:
  22. \       Allows definition of tasks, semaphores and channels. Follows the
  23. \       basic models of concurrent programming primitives. 
  24. \
  25. \  Copying:
  26. \       This program is free software; you can redistribute it and\or modify
  27. \       it under the terms of the GNU General Public License as published by
  28. \       the Free Software Foundation; either version 1, or (at your option)
  29. \       any later version.
  30. \
  31. \       This program is distributed in the hope that it will be useful,
  32. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  33. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34. \       GNU General Public License for more details.
  35. \
  36. \       You should have received a copy of the GNU General Public License
  37. \       along with this program; see the file COPYING.  If not, write to
  38. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  39.  
  40. .( Loading Multi-tasking definitions...) cr
  41.  
  42. #include enumerates.f83
  43. #include structures.f83
  44. #include queues.f83
  45.  
  46. queues structures multi-tasking definitions
  47.  
  48. ( Task structure and status codes)
  49.  
  50. struct.type TASK ( -- )
  51.   struct QUEUE +queue private          ( System administration of tasks)
  52.   enum +status private                 ( Status code field)
  53.   ptr  +sp private                     ( Parameter stack pointer)
  54.   ptr  +s0 private                     ( Parameter stack bottom pointer)
  55.   ptr  +ip private                     ( Instruction pointer)
  56.   ptr  +rp private                     ( Return stack pointer)
  57.   ptr  +r0 private                     ( Return stack bottom pointer)
  58.   ptr  +fp private                     ( Argument frame stack pointer)
  59.   ptr  +ep private                     ( Exception frame pointer)
  60. struct.end
  61.  
  62. enumerates
  63.  
  64. enum.type TASK-STATUS-CODES
  65.   enum TERMINATED                      ( Terminated status code)
  66.   enum READY                           ( Ready for "schedule")
  67.   enum RUNNING                         ( Scheduled and running)
  68.   enum IOWAITING                       ( Waiting for in- or output)
  69.   enum WAITING                         ( Generic waiting)
  70.   enum DELAYED                         ( In delay function call)
  71. enum.end
  72.   
  73. multi-tasking
  74.  
  75. ( Task inquiry and manipulation functions)
  76.  
  77. : deactivate ( queue task -- ) 
  78.   running @ succ >r                    ( Access the next runnable task)
  79.   dup out                              ( Remove this task from the queue)
  80.   swap into                            ( And insert into queue of waiting)
  81.   r> resume ;                          ( The next task)
  82.  
  83. : activate ( task -- ) 
  84.   running @ succ into                  ( And insert it after the current task)
  85.   detach ;                             ( And restart it)
  86.  
  87. : delay ( n -- )
  88.   DELAYED running @ +status !          ( Indicate that the task is delayed)
  89.   0 do detach loop                     ( Delay a task a number of switches)
  90.   RUNNING running @ +status ! ;                ( Restore running state)
  91.  
  92. : join ( task -- ) 
  93.   WAITING running @ +status !          ( Indicate that the task is waiting)
  94.   begin                                        ( Wait for task to terminate)
  95.     dup +status @                      ( Check status. While not zero)
  96.   while                                        ( and thus not terminate)
  97.     detach                             ( Switch tasks)
  98.   repeat drop                          ( Drop task parameter)
  99.   RUNNING running @ +status ! ;                ( Restore running state)
  100.  
  101. : who ( -- ) 
  102.   ." task#(s): "                       ( Print header and list of tasks)
  103.   running @ print cr ;                 ( addresses)
  104.  
  105. ( Dijkstra's Semaphore definition)
  106.  
  107. struct.type SEMAPHORE ( n -- )
  108.   struct QUEUE +waiting private                ( Queue of waiting tasks)
  109.   long +count private                  ( Current counter value)
  110. struct.init ( n semaphore -- )
  111.   dup +waiting as QUEUE initiate       ( Initiate semephore queue)
  112.   +count !                             ( Initiate semaphore counter)
  113. struct.end
  114.  
  115. : mutex ( -- ) 
  116.   1 SEMAPHORE ;                                ( Mutual exclusion semaphore)
  117.  
  118. : signal ( semaphore -- ) 
  119.   dup +waiting ?empty                  ( Check if the waiting queue is empty)
  120.   if 1 swap +count +!                  ( Increment counter)
  121.   else
  122.     +waiting succ dup out              ( Remove the first waiting task)
  123.     activate                           ( And reactivate the task)
  124.   then ;
  125.  
  126. : ?wait ( semaphore -- flag) 
  127.   +count @ 0= ;                                ( Check if a wait will delay the task)
  128.  
  129. : wait ( semaphore -- ) 
  130.   dup ?wait                            ( Does the task have to wait)
  131.   if WAITING running @ +status !       ( Indicate that the task is waiting)
  132.     +waiting running @ deactivate      ( Deactivate to the waiting queue)
  133.     RUNNING running @ +status !        ( Restore running state)
  134.   else
  135.     -1 swap +count +!                  ( Decrement the counter)
  136.   then ;
  137.  
  138. ( Extension of Hoare's Channels)
  139.  
  140. enum.type COMMUNICATION-MODES
  141.   enum ONE-TO-ONE                      ( Task to task communication)
  142.   enum ONE-TO-MANY                     ( One task to several tasks)
  143.   enum MANY-TO-ONE                     ( Serveral task to one task)
  144. enum.end
  145.  
  146. struct.type CHAN ( mode -- )
  147.   long +data private                   ( Data past from sender to receiver)
  148.   long +mode private                   ( Communication mode)
  149.   struct SEMAPHORE +sent private       ( Semaphore for sender)
  150.   struct SEMAPHORE +received private   ( Semaphore for receiver)
  151. struct.init ( mode chan -- )
  152.   swap over +mode !                    ( Set up channel mode)
  153.   0 over +sent as SEMAPHORE initiate   ( Initiate semaphore fields)
  154.   0 swap +received as SEMAPHORE initiate ( as synchronize semphores)
  155. struct.end
  156.  
  157. : ?avail ( chan -- flag) 
  158.   dup +mode @ MANY-TO-ONE =            ( Check channel mode)
  159.   if +received ?wait not               ( Check if receiver is available)
  160.   else +sent ?wait not then ;          ( Check if sender is available)
  161.  
  162. : send ( data chan -- ) 
  163.   dup +mode @ MANY-TO-ONE =            ( Check mode first)
  164.   if dup +received wait                        ( Wait for a receiver)
  165.      swap over +data !                 ( Assign data field)
  166.      +sent signal                      ( And signal the receiver)
  167.   else
  168.      swap over +data !                         ( Assign data field of channel)
  169.      dup +sent signal                  ( Signal that data is available)
  170.      +received wait                    ( And wait for receiver to fetch)
  171.   then ;
  172.  
  173. : receive ( chan -- data)  
  174.   dup +mode @ MANY-TO-ONE =            ( Check mode first)
  175.   if dup +received signal              ( Signal a receiver is ready)
  176.      dup +sent wait                    ( Wait for sender)
  177.      +data @                           ( Fetch sent data from channel)
  178.   else
  179.      dup +sent wait                    ( Wait for sender to send data)
  180.      dup +data @                       ( Fetch data from channel)
  181.      swap +received signal             ( And acknowledge to sender)
  182.   then ;
  183.      
  184. ( Message passing; rendezvous)
  185.  
  186. struct.type RENDEZVOUS ( -- )
  187.   struct CHAN +arg private             ( Channel for argument sending)
  188.   struct CHAN +res private             ( Channel for result receiving)
  189. struct.init ( rendezvous -- )
  190.   ONE-TO-ONE over +arg as CHAN initiate        ( Initiate argument channel)
  191.   ONE-TO-ONE swap +res as CHAN initiate        ( Initiate result channel)
  192. struct.does ( arg rendezvous -- res)
  193.   swap over +arg send                  ( Send the argument)
  194.   +res receive                         ( and receive the result)
  195. struct.end
  196.  
  197. : accept ( -- rendezvous arg)
  198.   ' >body [compile] literal            ( Access the rendezvous structure)
  199.   ?compile dup                         ( Receive the argument to this task)
  200.   ?compile +arg
  201.   ?compile receive ; immediate
  202.  
  203. : accept.end ( rendezvous res -- )
  204.   ?compile swap                                ( Send the result to the sender)
  205.   ?compile +res
  206.   ?compile send ; immediate
  207.  
  208. : ?awaiting ( -- boolean)
  209.   ' >body [compile] literal            ( Access the rendezvous structure)
  210.   ?compile +arg                                ( Check if an argument is available)
  211.   ?compile ?avail ; immediate
  212.  
  213. ( High Level Task definition with user variables)
  214.  
  215. forward make ( task.type -- task)
  216.  
  217. struct.type task.type ( parameters returns -- )
  218.   long +users private                  ( Size of user area in bytes)
  219.   long +parameters private             ( Size of parameter stack)
  220.   long +returns        private                 ( Size of return stack)
  221.   ptr  +body private                   ( Pointer to task body code)
  222. struct.init ( parameters returns task.type -- task.type users0)
  223.   dup >r +returns !                    ( Assign given fields)
  224.   r@ +parameters !                     ( And prepare for definition of)
  225.   r> sizeof TASK                       ( user variable fields for tasks)
  226. struct.does ( task -- )
  227.   make dup schedule constant           ( Make a task, start it)
  228. struct.end                             ( And give it a name)
  229.  
  230. : make ( task.type -- task)
  231.   dup >r +users @                      ( Fetch task size parameters)
  232.   r@ +parameters @                     ( And pointer to task body)
  233.   r@ +returns @                        ( And create a task instance)
  234.   r> +body @ task ;
  235.  
  236. : new ( -- task)
  237.   ' >body [compile] literal            ( Requires symbol after to be a task)
  238.   ?compile make                        ( type. Makes a task instance and)
  239.   ?compile dup                         ( schedules it. Return pointer to)
  240.   ?compile schedule ; immediate                ( create instance)
  241.  
  242. : bytes ( users1 size -- users2)  
  243.   over user + ;                                ( Create a user variable and update)
  244.  
  245. : field ( size -- )
  246.   create ,                             ( Save size of user variable type)
  247.   does> @ bytes ; private              ( Fetch size and create field name)
  248.  
  249. : struct ( -- )
  250.   [compile] sizeof bytes ;             ( Fetch size of structure and create)
  251.  
  252. 1 field byte ( -- )
  253. 2 field word ( -- )
  254. 4 field long ( -- )
  255. 4 field ptr ( -- )
  256. 4 field enum ( -- )
  257.  
  258. : task.body ( task.type users3 -- ) 
  259.   align over +users !                  ( Align and assign user area size)
  260.   here swap +body !                    ( Assign pointer to task body code)
  261.   ] ;                                  ( And start compiling)
  262.  
  263. : task.end ( -- )
  264.   [compile] ; ; immediate compilation  ( Stop compiling)
  265.  
  266. forth only
  267.  
  268.  
  269.