various fixups
This commit is contained in:
parent
2cb940a546
commit
25199750cf
363
lisp/armasm.lsp
363
lisp/armasm.lsp
|
|
@ -1,363 +0,0 @@
|
||||||
; 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))
|
|
||||||
|
|
||||||
|
|
@ -1,53 +0,0 @@
|
||||||
; The ATtiny database v3 - 9th April 2019
|
|
||||||
; See http://www.ulisp.com/show?2I60
|
|
||||||
;
|
|
||||||
|
|
||||||
(defvar *data*
|
|
||||||
'((attinyX5 (pins 8) (io 5) (adc 4) (pwm 3) (usi 1) (timer8 2) (crystal) (pll))
|
|
||||||
(attiny85 (family attinyx5) (flash 8192) (ram 512) (eeprom 512) (price soic 72) (price pdip 90))
|
|
||||||
(attiny45 (family attinyx5) (flash 4096) (ram 256) (eeprom 256) (price soic 77) (price pdip 85))
|
|
||||||
(attiny25 (family attinyx5) (flash 2048) (ram 128) (eeprom 128) (price soic 79) (price pdip 83))
|
|
||||||
|
|
||||||
(attinyX4 (pins 14) (io 11) (adc 8) (pwm 4) (usi 1) (timer8 1) (timer16 1) (crystal))
|
|
||||||
(attiny84 (family attinyX4) (flash 8192) (ram 512) (eeprom 512) (price soic 60) (price pdip 87))
|
|
||||||
(attiny44 (family attinyX4) (flash 4096) (ram 256) (eeprom 256) (price soic 56) (price pdip 86))
|
|
||||||
(attiny24 (family attinyX4) (flash 2048) (ram 128) (eeprom 128) (price soic 52) (price pdip 83))
|
|
||||||
|
|
||||||
(attinyX313 (pins 20) (io 17) (pwm 3) (uart 1) (usi 1) (timer8 1) (timer16 1) (crystal))
|
|
||||||
(attiny4313 (family attinyX313) (flash 4096) (ram 256) (eeprom 256) (price soic 70) (price pdip 98))
|
|
||||||
(attiny2313 (family attinyX313) (flash 2048) (ram 128) (eeprom 128) (price soic 82) (price pdip 99))
|
|
||||||
|
|
||||||
(attinyX41 (pins 14) (io 11) (adc 12) (uart 2) (i2c slave) (timer8 1) (timer16 2) (crystal))
|
|
||||||
(attiny841 (family attinyX41) (flash 8192) (ram 512) (eeprom 512) (price soic 78))
|
|
||||||
(attiny441 (family attinyX41) (flash 4096) (ram 256) (eeprom 256) (price soic 73))
|
|
||||||
|
|
||||||
(attinyX61 (pins 20) (io 15) (adc 11) (pwm 3) (usi 1) (timer8 1) (timer16 1) (crystal) (pll))
|
|
||||||
(attiny861 (family attinyX61) (flash 8192) (ram 512) (eeprom 512) (price soic 92) (price pdip 110))
|
|
||||||
(attiny461 (family attinyX61) (flash 4096) (ram 256) (eeprom 256) (price soic 85) (price pdip 129))
|
|
||||||
(attiny261 (family attinyX61) (flash 2048) (ram 128) (eeprom 128) (price soic 83) (price pdip 107))
|
|
||||||
|
|
||||||
(attinyX7 (pins 20) (io 16) (adc 11) (pwm 3) (uart 1) (usi 1) (timer8 1) (timer16 1) (crystal) (lin))
|
|
||||||
(attiny167 (family attinyX7) (flash 16384) (ram 512) (eeprom 512) (price soic 111))
|
|
||||||
(attiny87 (family attinyX7) (flash 8192) (ram 512) (eeprom 512) (price soic 124))
|
|
||||||
|
|
||||||
(attinyX8 (pins 28) (io 27) (adc 8) (pwm 4) (i2c master) (i2c slave) (usi 1) (timer8 1) (timer16 1))
|
|
||||||
(attiny88 (family attinyX8) (flash 8192) (ram 512) (eeprom 64) (price tqfp 76) (price pdip 143))
|
|
||||||
(attiny48 (family attinyX8) (flash 4096) (ram 256) (eeprom 64) (price tqfp 78) (price pdip 131))
|
|
||||||
|
|
||||||
(attinyX34 (pins 20) (io 17) (adc 12) (pwm 4) (i2c slave) (uart 2) (usi 1) (timer8 1) (timer16 1) (crystal))
|
|
||||||
(attiny1634 (family attinyX34) (flash 16384) (ram 1024) (eeprom 256) (price soic 118))
|
|
||||||
|
|
||||||
(attinyX28 (pins 32) (io 27) (adc 28) (pwm 4) (i2c slave) (uart 1) (timer8 1) (timer16 1))
|
|
||||||
(attiny828 (family attinyX28) (flash 8192) (ram 512) (eeprom 512) (price tqfp 84))
|
|
||||||
|
|
||||||
(attinyX3 (pins 20) (io 15) (adc 4) (pwm 4) (usi 1) (timer8 1) (timer16 1) (boost))
|
|
||||||
(attiny43 (family attinyX3) (flash 4096) (ram 512) (eeprom 64) (price soic 147))
|
|
||||||
|
|
||||||
(attiny9/10 (pins 6) (io 4) (adc 4) (pwm 2) (timer16 1))
|
|
||||||
(attiny4/5 (pins 6) (io 4) (pwm 2) (timer16 1))
|
|
||||||
(attiny10 (family attiny9/10) (flash 1024) (ram 32) (price sot 25))
|
|
||||||
(attiny9 (family attiny9/10) (flash 512) (ram 32) (price sot 25))
|
|
||||||
(attiny5 (family attiny4/5) (flash 1024) (ram 32) (price sot 23))
|
|
||||||
(attiny4 (family attiny4/5) (flash 512) (ram 32) (price sot 27))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,38 +0,0 @@
|
||||||
;
|
|
||||||
; Ringing the changes
|
|
||||||
; see http://www.ulisp.com/show?1G42
|
|
||||||
;
|
|
||||||
|
|
||||||
(defvar *bell-pin* 3)
|
|
||||||
|
|
||||||
(defun fnd (x lst)
|
|
||||||
(cond
|
|
||||||
((null lst) nil)
|
|
||||||
((< x (car lst)) (car lst))
|
|
||||||
(t (fnd x (cdr lst)))))
|
|
||||||
|
|
||||||
(defun sub (new old lst)
|
|
||||||
(cond
|
|
||||||
((null lst) nil)
|
|
||||||
((eq old (car lst)) (cons new (cdr lst)))
|
|
||||||
(t (cons (car lst) (sub new old (cdr lst))))))
|
|
||||||
|
|
||||||
(defun nxt (lst)
|
|
||||||
(cond
|
|
||||||
((not (apply > (cdr lst))) (cons (car lst) (nxt (cdr lst))))
|
|
||||||
((> (car lst) (cadr lst)) nil)
|
|
||||||
(t (let* ((rest (reverse (cdr lst)))
|
|
||||||
(old (fnd (car lst) rest)))
|
|
||||||
(cons old (sub (car lst) old rest))))))
|
|
||||||
|
|
||||||
(defun all (fun lst)
|
|
||||||
(when lst
|
|
||||||
(funcall fun lst)
|
|
||||||
(all fun (nxt lst))))
|
|
||||||
|
|
||||||
(defun bel (lis)
|
|
||||||
(mapc
|
|
||||||
(lambda (x) (note *bell-pin* x 4) (delay 500) (note) (delay 125))
|
|
||||||
lis)
|
|
||||||
(delay 500))
|
|
||||||
|
|
||||||
|
|
@ -1,45 +0,0 @@
|
||||||
(defvar *cmds* nil)
|
|
||||||
|
|
||||||
(defun %edit (fun)
|
|
||||||
(cond
|
|
||||||
((null *cmds*) fun)
|
|
||||||
((eq (car *cmds*) #\b) (pop *cmds*) fun)
|
|
||||||
((eq (car *cmds*) #\e) (pop *cmds*) (%edit (list fun)))
|
|
||||||
((eq (car *cmds*) #\h) (pop *cmds*) (%edit (cons 'highlight (list fun))))
|
|
||||||
((consp (car *cmds*))
|
|
||||||
(let ((val (cdar *cmds*)))
|
|
||||||
(case (caar *cmds*)
|
|
||||||
(#\r (pop *cmds*) (%edit val))
|
|
||||||
((#\c #\i) (pop *cmds*) (%edit (cons val fun)))
|
|
||||||
(#\f (cond
|
|
||||||
((null fun) nil)
|
|
||||||
((equal val fun) (pop *cmds*) (%edit fun))
|
|
||||||
((atom fun) fun)
|
|
||||||
(t (cons (%edit (car fun)) (%edit (cdr fun)))))))))
|
|
||||||
((atom fun) (pop *cmds*) (%edit fun))
|
|
||||||
((eq (car *cmds*) #\d) (pop *cmds*) (%edit (cons (car fun) (%edit (cdr fun)))))
|
|
||||||
((eq (car *cmds*) #\a) (pop *cmds*) (%edit (cons (%edit (car fun)) (cdr fun))))
|
|
||||||
((eq (car *cmds*) #\x) (pop *cmds*) (%edit (cdr fun)))
|
|
||||||
(t fun)))
|
|
||||||
|
|
||||||
(defun edit (name)
|
|
||||||
(let ((fun (eval name))
|
|
||||||
cc)
|
|
||||||
(setq *cmds* nil)
|
|
||||||
(loop
|
|
||||||
(write-byte 12)
|
|
||||||
(setq cc (append cc (list #\h)))
|
|
||||||
(setq *cmds* cc)
|
|
||||||
(pprint (%edit fun))
|
|
||||||
(setq cc (butlast cc))
|
|
||||||
(let ((c (get-key)))
|
|
||||||
(case c
|
|
||||||
(#\q (set name fun) (return name))
|
|
||||||
(#\s (setq *cmds* cc) (set name (%edit fun)) (return name))
|
|
||||||
(#\z (when cc (setq cc (butlast cc))))
|
|
||||||
((#\r #\c #\i #\f #\e)
|
|
||||||
(write-byte 11) (princ c) (princ #\:)
|
|
||||||
(setq cc (append cc (list (cons c (read))))))
|
|
||||||
((#\d #\a #\x #\b)
|
|
||||||
(setq cc (append cc (list c))))
|
|
||||||
(t (write-byte 7)))))))
|
|
||||||
24
lisp/pkg.lsp
24
lisp/pkg.lsp
|
|
@ -1,24 +0,0 @@
|
||||||
(defvar *packages* nil)
|
|
||||||
|
|
||||||
(defun load-package (filename)
|
|
||||||
(let* ((path (concatenate 'string filename ".pkg"))
|
|
||||||
(forms (load path)))
|
|
||||||
(setf *packages* (append-to-list
|
|
||||||
(cons filename forms)
|
|
||||||
(remove-if (lambda (x)
|
|
||||||
(string= (car x) filename))
|
|
||||||
*packages*)))))
|
|
||||||
|
|
||||||
(defun save-package (filename lst)
|
|
||||||
(with-sd-card (str filename 2)
|
|
||||||
(dolist (f lst)
|
|
||||||
(symbol-def f str))))
|
|
||||||
|
|
||||||
(defun unload-package (package)
|
|
||||||
(dolist (sym (cdr (assoc package *packages*)))
|
|
||||||
(makunbound sym)))
|
|
||||||
|
|
||||||
(defun add-to-package (filename list)
|
|
||||||
(with-sd-card (str filename 1)
|
|
||||||
(dolist (f lst)
|
|
||||||
(symdef str))))
|
|
||||||
|
|
@ -1,89 +0,0 @@
|
||||||
; uLisp Query Language - 9th April 2019
|
|
||||||
; See http://www.ulisp.com/show?2I60
|
|
||||||
;
|
|
||||||
|
|
||||||
; Database
|
|
||||||
|
|
||||||
(defvar *rules* nil)
|
|
||||||
|
|
||||||
(defun add (rule)
|
|
||||||
(unless (assoc (car rule) *rules*) (push (list (car rule)) *rules*))
|
|
||||||
(push (cdr rule) (cdr (assoc (car rule) *rules*)))
|
|
||||||
t)
|
|
||||||
|
|
||||||
; Match
|
|
||||||
|
|
||||||
(defun match (x y &optional binds)
|
|
||||||
(cond
|
|
||||||
((eq x y) (if binds binds '((t))))
|
|
||||||
((assoc x binds) (match (binding x binds) y binds))
|
|
||||||
((assoc y binds) (match x (binding y binds) binds))
|
|
||||||
((var? x) (cons (cons x y) binds))
|
|
||||||
((var? y) (cons (cons y x) binds))
|
|
||||||
(t
|
|
||||||
(when (and (consp x) (consp y))
|
|
||||||
(let ((m (match (car x) (car y) binds)))
|
|
||||||
(when m (match (cdr x) (cdr y) m)))))))
|
|
||||||
|
|
||||||
(defun var? (x)
|
|
||||||
(and (symbolp x) (eq (char (string x) 0) #\?)))
|
|
||||||
|
|
||||||
(defun binding (x binds)
|
|
||||||
(let ((b (assoc x binds)))
|
|
||||||
(when b
|
|
||||||
(or (binding (cdr b) binds)
|
|
||||||
(cdr b)))))
|
|
||||||
|
|
||||||
; Inference
|
|
||||||
|
|
||||||
(defun query (expr &optional binds)
|
|
||||||
(case (car expr)
|
|
||||||
(and (query-and (reverse (cdr expr)) binds))
|
|
||||||
(or (query-or (cdr expr) binds))
|
|
||||||
(not (query-not (second expr) binds))
|
|
||||||
(test (query-test (second expr) binds))
|
|
||||||
(t (lookup (car expr) (cdr expr) binds))))
|
|
||||||
|
|
||||||
(defun lookup (pred args &optional binds)
|
|
||||||
(mapcan
|
|
||||||
(lambda (x)
|
|
||||||
(let ((m (match args x binds)))
|
|
||||||
(when m (list m))))
|
|
||||||
(cdr (assoc pred *rules*))))
|
|
||||||
|
|
||||||
(defun query-and (clauses binds)
|
|
||||||
(if (null clauses)
|
|
||||||
(list binds)
|
|
||||||
(mapcan (lambda (b) (query (car clauses) b))
|
|
||||||
(query-and (cdr clauses) binds))))
|
|
||||||
|
|
||||||
(defun query-or (clauses binds)
|
|
||||||
(apply 'append (mapcar (lambda (c) (query c binds)) clauses)))
|
|
||||||
|
|
||||||
(defun query-not (clause binds)
|
|
||||||
(unless (query clause binds)
|
|
||||||
(list binds)))
|
|
||||||
|
|
||||||
(defun subs (lst binds)
|
|
||||||
(cond
|
|
||||||
((null lst) nil)
|
|
||||||
((atom lst) (if (assoc lst binds) (cdr (assoc lst binds)) lst))
|
|
||||||
(t (cons (subs (car lst) binds) (subs (cdr lst) binds)))))
|
|
||||||
|
|
||||||
(defun query-test (tst binds)
|
|
||||||
(when (eval (subs tst binds))
|
|
||||||
(list binds)))
|
|
||||||
|
|
||||||
(defun answer (expr output)
|
|
||||||
(dolist (binds (query expr nil))
|
|
||||||
(mapc (lambda (p) (princ p) (princ #\space)) (subs output binds))
|
|
||||||
(terpri)))
|
|
||||||
|
|
||||||
(defun read-data ()
|
|
||||||
(dolist (rules *data*)
|
|
||||||
(let ((pred (first rules))
|
|
||||||
(data (cdr rules)))
|
|
||||||
(mapc (lambda (rule) (add (cons (first rule) (cons pred (cdr rule))))) data)))
|
|
||||||
t)
|
|
||||||
|
|
||||||
|
|
||||||
395
lisp/r5asm.lsp
395
lisp/r5asm.lsp
|
|
@ -1,395 +0,0 @@
|
||||||
; 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))
|
|
||||||
|
|
||||||
161
lisp/r5asmpi.lsp
161
lisp/r5asmpi.lsp
|
|
@ -1,161 +0,0 @@
|
||||||
; 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))
|
|
||||||
|
|
||||||
|
|
||||||
57
lisp/rtc.lsp
57
lisp/rtc.lsp
|
|
@ -1,57 +0,0 @@
|
||||||
(defvar *rtc-port* 0)
|
|
||||||
|
|
||||||
(defun bcd-to-dec (x)
|
|
||||||
"(bcd-to-dec x)
|
|
||||||
Convert the BCD-encoded number x to a decimal value."
|
|
||||||
(+
|
|
||||||
(* 10 (ash x -4))
|
|
||||||
(logand x #xf)))
|
|
||||||
|
|
||||||
(defun dec-to-bcd (x)
|
|
||||||
"(dec-to-bcd x)
|
|
||||||
Converts the decimal value to a BCD-encoded number.
|
|
||||||
Number must be in the range 0 to 99."
|
|
||||||
(+
|
|
||||||
(ash (floor x 10) 4)
|
|
||||||
(logand (rem x 10) #xf)))
|
|
||||||
|
|
||||||
(defun rtc-p ()
|
|
||||||
"(rtc-p)
|
|
||||||
Returns t if the RTC is connected."
|
|
||||||
(with-i2c (str *rtc-port* #x68)
|
|
||||||
(streamp str)))
|
|
||||||
|
|
||||||
(defun rtc-set (h m s)
|
|
||||||
"(rtc-set hr min sec)
|
|
||||||
Set the time on a DS3231 RTC. Times are in BCD, so use
|
|
||||||
the appropriate reader macro, e.g. (rtc-set #x12 #x34 #x00)
|
|
||||||
for 12:34:00."
|
|
||||||
(let ((h (dec-to-bcd h))
|
|
||||||
(m (dec-to-bcd m))
|
|
||||||
(s (dec-to-bcd s)))
|
|
||||||
(with-i2c (str *rtc-port* #x68)
|
|
||||||
(write-byte 0 str)
|
|
||||||
(write-byte s str)
|
|
||||||
(write-byte m str)
|
|
||||||
(write-byte h str))))
|
|
||||||
|
|
||||||
(defun rtc-get ()
|
|
||||||
(with-i2c (str *rtc-port* #x68)
|
|
||||||
(write-byte 0 str)
|
|
||||||
(restart-i2c str 3)
|
|
||||||
(mapcar bcd-to-dec
|
|
||||||
(reverse
|
|
||||||
(list
|
|
||||||
(read-byte str)
|
|
||||||
(read-byte str)
|
|
||||||
(read-byte str))))))
|
|
||||||
|
|
||||||
(defun rtc-now ()
|
|
||||||
"(rtc-now)
|
|
||||||
Set the time using the RTC."
|
|
||||||
(apply now (rtc-get)))
|
|
||||||
|
|
||||||
(defun now-rtc ()
|
|
||||||
"(now-rtc)
|
|
||||||
Sets the RTC time using the now function."
|
|
||||||
(apply rtc-set (now)))
|
|
||||||
22
lisp/sync.sh
22
lisp/sync.sh
|
|
@ -1,22 +0,0 @@
|
||||||
#!/bin/sh
|
|
||||||
|
|
||||||
if [ "$(uname -s)" = "Linux" ]
|
|
||||||
then
|
|
||||||
DEFAULT_MOUNT="/media/kyle/ULISP"
|
|
||||||
else
|
|
||||||
DEFAULT_MOUNT="/Volumes/ULISP"
|
|
||||||
fi
|
|
||||||
|
|
||||||
MEDIA="${1:-${DEFAULT_MOUNT}}"
|
|
||||||
|
|
||||||
if [ ! -d "${MEDIA}" ]
|
|
||||||
then
|
|
||||||
echo "[!] ${MEDIA} isn't mounted!"
|
|
||||||
exit 1
|
|
||||||
fi
|
|
||||||
|
|
||||||
echo "[+] transferring lisp files to ${MEDIA}..."
|
|
||||||
cp *.lsp "$MEDIA"
|
|
||||||
echo "[+] unmounting ${MEDIA}"
|
|
||||||
umount "$MEDIA"
|
|
||||||
echo "[+] transfer complete"
|
|
||||||
86
lisp/tak.lsp
86
lisp/tak.lsp
|
|
@ -1,86 +0,0 @@
|
||||||
(defun tak (x y z)
|
|
||||||
(if (not (< y x))
|
|
||||||
z
|
|
||||||
(tak
|
|
||||||
(tak (1- x) y z)
|
|
||||||
(tak (1- y) z x)
|
|
||||||
(tak (1- z) x y))))
|
|
||||||
|
|
||||||
(defun benchmark-tak ()
|
|
||||||
(tak 18 12 6))
|
|
||||||
|
|
||||||
(defun fib (n)
|
|
||||||
(if (< n 3) 1
|
|
||||||
(+ (fib (- n 1)) (fib (- n 2)))))
|
|
||||||
|
|
||||||
(defun benchmark-fib ()
|
|
||||||
(fib 23))
|
|
||||||
|
|
||||||
(defun q (n)
|
|
||||||
(if (<= n 2) 1
|
|
||||||
(+
|
|
||||||
(q (- n (q (- n 1))))
|
|
||||||
(q (- n (q (- n 2)))))))
|
|
||||||
|
|
||||||
(defun benchmark-q ()
|
|
||||||
(q 21))
|
|
||||||
|
|
||||||
(defun q2 (x y)
|
|
||||||
(if (or (< x 1) (< y 1)) 1
|
|
||||||
(+ (q2 (- x (q2 (1- x) y)) y)
|
|
||||||
(q2 x (- y (q2 x (1- y)))))))
|
|
||||||
|
|
||||||
(defun benchmark-q2 ()
|
|
||||||
(q2 7 8))
|
|
||||||
|
|
||||||
(defun factor (n)
|
|
||||||
(cond
|
|
||||||
((zerop (mod n 2)) 2)
|
|
||||||
((zerop (mod n 3)) 3)
|
|
||||||
(t (let ((d 5) (i 2))
|
|
||||||
(loop
|
|
||||||
(when (> (* d d) n) (return n))
|
|
||||||
(when (zerop (mod n d)) (return d))
|
|
||||||
(incf d i) (setq i (- 6 i)))))))
|
|
||||||
|
|
||||||
(defvar *factor-prime* 2142142141)
|
|
||||||
(defun benchmark-factor ()
|
|
||||||
(factor *factor-prime*))
|
|
||||||
|
|
||||||
(defun sieve (size)
|
|
||||||
(let ((a (make-array size :element-type 'bit))
|
|
||||||
max)
|
|
||||||
(setf (aref a 0) 1 (aref a 1) 1)
|
|
||||||
(dotimes (i size max)
|
|
||||||
(when (zerop (aref a i))
|
|
||||||
(setq max i)
|
|
||||||
(do ((j (* 2 i) (+ j i))) ((>= j size)) (setf (aref a j) 1))))))
|
|
||||||
|
|
||||||
(defun benchmark-sieve ()
|
|
||||||
(sieve 100000))
|
|
||||||
|
|
||||||
(defun benchmark-check (fun expected)
|
|
||||||
(let ((answer (fun)))
|
|
||||||
(unless (eq answer expected)
|
|
||||||
(error "benchmark failed: have ~a, expected ~a~%"
|
|
||||||
answer
|
|
||||||
expected)
|
|
||||||
t)))
|
|
||||||
|
|
||||||
(defun benchmark-time-it (fun expected)
|
|
||||||
(time (benchmark-check fun expected)))
|
|
||||||
|
|
||||||
(defun benchmark ()
|
|
||||||
(print '(tak 18 12 6))
|
|
||||||
(benchmark-time-it benchmark-tak 7)
|
|
||||||
(print '(fib 23))
|
|
||||||
(benchmark-time-it benchmark-fib 28657)
|
|
||||||
(print '(q 21))
|
|
||||||
(benchmark-time-it benchmark-q 12)
|
|
||||||
(print '(q2 7 8))
|
|
||||||
(benchmark-time-it benchmark-q2 31)
|
|
||||||
(print '(factor 2142142141))
|
|
||||||
(benchmark-time-it benchmark-factor *factor-prime*)
|
|
||||||
(print '(sieve 100000))
|
|
||||||
(benchmark-time-it benchmark-sieve 99991))
|
|
||||||
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
||||||
(defun pprintf (sym str)
|
|
||||||
"(pprintf sym str)
|
|
||||||
Pretty-print the function pointed to by sym to
|
|
||||||
the stream, which follows the 'format directives."
|
|
||||||
(let ((form (eval sym)))
|
|
||||||
(format str "(defun ~a ~a~%~{ ~a~^~%~})"
|
|
||||||
(string sym)
|
|
||||||
(cadr form)
|
|
||||||
(cddr form))))
|
|
||||||
|
|
||||||
(defun copy-file (source dest)
|
|
||||||
(with-sd-card (writer dest 2)
|
|
||||||
(with-sd-card (reader source)
|
|
||||||
(loop
|
|
||||||
(let ((data (read-byte reader)))
|
|
||||||
(when (null data)
|
|
||||||
(return))
|
|
||||||
(write-byte data writer))))))
|
|
||||||
|
|
||||||
(defun i2c-scan (port)
|
|
||||||
(dotimes (addr 127)
|
|
||||||
(with-i2c (str port addr)
|
|
||||||
(when str (print addr)))))
|
|
||||||
|
|
||||||
(defun i2c-scan2 (port)
|
|
||||||
(dotimes (addr 127)
|
|
||||||
(with-i2c (str port addr)
|
|
||||||
(format t "~,20'x: " addr)
|
|
||||||
(if str (print t)
|
|
||||||
(print nil)))))
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
;
|
|
||||||
; ULOS simple object system
|
|
||||||
; see http://forum.ulisp.com/t/a-simple-object-system-for-ulisp/622
|
|
||||||
;
|
|
||||||
|
|
||||||
; Define an object
|
|
||||||
(defun object (&optional parent slots)
|
|
||||||
(let ((obj (when parent (list (cons 'parent parent)))))
|
|
||||||
(loop
|
|
||||||
(when (null slots) (return obj))
|
|
||||||
(push (cons (first slots) (second slots)) obj)
|
|
||||||
(setq slots (cddr slots)))))
|
|
||||||
|
|
||||||
; Get the value of a slot in an object or its parents
|
|
||||||
(defun value (obj slot)
|
|
||||||
(when (symbolp obj) (setq obj (eval obj)))
|
|
||||||
(let ((pair (assoc slot obj)))
|
|
||||||
(if pair (cdr pair)
|
|
||||||
(let ((p (cdr (assoc 'parent obj))))
|
|
||||||
(and p (value p slot))))))
|
|
||||||
|
|
||||||
; Update a slot in an object
|
|
||||||
(defun update (obj slot value)
|
|
||||||
(when (symbolp obj) (setq obj (eval obj)))
|
|
||||||
(let ((pair (assoc slot obj)))
|
|
||||||
(when pair (setf (cdr pair) value))))
|
|
||||||
|
|
@ -1,7 +1,17 @@
|
||||||
/*
|
/*
|
||||||
User Extensions
|
User Extensions
|
||||||
|
|
||||||
|
LispBox uLisp Extension - Version 1.0 - June 2024
|
||||||
|
Hartmut Grawe - github.com/ersatzmoco - June 2024
|
||||||
|
|
||||||
|
edited by hasn0life for Lilygo T-Deck - Jan 2025
|
||||||
|
|
||||||
|
updated by picolisper for LilyGo T-Deck and
|
||||||
|
PicoCalc - April 2025
|
||||||
|
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
|
||||||
// Utility functions
|
// Utility functions
|
||||||
uint8_t
|
uint8_t
|
||||||
dec_to_bcd(uint8_t n)
|
dec_to_bcd(uint8_t n)
|
||||||
|
|
@ -23,7 +33,7 @@ bcd_to_dec(uint8_t n)
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Standard definitions
|
* STANDARD DEFINITIONS
|
||||||
*
|
*
|
||||||
* These definitions should be the same on every platform.
|
* These definitions should be the same on every platform.
|
||||||
*/
|
*/
|
||||||
|
|
@ -204,7 +214,6 @@ fn_listlibrary2(object *args, object *env)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
object *
|
object *
|
||||||
fn_lambdap(object *arg, object *env)
|
fn_lambdap(object *arg, object *env)
|
||||||
{
|
{
|
||||||
|
|
@ -221,6 +230,132 @@ fn_lambdap(object *arg, object *env)
|
||||||
return nil;
|
return nil;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
object *
|
||||||
|
fn_searchstr(object *args, object *env)
|
||||||
|
{
|
||||||
|
(void) env;
|
||||||
|
|
||||||
|
int startpos = 0;
|
||||||
|
object *pattern = first(args);
|
||||||
|
object *target = second(args);
|
||||||
|
args = cddr(args);
|
||||||
|
|
||||||
|
if (pattern == NULL) {
|
||||||
|
return number(0);
|
||||||
|
} else if (target == NULL) {
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (args != NULL) {
|
||||||
|
startpos = checkinteger(car(args));
|
||||||
|
}
|
||||||
|
|
||||||
|
if (stringp(pattern) && stringp(target)) {
|
||||||
|
int l = stringlength(target);
|
||||||
|
int m = stringlength(pattern);
|
||||||
|
|
||||||
|
if (startpos > l) {
|
||||||
|
error2(indexrange);
|
||||||
|
}
|
||||||
|
|
||||||
|
for (int i = startpos; i <= l-m; i++) {
|
||||||
|
int j = 0;
|
||||||
|
while (j < m && nthchar(target, i+j) == nthchar(pattern, j)) {
|
||||||
|
j++;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (j == m) {
|
||||||
|
return number(i);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return nil;
|
||||||
|
} else {
|
||||||
|
error2("arguments are not both lists or strings");
|
||||||
|
}
|
||||||
|
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
object *
|
||||||
|
fn_searchn(object *args, object *env)
|
||||||
|
{
|
||||||
|
(void) env;
|
||||||
|
|
||||||
|
int matches = 0;
|
||||||
|
int last_index = 0;
|
||||||
|
object *pattern = first(args);
|
||||||
|
object *target = second(args);
|
||||||
|
|
||||||
|
if (cddr(args) != NULL) {
|
||||||
|
object *num = third(args);
|
||||||
|
|
||||||
|
if (integerp(num)) {
|
||||||
|
matches = num->integer;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (pattern == NULL) {
|
||||||
|
return number(0);
|
||||||
|
} else if (target == NULL) {
|
||||||
|
return nil;
|
||||||
|
} else if (listp(pattern) && listp(target)) {
|
||||||
|
int l = listlength(target);
|
||||||
|
int m = listlength(pattern);
|
||||||
|
|
||||||
|
for (int i = 0; i <= l-m; i++) {
|
||||||
|
object *target1 = target;
|
||||||
|
while (pattern != NULL && eq(car(target1), car(pattern))) {
|
||||||
|
pattern = cdr(pattern);
|
||||||
|
target1 = cdr(target1);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (pattern == NULL){
|
||||||
|
last_index = i;
|
||||||
|
|
||||||
|
if (matches-- == 0) {
|
||||||
|
return number(i);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
pattern = first(args); target = cdr(target);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (last_index > 0) {
|
||||||
|
return number(last_index);
|
||||||
|
}
|
||||||
|
return nil;
|
||||||
|
} else if (stringp(pattern) && stringp(target)) {
|
||||||
|
int l = stringlength(target);
|
||||||
|
int m = stringlength(pattern);
|
||||||
|
|
||||||
|
for (int i = 0; i <= l-m; i++) {
|
||||||
|
int j = 0;
|
||||||
|
while (j < m && nthchar(target, i+j) == nthchar(pattern, j)) {
|
||||||
|
j++;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (j == m) {
|
||||||
|
last_index = i;
|
||||||
|
if(matches-- == 0){
|
||||||
|
return number(i);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (last_index > 0) {
|
||||||
|
return number(last_index);
|
||||||
|
}
|
||||||
|
|
||||||
|
return nil;
|
||||||
|
} else {
|
||||||
|
error2(PSTR("arguments are not both lists or strings"));
|
||||||
|
}
|
||||||
|
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
// SD card standard library.
|
// SD card standard library.
|
||||||
|
|
||||||
#if defined(sdcardsupport)
|
#if defined(sdcardsupport)
|
||||||
|
|
@ -378,6 +513,320 @@ fn_sd_list(object *args, object *env)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
* PICOCALC-SPECIFIC FUNCTIONS
|
||||||
|
*
|
||||||
|
* Only works on the PicoCalc...
|
||||||
|
*/
|
||||||
|
#if defined(PLATFORM_PICOCALC)
|
||||||
|
char
|
||||||
|
getkey()
|
||||||
|
{
|
||||||
|
PCKeyboard::KeyEvent kevt;
|
||||||
|
char keypress;
|
||||||
|
|
||||||
|
do {
|
||||||
|
kevt = pc_kbd.keyEvent();
|
||||||
|
|
||||||
|
if (kevt.state == PCKeyboard::StatePress) {
|
||||||
|
if (kevt.key == 6) {
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
|
||||||
|
keypress = kevt.key;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
} while (pc_kbd.keyCount() == 0);
|
||||||
|
|
||||||
|
|
||||||
|
do {
|
||||||
|
kevt = pc_kbd.keyEvent();
|
||||||
|
} while (kevt.state != PCKeyboard::StateRelease);
|
||||||
|
|
||||||
|
switch (keypress) {
|
||||||
|
case 177:
|
||||||
|
keypress = 27;
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
// do nothing
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
|
return keypress;
|
||||||
|
}
|
||||||
|
|
||||||
|
object *
|
||||||
|
fn_get_key(object *args, object *env)
|
||||||
|
{
|
||||||
|
(void) args;
|
||||||
|
(void) env;
|
||||||
|
|
||||||
|
return character(getkey());
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
#if defined(TDECK_PERI_POWERON)
|
||||||
|
#define touchscreen
|
||||||
|
|
||||||
|
#if defined(touchscreen)
|
||||||
|
#include "TouchDrvGT911.hpp"
|
||||||
|
TouchDrvGT911 touch;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define TDECK_TOUCH_INT 16
|
||||||
|
|
||||||
|
#define TDECK_TRACKBALL_UP 3
|
||||||
|
#define TDECK_TRACKBALL_DOWN 15
|
||||||
|
#define TDECK_TRACKBALL_LEFT 1
|
||||||
|
#define TDECK_TRACKBALL_RIGHT 2
|
||||||
|
#define PLATFORM_TDECK
|
||||||
|
|
||||||
|
volatile int ball_val = 0;
|
||||||
|
|
||||||
|
// Touchscreen
|
||||||
|
void
|
||||||
|
initTouch()
|
||||||
|
{
|
||||||
|
#if defined (touchscreen)
|
||||||
|
pinMode(TDECK_TOUCH_INT, INPUT);
|
||||||
|
touch.setPins(-1, TDECK_TOUCH_INT);\
|
||||||
|
//keyboard already initialized the I2C?
|
||||||
|
if (!touch.begin(Wire1, GT911_SLAVE_ADDRESS_L)) {
|
||||||
|
while (1) {
|
||||||
|
Serial.println("Failed to find GT911 - check your wiring!");
|
||||||
|
delay(1000);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
// Set touch max xy
|
||||||
|
touch.setMaxCoordinates(320, 240);
|
||||||
|
// Set swap xy
|
||||||
|
touch.setSwapXY(true);
|
||||||
|
// Set mirror xy
|
||||||
|
touch.setMirrorXY(false, true);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
void
|
||||||
|
ISR_trackball_up()
|
||||||
|
{
|
||||||
|
ball_val = 218;
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
ISR_trackball_down()
|
||||||
|
{
|
||||||
|
ball_val = 217;
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
ISR_trackball_left()
|
||||||
|
{
|
||||||
|
ball_val = 216;
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
ISR_trackball_right ()
|
||||||
|
{
|
||||||
|
ball_val = 215;
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
inittrackball()
|
||||||
|
{
|
||||||
|
pinMode(TDECK_TRACKBALL_UP, INPUT_PULLUP);
|
||||||
|
pinMode(TDECK_TRACKBALL_DOWN, INPUT_PULLUP);
|
||||||
|
pinMode(TDECK_TRACKBALL_LEFT, INPUT_PULLUP);
|
||||||
|
pinMode(TDECK_TRACKBALL_RIGHT, INPUT_PULLUP);
|
||||||
|
attachInterrupt(digitalPinToInterrupt(TDECK_TRACKBALL_UP), ISR_trackball_up, FALLING);
|
||||||
|
attachInterrupt(digitalPinToInterrupt(TDECK_TRACKBALL_DOWN), ISR_trackball_down, FALLING);
|
||||||
|
attachInterrupt(digitalPinToInterrupt(TDECK_TRACKBALL_LEFT), ISR_trackball_left, FALLING);
|
||||||
|
attachInterrupt(digitalPinToInterrupt(TDECK_TRACKBALL_RIGHT), ISR_trackball_right, FALLING);
|
||||||
|
}
|
||||||
|
|
||||||
|
object *
|
||||||
|
fn_get_touch_points(object *args, object *env)
|
||||||
|
{
|
||||||
|
#if defined(touchscreen)
|
||||||
|
int16_t x[5], y[5];
|
||||||
|
uint8_t touched = 0;
|
||||||
|
object *result = nil;
|
||||||
|
do {
|
||||||
|
touched = touch.getPoint(x, y, touch.getSupportTouchPoint());
|
||||||
|
if (touched > 0) {
|
||||||
|
//start from the end of the list so we dont have to reverse it
|
||||||
|
for (int i = touched; i > 0; --i) {
|
||||||
|
result = cons(cons(number(x[i-1]), number(y[i-1])), result);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} while(touch.isPressed());
|
||||||
|
return result;
|
||||||
|
|
||||||
|
#else
|
||||||
|
return nil;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
bool
|
||||||
|
isScreenTouched()
|
||||||
|
{
|
||||||
|
bool received_touch = false;
|
||||||
|
|
||||||
|
// Clear any previous readings since it buffers those.
|
||||||
|
do {
|
||||||
|
int16_t x[5], y[5];
|
||||||
|
uint8_t touched = touch.getPoint(x, y, touch.getSupportTouchPoint());
|
||||||
|
} while(touch.isPressed());
|
||||||
|
|
||||||
|
// touch.ispressed() will trigger like 5 times if you press it once so
|
||||||
|
// we have to loop through it and get the touchpoints
|
||||||
|
do {
|
||||||
|
int16_t x[5], y[5];
|
||||||
|
uint8_t touched = touch.getPoint(x, y, touch.getSupportTouchPoint());
|
||||||
|
if (touched > 0) {
|
||||||
|
received_touch = true;
|
||||||
|
}
|
||||||
|
} while(touch.isPressed());
|
||||||
|
|
||||||
|
return received_touch;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
// T-Deck extras
|
||||||
|
char
|
||||||
|
touchKeyModEditor(char temp)
|
||||||
|
{
|
||||||
|
#if defined (touchscreen)
|
||||||
|
/* t-deck / blackberry keyboard missing symbols
|
||||||
|
missing mapped alt symbol
|
||||||
|
` k '
|
||||||
|
~ p @
|
||||||
|
% $
|
||||||
|
^ a *
|
||||||
|
& q #
|
||||||
|
= o +
|
||||||
|
< t (
|
||||||
|
> y )
|
||||||
|
\ u _
|
||||||
|
| g /
|
||||||
|
|
||||||
|
[ alt-t (
|
||||||
|
] alt-y )
|
||||||
|
|
||||||
|
{ n/a
|
||||||
|
} n/a
|
||||||
|
tab space
|
||||||
|
|
||||||
|
while holding the touch screen
|
||||||
|
c --- quit editor and return to REPL
|
||||||
|
n --- discard current text buffer (i.e. new file)
|
||||||
|
backspace --- delete line starting at cursor position
|
||||||
|
trackball left --- move cursor to start of line
|
||||||
|
trackball right --- move cursor to end of line
|
||||||
|
^ --- move cursor to beginning of buffer
|
||||||
|
trackball up / trackball down --- move one page up or down
|
||||||
|
|
||||||
|
Fn-h --- help menu
|
||||||
|
Fn-( --- toggle bracket matching on/off
|
||||||
|
Fn-) --- check if bracket under the cursor has a matching bracket
|
||||||
|
in the buffer. If so, they are temporarily highlighted.
|
||||||
|
(Use when continuous bracket matching is off.)
|
||||||
|
Fn-b --- bind contents of the text buffer to a symbol of your choice and quit editor
|
||||||
|
Fn-d --- delete a file on the SD card
|
||||||
|
Fn-s --- save text buffer to SD card
|
||||||
|
Fn-l --- load text from SD card into buffer, discarding the present one
|
||||||
|
Fn-i --- show directory of SD card
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
if (isScreenTouched()) {
|
||||||
|
if (temp == 'k') return '`';
|
||||||
|
else if (temp == 'p') return '~';
|
||||||
|
else if (temp == '$') return '%';
|
||||||
|
else if (temp == 'a') return '^';
|
||||||
|
else if (temp == 'q') return '&';
|
||||||
|
else if (temp == 'o') return '=';
|
||||||
|
else if (temp == 't') return '<';
|
||||||
|
else if (temp == 'y') return '>';
|
||||||
|
else if (temp == 'u') return '\\';
|
||||||
|
else if (temp == 'g') return '|';
|
||||||
|
else if (temp == '(') return '[';
|
||||||
|
else if (temp == ')') return ']';
|
||||||
|
else if (temp == ' ') return '\t';
|
||||||
|
|
||||||
|
else if (temp == 'c') return (char)17; //quit
|
||||||
|
else if (temp == 'n') return (char)24; //new
|
||||||
|
else if (temp == 8) return (char)12; //delete line
|
||||||
|
else if (temp == '*') return (char)94; //beginning
|
||||||
|
else if (temp == 'h') return (char)16; //help
|
||||||
|
else if (temp == 's') return (char)203; //save
|
||||||
|
else if (temp == 'l') return (char)204; //load
|
||||||
|
else if (temp == 'd') return (char)202; //delete
|
||||||
|
else if (temp == 'b') return (char)198; //bind
|
||||||
|
else if (temp == 'i') return (char)205; //show dir
|
||||||
|
else if (temp == '1') return (char)194; //toggle bracket
|
||||||
|
else if (temp == '2') return (char)195; //highlight
|
||||||
|
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
if (temp == '@') temp = '~';
|
||||||
|
if (temp == '_') temp = '\\';
|
||||||
|
#endif
|
||||||
|
return temp;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
object *
|
||||||
|
fn_KeyboardGetKey(object *args, object *env)
|
||||||
|
{
|
||||||
|
(void) env, (void) args;
|
||||||
|
|
||||||
|
Wire1.requestFrom(0x55, 1);
|
||||||
|
if (Wire1.available()) {
|
||||||
|
char temp = Wire1.read();
|
||||||
|
if ((temp != 0) && (temp !=255)){
|
||||||
|
temp = touchKeyModEditor(temp);
|
||||||
|
//Serial.println((int)temp);
|
||||||
|
return number(temp);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (ball_val != 0) {
|
||||||
|
int temp = ball_val;
|
||||||
|
ball_val = 0;
|
||||||
|
if (isScreenTouched()) {
|
||||||
|
// ((or 1 210) (se:linestart))
|
||||||
|
// ((or 5 213) (se:lineend))
|
||||||
|
// (211 (se:prevpage))
|
||||||
|
// (214 (se:nextpage))
|
||||||
|
switch(temp){
|
||||||
|
case 218: temp = 211; break; //up
|
||||||
|
case 217: temp = 214; break; //down
|
||||||
|
case 216: temp = 210; break; //left
|
||||||
|
case 215: temp = 213; break; //right
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return number(temp);
|
||||||
|
}
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
(keyboard-flush)
|
||||||
|
Discard missing key up/down events.
|
||||||
|
*/
|
||||||
|
object *
|
||||||
|
fn_KeyboardFlush(object *args, object *env)
|
||||||
|
{
|
||||||
|
(void) args, (void) env;
|
||||||
|
return nil;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* SYMBOL NAMES
|
* SYMBOL NAMES
|
||||||
*
|
*
|
||||||
|
|
@ -390,6 +839,8 @@ const char stringbcd_to_dec[] PROGMEM = "bcd-to-dec";
|
||||||
const char stringdec_to_bcd[] PROGMEM = "dec-to-bcd";
|
const char stringdec_to_bcd[] PROGMEM = "dec-to-bcd";
|
||||||
const char stringlist_library2[] PROGMEM = "list-library2";
|
const char stringlist_library2[] PROGMEM = "list-library2";
|
||||||
const char stringplatform[] PROGMEM = "platform";
|
const char stringplatform[] PROGMEM = "platform";
|
||||||
|
const char stringSearchStr[] PROGMEM = "search-str";
|
||||||
|
const char stringsearchn[] PROGMEM = "searchn";
|
||||||
|
|
||||||
#if defined(sdcardsupport)
|
#if defined(sdcardsupport)
|
||||||
const char stringsd_rename[] PROGMEM = "sd-rename";
|
const char stringsd_rename[] PROGMEM = "sd-rename";
|
||||||
|
|
@ -400,6 +851,21 @@ const char stringsd_rmdir[] PROGMEM = "sd-remove-dir";
|
||||||
const char stringsd_dir[] PROGMEM = "sd-list";
|
const char stringsd_dir[] PROGMEM = "sd-list";
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#if defined(PLATFORM_PICOCALC)
|
||||||
|
const char string_get_key[] PROGMEM = "get-key";
|
||||||
|
#elif defined(TDECK_PERI_POWERON)
|
||||||
|
const char string_gettouchpoints[] PROGMEM = "get-touch-points";
|
||||||
|
const char stringKeyboardGetKey[] PROGMEM = "keyboard-get-key";
|
||||||
|
const char stringKeyboardFlush[] PROGMEM = "keyboard-flush";
|
||||||
|
const char stringSearchStr[] PROGMEM = "search-str";
|
||||||
|
const char stringsearchn[] PROGMEM = "searchn";
|
||||||
|
|
||||||
|
#elif defined(TDECK_PERI_POWERON)
|
||||||
|
const char string_gettouchpoints[] PROGMEM = "get-touch-points";
|
||||||
|
const char stringKeyboardGetKey[] PROGMEM = "keyboard-get-key";
|
||||||
|
const char stringKeyboardFlush[] PROGMEM = "keyboard-flush";
|
||||||
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* DOCUMENTATION STRINGS
|
* DOCUMENTATION STRINGS
|
||||||
*
|
*
|
||||||
|
|
@ -432,6 +898,17 @@ const char doc_platform[] PROGMEM = "(platform)\n"
|
||||||
"Returns a keyword with the current platform. Supports :picocalc,\n"
|
"Returns a keyword with the current platform. Supports :picocalc,\n"
|
||||||
":t-deck, and :teensy41. Otherwise, returns :unknown.";
|
":t-deck, and :teensy41. Otherwise, returns :unknown.";
|
||||||
|
|
||||||
|
const char docSearchStr[] PROGMEM = "(search pattern target [startpos])\n"
|
||||||
|
"Returns the index of the first occurrence of pattern in target, or nil if it's not found\n"
|
||||||
|
"starting from startpos";
|
||||||
|
|
||||||
|
const char docsearchn[] PROGMEM = "(searchn pattern target [n])\n"
|
||||||
|
"Returns the index of the nth occurrence of pattern in target,\n"
|
||||||
|
"which can be lists or strings, or nil if it's not found.\n"
|
||||||
|
"if the pattern occured more than once but less than n times, it returns the last occuring index";
|
||||||
|
|
||||||
|
|
||||||
|
// SD card doc strings
|
||||||
#if defined(sdcardsupport)
|
#if defined(sdcardsupport)
|
||||||
const char docsd_rename[] PROGMEM = "(sd-rename from to)\n"
|
const char docsd_rename[] PROGMEM = "(sd-rename from to)\n"
|
||||||
"Renames the file named by 'from' to 'to.'";
|
"Renames the file named by 'from' to 'to.'";
|
||||||
|
|
@ -455,6 +932,25 @@ const char docsd_rmdir[] PROGMEM = "(sd-remove-dir directory)\n"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
// PicoCalc-specific doc strings
|
||||||
|
#if defined(PLATFORM_PICOCALC)
|
||||||
|
const char doc_get_key[] PROGMEM = "(get-key)\n"
|
||||||
|
"Waits for a keypress event, then returns the key.";
|
||||||
|
|
||||||
|
// T-Deck-specific doc strings
|
||||||
|
#elif defined(TDECK_PERI_POWERON)
|
||||||
|
const char doc_gettouchpoints[] PROGMEM = "(get-touch-points)\n"
|
||||||
|
"Returns all the points being touched on the screen in a list of x,y pairs or an empty list";
|
||||||
|
|
||||||
|
const char docKeyboardGetKey[] PROGMEM = "(keyboard-get-key [pressed])\n"
|
||||||
|
"Get key last recognized - default: when released, if [pressed] is t: when pressed).";
|
||||||
|
const char docKeyboardFlush[] PROGMEM = "(keyboard-flush)\n"
|
||||||
|
"Discard missing key up/down events.";
|
||||||
|
|
||||||
|
// End of platform-specific doc strings.
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
// Symbol lookup table
|
// Symbol lookup table
|
||||||
const tbl_entry_t lookup_table2[] PROGMEM = {
|
const tbl_entry_t lookup_table2[] PROGMEM = {
|
||||||
{ stringlambdap, fn_lambdap, 0211, doclambdap },
|
{ stringlambdap, fn_lambdap, 0211, doclambdap },
|
||||||
|
|
@ -464,6 +960,8 @@ const tbl_entry_t lookup_table2[] PROGMEM = {
|
||||||
{ stringdec_to_bcd, fn_dec_to_bcd, 0211, doc_dec_to_bcd },
|
{ stringdec_to_bcd, fn_dec_to_bcd, 0211, doc_dec_to_bcd },
|
||||||
{ stringlist_library2, fn_listlibrary2, 0200, doc_list_library2 },
|
{ stringlist_library2, fn_listlibrary2, 0200, doc_list_library2 },
|
||||||
{ stringplatform, fn_platform, 0200, doc_platform },
|
{ stringplatform, fn_platform, 0200, doc_platform },
|
||||||
|
{ stringSearchStr, fn_searchstr, 0224, docSearchStr },
|
||||||
|
{ stringsearchn, fn_searchn, 0223, docsearchn },
|
||||||
|
|
||||||
#if defined(sdcardsupport)
|
#if defined(sdcardsupport)
|
||||||
{ stringsd_rename, fn_sd_rename, 0222, docsd_rename },
|
{ stringsd_rename, fn_sd_rename, 0222, docsd_rename },
|
||||||
|
|
@ -473,6 +971,14 @@ const tbl_entry_t lookup_table2[] PROGMEM = {
|
||||||
{ stringsd_mkdir, fn_sd_mkdir, 0211, docsd_mkdir },
|
{ stringsd_mkdir, fn_sd_mkdir, 0211, docsd_mkdir },
|
||||||
{ stringsd_rmdir, fn_sd_rmdir, 0211, docsd_rmdir },
|
{ stringsd_rmdir, fn_sd_rmdir, 0211, docsd_rmdir },
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#if defined(PLATFORM_PICOCALC)
|
||||||
|
{ string_get_key, fn_get_key, 0200, doc_get_key },
|
||||||
|
#elif defined(TDECK_PERI_POWERON)
|
||||||
|
{ string_gettouchpoints, fn_get_touch_points, 0200, doc_gettouchpoints },
|
||||||
|
{ stringKeyboardGetKey, fn_KeyboardGetKey, 0201, docKeyboardGetKey },
|
||||||
|
{ stringKeyboardFlush, fn_KeyboardFlush, 0200, docKeyboardFlush },
|
||||||
|
#endif
|
||||||
};
|
};
|
||||||
|
|
||||||
// Table cross-reference functions
|
// Table cross-reference functions
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue