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

Fix broken IR graph flow with merge iblocks

Browse source
This commit is contained in:
John Lorentzson 2025-07-03 15:58:56 +02:00
parent 235ca8c07e
commit 7171398c07
3 changed files with 27 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
wip-duuqnd/user-side-compiler/middle/compile-node-to-ir.lisp
View file

@ -74,7 +74,7 @@
(then-iblock (make-instance 'iblock :name "then")) (then-iblock (make-instance 'iblock :name "then"))
(else-iblock (make-instance 'iblock :name "else")) (else-iblock (make-instance 'iblock :name "else"))
(continuation (if else-exists-p (continuation (if else-exists-p
(make-instance 'iblock :name "merge") (make-instance 'iblock-merge :name "merge")
else-iblock))) else-iblock)))
(build-insert-end (make-instance (build-insert-end (make-instance
'ir-if 'ir-if

34
wip-duuqnd/user-side-compiler/middle/jigs.lisp
View file

@ -40,19 +40,33 @@
;;; Compilation setup ;;; Compilation setup
(defun fix-iblock-flow (iblock) (defun fix-iblock-flow (start-iblock)
(let ((reached '())) (let ((reached '())
(last nil)
(deferred '()))
(labels (labels
((fix (iblock prev) ((fix-deferred ()
(unless (null deferred)
(loop :for after :in (nreverse (pop deferred))
:do (fix after last))))
(fix (iblock prev)
(unless (member iblock reached) (unless (member iblock reached)
(push iblock reached) (push iblock reached)
(setf (next iblock) (unless (null prev)
(first (successors iblock)) (setf (next prev) iblock))
(prev iblock) prev) (setf (prev iblock) prev
(loop :for prev := iblock :then s last iblock)
:for s :in (successors iblock) (fix-deferred)
:do (fix s prev))))) (push '() deferred)
(fix iblock nil)))) (loop :for s :in (successors iblock)
:if (typep s 'iblock-merge)
:do (pushnew s (car deferred))
:else
:do (fix s last))
(when (null prev)
(loop :until (null deferred)
:do (fix-deferred))))))
(fix start-iblock nil))))
(defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body) (defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body)
`(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program))) `(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program)))

2
wip-duuqnd/user-side-compiler/middle/structure.lisp
View file

@ -12,6 +12,8 @@
(%prev :accessor prev :type (or null iblock) :initform nil) (%prev :accessor prev :type (or null iblock) :initform nil)
(%name :accessor name :initarg :name :initform nil))) (%name :accessor name :initarg :name :initform nil)))
(defclass iblock-merge (iblock) ())
(defmethod find-variable (reference (search-from ir-program)) (defmethod find-variable (reference (search-from ir-program))
(multiple-value-bind (var existsp) (multiple-value-bind (var existsp)
(gethash reference (variables search-from)) (gethash reference (variables search-from))