From 41bd413b4cc180575db506fd9c1bcbf543b942d7 Mon Sep 17 00:00:00 2001
From: John Lorentzson <duuqnd@stacken.kth.se>
Date: Thu, 8 May 2025 19:10:38 +0200
Subject: [PATCH] Add LABEL class and replace uses of temporary strings with it

---
 wip-duuqnd/user-side-compiler/high-level.lisp | 13 ++++-------
 wip-duuqnd/user-side-compiler/label.lisp      | 23 +++++++++++++++++++
 .../user-side-compiler/user-side-compiler.asd |  1 +
 3 files changed, 29 insertions(+), 8 deletions(-)
 create mode 100644 wip-duuqnd/user-side-compiler/label.lisp

diff --git a/wip-duuqnd/user-side-compiler/high-level.lisp b/wip-duuqnd/user-side-compiler/high-level.lisp
index 7fdd12a..51f9e68 100644
--- a/wip-duuqnd/user-side-compiler/high-level.lisp
+++ b/wip-duuqnd/user-side-compiler/high-level.lisp
@@ -8,12 +8,9 @@
   (push (make-instance instruction-class :operand operand :source *instruction-source*)
         *compile-result*))
 
-(defun genlabel (&optional (prefix "L"))
-  (format nil "~A~D" prefix (incf *label-counter*)))
-
 (defun produce-label (&optional label)
   (when (null label)
-    (setf label (genlabel)))
+    (setf label (make-label)))
   (push label *compile-result*)
   label)
 
@@ -83,9 +80,9 @@
 
 (defmethod generate-code ((node node-branch))
   (let ((*instruction-source* node)
-        (else-label (genlabel "ELSE")))
+        (else-label (make-label :name-prefix "ELSE")))
     (produce-instruction 'inst-lda-absolute "RESULT")
-    (produce-instruction 'inst-bne-zero-page else-label)
+    (produce-instruction 'inst-bne-relative else-label)
     ;; The THEN branch
     (compile-node (branch-next node))
     ;; The ELSE branch
@@ -98,7 +95,7 @@
 
 (defmethod generate-code ((node node-dotimes))
   (let ((*instruction-source* node)
-        (loop-label (genlabel "LOOPBACK")))
+        (loop-label (make-label :name-prefix "LOOPBACK")))
     (produce-instruction 'inst-txa-implied)
     (produce-instruction 'inst-pha-implied)
 
@@ -107,7 +104,7 @@
     (produce-label loop-label)
     (compile-node (loopee-node node))
     (produce-instruction 'inst-dex-implied)
-    (produce-instruction 'inst-bne-zero-page loop-label)
+    (produce-instruction 'inst-bne-relative loop-label)
 
     (produce-instruction 'inst-pla-implied)
     (produce-instruction 'inst-tax-implied)))
diff --git a/wip-duuqnd/user-side-compiler/label.lisp b/wip-duuqnd/user-side-compiler/label.lisp
new file mode 100644
index 0000000..38060fd
--- /dev/null
+++ b/wip-duuqnd/user-side-compiler/label.lisp
@@ -0,0 +1,23 @@
+(in-package #:user-side-compiler)
+
+(defclass label ()
+  ((%name :accessor name :initarg :name)
+   (%address :accessor address :initform nil :initarg :address)))
+
+(defmethod print-object ((object label) stream)
+  (with-accessors ((name name) (address address)) object
+    (print-unreadable-object (object stream :type t)
+      (write-string name stream)
+      (unless (null address)
+        (format stream " @ 0x~4,'0X" address)))))
+
+(defun make-label-name (prefix)
+  (format nil "~A~D" prefix (incf *label-counter*)))
+
+(defun make-label (&key name name-prefix address)
+  (when (null name)
+    (setf name (make-label-name (if (null name-prefix) "L" name-prefix))))
+  (when (and (not (null name)) (not (null name-prefix)))
+    (warn "MAKE-LABEL with both name (~A) and prefix (~A) specified (useless)."
+          name name-prefix))
+  (make-instance 'label :name name :address address))
diff --git a/wip-duuqnd/user-side-compiler/user-side-compiler.asd b/wip-duuqnd/user-side-compiler/user-side-compiler.asd
index b0232b4..26b18d6 100644
--- a/wip-duuqnd/user-side-compiler/user-side-compiler.asd
+++ b/wip-duuqnd/user-side-compiler/user-side-compiler.asd
@@ -4,5 +4,6 @@
   :serial t
   :components
   ((:file "package")
+   (:file "label")
    (:file "high-level")
    (:file "instruction")))