ulisp-mode (wip)

cu-ulisp-mode.el

(define-minor-mode ulisp-mode
  "Simple uLisp mode that overrides slime-eval-* with lisp-eval-* equivalents,
and can automatically update dynamic fn-refs for call-c-fun"
  :init-value nil
  :lighter " uLisp"
  :keymap nil
  (if ulisp-mode
      (progn
        (setq dc/previous-i-l-p inferior-lisp-program)
        (setq inferior-lisp-program "cu -l /dev/ttyACM0 -s 9600")
        (setq comint-process-echoes t)

        (defadvice slime-eval-defun (around lisp-eval-defun activate)
          (lisp-eval-defun (ad-get-arg 0)))

        (defadvice slime-eval-region (around lisp-eval-region activate)
          (lisp-eval-region (ad-get-arg 0) (ad-get-arg 1)))

        (defadvice slime-eval-buffer (around lisp-eval-buffer activate)
          (lisp-eval-buffer))

        (defadvice slime-eval-last-expression (around lisp-eval-last-sexp activate)
          (lisp-eval-last-sexp))

        (defun find-project-directory ()
          "Find the project directory containing the current buffer's file."
          (let ((dir (file-name-directory (buffer-file-name))))
            (while (and dir (not (file-exists-p (expand-file-name ".git" dir))))
              (setq dir (file-name-directory (directory-file-name dir))))
            dir))

        (defun kebab-to-camel (str)
          (let ((case-fold-search nil))
            (replace-regexp-in-string
             "-\\([a-z]\\)" (lambda (match) (upcase (substring match 1))) str t)))

        (defun camel-to-kebab (str)
          "Convert camelCase string STR to kebab-case."
          (let ((case-fold-search nil))
            (downcase
             (replace-regexp-in-string "\\([a-z]\\)\\([A-Z]\\)" "\\1-\\2" str t))))


        (defun extract-defvars ()
          (save-excursion
            (goto-char (point-min))
            (let (result)
              (while (re-search-forward "(defvar \\(.*?\\) \\(#x[0-9a-gA-F]+\\))" nil t)
                (let ((defvar-name (substring-no-properties (match-string 1)))
                      (address (substring-no-properties (match-string 2))))
                  (push (cons defvar-name address) result)))
              result)))

        (defun find-closest-match (fn-name nm-output old-address)
          (let ((matches (find-matching-addresses fn-name nm-output old-address)))
            (when matches
              (setq matches (sort matches (lambda (a b)
                                            (or (< (nth 2 a) (nth 2 b))
                                                (and (= (nth 2 a) (nth 2 b)) (< (nth 3 a) (nth 3 b)))))))
              (let ((closest-match (car matches)))
                (nth 1 closest-match)))))


        (defun find-matching-addresses (fn-name nm-output old-address)
          (let (matches)
            (with-temp-buffer
              (insert nm-output)
              (goto-char (point-min))
              (while (re-search-forward "\\([0-9a-fA-F]+\\) \\(\\S-+\\) \\(\\(?:[a-zA-Z_][a-zA-Z0-9_:]*\\)?\\)" nil t)

                (let* ((address (match-string 1))
                       (symbol-type (match-string 2))
                       (full-fn-name (match-string 3))
                       (base-fn-name (replace-regexp-in-string ".* " "" full-fn-name))
                       (class-name (car (split-string base-fn-name "::")))
                       (method-name (or (cadr (split-string base-fn-name "::"))
                                        base-fn-name))
                       (name-distance (string-distance fn-name method-name))
                       (address-distance (if (string= old-address "#xg")
                                             0
                                           (abs (- (string-to-number address 16)
                                                   (string-to-number (string-replace "#x" "" old-address) 16))))))
                  (push (list class-name address name-distance address-distance
                              method-name old-address base-fn-name) matches)))
              (when matches
                (setq matches (sort matches (lambda (a b)
                                              (or (< (nth 2 a) (nth 2 b))
                                                  (and (= (nth 2 a) (nth 2 b)) (< (nth 3 a) (nth 3 b))))))))
              matches)))


        (defun update-defvars ()
          "Update defvars with the corresponding addresses using `nm` command.
   Display alternative matches with name-distance of 0 as comments."
          (interactive)
          (with-undo-amalgamate
            (let* ((project-dir (find-project-directory))
                   (defvars (extract-defvars)))
              (save-excursion
                (dolist (defvar defvars)
                  (let* ((defvar-name (car defvar))
                         (old-address (cdr defvar))
                         (fn-name (kebab-to-camel defvar-name))
                         (nm-output (shell-command-to-string
                                     (concat "nm " project-dir
                                             ".pio/build/pico/firmware.elf --demangle | grep " fn-name)))
                         (new-address (concat "#x" (find-closest-match fn-name nm-output old-address)))
                         (alternative-matches (find-matching-addresses fn-name nm-output old-address)))
                    (when new-address
                      (replace-string old-address new-address nil (point-min) (point-max))
                      (when alternative-matches
                        (insert-alternative-matches-comments alternative-matches)))))))))



        (defun kill-current-comment ()
          (let* ((existing-comment-start (search-backward " ; " (line-beginning-position) t))
                 (existing-comment-end (line-end-position)))
            (when (and existing-comment-start
                       (<= existing-comment-start existing-comment-end))
              (delete-region existing-comment-start existing-comment-end))))

        (defun insert-alternative-matches-comments (alternative-matches)
          "Insert comments for alternative matches with name-distance of 0.
   Include function name and addresses."
          (let ((closest-match-fuzzy? (< 2 (nth 2 (car alternative-matches))))
                (alt-matches (cdr (seq-take-while (lambda (match) (> 2 (nth 2 match))) alternative-matches))))
            (end-of-line)
            (kill-current-comment)
            (cond
             (alt-matches
              (insert (concat " ; " (caar alternative-matches)))
              (insert " - Alts: ")
              (insert (mapconcat (lambda (m) (format "%s #x%s" (car m) (cadr m)) ) alt-matches)))

             (closest-match-fuzzy?
              (insert " ; Opts: \n(\n")
              (insert (mapconcat (lambda (m) (format "(defvar %s #x%s) ; %s\n"
                                                     (camel-to-kebab (nth 4 m))
                                                     (cadr m)
                                                     (car (last m))) ) alternative-matches))
              (insert ")")
              ))))

        (message "simple-list-mode enabled"))


    (progn (setq inferior-lisp-program dc/previous-i-f-p)
           (message "simple-list-mode disabled"))

    (ad-disable-advice 'slime-eval-defun 'around 'lisp-eval-defun)
    (ad-activate 'slime-eval-defun)

    (ad-disable-advice 'slime-eval-region 'around 'lisp-eval-region)
    (ad-activate 'slime-eval-region)

    (ad-disable-advice 'slime-eval-buffer 'around 'lisp-eval-buffer)
    (ad-activate 'slime-eval-buffer)

    (ad-disable-advice 'slime-eval-last-expression 'around 'lisp-eval-last-expression)
    (ad-activate 'slime-eval-last-expression)))

Also, here is a wip call-c-fun variant for calling methods of a specific instance:

(defvar tft #x20030b74)
(defvar fillscreen #x10012635)
(call-c-method tft fillscreen 20)

using MethodPtr = uint32_t (*)(void*);

object *fn_call_c_method(object *args, object *env) {
    (void) env;
    void* inst;
    MethodPtr pAddr;

    object *arg = first(args);
    if (checkinteger(arg) && checkinteger(second(args))) {
        inst = reinterpret_cast<void*>(checkinteger(arg));
        pAddr = reinterpret_cast<MethodPtr>(checkinteger(second(args)));
    } else {
        return nil;
    }

    object *ret;
    object *fun_args = cdr(cdr(args));
    int arg_len = listlength(fun_args);
    printf("addr=%p arg_len=%d\n", pAddr, arg_len);

    std::function<object*(void*)> method = [pAddr](void* instance) {
       int ret = reinterpret_cast<int (*)(void*)>(pAddr)(instance);
        return number(ret);
    };

    switch (arg_len) {
        case 0: {
            ret = method(inst);
            break;
        }
        case 1: {
            void* arg1 = get_value(first(fun_args));
             ret = std::bind(method, inst)(arg1);
            break;
        }
        case 2: {
            void* arg1 = get_value(first(fun_args));
            void* arg2 = get_value(second(fun_args));
            ret = std::bind(method, inst)(arg1, arg2);
            break;
        }
        case 3: {
            void* arg1 = get_value(first(fun_args));
            void* arg2 = get_value(second(fun_args));
            void* arg3 = get_value(third(fun_args));
            ret = std::bind(method, inst)(arg1, arg2, arg3);
            break;
        }

        default:
            SerialPrintInt(arg_len);
            error(toomanyargs, args);
            return nil;
    }

    return ret;
}


// Symbol names
const char string_call_c_method[] PROGMEM = "call-c-method";

// Documentation strings

const char doc_call_c_method[] PROGMEM = "(call-c-method class-address method-address arg0 arg1 ...)\n"
"call a c class method with args";