Add code-generator.lisp to ASD

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

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)
+  (if (null *asm-foot*)
-  (setf *asm-output* (append *asm-output* (list obj))))
+      (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
+  (let ((new-instruction (apply #'make-instance
-                          'asm-instruction
+                                'asm-instruction
-                          initargs)))
+                                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))
@@ -104,6 +117,9 @@
 (defmethod compile-ir ((inst ir-inst))
   (warn "Skipped compiling ~A; no COMPILE-IR method" inst))
 
+(defmethod compile-ir ((inst ir-return))
+  (emit-asm-instruction :opcode #x60 :byte-length 1))
+
 (defmethod compile-ir ((inst ir-plus))
   (unless (= (length (inputs inst)) 2)
     (error "During the final code generation step, IR-PLUS must have exactly 2 operands."))
@@ -132,16 +148,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
+    (values start-instruction address)))
-    ;; constant labels such as assembly routines and for generated labels.
+
-    (values assembly-list 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 +192,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)))))))))

wip-duuqnd/user-side-compiler/user-side-compiler.asd

@@ -2,7 +2,7 @@
 
 (defsystem #:user-side-compiler
   :serial t
-  :depends-on (#:closer-mop)
+  :depends-on (#:closer-mop #:alexandria)
   :components
   ((:file "package")
    (:file "toolkit")
@@ -32,4 +32,5 @@
    (:module "backend"
     :depends-on ("middle")
     :serial t
-    :components ((:file "value-allocator")))))
+    :components ((:file "value-allocator")
+                 (:file "code-generator")))))