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

Make assembly program representation smarter

Browse source 
Storing assembly instructions in a list felt nice since that lets me
just fire and forget, but if we want to properly optimize short
branches (i.e. branches that do not require a full JMP) we'll need to
be able to rewrite assembly after linking, and I feel that's best done
by making assembly instructions hold a NEXT rather than poking at a
list clumsily.

The first linking pass was also moved out to a separate function since
we may want to run the first pass twice, first after the initial
assembling and second after expanding optimistic short branches (those
that turned out to be longer branches than 127/128 bytes) into a long
branch snippet (branch with inverted condition skipping over a JMP).
This commit is contained in:
John Lorentzson 2025-07-03 10:25:14 +02:00
parent 0ceb455031
commit c41fb46457
1 changed files with 36 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1,7 +1,8 @@
(in-package #:user-side-compiler) (in-package #:user-side-compiler)
(defclass asm-object () (defclass asm-object ()
((%source :accessor source :initarg :source :initform nil))) ((%source :accessor source :initarg :source :initform nil)
(%next :accessor next :initform nil)))
(defclass asm-label (asm-object) (defclass asm-label (asm-object)
((%name :accessor name :initarg :name) ((%name :accessor name :initarg :name)
@ -12,19 +13,31 @@
(%operand :accessor operand :initarg :operand :initform nil) (%operand :accessor operand :initarg :operand :initform nil)
(%byte-length :accessor byte-length :initarg :byte-length))) (%byte-length :accessor byte-length :initarg :byte-length)))
(defvar *asm-output* '()) (defvar *asm-labels* (make-hash-table :test #'equal)
"A hash table connecting identities (names) to ASM-LABEL objects.")
(defvar *asm-head* nil
"The first assembly object, used for traversal.")
(defvar *asm-foot* nil
"The (so far) last assembly object, used for construction.")
(defun emit-asm-object (obj) (defun emit-asm-object (obj)
(check-type obj asm-object) (if (null *asm-foot*)
(setf *asm-output* (append *asm-output* (list obj)))) (setf *asm-head* obj)
(setf (next *asm-foot*) obj))
(setf *asm-foot* obj))
(defun emit-asm-instruction (&rest initargs) (defun emit-asm-instruction (&rest initargs)
(emit-asm-object (apply #'make-instance (let ((new-instruction (apply #'make-instance
'asm-instruction 'asm-instruction
initargs))) initargs)))
(emit-asm-object new-instruction)))
(defun emit-asm-label (identity) (defun emit-asm-label (identity)
(emit-asm-object (make-instance 'asm-label :name identity))) (let ((label (make-instance 'asm-label :name identity)))
(setf (gethash identity *asm-labels*)
label)
(emit-asm-object label)))
(defvar *variable-allocations* (make-hash-table)) (defvar *variable-allocations* (make-hash-table))
(defvar *last-instruction* '(:nop)) (defvar *last-instruction* '(:nop))
@ -132,16 +145,23 @@
(emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 1) (emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 1)
(emit-store-result (output inst))) (emit-store-result (output inst)))
(defun link-assembly (assembly-list origin-address) (defun link-compute-addresses (start-instruction origin-address)
"First linking pass, computes the addresses of all labels."
(let ((address origin-address)) (let ((address origin-address))
(loop :for asm-obj :in assembly-list (loop :for asm-obj := start-instruction :then (next asm-obj)
:until (null asm-obj)
:do (cond ((typep asm-obj 'asm-label) :do (cond ((typep asm-obj 'asm-label)
(setf (address asm-obj) address)) (setf (address asm-obj) address))
((typep asm-obj 'asm-instruction) ((typep asm-obj 'asm-instruction)
(incf address (byte-length asm-obj))))) (incf address (byte-length asm-obj)))))
(values start-instruction address)))
(defun link-assembly (start-instruction origin-address)
(link-compute-addresses start-instruction origin-address)
;; TODO: Second pass, replacing labels with their addresses, both for ;; TODO: Second pass, replacing labels with their addresses, both for
;; constant labels such as assembly routines and for generated labels. ;; constant labels such as assembly routines and for generated labels.
(values assembly-list address))) ;;(values start-instruction address)
)
(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)
@ -169,9 +189,10 @@
(terpri)) (terpri))
(when make-asm-p (when make-asm-p
(with-variable-allocations allocations (with-variable-allocations allocations
(let ((*asm-output* '())) (let ((*asm-head* nil)
(*asm-foot* nil))
(do-iblocks (ib rb) (do-iblocks (ib rb)
(emit-asm-label ib) (emit-asm-label ib)
(do-instructions (inst ib) (do-instructions (inst ib)
(compile-ir inst))) (compile-ir inst)))
(link-assembly *asm-output* #x8000))))))))) (link-assembly *asm-head* #x8000)))))))))