(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]) (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))))