1\ Multitasker 19aug94py 2 3\ Copyright (C) 1995,1996,1997,2001,2003,2007 Free Software Foundation, Inc. 4 5\ This file is part of Gforth. 6 7\ Gforth is free software; you can redistribute it and/or 8\ modify it under the terms of the GNU General Public License 9\ as published by the Free Software Foundation, either version 3 10\ of the License, or (at your option) any later version. 11 12\ This program is distributed in the hope that it will be useful, 13\ but WITHOUT ANY WARRANTY; without even the implied warranty of 14\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15\ GNU General Public License for more details. 16 17\ You should have received a copy of the GNU General Public License 18\ along with this program. If not, see http://www.gnu.org/licenses/. 19 20Create sleepers sleepers A, sleepers A, 0 , 21 22: link-task ( task1 task2 -- ) 23 \G LINK-TASK links task1 into the task chain of task2 24 over 2@ 2dup cell+ ! swap ! \ unlink task1 25 2dup @ cell+ ! 2dup dup @ rot 2! ! ; 26 27: sleep ( task -- ) 28 \G deactivates task 29 sleepers link-task ; 30: wake ( task -- ) 31 \G activates task 32 next-task link-task ; 33 34: pause ( -- ) 35 \G PAUSE is the task-switcher 36 rp@ fp@ lp@ sp@ save-task ! 37 next-task @ up! save-task @ sp! 38 lp! fp! rp! ; 39 40: stop ( -- ) 41 \G STOP sleeps a task and switches to the next 42 rp@ fp@ lp@ sp@ save-task ! 43 next-task @ up! save-task @ sp! 44 lp! fp! rp! prev-task @ sleep ; 45 46:noname ' >body @ ; 47:noname ' >body @ postpone literal ; 48interpret/compile: user' ( 'user' -- n ) 49\G USER' computes the task offset of a user variable 50 51: NewTask ( stacksize -- Task ) dup 2* 2* udp @ + dup 52 \G NEWTASK creates a new, sleeping task 53 allocate throw + >r 54 r@ over - udp @ - next-task over udp @ move 55 r> over user' rp0 + ! dup >r 56 dup r@ user' lp0 + ! over - 57 dup r@ user' fp0 + ! over - 58 dup r@ user' sp0 + ! over - 59 dup r@ user' normal-dp + dup >r ! 60 r> r@ user' dpp + ! 2drop 61 0 r@ user' current-input + ! 62 r> dup 2dup 2! dup sleep ; 63 64Create killer killer A, killer A, 65: kill ( task -- ) 66 \G kills a task - deactivate and free task area 67 dup killer link-task killer dup dup 2! 68 user' normal-dp + @ free throw ; 69 70: kill-task ( -- ) 71 \G kills the current task, also on bottom of return stack of a new task 72 next-task @ up! save-task @ sp! 73 lp! fp! rp! prev-task @ kill ; 74 75: (pass) ( x1 .. xn n task -- ) rdrop 76 [ ' kill-task >body ] ALiteral r> 77 rot >r r@ user' rp0 + @ 2 cells - dup >r 2! 78 r> swap 1+ 79 r@ user' fp0 + @ swap 1+ 80 r@ user' lp0 + @ swap 1+ 81 cells r@ user' sp0 + @ tuck swap - dup r@ user' save-task + ! 82 ?DO I ! cell +LOOP r> wake ; 83 84: activate ( task -- ) 85 \G activates the task. 86 \G Continues execution with the caller of ACTIVATE. 87 0 swap (pass) ; 88: pass ( x1 .. xn n task -- ) 89 \G passes n parameters to the task and activates that task. 90 \G Continues execution with the caller of PASS. 91 (pass) ; 92 93: single-tasking? ( -- flag ) 94 \G checks if only one task is running 95 next-task dup @ = ; 96 97: task-key BEGIN pause key? single-tasking? or UNTIL (key) ; 98: task-emit (emit) pause ; 99: task-type (type) pause ; 100 101' task-key IS key 102' task-emit IS emit 103' task-type IS type 104