From b22f0435232a5807d0e429c1d652fce8adaf0a0a Mon Sep 17 00:00:00 2001
From: John Lorentzson <duuqnd@stacken.kth.se>
Date: Thu, 27 Mar 2025 22:39:18 +0100
Subject: [PATCH] Proof of concept compiler

Compiles hand-created nodes for subroutine calls, forward branching,
and fixed-length looping into textual 6502 assembly code. Currently
only outputs this code to standard output for inspection.
---
 wip-duuqnd/compiler.lisp | 83 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 83 insertions(+)
 create mode 100644 wip-duuqnd/compiler.lisp

diff --git a/wip-duuqnd/compiler.lisp b/wip-duuqnd/compiler.lisp
new file mode 100644
index 0000000..e82b7e4
--- /dev/null
+++ b/wip-duuqnd/compiler.lisp
@@ -0,0 +1,83 @@
+(defpackage #:compiler
+  (:use #:cl))
+
+(in-package #:compiler)
+
+(defvar *label-counter* 0)
+
+(defun genlabel (&optional (prefix "L"))
+  (format nil "~A~D" prefix (incf *label-counter*)))
+
+(defmacro format-inst (destination control-string &rest format-arguments)
+  `(format ,destination "~8@T~A~%" (format nil ,control-string ,@format-arguments)))
+
+(defclass reference () ())
+
+(defclass reference-constant (reference)
+  ((%value :accessor ref-value :initarg :value)))
+
+(defmethod dereference ((ref reference-constant))
+  (format-inst t "LDA #~D" (ref-value ref)))
+
+(defclass reference-variable (reference)
+  ((%index :accessor ref-index :initarg :index)))
+
+(defmethod dereference ((ref reference-variable))
+  (format-inst t "LDY #~D" (ref-index ref))
+  (format-inst t "LDA VARVEC,Y"))
+
+(defclass node ()
+  ((%next :accessor next :accessor normal-next)))
+
+(defclass node-call (node)
+  ((%callee :accessor callee :initarg :callee)
+   (%arguments :accessor arguments :initarg :arguments)))
+
+(defmethod generate-code ((node node-call))
+  (loop :for ref :in (arguments node)
+        :for index :from 0
+        :do (dereference ref)
+        :do (format-inst t "STA ARGVEC+~D" index))
+  (format-inst t "JSR ~A" (callee node)))
+
+(defclass node-branch (node)
+  ((%branch-next :accessor branch-next :initarg :branch-next)))
+
+(defmethod generate-code ((node node-branch))
+  (let ((else-label (genlabel "ELSE")))
+    (format-inst t "LDA RESULT")
+    (format-inst t "BNE ~A" else-label)
+    ;; THEN branch
+    (generate-code (branch-next node))
+    (format t "~%~A:~%" else-label)))
+
+(defclass node-dotimes (node)
+  ((%spot-ref :accessor stop-ref :initarg :stop-ref
+              :documentation "A reference giving a value of how many times to run the loop.")
+   (%loopee-node :accessor loopee-node :initarg :loopee-node)))
+
+(defmethod generate-code ((node node-dotimes))
+  (format-inst t "TXA")
+  (format-inst t "PHA")
+
+  (let ((loop-label (genlabel "LOOPBACK")))
+    (dereference (stop-ref node))
+    (format-inst t "TAX")
+    (format t "~%~A:~%" loop-label)
+    (generate-code (loopee-node node))
+    (format-inst t "DEX")
+    (format-inst t "BNE ~A" loop-label))
+
+  (format-inst t "PLA")
+  (format-inst t "TAX"))
+
+(defun make-call (callee args)
+  (let ((arguments
+          (loop :for (constp value) :in args
+                :with index := -1
+                :if constp
+                  :collect (make-instance 'reference-constant :value value)
+                :else
+                  :collect (make-instance 'reference-variable :index (incf index)))))
+    (make-instance 'node-call :callee callee
+                              :arguments arguments)))