John Lorentzson
9e643e6c6d
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).
110 lines
4.3 KiB
Common Lisp
110 lines
4.3 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defclass ir-inst ()
|
|
((%next :accessor next :initarg :successor)
|
|
(%previous :accessor previous :initarg :predecessor)
|
|
(%inputs :accessor inputs :initarg :inputs :initform '())
|
|
(%output :accessor output :initarg :output :initform nil)
|
|
(%iblock :accessor iblock :initarg :iblock)
|
|
(%source :accessor source :initarg :source)))
|
|
|
|
(defmethod effect-used-p ((inst ir-inst))
|
|
nil)
|
|
|
|
(defmethod (setf inputs) ((new-value list) (object ir-inst))
|
|
(when (slot-boundp object '%inputs)
|
|
(mapc (lambda (i) (remove-user i object)) (inputs object)))
|
|
(dolist (data new-value)
|
|
(add-user data object))
|
|
(setf (slot-value object '%inputs) new-value))
|
|
|
|
(defmethod shared-initialize :before
|
|
((instance ir-inst) slot-names &rest initargs
|
|
&key (inputs nil inputsp) (input nil inputp) (output nil outputp)
|
|
&allow-other-keys)
|
|
(declare (ignore slot-names initargs))
|
|
(when outputp
|
|
(when (slot-boundp instance '%output)
|
|
(setf (definition (output instance)) nil))
|
|
(setf (output instance) output
|
|
(definition output) instance))
|
|
(assert (not (and inputsp inputp))) ; cannot give both singular and plural
|
|
(when inputsp
|
|
(setf (inputs instance) inputs))
|
|
(when inputp
|
|
(setf (inputs instance) (list input))))
|
|
|
|
(defclass ir-one-input (ir-inst)
|
|
((%inputs :type (or null (cons t null))))
|
|
(:documentation "Mixin for instructions that may take only one input."))
|
|
|
|
(defclass ir-effect-use (ir-inst) ()
|
|
(:documentation "An instruction used at least in part for its side-effects. May not be deleted
|
|
solely due to its output being unused."))
|
|
|
|
(defmethod effect-used-p ((inst ir-effect-use))
|
|
t)
|
|
|
|
(defclass ir-no-output (ir-effect-use)
|
|
((%output :accessor output :type null :initform nil))
|
|
(:documentation "Mixin forbidding an instruction from having an output."))
|
|
|
|
(defmethod input ((inst ir-one-input))
|
|
(first (inputs inst)))
|
|
|
|
(defclass ir-terminator (ir-inst)
|
|
((%destinations :accessor destinations :initarg :destinations)
|
|
(%next :initform nil :type null))
|
|
(:documentation "An instruction that ends a basic block."))
|
|
|
|
(defclass ir-return (ir-terminator)
|
|
((%destinations :initform nil :type null)))
|
|
|
|
(defclass ir-if (ir-terminator ir-one-input) ())
|
|
(defclass ir-jump (ir-terminator) ())
|
|
|
|
(defclass ir-getconst (ir-one-input ir-inst)
|
|
((%inputs :type (or null (cons fixnum null)))))
|
|
|
|
(tlk:define-simple-print-object (ir-getconst %inputs) :format-string "~{~A~}")
|
|
|
|
(defmethod shared-initialize :after ((instance ir-getconst) slot-names &rest initargs
|
|
&key &allow-other-keys)
|
|
(declare (ignore slot-names initargs))
|
|
(unless (null (output instance))
|
|
(check-type (output instance) ir-constant)
|
|
(setf (value (output instance))
|
|
(input instance))))
|
|
|
|
(defclass ir-fetchvar (ir-one-input ir-inst) ())
|
|
(defclass ir-assign (ir-one-input ir-inst) ())
|
|
|
|
(defclass ir-operation (ir-inst) ())
|
|
|
|
(defclass ir-call (ir-operation)
|
|
((%callee :accessor callee :initarg :callee)))
|
|
|
|
(defmethod effect-used-p ((inst ir-call))
|
|
;; TODO: Return the non-pureness of the callee
|
|
t)
|
|
|
|
;;; A messy but quick way to define all the very similar arithmetic operations
|
|
(macrolet ((ops ((&rest superclasses) &rest classes)
|
|
`(progn
|
|
,@(loop :for (class-name ignore symbol) :in classes
|
|
:collect `(progn
|
|
(defclass ,class-name ,superclasses ())
|
|
(defmethod print-ir-inst ((inst ,class-name))
|
|
(format t " (~A~{ ~A~}) -> ~A~%"
|
|
,symbol (inputs inst) (output inst)))))
|
|
(defun get-ir-expr-inst-type (node)
|
|
(typecase node
|
|
,@(loop :for (ir-class node-class ignore) :in classes
|
|
:unless (null node-class)
|
|
:collect `(,node-class ',ir-class)))))))
|
|
(ops (ir-operation) ; NILs indicate TODOs here for now
|
|
(ir-test-equal node-expr-test-equal "==")
|
|
(ir-test-not-equal node-expr-test-not-equal "!=")
|
|
(ir-test-less nil "<") (ir-test-greater nil ">")
|
|
(ir-test-less-or-equal nil "<=") (ir-test-greater-or-equal nil ">=")
|
|
(ir-plus node-expr-plus "+") (ir-minus node-expr-minus "-") (ir-mult node-expr-multiply "*") (ir-div node-expr-divide "/")))
|