Annotation of gforth/tasker.fs, revision 1.2

1.1       pazsan      1: \ Multitasker                                          19aug94py
                      2: 
                      3: Create sleepers  sleepers A, sleepers A, 0 ,
                      4: 
                      5: \ LINK-TASK links task1 into the task chain of task2
                      6: : link-task ( task1 task2 -- )
                      7:   over 2@  2dup cell+ ! swap !  \ unlink task1
                      8:   2dup @ cell+ !  2dup dup @ rot 2!  ! ;
                      9: 
                     10: : sleep ( task -- )  sleepers  link-task ;
                     11: : wake  ( task -- )  next-task link-task ;
                     12: 
                     13: \ PAUSE is the task-switcher
                     14: : pause ( -- )
                     15:   rp@ fp@ lp@ sp@ save-task !
                     16:   next-task @ up! save-task @ sp!
                     17:   lp! fp! rp! ;
                     18: 
                     19: \ STOP sleeps a task and switches to the next
                     20: : stop ( -- )
                     21:   rp@ fp@ lp@ sp@ save-task !
                     22:   next-task @ up! save-task @ sp!
                     23:   lp! fp! rp! prev-task @ sleep ;
                     24: 
                     25: \ USER' computes the task offset
                     26: : user' ( 'user' -- n )
                     27:   ' >body @ state @ IF  postpone Literal  THEN ; immediate
                     28: 
                     29: \ NEWTASK creates a new, sleeping task
                     30: : NewTask ( n -- Task )  dup 2* 2* udp @ + dup
                     31:   allocate throw  + >r
                     32:   r@ over - udp @ - next-task over udp @ move
                     33:   r> over user' r0 + ! dup >r
                     34:   dup r@ user' l0   + ! over -
                     35:   dup r@ user' f0   + ! over -
                     36:   dup r@ user' s0   + ! over -
                     37:   dup r@ user' normal-dp + dup >r !
                     38:    r> r@ user' dpp  + ! + $10 +
                     39:       r@ user' >tib + !
                     40:   r> dup 2dup 2! dup sleep ;
                     41: 
                     42: : kill-task
                     43:   next-task @ up! save-task @ sp!
                     44:   lp! fp! rp! prev-task @ dup dup link-task user' normal-dp + @ free throw ;
                     45: 
                     46: : (pass) ( x1 .. xn n task -- )  rdrop
                     47:   [ ' kill-task >body ] ALiteral r>
                     48:   rot >r r@ user' r0 + @ 2 cells - dup >r 2!
                     49:   r>              swap 1+
                     50:   r@ user' f0 + @ swap 1+
                     51:   r@ user' l0 + @ swap 1+
                     52:   cells r@ user' s0 + @ tuck swap - dup r@ user' save-task + !
                     53:   ?DO  I !  cell  +LOOP  r> wake ;
                     54: 
                     55: : activate ( task -- )  0 swap (pass) ;
                     56: : pass ( x1 .. xn n task -- )  (pass) ;
                     57: 
1.2     ! pazsan     58: : single-tasking? ( -- flag )
        !            59:     next-task dup @ = ;
        !            60: 
        !            61: : task-key   BEGIN  pause key? single-tasking? or  UNTIL  (key) ;
1.1       pazsan     62: : task-emit  (emit) pause ;
                     63: : task-type  (type) pause ;
                     64: 
                     65: ' task-key  IS key
                     66: ' task-emit IS emit
                     67: ' task-type IS type

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>