--- a/lisp/ChangeLog	Fri Mar 26 15:06:28 2010 +0000
+++ b/lisp/ChangeLog	Mon Mar 29 00:11:03 2010 -0500
@@ -1,3 +1,12 @@
+2010-03-25  Ben Wing  <ben@xemacs.org>
+
+	* diagnose.el (show-memory-usage):
+	* diagnose.el (show-object-memory-usage-stats):
+	Further changes to correspond with changes in the C code;
+	add an additional column in show-object-memory-usage-stats showing
+	the ancillary Lisp overhead used with each type; shrink columns for
+	windows in show-memory-usage to get it to fit in 79 chars.
+
 2010-03-26  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* descr-text.el (describe-char-display):

--- a/lisp/diagnose.el	Fri Mar 26 15:06:28 2010 +0000
+++ b/lisp/diagnose.el	Mon Mar 29 00:11:03 2010 -0500
@@ -35,11 +35,12 @@
   "Show statistics about memory usage of various sorts in XEmacs."
   (interactive)
   (garbage-collect)
-  (flet ((show-foo-stats (objtypename cleanfun objlist)
+  (flet ((show-foo-stats (objtypename statname-plist cleanfun objlist
+			  &optional objnamelen)
 	   (let* ((hash (make-hash-table))
 		  (first t)
-		  types fmt
-		  (objnamelen 25)
+		  types origtypes fmt
+		  (objnamelen (or objnamelen 25))
 		  (linelen objnamelen)
 		  (totaltotal 0))
 	     (loop for obj in objlist do
@@ -54,19 +55,22 @@
 		 ;; the  memory grouped by type
 		 (while (and stats (pop stats)))
 
-		 (loop for (type . num) in stats while type do
+		 (loop for (type . num) in (remq t stats) while type do
+		   (if first (push type origtypes))
+		   (setq type (getf statname-plist type type))
 		   (puthash type (+ num (or (gethash type hash) 0)) hash)
 		   (incf total num)
 		   (if first (push type types)))
 		 (incf totaltotal total)
 		 (when first
 		   (setq types (nreverse types))
+		   (setq origtypes (nreverse origtypes))
 		   (setq fmt (concat
 			      (format "%%-%ds" objnamelen)
 			      (mapconcat
 			       #'(lambda (type)
 				   (let ((fieldlen
-					  (max 8 (+ 2 (length
+					  (max 7 (+ 2 (length
 						       (symbol-name type))))))
 				     (incf linelen fieldlen)
 				     (format "%%%ds" fieldlen)))
@@ -83,7 +87,7 @@
 							     (1- objnamelen)))
 				 (nconc (mapcar #'(lambda (type)
 						    (cdr (assq type stats)))
-						types)
+						origtypes)
 					(list total)))))
 		 (setq first nil)))
 	     (princ "\n")
@@ -103,7 +107,7 @@
 	  (when-fboundp 'charset-list
 	    (setq begin (point))
 	    (incf grandtotal
-		  (show-foo-stats 'charset 'charset-name
+		  (show-foo-stats 'charset nil 'charset-name
 				  (mapcar 'get-charset (charset-list))))
 	    (when-fboundp 'sort-numeric-fields
 	      (sort-numeric-fields -1
@@ -117,7 +121,7 @@
 	    (princ "\n"))
 	  (setq begin (point))
 	  (incf grandtotal
-		(show-foo-stats 'buffer 'buffer-name (buffer-list)))
+		(show-foo-stats 'buffer nil 'buffer-name (buffer-list)))
 	  (when-fboundp 'sort-numeric-fields
 	    (sort-numeric-fields -1
 				 (save-excursion
@@ -130,11 +134,19 @@
 	  (princ "\n")
 	  (setq begin (point))
 	  (incf grandtotal
-		(show-foo-stats 'window #'(lambda (x)
-					    (buffer-name (window-buffer x)))
+		(show-foo-stats 'window
+				'(line-start-cache line-st.
+				  face-cache face
+				  glyph-cache glyph
+				  redisplay-structs redisplay
+				  scrollbar-instances scrollbar
+				  window-mirror mirror)
+				#'(lambda (x)
+				    (buffer-name (window-buffer x)))
 				(mapcan #'(lambda (fr)
 					    (window-list fr t))
-					(frame-list))))
+					(frame-list))
+				16))
           (when-fboundp #'sort-numeric-fields
             (sort-numeric-fields -1
                                  (save-excursion
@@ -152,9 +164,14 @@
 	    (princ (make-string 40 ?-))
 	    (princ "\n")
 	    (map-plist #'(lambda (stat num)
-			   (when (string-match 
-				  "\\(.*\\)-storage$"
-				  (symbol-name stat))
+			   (when (and
+				  (not
+				   (string-match 
+				    "\\(.*\\)-ancillary-storage$"
+				    (symbol-name stat)))
+				  (string-match 
+				   "\\(.*\\)-storage$"
+				   (symbol-name stat)))
 			     (incf total num)
 			     (princ (format fmt
 					    (match-string 1 (symbol-name stat))
@@ -184,12 +201,14 @@
   (garbage-collect)
   (let ((buffer "*object memory usage statistics*")
 	(plist (object-memory-usage-stats))
-	(fmt "%-30s%10s%10s%10s%18s\n")
+	(fmt "%-28s%10s%10s%10s%10s%10s\n")
 	(grandtotal 0)
 	begin)
   (flet ((show-stats (match-string)
-	(princ (format fmt "object" "count" "storage" "overhead"
-		       "non-Lisp storage"))
+	(princ (format "%28s%10s%40s\n" "" ""
+		       "--------------storage---------------"))
+	(princ (format fmt "object" "count" "object" "overhead"
+		       "non-Lisp" "ancillary"))
 	(princ (make-string 78 ?-))
 	(princ "\n")
 	(let ((total-use 0)
@@ -202,9 +221,13 @@
 	       (let ((symmatch
 		      (and (string-match match-string (symbol-name stat))
 			   (match-string 1 (symbol-name stat)))))
-		 (when (and symmatch (or (< (length symmatch) 9)
-					 (not (equal (substring symmatch -9)
-						     "-non-lisp"))))
+		 (when (and symmatch
+			    (or (< (length symmatch) 9)
+				(not (equal (substring symmatch -9)
+					    "-non-lisp")))
+			    (or (< (length symmatch) 15)
+				(not (equal (substring symmatch -15)
+					    "-lisp-ancillary"))))
 		   (let* ((storage-use num)
 			  (storage-use-overhead
 			   (or (plist-get 
@@ -227,6 +250,12 @@
 				(intern (concat symmatch
 						"-non-lisp-storage")))
 			       0))
+			  (lisp-ancillary-storage
+			   (or (plist-get
+				plist
+				(intern (concat symmatch
+						"-lisp-ancillary-storage")))
+			       0))
 			  (storage-count 
 			   (or (loop for str in '("s-used" "es-used" "-used")
 				 for val = (plist-get
@@ -251,19 +280,20 @@
 					 (or storage-count "unknown")
 					 storage-use
 					 storage-use-overhead
-					 non-lisp-storage)))))))
+					 non-lisp-storage
+					 lisp-ancillary-storage)))))))
 	   plist)
 	  (princ "\n")
 	  (princ (format fmt "total" 
 			 total-count total-use total-use-overhead
-			 total-non-lisp-use))
+			 total-non-lisp-use ""))
 	  (incf grandtotal total-use-with-overhead)
 	  (incf grandtotal total-non-lisp-use)
           (when-fboundp #'sort-numeric-fields
-            (sort-numeric-fields -3
+            (sort-numeric-fields -4
                                  (save-excursion
                                    (goto-char begin)
-                                   (forward-line 3)
+                                   (forward-line 4)
                                    (point))
                                  (save-excursion
                                    (forward-line -2)

--- a/src/ChangeLog	Fri Mar 26 15:06:28 2010 +0000
+++ b/src/ChangeLog	Mon Mar 29 00:11:03 2010 -0500
@@ -1,3 +1,325 @@
+2010-03-28  Ben Wing  <ben@xemacs.org>
+
+	* window.c (find_window_mirror_internal):
+	Stop looking if no window mirror, and return 0.
+	
+	* window.c (window_display_lines):
+	* window.c (window_display_buffer):
+	* window.c (set_window_display_buffer):
+	Don't need to update window mirror before calling find_window_mirror
+	because does the updating automatically.
+
+2010-03-25  Ben Wing  <ben@xemacs.org>
+
+	* alloc.c:
+	* alloc.c (struct):
+	* alloc.c (finish_object_memory_usage_stats):
+	* alloc.c (object_memory_usage_stats):
+	* alloc.c (Fobject_memory_usage):
+	* alloc.c (lisp_object_memory_usage_full):
+	* alloc.c (compute_memusage_stats_length):
+	* lrecord.h:
+	* lrecord.h (struct lrecord_implementation):
+	Add fields to the `lrecord_implementation' structure to list an
+	offset into the array of extra statistics in a
+	`struct generic_usage_stats' and a length, listing the first slice
+	of ancillary Lisp-object memory.  Compute automatically in
+	compute_memusage_stats_length().  Use to add an entry
+	`FOO-lisp-ancillary-storage' for object type FOO.
+
+	Don't crash when an int or char is given to object-memory-usage,
+	signal an error instead.
+
+	Add functions lisp_object_memory_usage_full() and
+	lisp_object_memory_usage() to compute the total memory usage of an
+	object (sum of object, non-Lisp attached, and Lisp ancillary
+	memory).
+	
+	* array.c:
+	* array.c (gap_array_memory_usage):
+	* array.h:
+	Add function to return memory usage of a gap array.
+	
+	* buffer.c (struct buffer_stats):
+	* buffer.c (compute_buffer_usage):
+	* buffer.c (vars_of_buffer):
+	* extents.c (compute_buffer_extent_usage):
+	* marker.c:
+	* marker.c (compute_buffer_marker_usage):
+	* extents.h:
+	* lisp.h:
+	Remove `struct usage_stats' arg from compute_buffer_marker_usage()
+	and compute_buffer_extent_usage() -- these are ancillary Lisp
+	objects and don't get accumulated into `struct usage_stats';
+	change the value of `memusage_stats_list' so that `markers' and
+	`extents' memory is in Lisp-ancillary, where it belongs.
+
+	In compute_buffer_marker_usage(), use lisp_object_memory_usage()
+	rather than lisp_object_storage_size().
+	
+	* casetab.c:
+	* casetab.c (case_table_memory_usage):
+	* casetab.c (vars_of_casetab):
+	* emacs.c (main_1):
+	Add memory usage stats for case tables.
+	
+	* lisp.h:
+	Add comment explaining the `struct generic_usage_stats' more,
+	as well as the new fields in lrecord_implementation.
+
+	* console-impl.h:
+	* console-impl.h (struct console_methods):
+	* scrollbar-gtk.c:
+	* scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage):
+	* scrollbar-msw.c:
+	* scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage):
+	* scrollbar-x.c:
+	* scrollbar-x.c (x_compute_scrollbar_instance_usage):
+	* scrollbar.c:
+	* scrollbar.c (struct scrollbar_instance_stats):
+	* scrollbar.c (compute_all_scrollbar_instance_usage):
+	* scrollbar.c (scrollbar_instance_memory_usage):
+	* scrollbar.c (scrollbar_objects_create):
+	* scrollbar.c (vars_of_scrollbar):
+	* scrollbar.h:
+	* symsinit.h:
+	* window.c:
+	* window.c (find_window_mirror_maybe):
+	* window.c (struct window_mirror_stats):
+	* window.c (compute_window_mirror_usage):
+	* window.c (window_mirror_memory_usage):
+	* window.c (compute_window_usage):
+	* window.c (window_objects_create):
+	* window.c (syms_of_window):
+	* window.c (vars_of_window):
+	Redo memory-usage associated with windows, window mirrors, and
+	scrollbar instances.  Should fix crash in find_window_mirror,
+	among other things.  Properly assign memo ry to object memory,
+	non-Lisp extra memory, and Lisp ancillary memory.  For example,
+	redisplay structures are non-Lisp memory hanging off a window
+	mirror, not a window; make it an ancillary Lisp-object field.
+	Window mirrors and scrollbar instances have their own statistics,
+	among other things.
+	 
+2010-03-24  Ben Wing  <ben@xemacs.org>
+
+	* array.h:
+	* array.h (XD_LISP_DYNARR_DESC):
+	* dumper.c (pdump_register_sub):
+	* dumper.c (pdump_store_new_pointer_offsets):
+	* dumper.c (pdump_reloc_one_mc):
+	* elhash.c:
+	* gc.c  (lispdesc_one_description_line_size):
+	* gc.c (kkcc_marking):
+	* lrecord.h:
+	* lrecord.h (IF_NEW_GC):
+	* lrecord.h (enum memory_description_type):
+	* lrecord.h (enum data_description_entry_flags):
+	* lrecord.h (struct opaque_convert_functions):
+	Rename XD_LISP_OBJECT_BLOCK_PTR to XD_INLINE_LISP_OBJECT_BLOCK_PTR
+	and document it in lrecord.h.
+
+	* data.c:
+	* data.c (finish_marking_weak_lists):
+	* data.c (continue_marking_ephemerons):
+	* data.c (finish_marking_ephemerons):
+	* elhash.c (MARK_OBJ):
+	* gc.c:
+	* gc.c (lispdesc_indirect_count_1):
+	* gc.c (struct):
+	* gc.c (kkcc_bt_push):
+	* gc.c (kkcc_gc_stack_push):
+	* gc.c (kkcc_gc_stack_push_lisp_object):
+	* gc.c (kkcc_gc_stack_repush_dirty_object):
+	* gc.c (KKCC_DO_CHECK_FREE):
+	* gc.c (mark_object_maybe_checking_free):
+	* gc.c (mark_struct_contents):
+	* gc.c (mark_lisp_object_block_contents):
+	* gc.c (register_for_finalization):
+	* gc.c (mark_object):
+	* gc.h:
+	* lisp.h:
+	* profile.c:
+	* profile.c (mark_profiling_info_maphash):
+	Clean up KKCC code related to DEBUG_XEMACS.  Rename
+	kkcc_backtrace() to kkcc_backtrace_1() and add two params: a
+	`size' arg to control how many stack elements to print and a
+	`detailed' arg to control whether Lisp objects are printed using
+	`debug_print()'.  Create front-ends to kkcc_backtrace_1() --
+	kkcc_detailed_backtrace(), kkcc_short_backtrace(),
+	kkcc_detailed_backtrace_full(), kkcc_short_backtrace_full(), as
+	well as shortened versions kbt(), kbts(), kbtf(), kbtsf() -- to
+	call it with various parameter values.  Add an `is_lisp' field to
+	the stack and backtrace structures and use it to keep track of
+	whether an object pushed onto the stack is a Lisp object or a
+	non-Lisp structure; in kkcc_backtrace_1(), don't try to print a
+	non-Lisp structure as a Lisp object.
+	
+	* elhash.c:
+	* extents.c:
+	* file-coding.c:
+	* lrecord.h:
+	* lrecord.h (IF_NEW_GC):
+	* marker.c:
+	* marker.c (Fmarker_buffer):
+	* mule-coding.c:
+	* number.c:
+	* rangetab.c:
+	* specifier.c:
+	New macros IF_OLD_GC(), IF_NEW_GC() to simplify declaration of
+	Lisp objects when a finalizer may exist in one but not the other.
+	Use them appropriately.
+
+	* extents.c (finalize_extent_info):
+	Don't zero out data->soe and data->extents before trying to free,
+	else we get memory leaks.
+	
+	* lrecord.h (enum lrecord_type):
+	Make the first lrecord type have value 1 not 0 so that 0 remains
+	without implementation and attempts to interpret zeroed memory
+	as a Lisp object will be more obvious.
+
+	* array.c (Dynarr_free):
+	* device-msw.c (msprinter_delete_device):
+	* device-tty.c (free_tty_device_struct):
+	* device-tty.c (tty_delete_device):
+	* dialog-msw.c (handle_directory_dialog_box):
+	* dialog-x.c:
+	* emacs.c (free_argc_argv):
+	* emodules.c (attempt_module_delete):
+	* file-coding.c (chain_finalize_coding_stream_1):
+	* file-coding.c (chain_finalize_coding_stream):
+	* glyphs-eimage.c:
+	* glyphs-eimage.c (jpeg_instantiate_unwind):
+	* glyphs-eimage.c (gif_instantiate_unwind):
+	* glyphs-eimage.c (png_instantiate_unwind):
+	* glyphs-eimage.c (tiff_instantiate_unwind):
+	* imgproc.c:
+	* imgproc.c (build_EImage_quantable):
+	* insdel.c (uninit_buffer_text):
+	* mule-coding.c (iso2022_finalize_detection_state):
+	* objects-tty.c (tty_finalize_color_instance):
+	* objects-tty.c (tty_finalize_font_instance):
+	* objects-tty.c (tty_font_list):
+	* process.c:
+	* process.c (finalize_process):
+	* redisplay.c (add_propagation_runes):
+	* scrollbar-gtk.c:
+	* scrollbar-gtk.c (gtk_free_scrollbar_instance):
+	* scrollbar-gtk.c (gtk_release_scrollbar_instance):
+	* scrollbar-msw.c:
+	* scrollbar-msw.c (mswindows_free_scrollbar_instance):
+	* scrollbar-msw.c (unshow_that_mofo):
+	* scrollbar-x.c (x_free_scrollbar_instance):
+	* scrollbar-x.c (x_release_scrollbar_instance):
+	* select-x.c:
+	* select-x.c (x_handle_selection_request):
+	* syntax.c:
+	* syntax.c (uninit_buffer_syntax_cache):
+	* text.h (eifree):
+	If possible, whenever we call xfree() on a field in a structure,
+	set the field to 0 afterwards.  A lot of code is written so that
+	it checks the value being freed to see if it is non-zero before
+	freeing it -- doing this and setting the value to 0 afterwards
+	ensures (a) we won't try to free twice if the cleanup code is
+	called twice; (b) if the object itself stays around, KKCC won't
+	crash when attempting to mark the freed field.
+
+	* rangetab.c:
+	Add a finalization method when not NEW_GC to avoid memory leaks.
+	(#### We still get memory leaks when NEW_GC; need to convert gap
+	array to Lisp object).
+
+2010-03-22  Ben Wing  <ben@xemacs.org>
+
+	* Makefile.in.in (objs):
+	* array.c:
+	* array.c (gap_array_adjust_markers):
+	* array.c (gap_array_move_gap):
+	* array.c (gap_array_make_gap):
+	* array.c (gap_array_insert_els):
+	* array.c (gap_array_delete_els):
+	* array.c (gap_array_make_marker):
+	* array.c (gap_array_delete_marker):
+	* array.c (gap_array_delete_all_markers):
+	* array.c (gap_array_clone):
+	* array.h:
+	* depend:
+	* emacs.c (main_1):
+	* extents.c:
+	* extents.c (EXTENT_GAP_ARRAY_AT):
+	* extents.c (extent_list_num_els):
+	* extents.c (extent_list_locate):
+	* extents.c (extent_list_at):
+	* extents.c (extent_list_delete_all):
+	* extents.c (allocate_extent_list):
+	* extents.c (syms_of_extents):
+	* extents.h:
+	* extents.h (XEXTENT_LIST_MARKER):
+	* lisp.h:
+	* rangetab.c:
+	* rangetab.c (mark_range_table):
+	* rangetab.c (print_range_table):
+	* rangetab.c (range_table_equal):
+	* rangetab.c (range_table_hash):
+	* rangetab.c (verify_range_table):
+	* rangetab.c (get_range_table_pos):
+	* rangetab.c (Fmake_range_table):
+	* rangetab.c (Fcopy_range_table):
+	* rangetab.c (Fget_range_table):
+	* rangetab.c (put_range_table):
+	* rangetab.c (Fclear_range_table):
+	* rangetab.c (Fmap_range_table):
+	* rangetab.c (unified_range_table_bytes_needed):
+	* rangetab.c (unified_range_table_copy_data):
+	* rangetab.c (unified_range_table_lookup):
+	* rangetab.h:
+	* rangetab.h (struct range_table_entry):
+	* rangetab.h (struct Lisp_Range_Table):
+	* rangetab.h (rangetab_gap_array_at):
+	* symsinit.h:
+	Rename dynarr.c to array.c.  Move gap array from extents.c to array.c.
+	Extract dynarr, gap array and stack-like malloc into new file array.h.
+	Rename GAP_ARRAY_NUM_ELS -> gap_array_length().  Add gap_array_at(),
+	gap_array_atp().
+
+	Rewrite range table code to use gap arrays.  Make put_range_table()
+	smarter so that its operation is O(log n) for adding a localized
+	range.
+
+	* gc.c (lispdesc_block_size_1):
+	Don't ABORT() when two elements are located at the same place.
+	This will happen with a size-0 gap array -- both parts of the array
+	(before and after gap) are in the same place.
+
+2010-03-21  Ben Wing  <ben@xemacs.org>
+
+	* alloc.c:
+	* alloc.c (assert_proper_sizing):
+	* alloc.c (c_readonly):
+	* alloc.c (malloced_storage_size):
+	* alloc.c (fixed_type_block_overhead):
+	* alloc.c (lisp_object_storage_size):
+	* alloc.c (inc_lrecord_stats):
+	* alloc.c (dec_lrecord_stats):
+	* alloc.c (pluralize_word):
+	* alloc.c (object_memory_usage_stats):
+	* alloc.c (Fobject_memory_usage):
+	* alloc.c (compute_memusage_stats_length):
+	* alloc.c (disksave_object_finalization_1):
+	* alloc.c (Fgarbage_collect):
+	* mc-alloc.c:
+	* mc-alloc.c (mc_alloced_storage_size):
+	* mc-alloc.h:
+	No functionality change here.  Collect the allocations-statistics
+	code that was scattered throughout alloc.c into one place.  Add
+	remaining section headings so that all sections have headings
+	clearly identifying the start of the section and its purpose.
+	Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS;
+	this fixes build problems and is related to the export of
+	lisp_object_storage_size() and malloced_storage_size() when
+	non-MEMORY_USAGE_STATS in the previous change set.
+
 2010-03-22  Vin Shelton  <acs@xemacs.org>
 
 	* window.c (vars_of_window): Move HAVE_SCROLLBARS test so the code

--- a/src/Makefile.in.in	Fri Mar 26 15:06:28 2010 +0000
+++ b/src/Makefile.in.in	Mon Mar 29 00:11:03 2010 -0500
@@ -274,13 +274,12 @@
 ## if they all come out null.
 
 objs=\
- abbrev.o alloc.o alloca.o \
+ abbrev.o alloc.o alloca.o array.o \
  $(balloon_help_objs) blocktype.o buffer.o bytecode.o \
  callint.o casefiddle.o casetab.o chartab.o \
  $(clash_detection_objs) cmdloop.o cmds.o $(coding_system_objs) console.o \
  console-stream.o\
  data.o $(database_objs) $(debug_objs) device.o dired.o doc.o doprnt.o\
- dynarr.o \
  editfns.o elhash.o emacs.o emodules.o eval.o events.o\
  event-stream.o $(event_unixoid_objs) $(extra_objs) extents.o\
  faces.o file-coding.o fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o \

--- a/src/alloc.c	Fri Mar 26 15:06:28 2010 +0000
+++ b/src/alloc.c	Mon Mar 29 00:11:03 2010 -0500
@@ -142,96 +142,67 @@
 Lisp_Object Qother_memory_dynarr_overhead, Qother_memory_gap_overhead;
 #endif /* MEMORY_USAGE_STATS */
 
+#ifndef NEW_GC
+static int gc_count_num_short_string_in_use;
+static Bytecount gc_count_string_total_size;
+static Bytecount gc_count_short_string_total_size;
+static Bytecount gc_count_long_string_storage_including_overhead;
+#endif /* not NEW_GC */
+
+/* static int gc_count_total_records_used, gc_count_records_total_size; */
+
+/* stats on objects in use */
+
+#ifdef NEW_GC
+
+static struct
+{
+  int instances_in_use;
+  int bytes_in_use;
+  int bytes_in_use_including_overhead;
+} lrecord_stats [countof (lrecord_implementations_table)];
+
+#else /* not NEW_GC */
+
+static struct
+{
+  Elemcount instances_in_use;
+  Bytecount bytes_in_use;
+  Bytecount bytes_in_use_overhead;
+  Elemcount instances_freed;
+  Bytecount bytes_freed;
+  Bytecount bytes_freed_overhead;
+  Elemcount instances_on_free_list;
+  Bytecount bytes_on_free_list;
+  Bytecount bytes_on_free_list_overhead;
+#ifdef MEMORY_USAGE_STATS
+  Bytecount nonlisp_bytes_in_use;
+  Bytecount lisp_ancillary_bytes_in_use;
+  struct generic_usage_stats stats;
+#endif
+} lrecord_stats [countof (lrecord_implementations_table)];
+
+#endif /* (not) NEW_GC */
+
 /* Very cheesy ways of figuring out how much memory is being used for
    data. #### Need better (system-dependent) ways. */
 void *minimum_address_seen;
 void *maximum_address_seen;
 
-/* Determine now whether we need to garbage collect or not, to make
-   Ffuncall() faster */
-#define INCREMENT_CONS_COUNTER_1(size)		\
-do						\
-{						\
-  consing_since_gc += (size);			\
-  total_consing += (size);			\
-  if (profiling_active)				\
-    profile_record_consing (size);		\
-  recompute_need_to_garbage_collect ();		\
-} while (0)
-
-#define debug_allocation_backtrace()				\
-do {								\
-  if (debug_allocation_backtrace_length > 0)			\
-    debug_short_backtrace (debug_allocation_backtrace_length);	\
-} while (0)
-
-#ifdef DEBUG_XEMACS
-#define INCREMENT_CONS_COUNTER(foosize, type)		\
-  do {							\
-    if (debug_allocation)				\
-      {							\
-	stderr_out ("allocating %s (size %ld)\n", type,	\
-		    (long) foosize);			\
-	debug_allocation_backtrace ();			\
-      }							\
-    INCREMENT_CONS_COUNTER_1 (foosize);			\
-  } while (0)
-#define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type)		\
-  do {								\
-    if (debug_allocation > 1)					\
-      {								\
-	stderr_out ("allocating noseeum %s (size %ld)\n", type,	\
-		    (long) foosize);				\
-	debug_allocation_backtrace ();				\
-      }								\
-    INCREMENT_CONS_COUNTER_1 (foosize);				\
-  } while (0)
-#else
-#define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
-#define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
-  INCREMENT_CONS_COUNTER_1 (size)
-#endif
-
-#ifdef NEW_GC
-/* [[ The call to recompute_need_to_garbage_collect is moved to
-   free_normal_lisp_object, since DECREMENT_CONS_COUNTER is extensively called
-   during sweep and recomputing need_to_garbage_collect all the time
-   is not needed. ]] -- not accurate! */
-#define DECREMENT_CONS_COUNTER(size) do {	\
-  consing_since_gc -= (size);			\
-  total_consing -= (size);			\
-  if (profiling_active)				\
-    profile_record_unconsing (size);		\
-  if (consing_since_gc < 0)			\
-    consing_since_gc = 0;			\
-} while (0)
-#else /* not NEW_GC */
-#define DECREMENT_CONS_COUNTER(size) do {	\
-  consing_since_gc -= (size);			\
-  total_consing -= (size);			\
-  if (profiling_active)				\
-    profile_record_unconsing (size);		\
-  if (consing_since_gc < 0)			\
-    consing_since_gc = 0;			\
-  recompute_need_to_garbage_collect ();		\
-} while (0)
-#endif /*not NEW_GC */
-
-#ifndef NEW_GC
-int
-c_readonly (Lisp_Object obj)
-{
-  return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
-}
-#endif /* not NEW_GC */
-
-int
-lisp_readonly (Lisp_Object obj)
-{
-  return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
-}
-
 
+/************************************************************************/
+/*                         Low-level allocation                         */
+/************************************************************************/
+
+void
+recompute_funcall_allocation_flag (void)
+{
+  funcall_allocation_flag =
+    need_to_garbage_collect ||
+    need_to_check_c_alloca ||
+    need_to_signal_post_gc;
+}
+
 /* Maximum amount of C stack to save when a GC happens.  */
 
 #ifndef MAX_SAVE_STACK
@@ -255,6 +226,22 @@
       xfree (tmp);
     }
 }
+
+#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
+/* If we released our reserve (due to running out of memory),
+   and we have a fair amount free once again,
+   try to set aside another reserve in case we run out once more.
+
+   This is called when a relocatable block is freed in ralloc.c.  */
+void refill_memory_reserve (void);
+void
+refill_memory_reserve (void)
+{
+  if (breathing_space == 0)
+    breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD);
+}
+#endif /* !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC) */
+
 #endif /* not NEW_GC */
 
 static void
@@ -490,6 +477,80 @@
 #endif /* NEED_STRDUP */
 
 
+/************************************************************************/
+/*                        Lisp object allocation                        */
+/************************************************************************/
+
+/* Determine now whether we need to garbage collect or not, to make
+   Ffuncall() faster */
+#define INCREMENT_CONS_COUNTER_1(size)		\
+do						\
+{						\
+  consing_since_gc += (size);			\
+  total_consing += (size);			\
+  if (profiling_active)				\
+    profile_record_consing (size);		\
+  recompute_need_to_garbage_collect ();		\
+} while (0)
+
+#define debug_allocation_backtrace()				\
+do {								\
+  if (debug_allocation_backtrace_length > 0)			\
+    debug_short_backtrace (debug_allocation_backtrace_length);	\
+} while (0)
+
+#ifdef DEBUG_XEMACS
+#define INCREMENT_CONS_COUNTER(foosize, type)		\
+  do {							\
+    if (debug_allocation)				\
+      {							\
+	stderr_out ("allocating %s (size %ld)\n", type,	\
+		    (long) foosize);			\
+	debug_allocation_backtrace ();			\
+      }							\
+    INCREMENT_CONS_COUNTER_1 (foosize);			\
+  } while (0)
+#define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type)		\
+  do {								\
+    if (debug_allocation > 1)					\
+      {								\
+	stderr_out ("allocating noseeum %s (size %ld)\n", type,	\
+		    (long) foosize);				\
+	debug_allocation_backtrace ();				\
+      }								\
+    INCREMENT_CONS_COUNTER_1 (foosize);				\
+  } while (0)
+#else
+#define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
+#define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
+  INCREMENT_CONS_COUNTER_1 (size)
+#endif
+
+#ifdef NEW_GC
+/* [[ The call to recompute_need_to_garbage_collect is moved to
+   free_normal_lisp_object, since DECREMENT_CONS_COUNTER is extensively called
+   during sweep and recomputing need_to_garbage_collect all the time
+   is not needed. ]] -- not accurate! */
+#define DECREMENT_CONS_COUNTER(size) do {	\
+  consing_since_gc -= (size);			\
+  total_consing -= (size);			\
+  if (profiling_active)				\
+    profile_record_unconsing (size);		\
+  if (consing_since_gc < 0)			\
+    consing_since_gc = 0;			\
+} while (0)
+#else /* not NEW_GC */
+#define DECREMENT_CONS_COUNTER(size) do {	\
+  consing_since_gc -= (size);			\
+  total_consing -= (size);			\
+  if (profiling_active)				\
+    profile_record_unconsing (size);		\
+  if (consing_since_gc < 0)			\
+    consing_since_gc = 0;			\
+  recompute_need_to_garbage_collect ();		\
+} while (0)
+#endif /*not NEW_GC */
+
 #ifndef NEW_GC
 static void *
 allocate_lisp_storage (Bytecount size)
@@ -517,63 +578,6 @@
 }
 #endif /* not NEW_GC */
 
-#if defined (NEW_GC) && defined (ALLOC_TYPE_STATS)
-static struct
-{
-  int instances_in_use;
-  int bytes_in_use;
-  int bytes_in_use_including_overhead;
-} lrecord_stats [countof (lrecord_implementations_table)];
-
-void
-init_lrecord_stats (void)
-{
-  xzero (lrecord_stats);
-}
-
-void
-inc_lrecord_stats (Bytecount size, const struct lrecord_header *h)
-{
-  int type_index = h->type;
-  if (!size)
-    size = detagged_lisp_object_size (h);
-
-  lrecord_stats[type_index].instances_in_use++;
-  lrecord_stats[type_index].bytes_in_use += size;
-  lrecord_stats[type_index].bytes_in_use_including_overhead
-#ifdef MEMORY_USAGE_STATS
-    += mc_alloced_storage_size (size, 0);
-#else /* not MEMORY_USAGE_STATS */
-    += size;
-#endif /* not MEMORY_USAGE_STATS */
-}
-
-void
-dec_lrecord_stats (Bytecount size_including_overhead, 
-		   const struct lrecord_header *h)
-{
-  int type_index = h->type;
-  int size = detagged_lisp_object_size (h);
-
-  lrecord_stats[type_index].instances_in_use--;
-  lrecord_stats[type_index].bytes_in_use -= size;
-  lrecord_stats[type_index].bytes_in_use_including_overhead
-    -= size_including_overhead;
-
-  DECREMENT_CONS_COUNTER (size);
-}
-
-int
-lrecord_stats_heap_size (void)
-{
-  int i;
-  int size = 0;
-  for (i = 0; i < countof (lrecord_implementations_table); i++)
-    size += lrecord_stats[i].bytes_in_use;
-  return size;
-}
-#endif /* NEW_GC && ALLOC_TYPE_STATS */
-
 #define assert_proper_sizing(size)			\
   type_checking_assert					\
     (implementation->static_size == 0 ?			\
@@ -755,32 +759,6 @@
 #endif /* Unused */
 #endif /* not NEW_GC */
 
-
-static void
-disksave_object_finalization_1 (void)
-{
-#ifdef NEW_GC
-  mc_finalize_for_disksave ();
-#else /* not NEW_GC */
-  struct old_lcrecord_header *header;
-
-  for (header = all_lcrecords; header; header = header->next)
-    {
-      struct lrecord_header *objh = &header->lheader;
-      const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
-#if 0 /* possibly useful for debugging */
-      if (!RECORD_DUMPABLE (objh) && !objh->free)
-	{
-	  stderr_out ("Disksaving a non-dumpable object: ");
-	  debug_print (wrap_pointer_1 (header));
-	}
-#endif
-      if (imp->disksave && !objh->free)
-	(imp->disksave) (wrap_pointer_1 (header));
-    }
-#endif /* not NEW_GC */
-}
-
 /* Bitwise copy all parts of a Lisp object other than the header */
 
 void
@@ -872,9 +850,37 @@
 #endif
 }
 
+#ifndef NEW_GC
+int
+c_readonly (Lisp_Object obj)
+{
+  return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
+}
+#endif /* not NEW_GC */
+
+int
+lisp_readonly (Lisp_Object obj)
+{
+  return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
+}
+
+/* #### Should be made into an object method */
+
+int
+object_dead_p (Lisp_Object obj)
+{
+  return ((BUFFERP  (obj) && !BUFFER_LIVE_P  (XBUFFER  (obj))) ||
+	  (FRAMEP   (obj) && !FRAME_LIVE_P   (XFRAME   (obj))) ||
+	  (WINDOWP  (obj) && !WINDOW_LIVE_P  (XWINDOW  (obj))) ||
+	  (DEVICEP  (obj) && !DEVICE_LIVE_P  (XDEVICE  (obj))) ||
+	  (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) ||
+	  (EVENTP   (obj) && !EVENT_LIVE_P   (XEVENT   (obj))) ||
+	  (EXTENTP  (obj) && !EXTENT_LIVE_P  (XEXTENT  (obj))));
+}
+
 
 /************************************************************************/
-/*			  Debugger support				*/
+/*                           Debugger support                           */
 /************************************************************************/
 /* Give gdb/dbx enough information to decode Lisp Objects.  We make
    sure certain symbols are always defined, so gdb doesn't complain
@@ -921,7 +927,7 @@
 #define DECLARE_FIXED_TYPE_ALLOC(type, structture) struct __foo__
 #else
 /************************************************************************/
-/*			  Fixed-size type macros			*/
+/*                        Fixed-size type macros                        */
 /************************************************************************/
 
 /* For fixed-size types that are commonly used, we malloc() large blocks
@@ -1061,21 +1067,6 @@
    remain free for the next 1000 (or whatever) times that
    an object of that type is allocated.  */
 
-#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
-/* If we released our reserve (due to running out of memory),
-   and we have a fair amount free once again,
-   try to set aside another reserve in case we run out once more.
-
-   This is called when a relocatable block is freed in ralloc.c.  */
-void refill_memory_reserve (void);
-void
-refill_memory_reserve (void)
-{
-  if (breathing_space == 0)
-    breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD);
-}
-#endif
-
 #ifdef ALLOC_NO_POOLS
 # define TYPE_ALLOC_SIZE(type, structtype) 1
 #else
@@ -3569,38 +3560,208 @@
 #endif /* not DEBUG_XEMACS */
 #endif /* NEW_GC */
 
-
-/************************************************************************/
-/*                        Allocation Statistics                         */
-/************************************************************************/
-
-#ifndef NEW_GC
-static int gc_count_num_short_string_in_use;
-static Bytecount gc_count_string_total_size;
-static Bytecount gc_count_short_string_total_size;
-static Bytecount gc_count_long_string_storage_including_overhead;
-
-/* static int gc_count_total_records_used, gc_count_records_total_size; */
+#ifdef ALLOC_TYPE_STATS
 
 
-/* stats on objects in use */
-
-static struct
-{
-  Elemcount instances_in_use;
-  Bytecount bytes_in_use;
-  Bytecount bytes_in_use_overhead;
-  Elemcount instances_freed;
-  Bytecount bytes_freed;
-  Bytecount bytes_freed_overhead;
-  Elemcount instances_on_free_list;
-  Bytecount bytes_on_free_list;
-  Bytecount bytes_on_free_list_overhead;
+/************************************************************************/
+/*                   Determining allocation overhead                    */
+/************************************************************************/
+
+/* Attempt to determine the actual amount of space that is used for
+   the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
+
+   It seems that the following holds:
+
+   1. When using the old allocator (malloc.c):
+
+      -- blocks are always allocated in chunks of powers of two.  For
+	 each block, there is an overhead of 8 bytes if rcheck is not
+	 defined, 20 bytes if it is defined.  In other words, a
+	 one-byte allocation needs 8 bytes of overhead for a total of
+	 9 bytes, and needs to have 16 bytes of memory chunked out for
+	 it.
+
+   2. When using the new allocator (gmalloc.c):
+
+      -- blocks are always allocated in chunks of powers of two up
+         to 4096 bytes.  Larger blocks are allocated in chunks of
+	 an integral multiple of 4096 bytes.  The minimum block
+         size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG
+	 is defined.  There is no per-block overhead, but there
+	 is an overhead of 3*sizeof (size_t) for each 4096 bytes
+	 allocated.
+
+    3. When using the system malloc, anything goes, but they are
+       generally slower and more space-efficient than the GNU
+       allocators.  One possibly reasonable assumption to make
+       for want of better data is that sizeof (void *), or maybe
+       2 * sizeof (void *), is required as overhead and that
+       blocks are allocated in the minimum required size except
+       that some minimum block size is imposed (e.g. 16 bytes). */
+
+Bytecount
+malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
+		       struct usage_stats *stats)
+{
+  Bytecount orig_claimed_size = claimed_size;
+
+#ifndef SYSTEM_MALLOC
+  if (claimed_size < (Bytecount) (2 * sizeof (void *)))
+    claimed_size = 2 * sizeof (void *);
+# ifdef SUNOS_LOCALTIME_BUG
+  if (claimed_size < 16)
+    claimed_size = 16;
+# endif
+  if (claimed_size < 4096)
+    {
+      /* fxg: rename log->log2 to supress gcc3 shadow warning */
+      int log2 = 1;
+
+      /* compute the log base two, more or less, then use it to compute
+	 the block size needed. */
+      claimed_size--;
+      /* It's big, it's heavy, it's wood! */
+      while ((claimed_size /= 2) != 0)
+	++log2;
+      claimed_size = 1;
+      /* It's better than bad, it's good! */
+      while (log2 > 0)
+        {
+	  claimed_size *= 2;
+          log2--;
+        }
+      /* We have to come up with some average about the amount of
+	 blocks used. */
+      if ((Bytecount) (rand () & 4095) < claimed_size)
+	claimed_size += 3 * sizeof (void *);
+    }
+  else
+    {
+      claimed_size += 4095;
+      claimed_size &= ~4095;
+      claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
+    }
+
+#else
+
+  if (claimed_size < 16)
+    claimed_size = 16;
+  claimed_size += 2 * sizeof (void *);
+
+#endif /* system allocator */
+
+  if (stats)
+    {
+      stats->was_requested += orig_claimed_size;
+      stats->malloc_overhead += claimed_size - orig_claimed_size;
+    }
+  return claimed_size;
+}
+
+#ifndef NEW_GC
+static Bytecount
+fixed_type_block_overhead (Bytecount size, Bytecount per_block)
+{
+  Bytecount overhead = 0;
+  Bytecount storage_size = malloced_storage_size (0, per_block, 0);
+  while (size >= per_block)
+    {
+      size -= per_block;
+      overhead += storage_size - per_block;
+    }
+  if (rand () % per_block < size)
+    overhead += storage_size - per_block;
+  return overhead;
+}
+#endif /* not NEW_GC */
+
+Bytecount
+lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
+{
+#ifndef NEW_GC
+  const struct lrecord_implementation *imp =
+    XRECORD_LHEADER_IMPLEMENTATION (obj);
+#endif /* not NEW_GC */
+  Bytecount size = lisp_object_size (obj);
+
+#ifdef NEW_GC
+  return mc_alloced_storage_size (size, ustats);
+#else
+  if (imp->frob_block_p)
+    {
+      Bytecount overhead =
+	/* #### Always using cons_block is incorrect but close; only
+	   string_chars_block is significantly different in size, and
+	   it won't ever be seen in this function */
+	fixed_type_block_overhead (size, sizeof (struct cons_block));
+      if (ustats)
+	{
+	  ustats->was_requested += size;
+	  ustats->malloc_overhead += overhead;
+	}
+      return size + overhead;
+    }
+  else
+    return malloced_storage_size (XPNTR (obj), size, ustats);
+#endif
+}
+
+
+/************************************************************************/
+/*                  Allocation Statistics: Accumulate                   */
+/************************************************************************/
+
+#ifdef NEW_GC
+
+void
+init_lrecord_stats (void)
+{
+  xzero (lrecord_stats);
+}
+
+void
+inc_lrecord_stats (Bytecount size, const struct lrecord_header *h)
+{
+  int type_index = h->type;
+  if (!size)
+    size = detagged_lisp_object_size (h);
+
+  lrecord_stats[type_index].instances_in_use++;
+  lrecord_stats[type_index].bytes_in_use += size;
+  lrecord_stats[type_index].bytes_in_use_including_overhead
 #ifdef MEMORY_USAGE_STATS
-  Bytecount nonlisp_bytes_in_use;
-  struct generic_usage_stats stats;
-#endif
-} lrecord_stats [countof (lrecord_implementations_table)];
+    += mc_alloced_storage_size (size, 0);
+#else /* not MEMORY_USAGE_STATS */
+    += size;
+#endif /* not MEMORY_USAGE_STATS */
+}
+
+void
+dec_lrecord_stats (Bytecount size_including_overhead, 
+		   const struct lrecord_header *h)
+{
+  int type_index = h->type;
+  int size = detagged_lisp_object_size (h);
+
+  lrecord_stats[type_index].instances_in_use--;
+  lrecord_stats[type_index].bytes_in_use -= size;
+  lrecord_stats[type_index].bytes_in_use_including_overhead
+    -= size_including_overhead;
+
+  DECREMENT_CONS_COUNTER (size);
+}
+
+int
+lrecord_stats_heap_size (void)
+{
+  int i;
+  int size = 0;
+  for (i = 0; i < countof (lrecord_implementations_table); i++)
+    size += lrecord_stats[i].bytes_in_use;
+  return size;
+}
+
+#else /* not NEW_GC */
 
 static void
 clear_lrecord_stats (void)
@@ -3705,7 +3866,547 @@
     tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
 }
 
+#endif /* (not) NEW_GC */
+
+void
+finish_object_memory_usage_stats (void)
+{
+  /* Here we add up the aggregate values for each statistic, previously
+     computed during tick_lrecord_stats(), to get a single combined value
+     of non-Lisp memory usage for all objects of each type.  We can't
+     do this if NEW_GC because nothing like tick_lrecord_stats() gets
+     called -- instead, statistics are computed when objects are allocated,
+     which is too early to be calling the memory_usage() method. */
+#if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC)
+  int i;
+  for (i = 0; i < countof (lrecord_implementations_table); i++)
+    {
+      struct lrecord_implementation *imp = lrecord_implementations_table[i];
+      if (imp && imp->num_extra_nonlisp_memusage_stats)
+	{
+	  int j;
+	  for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++)
+	    lrecord_stats[i].nonlisp_bytes_in_use +=
+	      lrecord_stats[i].stats.othervals[j];
+	}
+      if (imp && imp->num_extra_lisp_ancillary_memusage_stats)
+	{
+	  int j;
+	  for (j = 0; j < imp->num_extra_lisp_ancillary_memusage_stats; j++)
+	    lrecord_stats[i].lisp_ancillary_bytes_in_use +=
+	      lrecord_stats[i].stats.othervals
+	      [j + imp->offset_lisp_ancillary_memusage_stats];
+	}
+    }
+#endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */
+}
+
+#define COUNT_FROB_BLOCK_USAGE(type)					\
+  EMACS_INT s = 0;							\
+  EMACS_INT s_overhead = 0;						\
+  struct type##_block *x = current_##type##_block;			\
+  while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; }	\
+  s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \
+  DO_NOTHING
+
+#define COPY_INTO_LRECORD_STATS(type)				\
+do {								\
+  COUNT_FROB_BLOCK_USAGE (type);				\
+  lrecord_stats[lrecord_type_##type].bytes_in_use += s;		\
+  lrecord_stats[lrecord_type_##type].bytes_in_use_overhead +=	\
+    s_overhead;							\
+  lrecord_stats[lrecord_type_##type].instances_on_free_list +=	\
+    gc_count_num_##type##_freelist;				\
+  lrecord_stats[lrecord_type_##type].instances_in_use +=	\
+    gc_count_num_##type##_in_use;				\
+} while (0)
+
+
+/************************************************************************/
+/*                 Allocation statistics: format nicely                 */
+/************************************************************************/
+
+static Lisp_Object
+gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail)
+{
+  /* C doesn't have local functions (or closures, or GC, or readable syntax,
+     or portable numeric datatypes, or bit-vectors, or characters, or
+     arrays, or exceptions, or ...) */
+  return cons3 (intern (name), make_int (value), tail);
+}
+
+/* Pluralize a lowercase English word stored in BUF, assuming BUF has
+   enough space to hold the extra letters (at most 2). */
+static void
+pluralize_word (Ascbyte *buf)
+{
+  Bytecount len = strlen (buf);
+  int upper = 0;
+  Ascbyte d, e;
+
+  if (len == 0 || len == 1)
+    goto pluralize_apostrophe_s;
+  e = buf[len - 1];
+  d = buf[len - 2];
+  upper = isupper (e);
+  e = tolower (e);
+  d = tolower (d);
+  if (e == 'y')
+    {
+      switch (d)
+	{
+	case 'a':
+	case 'e':
+	case 'i':
+	case 'o':
+	case 'u':
+	  goto pluralize_s;
+	default:
+	  buf[len - 1] = (upper ? 'I' : 'i');
+	  goto pluralize_es;
+	}
+    }
+  else if (e == 's' || e == 'x' || (e == 'h' && (d == 's' || d == 'c')))
+    {
+      pluralize_es:
+      buf[len++] = (upper ? 'E' : 'e');
+    }
+  pluralize_s:
+  buf[len++] = (upper ? 'S' : 's');
+  buf[len] = '\0';
+  return;
+
+  pluralize_apostrophe_s:
+  buf[len++] = '\'';
+  goto pluralize_s;
+}
+
+static void
+pluralize_and_append (Ascbyte *buf, const Ascbyte *name, const Ascbyte *suffix)
+{
+  strcpy (buf, name);
+  pluralize_word (buf);
+  strcat (buf, suffix);
+}
+
+static Lisp_Object
+object_memory_usage_stats (int set_total_gc_usage)
+{
+  Lisp_Object pl = Qnil;
+  int i;
+  EMACS_INT tgu_val = 0;
+
+#ifdef NEW_GC
+  for (i = 0; i < countof (lrecord_implementations_table); i++)
+    {
+      if (lrecord_stats[i].instances_in_use != 0)
+        {
+          Ascbyte buf[255];
+          const Ascbyte *name = lrecord_implementations_table[i]->name;
+
+	  if (lrecord_stats[i].bytes_in_use_including_overhead != 
+	      lrecord_stats[i].bytes_in_use)
+	    {
+	      sprintf (buf, "%s-storage-including-overhead", name);
+	      pl = gc_plist_hack (buf, 
+				  lrecord_stats[i]
+				  .bytes_in_use_including_overhead,
+				  pl);
+	    }
+	  
+	  sprintf (buf, "%s-storage", name);
+	  pl = gc_plist_hack (buf, 
+			      lrecord_stats[i].bytes_in_use,
+			      pl);
+	  tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
+
+	  pluralize_and_append (buf, name, "-used");
+	  pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
+        }
+    }
+
+#else /* not NEW_GC */
+
+  for (i = 0; i < lrecord_type_count; i++)
+    {
+      if (lrecord_stats[i].bytes_in_use != 0
+          || lrecord_stats[i].bytes_freed != 0
+	  || lrecord_stats[i].instances_on_free_list != 0)
+        {
+          Ascbyte buf[255];
+          const Ascbyte *name = lrecord_implementations_table[i]->name;
+
+          sprintf (buf, "%s-storage-overhead", name);
+          pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl);
+	  tgu_val += lrecord_stats[i].bytes_in_use_overhead;
+          sprintf (buf, "%s-storage", name);
+          pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
+	  tgu_val += lrecord_stats[i].bytes_in_use;
+#ifdef MEMORY_USAGE_STATS
+	  if (lrecord_stats[i].nonlisp_bytes_in_use)
+	    {
+	      sprintf (buf, "%s-non-lisp-storage", name);
+	      pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use,
+				  pl);
+	      tgu_val += lrecord_stats[i].nonlisp_bytes_in_use;
+	    }
+	  if (lrecord_stats[i].lisp_ancillary_bytes_in_use)
+	    {
+	      sprintf (buf, "%s-lisp-ancillary-storage", name);
+	      pl = gc_plist_hack (buf, lrecord_stats[i].
+				  lisp_ancillary_bytes_in_use,
+				  pl);
+	      tgu_val += lrecord_stats[i].lisp_ancillary_bytes_in_use;
+	    }
+#endif /* MEMORY_USAGE_STATS */
+	  pluralize_and_append (buf, name, "-freed");
+          if (lrecord_stats[i].instances_freed != 0)
+            pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
+	  pluralize_and_append (buf, name, "-on-free-list");
+          if (lrecord_stats[i].instances_on_free_list != 0)
+            pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list,
+				pl);
+	  pluralize_and_append (buf, name, "-used");
+          pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
+        }
+    }
+
+  pl = gc_plist_hack ("long-string-chars-storage-overhead",
+                      gc_count_long_string_storage_including_overhead -
+		      (gc_count_string_total_size
+		       - gc_count_short_string_total_size), pl);
+  pl = gc_plist_hack ("long-string-chars-storage",
+                      gc_count_string_total_size
+		      - gc_count_short_string_total_size, pl);
+  do
+    {
+      COUNT_FROB_BLOCK_USAGE (string_chars);
+      tgu_val += s + s_overhead;
+      pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl);
+      pl = gc_plist_hack ("short-string-chars-storage", s, pl);
+    }
+  while (0);
+
+  pl = gc_plist_hack ("long-strings-total-length",
+                      gc_count_string_total_size
+		      - gc_count_short_string_total_size, pl);
+  pl = gc_plist_hack ("short-strings-total-length",
+                      gc_count_short_string_total_size, pl);
+  pl = gc_plist_hack ("long-strings-used",
+                      gc_count_num_string_in_use
+		      - gc_count_num_short_string_in_use, pl);
+  pl = gc_plist_hack ("short-strings-used",
+                      gc_count_num_short_string_in_use, pl);
+
+#endif /* NEW_GC */
+
+  if (set_total_gc_usage)
+    {
+      total_gc_usage = tgu_val;
+      total_gc_usage_set = 1;
+    }
+
+  return pl;
+}
+
+static Lisp_Object
+garbage_collection_statistics (void)
+{
+  /* The things we do for backwards-compatibility */
+#ifdef NEW_GC
+  return
+    list6 
+    (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
+	    make_int (lrecord_stats[lrecord_type_cons]
+		      .bytes_in_use_including_overhead)),
+     Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
+	    make_int (lrecord_stats[lrecord_type_symbol]
+		      .bytes_in_use_including_overhead)),
+     Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
+	    make_int (lrecord_stats[lrecord_type_marker]
+		      .bytes_in_use_including_overhead)),
+     make_int (lrecord_stats[lrecord_type_string]
+	       .bytes_in_use_including_overhead),
+     make_int (lrecord_stats[lrecord_type_vector]
+	       .bytes_in_use_including_overhead),
+     object_memory_usage_stats (1));
+#else /* not NEW_GC */
+  return
+    list6 (Fcons (make_int (gc_count_num_cons_in_use),
+		  make_int (gc_count_num_cons_freelist)),
+	   Fcons (make_int (gc_count_num_symbol_in_use),
+		  make_int (gc_count_num_symbol_freelist)),
+	   Fcons (make_int (gc_count_num_marker_in_use),
+		  make_int (gc_count_num_marker_freelist)),
+	   make_int (gc_count_string_total_size),
+	   make_int (lrecord_stats[lrecord_type_vector].bytes_in_use +
+		     lrecord_stats[lrecord_type_vector].bytes_freed +
+		     lrecord_stats[lrecord_type_vector].bytes_on_free_list),
+	   object_memory_usage_stats (1));
 #endif /* not NEW_GC */
+}
+
+DEFUN ("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0, 0, /*
+Return statistics about memory usage of Lisp objects.
+*/
+       ())
+{
+  return object_memory_usage_stats (0);
+}
+
+#endif /* ALLOC_TYPE_STATS */
+
+#ifdef MEMORY_USAGE_STATS
+
+DEFUN ("object-memory-usage", Fobject_memory_usage, 1, 1, 0, /*
+Return stats about the memory usage of OBJECT.
+The values returned are in the form of an alist of usage types and byte
+counts.  The byte counts attempt to encompass all the memory used
+by the object (separate from the memory logically associated with any
+other object), including internal structures and any malloc()
+overhead associated with them.  In practice, the byte counts are
+underestimated because certain memory usage is very hard to determine
+\(e.g. the amount of memory used inside the Xt library or inside the
+X server).
+
+Multiple slices of the total memory usage may be returned, separated
+by a nil.  Each slice represents a particular view of the memory, a
+particular way of partitioning it into groups.  Within a slice, there
+is no overlap between the groups of memory, and each slice collectively
+represents all the memory concerned.  The rightmost slice typically
+represents the total memory used plus malloc and dynarr overhead.
+
+Slices describing other Lisp objects logically associated with the
+object may be included, separated from other slices by `t' and from
+each other by nil if there is more than one.
+
+#### We have to figure out how to handle the memory used by the object
+itself vs. the memory used by substructures.  Probably the memory_usage
+method should return info only about substructures and related Lisp
+objects, since the caller can always find and all info about the object
+itself.
+*/
+       (object))
+{
+  struct generic_usage_stats gustats;
+  struct usage_stats object_stats;
+  int i;
+  Lisp_Object val = Qnil;
+  Lisp_Object stats_list;
+
+  if (INTP (object) || CHARP (object))
+    invalid_argument ("No memory associated with immediate objects (int or char)",
+		      object);
+
+  stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
+
+  xzero (object_stats);
+  lisp_object_storage_size (object, &object_stats);
+
+  val = acons (Qobject_actually_requested,
+	       make_int (object_stats.was_requested), val);
+  val = acons (Qobject_malloc_overhead,
+	       make_int (object_stats.malloc_overhead), val);
+  assert (!object_stats.dynarr_overhead);
+  assert (!object_stats.gap_overhead);
+
+  if (!NILP (stats_list))
+    {
+      xzero (gustats);
+      MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
+
+      val = Fcons (Qt, val);
+      val = acons (Qother_memory_actually_requested,
+		   make_int (gustats.u.was_requested), val);
+      val = acons (Qother_memory_malloc_overhead,
+		   make_int (gustats.u.malloc_overhead), val);
+      if (gustats.u.dynarr_overhead)
+	val = acons (Qother_memory_dynarr_overhead,
+		     make_int (gustats.u.dynarr_overhead), val);
+      if (gustats.u.gap_overhead)
+	val = acons (Qother_memory_gap_overhead,
+		     make_int (gustats.u.gap_overhead), val);
+      val = Fcons (Qnil, val);
+
+      i = 0;
+      {
+	LIST_LOOP_2 (item, stats_list)
+	  {
+	    if (NILP (item) || EQ (item, Qt))
+	      val = Fcons (item, val);
+	    else
+	      {
+		val = acons (item, make_int (gustats.othervals[i]), val);
+		i++;
+	      }
+	  }
+      }
+    }
+
+  return Fnreverse (val);
+}
+
+/* Compute total memory usage associated with an object, including
+
+   (a) Storage (including overhead) allocated to the object itself
+   (b) Storage (including overhead) for ancillary non-Lisp structures attached
+       to the object
+   (c) Storage (including overhead) for ancillary Lisp objects attached
+       to the object
+
+   Store the three types of memory into the return values provided they
+   aren't NULL, and return a sum of the three values.  Also store the
+   structure of individual statistics into STATS if non-zero.
+
+   Note that the value for type (c) is the sum of all three types of
+   memory associated with the ancillary Lisp objects.
+*/
+
+Bytecount
+lisp_object_memory_usage_full (Lisp_Object object, Bytecount *storage_size,
+			       Bytecount *extra_nonlisp_storage,
+			       Bytecount *extra_lisp_ancillary_storage,
+			       struct generic_usage_stats *stats)
+{
+  Bytecount total;
+  struct lrecord_implementation *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
+
+  total = lisp_object_storage_size (object, NULL);
+  if (storage_size)
+    *storage_size = total;
+
+  if (HAS_OBJECT_METH_P (object, memory_usage))
+    {
+      int i;
+      struct generic_usage_stats gustats;
+      Bytecount sum;
+
+      xzero (gustats);
+      OBJECT_METH (object, memory_usage, (object, &gustats));
+
+      if (stats)
+	*stats = gustats;
+
+      sum = 0;
+      for (i = 0; i < imp->num_extra_nonlisp_memusage_stats; i++)
+	sum += gustats.othervals[i];
+      total += sum;
+      if (extra_nonlisp_storage)
+	*extra_nonlisp_storage = sum;
+
+      sum = 0;
+      for (i = 0; i < imp->num_extra_lisp_ancillary_memusage_stats; i++)
+	sum += gustats.othervals[imp->offset_lisp_ancillary_memusage_stats +
+				 i];
+      total += sum;
+      if (extra_lisp_ancillary_storage)
+	*extra_lisp_ancillary_storage = sum;
+    }
+  else
+    {
+      if (extra_nonlisp_storage)
+	*extra_nonlisp_storage = 0;
+      if (extra_lisp_ancillary_storage)
+	*extra_lisp_ancillary_storage = 0;
+    }
+
+  return total;
+}
+
+
+Bytecount
+lisp_object_memory_usage (Lisp_Object object)
+{
+  return lisp_object_memory_usage_full (object, NULL, NULL, NULL, NULL);
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+#ifdef ALLOC_TYPE_STATS
+
+DEFUN ("total-object-memory-usage", Ftotal_object_memory_usage, 0, 0, 0, /*
+Return total number of bytes used for object storage in XEmacs.
+This may be helpful in debugging XEmacs's memory usage.
+See also `consing-since-gc' and `object-memory-usage-stats'.
+*/
+       ())
+{
+  return make_int (total_gc_usage + consing_since_gc);
+}
+
+#endif /* ALLOC_TYPE_STATS */
+
+
+/************************************************************************/
+/*                Allocation statistics: Initialization                 */
+/************************************************************************/
+#ifdef MEMORY_USAGE_STATS
+
+/* Compute the number of extra memory-usage statistics associated with an
+   object.  We can't compute this at the time INIT_LISP_OBJECT() is called
+   because the value of the `memusage_stats_list' property is generally
+   set afterwards.  So we compute the values for all types of objects
+   after all objects have been initialized. */
+
+static void
+compute_memusage_stats_length (void)
+{
+  int i;
+
+  for (i = 0; i < countof (lrecord_implementations_table); i++)
+    {
+      struct lrecord_implementation *imp = lrecord_implementations_table[i];
+
+      if (!imp)
+	continue;
+      /* For some of the early objects, Qnil was not yet initialized at
+	 the time of object initialization, so it came up as Qnull_pointer.
+	 Fix that now. */
+      if (EQ (imp->memusage_stats_list, Qnull_pointer))
+	imp->memusage_stats_list = Qnil;
+      {
+	Elemcount len = 0;
+	Elemcount nonlisp_len = 0;
+	Elemcount lisp_len = 0;
+	Elemcount lisp_offset = 0;
+	int group_num = 0;
+	int slice_num = 0;
+
+	LIST_LOOP_2 (item, imp->memusage_stats_list)
+	  {
+	    if (EQ (item, Qt))
+	      {
+		group_num++;
+		if (group_num == 1)
+		  lisp_offset = len;
+		slice_num = 0;
+	      }
+	    else if (EQ (item, Qnil))
+	      {
+		slice_num++;
+	      }
+	    else
+	      {
+		if (slice_num == 0)
+		  {
+		    if (group_num == 0)
+		      nonlisp_len++;
+		    else if (group_num == 1)
+		      lisp_len++;
+		  }
+		len++;
+	      }
+	  }
+
+	imp->num_extra_memusage_stats = len;
+	imp->num_extra_nonlisp_memusage_stats = nonlisp_len;
+	imp->num_extra_lisp_ancillary_memusage_stats = lisp_len;
+	imp->offset_lisp_ancillary_memusage_stats = lisp_offset;
+      }
+    }
+}
+
+#endif /* MEMORY_USAGE_STATS */
 
 
 /************************************************************************/
@@ -3772,32 +4473,9 @@
   /* *total = total_size; */
 }
 
-static Bytecount fixed_type_block_overhead (Bytecount size,
-					    Bytecount per_block);
-
 /* And the Lord said: Thou shalt use the `c-backslash-region' command
    to make macros prettier. */
 
-#define COUNT_FROB_BLOCK_USAGE(type)					\
-  EMACS_INT s = 0;							\
-  EMACS_INT s_overhead = 0;						\
-  struct type##_block *x = current_##type##_block;			\
-  while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; }	\
-  s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \
-  DO_NOTHING
-
-#define COPY_INTO_LRECORD_STATS(type)				\
-do {								\
-  COUNT_FROB_BLOCK_USAGE (type);				\
-  lrecord_stats[lrecord_type_##type].bytes_in_use += s;		\
-  lrecord_stats[lrecord_type_##type].bytes_in_use_overhead +=	\
-    s_overhead;							\
-  lrecord_stats[lrecord_type_##type].instances_on_free_list +=	\
-    gc_count_num_##type##_freelist;				\
-  lrecord_stats[lrecord_type_##type].instances_in_use +=	\
-    gc_count_num_##type##_in_use;				\
-} while (0)
-
 #ifdef ERROR_CHECK_GC
 
 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader)		\
@@ -4570,6 +5248,31 @@
 /*           "Disksave Finalization" -- Preparing for Dumping           */
 /************************************************************************/
 
+static void
+disksave_object_finalization_1 (void)
+{
+#ifdef NEW_GC
+  mc_finalize_for_disksave ();
+#else /* not NEW_GC */
+  struct old_lcrecord_header *header;
+
+  for (header = all_lcrecords; header; header = header->next)
+    {
+      struct lrecord_header *objh = &header->lheader;
+      const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
+#if 0 /* possibly useful for debugging */
+      if (!RECORD_DUMPABLE (objh) && !objh->free)
+	{
+	  stderr_out ("Disksaving a non-dumpable object: ");
+	  debug_print (wrap_pointer_1 (header));
+	}
+#endif
+      if (imp->disksave && !objh->free)
+	(imp->disksave) (wrap_pointer_1 (header));
+    }
+#endif /* not NEW_GC */
+}
+
 void
 disksave_object_finalization (void)
 {
@@ -4636,348 +5339,10 @@
 
 }
 
-#ifdef ALLOC_TYPE_STATS
-
-static Lisp_Object
-gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail)
-{
-  /* C doesn't have local functions (or closures, or GC, or readable syntax,
-     or portable numeric datatypes, or bit-vectors, or characters, or
-     arrays, or exceptions, or ...) */
-  return cons3 (intern (name), make_int (value), tail);
-}
-
-/* Pluralize a lowercase English word stored in BUF, assuming BUF has
-   enough space to hold the extra letters (at most 2). */
-static void
-pluralize_word (Ascbyte *buf)
-{
-  Bytecount len = strlen (buf);
-  int upper = 0;
-  Ascbyte d, e;
-
-  if (len == 0 || len == 1)
-    goto pluralize_apostrophe_s;
-  e = buf[len - 1];
-  d = buf[len - 2];
-  upper = isupper (e);
-  e = tolower (e);
-  d = tolower (d);
-  if (e == 'y')
-    {
-      switch (d)
-	{
-	case 'a':
-	case 'e':
-	case 'i':
-	case 'o':
-	case 'u':
-	  goto pluralize_s;
-	default:
-	  buf[len - 1] = (upper ? 'I' : 'i');
-	  goto pluralize_es;
-	}
-    }
-  else if (e == 's' || e == 'x' || (e == 'h' && (d == 's' || d == 'c')))
-    {
-      pluralize_es:
-      buf[len++] = (upper ? 'E' : 'e');
-    }
-  pluralize_s:
-  buf[len++] = (upper ? 'S' : 's');
-  buf[len] = '\0';
-  return;
-
-  pluralize_apostrophe_s:
-  buf[len++] = '\'';
-  goto pluralize_s;
-}
-
-static void
-pluralize_and_append (Ascbyte *buf, const Ascbyte *name, const Ascbyte *suffix)
-{
-  strcpy (buf, name);
-  pluralize_word (buf);
-  strcat (buf, suffix);
-}
-
-void
-finish_object_memory_usage_stats (void)
-{
-  /* Here we add up the aggregate values for each statistic, previously
-     computed during tick_lrecord_stats(), to get a single combined value
-     of non-Lisp memory usage for all objects of each type.  We can't
-     do this if NEW_GC because nothing like tick_lrecord_stats() gets
-     called -- instead, statistics are computed when objects are allocated,
-     which is too early to be calling the memory_usage() method. */
-#if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC)
-  int i;
-  for (i = 0; i < countof (lrecord_implementations_table); i++)
-    {
-      struct lrecord_implementation *imp = lrecord_implementations_table[i];
-      if (imp && imp->num_extra_nonlisp_memusage_stats)
-	{
-	  int j;
-	  for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++)
-	    lrecord_stats[i].nonlisp_bytes_in_use +=
-	      lrecord_stats[i].stats.othervals[j];
-	}
-    }
-#endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */
-}
-
-static Lisp_Object
-object_memory_usage_stats (int set_total_gc_usage)
-{
-  Lisp_Object pl = Qnil;
-  int i;
-  EMACS_INT tgu_val = 0;
-
-#ifdef NEW_GC
-  for (i = 0; i < countof (lrecord_implementations_table); i++)
-    {
-      if (lrecord_stats[i].instances_in_use != 0)
-        {
-          Ascbyte buf[255];
-          const Ascbyte *name = lrecord_implementations_table[i]->name;
-
-	  if (lrecord_stats[i].bytes_in_use_including_overhead != 
-	      lrecord_stats[i].bytes_in_use)
-	    {
-	      sprintf (buf, "%s-storage-including-overhead", name);
-	      pl = gc_plist_hack (buf, 
-				  lrecord_stats[i]
-				  .bytes_in_use_including_overhead,
-				  pl);
-	    }
-	  
-	  sprintf (buf, "%s-storage", name);
-	  pl = gc_plist_hack (buf, 
-			      lrecord_stats[i].bytes_in_use,
-			      pl);
-	  tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
-
-	  pluralize_and_append (buf, name, "-used");
-	  pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
-        }
-    }
-
-#else /* not NEW_GC */
-
-  for (i = 0; i < lrecord_type_count; i++)
-    {
-      if (lrecord_stats[i].bytes_in_use != 0
-          || lrecord_stats[i].bytes_freed != 0
-	  || lrecord_stats[i].instances_on_free_list != 0)
-        {
-          Ascbyte buf[255];
-          const Ascbyte *name = lrecord_implementations_table[i]->name;
-
-          sprintf (buf, "%s-storage-overhead", name);
-          pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl);
-	  tgu_val += lrecord_stats[i].bytes_in_use_overhead;
-          sprintf (buf, "%s-storage", name);
-          pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
-	  tgu_val += lrecord_stats[i].bytes_in_use;
-#ifdef MEMORY_USAGE_STATS
-	  if (lrecord_stats[i].nonlisp_bytes_in_use)
-	    {
-	      sprintf (buf, "%s-non-lisp-storage", name);
-	      pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use,
-				  pl);
-	      tgu_val += lrecord_stats[i].nonlisp_bytes_in_use;
-	    }
-#endif /* MEMORY_USAGE_STATS */
-	  pluralize_and_append (buf, name, "-freed");
-          if (lrecord_stats[i].instances_freed != 0)
-            pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
-	  pluralize_and_append (buf, name, "-on-free-list");
-          if (lrecord_stats[i].instances_on_free_list != 0)
-            pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list,
-				pl);
-	  pluralize_and_append (buf, name, "-used");
-          pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
-        }
-    }
-
-  pl = gc_plist_hack ("long-string-chars-storage-overhead",
-                      gc_count_long_string_storage_including_overhead -
-		      (gc_count_string_total_size
-		       - gc_count_short_string_total_size), pl);
-  pl = gc_plist_hack ("long-string-chars-storage",
-                      gc_count_string_total_size
-		      - gc_count_short_string_total_size, pl);
-  do
-    {
-      COUNT_FROB_BLOCK_USAGE (string_chars);
-      tgu_val += s + s_overhead;
-      pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl);
-      pl = gc_plist_hack ("short-string-chars-storage", s, pl);
-    }
-  while (0);
-
-  pl = gc_plist_hack ("long-strings-total-length",
-                      gc_count_string_total_size
-		      - gc_count_short_string_total_size, pl);
-  pl = gc_plist_hack ("short-strings-total-length",
-                      gc_count_short_string_total_size, pl);
-  pl = gc_plist_hack ("long-strings-used",
-                      gc_count_num_string_in_use
-		      - gc_count_num_short_string_in_use, pl);
-  pl = gc_plist_hack ("short-strings-used",
-                      gc_count_num_short_string_in_use, pl);
-
-#endif /* NEW_GC */
-
-  if (set_total_gc_usage)
-    {
-      total_gc_usage = tgu_val;
-      total_gc_usage_set = 1;
-    }
-
-  return pl;
-}
-
-DEFUN ("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0, 0, /*
-Return statistics about memory usage of Lisp objects.
-*/
-       ())
-{
-  return object_memory_usage_stats (0);
-}
-
-#endif /* ALLOC_TYPE_STATS */
-
-#ifdef MEMORY_USAGE_STATS
-
-/* Compute the number of extra memory-usage statistics associated with an
-   object.  We can't compute this at the time INIT_LISP_OBJECT() is called
-   because the value of the `memusage_stats_list' property is generally
-   set afterwards.  So we compute the values for all types of objects
-   after all objects have been initialized. */
-
-static void
-compute_memusage_stats_length (void)
-{
-  int i;
-
-  for (i = 0; i < countof (lrecord_implementations_table); i++)
-    {
-      int len = 0;
-      int nonlisp_len = 0;
-      int seen_break = 0;
-
-      struct lrecord_implementation *imp = lrecord_implementations_table[i];
-
-      if (!imp)
-	continue;
-      /* For some of the early objects, Qnil was not yet initialized at
-	 the time of object initialization, so it came up as Qnull_pointer.
-	 Fix that now. */
-      if (EQ (imp->memusage_stats_list, Qnull_pointer))
-	imp->memusage_stats_list = Qnil;
-      {
-	LIST_LOOP_2 (item, imp->memusage_stats_list)
-	  {
-	    if (!NILP (item) && !EQ (item, Qt))
-	      {
-		len++;
-		if (!seen_break)
-		  nonlisp_len++;
-	      }
-	    else
-	      seen_break++;
-	  }
-      }
-
-      imp->num_extra_memusage_stats = len;
-      imp->num_extra_nonlisp_memusage_stats = nonlisp_len;
-    }
-}
-
-DEFUN ("object-memory-usage", Fobject_memory_usage, 1, 1, 0, /*
-Return stats about the memory usage of OBJECT.
-The values returned are in the form of an alist of usage types and byte
-counts.  The byte counts attempt to encompass all the memory used
-by the object (separate from the memory logically associated with any
-other object), including internal structures and any malloc()
-overhead associated with them.  In practice, the byte counts are
-underestimated because certain memory usage is very hard to determine
-\(e.g. the amount of memory used inside the Xt library or inside the
-X server).
-
-Multiple slices of the total memory usage may be returned, separated
-by a nil.  Each slice represents a particular view of the memory, a
-particular way of partitioning it into groups.  Within a slice, there
-is no overlap between the groups of memory, and each slice collectively
-represents all the memory concerned.  The rightmost slice typically
-represents the total memory used plus malloc and dynarr overhead.
-
-Slices describing other Lisp objects logically associated with the
-object may be included, separated from other slices by `t' and from
-each other by nil if there is more than one.
-
-#### We have to figure out how to handle the memory used by the object
-itself vs. the memory used by substructures.  Probably the memory_usage
-method should return info only about substructures and related Lisp
-objects, since the caller can always find and all info about the object
-itself.
-*/
-       (object))
-{
-  struct generic_usage_stats gustats;
-  struct usage_stats object_stats;
-  int i;
-  Lisp_Object val = Qnil;
-  Lisp_Object stats_list = OBJECT_PROPERTY (object, memusage_stats_list);
-
-  xzero (object_stats);
-  lisp_object_storage_size (object, &object_stats);
-
-  val = acons (Qobject_actually_requested,
-	       make_int (object_stats.was_requested), val);
-  val = acons (Qobject_malloc_overhead,
-	       make_int (object_stats.malloc_overhead), val);
-  assert (!object_stats.dynarr_overhead);
-  assert (!object_stats.gap_overhead);
-
-  if (!NILP (stats_list))
-    {
-      xzero (gustats);
-      MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
-
-      val = Fcons (Qt, val);
-      val = acons (Qother_memory_actually_requested,
-		   make_int (gustats.u.was_requested), val);
-      val = acons (Qother_memory_malloc_overhead,
-		   make_int (gustats.u.malloc_overhead), val);
-      if (gustats.u.dynarr_overhead)
-	val = acons (Qother_memory_dynarr_overhead,
-		     make_int (gustats.u.dynarr_overhead), val);
-      if (gustats.u.gap_overhead)
-	val = acons (Qother_memory_gap_overhead,
-		     make_int (gustats.u.gap_overhead), val);
-      val = Fcons (Qnil, val);
-
-      i = 0;
-      {
-	LIST_LOOP_2 (item, stats_list)
-	  {
-	    if (NILP (item) || EQ (item, Qt))
-	      val = Fcons (item, val);
-	    else
-	      {
-		val = acons (item, make_int (gustats.othervals[i]), val);
-		i++;
-	      }
-	  }
-      }
-    }
-
-  return Fnreverse (val);
-}
-
-#endif /* MEMORY_USAGE_STATS */
+
+/************************************************************************/
+/*                Lisp interface onto garbage collection                */
+/************************************************************************/
 
 /* Debugging aids.  */
 
@@ -5005,41 +5370,10 @@
      call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */
   total_gc_usage_set = 0;
 #ifdef ALLOC_TYPE_STATS
-  /* The things we do for backwards-compatibility */
-#ifdef NEW_GC
-  return
-    list6 
-    (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
-	    make_int (lrecord_stats[lrecord_type_cons]
-		      .bytes_in_use_including_overhead)),
-     Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
-	    make_int (lrecord_stats[lrecord_type_symbol]
-		      .bytes_in_use_including_overhead)),
-     Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
-	    make_int (lrecord_stats[lrecord_type_marker]
-		      .bytes_in_use_including_overhead)),
-     make_int (lrecord_stats[lrecord_type_string]
-	       .bytes_in_use_including_overhead),
-     make_int (lrecord_stats[lrecord_type_vector]
-	       .bytes_in_use_including_overhead),
-     object_memory_usage_stats (1));
-#else /* not NEW_GC */
-  return
-    list6 (Fcons (make_int (gc_count_num_cons_in_use),
-		  make_int (gc_count_num_cons_freelist)),
-	   Fcons (make_int (gc_count_num_symbol_in_use),
-		  make_int (gc_count_num_symbol_freelist)),
-	   Fcons (make_int (gc_count_num_marker_in_use),
-		  make_int (gc_count_num_marker_freelist)),
-	   make_int (gc_count_string_total_size),
-	   make_int (lrecord_stats[lrecord_type_vector].bytes_in_use +
-		     lrecord_stats[lrecord_type_vector].bytes_freed +
-		     lrecord_stats[lrecord_type_vector].bytes_on_free_list),
-	   object_memory_usage_stats (1));
-#endif /* not NEW_GC */
-#else /* not ALLOC_TYPE_STATS */
+  return garbage_collection_statistics ();
+#else
   return Qnil;
-#endif /* ALLOC_TYPE_STATS */
+#endif
 }
 
 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
@@ -5078,18 +5412,6 @@
   return make_int (total_data_usage ());
 }
 
-#ifdef ALLOC_TYPE_STATS
-DEFUN ("total-object-memory-usage", Ftotal_object_memory_usage, 0, 0, 0, /*
-Return total number of bytes used for object storage in XEmacs.
-This may be helpful in debugging XEmacs's memory usage.
-See also `consing-since-gc' and `object-memory-usage-stats'.
-*/
-       ())
-{
-  return make_int (total_gc_usage + consing_since_gc);
-}
-#endif /* ALLOC_TYPE_STATS */
-
 #ifdef USE_VALGRIND
 DEFUN ("valgrind-leak-check", Fvalgrind_leak_check, 0, 0, "", /*
 Ask valgrind to perform a memory leak check.
@@ -5113,170 +5435,6 @@
 }
 #endif /* USE_VALGRIND */
 
-void
-recompute_funcall_allocation_flag (void)
-{
-  funcall_allocation_flag =
-    need_to_garbage_collect ||
-    need_to_check_c_alloca ||
-    need_to_signal_post_gc;
-}
-
-int
-object_dead_p (Lisp_Object obj)
-{
-  return ((BUFFERP  (obj) && !BUFFER_LIVE_P  (XBUFFER  (obj))) ||
-	  (FRAMEP   (obj) && !FRAME_LIVE_P   (XFRAME   (obj))) ||
-	  (WINDOWP  (obj) && !WINDOW_LIVE_P  (XWINDOW  (obj))) ||
-	  (DEVICEP  (obj) && !DEVICE_LIVE_P  (XDEVICE  (obj))) ||
-	  (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) ||
-	  (EVENTP   (obj) && !EVENT_LIVE_P   (XEVENT   (obj))) ||
-	  (EXTENTP  (obj) && !EXTENT_LIVE_P  (XEXTENT  (obj))));
-}
-
-#ifdef ALLOC_TYPE_STATS
-
-/* Attempt to determine the actual amount of space that is used for
-   the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
-
-   It seems that the following holds:
-
-   1. When using the old allocator (malloc.c):
-
-      -- blocks are always allocated in chunks of powers of two.  For
-	 each block, there is an overhead of 8 bytes if rcheck is not
-	 defined, 20 bytes if it is defined.  In other words, a
-	 one-byte allocation needs 8 bytes of overhead for a total of
-	 9 bytes, and needs to have 16 bytes of memory chunked out for
-	 it.
-
-   2. When using the new allocator (gmalloc.c):
-
-      -- blocks are always allocated in chunks of powers of two up
-         to 4096 bytes.  Larger blocks are allocated in chunks of
-	 an integral multiple of 4096 bytes.  The minimum block
-         size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG
-	 is defined.  There is no per-block overhead, but there
-	 is an overhead of 3*sizeof (size_t) for each 4096 bytes
-	 allocated.
-
-    3. When using the system malloc, anything goes, but they are
-       generally slower and more space-efficient than the GNU
-       allocators.  One possibly reasonable assumption to make
-       for want of better data is that sizeof (void *), or maybe
-       2 * sizeof (void *), is required as overhead and that
-       blocks are allocated in the minimum required size except
-       that some minimum block size is imposed (e.g. 16 bytes). */
-
-Bytecount
-malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
-		       struct usage_stats *stats)
-{
-  Bytecount orig_claimed_size = claimed_size;
-
-#ifndef SYSTEM_MALLOC
-  if (claimed_size < (Bytecount) (2 * sizeof (void *)))
-    claimed_size = 2 * sizeof (void *);
-# ifdef SUNOS_LOCALTIME_BUG
-  if (claimed_size < 16)
-    claimed_size = 16;
-# endif
-  if (claimed_size < 4096)
-    {
-      /* fxg: rename log->log2 to supress gcc3 shadow warning */
-      int log2 = 1;
-
-      /* compute the log base two, more or less, then use it to compute
-	 the block size needed. */
-      claimed_size--;
-      /* It's big, it's heavy, it's wood! */
-      while ((claimed_size /= 2) != 0)
-	++log2;
-      claimed_size = 1;
-      /* It's better than bad, it's good! */
-      while (log2 > 0)
-        {
-	  claimed_size *= 2;
-          log2--;
-        }
-      /* We have to come up with some average about the amount of
-	 blocks used. */
-      if ((Bytecount) (rand () & 4095) < claimed_size)
-	claimed_size += 3 * sizeof (void *);
-    }
-  else
-    {
-      claimed_size += 4095;
-      claimed_size &= ~4095;
-      claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
-    }
-
-#else
-
-  if (claimed_size < 16)
-    claimed_size = 16;
-  claimed_size += 2 * sizeof (void *);
-
-#endif /* system allocator */
-
-  if (stats)
-    {
-      stats->was_requested += orig_claimed_size;
-      stats->malloc_overhead += claimed_size - orig_claimed_size;
-    }
-  return claimed_size;
-}
-
-#ifndef NEW_GC
-static Bytecount
-fixed_type_block_overhead (Bytecount size, Bytecount per_block)
-{
-  Bytecount overhead = 0;
-  Bytecount storage_size = malloced_storage_size (0, per_block, 0);
-  while (size >= per_block)
-    {
-      size -= per_block;
-      overhead += storage_size - per_block;
-    }
-  if (rand () % per_block < size)
-    overhead += storage_size - per_block;
-  return overhead;
-}
-#endif /* not NEW_GC */
-
-Bytecount
-lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
-{
-#ifndef NEW_GC
-  const struct lrecord_implementation *imp =
-    XRECORD_LHEADER_IMPLEMENTATION (obj);
-#endif /* not NEW_GC */
-  Bytecount size = lisp_object_size (obj);
-
-#ifdef NEW_GC
-  return mc_alloced_storage_size (size, ustats);
-#else
-  if (imp->frob_block_p)
-    {
-      Bytecount overhead =
-	/* #### Always using cons_block is incorrect but close; only
-	   string_chars_block is significantly different in size, and
-	   it won't ever be seen in this function */
-	fixed_type_block_overhead (size, sizeof (struct cons_block));
-      if (ustats)
-	{
-	  ustats->was_requested += size;
-	  ustats->malloc_overhead += overhead;
-	}
-      return size + overhead;
-    }
-  else
-    return malloced_storage_size (XPNTR (obj), size, ustats);
-#endif
-}
-
-#endif /* ALLOC_TYPE_STATS */
-
 
 /************************************************************************/
 /*                            Initialization                            */

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/array.c	Mon Mar 29 00:11:03 2010 -0500
@@ -0,0 +1,1009 @@
+/* Support for dynarrs and other types of dynamic arrays.
+   Copyright (c) 1994, 1995 Free Software Foundation, Inc.
+   Copyright (c) 1993, 1995 Sun Microsystems, Inc.
+   Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005, 2010 Ben Wing.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with:  Not in FSF. */
+
+/* Written by Ben Wing, December 1993. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "insdel.h"
+
+
+/*****************************************************************************/
+/*                       "dynarr" a.k.a. dynamic array                       */
+/*****************************************************************************/
+
+/*
+A "dynamic array" or "dynarr" is a contiguous array of fixed-size elements
+where there is no upper limit (except available memory) on the number of
+elements in the array.  Because the elements are maintained contiguously,
+space is used efficiently (no per-element pointers necessary) and random
+access to a particular element is in constant time.  At any one point, the
+block of memory that holds the array has an upper limit; if this limit is
+exceeded, the memory is realloc()ed into a new array that is twice as big.
+Assuming that the time to grow the array is on the order of the new size of
+the array block, this scheme has a provably constant amortized time
+\(i.e. average time over all additions).
+
+When you add elements or retrieve elements, pointers are used.  Note that
+the element itself (of whatever size it is), and not the pointer to it,
+is stored in the array; thus you do not have to allocate any heap memory
+on your own.  Also, returned pointers are only guaranteed to be valid
+until the next operation that changes the length of the array.
+
+This is a container object.  Declare a dynamic array of a specific type
+as follows:
+
+  typedef struct
+  {
+    Dynarr_declare (mytype);
+  } mytype_dynarr;
+
+Use the following functions/macros:
+
+
+  ************* Dynarr creation *************
+
+   void *Dynarr_new(type)
+      [MACRO] Create a new dynamic-array object, with each element of the
+      specified type.  The return value is cast to (type##_dynarr).
+      This requires following the convention that types are declared in
+      such a way that this type concatenation works.  In particular, TYPE
+      must be a symbol, not an arbitrary C type.  To make dynarrs of
+      complex types, a typedef must be declared, e.g.
+
+      typedef unsigned char *unsigned_char_ptr;
+
+      and then you can say
+
+      unsigned_char_ptr_dynarr *dyn = Dynarr_new (unsigned_char_ptr);
+
+   void *Dynarr_new2(dynarr_type, type)
+      [MACRO] Create a new dynamic-array object, with each element of the
+      specified type.  The array itself is of type DYNARR_TYPE.  This makes
+      it possible to create dynarrs over complex types without the need
+      to create typedefs, as described above.  Use is as follows:
+
+      ucharptr_dynarr *dyn = Dynarr_new2 (ucharptr_dynarr *, unsigned char *);
+
+   Dynarr_free(d)
+      Destroy a dynamic array and the memory allocated to it.
+
+  ************* Dynarr access *************
+
+   type Dynarr_at(d, i)
+      [MACRO] Return the element at the specified index.  The index must be
+      between 0 and Dynarr_largest(d), inclusive.  With error-checking
+      enabled, bounds checking on the index is in the form of asserts() --
+      an out-of-bounds index causes an abort.  The element itself is
+      returned, not a pointer to it.
+
+   type *Dynarr_atp(d, i)
+      [MACRO] Return a pointer to the element at the specified index.
+      Restrictions and bounds checking on the index is as for Dynarr_at.
+      The pointer may not be valid after an element is added to or
+      (conceivably) removed from the array, because this may trigger a
+      realloc() performed on the underlying dynarr storage, which may
+      involve moving the entire underlying storage to a new location in
+      memory.
+
+   type *Dynarr_begin(d)
+      [MACRO] Return a pointer to the first element in the dynarr.  See
+      Dynarr_atp() for warnings about when the pointer might become invalid.
+
+   type *Dynarr_lastp(d)
+      [MACRO] Return a pointer to the last element in the dynarr.  See
+      Dynarr_atp() for warnings about when the pointer might become invalid.
+
+   type *Dynarr_past_lastp(d)
+      [MACRO] Return a pointer to the beginning of the element just past the
+      last one.  WARNING: This may not point to valid memory; however, the
+      byte directly before will be pointer will be valid memory.  This macro
+      might be useful for various reasons, e.g. as a stopping point in a loop
+      (although Dynarr_lastp() could be used just as well) or as a place to
+      start writing elements if Dynarr_length() < Dynarr_largest().
+
+  ************* Dynarr length/size retrieval and setting *************
+
+   int Dynarr_length(d)
+      [MACRO] Return the number of elements currently in a dynamic array.
+
+   int Dynarr_largest(d)
+      [MACRO] Return the maximum value that Dynarr_length(d) would
+      ever have returned.  This is used esp. in the redisplay code,
+      which reuses dynarrs for performance reasons.
+
+   int Dynarr_max(d)
+      [MACRO] Return the maximum number of elements that can fit in the
+      dynarr before it needs to be resized.
+
+      Note that Dynarr_length(d) <= Dynarr_largest(d) <= Dynarr_max(d).
+   
+   Bytecount Dynarr_sizeof(d)
+      [MACRO] Return the total size of the elements currently in dynarr
+      D.  This 
+
+   Dynarr_set_lengthr(d, len)
+      [MACRO] Set the length of D to LEN, which must be between 0 and
+      Dynarr_largest(d), inclusive.  With error-checking enabled, an
+      assertion failure will result from trying to set the length
+      to less than zero or greater than Dynarr_largest(d).  The
+      restriction to Dynarr_largest() is to ensure that
+
+   Dynarr_set_length(d, len)
+      [MACRO] Set the length of D to LEN, resizing the dynarr as
+      necessary to make sure enough space is available.  there are no
+      restrictions on LEN other than available memory and that it must
+      be at least 0.  Note that
+
+   Dynarr_set_length_and_zero(d, len)
+      [MACRO] Like Dynarr_set_length(d, len) but also, if increasing
+      the length, zero out the memory between the old and new lengths,
+      i.e. starting just past the previous last element and up through
+      the new last element.
+
+   Dynarr_incrementr(d)
+      [MACRO] Increments the length of D by 1.  Equivalent to
+      Dynarr_set_lengthr(d, Dynarr_length(d) + 1).
+
+   Dynarr_increment(d)
+      [MACRO] Increments the length of D by 1.  Equivalent to
+      Dynarr_set_length(d, Dynarr_length(d) + 1).
+
+   Dynarr_reset(d)
+      [MACRO] Reset the length of a dynamic array to 0.
+
+   Dynarr_resize(d, maxval)
+      Resize the internal dynarr storage to so that it can hold at least
+      MAXVAL elements.  Resizing is done using a geometric series
+      (repeatedly multiply the old maximum by a constant, normally 1.5,
+      till a large enough size is reached), so this will be efficient
+      even if resizing larger by one element at a time.  This is mostly
+      an internal function.
+
+
+
+  ************* Adding/deleting elements to/from a dynarr *************
+
+   Dynarr_add(d, el)
+      [MACRO] Add an element to the end of a dynamic array.  EL is a pointer
+      to the element; the element itself is stored in the array, however.
+      No function call is performed unless the array needs to be resized.
+
+   Dynarr_add_many(d, base, len)
+      [MACRO] Add LEN elements to the end of the dynamic array.  The elements
+      should be contiguous in memory, starting at BASE.  If BASE if NULL,
+      just make space for the elements; don't actually add them.
+
+   Dynarr_prepend_many(d, base, len)
+      [MACRO] Prepend LEN elements to the beginning of the dynamic array.
+      The elements should be contiguous in memory, starting at BASE.
+      If BASE if NULL, just make space for the elements; don't actually
+      add them.
+
+   Dynarr_insert_many(d, base, len, pos)
+      Insert LEN elements to the dynamic array starting at position
+      POS.  The elements should be contiguous in memory, starting at BASE.
+      If BASE if NULL, just make space for the elements; don't actually
+      add them.
+
+   type Dynarr_pop(d)
+      [MACRO] Pop the last element off the dynarr and return it.
+
+   Dynarr_delete(d, i)
+      [MACRO] Delete an element from the dynamic array at position I.
+
+   Dynarr_delete_many(d, pos, len)
+      Delete LEN elements from the dynamic array starting at position
+      POS.
+
+   Dynarr_zero_many(d, pos, len)
+      Zero out LEN elements in the dynarr D starting at position POS.
+
+   Dynarr_delete_by_pointer(d, p)
+      [MACRO] Delete an element from the dynamic array at pointer P,
+      which must point within the block of memory that stores the data.
+      P should be obtained using Dynarr_atp().
+
+  ************* Dynarr locking *************
+
+   Dynarr_lock(d)
+      Lock the dynarr against further locking or writing.  With error-checking
+      enabled, any attempts to write into a locked dynarr or re-lock an
+      already locked one will cause an assertion failure and abort.
+
+   Dynarr_unlock(d)
+      Unlock a locked dynarr, allowing writing into it.
+
+  ************* Dynarr global variables *************
+
+   Dynarr_min_size
+      Minimum allowable size for a dynamic array when it is resized.
+
+*/
+
+static const struct memory_description const_Ascbyte_ptr_description_1[] = {
+  { XD_ASCII_STRING, 0 },
+  { XD_END }
+};
+
+const struct sized_memory_description const_Ascbyte_ptr_description = {
+  sizeof (const Ascbyte *),
+  const_Ascbyte_ptr_description_1
+};
+
+static const struct memory_description const_Ascbyte_ptr_dynarr_description_1[] = {
+  XD_DYNARR_DESC (const_Ascbyte_ptr_dynarr, &const_Ascbyte_ptr_description),
+  { XD_END }
+};
+
+const struct sized_memory_description const_Ascbyte_ptr_dynarr_description = {
+  sizeof (const_Ascbyte_ptr_dynarr),
+  const_Ascbyte_ptr_dynarr_description_1
+};
+
+
+static Elemcount Dynarr_min_size = 8;
+
+static void
+Dynarr_realloc (Dynarr *dy, Elemcount new_size)
+{
+  if (DUMPEDP (dy->base))
+    {
+      void *new_base = malloc (new_size * Dynarr_elsize (dy));
+      memcpy (new_base, dy->base, 
+	      (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) *
+	      Dynarr_elsize (dy));
+      dy->base = new_base;
+    }
+  else
+    dy->base = xrealloc (dy->base, new_size * Dynarr_elsize (dy));
+}
+
+void *
+Dynarr_newf (Bytecount elsize)
+{
+  Dynarr *d = xnew_and_zero (Dynarr);
+  d->elsize_ = elsize;
+
+  return d;
+}
+
+#ifdef NEW_GC
+DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("dynarr", dynarr,
+				      0, 0,
+				      Dynarr);
+
+static void
+Dynarr_lisp_realloc (Dynarr *dy, Elemcount new_size)
+{
+  void *new_base =
+    XPNTR (alloc_sized_lrecord_array (Dynarr_elsize (dy), new_size,
+				      dy->lisp_imp));
+  if (dy->base)
+    memcpy (new_base, dy->base, 
+	    (Dynarr_max (dy) < new_size ? Dynarr_max (dy) : new_size) *
+	    Dynarr_elsize (dy));
+  dy->base = new_base;
+}
+
+void *
+Dynarr_lisp_newf (Bytecount elsize, 
+		  const struct lrecord_implementation *dynarr_imp, 
+		  const struct lrecord_implementation *imp)
+{
+  Dynarr *d = (Dynarr *) XPNTR (alloc_sized_lrecord (sizeof (Dynarr),
+                                                     dynarr_imp));
+  d->elsize_ = elsize;
+  d->lisp_imp = imp;
+
+  return d;
+}
+#endif /* not NEW_GC */
+
+void
+Dynarr_resize (void *d, Elemcount size)
+{
+  Elemcount newsize;
+  double multiplier;
+  Dynarr *dy = (Dynarr *) Dynarr_verify (d);
+
+  if (Dynarr_max (dy) <= 8)
+    multiplier = 2;
+  else
+    multiplier = 1.5;
+
+  for (newsize = Dynarr_max (dy); newsize < size;)
+    newsize = max (Dynarr_min_size, (Elemcount) (multiplier * newsize));
+
+  /* Don't do anything if the array is already big enough. */
+  if (newsize > Dynarr_max (dy))
+    {
+#ifdef NEW_GC
+      if (dy->lisp_imp)
+	Dynarr_lisp_realloc (dy, newsize);
+      else
+	Dynarr_realloc (dy, newsize);
+#else /* not NEW_GC */
+      Dynarr_realloc (dy, newsize);
+#endif /* not NEW_GC */
+      dy->max_ = newsize;
+    }
+}
+
+/* Add a number of contiguous elements to the array starting at POS. */
+
+void
+Dynarr_insert_many (void *d, const void *base, Elemcount len, Elemcount pos)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  Elemcount old_len = Dynarr_length (dy);
+
+  /* #### This could conceivably be wrong, if code wants to access stuff
+     between len and largest. */
+  dynarr_checking_assert (pos >= 0 && pos <= old_len);
+  dynarr_checking_assert (len >= 0);
+  Dynarr_increase_length (dy, old_len + len);
+
+  if (pos != old_len)
+    {
+      memmove ((Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy),
+	       (Rawbyte *) dy->base + pos*Dynarr_elsize (dy),
+	       (old_len - pos)*Dynarr_elsize (dy));
+    }
+  /* Some functions call us with a value of 0 to mean "reserve space but
+     don't write into it" */
+  if (base)
+    memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base,
+	    len*Dynarr_elsize (dy));
+}
+
+void
+Dynarr_delete_many (void *d, Elemcount pos, Elemcount len)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+
+  dynarr_checking_assert (pos >= 0 && len >= 0 &&
+			  pos + len <= Dynarr_length (dy));
+
+  memmove ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy),
+	   (Rawbyte *) dy->base + (pos + len)*Dynarr_elsize (dy),
+	   (Dynarr_length (dy) - pos - len)*Dynarr_elsize (dy));
+
+  Dynarr_set_length_1 (dy, Dynarr_length (dy) - len);
+}
+
+void
+Dynarr_free (void *d)
+{
+  Dynarr *dy = (Dynarr *) d;
+
+#ifdef NEW_GC
+  if (dy->base && !DUMPEDP (dy->base))
+    {
+      if (!dy->lisp_imp)
+	{
+	  xfree (dy->base);
+	  dy->base = 0;
+	}
+    }
+  if (!DUMPEDP (dy))
+    {
+      if (!dy->lisp_imp)
+	xfree (dy);
+    }
+#else /* not NEW_GC */
+  if (dy->base && !DUMPEDP (dy->base))
+    {
+      xfree (dy->base);
+      dy->base = 0;
+    }
+  if(!DUMPEDP (dy))
+    xfree (dy);
+#endif /* not NEW_GC */
+}
+
+#ifdef MEMORY_USAGE_STATS
+
+/* Return memory usage for dynarr D.  The returned value is the total
+   amount of bytes actually being used for the dynarr, including all
+   overhead.  The extra amount of space in the dynarr that is
+   allocated beyond what was requested is returned in DYNARR_OVERHEAD
+   in STATS.  The extra amount of space that malloc() allocates beyond
+   what was requested of it is returned in MALLOC_OVERHEAD in STATS.
+   See the comment above the definition of this structure. */
+
+Bytecount
+Dynarr_memory_usage (void *d, struct usage_stats *stats)
+{
+  Bytecount total = 0;
+  Dynarr *dy = (Dynarr *) d;
+
+  /* We have to be a bit tricky here because not all of the
+     memory that malloc() will claim as "requested" was actually
+     requested. */
+
+  if (dy->base)
+    {
+      Bytecount malloc_used =
+	malloced_storage_size (dy->base, Dynarr_elsize (dy) * Dynarr_max (dy),
+			       0);
+      /* #### This may or may not be correct.  Some dynarrs would
+	 prefer that we use dy->len instead of dy->largest here. */
+      Bytecount was_requested = Dynarr_elsize (dy) * Dynarr_largest (dy);
+      Bytecount dynarr_overhead =
+	Dynarr_elsize (dy) * (Dynarr_max (dy) - Dynarr_largest (dy));
+
+      total += malloc_used;
+      stats->was_requested += was_requested;
+      stats->dynarr_overhead += dynarr_overhead;
+      /* And the remainder must be malloc overhead. */
+      stats->malloc_overhead +=
+	malloc_used - was_requested - dynarr_overhead;
+    }
+
+  total += malloced_storage_size (d, sizeof (*dy), stats);
+
+  return total;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+
+/*****************************************************************************/
+/*                           stack-like allocation                           */
+/*****************************************************************************/
+
+/* Version of malloc() that will be extremely efficient when allocation
+   nearly always occurs in LIFO (stack) order.
+
+   #### Perhaps shouldn't be in this file, but where else? */
+
+typedef struct
+{
+  Dynarr_declare (char_dynarr *);
+} char_dynarr_dynarr;
+
+char_dynarr_dynarr *stack_like_free_list;
+char_dynarr_dynarr *stack_like_in_use_list;
+
+void *
+stack_like_malloc (Bytecount size)
+{
+  char_dynarr *this_one;
+  if (!stack_like_free_list)
+    {
+      stack_like_free_list = Dynarr_new2 (char_dynarr_dynarr,
+					  char_dynarr *);
+      stack_like_in_use_list = Dynarr_new2 (char_dynarr_dynarr,
+					    char_dynarr *);
+    }
+
+  if (Dynarr_length (stack_like_free_list) > 0)
+    this_one = Dynarr_pop (stack_like_free_list);
+  else
+    this_one = Dynarr_new (char);
+  Dynarr_add (stack_like_in_use_list, this_one);
+  Dynarr_reset (this_one);
+  Dynarr_add_many (this_one, 0, size);
+  return Dynarr_begin (this_one);
+}
+
+void
+stack_like_free (void *val)
+{
+  Elemcount len = Dynarr_length (stack_like_in_use_list);
+  assert (len > 0);
+  /* The vast majority of times, we will be called in a last-in first-out
+     order, and the item at the end of the list will be the one we're
+     looking for, so just check for this first and avoid any function
+     calls. */
+  if (Dynarr_begin (Dynarr_at (stack_like_in_use_list, len - 1)) == val)
+    {
+      char_dynarr *this_one = Dynarr_pop (stack_like_in_use_list);
+      Dynarr_add (stack_like_free_list, this_one);
+    }
+  else
+    {
+      /* Find the item and delete it. */
+      int i;
+      assert (len >= 2);
+      for (i = len - 2; i >= 0; i--)
+	if (Dynarr_begin (Dynarr_at (stack_like_in_use_list, i)) ==
+	    val)
+	  {
+	    char_dynarr *this_one = Dynarr_at (stack_like_in_use_list, i);
+	    Dynarr_add (stack_like_free_list, this_one);
+	    Dynarr_delete (stack_like_in_use_list, i);
+	    return;
+	  }
+
+      ABORT ();
+    }
+}
+
+
+/*****************************************************************************/
+/*                           Generalized gap array                           */
+/*****************************************************************************/
+
+/* A "gap array" is an array that has a "gap" somewhere in the middle of it,
+   so that insertions and deletions near the gap -- or in general, highly
+   localized insertions and deletions -- are very fast.  Inserting or
+   deleting works by first moving the gap to the insertion or deletion
+   position and then shortening or lengthening the gap as necessary.  The
+   idea comes from the gap used in storing text in a buffer.
+
+   The gap array interface differs in a number of ways from dynarrs (####
+   and should be changed so that it works the same as dynarrs):
+
+   (1) There aren't separate type-specific gap array types.  As a result,
+       operations like gap_array_at() require that the type be specified as
+       one of the arguments.  It is often more convenient to use a macro
+       wrapper around this operation.
+
+   (2) The gap array type is itself a stretchy array rather than using a
+       separate block of memory to store the array.  This means that certain
+       operations (especially insertions) may relocate the the gap array,
+       and as a result return a pointer to the (possibly) moved gap array,
+       which must be stored back into the location where the gap array
+       pointer resides.  This also means that the caller must worry about
+       cloning the gap array in the case where it has been dumped, or you
+       will get an ABORT() inside of xrealloc().
+
+   (3) Fewer operations are available than for dynarrs, and may have
+       different names and/or different calling conventions.
+
+   (4) The mechanism for creating "Lisp-object gap arrays" isn't completely
+       developed.  Currently it's only possible to create a gap-array Lisp
+       object that wraps Lisp_Object pointers (not Lisp object structures
+       directly), and only under NEW_GC.
+
+   (5) Gap arrays have a concept of a "gap array marker" that properly
+       tracks insertions and deletions; no such thing exists in dynarrs.
+       It exists in gap arrays because it's necessary for their use in
+       implementing extent lists.
+ */
+
+extern const struct sized_memory_description gap_array_marker_description;
+
+static const struct memory_description gap_array_marker_description_1[] = { 
+#ifdef NEW_GC
+  { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) },
+#else /* not NEW_GC */
+  { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1,
+    { &gap_array_marker_description } },
+#endif /* not NEW_GC */
+  { XD_END }
+};
+
+#ifdef NEW_GC
+DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("gap-array-marker", gap_array_marker,
+				    0, gap_array_marker_description_1,
+				    struct gap_array_marker);
+#else /* not NEW_GC */
+const struct sized_memory_description gap_array_marker_description = {
+  sizeof (Gap_Array_Marker),
+  gap_array_marker_description_1
+};
+#endif /* not NEW_GC */
+
+static const struct memory_description lispobj_gap_array_description_1[] = {
+  XD_GAP_ARRAY_DESC (&lisp_object_description),
+  { XD_END }
+};
+
+#ifdef NEW_GC
+
+static Bytecount
+size_gap_array (Lisp_Object obj)
+{
+  Gap_Array *ga = XGAP_ARRAY (obj);
+  return gap_array_byte_size (ga);
+}
+
+DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("gap-array", gap_array,
+					      0,
+					      lispobj_gap_array_description_1,
+					      size_gap_array,
+					      struct gap_array);
+#else /* not NEW_GC */
+const struct sized_memory_description lispobj_gap_array_description = {
+  0, lispobj_gap_array_description_1
+};
+#endif /* (not) NEW_GC */
+
+#ifndef NEW_GC
+static Gap_Array_Marker *gap_array_marker_freelist;
+#endif /* not NEW_GC */
+
+/* This generalizes the "array with a gap" model used to store buffer
+   characters.  This is based on the stuff in insdel.c and should
+   probably be merged with it.  This is not extent-specific and should
+   perhaps be moved into a separate file. */
+
+/* ------------------------------- */
+/*        internal functions       */
+/* ------------------------------- */
+
+/* Adjust the gap array markers in the range (FROM, TO].  Parallel to
+   adjust_markers() in insdel.c. */
+
+static void
+gap_array_adjust_markers (Gap_Array *ga, Memxpos from,
+			  Memxpos to, Elemcount amount)
+{
+  Gap_Array_Marker *m;
+
+  for (m = ga->markers; m; m = m->next)
+    m->pos = do_marker_adjustment (m->pos, from, to, amount);
+}
+
+static void
+gap_array_recompute_derived_values (Gap_Array *ga)
+{
+  ga->offset_past_gap = ga->elsize * (ga->gap + ga->gapsize);
+  ga->els_past_gap = ga->numels - ga->gap;
+}
+
+/* Move the gap to array position POS.  Parallel to move_gap() in
+   insdel.c but somewhat simplified. */
+
+static void
+gap_array_move_gap (Gap_Array *ga, Elemcount pos)
+{
+  Elemcount gap = ga->gap;
+  Elemcount gapsize = ga->gapsize;
+
+  if (pos < gap)
+    {
+      memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
+	       GAP_ARRAY_MEMEL_ADDR (ga, pos),
+	       (gap - pos)*ga->elsize);
+      gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap,
+				gapsize);
+    }
+  else if (pos > gap)
+    {
+      memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
+	       GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
+	       (pos - gap)*ga->elsize);
+      gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize),
+				(Memxpos) (pos + gapsize), - gapsize);
+    }
+  ga->gap = pos;
+
+  gap_array_recompute_derived_values (ga);
+}
+
+/* Make the gap INCREMENT characters longer.  Parallel to make_gap() in
+   insdel.c.  The gap array may be moved, so assign the return value back
+   to the array pointer. */
+
+static Gap_Array *
+gap_array_make_gap (Gap_Array *ga, Elemcount increment)
+{
+  Elemcount real_gap_loc;
+  Elemcount old_gap_size;
+
+  /* If we have to get more space, get enough to last a while.  We use
+     a geometric progression that saves on realloc space. */
+  increment += 100 + ga->numels / 8;
+
+#ifdef NEW_GC
+  if (ga->is_lisp)
+    ga = (Gap_Array *) mc_realloc (ga,
+				   offsetof (Gap_Array, array) +
+				   (ga->numels + ga->gapsize + increment) *
+				   ga->elsize);
+  else
+#endif /* not NEW_GC */
+    ga = (Gap_Array *) xrealloc (ga,
+				 offsetof (Gap_Array, array) +
+				 (ga->numels + ga->gapsize + increment) *
+				 ga->elsize);
+  if (ga == 0)
+    memory_full ();
+
+  real_gap_loc = ga->gap;
+  old_gap_size = ga->gapsize;
+
+  /* Call the newly allocated space a gap at the end of the whole space.  */
+  ga->gap = ga->numels + ga->gapsize;
+  ga->gapsize = increment;
+
+  /* Move the new gap down to be consecutive with the end of the old one.
+     This adjusts the markers properly too.  */
+  gap_array_move_gap (ga, real_gap_loc + old_gap_size);
+
+  /* Now combine the two into one large gap.  */
+  ga->gapsize += old_gap_size;
+  ga->gap = real_gap_loc;
+
+  gap_array_recompute_derived_values (ga);
+
+  return ga;
+}
+
+/* ------------------------------- */
+/*        external functions       */
+/* ------------------------------- */
+
+Bytecount
+gap_array_byte_size (Gap_Array *ga)
+{
+  return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize;
+}
+
+/* Insert NUMELS elements (pointed to by ELPTR) into the specified
+   gap array at POS.  The gap array may be moved, so assign the
+   return value back to the array pointer. */
+
+Gap_Array *
+gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr,
+		      Elemcount numels)
+{
+  assert (pos >= 0 && pos <= ga->numels);
+  if (ga->gapsize < numels)
+    ga = gap_array_make_gap (ga, numels - ga->gapsize);
+  if (pos != ga->gap)
+    gap_array_move_gap (ga, pos);
+
+  memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
+	  numels*ga->elsize);
+  ga->gapsize -= numels;
+  ga->gap += numels;
+  ga->numels += numels;
+  gap_array_recompute_derived_values (ga);
+  /* This is the equivalent of insert-before-markers.
+
+     #### Should only happen if marker is "moves forward at insert" type.
+     */
+
+  gap_array_adjust_markers (ga, pos - 1, pos, numels);
+  return ga;
+}
+
+/* Delete NUMELS elements from the specified gap array, starting at FROM. */
+
+void
+gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel)
+{
+  Elemcount to = from + numdel;
+  Elemcount gapsize = ga->gapsize;
+
+  assert (from >= 0);
+  assert (numdel >= 0);
+  assert (to <= ga->numels);
+
+  /* Make sure the gap is somewhere in or next to what we are deleting.  */
+  if (to < ga->gap)
+    gap_array_move_gap (ga, to);
+  if (from > ga->gap)
+    gap_array_move_gap (ga, from);
+
+  /* Relocate all markers pointing into the new, larger gap
+     to point at the end of the text before the gap.  */
+  gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
+			    - numdel - gapsize);
+
+  ga->gapsize += numdel;
+  ga->numels -= numdel;
+  ga->gap = from;
+  gap_array_recompute_derived_values (ga);
+}
+
+Gap_Array_Marker *
+gap_array_make_marker (Gap_Array *ga, Elemcount pos)
+{
+  Gap_Array_Marker *m;
+
+  assert (pos >= 0 && pos <= ga->numels);
+#ifdef NEW_GC
+    m = XGAP_ARRAY_MARKER (ALLOC_NORMAL_LISP_OBJECT (gap_array_marker));
+#else /* not NEW_GC */
+  if (gap_array_marker_freelist)
+    {
+      m = gap_array_marker_freelist;
+      gap_array_marker_freelist = gap_array_marker_freelist->next;
+    }
+  else
+    m = xnew (Gap_Array_Marker);
+#endif /* not NEW_GC */
+
+  m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
+  m->next = ga->markers;
+  ga->markers = m;
+  return m;
+}
+
+void
+gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
+{
+  Gap_Array_Marker *p, *prev;
+
+  for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
+    ;
+  assert (p);
+  if (prev)
+    prev->next = p->next;
+  else
+    ga->markers = p->next;
+#ifndef NEW_GC
+  m->next = gap_array_marker_freelist;
+  m->pos = 0xDEADBEEF; /* -559038737 base 10 */
+  gap_array_marker_freelist = m;
+#endif /* not NEW_GC */
+}
+
+#ifndef NEW_GC
+void
+gap_array_delete_all_markers (Gap_Array *ga)
+{
+  Gap_Array_Marker *p, *next;
+
+  for (p = ga->markers; p; p = next)
+    {
+      next = p->next;
+      p->next = gap_array_marker_freelist;
+      p->pos = 0xDEADBEEF; /* -559038737 as an int */
+      gap_array_marker_freelist = p;
+    }
+}
+#endif /* not NEW_GC */
+
+void
+gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos)
+{
+  assert (pos >= 0 && pos <= ga->numels);
+  m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
+}
+
+Gap_Array *
+make_gap_array (Elemcount elsize, int USED_IF_NEW_GC (do_lisp))
+{
+  Gap_Array *ga;
+#ifdef NEW_GC
+  /* #### I don't quite understand why it's necessary to make all these
+     internal objects into Lisp objects under NEW_GC.  It's a pain in the
+     ass to code around this.  I'm proceeding on the assumption that it's
+     not really necessary to do it after all, and so we only make a Lisp-
+     object gap array when the object being held is a Lisp_Object, i.e. a
+     pointer to a Lisp object.  In the case where instead we hold a `struct
+     range_table_entry', just blow it off.  Otherwise we either need to do
+     a bunch of painful and/or boring rewriting. --ben */
+  if (do_lisp)
+    {
+      ga = XGAP_ARRAY (ALLOC_SIZED_LISP_OBJECT (sizeof (Gap_Array),
+						gap_array));
+      ga->is_lisp = 1;
+    }
+  else
+#endif /* not NEW_GC */
+    ga = xnew_and_zero (Gap_Array);
+  ga->elsize = elsize;
+  return ga;
+}
+
+Gap_Array *
+gap_array_clone (Gap_Array *ga)
+{
+  Bytecount size = gap_array_byte_size (ga);
+  Gap_Array *ga2;
+  Gap_Array_Marker *m;
+
+#ifdef NEW_GC
+  if (ga->is_lisp)
+    {
+      ga2 = XGAP_ARRAY (ALLOC_SIZED_LISP_OBJECT (size, gap_array));
+      copy_lisp_object (wrap_gap_array (ga2), wrap_gap_array (ga));
+    }
+  else
+#endif
+    {
+      ga2 = (Gap_Array *) xmalloc (size);
+      memcpy (ga2, ga, size);
+    }
+  ga2->markers = NULL;
+  for (m = ga->markers; m; m = m->next)
+    gap_array_make_marker (ga2, m->pos);
+  return ga2;
+}
+
+#ifndef NEW_GC
+void
+free_gap_array (Gap_Array *ga)
+{
+  gap_array_delete_all_markers (ga);
+  xfree (ga);
+}
+#endif /* not NEW_GC */
+
+#ifdef MEMORY_USAGE_STATS
+
+/* Return memory usage for gap array GA.  The returned value is the total
+   amount of bytes actually being used for the gap array, including all
+   overhead.  The extra amount of space in the gap array that is used
+   for the gap is counted in GAP_OVERHEAD, not in WAS_REQUESTED.
+   If NEW_GC, space for gap-array markers is returned through MARKER_ANCILLARY;
+   otherwise it's added into the gap array usage. */
+
+Bytecount
+gap_array_memory_usage (Gap_Array *ga, struct usage_stats *stats,
+			Bytecount *marker_ancillary)
+{
+  Bytecount total = 0;
+
+  /* We have to be a bit tricky here because not all of the
+     memory that malloc() will claim as "requested" was actually
+     requested -- some of it makes up the gap. */
+
+  Bytecount size = gap_array_byte_size (ga);
+  Bytecount gap_size = ga->gapsize * ga->elsize;
+  Bytecount malloc_used = malloced_storage_size (ga, size, 0);
+  total += malloc_used;
+  stats->was_requested += size - gap_size;
+  stats->gap_overhead += gap_size;
+  stats->malloc_overhead += malloc_used - size;
+
+#ifdef NEW_GC
+  {
+    Bytecount marker_usage = 0;
+    Gap_Array_Marker *p;
+
+    for (p = ga->markers; p; p = p->next)
+      marker_usage += lisp_object_memory_usage (wrap_gap_array_marker (p));
+    if (marker_ancillary)
+      *marker_ancillary = marker_usage;
+  }
+#else
+  {
+    Gap_Array_Marker *p;
+
+    for (p = ga->markers; p; p = p->next)
+      total += malloced_storage_size (p, sizeof (p), stats);
+    if (marker_ancillary)
+      *marker_ancillary = 0;
+  }
+#endif /* (not) NEW_GC */
+  
+  return total;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+
+/*****************************************************************************/
+/*                              Initialization                               */
+/*****************************************************************************/
+
+void
+syms_of_array (void)
+{
+#ifdef NEW_GC
+  INIT_LISP_OBJECT (gap_array_marker);
+  INIT_LISP_OBJECT (gap_array);
+#endif /* NEW_GC */
+}
+

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/array.h	Mon Mar 29 00:11:03 2010 -0500
@@ -0,0 +1,769 @@
+/* Header for arrays (dynarrs, gap arrays, etc.).
+   Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+   Copyright (C) 1996, 2001, 2002, 2004, 2005, 2009, 2010 Ben Wing.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* This file has been Mule-ized, Ben Wing, 10-13-04. */
+
+#ifndef INCLUDED_array_h_
+#define INCLUDED_array_h_
+
+/************************************************************************/
+/**               Definition of dynamic arrays (dynarrs)               **/
+/************************************************************************/
+
+BEGIN_C_DECLS
+
+/************* Dynarr declaration *************/
+
+#ifdef NEW_GC
+#define DECLARE_DYNARR_LISP_IMP()			\
+  const struct lrecord_implementation *lisp_imp;
+#else
+#define DECLARE_DYNARR_LISP_IMP()
+#endif
+
+#ifdef ERROR_CHECK_DYNARR
+#define DECLARE_DYNARR_LOCKED()				\
+  int locked;
+#else
+#define DECLARE_DYNARR_LOCKED()
+#endif
+
+#define Dynarr_declare(type)			\
+  struct lrecord_header header;			\
+  type *base;					\
+  DECLARE_DYNARR_LISP_IMP ()			\
+  DECLARE_DYNARR_LOCKED ()			\
+  int elsize_;					\
+  int len_;					\
+  int largest_;					\
+  int max_
+
+typedef struct dynarr
+{
+  Dynarr_declare (void);
+} Dynarr;
+
+#define XD_DYNARR_DESC(base_type, sub_desc)				\
+  { XD_BLOCK_PTR, offsetof (base_type, base),				\
+    XD_INDIRECT(1, 0), {sub_desc} },					\
+  { XD_INT,        offsetof (base_type, len_) },			\
+  { XD_INT_RESET,  offsetof (base_type, largest_), XD_INDIRECT(1, 0) },	\
+  { XD_INT_RESET,  offsetof (base_type, max_), XD_INDIRECT(1, 0) }
+
+#ifdef NEW_GC
+#define XD_LISP_DYNARR_DESC(base_type, sub_desc)			\
+  { XD_INLINE_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base),		\
+    XD_INDIRECT(1, 0), {sub_desc} },					\
+  { XD_INT,        offsetof (base_type, len_) },			\
+  { XD_INT_RESET,  offsetof (base_type, largest_), XD_INDIRECT(1, 0) },	\
+  { XD_INT_RESET,  offsetof (base_type, max_), XD_INDIRECT(1, 0) }
+#endif /* NEW_GC */
+
+/************* Dynarr verification *************/
+
+/* Dynarr locking and verification.
+
+   [I] VERIFICATION
+
+   Verification routines simply return their basic argument, possibly
+   casted, but in the process perform some verification on it, aborting if
+   the verification fails.  The verification routines take FILE and LINE
+   parameters, and use them to output the file and line of the caller
+   when an abort occurs, rather than the file and line of the inline
+   function, which is less than useful.
+
+   There are three basic types of verification routines:
+
+   (1) Verify the dynarr itself.  This verifies the basic invariant
+   involving the length/size values:
+
+   0 <= Dynarr_length(d) <= Dynarr_largest(d) <= Dynarr_max(d)
+
+   (2) Verify the dynarr itself prior to modifying it.  This performs
+   the same verification as previously, but also checks that the
+   dynarr is not locked (see below).
+
+   (3) Verify a dynarr position.  Unfortunately we have to have
+   different verification routines depending on which kind of operation
+   is being performed:
+
+   (a) For Dynarr_at(), we check that the POS is bounded by Dynarr_largest(),
+       i.e. 0 <= POS < Dynarr_largest().
+   (b) For Dynarr_atp_allow_end(), we also have to allow
+       POS == Dynarr_largest().
+   (c) For Dynarr_atp(), we behave largely like Dynarr_at() but make a
+       special exception when POS == 0 and Dynarr_largest() == 0 -- see
+       comment below.
+   (d) Some other routines contain the POS verification within their code,
+       and make the check 0 <= POS < Dynarr_length() or
+       0 <= POS <= Dynarr_length().
+
+   #### It is not well worked-out whether and in what circumstances it's
+   allowed to use a position that is between Dynarr_length() and
+   Dynarr_largest().  The ideal solution is to never allow this, and require
+   instead that code first change the length before accessing higher
+   positions.  That would require looking through all the code that accesses
+   dynarrs and fixing it appropriately (especially redisplay code, and
+   especially redisplay code in the vicinity of a reference to
+   Dynarr_largest(), since such code usually checks explicitly to see whether
+   there is extra stuff between Dynarr_length() and Dynarr_largest().)
+
+   [II] LOCKING
+
+   The idea behind dynarr locking is simple: Locking a dynarr prevents
+   any modification from occurring, or rather, leads to an abort upon
+   any attempt to modify a dynarr.
+
+   Dynarr locking was originally added to catch some sporadic and hard-to-
+   debug crashes in the redisplay code where dynarrs appeared to be getting
+   corrupted in an unexpected fashion.  The solution was to lock the
+   dynarrs that were getting corrupted (in this case, the display-line
+   dynarrs) around calls to routines that weren't supposed to be changing
+   these dynarrs but might somehow be calling code that modified them.
+   This eventually revealed that there was a reentrancy problem with
+   redisplay that involved the QUIT mechanism and the processing done in
+   order to determine whether C-g had been pressed -- this processing
+   involves retrieving, processing and queueing pending events to see
+   whether any of them result in a C-g keypress.  However, at least under
+   MS Windows this can result in redisplay being called reentrantly.
+   For more info:--
+   
+  (Info-goto-node "(internals)Critical Redisplay Sections")
+
+*/
+
+#ifdef ERROR_CHECK_DYNARR
+DECLARE_INLINE_HEADER (
+int
+Dynarr_verify_pos_at (void *d, Elemcount pos, const Ascbyte *file, int line)
+)
+{
+  Dynarr *dy = (Dynarr *) d;
+  /* We use `largest', not `len', because the redisplay code often
+     accesses stuff between len and largest. */
+  assert_at_line (pos >= 0 && pos < dy->largest_, file, line);
+  return pos;
+}
+
+DECLARE_INLINE_HEADER (
+int
+Dynarr_verify_pos_atp (void *d, Elemcount pos, const Ascbyte *file, int line)
+)
+{
+  Dynarr *dy = (Dynarr *) d;
+  /* We use `largest', not `len', because the redisplay code often
+     accesses stuff between len and largest. */
+  /* [[ Code will often do something like ...
+
+     val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+	                                     Dynarr_length (dyn));
+
+     which works fine when the Dynarr_length is non-zero, but when zero,
+     the result of Dynarr_atp() not only points past the end of the
+     allocated array, but the array may not have ever been allocated and
+     hence the return value is NULL.  But the length of 0 causes the
+     pointer to never get checked.  These can occur throughout the code
+     so we put in a special check. --ben ]]
+
+     Update: The common idiom `Dynarr_atp (dyn, 0)' has been changed to
+     `Dynarr_begin (dyn)'.  Possibly this special check at POS 0 can be
+     done only for Dynarr_begin() not for general Dynarr_atp(). --ben */
+  if (pos == 0 && dy->len_ == 0)
+    return pos;
+  /* #### It's vaguely possible that some code could legitimately want to
+     retrieve a pointer to the position just past the end of dynarr memory.
+     This could happen with Dynarr_atp() but not Dynarr_at().  If so, it
+     will trigger this assert().  In such cases, it should be obvious that
+     the code wants to do this; rather than relaxing the assert, we should
+     probably create a new macro Dynarr_atp_allow_end() which is like
+     Dynarr_atp() but which allows for pointing at invalid addresses -- we
+     really want to check for cases of accessing just past the end of
+     memory, which is a likely off-by-one problem to occur and will usually
+     not trigger a protection fault (instead, you'll just get random
+     behavior, possibly overwriting other memory, which is bad). --ben */
+  assert_at_line (pos >= 0 && pos < dy->largest_, file, line);
+  return pos;
+}
+
+DECLARE_INLINE_HEADER (
+int
+Dynarr_verify_pos_atp_allow_end (void *d, Elemcount pos, const Ascbyte *file,
+				 int line)
+)
+{
+  Dynarr *dy = (Dynarr *) d;
+  /* We use `largest', not `len', because the redisplay code often
+     accesses stuff between len and largest.
+     We also allow referencing the very end, past the end of allocated
+     legitimately space.  See comments in Dynarr_verify_pos_atp.()*/
+  assert_at_line (pos >= 0 && pos <= dy->largest_, file, line);
+  return pos;
+}
+
+#else
+#define Dynarr_verify_pos_at(d, pos, file, line) (pos)
+#define Dynarr_verify_pos_atp(d, pos, file, line) (pos)
+#define Dynarr_verify_pos_atp_allow_end(d, pos, file, line) (pos)
+#endif /* ERROR_CHECK_DYNARR */
+
+#ifdef ERROR_CHECK_DYNARR
+DECLARE_INLINE_HEADER (
+Dynarr *
+Dynarr_verify_1 (void *d, const Ascbyte *file, int line)
+)
+{
+  Dynarr *dy = (Dynarr *) d;
+  assert_at_line (dy->len_ >= 0 && dy->len_ <= dy->largest_ &&
+		  dy->largest_ <= dy->max_, file, line);
+  return dy;
+}
+
+DECLARE_INLINE_HEADER (
+Dynarr *
+Dynarr_verify_mod_1 (void *d, const Ascbyte *file, int line)
+)
+{
+  Dynarr *dy = (Dynarr *) d;
+  assert_at_line (!dy->locked, file, line);
+  return Dynarr_verify_1 (d, file, line);
+}
+
+#define Dynarr_verify(d) Dynarr_verify_1 (d, __FILE__, __LINE__)
+#define Dynarr_verify_mod(d) Dynarr_verify_mod_1 (d, __FILE__, __LINE__)
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_lock (void *d)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  dy->locked = 1;
+}
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_unlock (void *d)
+)
+{
+  Dynarr *dy = Dynarr_verify (d);
+  assert (dy->locked);
+  dy->locked = 0;
+}
+
+#else /* not ERROR_CHECK_DYNARR */
+
+#define Dynarr_verify(d) ((Dynarr *) d)
+#define Dynarr_verify_mod(d) ((Dynarr *) d)
+#define Dynarr_lock(d) DO_NOTHING
+#define Dynarr_unlock(d) DO_NOTHING
+
+#endif /* ERROR_CHECK_DYNARR */
+
+/************* Dynarr creation *************/
+
+MODULE_API void *Dynarr_newf (Bytecount elsize);
+MODULE_API void Dynarr_free (void *d);
+
+#ifdef NEW_GC
+MODULE_API void *Dynarr_lisp_newf (Bytecount elsize,
+				   const struct lrecord_implementation 
+				   *dynarr_imp,
+				   const struct lrecord_implementation *imp);
+
+#define Dynarr_lisp_new(type, dynarr_imp, imp)			\
+  ((type##_dynarr *) Dynarr_lisp_newf (sizeof (type), dynarr_imp, imp))
+#define Dynarr_lisp_new2(dynarr_type, type, dynarr_imp, imp)	\
+  ((dynarr_type *) Dynarr_lisp_newf (sizeof (type)), dynarr_imp, imp)
+#endif /* NEW_GC */
+#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof (type)))
+#define Dynarr_new2(dynarr_type, type) \
+  ((dynarr_type *) Dynarr_newf (sizeof (type)))
+
+/************* Dynarr access *************/
+
+#ifdef ERROR_CHECK_DYNARR
+#define Dynarr_at(d, pos) \
+  ((d)->base[Dynarr_verify_pos_at (d, pos, __FILE__, __LINE__)])
+#define Dynarr_atp_allow_end(d, pos) \
+  (&((d)->base[Dynarr_verify_pos_atp_allow_end (d, pos, __FILE__, __LINE__)]))
+#define Dynarr_atp(d, pos) \
+  (&((d)->base[Dynarr_verify_pos_atp (d, pos, __FILE__, __LINE__)]))
+#else
+#define Dynarr_at(d, pos) ((d)->base[pos])
+#define Dynarr_atp(d, pos) (&Dynarr_at (d, pos))
+#define Dynarr_atp_allow_end(d, pos) Dynarr_atp (d, pos)
+#endif
+
+/* Old #define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) */
+#define Dynarr_begin(d) Dynarr_atp (d, 0)
+#define Dynarr_lastp(d) Dynarr_atp (d, Dynarr_length (d) - 1)
+#define Dynarr_past_lastp(d) Dynarr_atp_allow_end (d, Dynarr_length (d))
+
+
+/************* Dynarr length/size retrieval and setting *************/
+
+/* Retrieve the length of a dynarr.  The `+ 0' is to ensure that this cannot
+   be used as an lvalue. */
+#define Dynarr_length(d) (Dynarr_verify (d)->len_ + 0)
+/* Retrieve the largest ever length seen of a dynarr.  The `+ 0' is to
+   ensure that this cannot be used as an lvalue. */
+#define Dynarr_largest(d) (Dynarr_verify (d)->largest_ + 0)
+/* Retrieve the number of elements that fit in the currently allocated
+   space.  The `+ 0' is to ensure that this cannot be used as an lvalue. */
+#define Dynarr_max(d) (Dynarr_verify (d)->max_ + 0)
+/* Return the size in bytes of an element in a dynarr. */
+#define Dynarr_elsize(d) (Dynarr_verify (d)->elsize_ + 0)
+/* Retrieve the advertised memory usage of a dynarr, i.e. the number of
+   bytes occupied by the elements in the dynarr, not counting any overhead. */
+#define Dynarr_sizeof(d) (Dynarr_length (d) * Dynarr_elsize (d))
+
+/* Actually set the length of a dynarr.  This is a low-level routine that
+   should not be directly used; use Dynarr_set_length() or
+   Dynarr_set_lengthr() instead. */
+DECLARE_INLINE_HEADER (
+void
+Dynarr_set_length_1 (void *d, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  dynarr_checking_assert (len >= 0 && len <= Dynarr_max (dy));
+  /* Use the raw field references here otherwise we get a crash because
+     we've set the length but not yet fixed up the largest value. */
+  dy->len_ = len;
+  if (dy->len_ > dy->largest_)
+    dy->largest_ = dy->len_;
+  (void) Dynarr_verify_mod (d);
+}
+
+/* "Restricted set-length": Set the length of dynarr D to LEN,
+    which must be in the range [0, Dynarr_largest(d)]. */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_set_lengthr (void *d, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  dynarr_checking_assert (len >= 0 && len <= Dynarr_largest (dy));
+  Dynarr_set_length_1 (dy, len);
+}
+
+/* "Restricted increment": Increment the length of dynarr D by 1; the resulting
+    length must be in the range [0, Dynarr_largest(d)]. */
+
+#define Dynarr_incrementr(d) Dynarr_set_lengthr (d, Dynarr_length (d) + 1)
+
+
+MODULE_API void Dynarr_resize (void *d, Elemcount size);
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_resize_to_fit (void *d, Elemcount size)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  if (size > Dynarr_max (dy))
+    Dynarr_resize (dy, size);
+}
+
+#define Dynarr_resize_to_add(d, numels)			\
+  Dynarr_resize_to_fit (d, Dynarr_length (d) + numels)
+
+/* This is an optimization.  This is like Dynarr_set_length() but the length
+   is guaranteed to be at least as big as the existing length. */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_increase_length (void *d, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  dynarr_checking_assert (len >= Dynarr_length (dy));
+  Dynarr_resize_to_fit (dy, len);
+  Dynarr_set_length_1 (dy, len);
+}
+
+/* Set the length of dynarr D to LEN.  If the length increases, resize as
+   necessary to fit. (NOTE: This will leave uninitialized memory.  If you
+   aren't planning on immediately overwriting the memory, use
+   Dynarr_set_length_and_zero() to zero out all the memory that would
+   otherwise be uninitialized.) */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_set_length (void *d, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  Elemcount old_len = Dynarr_length (dy);
+  if (old_len >= len)
+    Dynarr_set_lengthr (dy, len);
+  else
+    Dynarr_increase_length (d, len);
+}
+
+#define Dynarr_increment(d) Dynarr_increase_length (d, Dynarr_length (d) + 1)
+
+/* Zero LEN contiguous elements starting at POS. */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_zero_many (void *d, Elemcount pos, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  memset ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), 0,
+	  len*Dynarr_elsize (dy));
+}
+
+/* This is an optimization.  This is like Dynarr_set_length_and_zero() but
+   the length is guaranteed to be at least as big as the existing
+   length. */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_increase_length_and_zero (void *d, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  Elemcount old_len = Dynarr_length (dy);
+  Dynarr_increase_length (dy, len);
+  Dynarr_zero_many (dy, old_len, len - old_len);
+}
+
+/* Set the length of dynarr D to LEN.  If the length increases, resize as
+   necessary to fit and zero out all the elements between the old and new
+   lengths. */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_set_length_and_zero (void *d, Elemcount len)
+)
+{
+  Dynarr *dy = Dynarr_verify_mod (d);
+  Elemcount old_len = Dynarr_length (dy);
+  if (old_len >= len)
+    Dynarr_set_lengthr (dy, len);
+  else
+    Dynarr_increase_length_and_zero (d, len);
+}
+
+/* Reset the dynarr's length to 0. */
+#define Dynarr_reset(d) Dynarr_set_lengthr (d, 0)
+
+#ifdef MEMORY_USAGE_STATS
+struct usage_stats;
+Bytecount Dynarr_memory_usage (void *d, struct usage_stats *stats);
+#endif
+
+/************* Adding/deleting elements to/from a dynarr *************/
+
+/* Set the Lisp implementation of the element at POS in dynarr D.  Only
+   does this if the dynarr holds Lisp objects of a particular type (the
+   objects themselves, not pointers to them), and only under NEW_GC. */
+
+#ifdef NEW_GC
+#define DYNARR_SET_LISP_IMP(d, pos)					\
+do {									\
+  if ((d)->lisp_imp)							\
+    set_lheader_implementation						\
+      ((struct lrecord_header *)&(((d)->base)[pos]), (d)->lisp_imp);	\
+} while (0)  
+#else
+#define DYNARR_SET_LISP_IMP(d, pos) DO_NOTHING
+#endif /* (not) NEW_GC */
+
+/* Add Element EL to the end of dynarr D. */
+
+#define Dynarr_add(d, el)			\
+do {						\
+  Elemcount _da_pos = Dynarr_length (d);	\
+  (void) Dynarr_verify_mod (d);			\
+  Dynarr_increment (d);				\
+  ((d)->base)[_da_pos] = (el);			\
+  DYNARR_SET_LISP_IMP (d, _da_pos);		\
+} while (0)
+
+/* Set EL as the element at position POS in dynarr D.
+   Expand the dynarr as necessary so that its length is enough to include
+   position POS within it, and zero out any new elements created as a
+   result of expansion, other than the one at POS. */
+
+#define Dynarr_set(d, pos, el)				\
+do {							\
+  Elemcount _ds_pos = (pos);				\
+  (void) Dynarr_verify_mod (d);				\
+  if (Dynarr_length (d) < _ds_pos + 1)			\
+    Dynarr_increase_length_and_zero (d, _ds_pos + 1);	\
+  ((d)->base)[_ds_pos] = (el);				\
+  DYNARR_SET_LISP_IMP (d, _ds_pos);			\
+} while (0)
+
+/* Add LEN contiguous elements, stored at BASE, to dynarr D.  If BASE is
+   NULL, reserve space but don't store anything. */
+
+DECLARE_INLINE_HEADER (
+void
+Dynarr_add_many (void *d, const void *base, Elemcount len)
+)
+{
+  /* This duplicates Dynarr_insert_many to some extent; but since it is
+     called so often, it seemed useful to remove the unnecessary stuff
+     from that function and to make it inline */
+  Dynarr *dy = Dynarr_verify_mod (d);
+  Elemcount pos = Dynarr_length (dy);
+  Dynarr_increase_length (dy, Dynarr_length (dy) + len);
+  if (base)
+    memcpy ((Rawbyte *) dy->base + pos*Dynarr_elsize (dy), base,
+	    len*Dynarr_elsize (dy));
+}
+
+/* Insert LEN elements, currently pointed to by BASE, into dynarr D
+   starting at position POS. */
+
+MODULE_API void Dynarr_insert_many (void *d, const void *base, Elemcount len,
+				    Elemcount pos);
+
+/* Prepend LEN elements, currently pointed to by BASE, to the beginning. */
+
+#define Dynarr_prepend_many(d, base, len) Dynarr_insert_many (d, base, len, 0)
+
+/* Add literal string S to dynarr D, which should hold chars or unsigned
+   chars.  The final zero byte is not stored. */
+
+#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof (s) - 1)
+
+/* Convert Lisp string S to an external encoding according to CODESYS and
+   add to dynarr D, which should hold chars or unsigned chars.  No final
+   zero byte is appended. */
+
+/* #### This should be an inline function but LISP_STRING_TO_SIZED_EXTERNAL
+   isn't declared yet. */
+
+#define Dynarr_add_ext_lisp_string(d, s, codesys)		\
+do {								\
+  Lisp_Object dyna_ls_s = (s);					\
+  Lisp_Object dyna_ls_cs = (codesys);				\
+  Extbyte *dyna_ls_eb;						\
+  Bytecount dyna_ls_bc;						\
+								\
+  LISP_STRING_TO_SIZED_EXTERNAL (dyna_ls_s, dyna_ls_eb,		\
+				 dyna_ls_bc, dyna_ls_cs);	\
+  Dynarr_add_many (d, dyna_ls_eb, dyna_ls_bc);			\
+} while (0)
+
+/* Delete LEN elements starting at position POS. */
+
+MODULE_API void Dynarr_delete_many (void *d, Elemcount pos, Elemcount len);
+
+/* Pop off (i.e. delete) the last element from the dynarr and return it */
+
+#define Dynarr_pop(d)					\
+  (dynarr_checking_assert (Dynarr_length (d) > 0),	\
+   Dynarr_verify_mod (d)->len_--,			\
+   Dynarr_at (d, Dynarr_length (d)))
+
+/* Delete the item at POS */
+
+#define Dynarr_delete(d, pos) Dynarr_delete_many (d, pos, 1)
+
+/* Delete the item located at memory address P, which must be a `type *'
+   pointer, where `type' is the type of the elements of the dynarr. */
+#define Dynarr_delete_by_pointer(d, p) \
+  Dynarr_delete_many (d, (p) - ((d)->base), 1)
+
+/* Delete all elements that are numerically equal to EL. */
+
+#define Dynarr_delete_object(d, el)		\
+do						\
+{						\
+  REGISTER int i;				\
+  for (i = Dynarr_length (d) - 1; i >= 0; i--)	\
+    {						\
+      if (el == Dynarr_at (d, i))		\
+	Dynarr_delete_many (d, i, 1);		\
+    }						\
+} while (0)
+
+
+/************************************************************************/
+/**                       Stack-like malloc/free                       **/
+/************************************************************************/
+
+void *stack_like_malloc (Bytecount size);
+void stack_like_free (void *val);
+
+
+
+/************************************************************************/
+/**                             Gap array                              **/
+/************************************************************************/
+
+/* Holds a marker that moves as elements in the array are inserted and
+   deleted, similar to standard markers. */
+
+typedef struct gap_array_marker
+{
+#ifdef NEW_GC
+  NORMAL_LISP_OBJECT_HEADER header;
+#endif /* NEW_GC */
+  int pos;
+  struct gap_array_marker *next;
+} Gap_Array_Marker;
+
+
+/* Holds a "gap array", which is an array of elements with a gap located
+   in it.  Insertions and deletions with a high degree of locality
+   are very fast, essentially in constant time.  Array positions as
+   used and returned in the gap array functions are independent of
+   the gap. */
+
+/* Layout of gap array:
+
+   <------ gap ------><---- gapsize ----><----- numels - gap ---->
+   <---------------------- numels + gapsize --------------------->
+
+   For marking purposes, we use two extra variables computed from
+   the others -- the offset to the data past the gap, plus the number
+   of elements in that data:
+
+   offset_past_gap = elsize * (gap + gapsize)
+   els_past_gap = numels - gap
+*/
+
+
+typedef struct gap_array
+{
+#ifdef NEW_GC
+  NORMAL_LISP_OBJECT_HEADER header;
+  int is_lisp;
+#endif /* NEW_GC */
+  Elemcount gap;
+  Elemcount gapsize;
+  Elemcount numels;
+  Bytecount elsize;
+  /* Redundant numbers computed from the others, for marking purposes */
+  Bytecount offset_past_gap;
+  Elemcount els_past_gap;
+  Gap_Array_Marker *markers;
+  /* this is a stretchy array */
+  char array[1];
+} Gap_Array;
+
+#ifdef NEW_GC
+struct gap_array_marker;
+
+DECLARE_LISP_OBJECT (gap_array_marker, struct gap_array_marker);
+#define XGAP_ARRAY_MARKER(x) \
+  XRECORD (x, gap_array_marker, struct gap_array_marker)
+#define wrap_gap_array_marker(p) wrap_record (p, gap_array_marker)
+#define GAP_ARRAY_MARKERP(x) RECORDP (x, gap_array_marker)
+#define CHECK_GAP_ARRAY_MARKER(x) CHECK_RECORD (x, gap_array_marker)
+#define CONCHECK_GAP_ARRAY_MARKER(x) CONCHECK_RECORD (x, gap_array_marker)
+
+struct gap_array;
+
+DECLARE_LISP_OBJECT (gap_array, struct gap_array);
+#define XGAP_ARRAY(x) XRECORD (x, gap_array, struct gap_array)
+#define wrap_gap_array(p) wrap_record (p, gap_array)
+#define GAP_ARRAYP(x) RECORDP (x, gap_array)
+#define CHECK_GAP_ARRAY(x) CHECK_RECORD (x, gap_array)
+#define CONCHECK_GAP_ARRAY(x) CONCHECK_RECORD (x, gap_array)
+#endif /* NEW_GC */
+
+#ifdef NEW_GC
+#define XD_GAP_ARRAY_MARKER_DESC					\
+  { XD_LISP_OBJECT, offsetof (Gap_Array, markers) }
+#else /* not NEW_GC */
+#define XD_GAP_ARRAY_MARKER_DESC					\
+  { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1,			\
+    { &gap_array_marker_description }, XD_FLAG_NO_KKCC }
+#endif /* not NEW_GC */
+
+#define XD_GAP_ARRAY_DESC(sub_desc)					\
+  { XD_ELEMCOUNT, offsetof (Gap_Array, gap) },				\
+  { XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) },		\
+  { XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) },			\
+  XD_GAP_ARRAY_MARKER_DESC,						\
+  { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0),	\
+    { sub_desc } },							\
+  { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)),	\
+    XD_INDIRECT (2, 0), { sub_desc } }
+
+/* Convert a "memory position" (i.e. taking the gap into account) into
+   the address of the element at (i.e. after) that position.  "Memory
+   positions" are only used internally and are of type Memxpos.
+   "Array positions" are used externally and are of type Elemcount. */
+#define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
+
+/* Number of elements currently in a gap array */
+#define gap_array_length(ga) ((ga)->numels)
+
+#define gap_array_gappos(ga) ((ga)->gap)
+#define gap_array_gapsize(ga) ((ga)->gapsize)
+
+#define GAP_ARRAY_ARRAY_TO_MEMORY_POS_1(pos, gappos, gapsize) \
+  ((pos) < gappos ? (pos) : (pos) + gapsize)
+
+#define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
+  GAP_ARRAY_ARRAY_TO_MEMORY_POS_1 (pos, (ga)->gap, (ga)->gapsize)
+
+#define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
+  ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)
+
+/* Return a pointer to the element at a given position. */
+#define gap_array_atp(ga, pos, type) \
+  ((type *) GAP_ARRAY_MEMEL_ADDR (ga, GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos)))
+
+/* Return the element at a given position. */
+#define gap_array_at(ga, pos, type) (*gap_array_atp (ga, pos, type))
+
+/* Return a pointer to the beginning of memory storage for the gap array.
+   Note this is NOT the same as gap_array_atp(ga, 0, type) because that
+   will skip forward past the gap if the gap is at position 0. */
+#define gap_array_begin(ga, type) ((type *) ((ga)->array))
+
+#ifndef NEW_GC
+extern const struct sized_memory_description lispobj_gap_array_description;
+extern const struct sized_memory_description gap_array_marker_description;
+#endif
+
+Bytecount gap_array_byte_size (Gap_Array *ga);
+Gap_Array *gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr,
+				 Elemcount numels);
+void gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel);
+#define gap_array_delete_all_els(ga) \
+  gap_array_delete_els (ga, 0, gap_array_length (ga))
+Gap_Array_Marker *gap_array_make_marker (Gap_Array *ga, Elemcount pos);
+void gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m);
+void gap_array_delete_all_markers (Gap_Array *ga);
+void gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos);
+#define gap_array_marker_pos(ga, m) \
+  GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)
+Gap_Array *make_gap_array (Elemcount elsize, int USED_IF_NEW_GC (do_lisp));
+Gap_Array *gap_array_clone (Gap_Array *ga);
+void free_gap_array (Gap_Array *ga);
+Bytecount gap_array_memory_usage (Gap_Array *ga, struct usage_stats *stats,
+				  Bytecount *marker_ancillary);
+
+#endif /* INCLUDED_array_h_ */