mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-02-07 23:13:34 +00:00
cc1920749e
Your redbean can now interoperate with clients that require TLS crypto. This is accomplished using a protocol polyglot that lets us distinguish between HTTP and HTTPS regardless of the port number. Certificates will be generated automatically, if none are supplied by the user. Footprint increases by only a few hundred kb so redbean in MODY=tiny is now 1.0mb - Add lseek() polyfills for ZIP executable - Automatically polyfill /tmp/FOO paths on NT - Fix readdir() / ftw() / nftw() bugs on Windows - Introduce -B flag for slower SSL that's stronger - Remove mbedtls features Cosmopolitan doesn't need - Have base64 decoder support the uri-safe alternative - Remove Truncated HMAC because it's forbidden by the IETF - Add all the mbedtls test suites and make them go 3x faster - Support opendir() / readdir() / closedir() on ZIP executable - Use Everest for ECDHE-ECDSA because it's so good it's so good - Add tinier implementation of sha1 since it's not worth the rom - Add chi-square monte-carlo mean correlation tests for getrandom() - Source entropy on Windows from the proper interface everyone uses We're continuing to outperform NGINX and other servers on raw message throughput. Using SSL means that instead of 1,000,000 qps you can get around 300,000 qps. However redbean isn't as fast as NGINX yet at SSL handshakes, since redbean can do 2,627 per second and NGINX does 4.3k Right now, the SSL UX story works best if you give your redbean a key signing key since that can be easily generated by openssl using a one liner then redbean will do all the things that are impossibly hard to do like signing ecdsa and rsa certificates that'll work in chrome. We should integrate the let's encrypt acme protocol in the future. Live Demo: https://redbean.justine.lol/ Root Cert: https://redbean.justine.lol/redbean1.crt
857 lines
31 KiB
EmacsLisp
857 lines
31 KiB
EmacsLisp
;; ╔──────────────────────────────────────────────────────────────────╗
|
||
;; │ 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-xref-find-definitions ()
|
||
(interactive)
|
||
(let ((case-fold-search nil))
|
||
(xref-find-definitions (format "%S" (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)
|
||
(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 TESTARGS=-b" name))
|
||
(buns (format "o/$m/test/%s_test.com.runs TESTARGS=-b" name)))
|
||
(cond ((not (member ext '("c" "cc" "s" "S" "rl" "f")))
|
||
(format "m=%s; make -j8 -O MODE=$m V=1 o/$m/%s"
|
||
mode
|
||
(directory-file-name
|
||
(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 V=1"
|
||
;; "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 V=1")
|
||
"./$f"))
|
||
mode name))
|
||
((eq kind 'run-win7)
|
||
(format
|
||
(cosmo-join
|
||
" && "
|
||
`("m=%s; f=o/$m/%s.com"
|
||
,(concat "make -j8 -O $f MODE=$m V=1")
|
||
"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 V=1")
|
||
"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 V=1")
|
||
;; "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 '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 V=1 -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='-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='-fverbose-asm -fsanitize=address'"))
|
||
(t (cosmo--assembly arg "V=1 OVERRIDE_COPTS='' CPPFLAGS='-DSTACK_FRAME_UNLIMITED'"))))
|
||
|
||
(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='-DSTACK_FRAME_UNLIMITED' TARGET_ARCH='-march=k8'")) ;; znver2
|
||
(t
|
||
(cosmo--assembly
|
||
arg
|
||
"V=1 CCFLAGS=--verbose COPTS='$(MATHEMATICAL) -O3' CPPFLAGS='-DSTACK_FRAME_UNLIMITED' 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='-DSTACK_FRAME_UNLIMITED' TARGET_ARCH='-march=icelake-client'"))
|
||
(t
|
||
(cosmo--assembly
|
||
arg
|
||
"V=1 CCFLAGS=--verbose COPTS='$(MATHEMATICAL) -O3' CPPFLAGS='-DSTACK_FRAME_UNLIMITED' TARGET_ARCH='-march=icelake-client'"))))
|
||
|
||
(defun cosmo-assembly-balanced (arg)
|
||
(interactive "P")
|
||
(cosmo--assembly (or arg 5) "CFLAGS='-O2 -ftrapv' CPPFLAGS='-DSTACK_FRAME_UNLIMITED' V=1"))
|
||
|
||
(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)))
|
||
((eq major-mode 'python-mode)
|
||
(compile (format "python %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 ".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-worst-this-is-so-tiring ()
|
||
(define-key c-mode-base-map (kbd "C-c C-o") 'cosmo-show-optinfo))
|
||
(add-hook 'c-mode-common-hook 'cosmo-lisp-is-the-worst-this-is-so-tiring)
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; 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 '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
|