Add inlining (or compiler intrinsics if you prefer) for AND and XOR

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

@@ -280,6 +280,24 @@ is the responsibility of the pre-assembly compilation step."
   ;; BCS to true path
   (emit-branch-test-code (inputs inst) (output inst) '((#xB0))))
 
+;;; Inline snippets
+
+(define-normal-emitter emit-and #x29 #x25 #x2D)
+
+(defmethod compile-ir ((inst ir-inline-bitand))
+  (emit-load-data (first (inputs inst)))
+  (emit-and (data-reference (second (inputs inst))))
+  (emit-store-data (output inst)))
+
+(define-normal-emitter emit-xor #x49 #x45 #x4D)
+
+(defmethod compile-ir ((inst ir-inline-bitxor))
+  (emit-load-data (first (inputs inst)))
+  (emit-xor (data-reference (second (inputs inst))))
+  (emit-store-data (output inst)))
+
+;;; Functions for the performing the compilation process
+
 (defmacro do-asm-objects ((asm-obj start-asm-obj) &body body)
   `(loop :for ,asm-obj := ,start-asm-obj :then (next ,asm-obj)
          :until (null ,asm-obj)

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

@@ -1,5 +1,35 @@
 (in-package #:user-side-compiler)
 
+(defclass ir-inline (ir-inst) ())
+
+(defclass ir-inline-bitand (ir-inline ir-operation) ())
+(defclass ir-inline-bitxor (ir-inline ir-operation) ())
+
+(defparameter *inline-functions*
+  '(("bitand" . ir-inline-bitand)
+    ("bitxor" . ir-inline-bitxor)))
+
+(defun optim-inline (start-iblock)
+  (do-iblocks (iblock start-iblock)
+    (do-instructions (inst iblock)
+      (when (typep inst 'ir-call)
+        (let ((inline-equivalent (cdr (assoc (name (callee inst))
+                                             *inline-functions*
+                                             :test #'string-equal))))
+          (unless (null inline-equivalent)
+            (let* ((inputs (inputs inst))
+                   (output (output inst)))
+              (setf (inputs inst) '()
+                    (output inst) nil)
+              (let ((new (make-instance inline-equivalent
+                                        :source (source inst)
+                                        :inputs inputs
+                                        :output output)))
+                (insert-instruction-above new inst)
+                (delete-instruction inst)
+                (setf inst new))))))))
+  (print-iblocks start-iblock))
+
 (defun optim-reuse-temporary-slots (start-iblock allocations)
   (let ((free '()))
     (do-iblocks (iblock start-iblock)
@@ -58,7 +88,9 @@
 
 (defun pre-assembly (iblock)
   (pre-assembly-software-operations iblock)
-  (optim-prepare-direct-instructions iblock)
+  (optim-inline iblock)
+  (do-iblocks (ib iblock)
+    (optim-prepare-direct-instructions ib))
   (let ((allocs (allocate-values iblock)))
     (optim-reuse-temporary-slots iblock allocs)
     allocs))