79 lines
3.3 KiB
Common Lisp
79 lines
3.3 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
;;; This is typically called a register allocator, but since the only real
|
|
;;; registers we're working with are special purpose, and there's some special
|
|
;;; 6502-related nonsense going on as well, it feels better to call it a value
|
|
;;; allocator instead.
|
|
|
|
(defun calls-exist-between-p (start end)
|
|
(cond ((eql start end)
|
|
nil)
|
|
((typep start 'ir-call)
|
|
start)
|
|
((null start)
|
|
(error "Calls check crossed iblock boundary. This should not happen."))
|
|
(t
|
|
(calls-exist-between-p (next start) end))))
|
|
|
|
(defclass value-allocation ()
|
|
((%data :accessor data :initarg :data)
|
|
(%strategy :accessor strategy :initform :temporary-variable)
|
|
(%varvec-index :accessor varvec-index :initform nil)))
|
|
|
|
(defmethod choose-allocation-strategy ((alc value-allocation))
|
|
(setf
|
|
(strategy alc)
|
|
(let ((data (data alc)))
|
|
(cond ((null (users data))
|
|
:do-not-save)
|
|
((typep data 'ir-constant)
|
|
:constant)
|
|
((typep data 'ir-variable)
|
|
:named-variable)
|
|
((and (eql (next (definition data)) (last-use data))
|
|
(not (typep (last-use data) 'ir-call)))
|
|
:accumulator)
|
|
((and (not (typep data 'ir-reusable))
|
|
(typep (last-use data) 'ir-call)
|
|
(not (calls-exist-between-p (definition data) (last-use data))))
|
|
:direct-to-argvec)
|
|
(t
|
|
:temporary-variable)))))
|
|
|
|
(defun allocate-values (start-iblock)
|
|
(compute-lifetime-knowledge start-iblock)
|
|
(let ((allocations '()))
|
|
(do-iblocks (iblock start-iblock)
|
|
(do-instructions (inst iblock)
|
|
(unless (or (null (output inst))
|
|
(find (output inst) allocations :key #'data))
|
|
(let ((allocation (make-instance 'value-allocation :data (output inst))))
|
|
(choose-allocation-strategy allocation)
|
|
(push allocation allocations)))))
|
|
(setf allocations (nreverse allocations))
|
|
(let ((counter -1)
|
|
(named (remove :named-variable allocations
|
|
:test-not #'eql :key #'strategy))
|
|
(temporary (remove :temporary-variable allocations
|
|
:test-not #'eql :key #'strategy)))
|
|
(loop :for allocation :in (append named temporary)
|
|
:do (setf (varvec-index allocation) (incf counter))))
|
|
(remove-if #'null allocations :key (lambda (a) (users (data a))))))
|
|
|
|
(defun optim-reuse-temporary-slots (start-iblock allocations)
|
|
(let ((free '()))
|
|
(do-iblocks (iblock start-iblock)
|
|
(do-instructions (inst iblock)
|
|
(let ((ending (find inst allocations
|
|
:key (alexandria:compose #'last-use
|
|
#'data)))
|
|
(beginning (find (output inst) allocations :key #'data)))
|
|
(cond ((and ending
|
|
(eql (strategy ending) :temporary-variable)
|
|
(not (null (varvec-index ending))))
|
|
(pushnew (varvec-index ending) free))
|
|
((and beginning
|
|
(eql (strategy beginning) :temporary-variable)
|
|
(not (null (varvec-index beginning)))
|
|
(not (null free)))
|
|
(setf (varvec-index beginning) (pop free)))))))))
|