cosmopolitan/tool/emacs/cosmo-stuff.el

;; ╔──────────────────────────────────────────────────────────────────╗
;; │ To the extent possible under law, Justine Tunney has waived      │
;; │ all copyright and related or neighboring rights to this file,    │
;; │ as it is written in the following disclaimers:                   │
;; │   • http://unlicense.org/                                        │
;; │   • http://creativecommons.org/publicdomain/zero/1.0/            │
;; ╚──────────────────────────────────────────────────────────────────╝
;; Hodgepodge of copypasta from Justine's Emacs config intended to be
;; helpful to those wanting to configure their own Emacs editor to work
;; pretty well as a Cosmopolitan IDE.

;;; Code:

(require 'asm-mode)
(require 'cc-mode)
(require 'fortran)
(require 'cosmo-c-types)
(require 'cosmo-c-keywords)
(require 'cosmo-c-builtins)
(require 'cosmo-c-constants)
(require 'cosmo-cpp-constants)
(require 'cosmo-platform-constants)
(require 'dired)
(require 'javadown)
(require 'ld-script)
(require 'make-mode)

(setq c-doc-comment-style 'javadown)

(add-to-list 'auto-mode-alist '("\\.x$" . c-mode))  ;; -aux-info


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support Macros

(defmacro setql (var val)
  `(set (make-local-variable ',var) ,val))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support Functions

(defun cosmo-contains (x s &optional icase)
  (declare (pure t) (side-effect-free t))
  (let ((case-fold-search icase))
    (not (null (string-match-p (regexp-quote x) s)))))

(defun cosmo-startswith (x s &optional icase)
  (declare (pure t) (side-effect-free t))
  (not (null (string-prefix-p x s icase))))

(defun cosmo-endswith (x s &optional icase)
  (declare (pure t) (side-effect-free t))
  (let ((p (- (length s) (length x))))
    (and (>= p 0)
         (eq t (compare-strings x nil nil
                                s p nil icase)))))

(defun cosmo-replace (x y s)
  (declare (pure t) (side-effect-free t))
  (let ((case-fold-search nil))
    (replace-regexp-in-string (regexp-quote x) y s t t)))

(defun cosmo-join (s l)
  (declare (pure t) (side-effect-free t))
  (mapconcat 'identity l s))

(defun cosmo-lchop (p s)
  (declare (pure t) (side-effect-free t))
  (if (and (>= (length s) (length p))
           (string= p (substring s 0 (length p))))
      (substring s (length p))
    s))

(defun cosmo-first-that (predicate list)
  (declare (pure t))
  (when list
    (if (funcall predicate (car list))
        (car list)
      (cosmo-first-that predicate (cdr list)))))

(defun cosmo-file-name-sans-extensions (filename)
  (save-match-data
    (let (directory
          (file (file-name-sans-versions
                 (file-name-nondirectory filename))))
      (if (and (string-match "[.-].*\\'" file)
	       (not (eq 0 (match-beginning 0))))
	  (if (setq directory (file-name-directory filename))
	      (concat directory (substring file 0 (match-beginning 0)))
	    (substring file 0 (match-beginning 0)))
	filename))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; C-c .     Jump to symbol definition
;; C-c ,     Jump back to where we were
;; C-c C-i   Show references to symbol

;; TODO(jart): Why doesnt the default-directory variable work?
(defun project-current (&optional maybe-prompt dir)
  (expand-file-name
   (file-name-directory
    (locate-dominating-file
     (buffer-name) "Makefile"))))

(defun cosmo-xref-find-references ()
  (interactive)
  (let ((case-fold-search nil))
    (xref-find-references (format "%S" (symbol-at-point)))))

(defun cosmo-symbol-at-point (&optional no-properties)
  (let ((stab (copy-syntax-table)))
    (with-syntax-table stab
      (modify-syntax-entry ?+ " ")
      (let ((thing (thing-at-point 'symbol no-properties)))
        (when thing
          (intern thing))))))

(defun cosmo-xref-find-definitions ()
  (interactive)
  (let ((case-fold-search nil))
    (xref-find-definitions (format "%S" (cosmo-symbol-at-point)))))

(global-set-key (kbd "M-,") 'xref-pop-marker-stack)
(global-set-key (kbd "M-.") 'cosmo-xref-find-definitions)
(global-set-key (kbd "C-c TAB") 'cosmo-xref-find-references)

(defun stop-asking-questions-etags ()
  (set (make-local-variable 'tags-file-name)
       (format "%s/TAGS"
               (or (locate-dominating-file (buffer-name) "Makefile")
                   (file-name-directory (buffer-name))))))
(add-hook 'c-mode-common-hook 'stop-asking-questions-etags)
(add-hook 'c++-mode-common-hook 'stop-asking-questions-etags)
(setq tags-revert-without-query t)
(setq kill-buffer-query-functions ;; disable kill buffer w/ process question
      (delq 'process-kill-buffer-query-function kill-buffer-query-functions))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compile buffer and run associated test and/or display assembly
;;       C-c C-c   Compile
;;   M-1 C-c C-c   Compile w/ MODE=tiny
;;   M-2 C-c C-c   Compile w/ MODE=opt
;;   M-3 C-c C-c   Compile w/ MODE=rel
;;   M-4 C-c C-c   Compile w/ MODE=dbg
;;   M-5 C-c C-c   Compile w/ MODE=""
;;   M-8 C-c C-c   Compile w/ llvm
;;   M-9 C-c C-c   Compile w/ chibicc

(defun cosmo-intest (&optional file-name)
  (let (path root pkg)
    (and (setq path (or (buffer-file-name) dired-directory))
         (setq root (locate-dominating-file path "Makefile"))
         (setq pkg (file-relative-name path root))
         (cosmo-startswith "test/" pkg))))

(defun cosmo--make-mode (arg &optional default)
  (cond ((eq arg 1) "tiny")
        ((eq arg 2) "opt")
        ((eq arg 3) "rel")
        ((eq arg 4) "dbg")
        ((eq arg 5) "")
        ((eq arg 8) "llvm")
        (default default)
        ((cosmo-intest) "dbg")
        (t "")))

(defun cosmo--make-suffix (arg)
  (cond ((eq arg 9) ".chibicc")
        (t "")))

(defun cosmo--make-objdump-flags (arg)
  (cond ((eq arg 9) "-x")
        (t "")))

(defun cosmo--compile-command (this root kind mode suffix objdumpflags)
  (let* ((ext (file-name-extension this))       ;; e.g. "c"
         (dir (file-name-directory this))       ;; e.g. "/home/jart/daisy/libc/"
         (dots (file-relative-name root dir))   ;; e.g. "../"
         (file (file-relative-name this root))  ;; e.g. "libc/crc32c.c"
         (name (file-name-sans-extension file)) ;; e.g. "libc/crc32c"
         (buddy (format "test/%s_test.c" name))
         (runs (format "o/$m/%s.com.runs V=5 TESTARGS=-b" name))
         (buns (format "o/$m/test/%s_test.com.runs V=5 TESTARGS=-b" name)))
    (cond ((not (member ext '("c" "cc" "s" "S" "rl" "f")))
           (format "m=%s; make -j8 -O MODE=$m o/$m/%s"
                   mode
                   (directory-file-name
                    (or (file-name-directory
                         (file-relative-name this root))
                        ""))))
          ((and (equal suffix "")
                (cosmo-contains "_test." (buffer-file-name)))
           (format "m=%s; make -j8 -O MODE=$m %s"
                   mode runs))
          ((and (equal suffix "")
                (file-exists-p (format "%s" buddy)))
           (format (cosmo-join
                    " && "
                    '("m=%s; n=%s; make -j8 -O o/$m/$n%s.o MODE=$m"
                      ;; "bloat o/$m/%s.o | head"
                      ;; "nm -C --size o/$m/%s.o | sort -r"
                      "echo"
                      "size -A o/$m/$n.o | grep '^[.T]' | grep -v 'debug\\|command.line\\|stack' | sort -rnk2"
                      "objdump %s -wzCd o/$m/$n%s.o"))
                   mode name suffix objdumpflags suffix))
          ((eq kind 'run)
           (format
            (cosmo-join
             " && "
             `("m=%s; f=o/$m/%s.com"
               ,(concat "make -j8 -O $f MODE=$m")
               "./$f"))
            mode name))
          ((eq kind 'run-win7)
           (format
            (cosmo-join
             " && "
             `("m=%s; f=o/$m/%s.com"
               ,(concat "make -j8 -O $f MODE=$m")
               "scp $f $f.dbg win7:"
               "ssh win7 ./%s.com"))
            mode name (file-name-nondirectory name)))
          ((eq kind 'run-win10)
           (format
            (cosmo-join
             " && "
             `("m=%s; f=o/$m/%s.com"
               ,(concat "make -j8 -O $f MODE=$m")
               "scp $f $f.dbg win10:"
               "ssh win10 ./%s.com"))
            mode name (file-name-nondirectory name)))
          ((and (file-regular-p this)
                (file-executable-p this))
           (format "./%s" file))
          ('t
           (format
            (cosmo-join
             " && "
             `("m=%s; f=o/$m/%s%s.o"
               ,(concat "make -j8 -O $f MODE=$m")
               ;; "nm -C --size $f | sort -r"
               "echo"
               "size -A $f | grep '^[.T]' | grep -v 'debug\\|command.line\\|stack' | sort -rnk2"
               "objdump %s -wzCd $f"))
            mode name suffix objdumpflags)))))

(defun cosmo-compile (arg)
  (interactive "P")
  (let* ((this (or (buffer-file-name) dired-directory))
         (root (locate-dominating-file this "Makefile")))
    (when root
      (let* ((mode (cosmo--make-mode arg))
             (suffix (cosmo--make-suffix arg))
             (objdumpflags (cosmo--make-objdump-flags arg))
             (compilation-scroll-output nil)
             (default-directory root)
             (compile-command (cosmo--compile-command this root nil mode suffix objdumpflags)))
        (compile compile-command)))))

(defun cosmo-compile-hook ()
  (local-set-key (kbd "C-c C-c") 'cosmo-compile))

(progn
  (add-hook 'makefile-mode-hook 'cosmo-compile-hook)
  (add-hook 'asm-mode-hook 'cosmo-compile-hook)
  (add-hook 'ld-script-mode-hook 'cosmo-compile-hook)
  (add-hook 'dired-mode-hook 'cosmo-compile-hook)
  (add-hook 'c-mode-common-hook 'cosmo-compile-hook)
  (add-hook 'c++-mode-common-hook 'cosmo-compile-hook)
  (add-hook 'fortran-mode-hook 'cosmo-compile-hook)
  (add-hook 'protobuf-mode-hook 'cosmo-compile-hook))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Display assembly for C/C++ buffer
;;
;;       C-c C-a   Compile and show assembly, with a native optimized build
;;       C-c C-b   Compile and show assembly, with a balanced build
;;
;; The ALT key may be used to override the default mode.
;;
;;   M-1 C-c C-a   Compile w/ MODE=tiny
;;   M-2 C-c C-a   Compile w/ MODE=opt
;;   M-3 C-c C-a   Compile w/ MODE=rel
;;   M-4 C-c C-a   Compile w/ MODE=dbg
;;   M-5 C-c C-a   Compile w/ MODE=""
;;

(defvar cosmo--assembly-root nil)
(defvar cosmo--assembly-pending nil)

(defun cosmo--scrub (regex replace)
  (replace-regexp regex replace nil (point-min) (point-max)))

(defun cosmo--fixup-asm ()
  (cosmo--scrub
   ;; Code like this
   ;;
   ;;   .section "GNU!GNU!GNU!.must.be.in.every.asm.or.mprotect.breaks"
   ;;
   ;; Isn't needed since the underlying issue is addressed by ape/ape.S
   ;; which generates executable structure.
   "	.section	.note.GNU-stack,.*,@progbits\n"
   "")
  (cosmo--scrub
   ;; Code like this
   ;;
   ;;   and $2047, %edx
   ;;
   ;; Should be this
   ;;
   ;;   and $2047,%edx
   ;;
   ;; Per our favored coding style.
   ", "
   ",")
  (cosmo--scrub
   ;; Code like this
   ;;
   ;;   .ascii "foo"
   ;;   .zero  1
   ;;
   ;; Should be this
   ;;
   ;;   .ascii "foo"
   ;;   .zero  1
   ;;
   ;; @see -frecord-gcc-switches
   "\t\\.ascii\t\"\\([^\"]*\\)\"\n\t\\.zero\t1\n"
   "\t.asciz\t\"\\1\"\n")
  (cosmo--scrub
   ;; Code like this
   ;;
   ;;   movl %eax,a
   ;;   movb b,%bl
   ;;   movb $1,c
   ;;   incb d
   ;;   movq %xmm0,%rax
   ;;
   ;; Should be this
   ;;
   ;;   mov  %eax,a
   ;;   mov  %bl,b
   ;;   movb $1,c
   ;;   incb d
   ;;   movq %xmm0,%rax  # ;_;
   ;;
   ;; Because we dislike redundancy and don't want the
   ;; ibmicroborlandtel crowd feeling too uncomfortable.
   (let ((names-a-register
          "%[A-Za-z]")
         (normal-arithmetic-ops
          (regexp-opt
           (list
            "rcr"  "rcl"  "ror"  "rol"  "hlt"  "cmc"  "div"  "sar"
            "mov"  "shl"  "shr"  "lea"  "cmp"  "adc"  "sbb"  "inc"
            "sub"  "xor"  "add"  "and"  "or"   "not"  "btc"  "dec"
            "mul"  "neg"  "bt"   "bsf"  "bsr"  "int"  "test")))
         (prefixes
          (regexp-opt
           (list
            "es"       "cs"       "ss"      "ds"      "lock"
            "rep"      "repnz"    "repne"   "repz"    "repe"
            "rex.b"    "rex.x"    "rex.xb"  "rex.r"   "rex.rb"   "rex.rx"
            "rex.rxb"  "rex.w"    "rex.wb"  "rex.wx"  "rex.wxb"  "rex.wr"
            "rex.trb"  "rex.wrx"  "rex.wrxb"))))
     (concat "\\("
             "^[ \t]*"
             "\\(?:" prefixes " \\|\\)"
             normal-arithmetic-ops
             "\\)"
             "[bwlq]"
             "\\("
             "[ \t]+"
             "\\(?:"
             "%[A-Wa-w][^\n]+"
             "\\|"
             "[^%][^\n,]*,%[A-Za-z][^\n]+"
             "\\)"
             "\\)"))
   "\\1\\2")
  ;; Scroll first function to top of display.
  (goto-char (point-min))
  (when (search-forward-regexp
         "\t\\.type[^\n]*@function" nil t)
    (recenter-top-bottom 'top)))

(defun cosmo--assembly-compilation-finished (compilebuf msg)
  (when cosmo--assembly-pending
    (let ((asm-gcc (car cosmo--assembly-pending))
          (asm-clang (cdr cosmo--assembly-pending))
          width
          asm-gcc-buffer
          asm-gcc-window
          asm-clang-buffer
          asm-clang-window)
      (setq cosmo--assembly-pending nil)
      (when (not (cosmo-contains "finished" msg))
        (error "making assembly failed: %s" msg))
      (let ((f (format "%s/%s" cosmo--assembly-root asm-gcc)))
        (when (or (null asm-gcc) (not (file-exists-p f)))
          (error "asm-gcc not found: %s" f)))
      (let ((f (format "%s/%s" cosmo--assembly-root asm-clang)))
        (when (or (null asm-gcc) (not (file-exists-p f)))
          (error "asm-gcc not found: %s" f)))
      (delete-other-windows)
      (setq width (window-total-width))
      (setq asm-gcc-buffer (find-file-noselect asm-gcc t nil nil))
      (setq asm-clang-buffer (find-file-noselect asm-clang t nil nil))
      (setq asm-clang-window (split-window-right (- width (/ width 4))))
      (setq asm-gcc-window (split-window-right (- (- width (/ width 4)) (/ width 4))))
      (set-window-buffer asm-gcc-window asm-gcc-buffer)
      (set-window-buffer asm-clang-window asm-clang-buffer)
      (other-window 1)
      (cosmo--fixup-asm)
      (save-buffer)
      (bury-buffer (current-buffer))
      (other-window 1)
      (cosmo--fixup-asm)
      (save-buffer)
      (bury-buffer (current-buffer))
      (other-window 1)
      (bury-buffer compilebuf))))

(defun cosmo--purge-file (path)
  (let ((b (find-file-noselect path t nil nil)))
    (when b
      (with-current-buffer b
        (save-buffer))
      (when (not (kill-buffer b))
        (error "couldn't kill asm buffer"))))
  (delete-file path t))

(defun cosmo--assembly (arg extra-make-flags)
  (let* ((this (expand-file-name (or (buffer-file-name) dired-directory)))
         (root (expand-file-name (locate-dominating-file this "Makefile"))))
    (when root
      (let* ((mode (cosmo--make-mode arg "opt"))
             (ext (file-name-extension this))
             (dir (file-name-directory this))
             (dots (file-relative-name root dir))
             (file (file-relative-name this root))
             (name (file-name-sans-extension file))
             (asm-gcc (format "o/%s/%s-gcc.asm" mode name))
             (asm-clang (format "o/%s/%s-clang.asm" mode name)))
        (when (not (member ext '("c" "cc" "f")))
          (error "don't know how to show assembly for non c/c++ source file"))
        (let* ((default-directory root)
               (compile-command
                (format "make %s -j8 -O MODE=%s %s %s"
                        (or extra-make-flags "") mode asm-gcc asm-clang)))
          (save-buffer)
          (set-visited-file-modtime (current-time))
          (cosmo--purge-file asm-gcc)
          (cosmo--purge-file asm-clang)
          (save-buffer)
          (setq cosmo--assembly-root root)
          (setq cosmo--assembly-pending (cons asm-gcc asm-clang))
          (let ((errormsg (shell-command-to-string (format "touch %s" file))))
            (when (not (equal "" errormsg))
              (error errormsg)))
          (revert-buffer :ignore-auto :noconfirm)
          (compile compile-command))))))

(defun cosmo-assembly (arg)
  (interactive "P")
  (setq arg (or arg 2))
  ;; -ffast-math -funsafe-math-optimizations -fsched2-use-superblocks -fjump-tables
  (cond ((eq arg 9)
         (cosmo--assembly 1
                          "V=1 OVERRIDE_COPTS='-w -fverbose-asm -fsanitize=undefined -fno-sanitize=null -fno-sanitize=alignment -fno-sanitize=pointer-overflow'"))
        ((not (eq 0 (logand 8 arg)))
         (cosmo--assembly (setq arg (logand (lognot 8)))
                          "V=1 OVERRIDE_COPTS='-w -fverbose-asm -fsanitize=address'"))
        (t (cosmo--assembly arg "V=1 OVERRIDE_COPTS='-w ' CPPFLAGS=''"))))

(defun cosmo-assembly-native (arg)
  (interactive "P")
  (setq arg (or arg 3))
  (cond ((not (eq 0 (logand 8 arg)))
         (cosmo--assembly
          (setq arg (logand (lognot 8)))
          "V=1 CCFLAGS=--verbose COPTS='$(IEEE_MATH)' CPPFLAGS='' TARGET_ARCH='-march=k8'"))   ;; znver2
        (t
         (cosmo--assembly
          arg
          "V=1 CCFLAGS=--verbose COPTS='$(MATHEMATICAL) -O3' CPPFLAGS='' TARGET_ARCH='-march=k8'"))))  ;; znver2

(defun cosmo-assembly-icelake (arg)
  (interactive "P")
  (setq arg (or arg 3))
  (cond ((not (eq 0 (logand 8 arg)))
         (cosmo--assembly
          (setq arg (logand (lognot 8)))
          "V=1 CCFLAGS=--verbose COPTS='$(MATHEMATICAL) -O3' CPPFLAGS='' TARGET_ARCH='-march=icelake-client'"))
        (t
         (cosmo--assembly
          arg
          "V=1 CCFLAGS=--verbose COPTS='$(MATHEMATICAL) -O3' CPPFLAGS='' TARGET_ARCH='-march=icelake-client'"))))

(defun cosmo-assembly-balanced (arg)
  (interactive "P")
  (cosmo--assembly (or arg 5) "CFLAGS='-O2 -ftrapv' CPPFLAGS=''"))

(defun cosmo-mca (arg)
  (interactive "P")
  (let (code
        delete
        cleanup
        (inhibit-message t)
        (inhibit-read-only t)
        (term (getenv "TERM"))
        (prog (executable-find "llvm-mca-10"))
        (buf1 (get-buffer-create "*mca*"))
        (buf2 (generate-new-buffer "*mca*")))
    (setenv "TERM" "xterm-256color")
    (setq cleanup
          (lambda ()
            (setenv term)
            (kill-buffer buf2)
            (when delete (delete-file delete))))
    (condition-case exc
        (progn
          (if (not (buffer-modified-p))
              (setq code (buffer-file-name))
            (setq code (make-temp-file "mca.s"))
            (write-region nil nil code)
            (setq delete code))
          (with-current-buffer buf2
            (insert "\n")
            (setq rc (call-process prog nil t nil
                                   "-mcpu=skylake"
                                   "-mtriple=x86_64-pc-linux-gnu"
                                   "--bottleneck-analysis"
                                   "-instruction-info"
                                   "-iterations=8"
                                   "-all-stats"
                                   "-all-views"
                                   "-timeline"
                                   code)))
          (with-current-buffer buf1
            (replace-buffer-contents buf2)
            (if (eq rc 0)
                (fundamental-mode)
              (compilation-mode))
            (xterm-color-colorize-buffer)
            (display-buffer (current-buffer))))
      ('error
       (funcall cleanup)
       (error exc)))
    (funcall cleanup)))

(defun cosmo-assemble-hook ()
  (add-to-list 'compilation-finish-functions
               'cosmo--assembly-compilation-finished)
  (local-set-key (kbd "C-c C-a") 'cosmo-assembly)
  (local-set-key (kbd "C-c C-b") 'cosmo-assembly-balanced)
  (local-set-key (kbd "C-c C-n") 'cosmo-assembly-native)
  (local-set-key (kbd "C-c C-i") 'cosmo-assembly-icelake))

(defun cosmo-mca-hook ()
  ;; (local-set-key (kbd "C-c C-h") 'cosmo-mca)
  )

(progn
  (add-hook 'asm-mode-hook 'cosmo-mca-hook)
  (add-hook 'makefile-mode-hook 'cosmo-assemble-hook)
  (add-hook 'asm-mode-hook 'cosmo-assemble-hook)
  (add-hook 'ld-script-mode-hook 'cosmo-assemble-hook)
  (add-hook 'dired-mode-hook 'cosmo-assemble-hook)
  (add-hook 'c-mode-common-hook 'cosmo-assemble-hook)
  (add-hook 'fortran-mode-hook 'cosmo-assemble-hook)
  (add-hook 'protobuf-mode-hook 'cosmo-assemble-hook))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Run buffer.
;;       C-c C-r   Run
;;   M-1 C-c C-r   Run w/ MODE=tiny
;;   M-2 C-c C-r   Run w/ MODE=opt
;;   M-3 C-c C-r   Run w/ MODE=rel
;;   M-4 C-c C-r   Run w/ MODE=dbg
;;   M-5 C-c C-r   Run w/ MODE=""

(defun cosmo-run (arg)
  (interactive "P")
  (let* ((this (or (buffer-file-name) dired-directory))
         (proj (locate-dominating-file this "Makefile"))
         (root (or proj default-directory))
         (file (file-relative-name this root)))
    (when root
      (let ((default-directory root))
        (save-buffer)
        (cond ((file-executable-p file)
               (compile (if (cosmo-contains "/" file)
                            file
                          (format "./%s" file))))
              ((memq major-mode '(c-mode c++-mode asm-mode fortran-mode))
               (let* ((mode (cosmo--make-mode arg))
                      (compile-command (cosmo--compile-command this root 'run mode "" "")))
                 (compile compile-command)))
              ((eq major-mode 'sh-mode)
               (compile (format "sh %s" file)))
              ((and (eq major-mode 'python-mode)
                    (cosmo-startswith "third_party/python/Lib/test/" file))
               (let ((mode (cosmo--make-mode arg)))
                 (compile (format "make -j8 MODE=%s PYHARNESSARGS=-vv PYTESTARGS=-v o/%s/%s.py.runs"
                                  mode mode (file-name-sans-extension file)))))
              ((eq major-mode 'python-mode)
               (compile (format "python.com %s" file)))
              ('t
               (error "cosmo-run: unknown major mode")))))))

(defun cosmo-run-win7 (arg)
  (interactive "P")
  (let* ((this (or (buffer-file-name) dired-directory))
         (proj (locate-dominating-file this "Makefile"))
         (root (or proj default-directory))
         (file (file-relative-name this root)))
    (when root
      (let ((default-directory root))
        (save-buffer)
        (cond ((memq major-mode '(c-mode c++-mode asm-mode fortran-mode))
               (let* ((mode (cosmo--make-mode arg))
                      (compile-command (cosmo--compile-command this root 'run-win7 mode "" "")))
                 (compile compile-command)))
              ('t
               (error "cosmo-run: unknown major mode")))))))

(defun cosmo-run-win10 (arg)
  (interactive "P")
  (let* ((this (or (buffer-file-name) dired-directory))
         (proj (locate-dominating-file this "Makefile"))
         (root (or proj default-directory))
         (file (file-relative-name this root)))
    (when root
      (let ((default-directory root))
        (save-buffer)
        (cond ((memq major-mode '(c-mode c++-mode asm-mode fortran-mode))
               (let* ((mode (cosmo--make-mode arg))
                      (compile-command (cosmo--compile-command this root 'run-win10 mode "" "")))
                 (compile compile-command)))
              ('t
               (error "cosmo-run: unknown major mode")))))))

(progn
  (define-key asm-mode-map (kbd "C-c C-r") 'cosmo-run)
  (define-key c-mode-base-map (kbd "C-c C-r") 'cosmo-run)
  (define-key fortran-mode-map (kbd "C-c C-r") 'cosmo-run)
  (define-key sh-mode-map (kbd "C-c C-r") 'cosmo-run)
  (define-key python-mode-map (kbd "C-c C-r") 'cosmo-run)
  (define-key c-mode-map (kbd "C-c C-s") 'cosmo-run-win7)
  (define-key c-mode-map (kbd "C-c C-_") 'cosmo-run-win10))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Debug buffer.
;;       C-c C-d   Run in GDB/GUD
;;   M-1 C-c C-d   Run in GDB/GUD w/ MODE=tiny
;;   M-2 C-c C-d   Run in GDB/GUD w/ MODE=opt
;;   M-3 C-c C-d   Run in GDB/GUD w/ MODE=rel
;;   M-4 C-c C-d   Run in GDB/GUD w/ MODE=dbg
;;   M-5 C-c C-d   Run in GDB/GUD w/ MODE=""

(defun cosmo-debug (arg)
  (interactive "P")
  (let* ((this (or (buffer-file-name) dired-directory))
         (root (locate-dominating-file this "Makefile")))
    (when root
      (let* ((mode (cosmo--make-mode arg "dbg"))
             (name (file-relative-name this root))
             (next (file-name-sans-extension name))
             (exec (format "o/%s/%s.com.dbg" mode next))
             (default-directory root)
             (compile-command (cosmo--compile-command this root nil mode "" "")))
        (compile compile-command)
        (gdb (format "gdb -q -nh -i=mi %s -ex run" exec))))))

(progn
  (define-key asm-mode-map (kbd "C-c C-d") 'cosmo-debug)
  (define-key c-mode-base-map (kbd "C-c C-d") 'cosmo-debug))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; C-c C-t  Toggle buffer between source file and unit test file.

(defun cosmo-toggle-buddy ()
  (interactive)
  (let* ((this (or (buffer-file-name) dired-directory))
         (root (locate-dominating-file this "Makefile")))
    (when root
      (let* ((name (file-relative-name this root))
             (dir (file-name-directory this))
             (pkgname (file-name-nondirectory (substring dir 0 -1)))
             (dots (file-relative-name root dir))
             (notest (cosmo-file-name-sans-extensions
                      (cosmo-replace "_test" "" (cosmo-lchop "test/" name))))
             (buddy
              (cond ((and (cosmo-startswith "test/" dir)
                          (cosmo-endswith "/test.mk" name))
                     (message (format "%s/%s.mk" (substring dir 5) pkgname))
                     (format "%s/%s.mk" (substring dir 5) pkgname))
                    ((cosmo-startswith "test/" name)
                     (cosmo-first-that
                      'file-exists-p
                      (list (concat dots notest ".s")
                            (concat dots notest ".S")
                            (concat dots notest ".f")
                            (concat dots notest ".F")
                            (concat dots notest ".c")
                            (concat dots notest ".cc")
                            (concat dots notest ".rl")
                            (concat dots notest ".greg.c")
                            (concat dots notest ".ncabi.c")
                            (concat dots notest ".hookabi.c")
                            (concat dots notest ".h"))))
                    (t
                     (format "%stest/%s_test.c"
                             dots (cosmo-file-name-sans-extensions name))))))
        (when buddy
          (find-file buddy))))))

(progn
  (global-set-key (kbd "C-c C-t") 'cosmo-toggle-buddy))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; C-c C-h  Add Include Line

(defun cosmo-add-include ()
  (interactive)
  (let* ((no-whine t)
         (tag-file "HTAGS")
         (this (buffer-name))
         (case-fold-search nil)
         (search (thing-at-point 'symbol))
         (buffer (find-file-noselect (format "%s/%s"
                                             (locate-dominating-file
                                              this tag-file)
                                             tag-file)
                                     no-whine))
         (header (with-current-buffer buffer
                   (revert-buffer :ignore-auto :noconfirm)
                   (save-excursion
                     (goto-char 0)
                     (when (re-search-forward
                            (concat "\177" search "\001") nil t)
                       (when (re-search-backward "\f\n\\([^,]*\\)," nil t)
                         (match-string 1))))))
         (root (locate-dominating-file this "Makefile"))
         (name (file-relative-name this root)))
    (when header
      (when (not (equal header name))
        (save-excursion
          (goto-char 0)
          (re-search-forward "#include" nil t)
          (re-search-forward "^$")
          (re-search-backward "#include" nil t)
          (beginning-of-line)
          (insert (concat "#include \"" header "\"\n"))))
      (message header))))

(progn
  (define-key asm-mode-map (kbd "C-c C-h") 'cosmo-add-include)
  (define-key c-mode-base-map (kbd "C-c C-h") 'cosmo-add-include))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; C-c C-o  Show Optimization Report

(defun cosmo-show-optinfo (arg)
  (interactive "P")
  (let* ((mode (cosmo--make-mode arg "opt"))
         (this (or (buffer-file-name) dired-directory))
         (root (locate-dominating-file this "Makefile")))
    (when root
      (let* ((name (file-relative-name this root))
             (buddy
              (format "%s/o/%s/%s.optinfo.gz"
                      root mode (cosmo-file-name-sans-extensions name))))
        (when buddy
          (find-file buddy))))))

(defun cosmo-lisp-is-the-best ()
  (define-key c-mode-base-map (kbd "C-c C-o") 'cosmo-show-optinfo))
(add-hook 'c-mode-common-hook 'cosmo-lisp-is-the-best)

(defun cosmo-lisp-is-the-best++ ()
  (define-key c++-mode-base-map (kbd "C-c C-o") 'cosmo-show-optinfo))
(add-hook 'c++-mode-common-hook 'cosmo-lisp-is-the-best++)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cosmopolitan Extended Language Keyword Definitions

(defun cosmo-c-keywords-hook ()
  (font-lock-add-keywords
   nil `((,cosmo-c-keywords-regex . font-lock-keyword-face)
         (,cosmo-c-builtins-regex . font-lock-builtin-face)
         (,cosmo-platform-constants-regex . font-lock-builtin-face)
         (,cosmo-cpp-constants-regex . font-lock-constant-face)
         (,cosmo-c-constants-regex . font-lock-constant-face)
         (,cosmo-c-types-regex . font-lock-type-face))))

(defun cosmo-asm-keywords-hook ()
  (font-lock-add-keywords
   nil `((,cosmo-cpp-constants-regex . font-lock-constant-face)
         (,cosmo-platform-constants-regex . font-lock-constant-face))))

(add-hook 'c-mode-common-hook 'cosmo-c-keywords-hook)
(add-hook 'c++-mode-common-hook 'cosmo-c-keywords-hook)
(add-hook 'asm-mode-hook 'cosmo-asm-keywords-hook)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Symbol naming convention conversion

;; e.g. STARTF_USESHOWWINDOW -> kNtStartfUseshowwindow
(defun cosmo--ms-to-google-const (s)
  (declare (pure t) (side-effect-free t))
  (let ((d (downcase (substring s 1))))
    (cosmo-replace
     "kNtNt" "kNt"
     (concat
      "kNt"
      (substring s 0 1)
      (replace-regexp-in-string
       "_\\([A-Za-z]\\)"
       (lambda (m)
         (upcase (match-string 1 m)))
       d)))))

;; e.g. kNtStartfUseshowwindow -> STARTF_USESHOWWINDOW
(defun cosmo--google-to-ms-const (s)
  (declare (pure t) (side-effect-free t))
  (upcase (replace-regexp-in-string
           "\\(.\\)\\([A-Z]\\)"
           (lambda (m)
             (upcase (concat
                      (match-string 1 m) "_"
                      (match-string 2 m))))
           (substring s 3)
           t)))

(defun cosmo-toggle-ms-const ()
  (interactive)
  (let* ((case-fold-search nil)
         (bounds (if (use-region-p)
                        (cons (region-beginning) (region-end))
                      (bounds-of-thing-at-point 'symbol)))
         (text (buffer-substring-no-properties (car bounds) (cdr bounds))))
    (when bounds
      (let ((fn (if (or (cosmo-contains "_" text)
                        (equal text (upcase text)))
                    'cosmo--ms-to-google-const
                  'cosmo--google-to-ms-const)))
        (delete-region (car bounds) (cdr bounds))
        (insert (funcall fn text))))))

;; (define-key c-mode-base-map (kbd "C-c C-l") 'cosmo-toggle-ms-const)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CP/M EOF for the lulz

(defun cosmo-before-save ()
  (cond ((memq major-mode '(c-mode asm-mode))
         (set (make-local-variable 'require-final-newline)
              (not (equal (buffer-substring-no-properties
                           (- (point-max) 1) (point-max))
                          "\x1a"))))))

(add-hook 'before-save-hook 'cosmo-before-save)

(provide 'cosmo-stuff)

;;; cosmo-stuff.el ends here