forked from samueltardieu/picforth
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmultitasker.fs
84 lines (67 loc) · 2.22 KB
/
multitasker.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
\
\ PicForth library file
\
\ This library file has been written by Samuel Tardieu <[email protected]>.
\ It belongs to the public domain. Do whatever you want with it.
\
\ If you get an error saying that the multitasker code spans over multiple
\ banks, you should add some "nop" before the multitasker so that it
\ doesn't cross a code bank.
meta
variable l-task
\ Yield chain
: l-yield ( -- addr ) l-task @ 2 cells + ;
: chain-yield ( addr -- ) align here swap , l-yield @ , l-yield ! ;
: patch-addr ( addr host-tcb -- )
l-task ! l-yield @
begin dup while 2dup @ dup tcs@ rot $7ff and or swap tcs! cell+ @ repeat 2drop
;
\ Two bytes are necessary to save the task structure (FSR, PCL, PCLATH,
\ 8 bytes stack)
\ The TCB on the host contains:
\ - a pointer to the target structure (1 cell)
\ - a pointer to the previous task (1 cell)
\ - the latest address to patch for a yield (1 cell)
\ - XT to execute (1 cell)
8 value task-stack-size
: task-private-data-size ( -- n ) task-stack-size 3 + ;
: task ( -- )
align here data-here dup ,
task-private-data-size + data-org l-task @ , l-task ! 0 , tcshere , ;
: resume-task ( host-tcb -- )
@ dup ,w movf fsr movwf dup 2 + ,w movf pclath movwf 1+ ,w movf pcl movwf ;
target
variable multitasker-pclath
meta
: init-tasks ( -- )
l-task @ begin
dup while
dup @ dup task-private-data-size + movlw movwf
dup 3 cells + @
dup (literal) over @ 1+ (literal) meta> !
8 rshift (literal) dup @ 2 + (literal) meta> !
\ dup 3 cells + @ (literal) dup @ 1+ (literal) meta> !
\ dup 3 cells + @ 8 rshift (literal) dup @ 2 + (literal) meta> !
cell+ @
repeat drop
;
' init-tasks add-to-init-chain
: multitasker ( -- )
tcshere 8 rshift (literal) multitasker-pclath (literal) meta> !
tcshere clrwdt l-task @ begin
dup while
dup resume-task tcshere over patch-addr
dup @ 1+ movwf fsr ,w movf l-task @ @ movwf
cell+ @
repeat drop
dup cbank tcshere cbank <> abort" multitasker code spans over multiple code banks, please reorganize"
goto unreachable
;
: yield ( -- )
tcshere 4 + 8 rshift (literal) l-task @ @ 2 + (literal) meta> !
multitasker-pclath (literal) meta> @
pclath (literal) meta> !
tcshere 2 + movlw
tcshere 0 goto chain-yield
;
target