1 line
13 KiB
Plaintext
1 line
13 KiB
Plaintext
\ Forth co-operative multitasker /TASKER ( -- ) initialize multitasker links TCB ( u s r "ccc" ; -- tcb ) create a task control block HIS ( tcb user -- user' ) get a task's user variable address ACTIVATE ( tcb -- ) initialize stacks and run task WAKE ( tcb -- ) resume a task SLEEP ( tcb -- ) suspend a task STOP ( -- ) stop current task, switch to next MULTI ( -- ) enable multitasker SINGLE ( -- ) disable multitasker PAUSE ( -- ) switch to next active task GRAB ( sem -- ) grab resource GET ( sem -- ) pause then grab resource RELEASE ( sem -- ) release resource #FLOAT ( u -- ) per-task f/p stack bytes \ Load screen forth definitions decimal application cr .( loading Multitasker ) 2 #screens 1- thru \ STATUS LINK TOS /TASKER HIS \ Define reserved user variables 0 user TOS \ save top of stack 2 user STATUS status on \ task active flag 4 user LINK \ link to next task's user link value tlink \ topmost LINK \ Initialize multitasker links : /TASKER ( -- ) status tlink ! ; /tasker \ Calculate task local user address : HIS ( tcb user -- user' ) tos - + ; \ (pause) \ Pause current task & switch to next active code (pause) ( -- ) true # al mov \ wake fsp ) push si push bp push \ push FSP IP RP up ) bx mov sp 0 [bx] mov \ save SP to TOS 2 # bx add al 0 [bx] mov \ wake or sleep 1 $: 2 # bx add 0 [bx] bx mov \ find active task false # byte 0 [bx] cmp 1 $ jz false # byte 0 [bx] mov \ sleep 2 # bx sub bx up ) mov \ load UP 0 [bx] sp mov \ restore SP bp pop si pop fsp ) pop \ pop RP IP FSP next end-code \ STOP WAKE SLEEP SINGLE MULTI \ Stop current task & switch to next active code STOP ( -- ) al al sub ' (pause) 2 + ) jmp end-code \ Resume a task : WAKE ( tcb -- ) cell+ on ; \ Suspend a task : SLEEP ( tcb -- ) cell+ off ; \ Disable multitasker : SINGLE ( -- ) ['] noop is pause ; \ Enable multitasker : MULTI ( -- ) ['] (pause) is pause ; \\ (activate) \ Initialize stacks & wake task : (activate) ( tcb -- ) dup s0 his @ \ get task stack cell- over fs0 his @ over ! \ push FS0 cell- r> over ! \ push start IP cell- over r0 his @ over ! \ push R0 over tos his ! \ set TOS dup catcher his off \ set CATCHER wake ; \ (activate) \ Initialize stacks & wake task code (activate) ( tcb -- ) bx pop s0 user# [bx] ax mov \ get task stack sp ax xchg fs0 user# [bx] push \ push FS0 si push \ push start IP r0 user# [bx] push \ push R0 sp ax xchg ax tos user# [bx] mov \ set TOS 0 # catcher user# [bx] mov \ set CATCHER true # byte status user# [bx] mov \ awake ' exit ) jmp end-code \ ACTIVATE system \ Execution begins with word following ACTIVATE : ACTIVATE ?comp postpone (activate) ; immediate application \ #FLOAT TCB system fs0 @ s0 @ - value #FLOAT \ f/p stack bytes \ create task control block : TCB ( u s r "ccc" ; -- tcb ) create here >r rot dup allot up @ r@ rot cmove \ copy USER vars here dup r@ dp his 2! \ DP DPS swap allot here r@ s0 his ! \ S0 #float allot here r@ fs0 his ! \ FS0 allot here r@ r0 his ! \ R0 r@ sleep r@ status his tlink ! \ sleep & add task r> link his to tlink /tasker ; \ application \ GRAB GET RELEASE \ Grab resource code GRAB ( sem -- ) bx pop up ) ax mov 0 [bx] cx mov 1 $ jcxz cx ax cmp 2 $ jz bx push 2 # si sub ' (pause) ) jmp 1 $: ax 0 [bx] mov 2 $: next end-code \ Pause then grab resource : GET ( sem -- ) pause grab ; \ Release resource code RELEASE ( sem -- ) bx pop up ) ax mov 0 [bx] ax sub 1 $ jnz ax 0 [bx] mov 1 $: next end-code \ discard heads behead tlink tlink behead (pause) (pause) behead (activate) (activate) \\ Demo 1 variable SCREEN screen off #user dup user CNT 1 cells + ( u) dup 64 64 tcb DCOUNTING \ task1 control block ( u) 64 64 tcb HCOUNTING \ task2 control block : DCOUNTER ( -- ) dcounting activate decimal 0 cnt ! begin screen get get-xy 0 2 at-xy cnt @ dup 0 10 d.r 1+ cnt ! at-xy screen release pause again ; : HCOUNTER ( -- ) hcounting activate hex 0 cnt ! begin screen get get-xy 15 2 at-xy cnt @ dup 0 10 d.r 1- cnt ! at-xy screen release pause again ; : RUN ( -- ) /tasker status on page ." 2 tasks counting:" dcounter hcounter multi begin key? until key drop single ; cr .( Save demo1? ) y/n [if] turnkey run DEMO1 bye [then] \\ Demo 2 variable SCREEN screen off #user dup user CNT 1 floats + ( u) dup 200 64 tcb UCOUNTING \ task1 control block ( u) 200 64 tcb DCOUNTING \ task2 control block : UPCOUNT ( -- ) ucounting activate 0e cnt f! begin screen get get-xy 0 2 at-xy cnt f@ fdup 0 10 f.r 1e f+ cnt f! at-xy screen release pause again ; : DOWNCOUNT ( -- ) dcounting activate 0e cnt f! begin screen get get-xy 15 2 at-xy cnt f@ fdup 0 10 f.r 1e f- cnt f! at-xy screen release pause again ; : RUN ( -- ) /tasker status on page ." 2 f/p tasks counting:" upcount downcount multi begin key? until key drop single ; cr .( Save demo2? ) y/n [if] turnkey run DEMO2 bye [then] |