Make assembly program representation smarter
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:
parent
0ceb455031
commit
c41fb46457
1 changed files with 36 additions and 15 deletions
|
@ -1,7 +1,8 @@
|
|||
(in-package #:user-side-compiler)
|
||||
|
||||
(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)
|
||||
((%name :accessor name :initarg :name)
|
||||
|
@ -12,19 +13,31 @@
|
|||
(%operand :accessor operand :initarg :operand :initform nil)
|
||||
(%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)
|
||||
(check-type obj asm-object)
|
||||
(setf *asm-output* (append *asm-output* (list obj))))
|
||||
(if (null *asm-foot*)
|
||||
(setf *asm-head* obj)
|
||||
(setf (next *asm-foot*) obj))
|
||||
(setf *asm-foot* obj))
|
||||
|
||||
(defun emit-asm-instruction (&rest initargs)
|
||||
(emit-asm-object (apply #'make-instance
|
||||
(let ((new-instruction (apply #'make-instance
|
||||
'asm-instruction
|
||||
initargs)))
|
||||
(emit-asm-object new-instruction)))
|
||||
|
||||
(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 *last-instruction* '(:nop))
|
||||
|
@ -132,16 +145,23 @@
|
|||
(emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 1)
|
||||
(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))
|
||||
(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)
|
||||
(setf (address asm-obj) address))
|
||||
((typep asm-obj 'asm-instruction)
|
||||
(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
|
||||
;; 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)
|
||||
(with-input-from-string (source-stream text)
|
||||
|
@ -169,9 +189,10 @@
|
|||
(terpri))
|
||||
(when make-asm-p
|
||||
(with-variable-allocations allocations
|
||||
(let ((*asm-output* '()))
|
||||
(let ((*asm-head* nil)
|
||||
(*asm-foot* nil))
|
||||
(do-iblocks (ib rb)
|
||||
(emit-asm-label ib)
|
||||
(do-instructions (inst ib)
|
||||
(compile-ir inst)))
|
||||
(link-assembly *asm-output* #x8000)))))))))
|
||||
(link-assembly *asm-head* #x8000)))))))))
|
||||
|
|
Loading…
Add table
Reference in a new issue