diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 333bac2..e1aba46 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -1186,5 +1186,121 @@ arrive in the same load or the first refers to storage that does not exist." (interactive "r") (flan-dev--eval (flan-dev--text start end) "region" start end)) +;;; Disassembly + +;; `flan emit --dev' prints the IR a source file would compile to. This asks a +;; different question: what did the code the running program is calling for +;; this name actually come out as. Only the daemon can answer it, because the +;; daemon compiled every module it sent and still has both the .ll and the .so +;; — so the editor asks rather than shelling out to a compiler of its own, +;; which would show what the source says today and not what was installed. +;; +;; The header is SBCL's habit: say which function, from where, and out of +;; which object, before a line of code. The one line that matters most is +;; `showing', which is the daemon's own account of how much its answer claims +;; — there is no way to read an indirection cell back, so a body that has been +;; delivered is not thereby known to be installed, and the buffer says which of +;; the two it is looking at rather than letting the listing imply the stronger +;; one. + +(defvar flan-disassembly-buffer "*flan-disassembly*" + "Buffer `flan-disassemble' writes into.") + +(define-derived-mode flan-disassembly-mode special-mode "Flan-Disasm" + "Mode for the buffer `flan-disassemble' writes." + (setq-local truncate-lines t)) + +(defun flan-disassemble--header (label text) + "Insert a header line naming LABEL with TEXT, wrapped under the label." + (let ((fill-column 78) + (start (point))) + (insert (format "; %-11s %s\n" label text)) + (fill-region start (point)) + ;; `fill-region' breaks the line but does not carry the comment character + ;; onto the continuation, and a listing whose header stops being a comment + ;; halfway down reads as output rather than as commentary. + (save-excursion + (goto-char start) + (forward-line 1) + (while (< (point) (point-max)) + (insert "; ") + (forward-line 1))) + (put-text-property start (point) 'face 'font-lock-comment-face))) + +;;;###autoload +(defun flan-disassemble (name &optional ir) + "Show the code NAME last compiled to in the running program's own build. + +With a prefix argument, or non-nil IR, show the LLVM IR the body was built +from instead of the machine code it was assembled to. + +The name is resolved the way `M-.' resolves one: exactly first, then as the +tail of exactly one packaged name, because a buffer inside a package writes +`settle' for what the program calls `sim/settle'." + (interactive + (list (or (thing-at-point 'symbol t) + (completing-read + "Disassemble: " + (mapcar #'car (seq-filter (lambda (d) (equal (nth 1 d) "fn")) + flan-dev--defs)) + nil t nil nil + (and (fboundp 'flan-current-defun-name) + (flan-current-defun-name)))) + current-prefix-arg)) + (when (process-live-p flan-dev--connection) + (ignore-errors (flan-dev-refresh-defs))) + (let* ((d (flan-dev--lookup name)) + ;; Ambiguity is refused here rather than sent: the daemon would find + ;; no such name and say so, which is true and useless — it is this end + ;; that knows the buffer wrote a short name and that several program + ;; names end in it. + (_ (unless d + (when-let ((hits (flan-dev--ambiguous name))) + (user-error "flan: %s could be %s; write the one you mean" + name (string-join (mapcar #'car hits) " or "))))) + (full (if d (nth 0 d) name)) + (form (if ir "ir" "asm")) + (r (flan-dev--request (list :op "disassemble" :name full :form form)))) + (unless (equal (plist-get r :status) "ok") + (user-error "flan: %s" (or (plist-get r :message) "refused"))) + (with-current-buffer (get-buffer-create flan-disassembly-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (flan-disassembly-mode) + (let ((start (point))) + (insert (format "; %s for %s\n" + (if ir "LLVM IR" "disassembly") full)) + (put-text-property start (point) 'face 'font-lock-comment-face)) + (flan-disassemble--header "signature" (plist-get r :signature)) + (flan-disassemble--header "source" (plist-get r :loc)) + (flan-disassemble--header + "generation" + (let ((g (plist-get r :generation))) + (if (and (numberp g) (zerop g)) + "0 (the build the program was launched from)" + (format "%s" g)))) + (flan-disassemble--header "object" (plist-get r :object)) + (flan-disassemble--header "showing" (plist-get r :basis)) + (when (plist-get r :note) + (flan-disassemble--header "note" (plist-get r :note))) + (insert "\n") + (insert (plist-get r :text)) + (goto-char (point-min)))) + (display-buffer flan-disassembly-buffer))) + +;;;###autoload +(defun flan-disassemble-ir (name) + "Show the LLVM IR NAME's installed body was built from. +`flan-disassemble' with a prefix argument does the same thing; this exists so +that the IR half is findable by name rather than only by a modifier." + (interactive + (list (or (thing-at-point 'symbol t) + (completing-read + "LLVM IR for: " + (mapcar #'car (seq-filter (lambda (d) (equal (nth 1 d) "fn")) + flan-dev--defs)) + nil t)))) + (flan-disassemble name t)) + (provide 'flan-dev) ;;; flan-dev.el ends here diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index f515972..c99393b 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -128,6 +128,10 @@ line is off screen." ;; C-h after a prefix is how anyone finds out what is under C-c, and a ;; binding there takes that away. (define-key map (kbd "C-c C-v") #'flan-doc) + ;; The code the running program is calling for a name, as amd64 or as the + ;; IR it was built from. C-u for the IR rather than a second key: it is + ;; the same question asked of the same body. + (define-key map (kbd "C-c C-a") #'flan-disassemble) ;; The way out when a reload is refused: rebuild, relaunch, reconnect. (define-key map (kbd "C-c C-x") #'flan-dev-restart-program) map)