mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-01-31 19:43:32 +00:00
226aaf3547
This commit makes numerous refinements to cosmopolitan memory handling.
The default stack size has been reduced from 2mb to 128kb. A new macro
is now provided so you can easily reconfigure the stack size to be any
value you want. Work around the breaking change by adding to your main:
STATIC_STACK_SIZE(0x00200000); // 2mb stack
If you're not sure how much stack you need, then you can use:
STATIC_YOINK("stack_usage_logging");
After which you can `sort -nr o/$MODE/stack.log`. Based on the unit test
suite, nothing in the Cosmopolitan repository (except for Python) needs
a stack size greater than 30kb. There are also new macros for detecting
the size and address of the stack at runtime, e.g. GetStackAddr(). We
also now support sigaltstack() so if you want to see nice looking crash
reports whenever a stack overflow happens, you can put this in main():
ShowCrashReports();
Under `make MODE=dbg` and `make MODE=asan` the unit testing framework
will now automatically print backtraces of memory allocations when
things like memory leaks happen. Bugs are now fixed in ASAN global
variable overrun detection. The memtrack and asan runtimes also handle
edge cases now. The new tools helped to identify a few memory leaks,
which are fixed by this change.
This change should fix an issue reported in #288 with ARG_MAX limits.
Fixing this doubled the performance of MKDEPS.COM and AR.COM yet again.
870 lines
32 KiB
EmacsLisp
870 lines
32 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-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)
|
||
(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
|
||
(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 '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='-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=''"))))
|
||
|
||
(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 "python3 %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
|