Add bytesquashing (turning instructions etc. into dead bytes)

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

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