Stacken/c64-livecoding
6
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Add pre-assembly.lisp, which handles transformations needed for asm

Browse source
This commit is contained in:
John Lorentzson 2025-07-09 15:15:57 +02:00
parent 36b28f5b8b
commit 0f0ba054be
3 changed files with 66 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
wip-duuqnd/user-side-compiler/backend/pre-assembly.lisp Normal file
View file

@ -0,0 +1,64 @@
(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))

33
wip-duuqnd/user-side-compiler/backend/value-allocator.lisp
View file

@ -27,21 +27,6 @@
(%strategy :accessor strategy :initform :temporary-variable)
(%varvec-index :accessor varvec-index :initform nil)))
(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)))))))
(defmethod choose-allocation-strategy ((alc value-allocation))
(setf
(strategy alc)
@ -91,21 +76,3 @@
(loop :for allocation :in (append named temporary)
:do (setf (varvec-index allocation) (incf counter))))
allocations))
(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)))))))))

3
wip-duuqnd/user-side-compiler/user-side-compiler.asd
View file

@ -2,7 +2,7 @@
(defsystem #:user-side-compiler
:serial t
:depends-on (#:closer-mop #:alexandria)
:depends-on (#:closer-mop #:alexandria #:trivial-backtrace)
:components
((:file "package")
(:file "error-handling")
@ -35,4 +35,5 @@
:depends-on ("middle")
:serial t
:components ((:file "value-allocator")
(:file "pre-assembly")
(:file "code-generator")))))