\ MULTASK.SEQ   Multi tasking code for Forth.

PREFIX

ONLY FORTH ALSO DEFINITIONS

comment:

  The MultiTasker is loaded as an application on top of the
regular Forth System.  There is support for it in the nucleus
in the form of USER variables and PAUSEs inserted inside of
KEY EMIT and BLOCK.  The Forth multitasking scheme is
co-operative instead of interruptive.  All IO operations cause
a PAUSE to occur, and the multitasking loop looks around at
all of the current task for something to do.

  Modified by Tom Zimmer to work with F-PC, which needs to save the ES
register along with IP. - 2/29/88 -

NOTICE !!       This multi tasking DOES NOT SUPPORT MULTIPLE USERS !!!

  There are a significant number of things what will have to be changed
in this Forth system to support multi user, like the editor would have
to be re-written, ect.  So I am not supporting multi user, only
background processing.

  Background processing MAY NOT do any compiling, compile, like VARIABLE,
or CREATE, ect. at *** RUNTIME ***.                     06/06/88 13:58

  YDP and XDP are NOT user variables.

comment;

CODE (PAUSE)    ( -- )
                PUSH ES         \ Push ES, IP, and RP
                PUSH IP
                PUSH RP
                MOV BX, UP      \ make BX point to user area
                MOV 0 [BX], SP  \ save SP in user area offset 0
                ADD BX, # 4     \ adjust BX to point to LINK
                ADD BX, 0 [BX]  \ Add value in LINK to BX, pointing it to
                                \ next tasks user area offset 0
                ADD BX, # 2     \ bump BX 2 to point to ENTRY
                JMP BX          \ jump to next tasks entry point
                END-CODE

CODE RESTART    ( -- )
                POP BX          \ pop address of where we came from
                MOV AX, # -4
                ADD BX, AX      \ adjust to beginning of user area
                MOV UP BX       \ set UP to point to begin of user area
                POP AX          \ pop off old PC
                POPF            \ restore status register
                MOV SP, 0 [BX]  \ restore SP (stack pointer)
                POP RP          \ restore RP, IP, and ES
                POP IP
                POP ES
                NEXT            END-CODE

HEX   E9 CONSTANT INT#

: LOCAL         ( base addr -- addr' )   UP @ -   +   ;
: @LINK         ( -- addr ) LINK DUP @ +   2+   ;
: !LINK         ( addr -- ) LINK 2+ -   LINK !   ;
: SLEEP         ( addr -- ) E990 SWAP ENTRY LOCAL !   ;
: WAKE          ( addr -- ) E9CD SWAP ENTRY LOCAL !   ;
: STOP          ( -- )      UP @ SLEEP   PAUSE   ;
: SINGLE        ( -- )
                E9    ['] PAUSE C!              \ set JMP in PAUSE
                >NEXT ['] PAUSE >BODY -         \ get offset to NEXT
                      ['] PAUSE 1+ ! ;          \ store in PAUSE + 1

HEX

CODE MULTI      ( -- )
                MOV ' PAUSE # E9
                MOV BX, # ' (PAUSE) ' PAUSE 3 + -       \ relative I hope!
                MOV ' PAUSE 1+ BX
                MOV BX, # ' RESTART
                MOV AX, DS
                PUSH AX
                SUB AX, AX      MOV DS, AX
                MOV AX, CS      MOV INT# 4 * 2+ AX
                                MOV INT# 4 *    BX
                POP AX
                MOV DS, AX      NEXT
                END-CODE

UP @ WAKE   ENTRY !LINK

DECIMAL

: TASK:         ( size -- )
                CREATE   TOS HERE #USER @ CMOVE   ( Copy the USER Area )
                @LINK  UP @ -ROT  HERE UP !  !LINK ( I point where he did)
                DUP HERE +   DUP RP0 !   100 - SP0 !  SWAP UP !
                HERE ENTRY LOCAL !LINK    ( He points to me)
                HERE #USER @ +  HERE DP LOCAL !
                HERE SLEEP   ALLOT   ;

: SET-TASK      ( ES ip task -- )       \ NOTE: both ES and IP are passed
                                        \ to SET-TASK.
                >R SWAP R>
                DUP SP0 LOCAL @                 \ Top of Stack
                2- ROT OVER !                   \ Initial ES
                2- ROT OVER !                   \ Initial IP
                2- OVER RP0 LOCAL @ OVER !      \ Initial RP
                SWAP TOS LOCAL !  ;

: ACTIVATE      ( task -- )
                DUP
                R> R> SWAP ROT SET-TASK   WAKE  ;

: BACKGROUND:   ( -- )
                400 TASK:
                XHERE @LINK 2-          \ get address of new task, note that
                                        \ XHERE returns SEGMENT and OFFSET,
                                        \ which is used by SET-TASK
                SET-TASK  !CSP  ]  ;

comment:

  Here is a sample of how to create a background task that will do a
listing of the current file, with the hypothetical word FUNCTION1.  The
task MYTASK is created with the default function FUNCTION1 assigned to it.
Next we define a word MYTASK-THIS, what changes the function assigned to
MYTASK to perform FUNCTION2.  This allows us to change the function a
task performs without having to define a new task. In each case, the
task is stopped after its assigned FUNCTION is performed.


        background: mytask  function1 stop ;

        : mytask-this   mytask activate   function2 stop  ;


  This next example defines a variable, and a routine which increments
the variable in the background.  Notice that the program is an infinite
loop, and will only stop when put to sleep, or when multi tasking is
turned off with SINGLE.  This example will actually work, you might try
typing it into a file and loading it.


variable counts
background: counter   begin pause 1 counts +! again  ;

MULTI COUNTER WAKE              \ start up the COUNTER task

\ COUNTER SLEEP                 \ put the COUNTER task to sleep
\ SINGLE                        \ disable multi tasking

comment;

ONLY FORTH ALSO DEFINITIONS