Add pre-assembly.lisp, which handles transformations needed for asm

wip-duuqnd/user-side-compiler/backend/pre-assembly.lisp

@@ -0,0 +1,64 @@
+(in-package #:user-side-compiler)
+
+(defun optim-reuse-temporary-slots (start-iblock allocations)
+  (let ((free '()))
+    (do-iblocks (iblock start-iblock)
+      (do-instructions (inst iblock)
+        (let ((ending (find inst allocations
+                            :key (alexandria:compose #'last-use
+                                                     #'data)))
+              (beginning (find (output inst) allocations :key #'data)))
+          (cond ((and ending
+                      (eql (strategy ending) :temporary-variable)
+                      (not (null (varvec-index ending))))
+                 (pushnew (varvec-index ending) free))
+                ((and beginning
+                      (eql (strategy beginning) :temporary-variable)
+                      (not (null (varvec-index beginning)))
+                      (not (null free)))
+                 (setf (varvec-index beginning) (pop free)))))))))
+
+(defun optim-prepare-direct-instructions (iblock)
+  (do-instructions (inst iblock)
+    (when (typep inst 'ir-operation)
+      (assert (= (length (inputs inst)) 2))
+      (destructuring-bind (accumulator operand)
+          (inputs inst)
+        (when (typep (definition accumulator) '(or ir-fetchvar ir-getconst))
+          (move-instruction-above (definition accumulator) inst))
+        (when (typep (definition operand) '(or ir-fetchvar ir-getconst))
+          (when (typep (definition operand) 'ir-fetchvar)
+            (setf (inputs inst)
+                  (substitute (input (definition operand)) operand
+                              (inputs inst))))
+          (delete-instruction (definition operand)))))))
+
+(defparameter *operation-routines*
+  '((ir-mult . "mult")
+    (ir-div . "div")))
+
+(defun pre-assembly-software-operations (start-iblock)
+  (do-iblocks (ib start-iblock)
+    (do-instructions (inst ib)
+      (when (member (type-of inst) *operation-routines* :key #'car)
+        (let ((inputs (inputs inst))
+              (output (output inst))
+              (implementation (get-asm-function
+                               (cdr (assoc (type-of inst)
+                                           *operation-routines*)))))
+          (setf (inputs inst) '()
+                (output inst) nil)
+          (let ((new (make-instance 'ir-call
+                                    :callee implementation
+                                    :inputs inputs :output output)))
+            (insert-instruction-above new inst)
+            (delete-instruction inst)
+            ;; To ensure that the code walking continues correctly
+            (setf inst new)))))))
+
+(defun pre-assembly (iblock)
+  (pre-assembly-software-operations iblock)
+  (optim-prepare-direct-instructions iblock)
+  (let ((allocs (allocate-values iblock)))
+    (optim-reuse-temporary-slots iblock allocs)
+    allocs))

wip-duuqnd/user-side-compiler/backend/value-allocator.lisp

@@ -27,21 +27,6 @@
    (%strategy :accessor strategy :initform :temporary-variable)
    (%varvec-index :accessor varvec-index :initform nil)))
 
-(defun optim-prepare-direct-instructions (iblock)
-  (do-instructions (inst iblock)
-    (when (typep inst 'ir-operation)
-      (assert (= (length (inputs inst)) 2))
-      (destructuring-bind (accumulator operand)
-          (inputs inst)
-        (when (typep (definition accumulator) '(or ir-fetchvar ir-getconst))
-          (move-instruction-above (definition accumulator) inst))
-        (when (typep (definition operand) '(or ir-fetchvar ir-getconst))
-          (when (typep (definition operand) 'ir-fetchvar)
-            (setf (inputs inst)
-                  (substitute (input (definition operand)) operand
-                              (inputs inst))))
-          (delete-instruction (definition operand)))))))
-
 (defmethod choose-allocation-strategy ((alc value-allocation))
   (setf
    (strategy alc)
@@ -91,21 +76,3 @@
       (loop :for allocation :in (append named temporary)
             :do (setf (varvec-index allocation) (incf counter))))
     allocations))
-
-(defun optim-reuse-temporary-slots (start-iblock allocations)
-  (let ((free '()))
-    (do-iblocks (iblock start-iblock)
-      (do-instructions (inst iblock)
-        (let ((ending (find inst allocations
-                            :key (alexandria:compose #'last-use
-                                                     #'data)))
-              (beginning (find (output inst) allocations :key #'data)))
-          (cond ((and ending
-                      (eql (strategy ending) :temporary-variable)
-                      (not (null (varvec-index ending))))
-                 (pushnew (varvec-index ending) free))
-                ((and beginning
-                      (eql (strategy beginning) :temporary-variable)
-                      (not (null (varvec-index beginning)))
-                      (not (null free)))
-                 (setf (varvec-index beginning) (pop free)))))))))

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 #:alexandria #:trivial-backtrace)
   :components
   ((:file "package")
    (:file "error-handling")
@@ -35,4 +35,5 @@
     :depends-on ("middle")
     :serial t
     :components ((:file "value-allocator")
+                 (:file "pre-assembly")
                  (:file "code-generator")))))