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

Set up IBLOCK order during building to fix ordering bug

Browse source
This commit is contained in:
John Lorentzson 2025-07-29 18:57:33 +02:00
parent 04df970b3a
commit ab9ff442ef
3 changed files with 3 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
user-side-compiler/interface.lisp
View file

@ -43,7 +43,6 @@
(builder (make-instance 'builder))) (builder (make-instance 'builder)))
(build-begin builder iblock) (build-begin builder iblock)
(compile-node syntax-tree builder) (compile-node syntax-tree builder)
(fix-iblock-flow iblock)
(unless (null (next iblock)) (unless (null (next iblock))
(make-iblock-names-unique (next iblock))) (make-iblock-names-unique (next iblock)))
iblock)) iblock))

4
user-side-compiler/middle/graph-manipulation.lisp
View file

@ -57,7 +57,9 @@
(defun build-begin (builder iblock) (defun build-begin (builder iblock)
"Start BUILDER on a fresh IBLOCK." "Start BUILDER on a fresh IBLOCK."
(when (slot-boundp builder '%iblock) (when (slot-boundp builder '%iblock)
(setf (program iblock) (program (iblock builder)))) (setf (program iblock) (program (iblock builder))
(next (iblock builder)) iblock
(prev iblock) (iblock builder)))
(setf (insertion-point builder) nil (setf (insertion-point builder) nil
(iblock builder) iblock)) (iblock builder) iblock))

29
user-side-compiler/middle/jigs.lisp
View file

@ -53,34 +53,6 @@
(setf (name iblock) (setf (name iblock)
(format nil "~A_1" (name iblock))))))))) (format nil "~A_1" (name iblock)))))))))
(defun fix-iblock-flow (start-iblock)
(let ((reached '())
(last nil)
(deferred '()))
(labels
((fix-deferred ()
(unless (null deferred)
(loop :for after :in (nreverse (pop deferred))
:do (fix after last))))
(fix (iblock prev)
(unless (member iblock reached)
(push iblock reached)
(unless (null prev)
(setf (next prev) iblock))
(setf (prev iblock) prev
last iblock)
(fix-deferred)
(push '() deferred)
(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)))
(,builder (make-instance 'builder))) (,builder (make-instance 'builder)))
@ -90,7 +62,6 @@
,@body) ,@body)
(when ,add-return-p (when ,add-return-p
(build-insert-end (make-instance 'ir-return) ,builder)) (build-insert-end (make-instance 'ir-return) ,builder))
(fix-iblock-flow ,iblock)
(unless (null (next ,iblock)) (unless (null (next ,iblock))
(make-iblock-names-unique (next ,iblock)))))) (make-iblock-names-unique (next ,iblock))))))