home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / MULTASK.SEQ < prev    next >
Encoding:
Text File  |  1987-12-08  |  2.8 KB  |  85 lines
  1. \ MULTASK.SEQ   Multi tasking code for Forth.
  2.  
  3. POSTFIX
  4.  
  5. ONLY FORTH ALSO DEFINITIONS
  6.  
  7. comment:
  8.  
  9. The MultiTasker is loaded as an application on top of the
  10. regular Forth System.  There is support for it in the nucleus
  11. in the form of USER variables and PAUSEs inserted inside of
  12. KEY EMIT and BLOCK.  The Forth multitasking scheme is
  13. co-operative instead of interruptive.  All IO operations cause
  14. a PAUSE to occur, and the multitasking loop looks around at
  15. all of the current task for something to do.
  16.  
  17. comment;
  18.  
  19. CODE (PAUSE)    ( -- )
  20.                 IP PUSH   RP PUSH   UP #) BX MOV   SP 0 [BX] MOV
  21.                 BX INC   BX INC   BX INC   BX INC
  22.                 0 [BX] BX ADD   BX INC   BX INC   BX JMP   C;
  23.  
  24. CODE RESTART    ( -- )
  25.                 -4 # AX MOV   BX POP   AX BX ADD   BX UP #) MOV
  26.                 AX POP   POPF
  27.                 0 [BX] SP MOV
  28.                 RP POP   IP POP   NEXT   C;
  29.  
  30. HEX   E9 CONSTANT INT#
  31.  
  32. : LOCAL         ( base addr -- addr' )   UP @ -   +   ;
  33. : @LINK         ( -- addr )   LINK DUP @ +   2+   ;
  34. : !LINK         ( addr -- )   LINK 2+ -   LINK !   ;
  35. : SLEEP         ( addr -- )   E990 SWAP ENTRY LOCAL !   ;
  36. : WAKE          ( addr -- )   E9CD SWAP ENTRY LOCAL !   ;
  37. : STOP          ( -- )        UP @ SLEEP   PAUSE   ;
  38. : SINGLE        ( -- )        ['] PAUSE >BODY ['] PAUSE !   ;
  39.  
  40. CODE MULTI      ( -- )
  41.                 ' (PAUSE) @ # BX MOV   BX ' PAUSE #) MOV
  42.                 ' RESTART @ # BX MOV
  43.                 DS AX MOV   AX PUSH   AX AX SUB  AX DS MOV
  44.                 CS AX MOV   AX INT# 4 * 2+ #) MOV   BX INT# 4 * #) MOV
  45.                 AX POP  AX DS MOV  NEXT   C;
  46.  
  47. UP @ WAKE   ENTRY !LINK      DECIMAL
  48.  
  49. : TASK:         ( size -- )
  50.                 CREATE   TOS HERE #USER @ CMOVE   ( Copy the USER Area )
  51.                 @LINK  UP @ -ROT  HERE UP !  !LINK ( I point where he did)
  52.                 DUP HERE +   DUP RP0 !   100 - SP0 !  SWAP UP !
  53.                 HERE ENTRY LOCAL !LINK    ( He points to me)
  54.                 HERE #USER @ +  HERE DP LOCAL !
  55.                 HERE SLEEP   ALLOT   ;
  56.  
  57. : SET-TASK      ( ip task -- )
  58.                 DUP SP0 LOCAL @   ( Top of Stack )
  59.                 2- ROT OVER ! ( Initial IP )
  60.                 2- OVER RP0 LOCAL @ OVER !   ( Initial RP )
  61.                 SWAP TOS LOCAL !  ;
  62.  
  63. : ACTIVATE      ( task -- )
  64.                 R> OVER SET-TASK   WAKE  ;
  65.  
  66. : BACKGROUND:   ( -- )
  67.                 400 TASK:   HERE @LINK 2- ( get address of new task )
  68.                 SET-TASK  !CSP  ]  ;
  69.  
  70. comment:
  71.  
  72. background: spooler     1 capacity show  stop ;
  73.  
  74. : spool-this   spooler activate  3 15 [ shadow ] show stop  ;
  75.  
  76. variable counts
  77. background: counter   begin pause 1 counts +! again  ;
  78.  
  79. MULTI  COUNTER WAKE  or COUNTER SLEEP  SINGLE
  80.  
  81. comment;
  82.  
  83. ONLY FORTH ALSO DEFINITIONS
  84.  
  85.