Return to tasker.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/tasker.fs, revision 1.1

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: 
        !            58: : task-key   BEGIN  pause key?  UNTIL  (key) ;
        !            59: : task-emit  (emit) pause ;
        !            60: : task-type  (type) pause ;
        !            61: 
        !            62: ' task-key  IS key
        !            63: ' task-emit IS emit
        !            64: ' task-type IS type