File:  [gforth] / gforth / tasker.fs
Revision 1.1: download - view: text, annotated - select for diffs
Sun Mar 31 20:16:04 1996 UTC (27 years, 11 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Added tiny multitasker

    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

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