Stacken/c64-livecoding
6
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Various additions and changes to compiler backend for IFs and calls

Browse source 
Branching now exists in a general way (work for tests requiring
multiple branch instructions still needed) that works for both storing
test results and taking branches in code.

De-duplicated arguments to calls now load correctly.
This commit is contained in:
John Lorentzson 2025-07-06 22:24:51 +02:00
parent 9685f00e10
commit 016d7ededd
1 changed files with 64 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -68,6 +68,8 @@
(cons :address (+ (varvec-index (allocation-details data))
+varvec-offset+)))
(:direct-to-argvec
(unless (= (count data (inputs (first (users data)))) 1)
(error "Tried to manually dereference reused function argument ~A." data))
(cons :address (+ (position data (inputs (first (users data))))
+argvec-offset+)))
(:constant
@ -109,12 +111,19 @@ is the responsibility of the pre-assembly compilation step."
(define-normal-emitter emit-cmp #xc9 #xc5 #xcd)
(defun emit-store-data (data)
(if (or (eql (strategy (allocation-details data)) :not-saved)
(eql (strategy (allocation-details data)) :constant))
(if (member (strategy (allocation-details data))
'(:not-saved :constant :branch))
(setf *last-instruction* :useless)
(progn
(unless (eql (strategy (allocation-details data)) :accumulator)
(emit-sta (data-reference data)))
(if (and (eql (strategy (allocation-details data)) :direct-to-argvec)
(> (count data (inputs (first (users data)))) 1))
(loop :with args := (inputs (first (users data)))
:for index := (position data args)
:then (position data args :start (1+ index))
:until (null index)
:do (emit-sta (cons :address (+ index +argvec-offset+))))
(emit-sta (data-reference data))))
(setf *last-instruction* (list :store data)))))
(defun emit-store-bool (data)
@ -138,6 +147,8 @@ is the responsibility of the pre-assembly compilation step."
((eql (strategy (allocation-details data)) :accumulator)
(assert (eql (next (definition data)) (last-use data)))
(setf *last-instruction* :useless))
((eql (strategy (allocation-details data)) :branch)
(assert (typep (next (definition data)) 'ir-if)))
((eql (strategy (allocation-details data)) :direct-to-argvec)
;; TODO: Assert that it actually has been stored
(setf *last-instruction* :useless))
@ -205,9 +216,11 @@ is the responsibility of the pre-assembly compilation step."
(defmethod compile-ir ((inst ir-call))
(loop :for arg :in (inputs inst)
:for arg-index :from 0
:do (emit-load-data arg)
:do (setf *last-instruction* :useless)
:unless (eql (strategy (allocation-details arg)) :direct-to-argvec)
:do (emit-sta (cons :address (+ arg-index +argvec-offset+))))
:do (emit-lda (data-reference arg))
(emit-sta (cons :address (+ arg-index +argvec-offset+)))
(format t "~D. ~A~%" arg-index arg))
(emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 3)
(emit-store-data (output inst)))
@ -216,8 +229,8 @@ is the responsibility of the pre-assembly compilation step."
(first (destinations inst)))
(emit-asm-instruction :opcode #x4C
:operand (first (destinations inst))
:byte-length 3))
(setf *last-instruction* (list :jump (first (destinations inst)))))
:byte-length 3)
(setf *last-instruction* (list :jump (first (destinations inst))))))
(defmethod compile-ir ((inst ir-if))
(let ((next-iblock (next (iblock inst)))
@ -228,19 +241,50 @@ is the responsibility of the pre-assembly compilation step."
;; ensures that this assumption become false without us noticing.
;; We implicitly fall through to THEN-BLOCK in the event of no branch.
(assert (eql next-iblock then-iblock))
(emit-load-bool (input inst))
(emit-asm-instruction :opcode #xD0
:operand else-iblock
:byte-length 2)
(emit-load-data (input inst))
(let ((prev-is-test-p (eql (strategy (allocation-details (input inst)))
:branch)))
(if prev-is-test-p
;; If previous was a test, this instruction will be skipped if the
;; test succeeds and we fall through to the THEN case. If it fails,
;; this instruction executes, which jumps to the ELSE case.
(emit-asm-instruction :opcode #x4C
:operand else-iblock
:byte-length 3)
;; If the input is a bool value, we have to actually do some work.
(progn
;; BNE +3, if it's Not Equal (zero), then it's true, so we skip...
(emit-asm-instruction :opcode #xD0 :operand 3 :byte-length 2)
;; ...the jump to the ELSE case.
(emit-asm-instruction :opcode #x4C
:operand else-iblock
:byte-length 3))))
(setf *last-instruction* :branch)))
(defun emit-branch-test-code (inputs output branch-opcode)
(let ((branchp (eql (strategy (allocation-details output)) :branch)))
(emit-load-data (first inputs))
(unless branchp ; If we're *NOT* branching, we're storing a test result.
;; LDX #1. This value will go into A if the test succeeds.
(emit-asm-instruction :opcode #xA2 :operand 1 :byte-length 2))
(emit-cmp (data-reference (second inputs)))
;; The actual branch instruction for our test.
(emit-asm-instruction :opcode branch-opcode :operand 3 :byte-length 2)
(unless branchp
;; In the event of no branch -- we're storing the result -- we skip over
;; an LDX #0 instruction if it succeeded, run if if the test failed.
(emit-asm-instruction :opcode #xA2 :operand 0 :byte-length 2)
;; And a NOP since the skip is three bytes, since in the even of a branch
;; it will be skipping over a whole JMP.
(emit-asm-instruction :opcode #xEA :byte-length 1)
;; Then, regardless if we skipped or not, we put the result we have in X,
;; either 0 or 1, into A by emitting a TXA.
(emit-asm-instruction :opcode #x8A :byte-length 1))
;; And regardless, we store the result, if applicable.
(emit-store-data output)))
(defmethod compile-ir ((inst ir-test-equal))
(emit-load-data (first (inputs inst)))
(if (eql (strategy (allocation-details (second (inputs inst))))
:constant)
(emit-cmp :immediate (ir-constant-value (second (inputs inst))))
(emit-cmp :address (data-reference (second (inputs inst)))))
(emit-store-bool (output inst)))
(emit-branch-test-code (inputs inst) (output inst) #xF0))
(defmacro do-asm-objects ((asm-obj start-asm-obj) &body body)
`(loop :for ,asm-obj := ,start-asm-obj :then (next ,asm-obj)
@ -277,8 +321,9 @@ is the responsibility of the pre-assembly compilation step."
(when (typep (operand asm-obj) 'iblock)
(resolve-iblock asm-obj))
;; - 2 is to offset for the branch instruction's length
(let* ((offset (- (address (operand asm-obj)) (address asm-obj) 2)))
(setf (operand asm-obj) (ldb (byte 8 0) (the (signed-byte 8) offset)))))
(unless (typep (operand asm-obj) '(unsigned-byte 8))
(let* ((offset (- (address (operand asm-obj)) (address asm-obj) 2)))
(setf (operand asm-obj) (ldb (byte 8 0) (the (signed-byte 8) offset))))))
(t
(when (typep (operand asm-obj) 'iblock)
(resolve-iblock asm-obj))