Re: Skipping unexec via a big .elc file

[Stefan Monnier]

> I switched over to a pair of hash tables and the run time is just under 0.2s
> on my test machine now.  Profiling reports are now topped by read1,
> readchar, and readbyte_from_file (now including the expanded getc_unlocked
> calls), accounting for about 30% of the CPU time between them.  The hash
> functions and substitute_object_recurse are not taking a significant amount
> of time.

BTW, I don't know if you've tried to make that dumped file work
correctly, but in case you haven't here's my latest attempt.

It mostly works, tho there are still issues such as the fact that the
global-font-lock-mode still fails to be properly enabled.


        Stefan


diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 310ca29..9ca53eb 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -439,7 +439,8 @@ macroexp--const-symbol-p
   (or (memq symbol '(nil t))
       (keywordp symbol)
       (if any-value
-         (or (memq symbol byte-compile-const-variables)
+         (or (and (boundp 'byte-compile-const-variables)
+                   (memq symbol byte-compile-const-variables))
              ;; FIXME: We should provide a less intrusive way to find out
              ;; if a variable is "constant".
              (and (boundp symbol)
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 21ab7e1..bb4808b 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -290,7 +290,7 @@ define-charset
                      elt))
                  props))
     (setcdr (assq :plist attrs) props)
-
+    (put name 'internal--charset-args (mapcar #'cdr attrs))
     (apply 'define-charset-internal name (mapcar 'cdr attrs))))
 
 
@@ -911,6 +911,8 @@ define-coding-system
          (cons :name (cons name (cons :docstring (cons (purecopy docstring)
                                                        props)))))
     (setcdr (assq :plist common-attrs) props)
+    (put name 'internal--cs-args
+         (mapcar #'cdr (append common-attrs spec-attrs)))
     (apply 'define-coding-system-internal
           name (mapcar 'cdr (append common-attrs spec-attrs)))))
 
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 21c64a8..5967334 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,4 +1,4 @@
-;;; loadup.el --- load up standardly loaded Lisp files for Emacs
+;;; loadup.el --- load up standardly loaded Lisp files for Emacs  -*- 
lexical-binding:t -*-
 
 ;; Copyright (C) 1985-1986, 1992, 1994, 2001-2016 Free Software
 ;; Foundation, Inc.
@@ -461,6 +461,150 @@
                                                invocation-directory)
                              (expand-file-name name invocation-directory)
                              t)))
+      (message "Dumping into dumped.elc...preparing...")
+
+      ;; Dump the current state into a file so we can reload it!
+      (message "Dumping into dumped.elc...generating...")
+      (let ((faces '())
+            (coding-systems '()) (coding-system-aliases '())
+            (charsets '()) (charset-aliases '())
+            (cmds '()))
+        (setcdr global-buffers-menu-map nil) ;; Get rid of buffer objects!
+        (mapatoms
+         (lambda (s)
+           (when (fboundp s)
+             (if (subrp (symbol-function s))
+                 ;; subr objects aren't readable!
+                 (unless (equal (symbol-name s) (subr-name (symbol-function 
s)))
+                   (push `(fset ',s (symbol-function ',(intern (subr-name 
(symbol-function s))))) cmds))
+               (if (memq s '(rename-buffer))
+                   ;; FIXME: We need these, but they contain
+                   ;; unprintable objects.
+                   nil
+                 (push `(fset ',s ,(macroexp-quote (symbol-function s)))
+                       cmds))))
+           (when (and (boundp s)
+                      (not (macroexp--const-symbol-p s 'any-value))
+                      ;; I think we don't need/want these!
+                      (not (memq s '(terminal-frame obarray
+                                     initial-window-system window-system
+                                     ;; custom-delayed-init-variables
+                                     exec-path
+                                     process-environment
+                                     command-line-args noninteractive))))
+             ;; FIXME: Handle varaliases!
+             (let ((v (symbol-value s)))
+               (push `(set-default
+                       ',s
+                       ,(cond
+                         ;; FIXME: (Correct) hack to avoid
+                         ;; unprintable objects.
+                         ((eq s 'undo-auto--undoably-changed-buffers) nil)
+                         ;; FIXME: Incorrect hack to avoid
+                         ;; unprintable objects.
+                         ((eq s 'advertised-signature-table)
+                          (make-hash-table :test 'eq :weakness 'key))
+                         ((subrp v)
+                          `(symbol-function ',(intern (subr-name v))))
+                         ((and (markerp v) (null (marker-buffer v)))
+                          '(make-marker))
+                         ((and (overlayp v) (null (overlay-buffer v)))
+                          '(let ((ol (make-overlay (point-min) (point-min))))
+                             (delete-overlay ol)
+                             ol))
+                         (v (macroexp-quote v))))
+                     cmds)
+               (push `(defvar ,s) cmds)))
+           (when (symbol-plist s)
+             (push `(setplist ',s ',(symbol-plist s)) cmds))
+           (when (get s 'face-defface-spec)
+             (push s faces))
+           (if (get s 'internal--cs-args)
+               (push s coding-systems))
+           (when (and (coding-system-p s)
+                      (not (eq s (car (coding-system-aliases s)))))
+             (push (cons s (car (coding-system-aliases s)))
+                   coding-system-aliases))
+           (if (get s 'internal--charset-args)
+               (push s charsets)
+             (when (and (charsetp s)
+                        (not (eq s (get-charset-property s :name))))
+               (push (cons s (get-charset-property s :name))
+                     charset-aliases))))
+         obarray)
+        (message "Dumping into dumped.elc...printing...")
+        (with-current-buffer (generate-new-buffer "dumped.elc")
+          (insert ";address@hidden@address@hidden;;; Compiled\n;;; in Emacs 
version "
+                  emacs-version "\n")
+          (let ((print-circle t)
+                (print-gensym t)
+                (print-quoted t)
+                (print-level nil)
+                (print-length nil)
+                (print-escape-newlines t)
+                (standard-output (current-buffer)))
+            (print `(progn . ,cmds))
+            (terpri)
+            (print `(let ((css ',charsets))
+                      (dotimes (i 3)
+                        (dolist (cs (prog1 css (setq css nil)))
+                          ;; (message "Defining charset %S..." cs)
+                          (condition-case nil
+                              (progn
+                                (apply #'define-charset-internal
+                                       cs (get cs 'internal--charset-args))
+                                ;; (message "Defining charset %S...done" cs)
+                                )
+                            (error
+                             ;; (message "Defining charset %S...postponed"
+                             ;;          cs)
+                             (push cs css)))))))
+            (terpri)
+            (print `(dolist (cs ',charset-aliases)
+                      (define-charset-alias (car cs) (cdr cs))))
+            (terpri)
+            (print `(let ((css ',coding-systems))
+                      (dotimes (i 3)
+                        (dolist (cs (prog1 css (setq css nil)))
+                          ;; (message "Defining coding-system %S..." cs)
+                          (condition-case nil
+                              (progn
+                                (apply #'define-coding-system-internal
+                                       cs (get cs 'internal--cs-args))
+                                ;; (message "Defining coding-system %S...done" 
cs)
+                                )
+                            (error
+                             ;; (message "Defining coding-system 
%S...postponed"
+                             ;;          cs)
+                             (push cs css)))))))
+            (print `(dolist (f ',faces)
+                      (face-spec-set f (get f 'face-defface-spec)
+                                     'face-defface-spec)))
+            (terpri)
+            (print `(dolist (cs ',coding-system-aliases)
+                      (define-coding-system-alias (car cs) (cdr cs))))
+            (terpri)
+            (print `(progn
+                      ;; (message "Done preloading!")
+                      ;; (message "custom-delayed-init-variables = %S"
+                      ;;          custom-delayed-init-variables)
+                      ;; (message "Running top-level = %S" top-level)
+                      (setq debug-on-error t)
+                      (use-global-map global-map)
+                      (eval top-level)
+                      ;; (message "top-level done!?")
+                      ))
+            (terpri))
+          (goto-char (point-min))
+          (while (re-search-forward " (\\(defvar\\|setplist\\|fset\\) " nil t)
+            (goto-char (match-beginning 0))
+            (delete-char 1) (insert "\n"))
+          (message "Dumping into dumped.elc...saving...")
+          (let ((coding-system-for-write 'emacs-internal))
+            (write-region (point-min) (point-max) (buffer-name)))
+          (message "Dumping into dumped.elc...done")
+          ))
+
       (kill-emacs)))
 
 ;; For machines with CANNOT_DUMP defined in config.h,
diff --git a/src/coding.c b/src/coding.c
index 9f709be..a677758 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10326,8 +10326,9 @@ usage: (define-coding-system-internal ...)  */)
       CHECK_NUMBER_CAR (reg_usage);
       CHECK_NUMBER_CDR (reg_usage);
 
-      request = Fcopy_sequence (args[coding_arg_iso2022_request]);
-      for (tail = request; CONSP (tail); tail = XCDR (tail))
+      request = Qnil;
+      for (tail = args[coding_arg_iso2022_request];
+            CONSP (tail); tail = XCDR (tail))
        {
          int id;
          Lisp_Object tmp1;
@@ -10339,7 +10340,8 @@ usage: (define-coding-system-internal ...)  */)
          CHECK_NATNUM_CDR (val);
          if (XINT (XCDR (val)) >= 4)
            error ("Invalid graphic register number: %"pI"d", XINT (XCDR 
(val)));
-         XSETCAR (val, make_number (id));
+         request = Fcons (Fcons (make_number (id), XCDR (val)),
+                           request);
        }
 
       flags = args[coding_arg_iso2022_flags];
diff --git a/src/emacs.c b/src/emacs.c
index 2480dfc..bdf3742 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1593,9 +1593,9 @@ Using an Emacs configured with --with-x-toolkit=lucid 
does not have this problem
 #endif
          Vtop_level = list2 (Qload, build_unibyte_string (file));
        }
-      /* Unless next switch is -nl, load "loadup.el" first thing.  */
-      if (! no_loadup)
-       Vtop_level = list2 (Qload, build_string ("loadup.el"));
+      else if (! no_loadup)
+        /* Unless next switch is -nl, load "loadup.el" first thing.  */
+       Vtop_level = list2 (Qload, build_string ("../src/dumped.elc"));
     }
 
   /* Set up for profiling.  This is known to work on FreeBSD,