396 lines
10 KiB
Common Lisp
396 lines
10 KiB
Common Lisp
; RISC-V Assembler - Version 4 - 18th October 2024
|
|
; see http://www.ulisp.com/show?310Z
|
|
;
|
|
|
|
; Extract register number
|
|
(defun regno (sym)
|
|
(case sym (zero 0) (ra 1) (sp 2) (gp 3) (tp 4) ((s0 fp) 8) (s1 9)
|
|
(t (let* ((s (string sym))
|
|
(c (char s 0))
|
|
(n (read-from-string (subseq s 1))))
|
|
(case c (#\x n) (#\a (+ n 10)) (#\s (+ n 16)) (#\t (if (<= n 2) (+ n 5) (+ n 25))))))))
|
|
|
|
; Short 3-bit register s0, s1, a0 to a5
|
|
(defun cregp (rd) (<= 8 (regno rd) 15))
|
|
|
|
(defun cregno (sym) (logand (regno sym) #x7))
|
|
|
|
; Pack arguments into bit fields
|
|
(defun emit (bits &rest args)
|
|
(let ((word 0))
|
|
(mapc #'(lambda (width value)
|
|
(unless (zerop (ash value (- width))) (error* "Won't fit"))
|
|
(setq word (logior (ash word width) value)))
|
|
bits args)
|
|
word))
|
|
|
|
; 32-bit emit
|
|
(defun emit32 (bits &rest args)
|
|
(let ((word (apply #'emit bits args)))
|
|
(list (logand word #xffff) (logand (ash word -16) #xffff))))
|
|
|
|
; Errors
|
|
(defun error* (txt) (format t "(pc=#x~x) ~a~%" *pc* txt))
|
|
|
|
; Test range of immediate signed values
|
|
(defun immp (x b)
|
|
(<= (- (ash 1 (1- b))) x (1- (ash 1 (1- b)))))
|
|
|
|
; Extract bitfield
|
|
(defun bits (x a &optional b)
|
|
(if b (logand (ash x (- b)) (1- (ash 1 (- a b -1))))
|
|
(logand (ash x (- a)) 1)))
|
|
|
|
(defun offset (label) (- label *pc*))
|
|
|
|
; Instruction formats
|
|
|
|
(defun reg (funct7 rs2 rs1 funct3 rd op)
|
|
(emit32 '(7 5 5 3 5 7) funct7 (regno rs2) (regno rs1) funct3 (regno rd) op))
|
|
|
|
(defun creg (op3 op1 op2 rd op2b rs2)
|
|
(cond
|
|
((and (cregp rd) (cregp rs2))
|
|
(emit '(3 1 2 3 2 3 2) op3 op1 op2 (cregno rd) op2b (cregno rs2) 1))
|
|
(t (error* "C won't fit"))))
|
|
|
|
(defun immed (imm12 rs1 funct3 rd op)
|
|
(cond
|
|
((immp imm12 12)
|
|
(emit32 '(12 5 3 5 7) (logand imm12 #xfff) (regno rs1) funct3 (regno rd) op))
|
|
(t
|
|
(error* "Immediate value out of range"))))
|
|
|
|
(defun cimmed (imm12 rs1 funct3 rd op)
|
|
(emit32 '(12 5 3 5 7) imm12 (regno rs1) funct3 (regno rd) op))
|
|
|
|
(defun branch (imm12 rs2 rs1 funct3 funct7)
|
|
(let ((off (offset imm12)))
|
|
(emit32 '(1 6 5 5 3 4 1 7)
|
|
(bits off 12) (bits off 10 5) (regno rs2)
|
|
(regno rs1) funct3 (bits off 4 1) (bits off 11) funct7)))
|
|
|
|
(defun jump (imm20 imm10-1 imm11 imm19-12 rd op)
|
|
(emit32 '(1 10 1 8 5 7) imm20 imm10-1 imm11 imm19-12 rd op))
|
|
|
|
(defun muldiv (rs2 rs1 funct3 rd funct7)
|
|
(emit32 '(7 5 5 3 5 7) 1 (regno rs2) (regno rs1) funct3 (regno rd) funct7))
|
|
|
|
(defun store (imm src base op)
|
|
(emit32 '(7 5 5 3 5 7) (bits imm 11 5) (regno src) (regno base) op (bits imm 4 0) #x23))
|
|
|
|
(defun cimm6 (rd imm op1 op2)
|
|
(emit '(3 1 5 5 2) op1 (bits imm 5) (regno rd) (bits imm 4 0) op2))
|
|
|
|
(defun cimm6* (rd imm op1 op2 op3)
|
|
(emit '(3 1 2 3 5 2) op1 (bits imm 5) op2 (cregno rd) (bits imm 4 0) op3))
|
|
|
|
;
|
|
; Alphabetical list of mnemonics
|
|
;
|
|
|
|
(defun $add (rd rs1 rs2)
|
|
(cond
|
|
((eq rd rs1)
|
|
(emit '(3 1 5 5 2) 4 1 (regno rd) (regno rs2) 2))
|
|
(t (reg 0 rs2 rs1 0 rd #x33))))
|
|
|
|
(defun $addi (rd rs1 imm)
|
|
(cond
|
|
((and (eq rd rs1) (immp imm 6))
|
|
(cimm6 rd imm 0 1))
|
|
((and (= (regno rd) 2) (= (regno rs1) 2) (immp imm 10))
|
|
(emit '(3 1 5 1 1 2 1 2) 3 (bits imm 9) 2 (bits imm 4) (bits imm 6) (bits imm 8 7) (bits imm 5) 1))
|
|
(t (immed imm rs1 0 rd #x13))))
|
|
|
|
(defun $and (rd rs1 rs2)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd) (cregp rs2))
|
|
(creg 4 0 3 rd 3 rs2))
|
|
(t (reg 0 rs2 rs1 7 rd #x33))))
|
|
|
|
(defun $andi (rd rs1 imm)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd) (immp imm 5))
|
|
(cimm6* rd imm 4 2 1))
|
|
(t (immed imm rs1 7 rd #x13))))
|
|
|
|
(defun $auipc (rd imm)
|
|
(cond
|
|
((zerop (logand imm #xfff))
|
|
(emit32 '(20 5 7) (bits imm 31 12) (regno rd) #x17))
|
|
(t (error* "auipc no good"))))
|
|
|
|
(defun $beq (rs1 rs2 imm12)
|
|
(branch imm12 rs2 rs1 0 #x63))
|
|
|
|
(defun $beqz (rs imm)
|
|
(let ((off (offset imm)))
|
|
(cond
|
|
((and (immp off 8) (cregp rs))
|
|
(emit '(3 1 2 3 2 2 1 2) 6 (bits off 8) (bits off 4 3)
|
|
(cregno rs) (bits off 7 6) (bits off 2 1) (bits off 5) 1))
|
|
(t ($beq rs 'x0 imm)))))
|
|
|
|
(defun $bge (rs1 rs2 imm12)
|
|
(branch imm12 rs2 rs1 5 #x63))
|
|
|
|
(defun $bgeu (rs1 rs2 imm12)
|
|
(branch imm12 rs2 rs1 7 #x63))
|
|
|
|
(defun $bgez (rs1 imm12)
|
|
($bge rs1 'x0 imm12))
|
|
|
|
(defun $bgt (rs1 rs2 imm12)
|
|
($blt rs2 rs1 imm12))
|
|
|
|
(defun $bgtu (rs1 rs2 imm12)
|
|
($bltu rs2 rs1 imm12))
|
|
|
|
(defun $bgtz (rs1 imm12)
|
|
($blt 'x0 rs1 imm12))
|
|
|
|
(defun $ble (rs1 rs2 imm12)
|
|
($bge rs2 rs1 imm12))
|
|
|
|
(defun $bleu (rs1 rs2 imm12)
|
|
($bgeu rs2 rs1 imm12))
|
|
|
|
(defun $blez (rs2 imm12)
|
|
($bge 'x0 rs2 imm12))
|
|
|
|
(defun $blt (rs1 rs2 imm12)
|
|
(branch imm12 rs2 rs1 4 #x63))
|
|
|
|
(defun $bltu (rs1 rs2 imm12)
|
|
(branch imm12 rs2 rs1 6 #x63))
|
|
|
|
(defun $bltz (rs1 imm12)
|
|
($blt rs1 'x0 imm12))
|
|
|
|
(defun $bne (rs1 rs2 imm12)
|
|
(branch imm12 rs2 rs1 1 #x63))
|
|
|
|
(defun $bnez (rs imm)
|
|
(let ((off (offset imm)))
|
|
(cond
|
|
((and (immp off 8) (cregp rs))
|
|
(emit '(3 1 2 3 2 2 1 2) 7 (bits off 8) (bits off 4 3)
|
|
(cregno rs) (bits off 7 6) (bits off 2 1) (bits off 5) 1))
|
|
(t ($bne rs 'x0 imm)))))
|
|
|
|
(defun $div (rd rs1 rs2)
|
|
(muldiv rs2 rs1 4 rd #x33))
|
|
|
|
(defun $divu (rd rs1 rs2)
|
|
(muldiv rs2 rs1 5 rd #x33))
|
|
|
|
(defun $divw (rd rs1 rs2)
|
|
(muldiv rs2 rs1 4 rd #x3b))
|
|
|
|
(defun $divuw (rd rs1 rs2)
|
|
(muldiv rs2 rs1 5 rd #x3b))
|
|
|
|
(defun $fence () (emit32 '(16 16) #x0ff0 #x000f))
|
|
|
|
(defun $j (label)
|
|
(let ((off (offset label)))
|
|
(emit '(3 1 1 2 1 1 1 3 1 2) 5 (bits off 11) (bits off 4) (bits off 9 8)
|
|
(bits off 10) (bits off 6) (bits off 7) (bits off 3 1) (bits off 5) 1)))
|
|
|
|
; C.JAL is RV32 only
|
|
(defun $jal (rd &optional label)
|
|
(when (null label) (setq label rd rd 'ra))
|
|
(let ((off (offset label)))
|
|
(emit32 '(1 10 1 8 5 7) (bits off 20) (bits off 10 1) (bits off 11) (bits off 19 12) (regno rd) #x6f)))
|
|
|
|
(defun $jalr (label lst)
|
|
(let ((off (+ (offset label) 4)))
|
|
(emit32 '(12 5 3 5 7) (bits off 11 0) (regno (car lst)) 0 (regno (car lst)) #x67)))
|
|
|
|
(defun $jr (rs1)
|
|
(emit '(3 1 5 5 2) 4 0 (regno rs1) 0 2))
|
|
|
|
; In next four, imm can be omitted and defaults to 0
|
|
(defun $lb (rd imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(immed imm (car lst) 0 rd 3))
|
|
|
|
(defun $lbu (rd imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(immed imm (car lst) 4 rd 3))
|
|
|
|
(defun $lh (rd imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(immed imm (car lst) 1 rd 3))
|
|
|
|
(defun $lhu (rd imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(immed imm (car lst) 5 rd 3))
|
|
|
|
; li pseudoinstruction - will load 32-bit immediates
|
|
(defun $li (rd imm)
|
|
(cond
|
|
((immp imm 6) ; 16 bit
|
|
(cimm6 rd imm 2 1))
|
|
((immp imm 12) ; 32 bit
|
|
($addi rd 'x0 imm))
|
|
(t (let ((imm12 (logand imm #x00000fff)) ; 64 bit
|
|
(imm20 (logand (ash imm -12) #xfffff)))
|
|
(append
|
|
($lui rd (if (= (logand imm12 #x800) #x800) (+ imm20 #x1000) imm20))
|
|
; $addi
|
|
(emit32 '(12 5 3 5 7) imm12 (regno rd) 0 (regno rd) #x13))))))
|
|
|
|
(defun $lui (rd imm)
|
|
(cond
|
|
((and (immp imm 6) (/= imm 0) (/= (regno rd) 0) (/= (regno rd) 2)) ; 16 bit
|
|
(cimm6 rd imm 3 1))
|
|
(t
|
|
(emit32 '(20 5 7) imm (regno rd) #x37))
|
|
(t (error* "lui no good"))))
|
|
|
|
(defun $lw (rd imm lst)
|
|
(cond
|
|
((listp lst)
|
|
(let ((base (car lst)))
|
|
(cond
|
|
; rs1 = sp
|
|
((and (= (regno base) 2))
|
|
(emit '(3 1 5 3 2 2) 2 (bits imm 5) (regno rd) (bits imm 4 2) (bits imm 7 6) 2))
|
|
; rs1 = general
|
|
((and (cregp rd) (cregp base))
|
|
(emit '(3 3 3 1 1 3 2) 2 (bits imm 5 3) (cregno base) (bits imm 2) (bits imm 6) (cregno rd) 0))
|
|
(t (immed imm base 2 rd 3)))))
|
|
(t (error* "Illegal 3rd arg"))))
|
|
|
|
(defun $mul (rd rs1 rs2)
|
|
(muldiv rs2 rs1 0 rd #x33))
|
|
|
|
(defun $mulh (rd rs1 rs2)
|
|
(muldiv rs2 rs1 1 rd #x33))
|
|
|
|
(defun $mulhsu (rd rs1 rs2)
|
|
(muldiv rs2 rs1 2 rd #x33))
|
|
|
|
(defun $mulhu (rd rs1 rs2)
|
|
(muldiv rs2 rs1 3 rd #x33))
|
|
|
|
(defun $mv (rd rs1)
|
|
(emit '(3 1 5 5 2) 4 0 (regno rd) (regno rs1) 2))
|
|
|
|
(defun $neg (rd rs2)
|
|
($sub rd 'x0 rs2))
|
|
|
|
(defun $nop ()
|
|
($addi 'x0 'x0 0))
|
|
|
|
(defun $not (rd rs1)
|
|
($xori rd rs1 -1))
|
|
|
|
(defun $or (rd rs1 rs2)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd) (cregp rs2))
|
|
(creg 4 0 3 rd 2 rs2))
|
|
(t (reg 0 rs2 rs1 6 rd #x33))))
|
|
|
|
(defun $ori (rd rs1 imm)
|
|
(immed imm rs1 6 rd #x13))
|
|
|
|
(defun $rem (rd rs1 rs2)
|
|
(muldiv rs2 rs1 6 rd #x33))
|
|
|
|
(defun $remu (rd rs1 rs2)
|
|
(muldiv rs2 rs1 7 rd #x33))
|
|
|
|
(defun $ret ()
|
|
($jr 'ra))
|
|
|
|
; In $sb, $sh, and $sw, imm can be omitted and defaults to 0
|
|
(defun $sb (src imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(store imm src (car lst) 0))
|
|
|
|
(defun $seqz (rd rs1)
|
|
($sltiu rd rs1 1))
|
|
|
|
(defun $sgtz (rd rs2)
|
|
($slt rd 'x0 rs2))
|
|
|
|
(defun $sh (src imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(store imm src (car lst) 1))
|
|
|
|
(defun $sll (rd rs1 rs2)
|
|
(reg 0 rs2 rs1 1 rd #x33))
|
|
|
|
(defun $slli (rd rs1 imm)
|
|
(cond
|
|
((and (eq rd rs1))
|
|
(cimm6 rd imm 0 2))
|
|
(t (emit32 '(6 6 5 3 5 7) 0 imm (regno rs1) 1 (regno rd) #x13))))
|
|
|
|
(defun $slt (rd rs1 rs2)
|
|
(reg 0 rs2 rs1 2 rd #x33))
|
|
|
|
(defun $slti (rd rs1 imm)
|
|
(immed imm rs1 2 rd #x13))
|
|
|
|
(defun $sltiu (rd rs1 imm)
|
|
(immed imm rs1 3 rd #x13))
|
|
|
|
(defun $sltu (rd rs1 rs2)
|
|
(reg 0 rs2 rs1 3 rd #x33))
|
|
|
|
(defun $sltz (rd rs1)
|
|
($slt rd rs1 'x0))
|
|
|
|
(defun $snez (rd rs2)
|
|
($sltu rd 'x0 rs2))
|
|
|
|
(defun $sra (rd rs1 rs2)
|
|
(reg #x20 rs2 rs1 2 rd #x33))
|
|
|
|
(defun $srai (rd rs1 imm)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd))
|
|
(cimm6* rd imm 4 1 1))
|
|
(t (emit32 '(6 6 5 3 5 7) #x10 imm (regno rs1) 5 (regno rd) #x13))))
|
|
|
|
(defun $srl (rd rs1 rs2)
|
|
(reg 0 rs2 rs1 5 rd #x33))
|
|
|
|
(defun $srli (rd rs1 imm)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd))
|
|
(cimm6* rd imm 4 0 1))
|
|
(t (emit32 '(6 6 5 3 5 7) 0 imm (regno rs1) 5 (regno rd) #x13))))
|
|
|
|
(defun $sub (rd rs1 rs2)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd) (cregp rs2))
|
|
(creg 4 0 3 rd 0 rs2))
|
|
(t (reg #x20 rs2 rs1 0 rd #x33))))
|
|
|
|
(defun $sw (src imm &optional lst)
|
|
(unless lst (setq lst imm imm 0))
|
|
(let ((base (car lst)))
|
|
(cond
|
|
; base = sp
|
|
((and (= (regno base) 2))
|
|
(emit '(3 4 2 5 2) 6 (bits imm 5 2) (bits imm 7 6) (regno src) 2))
|
|
; base = general
|
|
((and (cregp src) (cregp base))
|
|
(emit '(3 3 3 1 1 3 2) 6 (bits imm 5 3) (cregno base) (bits imm 2) (bits imm 6) (cregno src) 0))
|
|
(t (store imm src base 2)))))
|
|
|
|
(defun $xor (rd rs1 rs2)
|
|
(cond
|
|
((and (eq rd rs1) (cregp rd) (cregp rs2))
|
|
(creg 4 0 3 rd 1 rs2))
|
|
(t (reg 0 rs2 rs1 4 rd #x33))))
|
|
|
|
(defun $xori (rd rs1 imm)
|
|
(immed imm rs1 4 rd #x13))
|
|
|