John Lorentzson
9e643e6c6d
The compiler middle stage takes high level nodes and produces code in an intermediate representation more closely resembling assembly code. Optimizations and the tools for making those are also included. It's significantly easier to optimize IR than syntax trees or assembly. Several things need cleaning up, in particular there are things in jigs.lisp that really should be documented tools, not jigs (specifically the compilation setup and finalization).
93 lines
3.3 KiB
Common Lisp
93 lines
3.3 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defclass builder ()
|
|
((%iblock :accessor iblock :initarg :iblock)
|
|
(%insertion-point :accessor insertion-point :initarg :insertion-point)))
|
|
|
|
(defun insert-instruction-below (new target)
|
|
(check-type target (and ir-inst (not ir-terminator)))
|
|
(let ((next-inst (next target)))
|
|
(setf (next new) next-inst
|
|
(previous next-inst) new
|
|
(previous new) target
|
|
(next target) new
|
|
(iblock new) (iblock target))))
|
|
|
|
(defun insert-instruction-above (new target)
|
|
(let ((prev-inst (previous target))
|
|
(ib (iblock target)))
|
|
(setf (next new) target
|
|
(previous new) prev-inst
|
|
(previous target) new
|
|
(iblock new) ib)
|
|
(if (null prev-inst)
|
|
(setf (start ib) new)
|
|
(setf (next prev-inst) new))))
|
|
|
|
(defun yank-instruction (instruction)
|
|
"Removes INSTRUCTIONS without cleaning up, allowing it to be put back in."
|
|
(check-type instruction (and ir-inst (not ir-terminator)))
|
|
;; TODO: integrity checks
|
|
(let ((iblock (iblock instruction))
|
|
(before (previous instruction))
|
|
(after (next instruction)))
|
|
(setf (previous after) before)
|
|
(unless (null before)
|
|
(setf (next before) after))
|
|
(when (eql (start iblock) instruction)
|
|
(setf (start iblock) after)))
|
|
(setf (next instruction) nil
|
|
(previous instruction) nil))
|
|
|
|
(defun move-instruction-above (moving target)
|
|
(yank-instruction moving)
|
|
(insert-instruction-above moving target))
|
|
|
|
(defun move-instruction-below (moving target)
|
|
(yank-instruction moving)
|
|
(insert-instruction-below moving target))
|
|
|
|
(defun delete-instruction (instruction)
|
|
"Removes an instruction with the expectation that it's not coming back."
|
|
(dolist (input (inputs instruction))
|
|
(when (typep input 'ir-data)
|
|
(remove-user input instruction)))
|
|
(yank-instruction instruction))
|
|
|
|
(defun build-begin (builder iblock)
|
|
"Start BUILDER on a fresh IBLOCK."
|
|
(when (slot-boundp builder '%iblock)
|
|
(setf (program iblock) (program (iblock builder))))
|
|
(setf (insertion-point builder) nil
|
|
(iblock builder) iblock))
|
|
|
|
(defun %build-insert (builder inst)
|
|
(setf (iblock inst) (iblock builder))
|
|
(if (null (insertion-point builder))
|
|
(setf (start (iblock builder)) inst
|
|
(next inst) nil
|
|
(previous inst) nil)
|
|
(setf (next (insertion-point builder)) inst
|
|
(previous inst) (insertion-point builder)))
|
|
(setf (insertion-point builder) inst))
|
|
|
|
(declaim (ftype (function ((and ir-inst (not ir-terminator)) builder) t) build-insert))
|
|
(defun build-insert (instruction builder)
|
|
"Insert INSTRUCTION into the place being build by BUILDER."
|
|
(%build-insert builder instruction))
|
|
|
|
(declaim (ftype (function (ir-terminator builder) t) build-insert-end))
|
|
(defun build-insert-end (instruction builder)
|
|
"Insert a terminator INSTRUCTION with BUILDER, ending its current iblock."
|
|
(%build-insert builder instruction)
|
|
(setf (end (iblock builder)) instruction))
|
|
|
|
(defmacro do-iblocks ((iblock start-block) &body body)
|
|
`(loop :for ,iblock := ,start-block :then (next ,iblock)
|
|
:until (null ,iblock)
|
|
:do (progn ,@body)))
|
|
|
|
(defmacro do-instructions ((instruction iblock) &body body)
|
|
`(loop :for ,instruction := (start ,iblock) :then (next ,instruction)
|
|
:until (null ,instruction)
|
|
:do (progn ,@body)))
|