home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / multask.seq < prev    next >
Text File  |  1991-02-19  |  7KB  |  170 lines
  1. \ MULTASK.SEQ   Multi tasking code for Forth.
  2.  
  3. PREFIX
  4.  
  5. ONLY FORTH ALSO DEFINITIONS
  6.  
  7. DECIMAL
  8.  
  9. comment:
  10.  
  11.   The MultiTasker is loaded as an application on top of the
  12. regular Forth System.  There is support for it in the nucleus
  13. in the form of USER variables and PAUSEs inserted inside of
  14. KEY EMIT and BLOCK.  The Forth multitasking scheme is
  15. co-operative instead of interruptive.  All IO operations cause
  16. a PAUSE to occur, and the multitasking loop looks around at
  17. all of the current task for something to do.
  18.  
  19.   Modified by Tom Zimmer to work with F-PC, which needs to save the ES
  20. register along with IP. - 2/29/88 -
  21.  
  22. NOTICE !!       This multi tasking DOES NOT SUPPORT MULTIPLE USERS !!!
  23.  
  24.   There are a significant number of things what will have to be changed
  25. in this Forth system to support multi user, like the editor would have
  26. to be re-written, ect.  So I am not supporting multi user, only
  27. background processing.
  28.  
  29.   Background processing MAY NOT do any compiling, compile, like VARIABLE,
  30. or CREATE, ect. at *** RUNTIME ***.                     06/06/88 13:58
  31.  
  32.   YDP and XDP are NOT user variables.
  33.  
  34.   TJZ 02/19/91 20:29 - Fixed a couple of bugs in multi-tasking that
  35. prevented FSAVEd systems from running because multi-tasking was not
  36. relocatable. It is now!. Of course there was a small performance penalty.
  37.  
  38. comment;
  39.  
  40. CODE (PAUSE)    ( -- )
  41. \                PUSH ES         \ Push ES, IP, and RP  \ tjz 02/19/91 remove
  42.                 mov ax, es                              \ tjz 02/19/91 added
  43.                 sub ax, xseg                            \ tjz 02/19/91 added
  44.                 push ax                                 \ tjz 02/19/91 added
  45.                 PUSH IP
  46.                 PUSH RP
  47.                 MOV BX, UP      \ make BX point to user area
  48.                 MOV 0 [BX], SP  \ save SP in user area offset 0
  49.                 ADD BX, # 4     \ adjust BX to point to LINK
  50.                 ADD BX, 0 [BX]  \ Add value in LINK to BX, pointing it to
  51.                                 \ next tasks user area offset 0
  52.                 ADD BX, # 2     \ bump BX 2 to point to ENTRY
  53.                 JMP BX          \ jump to next tasks entry point
  54.                 END-CODE
  55.  
  56. CODE RESTART    ( -- )
  57.                 POP BX          \ pop address of where we came from
  58.                 MOV AX, # -4
  59.                 ADD BX, AX      \ adjust to beginning of user area
  60.                 MOV UP BX       \ set UP to point to begin of user area
  61.                 POP AX          \ pop off old PC
  62.                 POPF            \ restore status register
  63.                 MOV SP, 0 [BX]  \ restore SP (stack pointer)
  64.                 POP RP          \ restore RP, IP, and ES
  65.                 POP IP
  66.                 pop ax                          \ tjz 02/19/91 added
  67.                 add ax, xseg                    \ tjz 02/19/91 added
  68.                 mov es, ax                      \ tjz 02/19/91 added
  69. \                POP ES                         \ tjz 02/19/91 removed
  70.                 NEXT            END-CODE
  71.  
  72. $0E9 CONSTANT INT#
  73.  
  74. : LOCAL         ( base addr -- addr' )   UP @ -   +   ;
  75. : @LINK         ( -- addr ) LINK DUP @ +   2+   ;
  76. : !LINK         ( addr -- ) LINK 2+ -   LINK !   ;
  77. : SLEEP         ( addr -- ) $0E990 SWAP ENTRY LOCAL !   ;
  78. : WAKE          ( addr -- ) $0E9CD SWAP ENTRY LOCAL !   ;
  79. : STOP          ( -- )      UP @ SLEEP   PAUSE   ;
  80. : SINGLE        ( -- )
  81.                 $0E9  ['] PAUSE C!              \ set JMP in PAUSE
  82.                 >NEXT ['] PAUSE >BODY -         \ get offset to NEXT
  83.                       ['] PAUSE 1+ ! ;          \ store in PAUSE + 1
  84.  
  85. CODE MULTI      ( -- )
  86.                 MOV ' PAUSE # $0E9
  87.                 MOV BX, # ' (PAUSE) ' PAUSE 3 + -       \ relative I hope!
  88.                 MOV ' PAUSE 1+ BX
  89.                 MOV BX, # ' RESTART
  90.                 MOV AX, DS
  91.                 PUSH AX
  92.                 SUB AX, AX      MOV DS, AX
  93.                 MOV AX, CS      MOV INT# 4 * 2+ AX
  94.                                 MOV INT# 4 *    BX
  95.                 POP AX
  96.                 MOV DS, AX      NEXT
  97.                 END-CODE
  98.  
  99. UP @ WAKE   ENTRY !LINK
  100.  
  101. : ?MULTI        ( -- f1 )       \ f1 = true if MULTI tasking
  102.                 ['] (PAUSE) ['] PAUSE @REL>ABS = ;
  103.  
  104. : TASK:         ( size -- )
  105.                 CREATE   TOS HERE #USER @ CMOVE   ( Copy the USER Area )
  106.                 @LINK  UP @ -ROT  HERE UP !  !LINK ( I point where he did)
  107.                 DUP HERE +   DUP RP0 !   100 - SP0 !  SWAP UP !
  108.                 HERE ENTRY LOCAL !LINK    ( He points to me)
  109.                 HERE #USER @ +  HERE DP LOCAL !
  110.                 HERE SLEEP   ALLOT   ;
  111.  
  112. : SET-TASK      ( ES ip task -- )       \ NOTE: both ES and IP are passed
  113.                                         \ to SET-TASK.
  114.                 >R SWAP R>
  115.                 DUP SP0 LOCAL @                 \ Top of Stack
  116. \                2- ROT OVER !          \ Initial ES \ tjz 02/19/91 removed
  117.                 2- ROT xseg @ - OVER !  \ Initial ES \ tjz 02/19/91 added
  118.                 2- ROT OVER !                   \ Initial IP
  119.                 2- OVER RP0 LOCAL @ OVER !      \ Initial RP
  120.                 SWAP TOS LOCAL !  ;
  121.  
  122. : ACTIVATE      ( task -- )
  123.                 DUP
  124.                 2R> ROT SET-TASK   WAKE  ;
  125.  
  126. : BACKGROUND:   ( -- )
  127.                 400 TASK:
  128.                 XHERE @LINK 2-          \ get address of new task, note that
  129.                                         \ XHERE returns SEGMENT and OFFSET,
  130.                                         \ which is used by SET-TASK
  131.                 SET-TASK  !CSP  ]  ;
  132.  
  133. comment:
  134.  
  135.   Here is a sample of how to create a background task that will do a
  136. listing of the current file, with the hypothetical word FUNCTION1.  The
  137. task MYTASK is created with the default function FUNCTION1 assigned to it.
  138. Next we define a word MYTASK-THIS, what changes the function assigned to
  139. MYTASK to perform FUNCTION2.  This allows us to change the function a
  140. task performs without having to define a new task. In each case, the
  141. task is stopped after its assigned FUNCTION is performed.
  142.  
  143.  
  144.         background: mytask  function1 stop ;
  145.  
  146.         : mytask-this   mytask activate   function2 stop  ;
  147.  
  148.  
  149.   This next example defines a variable, and a routine which increments
  150. the variable in the background.  Notice that the program is an infinite
  151. loop, and will only stop when put to sleep, or when multi tasking is
  152. turned off with SINGLE.  This example will actually work, you might try
  153. typing it into a file and loading it.
  154.  
  155.  
  156. variable counts
  157. background: counter     begin   pause incr> counts
  158.                         again   ;
  159.  
  160. MULTI COUNTER WAKE              \ start up the COUNTER task
  161.  
  162. \ COUNTER SLEEP                 \ put the COUNTER task to sleep
  163. \ SINGLE                        \ disable multi tasking
  164.  
  165. comment;
  166.  
  167. ONLY FORTH ALSO DEFINITIONS
  168.  
  169.  
  170.