The compiler middle stage takes high level nodes and produces code in an intermediate representation more closely resembling assembly code. Optimizations and the tools for making those are also included. It's significantly easier to optimize IR than syntax trees or assembly. Several things need cleaning up, in particular there are things in jigs.lisp that really should be documented tools, not jigs (specifically the compilation setup and finalization).
86 lines
2.7 KiB
Common Lisp
86 lines
2.7 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
;;; Printing
|
|
|
|
(defmethod print-ir-inst (inst)
|
|
(cond ((and (listp (inputs inst))
|
|
(not (null (output inst))))
|
|
(format t " ~A ~A -> ~A~%" (class-name (class-of inst))
|
|
(inputs inst) (output inst)))
|
|
(t
|
|
(format t " ~A~%" (class-name (class-of inst))))))
|
|
|
|
(defmethod print-ir-inst ((inst ir-assign))
|
|
(format t " ASSIGN ~A -> ~A~%" (input inst) (output inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-test-equal))
|
|
(format t " ~A == ~A -> ~A~%" (first (inputs inst)) (second (inputs inst))
|
|
(output inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-call))
|
|
(format t " IR-CALL ~A ~A -> ~A~%" (callee inst) (inputs inst) (output inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-if))
|
|
(format t " ~A ~A ~A~%" (class-name (class-of inst))
|
|
(first (inputs inst)) (destinations inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-terminator))
|
|
(format t " ~A ~A~%" (class-name (class-of inst)) (destinations inst)))
|
|
|
|
(defun print-iblock (iblock)
|
|
(format t "~A:~%" (name iblock))
|
|
(loop :for inst := (start iblock) :then (next inst)
|
|
:do (print-ir-inst inst)
|
|
:until (eql inst (end iblock))))
|
|
|
|
(defun print-iblocks (start-iblock)
|
|
(loop :for iblock := start-iblock :then (next iblock)
|
|
:until (null iblock)
|
|
:do (print-iblock iblock)))
|
|
|
|
;;; Compilation setup
|
|
|
|
(defun fix-iblock-flow (iblock)
|
|
(let ((reached '()))
|
|
(labels
|
|
((fix (iblock prev)
|
|
(unless (member iblock reached)
|
|
(push iblock reached)
|
|
(setf (next iblock)
|
|
(first (successors iblock))
|
|
(prev iblock) prev)
|
|
(loop :for prev := iblock :then s
|
|
:for s :in (successors iblock)
|
|
:do (fix s prev)))))
|
|
(fix iblock nil))))
|
|
|
|
(defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body)
|
|
`(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program)))
|
|
(,builder (make-instance 'builder)))
|
|
(build-begin ,builder ,iblock)
|
|
(prog1
|
|
(progn
|
|
,@body)
|
|
(when ,add-return-p
|
|
(build-insert-end (make-instance 'ir-return) ,builder))
|
|
(fix-iblock-flow ,iblock))))
|
|
|
|
;;; Some quick example code
|
|
|
|
#+(or)
|
|
(with-input-from-string (source-stream "for x do 12 times
|
|
if x == 5 then
|
|
pixeldraw(x, x)
|
|
pixeldraw(x, sqrt(5))
|
|
pixeldraw(0, 0)
|
|
end
|
|
end")
|
|
(let ((*token-stream* (make-token-stream (tokenize source-stream))))
|
|
(let ((rb (with-compilation-setup (root-block builder)
|
|
(compile-node (match-syntax program) builder)
|
|
root-block)))
|
|
(do-iblocks (ib rb)
|
|
(optim-call-duplicate-args ib)
|
|
(optim-remove-unused ib))
|
|
(print-iblocks rb)
|
|
rb)))
|