Add LABEL class and replace uses of temporary strings with it

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

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

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