From c41fb464570e630cadbc3ce14ac10122bdcafd31 Mon Sep 17 00:00:00 2001
From: John Lorentzson <john_lorentzson@yahoo.com>
Date: Thu, 3 Jul 2025 10:25:14 +0200
Subject: [PATCH] Make assembly program representation smarter

Storing assembly instructions in a list felt nice since that lets me
just fire and forget, but if we want to properly optimize short
branches (i.e. branches that do not require a full JMP) we'll need to
be able to rewrite assembly after linking, and I feel that's best done
by making assembly instructions hold a NEXT rather than poking at a
list clumsily.

The first linking pass was also moved out to a separate function since
we may want to run the first pass twice, first after the initial
assembling and second after expanding optimistic short branches (those
that turned out to be longer branches than 127/128 bytes) into a long
branch snippet (branch with inverted condition skipping over a JMP).
---
 .../backend/code-generator.lisp               | 51 +++++++++++++------
 1 file changed, 36 insertions(+), 15 deletions(-)

diff --git a/wip-duuqnd/user-side-compiler/backend/code-generator.lisp b/wip-duuqnd/user-side-compiler/backend/code-generator.lisp
index 10b8833..eda09c5 100644
--- a/wip-duuqnd/user-side-compiler/backend/code-generator.lisp
+++ b/wip-duuqnd/user-side-compiler/backend/code-generator.lisp
@@ -1,7 +1,8 @@
 (in-package #:user-side-compiler)
 
 (defclass asm-object ()
-  ((%source :accessor source :initarg :source :initform nil)))
+  ((%source :accessor source :initarg :source :initform nil)
+   (%next :accessor next :initform nil)))
 
 (defclass asm-label (asm-object)
   ((%name :accessor name :initarg :name)
@@ -12,19 +13,31 @@
    (%operand :accessor operand :initarg :operand :initform nil)
    (%byte-length :accessor byte-length :initarg :byte-length)))
 
-(defvar *asm-output* '())
+(defvar *asm-labels* (make-hash-table :test #'equal)
+  "A hash table connecting identities (names) to ASM-LABEL objects.")
+
+(defvar *asm-head* nil
+  "The first assembly object, used for traversal.")
+(defvar *asm-foot* nil
+  "The (so far) last assembly object, used for construction.")
 
 (defun emit-asm-object (obj)
-  (check-type obj asm-object)
-  (setf *asm-output* (append *asm-output* (list obj))))
+  (if (null *asm-foot*)
+      (setf *asm-head* obj)
+      (setf (next *asm-foot*) obj))
+  (setf *asm-foot* obj))
 
 (defun emit-asm-instruction (&rest initargs)
-  (emit-asm-object (apply #'make-instance
-                          'asm-instruction
-                          initargs)))
+  (let ((new-instruction (apply #'make-instance
+                                'asm-instruction
+                                initargs)))
+    (emit-asm-object new-instruction)))
 
 (defun emit-asm-label (identity)
-  (emit-asm-object (make-instance 'asm-label :name identity)))
+  (let ((label (make-instance 'asm-label :name identity)))
+    (setf (gethash identity *asm-labels*)
+          label)
+    (emit-asm-object label)))
 
 (defvar *variable-allocations* (make-hash-table))
 (defvar *last-instruction* '(:nop))
@@ -132,16 +145,23 @@
   (emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 1)
   (emit-store-result (output inst)))
 
-(defun link-assembly (assembly-list origin-address)
+(defun link-compute-addresses (start-instruction origin-address)
+  "First linking pass, computes the addresses of all labels."
   (let ((address origin-address))
-    (loop :for asm-obj :in assembly-list
+    (loop :for asm-obj := start-instruction :then (next asm-obj)
+          :until (null asm-obj)
           :do (cond ((typep asm-obj 'asm-label)
                      (setf (address asm-obj) address))
                     ((typep asm-obj 'asm-instruction)
                      (incf address (byte-length asm-obj)))))
-    ;; TODO: Second pass, replacing labels with their addresses, both for
-    ;; constant labels such as assembly routines and for generated labels.
-    (values assembly-list address)))
+    (values start-instruction address)))
+
+(defun link-assembly (start-instruction origin-address)
+  (link-compute-addresses start-instruction origin-address)
+  ;; TODO: Second pass, replacing labels with their addresses, both for
+  ;; constant labels such as assembly routines and for generated labels.
+  ;;(values start-instruction address)
+  )
 
 (defun quick-and-dirty-test-compile (text &key print-ir-p print-alloc-p make-asm-p)
   (with-input-from-string (source-stream text)
@@ -169,9 +189,10 @@
             (terpri))
           (when make-asm-p
             (with-variable-allocations allocations
-              (let ((*asm-output* '()))
+              (let ((*asm-head* nil)
+                    (*asm-foot* nil))
                 (do-iblocks (ib rb)
                   (emit-asm-label ib)
                   (do-instructions (inst ib)
                     (compile-ir inst)))
-                (link-assembly *asm-output* #x8000)))))))))
+                (link-assembly *asm-head* #x8000)))))))))