John Lorentzson
a18c13a86e
It's unfinished and doesn't optimize space used by temporary variables. Every temporary gets its own memory slot right now.
61 lines
2.4 KiB
Common Lisp
61 lines
2.4 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))))
|
|
allocations))
|