Multitask extension

Requires: 6502 assembler

\ Multitasker BP 13.9.84 )
CR .( Loading Multitasker...) CR
Onlyforth

\ Multitasker

\needs Code INCLUDE" D:TAS65.F"

Code stop
 SP 2dec  IP    lda  SP X) sta
          IP 1+ lda  SP )Y sta
 SP 2dec  RP    lda  SP X) sta
          RP 1+ lda  SP )Y sta
 6 # ldy  SP    lda  UP )Y sta
     iny  SP 1+ lda  UP )Y sta
 1 # ldy  tya  clc  UP adc  W sta
 txa  UP 1+ adc  W 1+ sta
 W 1- jmp   end-code

| Create taskpause   Assembler
 $2C # lda  UP X) sta  ' stop @ jmp
end-code

: singletask

 [ ' pause @ ] Literal  ['] pause ! ;

: multitask   taskpause ['] pause ! ;

\ pass  activate

: pass  ( n0 .. nr-1 Tadr r -- )
 BEGIN  [ rot ( Trick ! ) ]
  swap  $2C over c! \ awake Task
  r> -rot           \ IP r addr
  8 + >r            \ s0 of Task
  r@ 2+ @  swap     \ IP r0 r
  2+ 2*             \ bytes on Taskstack
                    \ incl. r0 & IP
  r@ @ over -       \ new SP
  dup r> 2- !       \ into ssave
  swap bounds  ?DO  I !  2 +LOOP  ;
restrict

: activate ( Tadr --)
 0 [ -rot ( Trick ! ) ]  REPEAT ;
-2 allot  restrict

: sleep  ( Tadr --)
 $4C swap c! ;       \ JMP-Opcode

: wake  ( Tadr --)
 $2C swap c! ;       \ BIT-Opcode

\ building a Task

| : taskerror  ( string -)
 standardi/o  singletask
 ." Task error : " count type
 multitask stop ;

: Task ( rlen  slen -- )
 allot              \ Stack
 here $FF and $FE =
 IF 1 allot THEN     \ 6502-align
 up@ here $100 cmove \ init user area
 here  $4C c,       \ JMP opcode
                    \ to sleep Task
 up@ 1+ @ ,
 dup  up@ 1+ !      \ link Task
 3 allot            \ allot JSR wake
 dup  6 -  dup , ,  \ ssave and s0
 2dup +  ,          \ here + rlen = r0
 under  + here - 2+ allot
 ['] taskerror  over
 [ ' errorhandler >body c@ ] Literal + !
 Constant ;

\ more Tasks

: rendezvous  ( semaphoradr -)
 dup unlock pause lock ;

| : statesmart
 state @ IF [compile] Literal THEN ;

: 's  ( Tadr - adr.of.taskuservar)
 ' >body c@ + statesmart ; immediate

\ Syntax:   2  Demotask 's base  !
\ makes Demotask working binary

: tasks  ( -)
 ." MAIN " cr up@ dup 1+ @
 BEGIN  2dup - WHILE
  dup [ ' r0 >body c@ ] Literal + @
  6 + name> >name .name
  dup c@ $4C = IF ." sleeping" THEN cr
 1+ @ REPEAT  2drop ;

CR .( Multitasker loaded! ) CR

Example:

RatRace Multitasker example: requires a terminal with cursor control (AT-XY), does therefor not work on the Apple 1

( Multi Tasking Demo "RatRace )

CR .( Loading Multitask Demo...) CR

\needs task INCLUDE" D:MTASK.F"

USER X      10 X     !
USER Y      10 Y     !
USER DELAY  1  DELAY !

: CLS &125 EMIT ;
: RND ( -- 8b )
  $D20A C@ ;

$80 $100 TASK R1
$80 $100 TASK R2
$80 $100 TASK R3
$80 $100 TASK R4

: RAT
  DELAY @ 0 DO PAUSE LOOP 1 X +! ;
: RACE
  20 0 DO 
    RAT Y @ X @ AT ASCII # EMIT
  LOOP ;

: START ( Tadr -- )
  1 Y +! ( next line )
  Y @ 1 AT ." -->"
  ACTIVATE RND DELAY ! RACE STOP ;

CLS

MULTITASK

R1 START
R2 START
R3 START
R4 START

10 1 AT TASKS CR

.( RatRace Running )

VolksForth

Multitask extension