64 lines
2.7 KiB
Common Lisp
64 lines
2.7 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(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)))))))))
|
|
|
|
(defun optim-prepare-direct-instructions (iblock)
|
|
(do-instructions (inst iblock)
|
|
(when (typep inst 'ir-operation)
|
|
(assert (= (length (inputs inst)) 2))
|
|
(destructuring-bind (accumulator operand)
|
|
(inputs inst)
|
|
(when (typep (definition accumulator) '(or ir-fetchvar ir-getconst))
|
|
(move-instruction-above (definition accumulator) inst))
|
|
(when (typep (definition operand) '(or ir-fetchvar ir-getconst))
|
|
(when (typep (definition operand) 'ir-fetchvar)
|
|
(setf (inputs inst)
|
|
(substitute (input (definition operand)) operand
|
|
(inputs inst))))
|
|
(delete-instruction (definition operand)))))))
|
|
|
|
(defparameter *operation-routines*
|
|
'((ir-mult . "mult")
|
|
(ir-div . "div")))
|
|
|
|
(defun pre-assembly-software-operations (start-iblock)
|
|
(do-iblocks (ib start-iblock)
|
|
(do-instructions (inst ib)
|
|
(when (member (type-of inst) *operation-routines* :key #'car)
|
|
(let ((inputs (inputs inst))
|
|
(output (output inst))
|
|
(implementation (get-asm-function
|
|
(cdr (assoc (type-of inst)
|
|
*operation-routines*)))))
|
|
(setf (inputs inst) '()
|
|
(output inst) nil)
|
|
(let ((new (make-instance 'ir-call
|
|
:callee implementation
|
|
:inputs inputs :output output)))
|
|
(insert-instruction-above new inst)
|
|
(delete-instruction inst)
|
|
;; To ensure that the code walking continues correctly
|
|
(setf inst new)))))))
|
|
|
|
(defun pre-assembly (iblock)
|
|
(pre-assembly-software-operations iblock)
|
|
(optim-prepare-direct-instructions iblock)
|
|
(let ((allocs (allocate-values iblock)))
|
|
(optim-reuse-temporary-slots iblock allocs)
|
|
allocs))
|