Make ASM-FUNCTION hold an address to be called

TODO: Populate the table based on the asm source code declaration
comments and signal an error when a named function is missing.

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

@@ -1,10 +1,16 @@
 (in-package #:user-side-compiler)
 
-;;; STUB, TODO
+(defvar *asm-functions* (make-hash-table :test #'equalp))
 
 (defclass asm-function ()
-  ((%name :accessor name :initarg :name)))
+  ((%name :accessor name :initarg :name)
+   (%address :accessor address :initarg :address
+             :initform #xFEC0)))
 
 (define-transformation (token (token-name asm-function))
-  ;; TODO: Choose from a list, don't just create like this
+  (multiple-value-bind (asm-function existsp)
-  (make-instance 'asm-function :name (name token)))
+      (gethash (name token) *asm-functions*)
+    (if existsp
+        asm-function
+        (setf (gethash (name token) *asm-functions*)
+              (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-result (result)
+(defun emit-store-data (data)
-  (if (or (null (allocation-details result))
+  (if (or (null (allocation-details data))
-          (member (strategy (allocation-details result))
+          (member (strategy (allocation-details data))
                   '(:constant :accumulator)))
       (setf *last-instruction* '(:useless))
       (progn
-        (emit-sta :address (data-reference result))
+        (emit-sta :address (data-reference data))
-        (setf *last-instruction* (list :store result)))))
+        (setf *last-instruction* (list :store data)))))
 
 (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 :name "merge")
+                           (make-instance 'iblock-merge :name "merge")
                            else-iblock)))
     (build-insert-end (make-instance
                        'ir-if

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

@@ -40,19 +40,46 @@
 
 ;;; Compilation setup
 
-(defun fix-iblock-flow (iblock)
+(defun make-iblock-names-unique (start-iblock)
-  (let ((reached '()))
+  (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 '()))
     (labels
-        ((fix (iblock prev)
+        ((fix-deferred ()
+           (unless (null deferred)
+             (loop :for after :in (nreverse (pop deferred))
+                   :do (fix after last))))
+         (fix (iblock prev)
            (unless (member iblock reached)
              (push iblock reached)
-             (setf (next iblock)
+             (unless (null prev)
-                   (first (successors iblock))
+               (setf (next prev) iblock))
-                   (prev iblock) prev)
+             (setf (prev iblock) prev
-             (loop :for prev := iblock :then s
+                   last iblock)
-                   :for s :in (successors iblock)
+             (fix-deferred)
-                   :do (fix s prev)))))
+             (push '() deferred)
-      (fix iblock nil))))
+             (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))))
 
 (defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body)
   `(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program)))
@@ -63,7 +90,9 @@
            ,@body)
        (when ,add-return-p
          (build-insert-end (make-instance 'ir-return) ,builder))
-       (fix-iblock-flow ,iblock))))
+       (fix-iblock-flow ,iblock)
+       (unless (null (next ,iblock))
+         (make-iblock-names-unique (next ,iblock))))))
 
 ;;; Some quick example code
 

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

@@ -12,6 +12,8 @@
    (%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))