unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* baby step toward thread patch
@ 2011-01-05 14:40 Tom Tromey
  2011-01-18 20:42 ` Tom Tromey
  0 siblings, 1 reply; 6+ messages in thread
From: Tom Tromey @ 2011-01-05 14:40 UTC (permalink / raw)
  To: Emacs discussions

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

The concurrency branch hasn't been getting much action lately, largely
because of a combination of lack of time and the difficulty of keeping
it up-to-date with trunk.  I'd like to solve the latter problem by
putting some needed infrastructure directly on trunk.  Once all the
infrastructure bits are merged, development can focus on just the
threading bits.

In general these infrastructure changes don't involve any runtime cost.
However, they may make the code uglier.

I'm posting this to get an ok on this change before checking it in.  In
the absence of comments (after a decent interval) I will just go ahead
with it.

In elisp, a let binding will always be thread-local.  For this to work
properly, variables defined in C must be thread-aware somehow.  This
patch is a step toward one implementation of that.  In particular, it
moves most such globals into a structure and redefines the "plain" name
of the variable as a macro that references this structure.  Then on the
concurrency branch, we'll change the definitions of these macros to
introduce thread locality.

E.g., consider 'Vgc_cons_percentage'.  Right now it is defined in
alloc.c:

    static Lisp_Object Vgc_cons_percentage;

After this patch it will appear in a structure in globals.h:

    struct emacs_globals
    {
    [...]
      Lisp_Object Vgc_cons_percentage;
    [...]
    };

    extern struct emacs_globals globals;

    #define Vgc_cons_percentage \
        globals.Vgc_cons_percentage


In case you're curious, for threading we'll introduce an indirection:
each thread will have its own copy of this structure, and one pointer
per field.  The pointers will be redirected to either the global or
thread-local copy of the object depending on whether it is let-bound.
Then the macros will just dereference these pointers.

If you read the concurrency branch, you'll see that this approach is
different from what is implemented there.  The concurrency branch does
not work for the DEFVAR_INT and DEFVAR_BOOL cases, but this approach
will.


This patch has a couple of other minor tweaks in it: I had to rename a
few local variables that had the same name as one of the new macros, I
had to remove some (redundant) extern declarations, and in one case
("scroll_step") I had to rename a global to avoid a clash with a Gtk
header file.

These little changes I did by hand.  The major part of the patch was
written by a script, which I'm attaching.

I can commit the lesser changes separately, if anybody cares.


One last thing is that this patch doesn't handle buffer_defaults
properly yet.  That is not hard; I just think it should be an
independent change.


I did not write a ChangeLog entry for this yet.  I will update the .el
script to do this.

Tom


[-- Attachment #2: rewrite-globals.el --]
[-- Type: text/plain, Size: 5762 bytes --]

;; Rewrite DEFVAR_LISP variables.
;; Compatibility defines are added to globals.h.
;; Invoke as:  emacs --script rewrite-globals.el

(defvar defvar-list '())

(defvar global-text-list '())

(defvar variables-written '())

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

(defun message-at (text)
  (save-buffer)
  (message "%s:%d: %s"
	   (buffer-file-name)
	   (line-number-at-pos (point))
	   text))

(defun extract-defvars ()
  "Extract DEFVAR_{LISP,INT,BOOL} variable names for later processing.
Also, rewrite DEFVAR invocations to remove the `&' from the 2nd arg."
  (let ((case-fold-search nil))
    (while (re-search-forward "^[^#*]*\\(DEFVAR_[A-Z_]*\\)" nil 'move)
      (let ((kind (match-string 1)))
	(unless (member kind '("DEFVAR_KBOARD" "DEFVAR_PER_BUFFER"))
	  ;; Skip the paren and the first argument.
	  (skip-chars-forward " (")
	  (forward-sexp)
	  (skip-chars-forward ", \t\n")
	  ;; `...' and `no_cell' are special -- they mean that
	  ;; this is a phony DEFVAR.
	  ;; buffer_defaults will have to be handled separately.
	  (unless (looking-at "\\(no_cell\\|\\.\\.\\.\\|&buffer_defaults[^,]*\\),")
	    (if (looking-at "&\\(\\_<\\(\\sw\\|\\s_\\)+\\_>\\)")
		(let ((var-name (match-string 1)))
		  ;; This would improve safety but it interferes with
		  ;; buffer_defaults.
		  ;; (delete-char 1)
		  ;; (insert "f_")
		  (push var-name defvar-list)))))))))

(defun maybe-extract-comment ()
  (let ((here (point)))
    (skip-chars-backward " \t\n")
    (backward-char 2)
    (if (looking-at "[*]/")
	(progn
	 (search-backward "/*" nil 'move)
	 (if (bobp)
	     ""
	   (let ((result (buffer-substring (point) here)))
	     (delete-region (point) here)
	     result)))
      (goto-char here)
      "")))

(defun munge-V ()
  (interactive)
  (while (re-search-forward "^\\(extern \\|static \\)?\\(Lisp_Object\\|int\\|EMACS_INT\\) \\([^(;]\\|\n\\)+;" nil 'move)
    (goto-char (match-end 2))
    (forward-char)
    (let ((is-extern (equal (match-string 1) "extern "))
	  (type (match-string 2))
	  (start (match-beginning 0))
	  (this-text "")
	  (this-comment "")
	  (skipped-one nil)
	  (last-start (point))
	  (deleted-last nil))
      (while (not (looking-at ";"))
	(if (and (looking-at "[a-z0-9A-Z_]+")
		 (member (match-string 0) defvar-list))
	    (let ((var-name (match-string 0))
		  (var-start (match-beginning 0))
		  (var-end (match-end 0)))
	      ;; Output to globals.h.
	      (unless is-extern
		(cond
		 ((member var-name variables-written)
		  (message-at "Duplicate seen"))
		 ((string-match "buffer_defaults_" var-name)
		  ;; Ignore.
		  )
		 (t
		  (setq this-text (concat this-text
					  type " " ;; "f_"
					  var-name ";\n"))
		  (push var-name variables-written))))
	      ;; FIXME: must handle comment stuff here too.
	      ;; Remove it and trailing ",".
	      (goto-char var-end)
	      (skip-chars-forward " \t\n,")
	      (delete-region var-start (point))
	      (setq deleted-last t)
	      ;; Leave LAST-START pointing to the same spot.
	      )
	  ;; If the last was a delete, delete the "," before this
	  ;; one.
	  (if deleted-last
	      (delete-region last-start (point)))
	  (setq deleted-last nil)
	  ;; Skip sexps until we hit the next declaration.
	  (while (not (looking-at "[;,]"))
	    (forward-sexp)
	    (skip-chars-forward " \t\n"))
	  (setq skipped-one t)
	  (setq last-start (point)))
	;; Move to the start of the next declaration.
	(skip-chars-forward ", \t\n"))
      (cond
       ((not skipped-one)
	;; If we removed all the individual declarations, then remove
	;; the whole thing.
	(end-of-line)
	(forward-char)
	(delete-region start (point))
	(setq this-comment (maybe-extract-comment)))
       (deleted-last
	;; If the last was a delete, delete the "," now.
	(delete-region last-start (point))))
      ;; Only update the globals when we see the variable's
      ;; definition.
      (if is-extern
	  (if (not (equal this-comment ""))
	      (message "declaration has comment: %s" this-text))
	(push (cons this-comment this-text) global-text-list)))))

(defconst V-dir ".")

(defun no-newlines ()
  (let ((here (point)))
    (skip-chars-backward " \t\n")
    (delete-region (point) here)))

(defun just-one-newline ()
  (no-newlines)
  (insert "\n"))

(defun munge-V-directory ()
  ;; Compute files early to avoid problems with .# files.
  (let ((files (directory-files V-dir t "[ch]$")))

    ;; First extract all defvars.
    (dolist (file files)
      (save-excursion
	(message "Scanning %s" file)
	(find-file file)
	(extract-defvars)
	(save-buffer)))

    (setq defvar-list (delete-dups (sort defvar-list #'string<)))

    (dolist (file files)
      (save-excursion
	(message "Processing %s" file)
	(find-file file)
	(goto-char (point-min))
	(munge-V)
	(save-buffer)))

    (message "Creating globals.h")
    (find-file "globals.h")
    (erase-buffer)
    (insert "struct emacs_globals\n{")
    (dolist (item (nreverse global-text-list))
      (insert "\n")
      (unless (string= (car item) "")
	(insert (car item))
	(just-one-newline))
      (insert (cdr item))
      (just-one-newline))
    (insert "};\n\n")
    (insert "extern struct emacs_globals globals;\n\n")
    (indent-region (point-min) (point-max))
    (goto-char (point-max))
    (dolist (v defvar-list)
      (insert "#define " v " \\\n    "
	      (if (string-match "buffer_defaults_" v)
		  (concat "buffer_defaults." (substring v 16))
		(concat "globals." ;; "f_"
			v))
	      "\n"))
    (let ((version-control 'never))
      (save-buffer))

    (message "Updating lisp.h")
    (find-file "lisp.h")
    (goto-char (point-max))
    (search-backward "#endif")
    (insert "#include \"globals.h\"\n\n")
    (save-buffer)))

(munge-V-directory)

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

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

end of thread, other threads:[~2011-01-20 15:41 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-01-05 14:40 baby step toward thread patch Tom Tromey
2011-01-18 20:42 ` Tom Tromey
2011-01-19  8:27   ` Thien-Thi Nguyen
2011-01-19  8:54   ` Glenn Morris
2011-01-19 15:00     ` Tom Tromey
2011-01-20 15:41   ` Tom Tromey

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).