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

@@ -92,12 +92,12 @@
 (define-normal-emitter emit-lda #xa9 #xa5 #xad)
 (define-normal-emitter emit-sta (error "STA has no immediate mode.") #x85 #x8d)
 (define-normal-emitter emit-adc #x69 #x65 #x6d)
-(define-normal-emitter emit-sbc #xe9 #xe5 #xed)
 (define-normal-emitter emit-cmp #xc9 #xc5 #xcd)
 
 (defun emit-store-data (data)
   (if (or (null (allocation-details data))
-          (eql (strategy (allocation-details data)) :constant))
+          (member (strategy (allocation-details data))
+                  '(:constant :accumulator)))
       (setf *last-instruction* '(:useless))
       (progn
         (emit-sta :address (data-reference data))
@@ -108,7 +108,7 @@
   ;; The "DATA is stored"-case
   (if (or (null (allocation-details data))
           (member (strategy (allocation-details data))
-                  '(:constant :flags)))
+                  '(:constant :accumulator)))
       (setf *last-instruction* '(:useless))
       (progn
         (emit-asm-instruction :opcode :php :byte-length 1)
@@ -120,7 +120,8 @@
         (setf *last-instruction* '(:store-zero-flag data)))))
 
 (defun emit-load-data (data)
-  (if (or (eql (strategy (allocation-details data)) :direct-to-argvec)
+  (if (or (member (strategy (allocation-details data))
+                  '(:accumulator :direct-to-argvec))
           (equal *last-instruction* (list :store data))
           (equal *last-instruction* (list :load data)))
       (setf *last-instruction* '(:useless))
@@ -131,7 +132,8 @@
         (setf *last-instruction* (list :load data)))))
 
 (defun emit-load-bool (data)
-  (if (or (eql (strategy (allocation-details data)) :flags)
+  (if (or (member (strategy (allocation-details data))
+                  '(:accumulator))
           (equal *last-instruction* (list :store-zero-flag data))
           (equal *last-instruction* (list :load-zero-flag data)))
       (setf *last-instruction* '(:useless))
@@ -162,26 +164,15 @@
            :constant)
       (emit-adc :immediate (ir-constant-value (second (inputs inst))))
       (emit-adc :address (data-reference (second (inputs inst)))))
-  (emit-store-data (output inst)))
+  (emit-store-result (output inst)))
-
-(defmethod compile-ir ((inst ir-minus))
-  (unless (= (length (inputs inst)) 2)
-    (error "During the final code generation step, IR-MINUS must have exactly 2 operands."))
-  (emit-load-data (first (inputs inst)))
-  (emit-asm-instruction :opcode #x38 :byte-length 1) ; Set Carry
-  (if (eql (strategy (allocation-details (second (inputs inst))))
-           :constant)
-      (emit-sbc :immediate (ir-constant-value (second (inputs inst))))
-      (emit-sbc :address (data-reference (second (inputs inst)))))
-  (emit-store-data (output inst)))
 
 (defmethod compile-ir ((inst ir-assign))
   (emit-load-data (input inst))
-  (emit-store-data (output inst)))
+  (emit-store-result (output inst)))
 
 (defmethod compile-ir ((inst ir-fetchvar))
   (emit-load-data (input inst))
-  (emit-store-data (output inst)))
+  (emit-store-result (output inst)))
 
 (defmethod compile-ir ((inst ir-call))
   (loop :for arg :in (inputs inst)
@@ -190,7 +181,7 @@
         :unless (eql (strategy (allocation-details arg)) :direct-to-argvec)
           :do (emit-sta :address (+ arg-index +argvec-offset+)))
   (emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 3)
-  (emit-store-data (output inst)))
+  (emit-store-result (output inst)))
 
 (defmethod compile-ir ((inst ir-jump))
   (unless (eql (next (iblock inst))
@@ -275,7 +266,7 @@
   start-instruction)
 
 (defun compile-iblock (iblock)
-  (emit-asm-label (name iblock))
+  (emit-asm-label (unique-name iblock))
   (do-instructions (inst iblock)
     (compile-ir inst)))
 

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

@@ -31,8 +31,8 @@
            ((typep data 'ir-variable)
             :named-variable)
            ((and (eql (next (definition data)) (last-use data))
-                 (typep (last-use data) 'ir-if))
+                 (not (typep (last-use data) 'ir-call)))
-            :flags)
+            :accumulator)
            ((and (not (typep data 'ir-reusable))
                  (typep (last-use data) 'ir-call)
                  (not (calls-exist-between-p (definition data) (last-use data))))

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

@@ -178,6 +178,12 @@ IR-FETCHVAR instructions that would serve no purpose in compiled code."
   (let ((candidates-type '(or ir-test-equal ir-plus ir-minus))
         (to-remove '()))
     (do-instructions (inst iblock)
+      #+(or)
+      (when (equalp (name iblock) "else")
+        (break "~A ~A" inst
+               (if (typep inst 'ir-fetchvar)
+                   (format nil "~A ~A ~A" (input inst) (output inst) (users (output inst)))
+                   "")))
       (when (typep inst 'ir-fetchvar)
         (let ((result (output inst))
               (src (input inst)))