# HG changeset patch
# User Stefan Monnier <monnier@iro.umontreal.ca>
# Date 1271627373 14400
# Node ID 265966b778f9b5f24f456d35095275ffc49e0d53
# Parent  9b05dc529495325f1a98f18035153dd27fe1fef3
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.

diff -r 9b05dc529495 -r 265966b778f9 lisp/ChangeLog
--- 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.
diff -r 9b05dc529495 -r 265966b778f9 lisp/loadup.el
--- 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.
diff -r 9b05dc529495 -r 265966b778f9 src/ChangeLog
--- 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.
diff -r 9b05dc529495 -r 265966b778f9 src/alloc.c
--- 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.  */);