honeylisp/ssc/task.fnl

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