adding to lisp library
This commit is contained in:
parent
a3a83f692c
commit
96290cf128
|
|
@ -172,5 +172,31 @@ Returns a list with all items for which tst is true removed from lst."
|
|||
Returns a list with all items for which tst is false removed from lst."
|
||||
(mapcan #'(lambda (x) (when (funcall tst x) (list x))) lst))
|
||||
|
||||
(defun rtc-set (hr min)
|
||||
"(rtc-set hr min)
|
||||
Set the time on a DS3231 RTC. Times are in BCD, so use
|
||||
the appropriate reader macro, e.g. (rtc-set #x12 #x34)
|
||||
for 12:34. Assumes seconds are zero."
|
||||
(with-i2c (str #x68)
|
||||
(write-byte 0 str)
|
||||
(write-byte 0 str)
|
||||
(write-byte min str)
|
||||
(write-byte hr str)))
|
||||
|
||||
(defun rtc-get ()
|
||||
(with-i2c (str #x68)
|
||||
(write-byte 0 str)
|
||||
(restart-i2c str 3)
|
||||
(reverse
|
||||
(list
|
||||
(read-byte str)
|
||||
(read-byte str)
|
||||
(read-byte str)))))
|
||||
|
||||
(defun rtc-now ()
|
||||
"(rtc-now)
|
||||
Set the time using the RTC."
|
||||
(now (rtc-get)))
|
||||
|
||||
)lisplibrary";
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,363 @@
|
|||
; ARM Thumb Assembler for uLisp - Version 10 - 18th November 2024
|
||||
; see http://www.ulisp.com/show?2YRU
|
||||
;
|
||||
|
||||
; Extract register number
|
||||
(defun regno (sym)
|
||||
(case sym (sp 13) (lr 14) (pc 15)
|
||||
(t (read-from-string (subseq (string sym) 1)))))
|
||||
|
||||
; Pack arguments into bit fields
|
||||
(defun emit (bits &rest args)
|
||||
(let ((word 0) (shift -28))
|
||||
(mapc #'(lambda (value)
|
||||
(let ((width (logand (ash bits shift) #xf)))
|
||||
(incf shift 4)
|
||||
(unless (zerop (ash value (- width))) (error "Won't fit"))
|
||||
(setq word (logior (ash word width) value))))
|
||||
args)
|
||||
word))
|
||||
|
||||
(defun offset (label) (ash (- label *pc* 4) -1))
|
||||
|
||||
; data
|
||||
|
||||
(defun $word (val)
|
||||
(append
|
||||
(unless (zerop (mod *pc* 4)) (list ($nop)))
|
||||
(list (logand val #xffff) (logand (ash val -16) #xffff))))
|
||||
|
||||
; Shared routines, ordered by first four bits
|
||||
|
||||
; lsl lsr 0
|
||||
|
||||
(defun lsl-lsr-0 (op argd argm immed5)
|
||||
(emit #x41533000 0 op immed5 (regno argm) (regno argd)))
|
||||
|
||||
; asr 0
|
||||
|
||||
(defun asr-0 (op argd argm immed5)
|
||||
(emit #x41533000 1 op immed5 (regno argm) (regno argd)))
|
||||
|
||||
; add sub 1
|
||||
|
||||
(defun add-sub-1 (op argd argn argm)
|
||||
(cond
|
||||
((numberp argm)
|
||||
(emit #x61333000 #b000111 op argm (regno argn) (regno argd)))
|
||||
((null argm)
|
||||
(emit #x61333000 #b000110 op (regno argn) (regno argd) (regno argd)))
|
||||
(t
|
||||
(emit #x61333000 #b000110 op (regno argm) (regno argn) (regno argd)))))
|
||||
|
||||
; mov sub 2 3
|
||||
|
||||
(defun mov-sub-2-3 (op2 op argd immed8)
|
||||
(emit #x41380000 op2 op (regno argd) immed8))
|
||||
|
||||
; add mov 4
|
||||
|
||||
(defun add-mov-4 (op argd argm)
|
||||
(let ((rd (regno argd))
|
||||
(rm (regno argm)))
|
||||
(cond
|
||||
((and (>= rd 8) (>= rm 8))
|
||||
(emit #x61333000 #b010001 op #b011 (- rm 8) (- rd 8)))
|
||||
((>= rm 8)
|
||||
(emit #x61333000 #b010001 op #b001 (- rm 8) rd))
|
||||
((>= rd 8)
|
||||
(emit #x61333000 #b010001 op #b010 rm (- rd 8))))))
|
||||
|
||||
; reg-reg
|
||||
|
||||
(defun reg-reg (op argd argm)
|
||||
(emit #xa3300000 op (regno argm) (regno argd)))
|
||||
|
||||
; bx blx 4
|
||||
|
||||
(defun bx-blx (op argm)
|
||||
(emit #x81430000 #b01000111 op (regno argm) 0))
|
||||
|
||||
; str ldr 4, 6, 9
|
||||
|
||||
(defun str-ldr (op argd arg2)
|
||||
(cond
|
||||
((numberp arg2)
|
||||
(when (= op 0) (error "str not allowed with label"))
|
||||
(let ((arg (- (truncate (+ arg2 2) 4) (truncate *pc* 4) 1)))
|
||||
(emit #x41380000 4 1 (regno argd) (max 0 arg))))
|
||||
((listp arg2)
|
||||
(let ((argn (first arg2))
|
||||
(immed (or (eval (second arg2)) 0)))
|
||||
(unless (zerop (mod immed 4)) (error "not multiple of 4"))
|
||||
(cond
|
||||
((eq (regno argn) 15)
|
||||
(when (= op 0) (error "str not allowed with pc"))
|
||||
(emit #x41380000 4 1 (regno argd) (truncate immed 4)))
|
||||
((eq (regno argn) 13)
|
||||
(emit #x41380000 9 op (regno argd) (truncate immed 4)))
|
||||
(t
|
||||
(emit #x41533000 6 op (truncate immed 4) (regno argn) (regno argd))))))
|
||||
(t (error "illegal argument"))))
|
||||
|
||||
(defun str-ldr-5 (op argd arg2)
|
||||
(cond
|
||||
((listp arg2)
|
||||
(let ((argn (first arg2))
|
||||
(argm (second arg2)))
|
||||
(emit #x43333000 5 op (regno argm) (regno argn) (regno argd))))
|
||||
(t (error "illegal argument"))))
|
||||
|
||||
; add-10
|
||||
|
||||
(defun add-10 (op argd immed8)
|
||||
(emit #x41380000 #b1010 op (regno argd) (truncate immed8 4)))
|
||||
|
||||
; add-sub-11
|
||||
|
||||
(defun add-sub-11 (op immed7)
|
||||
(emit #x81700000 #b11010000 op (truncate immed7 4)))
|
||||
|
||||
; push pop 11
|
||||
|
||||
(defun push-pop (op lst)
|
||||
(let ((byte 0)
|
||||
(r 0))
|
||||
(mapc #'(lambda (x)
|
||||
(cond
|
||||
((and (= op 0) (eq x 'lr)) (setq r 1))
|
||||
((and (= op 1) (eq x 'pc)) (setq r 1))
|
||||
(t (setq byte (logior byte (ash 1 (regno x))))))) lst)
|
||||
(emit #x41218000 11 op 2 r byte)))
|
||||
|
||||
; b cond 13
|
||||
|
||||
(defun b-cond-13 (cnd label)
|
||||
(let ((soff8 (logand (offset label) #xff)))
|
||||
(emit #x44800000 13 cnd soff8)))
|
||||
|
||||
(defun cpside (op aif)
|
||||
(emit #xb1130000 #b10110110011 op 0 aif))
|
||||
|
||||
; Alphabetical list of mnemonics
|
||||
|
||||
(defun $adc (argd argm)
|
||||
(reg-reg #b0100000101 argd argm))
|
||||
|
||||
(defun $add (argd argn &optional argm)
|
||||
(cond
|
||||
((numberp argm)
|
||||
(cond
|
||||
((eq (regno argn) 15)
|
||||
(add-10 0 argd argm))
|
||||
((eq (regno argn) 13)
|
||||
(add-10 1 argd argm))
|
||||
(t (add-sub-1 0 argd argn argm))))
|
||||
((and (numberp argn) (null argm))
|
||||
(cond
|
||||
((eq (regno argd) 13)
|
||||
(add-sub-11 0 argn))
|
||||
(t
|
||||
(mov-sub-2-3 3 0 argd argn))))
|
||||
(t
|
||||
(cond
|
||||
((or (>= (regno argd) 8) (>= (regno argn) 8))
|
||||
(add-mov-4 0 argd argn))
|
||||
(t
|
||||
(add-sub-1 0 argd argn argm))))))
|
||||
|
||||
(defun $and (argd argm)
|
||||
(reg-reg #b0100000000 argd argm))
|
||||
|
||||
(defun $asr (argd argm &optional arg2)
|
||||
(unless arg2 (setq arg2 argm argm argd))
|
||||
(cond
|
||||
((numberp arg2)
|
||||
(asr-0 0 argd argm arg2))
|
||||
((eq argd argm)
|
||||
(reg-reg #b0100000100 argd arg2))
|
||||
(t (error "First 2 registers must be the same"))))
|
||||
|
||||
(defun $b (label)
|
||||
(emit #x41b00000 #xe 0 (logand (offset label) #x7ff)))
|
||||
|
||||
(defun $bcc (label)
|
||||
(b-cond-13 3 label))
|
||||
|
||||
(defun $bcs (label)
|
||||
(b-cond-13 2 label))
|
||||
|
||||
(defun $beq (label)
|
||||
(b-cond-13 0 label))
|
||||
|
||||
(defun $bge (label)
|
||||
(b-cond-13 10 label))
|
||||
|
||||
(defun $bgt (label)
|
||||
(b-cond-13 12 label))
|
||||
|
||||
(defun $bhi (label)
|
||||
(b-cond-13 8 label))
|
||||
|
||||
(defun $bhs (label)
|
||||
(b-cond-13 2 label))
|
||||
|
||||
(defun $ble (label)
|
||||
(b-cond-13 13 label))
|
||||
|
||||
(defun $blo (label)
|
||||
(b-cond-13 3 label))
|
||||
|
||||
(defun $blt (label)
|
||||
(b-cond-13 11 label))
|
||||
|
||||
(defun $bmi (label)
|
||||
(b-cond-13 4 label))
|
||||
|
||||
(defun $bne (label)
|
||||
(b-cond-13 1 label))
|
||||
|
||||
(defun $bpl (label)
|
||||
(b-cond-13 5 label))
|
||||
|
||||
(defun $bic (argd argm)
|
||||
(reg-reg #b0100001110 argd argm))
|
||||
|
||||
(defun $bl (label)
|
||||
(list
|
||||
(emit #x5b000000 #b11110 (logand (ash (offset label) -11) #x7ff))
|
||||
(emit #x5b000000 #b11111 (logand (offset label) #x7ff))))
|
||||
|
||||
(defun $blx (argm)
|
||||
(bx-blx 1 argm))
|
||||
|
||||
(defun $bx (argm)
|
||||
(bx-blx 0 argm))
|
||||
|
||||
(defun $cmn (argd argm)
|
||||
(reg-reg #b0100001011 argd argm))
|
||||
|
||||
(defun $cmp (argd argm)
|
||||
(cond
|
||||
((numberp argm)
|
||||
(mov-sub-2-3 2 1 argd argm))
|
||||
(t
|
||||
(reg-reg #b0100001010 argd argm))))
|
||||
|
||||
(defun $cpsid (aif)
|
||||
(cpside 1 aif))
|
||||
|
||||
(defun $cpsie (aif)
|
||||
(cpside 0 aif))
|
||||
|
||||
(defun $eor (argd argm)
|
||||
(reg-reg #b0100000001 argd argm))
|
||||
|
||||
(defun $ldr (argd arg2)
|
||||
(str-ldr 1 argd arg2))
|
||||
|
||||
(defun $ldrb (argd arg2)
|
||||
(str-ldr-5 6 argd arg2))
|
||||
|
||||
(defun $ldrh (argd arg2)
|
||||
(str-ldr-5 5 argd arg2))
|
||||
|
||||
(defun $ldrsb (argd arg2)
|
||||
(str-ldr-5 3 argd arg2))
|
||||
|
||||
(defun $ldrsh (argd arg2)
|
||||
(str-ldr-5 7 argd arg2))
|
||||
|
||||
(defun $lsl (argd argm &optional arg2)
|
||||
(unless arg2 (setq arg2 argm argm argd))
|
||||
(cond
|
||||
((numberp arg2)
|
||||
(lsl-lsr-0 0 argd argm arg2))
|
||||
((eq argd argm)
|
||||
(reg-reg #b0100000010 argd arg2))
|
||||
(t (error "First 2 registers must be the same"))))
|
||||
|
||||
(defun $lsr (argd argm &optional arg2)
|
||||
(unless arg2 (setq arg2 argm argm argd))
|
||||
(cond
|
||||
((numberp arg2)
|
||||
(lsl-lsr-0 1 argd argm arg2))
|
||||
((eq argd argm)
|
||||
(reg-reg #b0100000011 argd arg2))
|
||||
(t (error "First 2 registers must be the same"))))
|
||||
|
||||
(defun $mov (argd argm)
|
||||
(cond
|
||||
((numberp argm)
|
||||
(mov-sub-2-3 2 0 argd argm))
|
||||
((or (>= (regno argd) 8) (>= (regno argm) 8))
|
||||
(add-mov-4 1 argd argm))
|
||||
(t ; Synonym of LSLS Rd, Rm, #0
|
||||
(lsl-lsr-0 0 argd argm 0))))
|
||||
|
||||
(defun $mul (argd argm)
|
||||
(reg-reg #b0100001101 argd argm))
|
||||
|
||||
(defun $mvn (argd argm)
|
||||
(reg-reg #b0100001111 argd argm))
|
||||
|
||||
(defun $neg (argd argm)
|
||||
(reg-reg #b0100001001 argd argm))
|
||||
|
||||
(defun $nop () ; mov r8,r8
|
||||
(add-mov-4 1 'r8 'r8))
|
||||
|
||||
(defun $orr (argd argm)
|
||||
(reg-reg #b0100001100 argd argm))
|
||||
|
||||
(defun $push (lst)
|
||||
(push-pop 0 lst))
|
||||
|
||||
(defun $pop (lst)
|
||||
(push-pop 1 lst))
|
||||
|
||||
(defun $rev (argd argm)
|
||||
(reg-reg #b1011101000 argd argm))
|
||||
|
||||
(defun $rev16 (argd argm)
|
||||
(reg-reg #b1011101001 argd argm))
|
||||
|
||||
(defun $revsh (argd argm)
|
||||
(reg-reg #b1011101010 argd argm))
|
||||
|
||||
(defun $ror (argd argm)
|
||||
(reg-reg #b0100000111 argd argm))
|
||||
|
||||
(defun $sbc (argd argm)
|
||||
(reg-reg #b0100000110 argd argm))
|
||||
|
||||
(defun $str (argd arg2)
|
||||
(str-ldr 0 argd arg2))
|
||||
|
||||
(defun $strb (argd arg2)
|
||||
(str-ldr-5 2 argd arg2))
|
||||
|
||||
(defun $sub (argd argn &optional argm)
|
||||
(cond
|
||||
((not (numberp argn))
|
||||
(add-sub-1 1 argd argn argm))
|
||||
((eq (regno argd) 13)
|
||||
(add-sub-11 1 argn))
|
||||
(t
|
||||
(mov-sub-2-3 3 1 argd argn))))
|
||||
|
||||
(defun $sxtb (argd argm)
|
||||
(reg-reg #b1011001001 argd argm))
|
||||
|
||||
(defun $sxth (argd argm)
|
||||
(reg-reg #b1011001000 argd argm))
|
||||
|
||||
(defun $tst (argd argm)
|
||||
(reg-reg #b0100001000 argd argm))
|
||||
|
||||
(defun $uxtb (argd argm)
|
||||
(reg-reg #b1011001011 argd argm))
|
||||
|
||||
(defun $uxth (argd argm)
|
||||
(reg-reg #b1011001010 argd argm))
|
||||
|
||||
|
|
@ -0,0 +1,395 @@
|
|||
; 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))
|
||||
|
||||
|
|
@ -0,0 +1,161 @@
|
|||
; RISC-V Assembler extensions for RP2350 - Version 1 - 18th October 2024
|
||||
; see http://www.ulisp.com/show?4Y5E
|
||||
;
|
||||
|
||||
; Instruction formats
|
||||
|
||||
(defun bit13 (op1 op2 rs1 op3 rd)
|
||||
(emit32 '(7 5 5 3 5 7) op1 op2 (regno rs1) op3 (regno rd) #x13))
|
||||
|
||||
(defun bitimm5 (op1 imm5 rs1 op2 rd)
|
||||
(emit32 '(7 5 5 3 5 7) op1 (logand imm5 #x1f) (regno rs1) op2 (regno rd) #x13))
|
||||
|
||||
; Additional compressed formats
|
||||
|
||||
(defun $mul (rd rs1 rs2)
|
||||
(cond
|
||||
((and (eq rd rs1) (cregp rd) (cregp rs2))
|
||||
(emit '(3 3 3 2 3 2) 4 7 (cregno rd) 2 (cregno rs2) 1))
|
||||
(t (muldiv rs2 rs1 0 rd #x33))))
|
||||
|
||||
(defun $sb (src imm &optional lst)
|
||||
(unless lst (setq lst imm imm 0))
|
||||
(cond
|
||||
((and (cregp src) (cregp (car lst)) (<= 0 imm 3))
|
||||
(emit '(3 3 3 1 1 3 2) 4 2 (cregno (car lst)) (bits imm 0) (bits imm 1) (cregno src) 0))
|
||||
(t (store imm src (car lst) 0))))
|
||||
|
||||
(defun $sh (src imm &optional lst)
|
||||
(unless lst (setq lst imm imm 0))
|
||||
(cond
|
||||
((and (cregp src) (cregp (car lst)) (or (= imm 0) (= im 2))
|
||||
(emit '(3 3 3 1 1 3 2) 4 3 (cregno (car lst)) 0 (bits imm 1) (cregno src) 0))
|
||||
(t (store imm src (car lst) 1)))))
|
||||
|
||||
; Add compressed formats to $lbu, $lh, and $lhu. No $lb compressed format
|
||||
(defun $lbu (rd imm &optional lst)
|
||||
(unless lst (setq lst imm imm 0))
|
||||
(cond
|
||||
((and (cregp rd) (cregp (car lst)) (<= 0 imm 3))
|
||||
(emit '(3 3 3 1 1 3 2) 4 0 (cregno (car lst)) (bits imm 0) (bits imm 1) (cregno rd) 0))
|
||||
(t (immed imm (car lst) 4 rd 3))))
|
||||
|
||||
(defun $lh (rd imm &optional lst)
|
||||
(unless lst (setq lst imm imm 0))
|
||||
(cond
|
||||
((and (cregp rd) (cregp (car lst)) (or (= imm 0) (= im 2))
|
||||
(emit '(3 3 3 1 1 3 2) 4 1 (cregno (car lst)) 1 (bits imm 1) (cregno rd) 0))
|
||||
(t (immed imm (car lst) 1 rd 3)))))
|
||||
|
||||
(defun $lhu (rd imm &optional lst)
|
||||
(unless lst (setq lst imm imm 0))
|
||||
(cond
|
||||
((and (cregp rd) (cregp (car lst)) (or (= imm 0) (= im 2))
|
||||
(emit '(3 3 3 1 1 3 2) 4 1 (cregno (car lst)) 0 (bits imm 1) (cregno rd) 0))
|
||||
(t (immed imm (car lst) 5 rd 3)))))
|
||||
|
||||
(defun $xori (rd rs1 imm)
|
||||
(cond
|
||||
((and (eq rd rs1) (cregp rd) (= imm -1))
|
||||
(emit '(3 3 3 2 3 2) 4 7 (cregno rd) 3 5 1))
|
||||
(t (immed imm rs1 4 rd #x13))))
|
||||
|
||||
; New instructions
|
||||
|
||||
(defun $andn (rd rs1 rs2)
|
||||
(reg #x20 rs2 rs1 3 rd #x33))
|
||||
|
||||
(defun $bclr (rd rs1 rs2)
|
||||
(reg #x24 rs2 rs1 1 rd #x33))
|
||||
|
||||
(defun $bclri (rd rs1 imm5)
|
||||
(bitimm5 #x24 imm5 rs1 1 rd))
|
||||
|
||||
(defun $bext (rd rs1 rs2)
|
||||
(reg #x24 rs2 rs1 5 rd #x33))
|
||||
|
||||
(defun $bexti (rd rs1 imm5)
|
||||
(bitimm5 #x24 imm5 rs1 5 rd))
|
||||
|
||||
(defun $binv (rd rs1 rs2)
|
||||
(reg #x34 rs2 rs1 1 rd #x33))
|
||||
|
||||
(defun $binvi (rd rs1 imm5)
|
||||
(bitimm5 #x34 imm5 rs1 1 rd))
|
||||
|
||||
(defun $brev8 (rd rs1)
|
||||
(bit13 #x34 7 rs1 5 rd))
|
||||
|
||||
(defun $bset (rd rs1 rs2)
|
||||
(reg #x14 rs2 rs1 1 rd #x33))
|
||||
|
||||
(defun $bseti (rd rs1 imm5)
|
||||
(bitimm5 #x14 imm5 rs1 1 rd))
|
||||
|
||||
(defun $clz (rd rs1)
|
||||
(bit13 #x30 0 rs1 1 rd))
|
||||
|
||||
(defun $cpop (rd rs1)
|
||||
(bit13 #x30 2 rs1 1 rd))
|
||||
|
||||
(defun $ctz (rd rs1)
|
||||
(bit13 #x30 1 rs1 1 rd))
|
||||
|
||||
(defun $max (rd rs1 rs2)
|
||||
(reg #x05 rs2 rs1 6 rd #x33))
|
||||
|
||||
(defun $maxu (rd rs1 rs2)
|
||||
(reg #x05 rs2 rs1 7 rd #x33))
|
||||
|
||||
(defun $min (rd rs1 rs2)
|
||||
(reg #x05 rs2 rs1 4 rd #x33))
|
||||
|
||||
(defun $minu (rd rs1 rs2)
|
||||
(reg #x05 rs2 rs1 5 rd #x33))
|
||||
|
||||
(defun $orc.b (rd rs1)
|
||||
(bit13 #x14 7 rs1 5 rd))
|
||||
|
||||
(defun $orn (rd rs1 rs2)
|
||||
(reg #x20 rs2 rs1 5 rd #x33))
|
||||
|
||||
(defun $pack (rd rs1 rs2)
|
||||
(reg #x04 rs2 rs1 4 rd #x33))
|
||||
|
||||
(defun $packh (rd rs1 rs2)
|
||||
(reg #x04 rs2 rs1 7 rd #x33))
|
||||
|
||||
(defun $rev8 (rd rs1)
|
||||
(bit13 #x34 #x18 rs1 5 rd))
|
||||
|
||||
(defun $rol (rd rs1 rs2)
|
||||
(reg #x30 rs2 rs1 1 rd #x33))
|
||||
|
||||
(defun $ror (rd rs1 rs2)
|
||||
(reg #x30 rs2 rs1 5 rd #x33))
|
||||
|
||||
(defun $rori (rd rs1 imm5)
|
||||
(bitimm5 #x30 imm5 rs1 5 rd))
|
||||
|
||||
(defun $sext.b (rd rs1)
|
||||
(bit13 #x30 #x04 rs1 1 rd))
|
||||
|
||||
(defun $sext.h (rd rs1)
|
||||
(bit13 #x30 #x05 rs1 1 rd))
|
||||
|
||||
(defun $unzip (rd rs1)
|
||||
(bit13 #x04 #x0f rs1 5 rd))
|
||||
|
||||
(defun $xnor (rd rs1 rs2)
|
||||
(reg #x20 rs2 rs1 4 rd #x33))
|
||||
|
||||
(defun $zext.b (rd rs1)
|
||||
($andi rd rs1 #xff)))
|
||||
|
||||
(defun $zext.h (rd rs1)
|
||||
(emit32 '(7 5 5 3 5 7) #x04 0 (regno rs1) 4 (regno rd) #x33))
|
||||
|
||||
(defun $zip (rd rs1)
|
||||
(bit13 #x04 #x0f rs1 1 rd))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue