From c336e43c19bb5220cf720a41252c77fc6fff4067 Mon Sep 17 00:00:00 2001
From: John Lorentzson <duuqnd@stacken.kth.se>
Date: Thu, 8 May 2025 22:18:25 +0200
Subject: [PATCH] Add bytesquashing (turning instructions etc. into dead bytes)

---
 wip-duuqnd/user-side-compiler/bytesquash.lisp | 11 +++++++++++
 .../user-side-compiler/instruction.lisp       | 19 ++++++++++++++++++-
 2 files changed, 29 insertions(+), 1 deletion(-)
 create mode 100644 wip-duuqnd/user-side-compiler/bytesquash.lisp

diff --git a/wip-duuqnd/user-side-compiler/bytesquash.lisp b/wip-duuqnd/user-side-compiler/bytesquash.lisp
new file mode 100644
index 0000000..c92eacd
--- /dev/null
+++ b/wip-duuqnd/user-side-compiler/bytesquash.lisp
@@ -0,0 +1,11 @@
+(in-package #:user-side-compiler)
+
+(defgeneric bytesquash (object)
+  (:method ((object integer))
+    (typecase object
+      ((unsigned-byte 8) (list object))
+      ((unsigned-byte 16) (list (ldb (byte 8 0) object)
+                                (ldb (byte 8 8) object)))
+      (t (error "Cannot bytesquash integers larger than 16-bit."))))
+  (:method ((object label))
+    (bytesquash (address object))))
diff --git a/wip-duuqnd/user-side-compiler/instruction.lisp b/wip-duuqnd/user-side-compiler/instruction.lisp
index c613adc..f6b77cd 100644
--- a/wip-duuqnd/user-side-compiler/instruction.lisp
+++ b/wip-duuqnd/user-side-compiler/instruction.lisp
@@ -32,9 +32,14 @@
                      ""
                      (format nil " ~S" (operand object)))))))
 
-(defclass complete-mixin ()
+(defclass complete-instruction-mixin ()
   ((%opcode :allocation :class :reader opcode :initarg :opcode)))
 
+(defmethod bytesquash ((object complete-instruction-mixin))
+  (append (list (opcode object))
+          (when (> (instruction-length object) 1)
+            (bytesquash (operand object)))))
+
 (defclass immediate-mixin () ())
 (defclass implied-mixin () ())
 (defclass accumulator-mixin () ())
@@ -113,6 +118,18 @@
         :finally (setf (cdr cell)
                        (list (make-label :name "PROGRAM_END" :address address)))))
 
+(defun bytesquash-instruction-list (instruction-list origin)
+  (let* ((end-label (find "PROGRAM_END" (remove-if-not #'labelp instruction-list)
+                          :key #'name :test #'equalp))
+         (byte-vector (make-array (- (address end-label) origin)
+                                  :element-type '(unsigned-byte 8)
+                                  :fill-pointer 0)))
+    (loop :for thing :in instruction-list
+          :when (typep thing 'instruction)
+            :do (dolist (byte (bytesquash thing))
+                  (vector-push byte byte-vector)))
+    byte-vector))
+
 ;;; Testing
 
 (define-instruction "TXA" nil (:implied #x8a))