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

Make linking and final compile to byte sequence work

Browse source
This commit is contained in:
John Lorentzson 2025-07-03 16:58:29 +02:00
parent f9a69e2da9
commit f54ecb75b9
1 changed files with 62 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -230,12 +230,69 @@
:do (incf address (byte-length asm-obj))) :do (incf address (byte-length asm-obj)))
(values start-instruction address))) (values start-instruction address)))
(defun link-resolve-references (start-instruction)
(flet ((resolve-iblock (asm-obj)
(setf (operand asm-obj)
(multiple-value-bind (label existsp)
(gethash (name (operand asm-obj))
*asm-labels*)
(unless existsp
(error "Failed to resolve label ~A"
(name (operand asm-obj))))
label))))
(loop :for asm-obj := start-instruction :then (next asm-obj)
:until (null asm-obj)
:when (typep asm-obj 'asm-instruction)
:do (case (opcode asm-obj)
((#x10 #x30 #x50 #x70 #x90 #xb0 #xd0 #xf0)
;; Relative branches
(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)))))
(t
(when (typep (operand asm-obj) 'iblock)
(resolve-iblock asm-obj))
(when (typep (operand asm-obj) 'asm-label)
(setf (operand asm-obj) (address (operand asm-obj))))
(when (typep (operand asm-obj) 'asm-function)
(setf (operand asm-obj) (address (operand asm-obj)))))))))
(defun link-assembly (start-instruction origin-address) (defun link-assembly (start-instruction origin-address)
(link-compute-addresses start-instruction origin-address) (link-compute-addresses start-instruction origin-address)
;; TODO: Second pass, replacing labels with their addresses, both for ;; TODO: Branch correction
;; constant labels such as assembly routines and for generated labels. (link-resolve-references start-instruction)
;;(values start-instruction address) start-instruction)
)
(defun compile-iblock (iblock)
(emit-asm-label (unique-name iblock))
(do-instructions (inst iblock)
(compile-ir inst)))
(defun compile-iblocks (start-iblock)
(let ((*asm-head* nil)
(*asm-foot* nil)
(*asm-labels* (make-hash-table :test #'equal)))
(do-iblocks (iblock start-iblock)
(compile-iblock iblock))
(link-assembly *asm-head* #xC000)
*asm-head*))
(defun compiled-bytes (start-instruction)
(declare (optimize (debug 3)))
(loop :for asm-obj := start-instruction :then (next asm-obj)
:do (loop :until (or (null asm-obj) (typep asm-obj 'asm-instruction))
:do (setf asm-obj (next asm-obj)))
:until (null asm-obj)
:append (list (opcode asm-obj))
:when (> (byte-length asm-obj) 1)
:append (ecase (byte-length asm-obj)
(2 (list (the (unsigned-byte 8) (operand asm-obj))))
(3 (list (ldb (byte 8 0)
(the (unsigned-byte 16) (operand asm-obj)))
(ldb (byte 8 8)
(the (unsigned-byte 16) (operand asm-obj))))))))
(defun quick-and-dirty-test-compile (text &key print-ir-p print-alloc-p make-asm-p) (defun quick-and-dirty-test-compile (text &key print-ir-p print-alloc-p make-asm-p)
(with-input-from-string (source-stream text) (with-input-from-string (source-stream text)
@ -263,10 +320,4 @@
(terpri)) (terpri))
(when make-asm-p (when make-asm-p
(with-variable-allocations allocations (with-variable-allocations allocations
(let ((*asm-head* nil) (compile-iblocks rb))))))))
(*asm-foot* nil))
(do-iblocks (ib rb)
(emit-asm-label ib)
(do-instructions (inst ib)
(compile-ir inst)))
(link-assembly *asm-head* #x8000)))))))))