89 lines
3.9 KiB
Plaintext
89 lines
3.9 KiB
Plaintext
|
; ssc: the sufficiently simple compiler
|
||
|
|
|
||
|
|
; The goal of ssc is to allow simple prefix expressions to be compiled into 65816 code that
|
||
|
|
; would run at least as fast or faster than the equivalent threaded Forth code. Complex
|
||
|
|
; optimizations are a non-goal; if you want to tune the generated code, go ahead and write
|
||
|
|
; the assembly directly.
|
||
|
|
|
||
|
|
; * All values are 16-bit integers, like Forth or BCPL.
|
||
|
|
; * Data and return addresses are mixed on one stack, unlike Forth.
|
||
|
|
; * Function calls take a fixed number of arguments, and return 0 or 1 results. The compiler enforces arity checking.
|
||
|
|
; * To call a function taking arguments [arg1 arg2 arg3], arg3 should be in the A register, and the stack should look like:
|
||
|
|
; arg1 arg2 return-address
|
||
|
|
; * The caller is responsible for removing arg1 + arg2 from the stack once the function returns.
|
||
|
|
; * The caller is responsible for preserving the X and Y registers, if this is desirable.
|
||
|
|
; * If the function returns a value, it is stored in the A register.
|
||
|
|
; * If a function takes no arguments and returns no result, it is not obliged to preserve the A register.
|
||
|
|
; * Multitasking is achieved by overlapping the D and S registers on the same 256-byte page of memory.
|
||
|
|
; Yielding to a new task involves saving the S register, setting the D register to the new task's page,
|
||
|
|
; then setting the S register to the saved value in the old task.
|
||
|
|
; * Useful task-local "registers" are kept at the beginning of the page, and the stack grows down from the end of the page.
|
||
|
|
; * DP register list:
|
||
|
|
; * bank-local address (16 bits)
|
||
|
|
; * long address (24 bits)
|
||
|
|
; * Last suspended value of S
|
||
|
|
; * Mailbox
|
||
|
|
; * Pointer to next task
|
||
|
|
|
||
|
|
; Compiler notes:
|
||
|
|
; Expressions are of the form [:function arg1 arg2 arg3]
|
||
|
|
; args are either strings (symbols) or numbers
|
||
|
|
(local Object (require :core.object))
|
||
|
|
(local lume (require :lib.lume))
|
||
|
|
(local Ssc (Object:extend))
|
||
|
|
(local Prg (require :asm.asm))
|
||
|
|
|
||
|
|
(fn Ssc.new [self ?opts]
|
||
|
|
(local opts (or ?opts {}))
|
||
|
|
(set self.prg (or opts.prg (Prg.new nil :65816)))
|
||
|
|
(when opts.exprforms (set self.exprforms opts.exprforms))
|
||
|
|
(when opts.stmtforms (set self.stmtforms opts.stmtforms))
|
||
|
|
(set self.functions {}))
|
||
|
|
|
||
|
|
(set Ssc.exprforms
|
||
|
|
{:+ (lambda [self first ...]
|
||
|
|
(local block [:block [:clc] (self:compile-expr first)])
|
||
|
|
(for [i 1 (select :# ...)]
|
||
|
|
(let [val (select i ...)]
|
||
|
|
(table.insert block
|
||
|
|
(match val
|
||
|
|
1 [:inc]
|
||
|
|
-1 [:dec]
|
||
|
|
(where val (= (type val) :number)) [:adc val]
|
||
|
|
_ [:block (self:compile-expr val) [:adc 0 :s] [:ply]]))))
|
||
|
|
block)
|
||
|
|
:- (lambda [self first ...]
|
||
|
|
(local block [:block [:sec] (self:compile-expr first)])
|
||
|
|
(for [i 1 (select :# ...)]
|
||
|
|
(let [val (select i ...)]
|
||
|
|
(table.insert block
|
||
|
|
(match val
|
||
|
|
1 [:dec]
|
||
|
|
-1 [:inc]
|
||
|
|
(where val (= (type val) :number)) [:sbc val]
|
||
|
|
_ [:block (self:compile-expr val) [:sbc 0 :s] [:ply]]))))
|
||
|
|
block)
|
||
|
|
:asm (lambda [self ...] [:block ...])
|
||
|
|
})
|
||
|
|
(fn countiter [minmax ?max]
|
||
|
|
(let [min (if ?max minmax 1)
|
||
|
|
max (or ?max minmax)]
|
||
|
|
(values (fn [_ i] (if (>= i max) nil (+ i 1)))
|
||
|
|
nil
|
||
|
|
min)))
|
||
|
|
|
||
|
|
(fn Ssc.compile-expr [self expr]
|
||
|
|
(match expr
|
||
|
|
(where num (= (type num) :number)) [:block [:pha] [:lda num]]
|
||
|
|
;:string TODO: oh shit I need to keep track of local scoping etc
|
||
|
|
(where [func & args] (= (?. self.functions func :arity) (length args))
|
||
|
|
(. self.functions func :returns-value))
|
||
|
|
(let [pre (icollect [_ arg (ipairs args)] (self:compile-expr arg))
|
||
|
|
post (if (<= (length args) 1) [] (icollect [_ (countiter (- (length args) 1))] [:ply]))]
|
||
|
|
(lume.concat [:block] pre [[:jsr func]] post))
|
||
|
|
(where [form & args] (. self.exprforms form))
|
||
|
|
((. self.exprforms form) self (table.unpack args))
|
||
|
|
_ (error (.. "Unrecognized expression " (fv expr)))))
|
||
|
|
|
||
|
|
Ssc
|