├── README.md └── lisp-riscv-compiler.lisp /README.md: -------------------------------------------------------------------------------- 1 | # Lisp RISC-V Compiler 2 | This is a simple experimental Lisp compiler, written in Lisp, that will compile a Lisp function into RISC-V machine code. 3 | 4 | It is designed for use with my [RISC-V assembler written in Lisp](https://github.com/technoblogy/lisp-riscv-assembler). 5 | 6 | For more information see [A Lisp compiler for RISC-V written in Lisp](http://www.ulisp.com/show?4Y20). 7 | -------------------------------------------------------------------------------- /lisp-riscv-compiler.lisp: -------------------------------------------------------------------------------- 1 | ; Lisp compiler to RISC-V Assembler - Version 1 - 11th October 2024 2 | ; 3 | 4 | #| 5 | Language definition: 6 | 7 | Defining variables and functions: defun, setq 8 | Symbols: nil, t 9 | List functions: car, cdr 10 | Arithmetic functions: +, -, *, /, mod, 1+, 1- 11 | Arithmetic comparisons: =, <, <=, >, >=, /= 12 | Conditionals: if, and, or 13 | |# 14 | 15 | ; Compile a lisp function 16 | 17 | (defun compiler (name) 18 | (if (eq (car (eval name)) 'lambda) 19 | (eval (comp (cons 'defun (cons name (cdr (eval name)))))) 20 | (error "Not a Lisp function"))) 21 | 22 | ; The main compile routine - returns compiled code for x, prefixed by type :integer or :boolean 23 | ; Leaves result in a0 24 | 25 | (defun comp (x &optional env tail) 26 | (cond 27 | ((null x) (type-code :boolean '(($li 'a0 0)))) 28 | ((eq x t) (type-code :boolean '(($li 'a0 1)))) 29 | ((symbolp x) (comp-symbol x env)) 30 | ((atom x) (type-code :integer (list (list '$li ''a0 x)))) 31 | (t (let ((fn (first x)) (args (rest x))) 32 | (case fn 33 | (defun (setq *label-num* 0) 34 | (setq env (mapcar #'(lambda (x y) (cons x y)) (second args) *locals*)) 35 | (comp-defun (first args) (second args) (cddr args) env)) 36 | (progn (comp-progn args env tail)) 37 | (if (comp-if (first args) (second args) (third args) env tail)) 38 | (setq (comp-setq args env tail)) 39 | (t (comp-funcall fn args env tail))))))) 40 | 41 | ; Utilities 42 | 43 | (defun push-regs (&rest regs) 44 | (let ((n -4)) 45 | (append 46 | (list (list '$addi ''sp ''sp (* -4 (length regs)))) 47 | (mapcar #'(lambda (reg) (list '$sw (list 'quote reg) (incf n 4) ''(sp))) regs)))) 48 | 49 | (defun pop-regs (&rest regs) 50 | (let ((n (* 4 (length regs)))) 51 | (append 52 | (mapcar #'(lambda (reg) (list '$lw (list 'quote reg) (decf n 4) ''(sp))) regs) 53 | (list (list '$addi ''sp ''sp (* 4 (length regs))))))) 54 | 55 | ; Like mapcon but not destructive 56 | 57 | (defun mappend (fn lst) 58 | (apply #'append (mapcar fn lst))) 59 | 60 | ; The type is prefixed onto the list of assembler code instructions 61 | 62 | (defun type-code (type code) (cons type code)) 63 | 64 | (defun code-type (type-code) (car type-code)) 65 | 66 | (defun code (type-code) (cdr type-code)) 67 | 68 | (defun checktype (fn type check) 69 | (unless (or (null type) (null check) (eq type check)) 70 | (error "Argument to '~a' must be ~a not ~a" fn check type))) 71 | 72 | ; Allocate registers - s0, s1, and a0 to a5 give compact instructions 73 | 74 | (defvar *params* '(a0 a1 a2 a3)) 75 | 76 | (defvar *locals* '(a4 a5 s0 s1 a6 a7 s2 s3 s4 s5 s6 s7 s8 s9 s10 s11)) 77 | 78 | (defvar *used-params* nil) 79 | 80 | ; Generate a label 81 | 82 | (defvar *label-num* 0) 83 | 84 | (defun gen-label () 85 | (read-from-string (format nil "lab~d" (incf *label-num*)))) 86 | 87 | ; Subfunctions 88 | 89 | (defun comp-symbol (x env) 90 | (let ((reg (cdr (assoc x env)))) 91 | (type-code nil (list (list '$mv ''a0 (list 'quote reg)))))) 92 | 93 | (defun comp-setq (args env tail) 94 | (let ((value (comp (second args) env tail)) 95 | (reg (cdr (assoc (first args) env)))) 96 | (type-code 97 | (code-type value) 98 | (append (code value) (list (list '$mv (list 'quote reg) ''a0)))))) 99 | 100 | (defun comp-defun (name args body env) 101 | (setq *used-params* (subseq *locals* 0 (length args))) 102 | (append 103 | (list 'defcode name args) 104 | (list name) 105 | (apply #'append 106 | (mapcar #'(lambda (x y) (list (list '$mv (list 'quote x) (list 'quote y)))) 107 | *used-params* *params*)) 108 | (code (comp-progn body env t)))) 109 | 110 | (defun comp-progn (exps env tail) 111 | (let* ((len (1- (length exps))) 112 | (nlast (subseq exps 0 len)) 113 | (last1 (nth len exps)) 114 | (start (mappend #'(lambda (x) (append (code (comp x env t)))) nlast)) 115 | (end (comp last1 env tail))) 116 | (type-code (code-type end) (append start (code end))))) 117 | 118 | (defun comp-if (pred then else env tail) 119 | (let ((lab1 (gen-label)) 120 | (lab2 (gen-label)) 121 | (test (comp pred env nil))) 122 | (checktype 'if (car test) :boolean) 123 | (type-code :integer 124 | (append 125 | (code test) (list (list '$beqz ''a0 lab1)) 126 | (code (comp then env t)) (list (list '$j lab2) lab1) 127 | (code (comp else env tail)) (list lab2) 128 | (when tail '(($ret))))))) 129 | 130 | (defun $sgt (rd rs1 rs2) 131 | ($slt rd rs2 rs1)) 132 | 133 | (defun comp-funcall (f args env tail) 134 | (let ((test (assoc f '((< . $slt) (> . $sgt)))) 135 | (teste (assoc f '((= . $seqz) (/= . $snez)))) 136 | (testn (assoc f '((>= . $slt) (<= . $sgt)))) 137 | (logical (assoc f '((and . $and) (or . $or)))) 138 | (arith1 (assoc f '((1+ . 1) (1- . -1)))) 139 | (arith (assoc f '((+ . $add) (- . $sub) (* . $mul) (/ . $div) (mod . $rem))))) 140 | (cond 141 | ((or test teste testn) 142 | (type-code :boolean 143 | (append 144 | (comp-args f args 2 :integer env) 145 | (pop-regs 'a1) 146 | (cond 147 | (test (list (list (cdr test) ''a0 ''a1 ''a0))) 148 | (teste (list '($sub 'a0 'a1 'a0) (list (cdr teste) ''a0 ''a0))) 149 | (testn (list (list (cdr testn) ''a0 ''a1 ''a0) '($xori 'a0 'a0 1)))) 150 | (when tail '(($ret)))))) 151 | (logical 152 | (type-code :boolean 153 | (append 154 | (comp-args f args 2 :boolean env) 155 | (pop-regs 'a1) 156 | (list (list (cdr logical) ''a0 ''a0 ''a1)) 157 | (when tail '(($ret)))))) 158 | (arith1 159 | (type-code :integer 160 | (append 161 | (comp-args f args 1 :integer env) 162 | (list (list '$addi ''a0 ''a0 (cdr arith1))) 163 | (when tail '(($ret)))))) 164 | (arith 165 | (type-code :integer 166 | (append 167 | (comp-args f args 2 :integer env) 168 | (pop-regs 'a1) 169 | (list (list (cdr arith) ''a0 ''a1 ''a0)) 170 | (when tail '(($ret)))))) 171 | ((member f '(car cdr)) 172 | (type-code :integer 173 | (append 174 | (comp-args f args 1 :integer env) 175 | (if (eq f 'cdr) (list '($lw 'a0 4 '(a0))) 176 | (list '($lw 'a0 0 '(a0)) '($lw 'a0 4 '(a0)))) 177 | (when tail '(($ret)))))) 178 | (t ; function call 179 | (type-code :integer 180 | (append 181 | (comp-args f args nil :integer env) 182 | (when (> (length args) 1) 183 | (append 184 | (list (list '$mv (list 'quote (nth (1- (length args)) *params*)) ''a0)) 185 | (apply #'pop-regs (subseq *params* 0 (1- (length args)))))) 186 | (cond 187 | (tail (list (list '$j f))) 188 | (t (append 189 | (apply #'push-regs (cons 'ra (reverse *used-params*))) 190 | (list (list '$jal f)) 191 | (apply 'pop-regs (append *used-params* (list 'ra)))))))))))) 192 | 193 | (defun comp-args (fn args n type env) 194 | (unless (or (null n) (= (length args) n)) 195 | (error "Incorrect number of arguments to '~a'" fn)) 196 | (let ((n (length args))) 197 | (mappend #'(lambda (y) 198 | (let ((c (comp y env nil))) 199 | (decf n) 200 | (checktype fn type (code-type c)) 201 | (if (zerop n) (code c) (append (code c) (push-regs 'a0))))) 202 | args))) 203 | --------------------------------------------------------------------------------