VolksForth/sources/msdos/tasker.fb.src

86 lines
5.4 KiB
Plaintext
Raw Normal View History

2017-04-23 22:25:49 +00:00
Screen 0 not modified
0 \ ks 22 dez 87
1 The multitasker is a simple yet powerful round robin scheme
2 with explicit task switching. This has the major advantage
3 that the system switches tasks only in known states.
4 Hence the difficulties in synchronizing tasks and locking
5 critical portions of code are greatly minimized or simply
6 do not exist at all.
7
8
9
10
11
12
13
14
15
Screen 1 not modified
0 \ Multitasker loadscreen ks 03 apr 88
1 Onlyforth \needs Assembler 2 loadfrom asm.scr
2
3 Code stop $E990 # U ) mov ' pause @ # jmp end-code
4
5 : singletask [ ' noop @ ] Literal ['] pause ! ;
6 : multitask [ ' pause @ ] Literal ['] pause ! ;
7
8 1 3 +thru .( Multitasker geladen) cr
9
10
11
12
13
14
15
Screen 2 not modified
0 \ pass activate ks 1 jun 87
1
2 : pass ( n0 ... nr-1 Taddr r -- )
3 BEGIN [ rot ]
4 swap $E9CD over ! \ awake Task
5 r> -rot \ Stack: IP r addr
6 8 + >r \ s0 of Task
7 r@ 2+ @ swap \ Stack: IP r0 r
8 2+ 2* \ bytes on Taskstack incl. r0 & IP
9 r@ @ over - \ new SP
10 dup r> 2- ! \ into Ssave
11 swap bounds ?DO I ! 2 +LOOP ; restrict
12
13 : activate ( Taddr -- ) 0 \ [ ' pass >body ] Literal >r ;
14 [ -rot ] REPEAT ; restrict
15
Screen 3 not modified
0 ( Building a Task ks 8 may 84 )
1
2 | : taskerror ( string -- ) standardi/o singletask
3 ." Task error: " count type multitask stop ;
4
5 : sleep ( addr -- ) $90 swap c! ;
6
7 : wake ( addr -- ) $CD swap c! ;
8
9 : rendezvous ( semaphoraddr -- )
10 dup unlock pause lock ;
11
12
13
14
15
Screen 4 not modified
0 \ Task ks 1 jun 87
1
2 : Task ( rlen slen -- ) clear
3 0 Constant here 2- >r \ addr of task constant
4 here -rot \ here for Task dp
5 even allot even \ allot dictionary area
6 here r> ! \ set task constant addr
7 up@ here $100 cmove \ init user area
8 here $E990 , \ JMP opcode
9 up@ 2+ dup dup @ + here - ,
10 2dup - 2- swap ! \ link task
11 0 , dup 2- dup , , \ ssave and s0
12 2dup + , \ here + rlen = r0
13 rot , \ dp
14 under + dp ! 0 , \ allot rstack
15 ['] taskerror [ ' errorhandler >body c@ ] Literal rot + ! ;