Beginnings of the Sufficiently Simple Compiler - it can add numbers!

asm/65816.fnl

@@ -107,7 +107,6 @@
 
 (fn op-pdat.bytes [op env]
   (local bytegen (. opcodes op.opcode))
-;   (pp op)
   (if bytegen
     (let [opbyte (bytegen op.mode)
           argbytes

asm/asm.fnl

@@ -110,9 +110,7 @@
       (if ok (values ...)
           (do (error (.. process " failed in " pdat.type " near " (or pdat.nearest-symbol "<start of block>") " @" (or pdat.addr "<no address>") " - " ...)))))
     (local processor (. pdat-processor pdat.type process))
-    (let [(a1 a2 a3 a4 a5) ...]
-      (if processor (complain (xpcall #(processor pdat a1 a2 a3 a4 a5) fennel.traceback)) default)))
-;     (if processor (complain (pcall #(processor pdat $...) ...)) default))
+    (if processor (complain (pcall #(processor pdat $...) ...)) default))
 
   (fn pdat-processor.raw.size [raw] (length raw.bytes))
   (fn pdat-processor.var.size [d] d.size)

ssc/init.fnl

@@ -0,0 +1,88 @@
+; 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