56 lines
2 KiB
Fennel
56 lines
2 KiB
Fennel
(import-macros {:sss ! : compile} :ssc.macros)
|
|
(local {: addr-parser} (require :asm.65816))
|
|
|
|
#(compile $1
|
|
[(do (set $1.TASK-NEXT ($1:alloc-dp-var))
|
|
(set $1.TASK-STACK ($1:alloc-dp-var))
|
|
(set $1.TASK-MAILBOX ($1:alloc-dp-var))
|
|
nil)]
|
|
(global word old-dp 0)
|
|
(global word old-sp 0)
|
|
|
|
(form save-dp-sp [#[:block [:tdc] [:sta :old-dp] [:tsc] [:sta :old-sp]]])
|
|
(form restore-dp-sp [#[:block [:lda :old-dp] [:tcd] [:lda :old-sp] [:tcs]]])
|
|
|
|
(const task-size 0x100)
|
|
(global word first-task)
|
|
(global word last-task)
|
|
|
|
(form set-task-base [(fn [ssc task-base]
|
|
[:block [:lda task-base] [:tcd]
|
|
[:sta ssc.TASK-NEXT] [:sta :first-task] [:sta :last-task]
|
|
[:lda (+ task-base 0xff)] [:tcs]])])
|
|
|
|
(fn yield ()
|
|
(asm (tsc) (sta [$1.TASK-STACK])
|
|
(lda [$1.TASK-NEXT]) (tcd)
|
|
(lda [$1.TASK-STACK]) (tcs)))
|
|
|
|
(fn yield-forever () (while true (yield)))
|
|
|
|
(fn reset-task (task f)
|
|
; setup stack
|
|
(word! (long (+ task 0xfe)) (- (ref yield-forever) 1)) ; allow tasks to return; rts adds one to the value on the stack for the next pc
|
|
(word! (long (+ task 0xfc)) (- f 1)) ; yield will return to this address
|
|
(word! (long (+ task [(addr-parser $1.TASK-STACK)])) (+ task 0xfb)) ; stack pointer is the next available location
|
|
(word! (long (+ task [(addr-parser $1.TASK-MAILBOX)])) 0) ; clear mailbox
|
|
)
|
|
|
|
(fn new-task (f)
|
|
(let (next-task (+ last-task task-size))
|
|
(reset-task next-task f)
|
|
(word! (long (+ next-task [(addr-parser $1.TASK-NEXT)])) first-task) ; the last task yields to the first task, round-robin
|
|
(word! (long (+ last-task [(addr-parser $1.TASK-NEXT)])) next-task) ; the previously-last task now yields to us
|
|
(set! last-task next-task)
|
|
next-task))
|
|
|
|
(form current-task [#[:tdc]])
|
|
|
|
(fn task-send (task msg)
|
|
(word! (long (+ task [(addr-parser $1.TASK-MAILBOX)])) msg))
|
|
|
|
(form task-peek [#[:lda $1.TASK-MAILBOX]])
|
|
|
|
(fn task-recv ()
|
|
(asm (ldx [$1.TASK-MAILBOX]) (lda 0) (sta [$1.TASK-MAILBOX]) (txa))))
|