wip-duuqnd/user-side-compiler/backend/code-generator.lisp

@@ -1,8 +1,7 @@
 (in-package #:user-side-compiler)
 
 (defclass asm-object ()
-  ((%source :accessor source :initarg :source :initform nil)
-   (%next :accessor next :initform nil)))
+  ((%source :accessor source :initarg :source :initform nil)))
 
 (defclass asm-label (asm-object)
   ((%name :accessor name :initarg :name)
@@ -13,31 +12,19 @@
    (%operand :accessor operand :initarg :operand :initform nil)
    (%byte-length :accessor byte-length :initarg :byte-length)))
 
-(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.")
+(defvar *asm-output* '())
 
 (defun emit-asm-object (obj)
-  (if (null *asm-foot*)
-      (setf *asm-head* obj)
-      (setf (next *asm-foot*) obj))
-  (setf *asm-foot* obj))
+  (check-type obj asm-object)
+  (setf *asm-output* (append *asm-output* (list obj))))
 
 (defun emit-asm-instruction (&rest initargs)
-  (let ((new-instruction (apply #'make-instance
-                                'asm-instruction
-                                initargs)))
-    (emit-asm-object new-instruction)))
+  (emit-asm-object (apply #'make-instance
+                          'asm-instruction
+                          initargs)))
 
 (defun emit-asm-label (identity)
-  (let ((label (make-instance 'asm-label :name identity)))
-    (setf (gethash identity *asm-labels*)
-          label)
-    (emit-asm-object label)))
+  (emit-asm-object (make-instance 'asm-label :name identity)))
 
 (defvar *variable-allocations* (make-hash-table))
 (defvar *last-instruction* '(:nop))
@@ -117,9 +104,6 @@
 (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."))
@@ -148,23 +132,16 @@
   (emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 1)
   (emit-store-result (output inst)))
 
-(defun link-compute-addresses (start-instruction origin-address)
-  "First linking pass, computes the addresses of all labels."
+(defun link-assembly (assembly-list origin-address)
   (let ((address origin-address))
-    (loop :for asm-obj := start-instruction :then (next asm-obj)
-          :until (null asm-obj)
+    (loop :for asm-obj :in assembly-list
           :do (cond ((typep asm-obj 'asm-label)
                      (setf (address asm-obj) address))
                     ((typep asm-obj 'asm-instruction)
                      (incf address (byte-length asm-obj)))))
-    (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)
-  )
+    ;; TODO: Second pass, replacing labels with their addresses, both for
+    ;; constant labels such as assembly routines and for generated labels.
+    (values assembly-list 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)
@@ -192,10 +169,9 @@
             (terpri))
           (when make-asm-p
             (with-variable-allocations allocations
-              (let ((*asm-head* nil)
-                    (*asm-foot* nil))
+              (let ((*asm-output* '()))
                 (do-iblocks (ib rb)
                   (emit-asm-label ib)
                   (do-instructions (inst ib)
                     (compile-ir inst)))
-                (link-assembly *asm-head* #x8000)))))))))
+                (link-assembly *asm-output* #x8000)))))))))

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

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