unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Patch for fields of `struct buffer'
@ 2011-01-27 20:18 Tom Tromey
  2011-01-28  7:37 ` Eli Zaretskii
                   ` (3 more replies)
  0 siblings, 4 replies; 123+ messages in thread
From: Tom Tromey @ 2011-01-27 20:18 UTC (permalink / raw)
  To: Emacs discussions

[-- Attachment #1: Type: text/plain, Size: 2039 bytes --]

Here is the promised change to buffer fields.

I need volunteers to complete this patch; or at least the ok on
proceeding to temporarily break the build.  See below for details.


In order to implement thread-specific let-binding of buffer-local
variables, we must introduce an indirection into the C code, so that
lookups of these variables see the thread-specific value, if any.

This patch enables this by adding an accessor macro for each field of
struct buffer.  For a field named `name', the corresponding accessor
is `BUF_NAME'.  All code outside of the GC must then use these
accessor macros.

On the trunk this results in the same code.  On the concurrency
branch, we will redefine these macros to do the needed thread
indirection.


This patch was automatically generated using the attached script.  The
basic idea is simple: rename all the fields in struct buffer, run
`make', and then use the locations in the error messages to decide
where to rewrite.  If you want to reproduce this, you will need a
modified GCC; I can tell you how to get the patches if you want.

Because this script runs the compiler, it only edits locations which
were included in my build.  So, it is probable that some needed
changes were not done.  Fixing any given build failure is simple, but
requires someone to actually see it.

This is where volunteers come in.  We could either proceed by
committing the patch and fixing the problems piecemeal, or by having a
couple people with other systems apply the patch, do a build, and send
me the logs (or patches relative to mine), then repeat.  You would not
need a modified GCC to do this step; I don't expect enough problems to
warrant more automation.


This same technique could be used to extend HIDE_LISP_IMPLEMENTATION
to all lisp types.  Is that worth doing?


The next patch will be applying the same treatment to struct kboard.
Again, it may be a while before I can get to that.


Let me know what you think.  I am not sure what I will do in the absence
of comments.  Maybe check it in!

Tom


[-- Attachment #2: hack buffer locals --]
[-- Type: text/plain, Size: 10721 bytes --]

;; Rewrite all references to buffer-objfwd fields in struct buffer
;; to use accessor macros.
;; This works in a tricky way: it renames all such fields, then
;; recompiles Emacs.  Then it visits each error location and
;; rewrites the expressions.
;; This has a few requirements in order to work.
;; First, Emacs must compile before the script is run.
;; It does not handle errors arising for other reasons.
;; Second, you need a GCC which has been hacked to emit proper
;; column location even when the -> expression in question has
;; been wrapped in a macro call.  I am using Dodji Seketeli's
;; patch series that adds location tracking through macros;
;; it has been submitted to gcc-patches but not yet applied.
;; After running this script, a few changes need to be made by hand.
;; These occur mostly in macros in headers, but also in
;; reset_buffer and reset_buffer_local_variables.  Finally,
;; DEFVAR_PER_BUFFER and the GC should not use these accessors.

(setq add-log-keep-changes-together t)

(defvar gcc-prefix "/home/tromey/gcc/install/")
(defvar gcc-bin-dir (concat gcc-prefix "bin/"))

(defvar emacs-base "/home/tromey/Emacs/emacs-mt/")
(defvar emacs-src (concat emacs-base "trunk/src/"))
(defvar emacs-build (concat emacs-base "build/src/"))

(defun file-error (text)
  (error "%s:%d:%d: error: expected %s"
	 buffer-file-name (line-number-at-pos (point))
	 (current-column)
	 text))

(defun assert-looking-at (exp)
  (unless (looking-at exp)
    (file-error exp)))

(defvar last-file-name nil)
(defvar last-function-name nil)

(defun edit-add-cl-entry ()
  (unless (equal buffer-file-name last-file-name)
    (setq last-file-name buffer-file-name)
    (setq last-function-name nil))

  (let ((function (add-log-current-defun)))
    (unless (equal function last-function-name)
      (setq last-function-name function)
      (save-current-buffer
	(add-change-log-entry))
      t)))

(defun insert-cl-entry (text)
  (save-current-buffer
    (find-file "ChangeLog")
    (insert text)
    (fill-paragraph)))

(defvar field-names nil)

(defvar field-regexp nil)

(defun modify-buffer.h ()
  (message "Modifying fields in struct buffer")
  (find-file (expand-file-name "buffer.h" emacs-src))
  (goto-char (point-min))

  (let ((add-log-current-defun-function
	 #'(lambda () "struct buffer")))
    (edit-add-cl-entry)
    (insert-cl-entry "Rename all Lisp_Object fields."))

  (re-search-forward "^struct buffer$")
  (forward-line)
  (assert-looking-at "^{")
  (let ((starting-point (point))
	(closing-brace (save-excursion
			 (forward-sexp)
			 (point-marker))))
    ;; Find each field.
    (while (re-search-forward "^\\s *Lisp_Object\\s +"
			      closing-brace 'move)
      (goto-char (match-end 0))
      (while (not (looking-at ";"))
	(assert-looking-at "\\([A-Za-z0-9_]+\\)\\(;\\|,\\s *\\)")
	;; Remember the name so we can generate accessors.
	(push (match-string-no-properties 1) field-names)
	;; Rename it.
	(goto-char (match-beginning 2))
	(insert "_")
	;; On to the next one, if any.
	(if (looking-at ",\\s *")
	    (goto-char (match-end 0)))))
    ;; Generate accessors.
    (goto-char starting-point)
    (forward-sexp)
    (forward-line)
    (insert "\n")
    (dolist (name field-names)
      (let* ((m-name (concat "BUF_" (upcase name)))
	     (add-log-current-defun-function
	      #'(lambda () m-name)))
	(insert "#define " m-name "(BUF) \\\n    ((BUF)->"
		;; "*find_variable_location (&((BUF)->"
		name ;;"_))\n"
		"_)\n")
	(edit-add-cl-entry)))
    (insert "\n")
    (insert-cl-entry "New macro."))
  (setq field-regexp (concat "\\(->\\|\\.\\)"
			     (regexp-opt field-names t)
			     "\\_>"))

  (goto-char (point-min))
  (search-forward "#define PER_BUFFER_VAR_OFFSET")
  (forward-line)
  (search-forward "VAR")
  (assert-looking-at ")")
  (insert " ## _")

  (save-buffer))

(defun modify-buffer.c ()
  (message "Updating swapfield in buffer.c")
  (find-file (expand-file-name "buffer.c" emacs-src))
  (goto-char (point-min))
  (search-forward "#define swapfield")
  (forward-paragraph)

  (let ((add-log-current-defun-function #'(lambda () "swapfield_")))
    (save-current-buffer
      (edit-add-cl-entry)
      (insert-cl-entry "New macro.")
      (fill-paragraph)))

  (insert "#define swapfield_(field, type) \\
  do {							\\
    type tmp##field = other_buffer->field ## _;		\\
    other_buffer->field ## _ = current_buffer->field ## _;	\\
    current_buffer->field ## _ = tmp##field;			\\
  } while (0)\n")
  (while (search-forward "swapfield" nil 'move)
    (if
	(save-excursion
	  (assert-looking-at " (\\([a-z_]+\\),")
	  (member (match-string-no-properties 1) field-names))
	(insert "_")
      (edit-add-cl-entry)))

  (insert-cl-entry "Use swapfield_ where appropriate.")

  (save-buffer))

(defun modify-lisp.h ()
  (message "Updating lisp.h")
  (find-file (expand-file-name "lisp.h" emacs-src))
  (goto-char (point-min))
  (search-forward "#define DEFVAR_BUFFER_DEFAULTS")
  (search-forward "buffer_defaults.vname")
  (assert-looking-at ");")
  (insert " ## _")

  (let ((add-log-current-defun-function
	 #'(lambda () "DEFVAR_BUFFER_DEFAULTS")))
    (edit-add-cl-entry)
    (insert-cl-entry "Update for change to field names."))

  (save-buffer))

(defun get-field-name ()
  (save-excursion
    (assert-looking-at "\\(\\.\\|->\\)\\([A-Za-z0-9_]+\\)\\_>")
    (prog1
	(match-string-no-properties 2)
      (delete-region (match-beginning 0) (match-end 0)))))

(defun maybe-skip-backward-lhs-again ()
  (let (st-point)
    (when
	(save-excursion
	  (skip-chars-backward " \t\n")
	  (prog1
	      (or (progn
		    (backward-char)
		    (equal (char-after) ?.))
		  (progn
		    (backward-char 1)
		    (looking-at "->")))
	    (setq st-point (point))))
      (goto-char st-point)
      (skip-backward-lhs))))

(defun skip-backward-lhs ()
  (skip-chars-backward " \t\n")
  (cond
   ((eq (char-before) ?\])
    (file-error "array ref!")
    ;; fixme
    )
   ((eq (char-before) ?\))
    ;; A paren expression is preceding.
    ;; See if this is just a paren expression or whether it is a
    ;; function call.
    ;; For now assume that there are no function-calls-via-expr.
    (backward-sexp)
    (skip-chars-backward " \t\n")
    (when (save-excursion
	    (backward-char)
	    (looking-at "[A-Za-z0-9_]"))
      (backward-sexp)
      (maybe-skip-backward-lhs-again)))
   ((save-excursion
      (backward-char)
      (looking-at "[A-Za-z0-9_]"))
    ;; An identifier.
    (backward-sexp)
    (maybe-skip-backward-lhs-again))
   (t
    (file-error "unhandled case!"))))

(defun do-fix-instance ()
  (cond
   ((looking-at "->")
    ;; The GC should not use the accessors.
    (if (string-match "/alloc[.]c$" buffer-file-name)
	(progn
	  (forward-sexp)
	  (insert "_"))
      (let ((field-name (get-field-name)))
	(insert ")")
	(backward-char)
	(skip-backward-lhs)
	(insert "BUF_" (upcase field-name) " ("))
      t))
   ((eq (char-after) ?.)
    (let ((field-name (get-field-name)))
      (insert ")")
      (backward-char)
      (backward-sexp)
      (assert-looking-at "\\(buffer_defaults\\|buffer_local_flags\\|buffer_local_symbols\\)")
      (if (equal field-name "vname")
	  ;; Undo our changes, this use is in DEFVAR_PER_BUFFER.
	  (progn
	    (forward-sexp)
	    (delete-char 1)		; the ")" we inserted.
	    (insert ".vname")
	    nil)
	(insert "BUF_" (upcase field-name) " (&")
	t)))
   (t
    (message "%s:%d:%d: warning: did not see -> or ., probably macro"
	     buffer-file-name (line-number-at-pos (point))
	     (current-column))
    nil)))

(defun update-header-files ()
  (dolist (file (directory-files emacs-src t "h$"))
    (let (any-changed)
      (message "Applying header changes to %s" file)
      (find-file file)
      (goto-char (point-min))
      (while (re-search-forward
	      "\\(current_buffer->\\|buffer_defaults\\.\\)"
	      nil 'move)
	(goto-char (match-end 0))
	(skip-chars-backward "->.")
	(when (looking-at field-regexp)
	  (when (do-fix-instance)
	    (edit-add-cl-entry)
	    (setq any-changed t)))
      (goto-char (point-min))
      (while (search-forward "XBUFFER (" nil 'move)
	(goto-char (- (match-end 0) 1))
	(forward-sexp)
	;; This works even for the new #define BUF_ macros
	;; because the field-regexp ends with \_>.
	(when (looking-at field-regexp)
	  (when (do-fix-instance)
	    (edit-add-cl-entry)
	    (setq any-changed t))))
      (save-buffer)
      (if any-changed
	  (insert-cl-entry "Update."))))))

(defun fix-one-instance (filename line column)
  (message "%s:%d:%d: info: fixing instance" filename line column)
  (find-file filename)
  (goto-char (point-min))
  (forward-line (- line 1))
  ;; (move-to-column (- column 1))
  (forward-char (- column 1))
  (when (do-fix-instance)
    (edit-add-cl-entry)
    t))

(defvar make-accumulation "")

(defvar last-error-line nil)
(defvar error-list nil)

(defun make-filter (process string)
  (setq make-accumulation (concat make-accumulation string))
  (while (string-match "^[^\n]*\n" make-accumulation)
    (let ((line (substring (match-string 0 make-accumulation) 0 -1)))
      (setq make-accumulation (substring make-accumulation
					 (match-end 0)))
      (message "%s" line)
      (if (string-match "^\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)+: error:"
			line)
	  (save-excursion
	    (let ((file-name (match-string 1 line))
		  (line-no (string-to-number (match-string 2 line)))
		  (col-no (string-to-number (match-string 3 line))))
	      ;; Process all errors on a given line in reverse order.
	      (unless (eq line-no last-error-line)
		(let (any-edited)
		  (dolist (one-item error-list)
		    (if (apply #'fix-one-instance one-item)
			(setq any-edited t)))
		  ;; Just edit ChangeLog by hand, it is simpler.
		  ;; (if any-edited
		  ;;     (insert-cl-entry "Update."))
		  )
		(setq error-list nil)
		(setq last-error-line line-no))
	      (push (list file-name line-no col-no) error-list)))))))

(defvar make-done nil)

(defun make-sentinel (process string)
  (dolist (one-item error-list)
    (apply #'fix-one-instance one-item))
  (setq make-done t))

(defun recompile-emacs ()
  (let* ((default-directory emacs-build)
	 (output-buffer (get-buffer-create "*recompile*"))
	 (exec-path (cons gcc-bin-dir exec-path))
	 (make (start-process "make" output-buffer "make" "-k"
			      (concat "CC=" gcc-bin-dir 
				      "gcc -ftrack-macro-expansion=2"))))
    (set-process-filter make #'make-filter)
    (set-process-sentinel make #'make-sentinel)
    (while (not make-done)
      (accept-process-output))))

(modify-buffer.h)
(modify-buffer.c)
(modify-lisp.h)
(update-header-files)
(recompile-emacs)
(dolist (buf (buffer-list))
  (with-current-buffer buf
    (when buffer-file-name
      (message "Saving %s" buffer-file-name)
      (save-buffer))))

[-- Attachment #3: the patch --]
[-- Type: application/x-gzip, Size: 56413 bytes --]

^ permalink raw reply	[flat|nested] 123+ messages in thread

end of thread, other threads:[~2011-02-16 14:55 UTC | newest]

Thread overview: 123+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-01-27 20:18 Patch for fields of `struct buffer' Tom Tromey
2011-01-28  7:37 ` Eli Zaretskii
2011-01-28  8:58   ` Tom Tromey
2011-01-28  9:29     ` Eli Zaretskii
2011-01-29 12:50       ` Eli Zaretskii
2011-01-29 13:33         ` Juanma Barranquero
2011-01-29 13:42           ` Eli Zaretskii
2011-02-02 18:17             ` Juanma Barranquero
2011-02-02 19:51               ` Eli Zaretskii
2011-01-28 14:55 ` Stefan Monnier
2011-01-28 17:38   ` Tom Tromey
2011-01-28 18:27     ` Stefan Monnier
2011-01-28 18:42       ` Tom Tromey
2011-01-28 20:04         ` Stefan Monnier
2011-01-28 17:23 ` Kim F. Storm
2011-01-28 17:36   ` Tom Tromey
2011-01-28 18:29   ` Stefan Monnier
2011-01-29  2:34     ` Miles Bader
2011-01-29  3:58       ` Stefan Monnier
2011-01-29 16:18 ` Richard Stallman
2011-01-30 20:23   ` Tom Tromey
2011-01-31  4:04     ` Stefan Monnier
2011-01-31 14:29       ` Tom Tromey
2011-01-31 15:22         ` Stefan Monnier
2011-01-31 15:30           ` Tom Tromey
2011-01-31 17:02             ` Stefan Monnier
2011-01-31 18:38               ` Tom Tromey
2011-01-31 20:03                 ` Stefan Monnier
2011-01-31 20:00             ` Stefan Monnier
2011-01-31 20:05               ` Tom Tromey
2011-01-31 20:40                 ` Stefan Monnier
2011-01-31 16:46         ` David De La Harpe Golden
2011-01-31 19:04           ` Tom Tromey
2011-01-31 22:08             ` David De La Harpe Golden
2011-02-01 10:54             ` Daniel Colascione
2011-02-07  2:34               ` Tom Tromey
2011-02-07 19:48                 ` concurrency suggestions for Gnus (was: Patch for fields of `struct buffer') Ted Zlatanov
2011-02-08  4:31                   ` concurrency suggestions for Gnus Miles Bader
2011-02-08 12:55                     ` Andy Moreton
2011-02-08 12:55                     ` Justin Lilly
2011-02-08 14:41                     ` bloom filters (was: concurrency suggestions for Gnus) Ted Zlatanov
2011-02-08 15:15                       ` Stephen J. Turnbull
2011-02-10  8:17                   ` concurrency suggestions for Gnus Lars Ingebrigtsen
2011-02-01 15:43             ` Patch for fields of `struct buffer' Stefan Monnier
2011-02-01 16:28               ` Helmut Eller
2011-02-07  2:47                 ` Tom Tromey
2011-02-07  2:44               ` Tom Tromey
2011-02-07  8:05                 ` Helmut Eller
2011-02-07 19:23                   ` Richard Stallman
2011-02-08 16:30                     ` Tom Tromey
2011-02-08 16:26                   ` Tom Tromey
2011-02-08 17:57                     ` Helmut Eller
2011-02-11 21:59                       ` Tom Tromey
2011-02-12  9:16                         ` Helmut Eller
2011-02-08 21:10                     ` Stefan Monnier
2011-01-31 19:38         ` Richard Stallman
2011-02-01 18:26         ` Tom Tromey
2011-02-01 19:28           ` Paul Eggert
2011-02-01 19:42             ` Tom Tromey
2011-02-09 10:16               ` Jim Meyering
2011-02-10  4:42                 ` Miles Bader
2011-02-01 20:34           ` Andreas Schwab
2011-02-01 21:56             ` Tom Tromey
2011-02-01 21:59           ` Tom Tromey
2011-02-02  0:44             ` Paul Eggert
2011-02-02  3:49             ` Stefan Monnier
2011-02-02 16:26               ` Tom Tromey
2011-02-02 16:37                 ` Stefan Monnier
2011-02-08 15:07               ` Tom Tromey
2011-02-08 21:02                 ` Stefan Monnier
2011-02-08 21:08                   ` Tom Tromey
2011-02-08 21:21                   ` Tom Tromey
2011-02-09 21:32                     ` Stefan Monnier
2011-02-08 21:58                 ` Andreas Schwab
2011-02-01 22:21           ` Stefan Monnier
2011-02-08 16:38             ` Tom Tromey
2011-02-11 21:48             ` Tom Tromey
2011-02-12  2:25               ` Stefan Monnier
2011-01-31 19:37     ` Richard Stallman
2011-01-31 19:57       ` Tom Tromey
2011-02-01  2:42         ` Tom Tromey
2011-02-01  4:09           ` Eli Zaretskii
2011-02-01 16:40         ` Richard Stallman
2011-02-01 16:44           ` Tom Tromey
2011-02-02  2:42             ` Richard Stallman
2011-01-31 20:30       ` Stefan Monnier
2011-01-31 20:49         ` Tom Tromey
2011-01-31 21:54           ` Stefan Monnier
2011-02-13 19:01             ` Richard Stallman
2011-02-14 17:47               ` Stefan Monnier
2011-02-14 19:34                 ` Lennart Borgman
2011-02-15 15:58                 ` Richard Stallman
2011-02-15 20:41                   ` Stefan Monnier
2011-02-01 16:39           ` Richard Stallman
2011-02-01 12:09         ` Stephen J. Turnbull
2011-02-02  2:41           ` Richard Stallman
2011-02-01 10:26       ` Daniel Colascione
2011-02-01 12:10         ` Stephen J. Turnbull
2011-02-01 14:23           ` Lennart Borgman
2011-02-01 16:19             ` Stephen J. Turnbull
2011-02-01 17:08               ` Lennart Borgman
2011-02-01 19:57               ` Daniel Colascione
2011-02-01 20:06                 ` Daniel Colascione
2011-02-01 16:41         ` Richard Stallman
2011-02-01 16:51           ` Tom Tromey
2011-02-02  2:42             ` Richard Stallman
2011-02-02  4:16               ` Tom Tromey
2011-02-02  5:04                 ` Stefan Monnier
2011-02-11 21:51               ` Tom Tromey
2011-02-12 23:28                 ` Richard Stallman
2011-02-13 20:26                   ` Installing `struct buffer' patch (Was: Patch for fields of `struct buffer') Tom Tromey
2011-02-14 16:42                     ` Installing `struct buffer' patch Chong Yidong
2011-02-14 16:48                       ` Tom Tromey
2011-02-14 16:52                         ` Chong Yidong
2011-02-14 16:58                           ` Tom Tromey
2011-02-14 17:36                           ` Stefan Monnier
2011-02-15 15:50                             ` Chong Yidong
2011-02-16 14:55                               ` Tom Tromey
2011-02-15 15:57                       ` Richard Stallman
2011-02-15  4:07                     ` Glenn Morris
2011-02-15 14:28                       ` Tom Tromey
2011-02-01 20:04           ` Patch for fields of `struct buffer' Daniel Colascione
2011-02-02  2:43             ` Richard Stallman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).