Mercurial > emacs
changeset 107895:265966b778f9
Hash-cons pure data.
* alloc.c (Fpurecopy): Hash-cons if requested.
(syms_of_alloc): Update purify-flag docstring.
* loadup.el: Setup hash-cons for pure data.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sun, 18 Apr 2010 17:49:33 -0400 |
| parents | 9b05dc529495 |
| children | f9390ec51de5 741b32aae521 |
| files | lisp/ChangeLog lisp/loadup.el src/ChangeLog src/alloc.c |
| diffstat | 4 files changed, 36 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Apr 18 17:45:44 2010 -0400 +++ b/lisp/ChangeLog Sun Apr 18 17:49:33 2010 -0400 @@ -1,5 +1,7 @@ 2010-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + * loadup.el: Setup hash-cons for pure data. + Fix duplicate entries in cedet's loaddefs.el files. * emacs-lisp/autoload.el (autoload-file-load-name): Be more clever. Should make most file-local generated-autoload-file unnecessary.
--- a/lisp/loadup.el Sun Apr 18 17:45:44 2010 -0400 +++ b/lisp/loadup.el Sun Apr 18 17:49:33 2010 -0400 @@ -64,6 +64,10 @@ (expand-file-name "international" dir) (expand-file-name "textmodes" dir))))) +(if (eq t purify-flag) + ;; Hash consing saved around 11% of pure space in my tests. + (setq purify-flag (make-hash-table :test 'equal))) + (message "Using load-path %s" load-path) (if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) @@ -345,6 +349,10 @@ ;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") +;; Avoid error if user loads some more libraries now and make sure the +;; hash-consing hash table is GC'd. +(setq purify-flag nil) + (if (null (garbage-collect)) (setq pure-space-overflow t)) @@ -378,9 +386,6 @@ (add-name-to-file "emacs" name t))) (kill-emacs))) -;; Avoid error if user loads some more libraries now. -(setq purify-flag nil) - ;; For machines with CANNOT_DUMP defined in config.h, ;; this file must be loaded each time Emacs is run. ;; So run the startup code now. First, remove `-l loadup' from args.
--- a/src/ChangeLog Sun Apr 18 17:45:44 2010 -0400 +++ b/src/ChangeLog Sun Apr 18 17:49:33 2010 -0400 @@ -1,3 +1,8 @@ +2010-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * alloc.c (Fpurecopy): Hash-cons if requested. + (syms_of_alloc): Update purify-flag docstring. + 2010-04-18 Jan Djärv <jan.h.d@swipnet.se> * gtkutil.c (xg_set_geometry): Set size in geometry string also.
--- a/src/alloc.c Sun Apr 18 17:45:44 2010 -0400 +++ b/src/alloc.c Sun Apr 18 17:49:33 2010 -0400 @@ -4893,14 +4893,21 @@ if (PURE_POINTER_P (XPNTR (obj))) return obj; + if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ + { + Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); + if (!NILP (tmp)) + return tmp; + } + if (CONSP (obj)) - return pure_cons (XCAR (obj), XCDR (obj)); + obj = pure_cons (XCAR (obj), XCDR (obj)); else if (FLOATP (obj)) - return make_pure_float (XFLOAT_DATA (obj)); + obj = make_pure_float (XFLOAT_DATA (obj)); else if (STRINGP (obj)) - return make_pure_string (SDATA (obj), SCHARS (obj), - SBYTES (obj), - STRING_MULTIBYTE (obj)); + obj = make_pure_string (SDATA (obj), SCHARS (obj), + SBYTES (obj), + STRING_MULTIBYTE (obj)); else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; @@ -4920,10 +4927,15 @@ } else XSETVECTOR (obj, vec); - return obj; } else if (MARKERP (obj)) error ("Attempt to copy a marker to pure storage"); + else + /* Not purified, don't hash-cons. */ + return obj; + + if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ + Fputhash (obj, obj, Vpurify_flag); return obj; } @@ -6371,7 +6383,9 @@ DEFVAR_LISP ("purify-flag", &Vpurify_flag, doc: /* Non-nil means loading Lisp code in order to dump an executable. -This means that certain objects should be allocated in shared (pure) space. */); +This means that certain objects should be allocated in shared (pure) space. +It can also be set to a hash-table, in which case this table is used to +do hash-consing of the objects allocated to pure space. */); DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages, doc: /* Non-nil means display messages at start and end of garbage collection. */);