From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tom Tromey Newsgroups: gmane.emacs.devel Subject: Re: Compiling Elisp to a native code with a GCC plugin Date: Tue, 14 Sep 2010 19:38:37 -0600 Message-ID: References: <87bp805ecr.fsf@gmail.com> <874ods5ctf.fsf@gmail.com> <877hio3urh.fsf@gmail.com> <87wrqo2ev4.fsf@gmail.com> <87bp802bpd.fsf@gmail.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1284514737 2465 80.91.229.12 (15 Sep 2010 01:38:57 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 15 Sep 2010 01:38:57 +0000 (UTC) Cc: emacs-devel@gnu.org To: Wojciech Meyer Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Sep 15 03:38:56 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OvgxZ-0006Ik-Ps for ged-emacs-devel@m.gmane.org; Wed, 15 Sep 2010 03:38:56 +0200 Original-Received: from localhost ([127.0.0.1]:53284 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OvgxY-0008Ca-5H for ged-emacs-devel@m.gmane.org; Tue, 14 Sep 2010 21:38:52 -0400 Original-Received: from [140.186.70.92] (port=42670 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OvgxQ-0008An-2s for emacs-devel@gnu.org; Tue, 14 Sep 2010 21:38:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1OvgxN-0004Pq-Sq for emacs-devel@gnu.org; Tue, 14 Sep 2010 21:38:43 -0400 Original-Received: from mx1.redhat.com ([209.132.183.28]:38850) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OvgxN-0004Pe-GJ for emacs-devel@gnu.org; Tue, 14 Sep 2010 21:38:41 -0400 Original-Received: from int-mx03.intmail.prod.int.phx2.redhat.com (int-mx03.intmail.prod.int.phx2.redhat.com [10.5.11.16]) by mx1.redhat.com (8.13.8/8.13.8) with ESMTP id o8F1cd8s002115 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK); Tue, 14 Sep 2010 21:38:40 -0400 Original-Received: from ns3.rdu.redhat.com (ns3.rdu.redhat.com [10.11.255.199]) by int-mx03.intmail.prod.int.phx2.redhat.com (8.13.8/8.13.8) with ESMTP id o8F1cdtj010964; Tue, 14 Sep 2010 21:38:39 -0400 Original-Received: from opsy.redhat.com (ovpn01.gateway.prod.ext.phx2.redhat.com [10.5.9.1]) by ns3.rdu.redhat.com (8.13.8/8.13.8) with ESMTP id o8F1ccBF012529; Tue, 14 Sep 2010 21:38:38 -0400 Original-Received: by opsy.redhat.com (Postfix, from userid 500) id 161203784BE; Tue, 14 Sep 2010 19:38:38 -0600 (MDT) X-Attribution: Tom In-Reply-To: (Wojciech Meyer's message of "Wed, 15 Sep 2010 00:33:09 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) X-Scanned-By: MIMEDefang 2.67 on 10.5.11.16 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:130166 Archived-At: --=-=-= Wojciech> Yes please, I would like to take a look, thanks. I attached the scripts. They have a few comments, but probably not enough, given that they are pretty much one-off hacks. (Though, funnily, today I'm going to repurpose one to rewrite gdb...) The appended patch is needed to get GCC to emit error locations on the `->' token when the token appears in the arguments to a macro. Wojciech> I am just not sure how efficiently and reliably branches work Wojciech> in bzr (I've managed to screw up some of my work once with Wojciech> bzr), and I am not sure how reliable are git mirrors. I quite Wojciech> like git, however there is a cost of troubles with integration Wojciech> with bzr. On other hand I find forking <-> merging Wojciech> unacceptable. I will try to mock something up, in the Wojciech> meantime. Yeah, bzr is a pain compared to git. But, we're stuck with it. Wojciech> BTW: If somebody would like to enlighten me on how reliably Wojciech> mirrored git works with the Emacs source tree, I would be Wojciech> grateful. Thanks. I think the mirror is updated regularly. I'm not using it myself, but I gather it works ok. Tom Index: macro.c =================================================================== --- macro.c (revision 164202) +++ macro.c (working copy) @@ -1350,7 +1350,7 @@ pfile->set_invocation_location = true; result = cpp_get_token (pfile); - if (pfile->context->macro) + if (pfile->context->macro && pfile->invocation_location > result->src_loc) *loc = pfile->invocation_location; else *loc = result->src_loc; --=-=-= Content-Disposition: inline; filename=hack-buffer-objfwd.el Content-Description: hack-buffer-objfwd.el ;; 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. (This is a one-liner in libcpp.) ;; 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. (defvar gcc-prefix "/home/tromey/gnu/Trunk/install/") (defvar emacs-src "/home/tromey/gnu/Emacs/Gitorious/emacs-mt/src/") (defvar emacs-build "/home/tromey/gnu/Emacs/Gitorious/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 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)) (re-search-forward "^struct buffer$") (forward-line) (assert-looking-at "^{") (let ((starting-point (point)) (closing-brace (save-excursion (forward-sexp) (point)))) ;; 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 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) (insert "#define BUF_" (upcase name) "(BUF) " "*find_variable_location (&((BUF)->" name "_))\n")) (insert "\n")) (setq field-regexp (concat "\\(->\\|\\.\\)" (regexp-opt field-names t) "\\_>")) (save-buffer)) (defun get-field-name () (save-excursion (assert-looking-at "\\(\\.\\|->\\)\\([A-Za-z0-9_]+\\)\\_>") (prog1 (match-string 2) (delete-region (match-beginning 0) (match-end 0))))) (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") (if (save-excursion (backward-char) (looking-at "[A-Za-z0-9_]")) (backward-sexp))) ((save-excursion (backward-char) (looking-at "[A-Za-z0-9_]")) (backward-sexp)) (t (file-error "unhandled case!")))) (defun do-fix-instance () (cond ((looking-at "->") (let ((field-name (get-field-name))) (insert ")") (backward-char) (skip-backward-lhs) (insert "BUF_" (upcase field-name) " ("))) ((eq (char-after) ?.) (let ((field-name (get-field-name))) (insert ")") (backward-char) (backward-sexp) (assert-looking-at "\\(buffer_defaults\\|buffer_local_flags\\)") (insert "BUF_" (upcase field-name) " (&"))) (t (message "%s:%d:%d: warning: did not see -> or ., probably macro" buffer-file-name (line-number-at-pos (point)) (current-column))))) (defun update-header-files () (dolist (file (directory-files emacs-src t "h$")) (message "Applying header changes to %s" file) (find-file file) (while (re-search-forward "\\(current_buffer->\\|buffer_defaults\\.\\)" nil 'move) (goto-char (match-end 0)) (skip-chars-backward "->.") (when (looking-at field-regexp) (do-fix-instance))) (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) (do-fix-instance))) (save-buffer))) (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)) (do-fix-instance)) (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) (dolist (one-item error-list) (apply #'fix-one-instance one-item)) (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*")) (make (start-process "make" output-buffer "make" "-k"))) (set-process-filter make #'make-filter) (set-process-sentinel make #'make-sentinel) (while (not make-done) (accept-process-output)))) (modify-buffer.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)))) --=-=-= Content-Disposition: inline; filename=rewrite-globals.el Content-Description: rewrite-globals.el ;; Rewrite DEFVAR_LISP variables. ;; Each variable is renamed to start with impl_. ;; Compatibility defines are added to globals.h. ;; Invoke as: emacs --script rewrite-globals.el (defvar defvar-list '()) (defun extract-defvars () (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&") (if (looking-at "\\_<\\(\\sw\\|\\s_\\)+\\_>") (let ((var-name (match-string 0))) (if (equal kind "DEFVAR_LISP") (push var-name defvar-list))))))))) (defun munge-V () (interactive) (while (re-search-forward "^\\(extern \\|static \\)?Lisp_Object " nil 'move) ;; skip function decls. (if (not (looking-at ".*(")) (while (looking-at "[a-z0-9A-Z_]+") (if (member (match-string 0) defvar-list) (progn ;; Rename them all to impl_ (goto-char (match-beginning 0)) (insert "impl_"))) (forward-sexp) (skip-chars-forward ", \t\n"))))) (defconst V-dir ".") (defun munge-V-directory () ;; First extract all defvars. (dolist (file (directory-files V-dir t "[ch]$")) (save-excursion (message "Scanning %s" file) (find-file file) (extract-defvars))) (setq defvar-list (delete-dups (sort defvar-list #'string<))) (dolist (file (directory-files V-dir t "[ch]$")) (save-excursion (message "Processing %s" file) (find-file file) (goto-char (point-min)) (munge-V) (save-buffer))) (find-file "globals.h") (erase-buffer) (dolist (v defvar-list) (insert "#define " v " *find_variable_location (&impl_" v ")\n")) ;; A few special cases for globals.h. (insert "\n") (dolist (v '("do_mouse_tracking" "Vmark_even_if_inactive" "Vprint_level")) (insert "extern Lisp_Object impl_" v ";\n")) (save-buffer)) (munge-V-directory) --=-=-=--