wip-duuqnd/user-side-compiler/asm-function.lisp

@@ -1,16 +1,10 @@
 (in-package #:user-side-compiler)
 
-(defvar *asm-functions* (make-hash-table :test #'equalp))
+;;; STUB, TODO
 
 (defclass asm-function ()
-  ((%name :accessor name :initarg :name)
-   (%address :accessor address :initarg :address
-             :initform #xFEC0)))
+  ((%name :accessor name :initarg :name)))
 
 (define-transformation (token (token-name asm-function))
-  (multiple-value-bind (asm-function existsp)
-      (gethash (name token) *asm-functions*)
-    (if existsp
-        asm-function
-        (setf (gethash (name token) *asm-functions*)
-              (make-instance 'asm-function :name (name token))))))
+  ;; TODO: Choose from a list, don't just create like this
+  (make-instance 'asm-function :name (name token)))

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

@@ -93,14 +93,14 @@
 (define-normal-emitter emit-sta (error "STA has no immediate mode.") #x85 #x8d)
 (define-normal-emitter emit-adc #x69 #x65 #x6d)
 
-(defun emit-store-data (data)
-  (if (or (null (allocation-details data))
-          (member (strategy (allocation-details data))
+(defun emit-store-result (result)
+  (if (or (null (allocation-details result))
+          (member (strategy (allocation-details result))
                   '(:constant :accumulator)))
       (setf *last-instruction* '(:useless))
       (progn
-        (emit-sta :address (data-reference data))
-        (setf *last-instruction* (list :store data)))))
+        (emit-sta :address (data-reference result))
+        (setf *last-instruction* (list :store result)))))
 
 (defun emit-load-data (data)
   (if (or (member (strategy (allocation-details data))

wip-duuqnd/user-side-compiler/middle/compile-node-to-ir.lisp

@@ -74,7 +74,7 @@
          (then-iblock (make-instance 'iblock :name "then"))
          (else-iblock (make-instance 'iblock :name "else"))
          (continuation (if else-exists-p
-                           (make-instance 'iblock-merge :name "merge")
+                           (make-instance 'iblock :name "merge")
                            else-iblock)))
     (build-insert-end (make-instance
                        'ir-if

wip-duuqnd/user-side-compiler/middle/jigs.lisp

@@ -40,46 +40,19 @@
 
 ;;; Compilation setup
 
-(defun make-iblock-names-unique (start-iblock)
-  (let ((encountered '()))
-    (do-iblocks (iblock start-iblock)
-      (let ((existing (assoc (name iblock) encountered :test #'equalp)))
-        (if existing
-            (progn
-              (setf (name iblock)
-                    (format nil "~A_~A" (name iblock) (incf (cdr existing)))))
-            (progn
-              (push (cons (copy-seq (name iblock)) 1) encountered)
-              (setf (name iblock)
-                    (format nil "~A_1" (name iblock)))))))))
-
-(defun fix-iblock-flow (start-iblock)
-  (let ((reached '())
-        (last nil)
-        (deferred '()))
+(defun fix-iblock-flow (iblock)
+  (let ((reached '()))
     (labels
-        ((fix-deferred ()
-           (unless (null deferred)
-             (loop :for after :in (nreverse (pop deferred))
-                   :do (fix after last))))
-         (fix (iblock prev)
+        ((fix (iblock prev)
            (unless (member iblock reached)
              (push iblock reached)
-             (unless (null prev)
-               (setf (next prev) iblock))
-             (setf (prev iblock) prev
-                   last iblock)
-             (fix-deferred)
-             (push '() deferred)
-             (loop :for s :in (successors iblock)
-                   :if (typep s 'iblock-merge)
-                     :do (pushnew s (car deferred))
-                   :else
-                     :do (fix s last))
-             (when (null prev)
-               (loop :until (null deferred)
-                     :do (fix-deferred))))))
-      (fix start-iblock nil))))
+             (setf (next iblock)
+                   (first (successors iblock))
+                   (prev iblock) prev)
+             (loop :for prev := iblock :then s
+                   :for s :in (successors iblock)
+                   :do (fix s prev)))))
+      (fix iblock nil))))
 
 (defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body)
   `(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program)))
@@ -90,9 +63,7 @@
            ,@body)
        (when ,add-return-p
          (build-insert-end (make-instance 'ir-return) ,builder))
-       (fix-iblock-flow ,iblock)
-       (unless (null (next ,iblock))
-         (make-iblock-names-unique (next ,iblock))))))
+       (fix-iblock-flow ,iblock))))
 
 ;;; Some quick example code
 

wip-duuqnd/user-side-compiler/middle/structure.lisp

@@ -12,8 +12,6 @@
    (%prev :accessor prev :type (or null iblock) :initform nil)
    (%name :accessor name :initarg :name :initform nil)))
 
-(defclass iblock-merge (iblock) ())
-
 (defmethod find-variable (reference (search-from ir-program))
   (multiple-value-bind (var existsp)
       (gethash reference (variables search-from))