From 1447c8a6b97de24867c8af36ec1a6a179151a758 Mon Sep 17 00:00:00 2001 From: inaki Date: Thu, 18 Feb 2021 22:51:55 +0100 Subject: [PATCH] fix tls and add gas mode --- init.el | 64 +- lisp/gas-mode.el | 2174 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 2213 insertions(+), 25 deletions(-) create mode 100644 lisp/gas-mode.el diff --git a/init.el b/init.el index 210257f..cf5b2c4 100644 --- a/init.el +++ b/init.el @@ -1,18 +1,27 @@ -;(setq gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3") +(setq gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3") (setq package-check-signature nil) -(package-initialize) - (require 'package) -(add-to-list 'package-archives '("gnu" . "https://elpa.gnu.org/packages/") t) -(add-to-list 'package-archives - '("melpa" . "https://melpa.org/packages/") t) -;(add-to-list 'package-archives -; '("marmalade" . "https://marmalade-repo.org/packages/") t) -(add-to-list 'custom-theme-load-path "~/.emacs.d/themes/") t -(add-to-list 'load-path "~/.emacs.d/lisp/" t) +(let* ((no-ssl (and (memq system-type '(windows-nt ms-dos)) + (not (gnutls-available-p)))) + (proto (if no-ssl "http" "https"))) + (when no-ssl + (warn "\ +Your version of Emacs does not support SSL connections, +which is unsafe because it allows man-in-the-middle attacks. +There are two things you can do about this warning: +1. Install an Emacs version that does support SSL and be safe. +2. Remove this warning from your init file so you won't see it again.")) + ;; Comment/uncomment these two lines to enable/disable MELPA and MELPA Stable as desired + (add-to-list 'package-archives (cons "melpa" (concat proto "://melpa.org/packages/")) t) + ;;(add-to-list 'package-archives (cons "melpa-stable" (concat proto "://stable.melpa.org/packages/")) t) + (when (< emacs-major-version 24) + ;; For important compatibility libraries like cl-lib + (add-to-list 'package-archives (cons "gnu" (concat proto "://elpa.gnu.org/packages/")))) + (add-to-list 'custom-theme-load-path "~/.emacs.d/themes/" t) + (add-to-list 'load-path "~/.emacs.d/lisp/" t)) -(setq use-package-always-ensure t) +(package-initialize) (unless (package-installed-p 'use-package) (package-refresh-contents) @@ -21,6 +30,15 @@ (require 'use-package) +(setq use-package-always-ensure t) + +(use-package asm-mode + :config + (setq asm-comment-char ?\#) + :mode ("\\.s\\'" . asm-mode) + :mode ("\\.S\\'" . asm-mode) + :mode ("\\.asm\\'" . asm-mode)) + (use-package async) (use-package cargo @@ -39,6 +57,8 @@ :config (editorconfig-mode 1)) +(setq evil-want-keybinding nil) + (use-package evil :init (setq evil-want-fine-undo t) @@ -76,8 +96,6 @@ (use-package magit-popup) (use-package nasm-mode - :mode ("\\.s\\'" . nasm-mode) - :mode ("\\.asm\\'" . nasm-mode) :mode ("\\.nasm\\'" . nasm-mode)) (use-package pkg-info) @@ -105,7 +123,12 @@ :init (setq tramp-default-method "ssh")) -(use-package undo-tree) +(use-package undo-tree + :config + (setq undo-limit 40000 + undo-strong-limit 60000) + undo-tree-auto-save-history t + undo-tree-history-directory-alist '(("." . "~/.undo-tree"))) (use-package web-mode :mode ("\\.html\\'" . web-mode) @@ -160,17 +183,16 @@ auto-window-vscroll nil backup-by-copying t backup-directory-alist '(("." . "~/.saves")) - undo-tree-history-directory-alist '(("." . "~/.undo-tree")) delete-old-versions t kept-new-versions 6 kept-old-versions 2 version-control t backup-directory-alist `((".*" . ,temporary-file-directory)) auto-save-file-name-transforms `((".*" ,temporary-file-directory t)) - undo-tree-auto-save-history t vc-mode 1 ring-bell-function 'ignore - column-number-mode 1) + column-number-mode 1 + savehist-mode 1) (setq-default scroll-up-aggressively 0.01 scroll-down-aggressively 0.01 @@ -187,7 +209,6 @@ (load "~/.emacs.d/lisp/plsql.el") (load "~/.emacs.d/lisp/dockerfile-mode.el") -(load "~/.emacs.d/lisp/nasm-mode.el") (add-to-list 'auto-mode-alist '("\\.\\(p\\(?:k[bg]\\|ls\\)\\|sql\\)\\'" . plsql-mode)) (add-to-list 'auto-mode-alist '("Dockerfile\\'" . dockerfile-mode)) @@ -203,12 +224,6 @@ (add-hook 'c-mode-common-hook (lambda () - (c-add-style "libvirt" - '((indent-tabs-mode . nil) - (c-basic-offset . 4) - (c-indent-level . 4) - (c-offsets-alist - (label . 1)))) ;; Add kernel style (c-add-style "linux-tabs-only" '("linux" @@ -220,7 +235,6 @@ (defun my-c-mode-hooks () (let ((bname (buffer-file-name))) (cond - ((string-match "libvirt/" bname) (c-set-style "libvirt")) ((string-match "datastructures/" bname) (c-set-style "linux")) ((string-match "linux/" bname) (c-set-style "linux-tabs-only")) ((string-match ".*" bname) (c-set-style "linux")) diff --git a/lisp/gas-mode.el b/lisp/gas-mode.el new file mode 100644 index 0000000..6a63715 --- /dev/null +++ b/lisp/gas-mode.el @@ -0,0 +1,2174 @@ +;; gas-mode.el --- mode for editing assembler code + +;; Copyright (C) 2007 Heike C. Zimmerer +;; Time-stamp: <2007-12-27 18:14:08 hcz> + +;; Author: Heike C. Zimmerer +;; Created: 20 Feb 2007 +;; Version: 1.10 2009-2-25 hcz +;; Keywords: languages + + + +;; This file is written for GNU Emacs, and uses the same license +;; terms; however, it is an add-on and not part of it. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; To use this mode, put gas-mode.el somewhere on your load-path. +;; Then add this to your .emacs: +;; +;; (require 'gas-mode) +;; (add-to-list 'auto-mode-alist '("\\.S\\'" . gas-mode)) + +;; gas-mode recognizes gas syntax (including embedded C preprocessor +;; directives). It does a limited amount of parsing, so it can do +;; some fancy things with syntactic elements (like labels). It, +;; however does not know about the peculiarities of the special +;; processor you're writing code for (there are just too many of +;; them), so, for example, it can't tell register names from labels. +;; Also, its scope is limited to the file you are editing. +;; +;; Symbol highlighting: For a symbol to be recognized as such, it must +;; be in a field where (as per gas syntax) symbols can be placed +;; (i.e. label field, argument field, some directives). If point +;; rests on such a symbol and there are more of it in the current +;; buffer, it is highlighted and you can move forward and backward +;; between all places where that symbol is referenced or defined with +;; forward-sexp and backward-sexp. +;; +;; This is different from a simple string search in that only those +;; places are considered where the symbol is actually used. For local +;; labels, gas-mode resolves which references are associated with +;; which location and only highlights those that fit. The +;; highlighting is different for different types of symbols; see the +;; customization buffer for the gas-symbol-* faces for short +;; explanations of their meanings. +;; +;; Special forms of local labels (like `55$') are not (yet?) +;; supported. + +;; A special feature may need some explanation: C passthroughs. +;; Assembler code is often used to write functions that are later +;; called by C programs. For this to work, you usually have to +;; maintain two files, one containing the assembler source, the other +;; holding the C interface declaration. C passthroughs allow you to +;; move the C declaration part into the assembler file next to the +;; function it belongs to. +;; +;; From the assembler's point of view, C passthroughs are just C syntax +;; comments with some small syntactic sugar added, like: +;; +;; /*C +;; int a_declaration(void); +;; extern volatile int another_declaration; +;; +;; /# and this will be passed as comment #/ +;; */ +;; +;; Note the `/*C' at the beginning and the `/# ... #/' for the nested +;; comment. +;; +;; It is then up to the Make process to generate a .h file, which +;; carries the declarations and the comment, changing the "/#" and "#/" +;; into "/*" and "*/". +;; +;; This may be done by including a line similar to the following into +;; your Makefile (assuming $(ASFILES) is a list of your assembly +;; language files) (and don't forget to use a TAB for the white space +;; which introduces the action lines ( echo ..., sed -n ...): +;; +;; asm-C-defs.h: $(ASFILES) +;; echo '/* Definitions of assembly language functions */' > $@ +;; echo '/* (automatically created by make) */' >> $@ +;; sed -n '/[/][*]C/,/[*][/]/{s|/[*]C||;s|[*]/||;s|/#|/*|;s|#/|*/|;p}' \ +;; $^ >> $@ +;; +;; (Note the above code requires the "/*C" and "*/" to be on a line of +;; their own.) gas-mode recognizes this kind of comment by proper +;; syntax highlighting. Symbol highlighting is also supported. For a +;; symbol to be highlighted within C passthrough code, it must be +;; defined to be global (because only then it is visible to an +;; external C program) in the same buffer. + +;; +;; This mode runs `gas-mode-hook' when initialization is complete. +;; + +;; Bugs: +;; +;; Most probably, yes. You'll tell me (). +;; +;; This code is *not tested at all* for syntaxes where +;; `gas-commant-char' differs from `?;'. + +;;; Change Log: +;; +;; 2007-05-26 1st public release (hcz). +;; +;; 2007-05-30 docstrings, commentary, +;; open string recognition with gas-next-token/limit-re. +;; +;; 2007-12-05 Bug with Intel syntax in arguemnt field fixed +;; +;; 2007-12-25 Indents fixed for C comments without closing '*/' +;; +;;; Code: + +(defgroup gas nil + "Mode for editing gas syntax assembler code." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :group 'languages) + +(defcustom gas-comment-char ?\; + "The comment start character assumed by gas mode." + + :type 'character +; :set 'gas-set-gas-comment-char + :group 'gas) + +(defcustom gas-opcode-column 14 + "The opcode column." + :type 'integer + :group 'gas) + +(defcustom gas-argument-column 20 + "The column for the arguments (if any)." + :type 'integer + :group 'gas) + +(defcustom gas-comment-column 36 + "The column where end of line asm comments go to." + :type 'integer + :group 'gas) + +(defcustom gas-comment-char-starts-comment nil + "Always jump to comment column when a variable `gas-comment-char' is typed. + +It t, starts/expands a comment if appropriate. When +unset (nil), use `gas-comment-dwim' (usually bound to M-;) to get there." + :type 'boolean + :group 'gas) + +(defcustom gas-indent-current-field-only nil + "If nil, 'indent' indents all fileds on the current line. +Else only the current field is affected." + :type 'boolean + :group 'gas) + +;; (defcustom gas-preserve-trailing-whitespace nil +;; "If nil, (re-)indenting removes trailing white space." +;; :type 'boolean +;; :group 'gas) +(setq gas-preserve-trailing-whitespace nil) ; (currently?) non-functional. + +(defcustom gas-enable-symbol-highlight t + "Enable symbol recognition and highlighing. + +When t and if point is on a symbol, some limited parsing data is +collected and all occurences of this symbol in the buffer get +highlighted according to the results (defined, global, etc.). As +long as a symbol is highlighted, `forward-sexp' and `backward-sexp' +move to the next/previous occurence of the same symbol in the +same buffer." + :type 'boolean + :group 'gas) + +(defcustom gas-use-C-passthrough t + "When true, C passthrough comments are recognized. + +This kind of comment is introduced by the starting sequence +\"/*C\" and is meant to be processed later by an external +program \(see the introducing comment in gas-mode.el for an +example) into C source code. Within these passthrough-comments, +the combination /# ... #/ is available for nested comments which +will be later changed into real C comments (/* ... */) by the +same external program." + :type 'boolean + :group 'gas) + +(defcustom gas-defun-regexp "\n\\([;#].*\\|.*[*]/[ \t]*\\|\\|[ \t]*\\|[ \t]+\\..*\\)\n\\([^ \t\n;]+:\\)" + "Regexp used to recognize the beginning of a defun. + +The default value describes a line which is either empty, a +full-line left-justified comment or a directive, followed by a +line starting with a label. Note that the character \";\" in the +regexp will be replaced by the actual comment character described +by variable `gas-comment-char'." + :type 'regexp +; :set 'gas-set-comment-regexp + :group 'gas) + + + +(defcustom gas-defun-regexp-subexp 2 + "The subexp in `gas-defun-regexp to jump to." + :type 'integer + :group 'gas) + +(defcustom gas-C-indent 3 + "Indent to use with C style comments." + :group 'gas + :type 'integer) + +(defcustom gas-C-comment-end-column 0 + "Where to indent a C comment end (\"*/\") if it starts a line." + :group 'gas + :type 'integer) + +(defcustom gas-symbol-highlight-delay 0.5 + "After this many seconds symbols get highlighted. + +Number of seconds of idle time (a float) to wait before a symbol +gets highlighted." + :group 'gas + :type 'float) + +(defgroup gas-faces nil + "Faces used by gas-mode." + :group 'gas) + +(defface gas-builtin + '((((class color) (background light)) (:foreground "maroon")) + (t (:foreground "yellow"))) + "Face to use for Gas buitins." + :group 'gas-faces) + +(defface gas-symbol-ok + '((((class color) (background light)) (:background "#e0ffe0")) + (((class color) (background dark)) (:background "#001f00")) + (t (:foreground "yellow" :background "blue"))) + "Face to use for symbols where exactly 1 definition was found." + :group 'gas-faces) + +(defface gas-symbol-error + '((((class color) (background light)) + (:background "#ffffe8" :foreground "red" :weight bold)) + (((class color) (background dark)) + (:background "#181800" :foreground "red" :weight bold)) + (t (:foreground "yellow" :background "red"))) + "Face to use when highlighting symbols with more than 1 definition." + :group 'gas-faces) + +(defface gas-symbol-global + '((((class color) (background light)) (:background "#d0f8ff")) + (((class color) (background dark)) (:background "#00383f")) + (t (:foreground "yellow" :background "blue"))) + "Face to use when highlighting global symbols." + :group 'gas-faces) + +(defface gas-symbol-undef + '((((class color) (background light)) + (:background "#ffffe8" :foreground "maroon")) + (((class color) (background dark)) + (:background "#181800")) + (t (:foreground "yellow" :background "red"))) + "Face to use for symbols defined as global when no definition +was found." + :group 'gas-faces) + +(defface gas-symbol-global-undef + '((((class color) (background light)) + (:background "#d0f8ff" :foreground "red")) + (((class color) (background dark)) + (:background "#002840" :foreground "red")) + (t (:foreground "yellow" :background "red"))) + "Face to use for symbols when no definition is found." + :group 'gas-faces) + +(defface gas-passthrough-code + '((((class color) (background light)) (:foreground "magenta4")) + (((class color) (background dark)) (:foreground "magenta2")) + (t (:foreground "magenta1" :background "cyan"))) + "Marks passthrough code." + :group 'gas-faces) + +(defface gas-passthrough-comment + '((((class color) (background light)) (:foreground "turquoise4")) + (((class color) (background dark)) (:foreground "turquoise2")) + (t (:foreground "turquoise1"))) + "Marks passthrough comments." + :group 'gas-faces) + +(defvar gas-builtin-face 'gas-builtin) +(defvar gas-symbol-ok-face 'gas-symbol-ok) +(defvar gas-symbol-error-face 'gas-symbol-error) +(defvar gas-symbol-global-face 'gas-symbol-global) +(defvar gas-symbol-undef-face 'gas-symbol-undef) +(defvar gas-symbol-global-undef-face 'gas-symbol-global-undef) +(defvar gas-passthrough-code-face 'gas-passthrough-code) +(defvar gas-passthrough-comment-face 'gas-passthrough-comment) + +(defconst gas-max-lines-in-cache 500 + "Maximum number of parsed lines in cache. + +I don't expect much impact from this on performance (the line +cache is emptied on any buffer change anyway). Play around with +this value if you suspect memory may be your problem.") + +(defconst gas-max-labels-in-cache 300 + "Maximum number of symbols in highlight cache. +Reduce this if memory footprint grows too high (very unlikely).") + +(defconst gas-re-sym "\\([_$A-Za-z][_0-9$A-Za-z]*\\)" + "Regexp defining a valid symbol as a subexpression.") + +(defconst gas-skip-sym "_0-9$A-Za-z" + "The valid characters for a symbol as used in `skip-chars-*' functions.") + +(defconst gas-re-nosym"[^_0-9$A-Za-z]" + "Regexp defining the character set not allowed in a symbol.") + +(defvar gas-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\n "> b" st) + (modify-syntax-entry ?. "_" st) + (modify-syntax-entry ?/ ". 124b" st) + (modify-syntax-entry ?* ". 23" st) + st) + "Syntax table used while in gas mode.") + +(defvar gas-mode-abbrev-table nil + "Abbrev table used while in Gas mode.") +(define-abbrev-table 'gas-mode-abbrev-table ()) + +(defvar gas-mode-map + (let ((map (make-sparse-keymap))) + ;; Note that the comment character isn't set up until gas-mode is called. + (define-key map ":" 'gas-colon) + (define-key map "\M-;" 'gas-comment) + (define-key map ";" 'gas-comment-char) + (define-key map "#" 'gas-hash) + (define-key map (kbd "") 'gas-indent-backward) + (define-key map "\C-c;" 'comment-region) + (define-key map "\C-j" 'newline-and-indent) + (define-key map "\C-m" 'newline-and-indent) + map) + "Keymap for Gas mode.") + +(defconst gas-equ (regexp-opt '(".equ" ".set" ".eqv" ".equiv" ".set")) + "Regex matching all operators which define a symbol.") + +(defconst gas-indents + '((C-comment-end . gas-C-comment-end-column) + (C-comment-start . 0) + (C-comment . gas-get-C-relative-indent) + (cpp-macro-def . 0) + (cpp-argument . 0) + (label . 0) + (opcode . gas-opcode-column) + (argument . gas-argument-column) + (asm-comment . gas-get-asm-comment-column)) + "Fields and their indents. +The cdr (the indent) may either be a number, a symbol bound to a +number, or a symbol bound to a function yielding the value.") + +(defconst gas-parse-sequences + '( + (starting-asm-line + . ((cpp-macro-def . cpp-macro-def) + (label . label) + (empty-label . label) + (asm-comment . asm-comment) + (opcode . opcode))) + (label + . ((opcode . opcode) + (asm-comment . asm-comment) + (garbage . garbage))) + (opcode + . ((asm-comment . asm-comment) + (argument . argument) + (eol-ws . eol-ws) + (garbage . garbage))) + (argument + . ((asm-comment . asm-comment) + (eol-ws . eol-ws) + (garbage . garbage))) + (asm-comment + . ((eol-ws . eol-ws))) + (cpp-argument + . ((eol-ws . eol-ws) + (garbage . garbage))) + (cpp-macro-def + . ((cpp-argument . cpp-argument) + (garbage . garbage))) + (cpp-argument + . ((eol-ws) + (garbage . garbage))) + (C-comment-start + . ((C-comment . C-comment))) + (starting-within-C-comment + . ((C-comment-end . C-comment-end) + (C-comment . C-comment))) + (C-comment + . ((C-comment-end . C-comment-end) + (eol-ws . eol-ws) + (garbage . garbage))) + (garbage + . ((eol-ws . eol-ws))) + (eol-ws + . fini)) + "Mapping from the field type we're on to the field types to check next. +car - type of field we're on (IOW, the one just handled) + cdr - ordered list of (first (most special) check first): + car - token to match + cdr - next field type iff match." ) + +(defconst gas-patterns + '((cpp-macro-def + "[ \t]*\\(\\(#[^ \t\n]*\\)\\)" + (0 1 1 1) + "/[*]") + (cpp-argument + "[ \t]*\\(\\([ \t]*\\([^ \t\n]\\)+\\)+\\)" + (0 1 1 1) + "/[*]") + (label + "[ \t]*\\([^ :\t\n]+:\\)" + (0 1 1 1) + "/[*]\\|;") + (opcode + "[ \t]*\\([^ \t\n]+\\)" + (0 1 1 1) + "/[*]\\|;") + (argument + "[ \t]*\\(\\([ \t]*\\([^ \t\n]\\)+\\)+\\)" + (0 1 1 1) + "/[*]\\|;") + (garbage + "[ \t]*\\(\\([ \t]*\\([^ \t\n]\\)+\\)+\\)" + (0 1 1 1) + "/[*]\\|;") + (asm-comment + "[ \t]*\\(\\(;+\\)\\([ \t]*[^ \t\n]+\\)*\\)" + (0 1 1 1) + nil) + (C-inline-comment + "[ \t]*\\(/[*].*?[*]/\\)" + (0 1 1 1) + nil) + (C-comment-start + "[ \t]*\\(/[*]C?\\)" + (0 1 1 1) + nil) + (empty-label + ;; a field of at least 1 white space: no fill at start, nil + ;; text field at start, fill at end + " [ \t]*" + (0 0 0 nil) + "/[*]\\|;") + (C-comment-end + "[ \t]*\\([*]/\\)" + (0 1 1 1) + nil) + (C-comment + ;; match the entire line (except for trailing whitespace) + "[ \t]*\\(\\([ \t]*[^ \t]+\\)*\\)" + (0 1 1 1) + "[*]/") + ;; fill only: zero or more white space, nil text field at + ;; end + (eol-ws + "[ \t]+\\( ?\\)" + (0 1 1 1) ; last element always empty + nil)) + "An alist of parse patterns. + +Each entry holds 4 elements (SYMBOL REGEXP SUBEXPS TERMINATE-RE): + + SYMBOL - designator (a symbol) under which it will be + referenced. + + REGEXP - the regexp to match against, + + SUBEXPS - a list (BEG-COL TEXT-COL END-COL END-OF-FIELD) of at + which subexpression of REGEXP to find beg-col, text-col, + end-col (see `gas-parse-line-really') and the end of the + field, + + TERMINATE-RE - a regexp, the start of which (if it matches and + if outside a \"..\" string) unconditionally terminates the + field. + +Every occurence of the character \";\" in both regexps is +replaced by variable `gas-comment-char' before use.") + +(defconst gas-elmt-types + '(type subtype beg-col text-col end-col text modified) + "The elements of a gas syntax field.") + +(defconst gas-builtin-keywords (concat "^\\(\\(\\sw\\|\\s_\\)+:?\\)?[ \t]+\\(" + (regexp-opt '( + ".Abort" ".ABORT" ".Align" ".Altmacro" ".Ascii" ".Asciz" + ".Balign" ".Byte" ".Comm" + ".Data" ".Def" ".Desc" ".Dim" ".Double" ".Eject" + ".Else" ".Elseif" ".End" ".Endef" ".Endfunc" ".Endif" + ".Equ" ".Equiv" ".Eqv" + ".Err" ".Error" ".Exitm" ".Extern" ".Fail" + ".File" ".Fill" ".Float" ".Func" + ".Global" ".Hidden" ".hword" ".Ident" + ".If" ".ifb" ".ifc" ".ifeq" ".ifeqs" + ".ifge" ".ifle" ".ifgt" ".iflt" + ".ifnb" ".ifnc" ".ifndef" ".ifdef" ".ifnotdef" ".ifne" ".ifnes" + ".Incbin" ".Include" ".Int" + ".Internal" ".Irp" ".Irpc" ".Lcomm" ".Lflags" ".Line" + ".Linkonce" ".List" ".Ln" + ".Long" ".Macro" ".MRI" ".Noaltmacro" + ".Nolist" ".Octa" ".Org" ".P2align" ".PopSection" ".Previous" + ".Print" ".Protected" ".Psize" ".Purgem" ".PushSection" + ".Quad" ".Rept" ".Sbttl" ".Scl" ".Section" ".Set" ".Short" + ".Single" ".Size" ".Skip" ".Sleb128" ".Space" ".Stab" ".String" + ".Struct" ".SubSection" ".Symver" ".Tag" ".Text" ".Title" ".Type" + ".Uleb128" ".Val" ".Version" ".VTableEntry" ".VTableInherit" + ".Warning" ".Weak" ".Weakref" ".Word" ".Deprecated")) + "\\)[ \t\n]")) + +(defvar gas-font-lock-keywords + (append + (list + '(gas-return-passthrough-code-hi . (0 gas-passthrough-code-face t)) + '(gas-return-passthrough-comment-hi . (0 gas-passthrough-comment-face t)) + '(gas-return-gas-hi-ok . (0 gas-symbol-ok-face t)) + '(gas-return-gas-hi-global . (0 gas-symbol-global-face t)) + '(gas-return-gas-hi-error . (0 gas-symbol-error-face t)) + '(gas-return-gas-hi-undef . (0 gas-symbol-undef-face t)) + '(gas-return-gas-hi-global-undef . (0 gas-symbol-global-undef-face t)) + (list gas-builtin-keywords 3 'gas-builtin-face) + '("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?" 1 font-lock-function-name-face)) + cpp-font-lock-keywords) + "Additional expressions to highlight in gas mode.") +(put 'gas-mode 'font-lock-defaults '(gas-font-lock-keywords)) + +;;;###autoload + +(defun gas-mode () + "Major mode for editing assembler code. + +Commands: + +\(Some of these commands may exhibit slightly different behaviour if point +is on a C syntax line.) + +\\[indent-for-tab-command] indent the field(s) point is on. If it already is in its position, + move on to the next field on the line. + +\\[gas-indent-backward] Move to the previous field. + +\\[gas-comment] When no region is active, starts a comment sequence: + - If a comment is present and point is not at its start, jump there. + - Else start a comment. If there already is one, increase its comment level. + What that is and what it does, is best explained when you try + it out: Move to en empty line, then type \\[gas-comment] and + then repeatedly \\[gas-comment] or \\[gas-comment-char]. + Calls \\[gas-comment-dwim] (see below) if the region is active. + +\\[forward-sexp] If you're on a highlighted symbol, jump to its next + occurence. Else do `forward-sexp' like in text mode. + +\\[backward-sexp] If you're on a highlighted symbol, jump to its previous + occurence. Else do `backward-sexp' like in text mode. + +\\[gas-comment-dwim] If the region starts at the leading white space + before a comment, all full-line comments in region will be + removed. If the region starts on a comment, comments will be + removed, but comments with leading white space will be left + untouched. Else insert triple variable `gas-comment-char's before all + lines in region. + +\\[fill-paragraph] beautifies the paragraph around + point, i.e. it adjusts all assembly syntax fields to their + standard positions. + +\\[indent-region] beautifies the region, i.e., adjusts all fields in region. + + +The following characters have a special meaning in special cases: + +\\[gas-colon] if it terminates a label: outdent the label and + move to opcode column. Else, just insert \\[gas-colon] as usual. + +\\[gas-comment-char] The value which introduces an asm style comment. + If typed in in a row after \\[gas-comment], behaves as an alias to \\[gas-comment]. else + just insert \\[gas-comment-char]. + Can be customized to always act as alias (`gas-comment-char-starts-comment'). + + Alternatively, you may use a File Variable to make it buffer local + (which allows you to use different syntaxes in the same session). + Note: Setting it to a value other than ?\; has not yet been tested. + +\\[gas-hash] If it starts a preprocessor directive: Outdent it to first + column. + +Customization: Entry on this mode runs `gas-mode-hook'. +The customization group is called 'gas'. + +Special commands: +\\{gas-mode-map}" + (interactive) + (kill-all-local-variables) + (setq mode-name "gas") + (setq major-mode 'gas-mode) + (setq local-abbrev-table gas-mode-abbrev-table) + (setq gas-comment-string (string gas-comment-char)) + (setq gas-comment-re (regexp-quote gas-comment-string)) + (set (make-local-variable 'indent-line-function) 'gas-indent) + (set (make-local-variable 'indent-region-function) 'gas-indent-region) + (set (make-local-variable 'forward-sexp-function) 'gas-forward-sexp) + (set (make-local-variable 'fill-paragraph-function) 'gas-fill-paragraph) + (set (make-local-variable 'font-lock-defaults) '(gas-font-lock-keywords)) + (set (make-local-variable 'gas-local-comment-char) gas-comment-char) + (set (make-local-variable 'beginning-of-defun-function) + 'gas-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + 'gas-end-of-defun) + (set (make-local-variable 'font-lock-keywords-case-fold-search) t) + (use-local-map (nconc (make-sparse-keymap) gas-mode-map)) + (local-set-key (vector gas-comment-char) 'gas-comment-char) + (set-syntax-table (make-syntax-table gas-mode-syntax-table)) + (modify-syntax-entry gas-comment-char "< b") + (dolist (var '(gas-line-cache gas-globals-cache gas-locals-cache + gas-hi-valid gas-hi-sym-list gas-hi-global gas-hi-undef + gas-hi-error gas-hi-ok gas-changed gas-highlights gas-hi + gas-pass-code-hi gas-pass-comment-hi gas-symbol-timer + gas-highlights-error gas-symbol-highlight-beg + gas-symbol-highlight-end gas-doing-comment + after-change-functions)) + (set (make-local-variable var) nil)) + (add-to-list 'after-change-functions 'gas-after-change) + (add-hook 'pre-command-hook 'gas-symbol-pre-command) + (gas-start-symbol-timer) + (run-mode-hooks 'gas-mode-hook) + ;; scan buffer for extra regions to highlight: + (gas-symbol-highlight)) + +(defun gas-dbg () + "You won't need this unless you're debugging `gas-mode'." + (interactive) + (setq debug-on-error t) + ;(setq debug-on-quit t) + (setq debug-items '(indent)) + (switch-to-buffer-other-frame "*Messages*") + (switch-to-buffer-other-frame "*scratch*") + (info "Elisp") + (switch-to-buffer-other-frame "*scratch*") + (find-file-other-frame "x.S") + (switch-to-buffer-other-frame "x.S") + (switch-to-buffer-other-frame (get-buffer-create "*gas-dbg*")) + (find-file-other-frame "gas-mode.el") + (column-number-mode t) + (switch-to-buffer-other-frame "gas-mode.el")) + +(defun dmsg (condition &rest args) + "Helper function, outputs debug messages into a buffer of their own. + +If DEBUG-ITEMS (a symbol or a list) has a non-empty +intersection with CONDITION (a symbol or a list)', apply `format' +to ARGS and insert the result at the end of the buffer +`gas-dbg' (which is created if non-existing). + +Currently defined symbols are: 'wip (work in progress), +'hi (highlighting), 'parser, 'cursor, 'sym (symbol highlighting), +'cursor." + (when (and (boundp 'debug-items) debug-items) + (when (not (listp condition)) + (setq condition (list condition))) + (when (not (listp debug-items)) + (setq debug-items (list debug-items))) + (when (or (eq condition '(all)) + (catch 'found + (dolist (c condition) + (when (member c debug-items) + (throw 'found t))))) + (let ((contents (apply 'format args))) + (save-current-buffer + (set-buffer (get-buffer-create "*gas-dbg*")) + (goto-char (point-max)) + (newline) + (insert contents) + (goto-char (point-max)) + ;(recenter -1) + ))))) + +(defun gas-change-comment-regexp (str) + "Return STR with all \";\"s replaced by (regexp-quote variable `gas-comment-char')." + (when str + (setq str (replace-regexp-in-string + ".*\\[[^]]*\\(;\\)" gas-comment-string str t t 1)) + (replace-regexp-in-string ";" (regexp-quote gas-comment-string) str t t))) + +(defun gas-change-comment-string (str) + "Return STR with all \";\"s replaced by variable `gas-comment-char'." + (when str + (replace-regexp-in-string ";" gas-comment-string str t t))) + +(defun gas-set-patterns (comment-char) + "Replace `gas-patterns' by a copy, replacing ?\; by COMMENT-CHAR. +Also sets variable `gas-comment-char' to COMMENT-CHAR." + (set (make-local-variable 'gas-comment-char) comment-char) + (set (make-local-variable 'gas-comment-string) (string gas-comment-char)) + (set (make-local-variable 'gas-comment-re) (regexp-quote gas-comment-string)) + (kill-local-variable 'gas-patterns) + (let (result) + (dolist (pattern gas-patterns) + (add-to-list 'result + (list + (car pattern) + (gas-change-comment-regexp (nth 1 pattern)) + (nth 2 pattern) + (gas-change-comment-regexp (nth 3 pattern))))) + (set (make-local-variable 'gas-patterns) result) + (dolist (sym '(gas-defun-regexp)) + (kill-local-variable sym) + (let ((result (gas-change-comment-regexp (eval sym)))) + (set (make-local-variable sym) result))))) + +(defun gas-after-change (beg end len) + "Invalidate saved parser state. +Argument BEG BEG, END, and LEN, athough saved in `gas-changed' for debugging purposes, are not used." + (setq gas-globals-cache nil) + (setq gas-hi-valid nil) + (setq gas-locals-cache nil) + (setq gas-changed (append gas-changed (list (current-buffer) beg end len)))) + +(defun gas-symbol-pre-command() + (setq gas-hi nil)) + +(defun gas-start-symbol-timer (&optional stop) + "Schedule a timer for symbol highlighting (if not already scheduled). +Optional STOP, if non-nil, means remove from schedule." + (if (and stop gas-symbol-timer) + (progn + (cancel-timer gas-symbol-timer) + (setq gas-symbol-timer nil)) + (unless (and gas-symbol-timer + (memq gas-symbol-timer timer-idle-list)) + (setq gas-symbol-timer + (run-with-idle-timer gas-symbol-highlight-delay + t + 'gas-symbol-highlight-maybe))))) + +(defun gas-return-passthrough-hi (pos what) + "Return next passthrough match (if any). +See highlight.el for POS and WHAT." + (let ((curpoint (point))) + (catch 'found + (dolist (match what) + (when (and (< curpoint (cdr match)) + (> pos (car match))) + (when (< curpoint (car match)) + (goto-char (car match))) + (when (re-search-forward ".+" (min pos (cdr match)) t) + (dmsg 'hi "match: %s, data: '%s'" match (match-string 0)) + (throw 'found t))) + (when (>= (car match) pos) + (throw 'found nil)))))) + +(defun gas-return-passthrough-code-hi (pos) + "Return next passthrough code match (if any). +See highlight.el for documentation on POS." + (gas-return-passthrough-hi pos gas-pass-code-hi)) + +(defun gas-return-passthrough-comment-hi (pos) + "Return next passthrough comment match (if any). +See highlight.el for documentaion on POS ." + (gas-return-passthrough-hi pos gas-pass-comment-hi)) + +(defun gas-passthrough-highlight () + "Compute blocks of C passthroughs to be highlighted." + (goto-char (point-min)) + (setq gas-pass-code-hi nil) + (setq gas-pass-comment-hi nil) + (let (beg end limit) + (while (and (re-search-forward "/[*]C" nil t) + (setq beg (point)) + (setq limit + (save-excursion + (and (re-search-forward "[*]/" nil t) + (- (point) 2))))) + (while (and beg + (setq end (and (re-search-forward "/#" limit t) + (point)))) + (add-to-list 'gas-pass-code-hi (cons beg (- end 2)) t) + (forward-char 2) + (when + (setq beg (and (re-search-forward "#/" limit t) (point))) + (add-to-list 'gas-pass-comment-hi (cons (- end 2) beg) t))) + (when beg + (add-to-list 'gas-pass-code-hi (cons beg limit) t))))) + +(defun gas-return-highlight (pos hi-list) + "Called through the gas-return-gas-hi-* functions by highlight.el. +If there's a match of POS against one of the entries in HI-LIST, +return match data. Else, return nil." + (when gas-hi-valid + (dmsg 'hi "gas-return-highlight, pos: %s, point: %s, list: %s" pos (point) hi-list) + (catch 'found + (dolist (match hi-list) + (if (< (car match) pos) + (when (>= (car match) (point)) + (dmsg 'hi "gas-return-highlight, match: %s" match) + (goto-char (car match)) + (throw 'found (re-search-forward ".+" (min pos (cadr match)) t))) + (dmsg 'hi "gas-return-highlight: nope.") + (throw 'found nil) + nil))))) + +(defun gas-return-gas-hi-global (pos) + "Check POS against the entries in the list `gas-hi-global'. +Called by highlight.el." + (gas-return-highlight pos gas-hi-global)) + +(defun gas-return-gas-hi-undef (pos) + "Check POS against the entries in the list `gas-hi-undef'. +Called by highlight.el." + (gas-return-highlight pos gas-hi-undef)) + +(defun gas-return-gas-hi-error (pos) + "Check POS against the entries in the list `gas-hi-error'. +Called by highlight.el." + (gas-return-highlight pos gas-hi-error)) + +(defun gas-return-gas-hi-ok (pos) + "Check POS against the entries in the list `gas-hi-ok'. +Called by highlight.el." + (gas-return-highlight pos gas-hi-ok)) + +(defun gas-return-gas-hi-global-undef (pos) + "Check POS against the entries in the list `gas-hi-undef'. +Called by highlight.el." + (gas-return-highlight pos gas-hi-global-undef)) + + +(defun gas-qualify-symbol (sym-re slist lflags) + "The common part of `gas-scan-global-symbol and `gas-scan-local-symbol'. + +Gets called with point on a line where a label match may be +found. It expects SYM-RE to be a regexp describing the +label. Adds on match the match it finds to SLIST (a symbol bound +to a list of matches) and the kind of match (as a symbol, like +'def for a definition or 'duplicate for a duplicate definition) +to LFLAGS." + (save-excursion + (let ((eol (line-end-position)) + (bol (line-beginning-position))) + (setq case-fold-search nil) + (if (gas-C-comment-p) + (progn + (backward-char) + (while (re-search-forward + (format "%s\\(%s\\)\\(%s\\|$\\)" + gas-re-nosym sym-re gas-re-nosym) + eol t) + (let ((beg (match-beginning 1)) + (end (match-end 1))) + (when (gas-C-passthrough-code-p) + (add-to-list lflags 'C-ref t) + (add-to-list slist (list 'C-ref beg end) t))))) + ;; not C style: + (let* ((fields (gas-parsed)) + (lbl (gas-nth 'text 'label fields)) + (arg (gas-nth 'text 'argument fields)) + (type 'ref) + (argno 0)) + (when (and lbl + (string-match (concat "^" sym-re ":?$") lbl)) + (setq nlabels (1+ nlabels)) + (if (member 'def (eval lflags)) + (add-to-list lflags 'duplicate t) + (add-to-list lflags 'def t)) + (move-to-column 0) + (looking-at "[^:]+:") + (add-to-list slist + (list 'def (match-beginning 0) (match-end 0)) t)) + (when arg + (move-to-column (- (gas-nth 'text-col 'argument fields) 1)) + (let ((type 'ref) + (eo-arg (+ bol (gas-nth 'end-col 'argument fields) 2)) + (opcode (gas-nth 'text 'opcode fields))) + (while (re-search-forward + (format "%s\\(%s\\)\\(%s\\|$\\)" + gas-re-nosym sym-re gas-re-nosym) + eo-arg t) + (let ((beg (match-beginning 1)) + (end (match-end 1))) + ;; first argument? + (if (and (= argno 0) ; yes + (string-match gas-equ opcode)) ; assignment? + (progn + (setq type 'def) ; yes + (if (member 'def (eval lflags)) + (add-to-list lflags 'duplicate t) + (add-to-list lflags 'def t))) + (add-to-list lflags 'ref t)) ; no + (when (string-match ".global" opcode) + (add-to-list lflags 'global t)) + (add-to-list slist (list type beg end) t) + (setq argno (1+ argno)))))))))) + ;; skip past parsed part: + (end-of-line)) + +(defun gas-scan-global-symbol (sym) + "Scan the buffer vor valid occurences of the global symbol SYM. +Called by `gas-symbol-highlight'." + (goto-char (point-min)) + (let* (sym-list + flags + qualifiers + (nlabels 0) + (sym-re (regexp-quote sym)) + (re (format "\\(^\\|%s\\)\\(%s\\)\\(%s\\|$\\)" + gas-re-nosym sym-re gas-re-nosym))) + (while (re-search-forward re nil t) + (when (input-pending-p) + (throw 'event-abort nil)) + (goto-char (match-beginning 2)) + (dmsg 'sym "global: qualified1: %s" sym-list) + (gas-qualify-symbol sym-re 'sym-list 'flags)) + (dmsg 'sym "global: sym-list: %s" sym-list) + (unless (equal sym-list '(nil)) + (list sym flags sym-list)))) + +(defun gas-scan-local-symbol (orig-sym) + "Scan the buffer vor valid occurences of the local symbol SYM. +Called by `gas-symbol-highlight'. +Argument ORIG-SYM is the complete symbol (as written)." + (when (string-match "^\\(.*\\)\\([:bf]\\)" orig-sym) + (let* ((search-lo (point-min)) ; location of previous duplicate + search-mid ; label pos + (search-hi (point-max)) ; location of next duplicate + (sym (match-string 1 orig-sym)) + (sym-kind (match-string 2 orig-sym)) + (sym-re (regexp-quote sym)) + (lbl-re (concat "^\\(" sym-re ":" "\\)" )) + (nlabels 0) + sym-list + flags + qualifiers + searches) + ;; determine region where the label is valid + (save-excursion + (when (equal sym-kind "b") + (re-search-backward lbl-re nil t)) ; skip label + (when (re-search-backward lbl-re nil t) + (setq search-lo (match-end 1))) + (goto-char search-lo) + (when (re-search-forward lbl-re nil t) + (setq search-mid (match-beginning 1))) + (when (re-search-forward lbl-re nil t) + (setq search-hi (match-beginning 1)))) + (let ((lo search-hi) ; first match + (hi search-lo) ; end of last match + (search-params + (if search-mid + (list + (list (concat sym-re "f") search-lo search-mid) + (list (concat sym-re ":") + search-mid (+ search-mid (length sym) 2)) + (list (concat sym-re "b") search-mid search-hi)) + (list + (list (concat sym-re "f") search-lo search-hi) + (list (concat sym-re "b") search-lo search-hi))))) + (dolist (param search-params) + (when (input-pending-p) + (throw 'event-abort nil)) + (let* ((sym-re (car param)) + (search-re (concat gas-re-nosym + "\\(" sym-re "\\)" gas-re-nosym)) + (limit (caddr param))) + (goto-char (- (cadr param) 1)) + (while (and (< (point) limit) + (re-search-forward search-re limit t)) + (setq lo (min lo (match-beginning 1))) + (setq hi (max hi (match-end 1))) + (goto-char (match-beginning 1)) + (gas-qualify-symbol sym-re 'sym-list 'flags)))) + (dmsg 'sym "local: sym-list: %s" sym-list) + (unless (equal sym-list '(nil)) + (list sym lo hi flags sym-list)))))) + +(defun gas-sym-invalidate () + "Invalidate all symbol scan results." + (setq gas-hi-sym-list nil) + (setq gas-hi-global nil) + (setq gas-hi-global-undef nil) + (setq gas-hi-undef nil) + (setq gas-hi-error nil) + (setq gas-hi-ok nil)) + +(defun gas-symbol-highlight () + "Get symbol point is on, look for match and highlight it. +For use with the idle timer." + ;; To debug this part, stop the idle timer mechanism first: + ;; (gas-start-symbol-timer 'stop) + ;; then eval it. + (save-match-data + (save-excursion + (gas-passthrough-highlight)) + (save-excursion + (let* ((fields (gas-parsed)) + (curpoint (point)) + (case-fold-orig case-fold-search) + (pointpos (gas-get-pointpos fields)) + sym-list) + (catch 'event-abort + (dmsg 'hi "pointpos=%s, fields=%s" pointpos fields) + ;; skip to the symbol's start + (skip-chars-backward gas-skip-sym) + (when (member (car pointpos) '(label argument C-comment)) + (setq case-fold-search nil) + (setq sym-list + (catch 'found + ;; local label? + (if (and (not (eq (car pointpos) 'C-comment)) + (looking-at (concat "\\(\\([0-9]+\\)\\([bf:]\\)\\)" + gas-re-nosym))) + (let ((lbl (match-string 2))) + ;; local label + (dolist (entry gas-locals-cache) + (when (input-pending-p) + (throw 'event-abort nil)) + (and (equal (car entry) lbl) + (>= (nth 1 entry) curpoint) + (<= (nth 2 entry) curpoint) + (dolist (sym (nthcdr 3 entry)) + (and (>= (nth 1 entry) curpoint) + (<= (nth 2 entry) curpoint) + (throw 'found (nthcdr 3 entry))))) + nil) + ;; not found in cache + (let ((entry (gas-scan-local-symbol (match-string 1)))) + (when entry + (when (> (length gas-locals-cache) + gas-max-labels-in-cache) + (dmsg 'sym "gas-locals-cache truncated.") + (nbutlast gas-locals-cache + (/ (* gas-max-labels-in-cache 3) 4))) + (add-to-list 'gas-locals-cache entry) + (throw 'found (nthcdr 3 entry))))) + ;; global label: + (when (looking-at (format "\\(%s+\\)%s" + gas-re-sym gas-re-nosym)) + (setq lbl (match-string 1)) + (when (setq entry (assoc lbl gas-globals-cache)) + (throw 'found (cdr entry))) + ;; not found in cache + (let ((entry (gas-scan-global-symbol lbl))) + (when entry + (when (> (length gas-globals-cache) + gas-max-labels-in-cache) + (dmsg 'sym "gas-globals-cache truncated.") + (nbutlast gas-globals-cache + (/ (* gas-max-labels-in-cache 3) 4))) + (add-to-list 'gas-globals-cache entry) + (throw 'found (cdr entry)))))))) + + (dmsg 'sym "gas-symbol-highlight: Matched: %s" sym-list) + (gas-sym-invalidate) + (setq gas-hi-sym-list sym-list) + (let ((flags (car sym-list)) + target-list) + (dolist (sym (cadr sym-list)) + (when (input-pending-p) + (throw 'event-abort nil)) + (setq target-list + (cond + ((member 'duplicate flags) 'gas-hi-error) + ((and (member 'global flags) (member 'def flags)) + 'gas-hi-global) + ((member 'global flags) 'gas-hi-global-undef) + ((eq (car sym) 'C-ref) nil) + ((and (member 'def flags) (member 'ref flags)) + 'gas-hi-ok) + ((> (length (cadr sym-list)) 1) 'gas-hi-undef))) + (dmsg 'sym "target-list, sym: %s, list: %s" sym target-list) + (when target-list + (add-to-list target-list (cdr sym) t)))) + (setq gas-hi-valid t) + (font-lock-fontify-buffer))) + (setq case-fold-search case-fold-orig))))) + +(defun gas-symbol-highlight-maybe () + "Check for a symbol at point to be highlighted. +For use with the idle timer." + (unless (or (not gas-enable-symbol-highlight ) (input-pending-p)) + (undo-boundary) ; probably redundant + (gas-symbol-highlight) + (undo-boundary))) ; -"- + + +(defun gas-C-comment-p () + "True if we're editing a C syntax comment (the one enclosed in /* */)." + (save-excursion + (let ((current (point))) + (cond ((not (re-search-backward "/\\*" 0 t)) nil) + ((not (re-search-forward "\\*/" current t))))))) + +;; format of a C passthrough: +;; --- asm +;; /*C +;; --- C passthrough code +;; /# +;; --- C passthrough comment +;; #/ +;; ---- C passthrough code +;; [... passthrough code, comment as above ...] +;; */ +;; --- asm +(defun gas-C-passthrough-p () + "True if we're editing a C passthrough (a C style comment enclosed in /*C ... +*/)" + (when gas-use-C-passthrough + (save-excursion + (let ((current (point))) + (and (re-search-backward "/\\*C" 0 t) + (not (re-search-forward "\\*/" current t))))))) + +(defun gas-C-passthrough-comment-p () + "True if we're editing a C passthrough comment (/# ... +#/ within a /*C ... */ comment)" + (when gas-use-C-passthrough + (save-excursion + (let ((current (point))) + (when (gas-C-passthrough-p) + (save-restriction + (prog2 + (gas-narrow-to-C-comment) + (and (re-search-backward "/\\#" 0 t) + (not (re-search-forward "[#*]/" current t)))))))))) + + +(defun gas-C-passthrough-code-p () + "True if we're editing C passthrough code. +i.e. we're within a /*C ...*/ comment but not within /# ... #/." + (when gas-use-C-passthrough + (and (gas-C-passthrough-p) + (not (gas-C-passthrough-comment-p))))) + +(defun gas-C-comment-really-p () + "True if we're in a standard C commont or in a nested passthrough C comment." + (and (gas-C-comment-p) + (not (gas-C-passthrough-code-p)))) + +(defun gas-comment-p () + "True if we're editing some kind of comment." + (or (looking-back (concat gas-comment-string ".*")) + (gas-C-comment-p))) + +(defun gas-narrow-to-C-comment () + "Narrow region to the C comment point resides in." + (unless (gas-C-comment-p) + (error "Not within C comment")) + (save-excursion + (let* ((beg (re-search-backward ".*/[*]")) + (end (re-search-forward "[*]/" nil t))) + (when end + (narrow-to-region beg end))))) + + +(defun gas-token-pattern (cur-check) + "Return a list how to parse for token `CUR-CHECK'. +The returned list holds three elements, see the documentation +of `gas-patterns' for an explanation." + (let ((pattern (cdr (assq cur-check gas-patterns)))) + (when (not pattern) + (t (error "Gas internal: illegal pattern %s requested" + cur-check))) + pattern)) + +(defun gas-next-token (check-list) + "Parse for one of the tokens in list `CHECK-LIST'. +`CHECK-LIST' is a list of cons cells (TOKEN-SYMBOL . RESULTING-TYPE). + +Look up each TOKEN-SYMBOL in `gas-patterns' in order, then match +the text at point against the two regexps found there. On match, +eat the match (advance point past it) and return the resulting +field with its car set to RESULTING-TYPE (which is the same as +TOKEN-SYMBOL in nearly all cases except for the final parser +state, 'fini (and may be nil if same)). If none matches, +return nil. + +Valid TOKEN-SYMBOLS and RESULTING-TYPEs are the ones listed in +'gas-patterns'." + + (save-match-data + (catch 'got-token + (dolist (cur-check check-list) + (save-restriction + (let* ((pattern-list (gas-token-pattern (car cur-check))) + (regexp (pop pattern-list)) + (subexps (pop pattern-list)) + (limit-re (pop pattern-list)) + limit + (subtype nil)) + (setq limit (line-end-position)) + (when (and limit-re + (looking-at + (format "\\(\\(\"[^\n\"]*\"\\)\\|[^\n\"]\\)*?\\(%s\\)" + limit-re))) + (setq limit (match-beginning 3))) + (when (>= limit (point)) + (narrow-to-region (point) limit) + (when (looking-at regexp) ; match pattern + (cond + ((eq (cdr cur-check) 'asm-comment) + ;; set subtype to the number of consecutive comment-chars + (setq subtype (- (match-end 2) (match-beginning 2)))) + ((eq (cdr cur-check) 'argument) + ;; set subtype to be a list holding the positions of the + ;; individual subexpressions (relative to start of text) + (let ((arg-beg (point)) + (arg-end (match-end 0))) + (setq subtype '(0)) + (save-excursion + (save-match-data + (while (re-search-forward "," arg-end t) + (add-to-list 'subtype (- (point) arg-beg 1) t))))))) + (goto-char (min limit (match-end 0))) + (throw 'got-token + (list (cdr cur-check) + subtype + (- (min limit (match-beginning (pop subexps))) curbol) + (- (min limit (match-beginning (pop subexps))) curbol) + (- (min limit (match-end (pop subexps))) curbol) + (let ((subexp (pop subexps))) + (and subexp + (not (equal (match-string subexp) "")) + (match-string subexp))) + nil)))))))))) + + + + + + +(defun gas-parse-line-really () + "Parse the line point is on, element by element. +The returned list holds a list of syntactic elements (fields) +found, in the order of appearance. Each syntactic element is +represented by a list holding 7 elements: + +'(TYPE SUBTYPE BEG-COL TEXT-COL END-COL TEXT MODIFIED) + 0 - 'type: ('label, 'opcode ...) + 1 - 'subtype: (additional information required by some types) + 2 - 'beg-col: first slot (column #) (usually occupied by white + space before text) + 3 - 'text-col: first text slot (column #) + 4 - 'end-col: first free slot after field (column #) + 5 - 'text: text contents (nil if empty) + 6 - 'modified: nil (will later reflect if rearrangement (indentation) + is required / was done). + +Terminology: A single list of these 7 elements is called a +`field' throughout gas-mode.el. `fields' as symbol name (or part +of a symbol name) means it stands for a variable bound to a list +of `field' lists which, in order of appearance, describe a +complete source line. + +Note that text-col may lie outside (on the right side of) the +range beg-col ... end-col if there's no actual text (it is the +column where text would have to go to). + +Don't assume a fixed element position except for 'type, which is +always the car of the list. Instead, use `gas-nth' to extract +elements by their symbolic names ('type, 'subtype, ...)." + + ;; We use syntax tables neither here nor much throughout the whole + ;; gas-mode, since assembler code, being line oriented and based on + ;; number and position of elements on the line, fits regexps better + ;; than syntax tables (IMHO). The only drawback is that this + ;; approach makes dealing with inline C-style comments embedded + ;; between asm fields (who the hell does that?) somewhat clumsy, + ;; but not by much. + (let (field + (f-type 'start) + pushed-f-type + (C-inline-comment-level 0) + fields) + + (save-excursion + (setq cureol (line-end-position)) + (beginning-of-line) + (setq curbol (point)) + + (setq f-type + (if (gas-C-comment-p) + (progn + (setq pushed-f-type 'starting-asm-line) + 'starting-within-C-comment) + 'starting-asm-line)) + (while f-type + ;; always check for C-comment first (except we're already + ;; inside) + (setq field + (and (not (gas-C-comment-p)) + (gas-next-token + '((C-inline-comment . C-inline-comment) + (C-comment-start . C-comment-start))))) + (unless field + ;; dispatch based on previous field + (let ((next-check (cdr (assq f-type gas-parse-sequences)))) + (when (not next-check) + (error "Gas-mode internal: gas-parse-line: %s" f-type)) + (when (not (eq next-check 'fini)) + ;; parse: + (setq field (gas-next-token next-check))) + (when (eq (car field) 'garbage) + (error "Gas-mode internal: garbage: %s" field)) + (dmsg 'parser "parsed a field: %s->%s" f-type field))) + (when (eq (car field) 'C-inline-comment) + (setcar field (list 'C-inline-comment C-inline-comment-level)) + (setq C-inline-comment-level (1+ C-inline-comment-level))) + (when (and (eq 'asm-comment (car field)) + (assq 'opcode fields)) + (gas-set-nth 'subtype field 1)) + (when field + (add-to-list 'fields field t)) + (when (eq (car field) 'C-comment-start) ; push state + (setq pushed-f-type f-type)) + (unless (and field (listp (car field))) ; not C-inline-comment + (setq f-type (car field))) + (when (eq f-type 'C-comment-end) ; pop state + (setq f-type pushed-f-type)) + (when (listp f-type) + (setq f-type (car f-type))))) + + + (dmsg '(parser cursor) "parsed all fields: %s" fields) + fields)) + + +(defun gas-get-field (field-type field-list &optional offset) + "Return field of specified type. + +Return field (a list) with first element (syntactic type) eq +to FIELD-TYPE from FIELD-LIST, nil if no such field. + +Optional OFFSET >= 0: return next field, OFFSET < 0: return +previous field. If OFFSET is given. both fields (FIELD-TYPE and +the one before/after) must exist, else nil is returned." + (if offset + (let (f-types + f-type) + (dolist (field field-list) + (add-to-list 'f-types (car field) t)) + (if (> offset 0) + (while (not (eq (pop ftypes) field-type))) + (while (and (setq f-type (nth 1 f-types)) + f-type + (not (eq f-type field-type))) + (pop f-types))) + (gas-get-field (car f-types) field-list)) + (assq field-type field-list))) + +(defun gas-nth (component field-from &optional field-list) + "Get one of the components of a field. + +COMPONENT is the component to be returned. FIELD-FROM is either +a list containing a field, or a symbol designating a field (see +`gas-parse-line-really' for both). + +In the latter case, optional FIELD-LIST must be supplied as a +list of fields where FIELD-FROM is extracted from." + (let ((field-from (if field-list + (gas-get-field field-from field-list) + field-from))) + (nth (gas-elmt-n component) field-from))) + +(defun gas-elmt-n (elmt) + "Return the numeric index of field component ELMT." + (when (symbolp elmt) + (- (length gas-elmt-types) (length (memq elmt gas-elmt-types))))) + +(defun gas-set-nth (elmt field val-or-fields &optional val) +"Set a single field component. + +ELMT is the content to set the field to. +If FIELD is a list containing a single field, set its ELMT (a +symbol) to VAL-OR-FIELDS. If FIELD is a symbol designating a +field and VAL-OR-FIELDS is a list of such fields (as returned by +`gas-parsed'), set ELMT in the FIELD field of VAL-OR-FIELDS to +VAL." + (let ((curfield field)) + (if val + (setq curfield (assq field val-or-fields)) + (setq val val-or-fields)) + (setcar (nthcdr (gas-elmt-n elmt) curfield) val))) + +(defun gas-rearrange (fields &optional elmt f-type val) + "Rearrange FIELDS so they fit together without gaps or overlapping. + +FIELDS is the field list describing the current line. + +Optional ELMT designates a field component in the field specified +by (eq to) F-TYPE, which has to be changed before rearrangement +to VAL. VAL may be a variable, a symbol which evaluates to the +taget value, or bound to a function returning the target type of +the component. + +If the line did change, return the field type (the car) of the +first field that has changed, else nil." + (let ((field-slot 0) ; next free slot for a field + (text-slot 0) ; next column where text should go to + (end-slot 0) + did-change) + (dolist (field fields) + (let ((old-col (gas-nth 'text-col field)) + (text (gas-nth 'text field))) + + (gas-set-nth 'beg-col field field-slot) + ;; insert new value if needed + (when (and val (eq f-type (gas-nth 'type field))) + (gas-set-nth elmt field val)) + ;; determine text column + (let ((tcol (gas-nth 'text-col field))) + ;; if the current text column is nil and we are reordering: + ;; put in its default value. + (when (or (eq elmt 'all) + (and (not val) (eq f-type (car field)))) + (setq tcol (cdr (assq (car field) gas-indents)))) + ;; if column is a symbol: replace it by its value + (when (and tcol (symbolp tcol)) + (setq tcol (if (fboundp tcol) + (funcall tcol) + (eval tcol)))) + ;; if we still have got no target value: use the next free + ;; text slot + (unless tcol + (setq tcol text-slot)) + ;; set text col to max (current, next-free-slot) + (setq tcol (max tcol text-slot)) + (gas-set-nth 'text-col field tcol) + ;; update `modified' flags: + (when (and text + (not (eq tcol old-col))) + (unless did-change + (setq did-change (car field))) + (gas-set-nth 'modified field t)) + (when text + (setq field-slot (+ (gas-nth 'text-col field) (length text)))) + (setq end-slot (max end-slot (or (gas-nth 'end-col field) 0))) + (gas-set-nth 'end-col field field-slot) + ;; determine next free slot + (setq text-slot (max tcol text-slot)) + (when (/= 0 field-slot) + (setq text-slot (max text-slot (1+ field-slot))))))) + (gas-set-nth 'end-col 'eol-ws fields end-slot) + did-change)) + + +(defun gas-reset-modified (fields) + "Clears the `modified' flag on all fields in FIELDS." + (dolist (field fields) + (gas-set-nth 'modified field nil))) + +(defun gas-get-pointpos (ffields) + "Determine the field in FFIELDS point is on. +Returns a list (F-TYPE SUBTYPE OFFSET-TO-FIELD-TEXT-BEGIN ABS-COLUMN EOL). +EOL may bei either the symbol 'eol or nil" + (let* ((curcol (current-column)) + (fields (copy-tree ffields)) + (ppos (list (caar fields) curcol))) + (catch 'pos-found + (dolist (field fields) + ;; first, look for a field match + (when (and (gas-nth 'text field) + (>= curcol (gas-nth 'beg-col field)) ; field start + (<= curcol (gas-nth 'end-col field))) ; field end + (setq ppos (list (car field) (- curcol (gas-nth 'text-col field)))) + (throw 'pos-found t))) + ;; no field match: look at position relative to text slot + (gas-rearrange fields 'all) + (dolist (field fields) + (when (or (<= curcol (gas-nth 'text-col field)) + (eq (car field) 'eol-ws)) + (setq ppos (list (car field) (- curcol (gas-nth 'text-col field)))) + (throw 'pos-found t)))) + (setq ppos (append ppos (list curcol))) + (if (>= curcol (gas-nth 'end-col 'eol-ws fields)) + (append ppos '(eol)) + ppos))) + +(defun gas-get-C-relative-indent () + "Return indent of the closest previous non-blank line in current C comment." + (if (not (gas-C-comment-p)) + gas-C-indent + (save-restriction + (gas-narrow-to-C-comment) + (let ((col + (save-excursion + (catch 'found + (if (looking-at "[ \t]*#/") + ;; end passthrough: same indent as start + (while (= 0 (forward-line -1)) + (when (looking-at "[ \t]*/#") + (throw 'found (current-indentation)))) + (while (= 0 (forward-line -1)) + (when (looking-at "[ \t]*/[*#]") + (throw 'found (+ gas-C-indent (current-indentation)))) + (when (looking-at "[ \t]*[^ \t\n]") + (throw 'found (current-indentation))))) + gas-C-indent)))) + (when (gas-C-passthrough-code-p) + (if (looking-at "[ \t\n]*}[ \t\n]*;") + (setq col (max 0 (- col gas-C-indent))))) + col)))) + +(defun gas-add-missing-fields (parsed-fields) + "Complete parser result by adding in empty but allowed fields. + +Determine line syntax from the parse result in PARSED-FIELDS, +then add in empty fields for syntactic components not used in the +source line but allowed by the syntax, so later code can safely +assume they are present." + ;; Let's qualify what we've got + (let (existing-types mandatory line-syntax new-fields f-type cur-type) + ;; determine mandatory fields: + (setq mandatory + (cond ((not parsed-fields) ; empty line + '(label opcode argument asm-comment eol-ws)) + ((assq 'C-comment parsed-fields) + '(C-comment-start C-comment C-comment-end eol-ws)) + ((assq 'cpp-macro-def parsed-fields) + '(cpp-macro-def cpp-argument eol-ws)) + (t + (let ((subtype (gas-nth 'subtype 'asm-comment parsed-fields))) + (cond + ((eq subtype 3) '(asm-comment eol-ws)) + ((eq subtype 2) '(label asm-comment eol-ws)) + (t '(label opcode argument asm-comment eol-ws))))))) + (dmsg '(parser cursor) "mandatory: %s" mandatory) + ;; We're going through all fields in `fields', inserting mandatory + ;; elements (from `mandatory') if not present + (dolist (field parsed-fields) + (setq f-type (car field)) + (if (member f-type mandatory) + ;; we have a mandatory field. Insert missing fields (if + ;; any) before it, then insert the field at its place. + (progn + ;; insert an empty field for each mandatory but + ;; not already exisiting element before the one + ;; we're dealing with. + (while (progn + (setq cur-type (pop mandatory)) + (not (eq cur-type f-type))) + (dmsg 'parser "adding missing mandatory: %s" cur-type) + (add-to-list 'new-fields + (list cur-type nil nil nil nil nil nil) t)) + ;; now insert field + (dmsg 'parser "adding existing mandatory: %s" field) + (add-to-list 'new-fields field t)) + ;; we have a non-mandatory field. Pass it through, + ;; keeping its place if possible. + (add-to-list 'new-fields field t))) + ;; done with parsed fields. + ;; add mandatory elements left out at right + (while (setq cur-type (pop mandatory)) + (dmsg 'rearranged "adding left-over: %s" cur-type) + (add-to-list 'new-fields + (list cur-type nil nil nil nil nil nil) t)) + (dmsg 'parser "new-fields=%s" new-fields) + new-fields)) + +(defun gas-parsed (&optional lineno) + "Return fields on line LINENO or, if nil, on current line. +Return cached data, if available. Else, call +`gas-parse-line-really', store result into the gas-line-cache and +return it." + (dmsg 'parser "gas-changed: %s, lenght gas-line-cache: %s" + gas-changed (length gas-line-cache)) + (unless (and (eq gas-comment-char ?\;) + (eq gas-local-comment-char gas-comment-char)) + (setq gas-local-comment-char gas-comment-char) + (gas-set-patterns gas-comment-char)) + (when gas-changed + (setq gas-line-cache nil) + (setq gas-changed nil)) + (when (> (length gas-line-cache) gas-max-lines-in-cache) + (dmsg 'parser "gas-line-cache truncated.") + (nbutlast gas-line-cache (/ (* gas-max-lines-in-cache 3) 4))) + (let* ((curline (or lineno (line-number-at-pos))) + (cached (assq curline gas-line-cache))) + (if cached + (cadr cached) + (let (fields) + (save-excursion + (goto-line curline) + (setq fields (gas-parse-line-really)) + (setq fields (gas-add-missing-fields fields)) + (gas-rearrange fields) + (dmsg 'parser "->gas-line-cache: %s" fields) + (add-to-list 'gas-line-cache (list curline fields))) + fields)))) + +(defun gas-put-parsed (fields lineno) + "Put FIELDS into gas-line-cache at LINENO. +Overwrites the previous entry for that line (if any)." + (gas-reset-modified fields) + (let ((current (assq lineno gas-line-cache))) + (if current + (setcdr current (list fields)) + (add-to-list 'gas-line-cache (list curline fields))))) + +(defun gas-put-out (&optional fields) + "Replace the current scrren line by the one described by FIELDS." + (when (not fields) + (setq fields (gas-parsed))) + (dmsg 'indent "put-out, fields: %s" fields) + (combine-after-change-calls + (save-excursion + (beginning-of-line) + (delete-region (point) (line-end-position)) + (dolist (field fields) + (when (and (gas-nth 'text field) + (or gas-preserve-trailing-whitespace + (not (eq (car field) 'eol-ws)))) + (indent-to (gas-nth 'text-col field)) + (insert (gas-nth 'text field))))))) + +(defun gas-get-asm-comment-column () + "Get comment column according to asm comment subtype on current line. +The caller must provide the variable `fields' (bound to current +line's parsed content)." + (let ((subtype (gas-nth 'subtype 'asm-comment fields))) + (cond ((not subtype) gas-comment-column) + ((= subtype 1) gas-comment-column) + ((= subtype 2) gas-opcode-column) + (t 0)))) + +(defun gas-set-point-to-field (f-type fields) + "Postition point to the start of the field of type F-TYPE. +FIELDS is a field list reflecting the current line." + (let ((target-col (gas-nth 'text-col f-type fields))) + (move-to-column target-col) + (indent-to target-col) + (when (eq f-type 'asm-comment) + (skip-chars-forward (format " %c" gas-comment-char)) + (when (not (looking-back " ")) + (insert-char ?\s 1))))) + +(defun gas-set-point (pointpos fields &optional direction always) + "Set point to a field of the current line. + +POINTPOS is the current field as returned by a call to +`gas-get-pointpos', FIELDS the parsed content of the current +line. + +If DIRECTION is nil or 'stay, set it to the beginning of +the current field. If DIRECTION is 'end-of-field, set it to the +end of the current field. If DIRECTION equals 'backward or +'forward, and ALWAYS is nil, set it to the beginning of the +next/previous field only if the field is unchanged, else to the +beginning of the current. Finally, if DIRECTION equals 'backward +or'forward and ALWAYS is non-nil, move point unconditionally to +the beginning of the next/previous field." + (let ((existing '(line-begin)) + f-type) + (dmsg 'indent "(gas-set-point %s %s %s)" pointpos direction always) + (dolist (field fields) + (setq existing (append existing (list (car field))))) + (add-to-list 'existing 'line-end t) + (when (eq direction 'backward) + (setq existing (nreverse existing))) + (setq f-type (car pointpos)) + (when (and (eq direction 'forward) + (eq (nth 3 pointpos) 'eol)) + ;; special forward skipping rules for certain fields: + (cond ((and (eq f-type 'C-comment-start) (= (nth 2 pointpos) 0)) + ;; move on: + nil) + ((memq f-type '(label opcode argument)) + (cond ((>= (nth 2 pointpos) gas-comment-column) + (setq f-type 'eol-ws)) ; next: line-end + ((and (not (gas-nth 'text 'opcode fields)) + (>= (nth 2 pointpos) gas-opcode-column)) + (setq f-type 'argument)))) ; next: comment + (t (setq f-type 'eol-ws)))) ; next: line-end + ;; rules for skipping backward: + (when (eq direction 'backward) + (when (= (nth 2 pointpos) 0) + (setq f-type (car (last existing 2)))) ;next: line-begin + (and (> (nth 1 pointpos) 0) + (or (not (eq f-type 'asm-comment)) + (not (looking-back ";[ \t]"))) + (setq direction 'stay))) + ;; move to next field if told to do so: + (when (and (not (memq direction '(pos stay end-of-field))) ; no - forbidden + (or always ; yes - do always + (and direction ; maybe - do only if field unchanged + (not (gas-nth 'modified f-type fields))))) + (setq f-type (cadr (member f-type existing)))) + (dmsg 'indent "gas-set-point next:%s, fields: %s" f-type fields) + ;; set point + (if (eq f-type 'line-begin) + (progn + (if (bobp) + (beep)) + (beginning-of-line)) + (when (eq f-type 'line-end) + (when (eobp) + (beep) + (error "End of buffer")) + (setq f-type 'eol-ws) + (setq direction 'end-of-field)) + (gas-put-out) + ;; and set point there: + (let ((where (gas-nth 'text-col f-type fields))) + (cond ((eq direction 'pos) + (setq where (+ (gas-nth 'text-col f-type fields) + (cadr pointpos)))) + ((eq direction 'end-of-field) + (setq where (max where (gas-nth 'end-col f-type fields))))) + (move-to-column where t) + (indent-to where)) + (when (eq f-type 'asm-comment) + (skip-chars-forward (format " %c" gas-comment-char)) + (when (not (looking-back " ")) + (insert-char ?\s 1)))))) + +(defun gas-indent (&optional direction always ffields) + "Indent current line. + +For lines carrying asm syntax, `gas-indent-current-field-only' +determines if only the current field or the entire line is +affected. + +See `gas-set-point' for a description of DIRECTION and ALWAYS. +FFIELDS, if present, is a list describing the fields on the +current line as returned by `gas-parsed'." + (let* ((fields (or ffields (gas-parsed))) + rearranged-type + pointpos) + (setq pointpos (gas-get-pointpos fields)) + (dmsg 'indent "gas-indent, fields: %s" fields) + (dmsg 'indent "gas-indent, pointpos: %s" pointpos) + (when (and (not direction) + (not (gas-C-comment-p)) + (eq this-command 'newline-and-indent)) + ;; go to first non-empty field. If none, to opcode. + (setq pointpos + (list + (or (catch 'field-found + (dolist (field fields) + (when (gas-nth 'text field) + (throw 'field-found (car field))))) + 'opcode) + 0 gas-opcode-column)) + (setq direction 'stay) + (setq always t)) + (setq rearranged-type + (cond + ((and (eq (caar fields) 'C-comment-start) + (or (save-excursion (beginning-of-line)(looking-at "[ \t]*$")) + (and (eq (car pointpos) 'C-comment) (= (nth 1 pointpos) 0)))) + ;; at start of C comment text (poosibly empty): in/outdent + (let ((n_indents (/ (nth 2 pointpos) gas-C-indent))) + (if (eq direction 'backward) + (setq n_indents (max 0 (1- n_indents))) + (setq n_indents (1+ n_indents))) + (gas-rearrange fields 'text-col 'C-comment + (* gas-C-indent n_indents)) + (setq direction 'stay) + 'C-comment)) + (gas-indent-current-field-only + (gas-rearrange fields 'text-col (car pointpos) + (cdr (assq (car pointpos) gas-indents)))) + (t (gas-rearrange fields 'all)))) + (dmsg 'indent "re-indented, fields: %s" fields) + (gas-put-parsed fields (line-number-at-pos)) + (gas-put-out) + (cond (always (gas-set-point pointpos fields direction always)) + (rearranged-type (gas-set-point-to-field rearranged-type fields)) + ((and (eq (car pointpos) 'C-comment) (not direction) + (> (cadr pointpos) 0)) + (gas-set-point pointpos fields 'pos always)) + ((and (not direction) (>= (cadr pointpos) 0)) + (gas-set-point pointpos fields 'forward always)) + (t (gas-set-point pointpos fields direction always))) + fields)) + +(defun gas-indent-region (&optional from to) + "Indent all fields in region. + +If optional FROM and TO are given, they are used instead of point +and mark for the region's end points." + (interactive) + (unless from (setq from (min (point) (mark)))) + (unless to (setq to (max (point) (mark)))) + (combine-after-change-calls + (save-excursion + (goto-char from) + (while (and (not (eobp)) (< (point) to)) + (dmsg 'indent "indent-region, line:%s" (line-number-at-pos)) + (if (gas-C-comment-p) + (beginning-of-line 2) ; skip C comments + (let ((fields (gas-parsed))) + (gas-rearrange fields 'all) + (gas-put-out fields) + (beginning-of-line 2))))))) + +(defun gas-indent-backward () + "Indent, then move to previous field. +While in C-comment, remove one level of indentation." + (interactive) + (gas-indent 'backward 'always)) + +(defun gas-forward-sexp (n) + "On a highlighted symbol, move to next (previous if N < 9). +Else do `forward-sexp' as usual." + (gas-sym-invalidate) + (interactive) + (gas-symbol-highlight) + (if gas-hi-sym-list + (unless + (catch 'found-one + (if (< 0 n) + (dolist (match (cadr gas-hi-sym-list)) + (when (> (cadr match) (point)) + (goto-char (cadr match)) + (throw 'found-one t))) + (dolist (match (reverse (cadr gas-hi-sym-list))) + (when (< (nth 2 match) (point)) + (goto-char (cadr match)) + (throw 'found-one t))))) + (beep)) + (let (forward-sexp-function) + (forward-sexp n)))) + + +(defun gas-beginning-of-defun () + "Skip to the beginning of the current block. +The block delimiter is described by `gas-defun-regexp'." + (interactive) + (let* ((beg (save-excursion + (re-search-backward gas-defun-regexp nil t)))) + (when beg + (goto-char (match-beginning gas-defun-regexp-subexp))))) + +(defun gas-end-of-defun () + "Skip to the beginning of the next block. +The block delimiter is described by `gas-defun-regexp'." + (interactive) + (let ((beg (save-excursion + (re-search-forward gas-defun-regexp nil t)))) + (when beg + (goto-char (match-beginning gas-defun-regexp-subexp))))) + + +(defun gas-hash () + "Insert a hash mark. If it start a macro, delete the indentaion." + (interactive) + (when (and (not (gas-comment-p)) + (looking-back "^[ \t]*")) + (beginning-of-line) + (delete-horizontal-space)) + (call-interactively 'self-insert-command)) + + +(defun gas-colon () + "Insert a colon; if it follows a label, delete the label's indentation." + (interactive) + (call-interactively 'self-insert-command) + ;; check if colon belongs to a label field + (let* ((fields (gas-parsed)) + (pointpos (gas-get-pointpos fields))) + (dmsg 'indent "gas-colon, fields: %s" fields) + (dmsg 'indent "gas-colon, pointpos: %s" pointpos) + (when (eq (car pointpos) 'label) + (beginning-of-line) + (gas-indent 'forward t)))) + + +;; Obsolete since Emacs-22.1. +(defalias 'gas-newline 'newline-and-indent) + +(defun gas-comment-region-dwim (&optional from to) + "De-comment region if at start of comment, make comment out of region if not. +Optional argument FROM Optional FROM and TO mark the region." + (unless from + (setq from (min (point) (mark))) + (setq to (max (point) (mark)))) + (when (save-excursion (goto-char to) (bolp)) + (setq to (1- to))) + (save-excursion + (let ((mmax (progn (goto-char to) (point-marker))) + (mmin (progn (goto-char from) (point-marker)))) + + (if (gas-C-passthrough-p) + (let* (beg end end-match + (pos (looking-at "[ \t\n]*/#")) + (de-comment (or pos (gas-C-passthrough-comment-p)))) + (save-restriction + (gas-narrow-to-C-comment) + (if de-comment + (progn + (when (gas-C-passthrough-comment-p) + (insert " #/\n")) + (while (re-search-forward + "\\(\n[ \t]*\\)?/#\\(\n[ \t]*\\)?" mmax t) + (replace-match "") + (when (re-search-forward + "\\(\n[ \t]*\\)?[#]/\\(\n[ \t]*\\)?" mmax t) + (replace-match ""))) + (let* ((end (save-excursion + (re-search-forward "[#*]/" nil t))) + (end-match (match-string 0)) + (beg (save-excursion + (re-search-forward "/#" nil t)))) + (when (and (equal end-match "#/") + (or (not beg) + (> beg end))) + ;; we have a comment close outside the selcted + ;; area which misses the matching comment open + (goto-char mmax) + (insert "\n/#\n")))) + ;; do C en-comment + (insert " /#\n ") ; + (while (and (save-excursion + (setq end (re-search-forward "[*#]/" nil t))) + (setq beg (re-search-forward "/#" mmax t))) + (replace-match "#/ /# ") + (re-search-forward "[#*]/" mmax t) + (if (equal end-match "*/") + (replace-match " #/\n*/") + (replace-match "#/ /#"))) + (let* ((end (save-excursion + (re-search-forward "[#*]/" nil t))) + (end-match (match-string 0)) + (beg (save-excursion + (re-search-forward "/#" nil t)))) + (when (and (equal end-match "*/") + (or (not beg) + (> beg end))) + ;; we have no comment close outside the selcted + ;; area but comment is open + (goto-char mmax) + (backward-char 2) + (insert "\n #/\n")))))) + ;; skip to the start of the asm comment if we're on one + (when (looking-back (format "%c+[ \t]*" gas-comment-char)) + (goto-char (match-beginning 0)) + (skip-chars-backward gas-comment-string)) + (save-restriction + (narrow-to-region (point) to) + (let ((triple-comment (concat (make-string 3 gas-comment-char) " ")) + comment-pattern + (de-comment + ;; de-comment if there's a comment after point or + ;; at the start of the next non-empty line + (looking-at (format "[ \t]*%c\\|.*\n[ \t\n]*\%c" + gas-comment-char gas-comment-char)))) + (when de-comment + (goto-char (match-end 0)) + (skip-chars-backward gas-comment-string) + (looking-at (format "\n?\\([ \t]\\)*\\(%c+\\)\\([ \t]?\\)" + gas-comment-char)) + (let ((pre-pattern (match-string 1)) + (mid-pattern (regexp-quote (match-string 2))) + (post-pattern (match-string 3))) + (setq pre-pattern + (if (and pre-pattern + (string-match "[ \t]" pre-pattern)) + "\\([ \t]*" + "\\(")) + (setq post-pattern + (if (and post-pattern + (string-match "[ \t]" post-pattern)) + "[ \t]?\\)" + (format "\\)\\([^%c]\\|$\\)" gas-comment-char))) + (setq comment-pattern + (concat pre-pattern mid-pattern post-pattern)))) + (catch 'fini + (while t + (cond ((gas-C-comment-p) nil) + ((looking-at "[ \t]/[*]") nil) + ((not de-comment) (insert triple-comment)) + (t (when (looking-at comment-pattern) + (replace-match "" nil t nil 1)))) + ;; forward-line returns t even after it just + ;; moved to eol (end of narrowed region): + (unless (and (= 0 (forward-line)) (bolp)) + (throw 'fini t))))))) + (setq mmax nil) + (setq mmin nil)))) + +(defun gas-backward-indent () + "Skip to previous asm field. Within C style comments, decrease indentation." + (interactive) + (gas-indent 'backward 'always)) + +(defun gas-comment () + "Start/expand a comment. +Suggested usage: while writing your code, trigger `gas-comment' +repeatedly until you are satisfied with the kind of comment." + (interactive) + (setq gas-doing-comment t) + (if mark-active + (gas-comment-region-dwim) + (let* ((fields (save-excursion (gas-parsed))) + (curcol (current-column)) + (pointpos (gas-get-pointpos fields)) + (subtype (gas-nth 'subtype 'asm-comment fields))) + (dmsg 'indent "gas-comment, pointpos: %s, fields. %s" + pointpos fields) + (cond + ((gas-C-passthrough-comment-p) (insert-char gas-comment-char 1)) + ((gas-C-passthrough-code-p) + (when (looking-back "/[*]C[ \t]*") + (insert "\n")) + (if (looking-back "[ \t]") + (insert "/# #/ ") + (insert " /# #/ ")) + (backward-char 5)) + ((gas-C-comment-p) + (if (and gas-use-C-passthrough + (looking-back "\\(/[*] ?\\)[ \t\n]*") ) + (save-excursion (replace-match "/*C" nil nil nil 1)) + (insert-char gas-comment-char 1))) + ((and subtype (>= subtype 3)) + (move-to-column (gas-nth 'text-col 'asm-comment fields)) + (looking-at ";+ ?") + (replace-match "") + (insert "/*") + (backward-char) + (gas-indent 'forward 'always) + (let ((curindent (current-indentation))) + (insert "\n\n") + (indent-to curindent) + (insert "*/") + (forward-line -1) + (indent-to (+ curindent gas-C-indent)))) + ((looking-back "[ \t]*#.*" (line-beginning-position)) + (insert "/* */ ") + (backward-char 5)) + (t + (let ((target-col (gas-nth 'text-col 'asm-comment fields))) + (when target-col + (move-to-column target-col))) + (when (or (not subtype) + (and (<= (current-column) curcol) + (save-excursion + (skip-chars-forward (format "%c \t" gas-comment-char)) + (>= (current-column) curcol)))) + (insert-char gas-comment-char 1) + (setq fields (gas-parsed))) + (gas-rearrange fields 'text-col 'asm-comment) + (gas-put-out fields) + (gas-set-point-to-field 'asm-comment fields)))))) + +(defun gas-fill-paragraph (arg) + "Beautify asm code block. Within comments, fill current paragraph. +Calls `fill-paragraph' if within a C comment with ARG passed +through (which is ignored otherwise)." + (let ((curcol (current-column)) + (fill-paragraph-function nil) + ; non-empty comment: + (asm-comment-re (format "\\([ \t]*\\(%c+\\)\\)[ \t]*[^ \t%c\n]\n?" + gas-comment-char gas-comment-char)) + (empty-line-re "\\([^ \t]+:\\)?[ \t]*$")) + (cond ((gas-C-comment-really-p) + (let* ((beg (save-excursion + (re-search-backward "/#\\|/[*][^C]\\([ \t]*\n\\)?") + (match-end 0))) + (end (save-excursion + (re-search-forward "\\(\n[ \t]*\\)?[*#]/") + (match-beginning 0)))) + (save-restriction + (narrow-to-region beg end) + (fill-paragraph arg)))) + ((gas-C-passthrough-code-p) + (let* ((beg (save-excursion + (re-search-backward "\\(#/\\|/[*]C\\)\\([ \t]*\n\\)?") + (match-end 0))) + (end (save-excursion + (re-search-forward "\\(\n[ \t]*\\)?[*#]/") + (match-beginning 0)))) + (goto-char beg) + (while (< (point) end) + (let ((fields (gas-parsed))) + (gas-rearrange fields 'all) + (gas-put-out fields) + (beginning-of-line 2))))) + ((save-excursion (beginning-of-line) (looking-at asm-comment-re)) + (let* ((fill-prefix (concat (match-string 1) " ")) + (re (format "[^%c\n]*\\%s[ \t]*[^ \t%c\n]\n?" gas-comment-char + (match-string 2) gas-comment-char)) + (beg (save-excursion + (beginning-of-line) + (while (save-excursion + (beginning-of-line) + (looking-at re)) + (end-of-line 0)) + (point))) + (end (save-excursion + (end-of-line) + (while (save-excursion + (beginning-of-line 2) + (looking-at re)) + (end-of-line 2)) + (point)))) + (save-restriction + (narrow-to-region beg end) + (fill-paragraph arg)))) + (t + (let ((beg (save-excursion + (beginning-of-line) + (while (save-excursion + (beginning-of-line 0) + (not (or (looking-at asm-comment-re) + (looking-at empty-line-re) + (gas-comment-p)))) + (beginning-of-line 0)) + (point))) + (end (save-excursion + (end-of-line) + (while (save-excursion + (beginning-of-line 2) + (not (or (looking-at asm-comment-re) + (looking-at empty-line-re) + (gas-comment-p)))) + (end-of-line 2)) + (point)))) + (gas-indent-region beg end)))) + (move-to-column curcol)) t) + +(defun gas-comment-char () + "Handle comment character. + +If we're in a comment start sequence (either introduced by the +last command being `gas-comment' or by +`gas-comment-char-starts-comment' being customized to a non-nil +value and typing 'gas-comment-char'), increment the level of the +comment just started. + +Else, if `gas-comment-char-starts-comment' is customized to a +non-nil value, start comment. + +Else just insert variable `gas-comment-char'." + (interactive) + (if (and gas-comment-char-starts-comment + (not (gas-C-comment-p))) + (gas-comment) + (if (and gas-doing-comment + (member last-command '(gas-comment-char gas-comment))) + (gas-comment) + (setq gas-doing-comment nil) + (insert-char gas-comment-char 1)))) + +(provide 'gas-mode) + +;;; gas-mode.el ends here