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).
153 lines
6.8 KiB
Common Lisp
153 lines
6.8 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defun compile-node-dependencies (deps builder)
|
|
(let ((results
|
|
(loop :for dep :in deps
|
|
:collect (compile-node dep builder))))
|
|
(assert (every (lambda (r) (typep r 'ir-data)) results))
|
|
results))
|
|
|
|
(defmethod compile-node ((node reference-variable) builder)
|
|
(let ((input (find-variable node (iblock builder)))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-fetchvar
|
|
:input input
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node token-name) builder)
|
|
(compile-node (transform node 'reference-variable) builder))
|
|
|
|
(defmethod compile-node ((node token-number) builder)
|
|
(let ((output (make-instance 'ir-constant)))
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input (value node)
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-block) builder)
|
|
(dolist (statement (statements node))
|
|
(compile-node statement builder)))
|
|
|
|
(defmethod compile-node ((node node-program) builder)
|
|
(call-next-method)
|
|
(build-insert-end (make-instance 'ir-return) builder))
|
|
|
|
(defmethod compile-node ((node node-call) builder)
|
|
(let* ((inputs (compile-node-dependencies (arguments node) builder))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-call
|
|
:callee (callee node)
|
|
:inputs inputs
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-standard-expr) builder)
|
|
(let* ((inputs (compile-node-dependencies (operands node) builder))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance (get-ir-expr-inst-type node)
|
|
:inputs inputs
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-expr-grouping) builder)
|
|
(compile-node (expression node) builder))
|
|
|
|
(defmethod compile-node ((node node-assignment) builder)
|
|
(let ((input (compile-node (value node) builder))
|
|
(output-var (find-variable (dst-variable node) builder))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-assign :input input :output output-var) builder)
|
|
;; This second instruction is so that we can let an assignment return
|
|
;; the value that was assigned, as in b = a = 1. If the assignment is not
|
|
;; used in this way, dead code elimination will remove this fetch.
|
|
(build-insert (make-instance 'ir-fetchvar :input output-var :output output) builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-conditional) builder)
|
|
(let* ((test-ir (the ir-result (compile-node (test-node node) builder)))
|
|
(else-exists-p (not (null (else-node node))))
|
|
(then-iblock (make-instance 'iblock :name "then"))
|
|
(else-iblock (make-instance 'iblock :name "else"))
|
|
(continuation (if else-exists-p
|
|
(make-instance 'iblock :name "merge")
|
|
else-iblock)))
|
|
(build-insert-end (make-instance
|
|
'ir-if
|
|
:input test-ir
|
|
:destinations (list then-iblock else-iblock))
|
|
builder)
|
|
(build-begin builder then-iblock)
|
|
(compile-node (then-node node) builder)
|
|
(build-insert-end (make-instance 'ir-jump :destinations (list continuation)) builder)
|
|
(when else-exists-p
|
|
(build-begin builder else-iblock)
|
|
(compile-node (else-node node) builder)
|
|
(build-insert-end (make-instance 'ir-jump :destinations (list continuation)) builder))
|
|
(build-begin builder continuation)))
|
|
|
|
(defmethod compile-node ((node node-dotimes) builder)
|
|
(unless (zerop (ref-value (stop-ref node)))
|
|
(let ((const-zero (make-instance 'ir-constant))
|
|
(const-stop (make-instance 'ir-constant))
|
|
(loop-body (make-instance 'iblock :name "loop"))
|
|
(continuation (make-instance 'iblock :name "after_loop"))
|
|
(counter-variable (find-variable (counter-ref node) builder))
|
|
|
|
(test-result (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input 0 :output const-zero)
|
|
builder)
|
|
(build-insert (make-instance 'ir-assign
|
|
:input const-zero
|
|
:output counter-variable)
|
|
builder)
|
|
(build-insert-end (make-instance 'ir-jump :destinations (list loop-body)) builder)
|
|
|
|
(build-begin builder loop-body)
|
|
(compile-node (loopee-node node) builder)
|
|
|
|
;; Increment the counter variable
|
|
(let ((counter-value (make-instance 'ir-result))
|
|
(increment-value (make-instance 'ir-constant))
|
|
(new-counter-value (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-fetchvar
|
|
:input counter-variable
|
|
:output counter-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input 1
|
|
:output increment-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-plus
|
|
:inputs (list counter-value
|
|
increment-value)
|
|
:output new-counter-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-assign
|
|
:input new-counter-value
|
|
:output counter-variable)
|
|
builder))
|
|
;; Check if it's equal to the stop value
|
|
(let ((counter-value (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-fetchvar
|
|
:input counter-variable
|
|
:output counter-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input (ref-value (stop-ref node))
|
|
:output const-stop)
|
|
builder)
|
|
(build-insert (make-instance 'ir-test-equal
|
|
:inputs (list counter-value const-stop)
|
|
:output test-result)
|
|
builder))
|
|
(build-insert-end (make-instance 'ir-if
|
|
:input test-result
|
|
:destinations (list continuation loop-body))
|
|
builder)
|
|
(build-begin builder continuation))))
|