honeylisp/ssc/task.fnl

59 lines
2.5 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]]])
(form save-6502-stack [#[:block [:tsc] [:tay] [:and 0xff] [:ora 0x100] [:tax] [:eor 0xffff] [:clc] [:adc 0x200] [:phb] [:mvn 0 0] [:plb]]])
(form restore-6502-stack [#[:block [:tsc] [:tax] [:and 0xff] [:ora 0x100] [:tay] [:eor 0xffff] [:clc] [:adc 0x200] [:phb] [:mvn 0 0] [:plb]]])
; 0x1ef = 0x1ef-0x1ff = 0x0f -> 0x7f
(define 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]
[:tsc] [:and 0xff] [:ora task-base] [:tcs]])])
(fn yield ()
(asm (tsc) (sta [$1.TASK-STACK]) ;
debug-stub on-hotswap (export debug-stub) (export on-hotswap) ; todo: cleanup mame hotswap logic
(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))))