root/src/pdumper.c

DEFINITIONS

1. divide_round_up
2. ATTRIBUTE_FORMAT_PRINTF
3. ptrdiff_t_to_dump_off
4. dump_get_max_page_size
5. emacs_reloc_set_type
6. dump_reloc_set_type
7. dump_reloc_get_offset
8. dump_reloc_set_offset
9. dump_fingerprint
10. dump_grow_buffer
11. dump_push
12. dump_pop
13. dump_tracking_referrers_p
14. dump_set_have_current_referrer
15. dump_set_referrer
16. dump_clear_referrer
17. dump_ptr_referrer
18. error_unsupported_dump_object
19. emacs_basis
20. emacs_ptr_at
21. emacs_offset
22. dump_builtin_symbol_p
23. dump_object_self_representing_p
24. intmax_t_from_lisp
25. intmax_t_to_lisp
26. dump_off_from_lisp
27. dump_off_to_lisp
28. dump_write
29. make_eq_hash_table
30. dump_tailq_init
31. dump_tailq_length
32. dump_tailq_prepend
33. dump_tailq_empty_p
34. dump_tailq_peek
35. dump_tailq_pop
36. dump_seek
37. dump_write_zero
38. dump_align_output
39. dump_object_start
40. dump_object_finish
41. dump_recall_object
42. dump_remember_object
43. dump_note_reachable
44. dump_object_emacs_ptr
45. dump_queue_init
46. dump_queue_empty_p
47. dump_queue_push_weight
48. dump_queue_enqueue
49. dump_calc_link_score
50. dump_queue_compute_score
51. dump_queue_scan_fancy
52. dump_queue_sequence
53. dump_queue_find_score_of_one_weight_queue
54. dump_queue_dequeue
55. dump_object_needs_dumping_p
56. dump_enqueue_object
57. print_paths_to_root_1
58. print_paths_to_root
59. dump_remember_cold_op
60. dump_reloc_dump_to_emacs_ptr_raw
61. dump_reloc_dump_to_dump_lv
62. dump_reloc_dump_to_dump_ptr_raw
63. dump_reloc_dump_to_emacs_lv
64. dump_emacs_reloc_copy_from_dump
65. dump_emacs_reloc_immediate
66. DEFINE_EMACS_IMMEDIATE_FN
67. dump_emacs_reloc_to_lv
68. dump_emacs_reloc_to_emacs_ptr_raw
69. dump_remember_fixup_lv
70. dump_remember_fixup_ptr_raw
71. dump_root_visitor
72. dump_roots
73. field_relpos
74. cpyptr
75. dump_field_lv_or_rawptr
76. dump_field_lv_rawptr
77. dump_field_lv
78. dump_field_fixup_later
79. dump_field_ptr_to_dump_offset
80. dump_field_emacs_ptr
81. _dump_object_start_pseudovector
82. finish_dump_pvec
83. dump_pseudovector_lisp_fields
84. dump_cons
85. dump_interval_tree
86. dump_string
87. dump_marker
88. dump_interval_node
89. dump_overlay
90. dump_field_finalizer_ref
91. dump_finalizer
92. dump_bignum
93. dump_float
94. dump_fwd_int
95. dump_fwd_bool
96. dump_fwd_obj
97. dump_fwd_buffer_obj
98. dump_fwd_kboard_obj
99. dump_fwd
100. dump_blv
101. dump_recall_symbol_aux
102. dump_remember_symbol_aux
103. dump_pre_dump_symbol
104. dump_symbol
105. dump_vectorlike_generic
106. hash_table_contents
107. dump_hash_table_list
108. hash_table_freeze
109. hash_table_thaw
110. dump_hash_table
111. dump_buffer
112. dump_bool_vector
113. dump_subr
114. dump_native_comp_unit
115. fill_pseudovec
116. dump_nilled_pseudovec
117. dump_vectorlike
118. dump_object
119. dump_object_for_offset
120. dump_charset
121. dump_charset_table
122. dump_finalizer_list_head_ptr
123. dump_metadata_for_pdumper
124. dump_sort_copied_objects
125. dump_hot_parts_of_discardable_objects
126. dump_drain_copied_objects
127. dump_cold_string
128. dump_cold_charset
129. dump_cold_buffer
130. dump_cold_bignum
131. dump_cold_native_subr
132. dump_drain_cold_data
133. read_ptr_raw_and_lv
134. dump_drain_user_remembered_data_hot
135. dump_drain_user_remembered_data_cold
136. dump_unwind_cleanup
137. dump_check_dump_off
138. dump_check_emacs_off
139. dump_decode_dump_reloc
140. dump_emit_dump_reloc
141. dump_check_overlap_dump_reloc
142. decode_emacs_reloc
143. dump_emit_emacs_reloc
144. dump_merge_emacs_relocs
145. drain_reloc_list
146. dump_do_fixup
147. dump_do_fixups
148. dump_drain_normal_queue
149. dump_drain_deferred_hash_tables
150. dump_drain_deferred_symbols
151. pdumper_do_now_and_after_load_impl
152. pdumper_do_now_and_after_late_load_impl
153. pdumper_remember_user_data_1
154. pdumper_remember_scalar_impl
155. pdumper_remember_lv_ptr_raw_impl
156. dump_anonymous_allocate_w32
157. dump_anonymous_allocate_posix
158. dump_anonymous_allocate
159. dump_anonymous_release
160. dump_map_file_w32
161. dump_map_file_posix
162. dump_map_file
163. dump_unmap_file
164. dump_discard_mem
165. dump_mmap_discard_contents
166. dump_mmap_reset
167. dump_mmap_release
168. dump_mm_heap_cb_release
169. dump_mmap_release_heap
170. dump_mmap_contiguous_heap
171. dump_mmap_release_vm
172. needs_mmap_retry_p
173. dump_mmap_contiguous_vm
174. dump_mmap_contiguous
175. dump_bitsets_init
176. dump_bitset__bit_slot
177. dump_bitset_bit_set_p
178. dump_bitset__set_bit_value
179. dump_bitset_set_bit
180. dump_bitset_clear
181. dump_ptr
182. dump_read_word_from_dump
183. dump_write_word_to_dump
184. dump_write_lv_to_dump
185. dump_find_relocation
186. dump_loaded_p
187. pdumper_cold_object_p_impl
188. pdumper_find_object_type_impl
189. pdumper_marked_p_impl
190. pdumper_set_marked_impl
191. pdumper_clear_marks_impl
192. dump_read_all
193. dump_reloc_size
194. dump_make_lv_from_reloc
195. dump_do_dump_relocation
196. dump_do_all_dump_reloc_for_phase
197. dump_do_emacs_relocation
198. dump_do_all_emacs_relocations
199. pdumper_set_emacs_execdir
200. pdumper_load
201. pdumper_record_wd
202. DEFUN
203. thaw_hash_tables
204. init_pdumper_once
205. syms_of_pdumper

     1 /* Copyright (C) 2018-2023 Free Software Foundation, Inc.
     2 
     3 This file is part of GNU Emacs.
     4 
     5 GNU Emacs is free software: you can redistribute it and/or modify
     6 it under the terms of the GNU General Public License as published by
     7 the Free Software Foundation, either version 3 of the License, or (at
     8 your option) any later version.
     9 
    10 GNU Emacs is distributed in the hope that it will be useful,
    11 but WITHOUT ANY WARRANTY; without even the implied warranty of
    12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    13 GNU General Public License for more details.
    14 
    15 You should have received a copy of the GNU General Public License
    16 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    17 
    18 #include <config.h>
    19 
    20 #include <errno.h>
    21 #include <fcntl.h>
    22 #include <limits.h>
    23 #include <math.h>
    24 #include <stdarg.h>
    25 #include <stdint.h>
    26 #include <stdlib.h>
    27 #include <sys/mman.h>
    28 #include <sys/param.h>
    29 #include <sys/stat.h>
    30 #include <sys/types.h>
    31 #include <unistd.h>
    32 
    33 #include "blockinput.h"
    34 #include "buffer.h"
    35 #include "charset.h"
    36 #include "coding.h"
    37 #include "fingerprint.h"
    38 #include "frame.h"
    39 #include "intervals.h"
    40 #include "lisp.h"
    41 #include "pdumper.h"
    42 #include "window.h"
    43 #include "sysstdio.h"
    44 #include "systime.h"
    45 #include "thread.h"
    46 #include "bignum.h"
    47 
    48 #ifdef CHECK_STRUCTS
    49 # include "dmpstruct.h"
    50 #endif
    51 
    52 /*
    53   TODO:
    54 
    55   - Two-pass dumping: first assemble object list, then write all.
    56     This way, we can perform arbitrary reordering or maybe use fancy
    57     graph algorithms to get better locality.
    58 
    59   - Don't emit relocations that happen to set Emacs memory locations
    60     to values they will already have.
    61 
    62   - Nullify frame_and_buffer_state.
    63 
    64   - Preferred base address for relocation-free non-PIC startup.
    65 
    66   - Compressed dump support.
    67 
    68 */
    69 
    70 #ifdef HAVE_PDUMPER
    71 
    72 #if GNUC_PREREQ (4, 7, 0)
    73 # pragma GCC diagnostic error "-Wshadow"
    74 #endif
    75 
    76 #define VM_POSIX 1
    77 #define VM_MS_WINDOWS 2
    78 
    79 #if defined (HAVE_MMAP) && defined (MAP_FIXED)
    80 # define VM_SUPPORTED VM_POSIX
    81 # if !defined (MAP_POPULATE) && defined (MAP_PREFAULT_READ)
    82 #  define MAP_POPULATE MAP_PREFAULT_READ
    83 # elif !defined (MAP_POPULATE)
    84 #  define MAP_POPULATE 0
    85 # endif
    86 #elif defined (WINDOWSNT)
    87   /* Use a float infinity, to avoid compiler warnings in comparing vs
    88      candidates' score.  */
    89 # undef INFINITY
    90 # define INFINITY __builtin_inff ()
    91 # include <windows.h>
    92 # define VM_SUPPORTED VM_MS_WINDOWS
    93 #else
    94 # define VM_SUPPORTED 0
    95 #endif
    96 
    97 /* Require an architecture in which pointers, ptrdiff_t and intptr_t
    98    are the same size and have the same layout, and where bytes have
    99    eight bits --- that is, a general-purpose computer made after 1990.
   100    Also require Lisp_Object to be at least as wide as pointers.  */
   101 verify (sizeof (ptrdiff_t) == sizeof (void *));
   102 verify (sizeof (intptr_t) == sizeof (ptrdiff_t));
   103 verify (sizeof (void (*) (void)) == sizeof (void *));
   104 verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
   105 verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
   106 verify (CHAR_BIT == 8);
   107 
   108 static size_t
   109 divide_round_up (size_t x, size_t y)
   110 {
   111   return (x + y - 1) / y;
   112 }
   113 
   114 static const char dump_magic[16] = {
   115   'D', 'U', 'M', 'P', 'E', 'D',
   116   'G', 'N', 'U',
   117   'E', 'M', 'A', 'C', 'S'
   118 };
   119 
   120 static pdumper_hook dump_hooks[24];
   121 static int nr_dump_hooks = 0;
   122 
   123 static pdumper_hook dump_late_hooks[24];
   124 static int nr_dump_late_hooks = 0;
   125 
   126 static struct
   127 {
   128   void *mem;
   129   int sz;
   130 } remembered_data[32];
   131 static int nr_remembered_data = 0;
   132 
   133 typedef int_least32_t dump_off;
   134 #define DUMP_OFF_MIN INT_LEAST32_MIN
   135 #define DUMP_OFF_MAX INT_LEAST32_MAX
   136 #define PRIdDUMP_OFF PRIdLEAST32
   137 
   138 enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 };
   139 
   140 static void ATTRIBUTE_FORMAT_PRINTF (1, 2)
   141 dump_trace (const char *fmt, ...)
   142 {
   143   if (0)
   144     {
   145       va_list args;
   146       va_start (args, fmt);
   147       vfprintf (stderr, fmt, args);
   148       va_end (args);
   149     }
   150 }
   151 
   152 static ssize_t dump_read_all (int fd, void *buf, size_t bytes_to_read);
   153 
   154 static dump_off
   155 ptrdiff_t_to_dump_off (ptrdiff_t value)
   156 {
   157   eassert (DUMP_OFF_MIN <= value);
   158   eassert (value <= DUMP_OFF_MAX);
   159   return (dump_off) value;
   160 }
   161 
   162 /* Worst-case allocation granularity on any system that might load
   163    this dump.  */
   164 static int
   165 dump_get_max_page_size (void)
   166 {
   167   return 64 * 1024;
   168 }
   169 
   170 #define dump_offsetof(type, member)                             \
   171   (ptrdiff_t_to_dump_off (offsetof (type, member)))
   172 
   173 enum dump_reloc_type
   174   {
   175     /* dump_ptr = dump_ptr + emacs_basis()  */
   176     RELOC_DUMP_TO_EMACS_PTR_RAW,
   177     /* dump_ptr = dump_ptr + dump_base  */
   178     RELOC_DUMP_TO_DUMP_PTR_RAW,
   179     /* dump_mpz = [rebuild bignum]  */
   180     RELOC_NATIVE_COMP_UNIT,
   181     RELOC_NATIVE_SUBR,
   182     RELOC_BIGNUM,
   183     /* dump_lv = make_lisp_ptr (dump_lv + dump_base,
   184                                 type - RELOC_DUMP_TO_DUMP_LV)
   185        (Special case for symbols: make_lisp_symbol)
   186        Must be second-last.  */
   187     RELOC_DUMP_TO_DUMP_LV,
   188     /* dump_lv = make_lisp_ptr (dump_lv + emacs_basis(),
   189                                 type - RELOC_DUMP_TO_DUMP_LV)
   190        (Special case for symbols: make_lisp_symbol.)
   191        Must be last.  */
   192     RELOC_DUMP_TO_EMACS_LV = RELOC_DUMP_TO_DUMP_LV + 8,
   193   };
   194 
   195 enum emacs_reloc_type
   196   {
   197     /* Copy raw bytes from the dump into Emacs.  The length field in
   198        the emacs_reloc is the number of bytes to copy.  */
   199     RELOC_EMACS_COPY_FROM_DUMP,
   200     /* Set a piece of memory in Emacs to a value we store directly in
   201        this relocation.  The length field contains the number of bytes
   202        we actually copy into Emacs.  */
   203     RELOC_EMACS_IMMEDIATE,
   204     /* Set an aligned pointer-sized object in Emacs to a pointer into
   205        the loaded dump at the given offset.  The length field is
   206        always the machine word size.  */
   207     RELOC_EMACS_DUMP_PTR_RAW,
   208     /* Set an aligned pointer-sized object in Emacs to point to
   209        something also in Emacs.  The length field is always
   210        the machine word size.  */
   211     RELOC_EMACS_EMACS_PTR_RAW,
   212     /* Set an aligned Lisp_Object in Emacs to point to a value in the
   213        dump.  The length field is the _tag type_ of the Lisp_Object,
   214        not a byte count!  */
   215     RELOC_EMACS_DUMP_LV,
   216     /* Set an aligned Lisp_Object in Emacs to point to a value in the
   217        Emacs image.  The length field is the _tag type_ of the
   218        Lisp_Object, not a byte count!  */
   219     RELOC_EMACS_EMACS_LV,
   220   };
   221 
   222 enum
   223   {
   224    EMACS_RELOC_TYPE_BITS = 3,
   225    EMACS_RELOC_LENGTH_BITS = (sizeof (dump_off) * CHAR_BIT
   226                               - EMACS_RELOC_TYPE_BITS)
   227   };
   228 
   229 struct emacs_reloc
   230 {
   231   ENUM_BF (emacs_reloc_type) type : EMACS_RELOC_TYPE_BITS;
   232   dump_off length : EMACS_RELOC_LENGTH_BITS;
   233   dump_off emacs_offset;
   234   union
   235   {
   236     dump_off dump_offset;
   237     dump_off emacs_offset2;
   238     intmax_t immediate;
   239   } u;
   240 };
   241 
   242 /* Set the type of an Emacs relocation.
   243 
   244    Also make sure that the type fits in the bitfield.  */
   245 static void
   246 emacs_reloc_set_type (struct emacs_reloc *reloc,
   247                       enum emacs_reloc_type type)
   248 {
   249   reloc->type = type;
   250   eassert (reloc->type == type);
   251 }
   252 
   253 struct dump_table_locator
   254 {
   255   /* Offset in dump, in bytes, of the first entry in the dump
   256      table.  */
   257   dump_off offset;
   258   /* Number of entries in the dump table.  We need an explicit end
   259      indicator (as opposed to a special sentinel) so we can efficiently
   260      binary search over the relocation entries.  */
   261   dump_off nr_entries;
   262 };
   263 
   264 enum
   265   {
   266    DUMP_RELOC_TYPE_BITS = 5,
   267    DUMP_RELOC_ALIGNMENT_BITS = 2,
   268 
   269    /* Minimum alignment required by dump file format.  */
   270    DUMP_RELOCATION_ALIGNMENT = 1 << DUMP_RELOC_ALIGNMENT_BITS,
   271 
   272    /* The alignment granularity (in bytes) for objects we store in the
   273       dump.  Always suitable for heap objects; may be more aligned.  */
   274    DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT),
   275 
   276    DUMP_RELOC_OFFSET_BITS = sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS
   277   };
   278 
   279 verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
   280 verify (DUMP_ALIGNMENT >= GCALIGNMENT);
   281 
   282 struct dump_reloc
   283 {
   284   unsigned int raw_offset : DUMP_RELOC_OFFSET_BITS;
   285   ENUM_BF (dump_reloc_type) type : DUMP_RELOC_TYPE_BITS;
   286 };
   287 verify (sizeof (struct dump_reloc) == sizeof (dump_off));
   288 
   289 /* Set the type of a dump relocation.
   290 
   291    Also assert that the type fits in the bitfield.  */
   292 static void
   293 dump_reloc_set_type (struct dump_reloc *reloc, enum dump_reloc_type type)
   294 {
   295   reloc->type = type;
   296   eassert (reloc->type == type);
   297 }
   298 
   299 static dump_off
   300 dump_reloc_get_offset (struct dump_reloc reloc)
   301 {
   302   return reloc.raw_offset << DUMP_RELOC_ALIGNMENT_BITS;
   303 }
   304 
   305 static void
   306 dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset)
   307 {
   308   eassert (offset >= 0);
   309   reloc->raw_offset = offset >> DUMP_RELOC_ALIGNMENT_BITS;
   310   if (dump_reloc_get_offset (*reloc) != offset)
   311     error ("dump relocation out of range");
   312 }
   313 
   314 void
   315 dump_fingerprint (FILE *output, char const *label,
   316                   unsigned char const xfingerprint[sizeof fingerprint])
   317 {
   318   enum { hexbuf_size = 2 * sizeof fingerprint };
   319   char hexbuf[hexbuf_size];
   320   hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint);
   321   fprintf (output, "%s%s%.*s\n", label, *label ? ": " : "",
   322            hexbuf_size, hexbuf);
   323 }
   324 
   325 /* To be used if some order in the relocation process has to be enforced. */
   326 enum reloc_phase
   327   {
   328     /* First to run.  Place every relocation with no dependency here.  */
   329     EARLY_RELOCS,
   330     /* Late and very late relocs are relocated at the very last after
   331        all hooks has been run.  All lisp machinery is at disposal
   332        (memory allocation allowed too).  */
   333     LATE_RELOCS,
   334     VERY_LATE_RELOCS,
   335     /* Fake, must be last.  */
   336     RELOC_NUM_PHASES
   337   };
   338 
   339 /* Format of an Emacs dump file.  All offsets are relative to
   340    the beginning of the file.  An Emacs dump file is coupled
   341    to exactly the Emacs binary that produced it, so details of
   342    alignment and endianness are unimportant.
   343 
   344    An Emacs dump file contains the contents of the Lisp heap.
   345    On startup, Emacs can start faster by mapping a dump file into
   346    memory and using the objects contained inside it instead of
   347    performing initialization from scratch.
   348 
   349    The dump file can be loaded at arbitrary locations in memory, so it
   350    includes a table of relocations that let Emacs adjust the pointers
   351    embedded in the dump file to account for the location where it was
   352    actually loaded.
   353 
   354    Dump files can contain pointers to other objects in the dump file
   355    or to parts of the Emacs binary.  */
   356 struct dump_header
   357 {
   358   /* File type magic.  */
   359   char magic[sizeof (dump_magic)];
   360 
   361   /* Associated Emacs binary.  */
   362   unsigned char fingerprint[sizeof fingerprint];
   363 
   364   /* Relocation table for the dump file; each entry is a
   365      struct dump_reloc.  */
   366   struct dump_table_locator dump_relocs[RELOC_NUM_PHASES];
   367 
   368   /* "Relocation" table we abuse to hold information about the
   369      location and type of each lisp object in the dump.  We need for
   370      pdumper_object_type and ultimately for conservative GC
   371      correctness.  */
   372   struct dump_table_locator object_starts;
   373 
   374   /* Relocation table for Emacs; each entry is a struct
   375      emacs_reloc.  */
   376   struct dump_table_locator emacs_relocs;
   377 
   378   /* Start of sub-region of hot region that we can discard after load
   379      completes.  The discardable region ends at cold_start.
   380 
   381      This region contains objects that we copy into the Emacs image at
   382      dump-load time.  */
   383   dump_off discardable_start;
   384 
   385   /* Start of the region that does not require relocations and that we
   386      expect never to be modified.  This region can be memory-mapped
   387      directly from the backing dump file with the reasonable
   388      expectation of taking few copy-on-write faults.
   389 
   390      For correctness, however, this region must be modifible, since in
   391      rare cases it is possible to see modifications to these bytes.
   392      For example, this region contains string data, and it's
   393      technically possible for someone to ASET a string character
   394      (although nobody tends to do that).
   395 
   396      The start of the cold region is always aligned on a page
   397      boundary.  */
   398   dump_off cold_start;
   399 
   400   /* Offset of a vector of the dumped hash tables.  */
   401   dump_off hash_list;
   402 };
   403 
   404 /* Double-ended singly linked list.  */
   405 struct dump_tailq
   406 {
   407   Lisp_Object head;
   408   Lisp_Object tail;
   409   intptr_t length;
   410 };
   411 
   412 /* Queue of objects to dump.  */
   413 struct dump_queue
   414 {
   415   /* Objects with no link weights at all.  Kept in dump order.  */
   416   struct dump_tailq zero_weight_objects;
   417   /* Objects with simple link weight: just one entry of type
   418      WEIGHT_NORMAL.  Score in this special case is non-decreasing as
   419      position increases, so we can avoid the need to rescan a big list
   420      for each object by storing these objects in order.  */
   421   struct dump_tailq one_weight_normal_objects;
   422   /* Likewise, for objects with one WEIGHT_STRONG weight.  */
   423   struct dump_tailq one_weight_strong_objects;
   424   /* List of objects with complex link weights --- i.e., not one of
   425      the above cases.  Order is irrelevant, since we scan the whole
   426      list every time.  Relatively few objects end up here.  */
   427   struct dump_tailq fancy_weight_objects;
   428   /* Hash table of link weights: maps an object to a list of zero or
   429      more (BASIS . WEIGHT) pairs.  As a special case, an object with
   430      zero weight is marked by Qt in the hash table --- this way, we
   431      can distinguish objects we've seen but that have no weight from
   432      ones that we haven't seen at all.  */
   433   Lisp_Object link_weights;
   434   /* Hash table mapping object to a sequence number --- used to
   435      resolve ties.  */
   436   Lisp_Object sequence_numbers;
   437   dump_off next_sequence_number;
   438 };
   439 
   440 enum cold_op
   441   {
   442     COLD_OP_OBJECT,
   443     COLD_OP_STRING,
   444     COLD_OP_CHARSET,
   445     COLD_OP_BUFFER,
   446     COLD_OP_BIGNUM,
   447     COLD_OP_NATIVE_SUBR,
   448   };
   449 
   450 /* This structure controls what operations we perform inside
   451    dump_object.  */
   452 struct dump_flags
   453 {
   454   /* Actually write object contents to the dump.  Without this flag
   455      set, we still scan objects and enqueue pointed-to objects; making
   456      this flag false is useful when we want to process an object's
   457      referents normally, but dump an object itself separately,
   458      later.  */
   459   bool_bf dump_object_contents : 1;
   460   /* Record object starts. We turn this flag off when writing to the
   461      discardable section so that we don't trick conservative GC into
   462      thinking we have objects there.  Ignored (we never record object
   463      starts) if dump_object_contents is false.  */
   464   bool_bf record_object_starts : 1;
   465   /* Pack objects tighter than GC memory alignment would normally
   466      require.  Useful for objects copied into the Emacs image instead
   467      of used directly from the loaded dump.
   468   */
   469   bool_bf pack_objects : 1;
   470   /* Sometimes we dump objects that we've already scanned for outbound
   471      references to other objects.  These objects should not cause new
   472      objects to enter the object dumping queue.  This flag causes Emacs
   473      to assert that no new objects are enqueued while dumping.  */
   474   bool_bf assert_already_seen : 1;
   475   /* Punt on unstable hash tables: defer them to ctx->deferred_hash_tables.  */
   476   bool_bf defer_hash_tables : 1;
   477   /* Punt on symbols: defer them to ctx->deferred_symbols.  */
   478   bool_bf defer_symbols : 1;
   479   /* Punt on cold objects: defer them to ctx->cold_queue.  */
   480   bool_bf defer_cold_objects : 1;
   481   /* Punt on copied objects: defer them to ctx->copied_queue.  */
   482   bool_bf defer_copied_objects : 1;
   483 };
   484 
   485 /* Information we use while we dump.  Note that we're not the garbage
   486    collector and can operate under looser constraints: specifically,
   487    we allocate memory during the dumping process.  */
   488 struct dump_context
   489 {
   490   /* Header we'll write to the dump file when done.  */
   491   struct dump_header header;
   492   /* Data that will be written to the dump file.  */
   493   void *buf;
   494   dump_off buf_size;
   495   dump_off max_offset;
   496 
   497   Lisp_Object old_purify_flag;
   498   Lisp_Object old_post_gc_hook;
   499   Lisp_Object old_process_environment;
   500 
   501 #ifdef REL_ALLOC
   502   bool blocked_ralloc;
   503 #endif
   504 
   505   /* File descriptor for dumpfile; < 0 if closed.  */
   506   int fd;
   507   /* Name of dump file --- used for error reporting.  */
   508   Lisp_Object dump_filename;
   509   /* Current offset in dump file.  */
   510   dump_off offset;
   511 
   512   /* Starting offset of current object.  */
   513   dump_off obj_offset;
   514 
   515   /* Flags currently in effect for dumping.  */
   516   struct dump_flags flags;
   517 
   518   dump_off end_heap;
   519 
   520   /* Hash mapping objects we've already dumped to their offsets.  */
   521   Lisp_Object objects_dumped;
   522 
   523   /* Hash mapping objects to where we got them.  Used for debugging.  */
   524   Lisp_Object referrers;
   525   Lisp_Object current_referrer;
   526   bool have_current_referrer;
   527 
   528   /* Queue of objects to dump.  */
   529   struct dump_queue dump_queue;
   530 
   531   /* Deferred object lists.  */
   532   Lisp_Object deferred_hash_tables;
   533   Lisp_Object deferred_symbols;
   534 
   535   /* Fixups in the dump file.  */
   536   Lisp_Object fixups;
   537 
   538   /* Hash table of staticpro values: avoids double relocations.  */
   539   Lisp_Object staticpro_table;
   540 
   541   /* Hash table mapping symbols to their pre-copy-queue fwd or blv
   542      structures (which we dump immediately before the start of the
   543      discardable section). */
   544   Lisp_Object symbol_aux;
   545   /* Queue of copied objects for special treatment.  */
   546   Lisp_Object copied_queue;
   547   /* Queue of cold objects to dump.  */
   548   Lisp_Object cold_queue;
   549 
   550   /* Relocations in the dump.  */
   551   Lisp_Object dump_relocs[RELOC_NUM_PHASES];
   552 
   553   /* Object starts.  */
   554   Lisp_Object object_starts;
   555 
   556   /* Relocations in Emacs.  */
   557   Lisp_Object emacs_relocs;
   558 
   559   /* Hash table mapping bignums to their _data_ blobs, which we store
   560      in the cold section.  The actual Lisp_Bignum objects are normal
   561      heap objects.  */
   562   Lisp_Object bignum_data;
   563 
   564   /* List of hash tables that have been dumped.  */
   565   Lisp_Object hash_tables;
   566 
   567   dump_off number_hot_relocations;
   568   dump_off number_discardable_relocations;
   569 };
   570 
   571 /* These special values for use as offsets in dump_remember_object and
   572    dump_recall_object indicate that the corresponding object isn't in
   573    the dump yet (and so it has no valid offset), but that it's on one
   574    of our to-be-dumped-later object queues (or that we haven't seen it
   575    at all).  All values must be non-positive, since positive values
   576    are physical dump offsets.  */
   577 enum dump_object_special_offset
   578   {
   579    DUMP_OBJECT_IS_RUNTIME_MAGIC = -6,
   580    DUMP_OBJECT_ON_COPIED_QUEUE = -5,
   581    DUMP_OBJECT_ON_HASH_TABLE_QUEUE = -4,
   582    DUMP_OBJECT_ON_SYMBOL_QUEUE = -3,
   583    DUMP_OBJECT_ON_COLD_QUEUE = -2,
   584    DUMP_OBJECT_ON_NORMAL_QUEUE = -1,
   585    DUMP_OBJECT_NOT_SEEN = 0,
   586   };
   587 
   588 /* Weights for score scores for object non-locality.  */
   589 
   590 struct link_weight
   591 {
   592   /* Wrapped in a struct to break unwanted implicit conversion.  */
   593   int value;
   594 };
   595 
   596 static struct link_weight const
   597   WEIGHT_NONE = { .value = 0 },
   598   WEIGHT_NORMAL = { .value = 1000 },
   599   WEIGHT_STRONG = { .value = 1200 };
   600 
   601 
   602 /* Dump file creation */
   603 
   604 static void dump_grow_buffer (struct dump_context *ctx)
   605 {
   606   ctx->buf = xrealloc (ctx->buf, ctx->buf_size = (ctx->buf_size ?
   607                                                   (ctx->buf_size * 2)
   608                                                   : 8 * 1024 * 1024));
   609 }
   610 
   611 static dump_off dump_object (struct dump_context *ctx, Lisp_Object object);
   612 static dump_off dump_object_for_offset (struct dump_context *ctx,
   613                                         Lisp_Object object);
   614 
   615 /* Like the Lisp function `push'.  Return NEWELT.  */
   616 static Lisp_Object
   617 dump_push (Lisp_Object *where, Lisp_Object newelt)
   618 {
   619   *where = Fcons (newelt, *where);
   620   return newelt;
   621 }
   622 
   623 /* Like the Lisp function `pop'.  */
   624 static Lisp_Object
   625 dump_pop (Lisp_Object *where)
   626 {
   627   Lisp_Object ret = XCAR (*where);
   628   *where = XCDR (*where);
   629   return ret;
   630 }
   631 
   632 static bool
   633 dump_tracking_referrers_p (struct dump_context *ctx)
   634 {
   635   return !NILP (ctx->referrers);
   636 }
   637 
   638 static void
   639 dump_set_have_current_referrer (struct dump_context *ctx, bool have)
   640 {
   641 #ifdef ENABLE_CHECKING
   642   ctx->have_current_referrer = have;
   643 #endif
   644 }
   645 
   646 /* Return true if objects should be enqueued in CTX to refer to an
   647    object that the caller should store into CTX->current_referrer.
   648 
   649    Until dump_clear_referrer is called, any objects enqueued are being
   650    enqueued because the object refers to them.  It is not valid to
   651    enqueue objects without a referrer set.  We check this constraint
   652    at runtime.
   653 
   654    It is invalid to call dump_set_referrer twice without an
   655    intervening call to dump_clear_referrer.  */
   656 static bool
   657 dump_set_referrer (struct dump_context *ctx)
   658 {
   659   eassert (!ctx->have_current_referrer);
   660   dump_set_have_current_referrer (ctx, true);
   661   return dump_tracking_referrers_p (ctx);
   662 }
   663 
   664 /* Unset the referrer that dump_set_referrer prepared for.  */
   665 static void
   666 dump_clear_referrer (struct dump_context *ctx)
   667 {
   668   eassert (ctx->have_current_referrer);
   669   dump_set_have_current_referrer (ctx, false);
   670   if (dump_tracking_referrers_p (ctx))
   671     ctx->current_referrer = Qnil;
   672 }
   673 
   674 static Lisp_Object
   675 dump_ptr_referrer (const char *label, void const *address)
   676 {
   677   char buf[128];
   678   buf[0] = '\0';
   679   sprintf (buf, "%s @ %p", label, address);
   680   return build_string (buf);
   681 }
   682 
   683 static void
   684 print_paths_to_root (struct dump_context *ctx, Lisp_Object object);
   685 
   686 static void dump_remember_cold_op (struct dump_context *ctx,
   687                                    enum cold_op op,
   688                                    Lisp_Object arg);
   689 
   690 static AVOID
   691 error_unsupported_dump_object (struct dump_context *ctx,
   692                                Lisp_Object object,
   693                                const char *msg)
   694 {
   695   if (dump_tracking_referrers_p (ctx))
   696     print_paths_to_root (ctx, object);
   697   error ("unsupported object type in dump: %s", msg);
   698 }
   699 
   700 static uintptr_t
   701 emacs_basis (void)
   702 {
   703   return (uintptr_t) &Vpurify_flag;
   704 }
   705 
   706 static void *
   707 emacs_ptr_at (const ptrdiff_t offset)
   708 {
   709   /* TODO: assert somehow that the result is actually in the Emacs
   710      image.  */
   711   return (void *) (emacs_basis () + offset);
   712 }
   713 
   714 static dump_off
   715 emacs_offset (const void *emacs_ptr)
   716 {
   717   /* TODO: assert that EMACS_PTR is actually in the Emacs image.  */
   718   eassert (emacs_ptr != NULL);
   719   intptr_t emacs_ptr_value = (intptr_t) emacs_ptr;
   720   ptrdiff_t emacs_ptr_relative = emacs_ptr_value - (intptr_t) emacs_basis ();
   721   return ptrdiff_t_to_dump_off (emacs_ptr_relative);
   722 }
   723 
   724 /* Return whether OBJECT is a symbol the storage of which is built
   725    into Emacs (and so is invariant across ASLR).  */
   726 static bool
   727 dump_builtin_symbol_p (Lisp_Object object)
   728 {
   729   return SYMBOLP (object) && c_symbol_p (XSYMBOL (object));
   730 }
   731 
   732 /* Return whether OBJECT has the same bit pattern in all Emacs
   733    invocations --- i.e., is invariant across a dump.  Note that some
   734    self-representing objects still need to be dumped!
   735 */
   736 static bool
   737 dump_object_self_representing_p (Lisp_Object object)
   738 {
   739   return FIXNUMP (object) || dump_builtin_symbol_p (object);
   740 }
   741 
   742 static intmax_t
   743 intmax_t_from_lisp (Lisp_Object value)
   744 {
   745   intmax_t n;
   746   bool ok = integer_to_intmax (value, &n);
   747   eassert (ok);
   748   return n;
   749 }
   750 
   751 static Lisp_Object
   752 intmax_t_to_lisp (intmax_t value)
   753 {
   754   return INT_TO_INTEGER (value);
   755 }
   756 
   757 static dump_off
   758 dump_off_from_lisp (Lisp_Object value)
   759 {
   760   intmax_t n = intmax_t_from_lisp (value);
   761   eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
   762   return n;
   763 }
   764 
   765 static Lisp_Object
   766 dump_off_to_lisp (dump_off value)
   767 {
   768   return INT_TO_INTEGER (value);
   769 }
   770 
   771 static void
   772 dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte)
   773 {
   774   eassert (nbyte == 0 || buf != NULL);
   775   eassert (ctx->obj_offset == 0);
   776   eassert (ctx->flags.dump_object_contents);
   777   while (ctx->offset + nbyte > ctx->buf_size)
   778     dump_grow_buffer (ctx);
   779   memcpy ((char *)ctx->buf + ctx->offset, buf, nbyte);
   780   ctx->offset += nbyte;
   781 }
   782 
   783 static Lisp_Object
   784 make_eq_hash_table (void)
   785 {
   786   return CALLN (Fmake_hash_table, QCtest, Qeq);
   787 }
   788 
   789 static void
   790 dump_tailq_init (struct dump_tailq *tailq)
   791 {
   792   tailq->head = tailq->tail = Qnil;
   793   tailq->length = 0;
   794 }
   795 
   796 static intptr_t
   797 dump_tailq_length (const struct dump_tailq *tailq)
   798 {
   799   return tailq->length;
   800 }
   801 
   802 static void
   803 dump_tailq_prepend (struct dump_tailq *tailq, Lisp_Object value)
   804 {
   805   Lisp_Object link = Fcons (value, tailq->head);
   806   tailq->head = link;
   807   if (NILP (tailq->tail))
   808     tailq->tail = link;
   809   tailq->length += 1;
   810 }
   811 
   812 static bool
   813 dump_tailq_empty_p (struct dump_tailq *tailq)
   814 {
   815   return NILP (tailq->head);
   816 }
   817 
   818 static Lisp_Object
   819 dump_tailq_peek (struct dump_tailq *tailq)
   820 {
   821   eassert (!dump_tailq_empty_p (tailq));
   822   return XCAR (tailq->head);
   823 }
   824 
   825 static Lisp_Object
   826 dump_tailq_pop (struct dump_tailq *tailq)
   827 {
   828   eassert (!dump_tailq_empty_p (tailq));
   829   eassert (tailq->length > 0);
   830   tailq->length -= 1;
   831   Lisp_Object value = XCAR (tailq->head);
   832   tailq->head = XCDR (tailq->head);
   833   if (NILP (tailq->head))
   834     tailq->tail = Qnil;
   835   return value;
   836 }
   837 
   838 static void
   839 dump_seek (struct dump_context *ctx, dump_off offset)
   840 {
   841   if (ctx->max_offset < ctx->offset)
   842     ctx->max_offset = ctx->offset;
   843   eassert (ctx->obj_offset == 0);
   844   ctx->offset = offset;
   845 }
   846 
   847 static void
   848 dump_write_zero (struct dump_context *ctx, dump_off nbytes)
   849 {
   850   while (nbytes > 0)
   851     {
   852       uintmax_t zero = 0;
   853       dump_off to_write = sizeof (zero);
   854       if (to_write > nbytes)
   855         to_write = nbytes;
   856       dump_write (ctx, &zero, to_write);
   857       nbytes -= to_write;
   858     }
   859 }
   860 
   861 static void
   862 dump_align_output (struct dump_context *ctx, int alignment)
   863 {
   864   if (ctx->offset % alignment != 0)
   865     dump_write_zero (ctx, alignment - (ctx->offset % alignment));
   866 }
   867 
   868 static dump_off
   869 dump_object_start (struct dump_context *ctx,
   870                    void *out,
   871                    dump_off outsz)
   872 {
   873   /* We dump only one object at a time, so obj_offset should be
   874      invalid on entry to this function.  */
   875   eassert (ctx->obj_offset == 0);
   876   int alignment = ctx->flags.pack_objects ? 1 : DUMP_ALIGNMENT;
   877   if (ctx->flags.dump_object_contents)
   878     dump_align_output (ctx, alignment);
   879   ctx->obj_offset = ctx->offset;
   880   memset (out, 0, outsz);
   881   return ctx->offset;
   882 }
   883 
   884 static dump_off
   885 dump_object_finish (struct dump_context *ctx,
   886                     const void *out,
   887                     dump_off sz)
   888 {
   889   dump_off offset = ctx->obj_offset;
   890   eassert (offset > 0);
   891   eassert (offset == ctx->offset); /* No intervening writes.  */
   892   ctx->obj_offset = 0;
   893   if (ctx->flags.dump_object_contents)
   894     dump_write (ctx, out, sz);
   895   return offset;
   896 }
   897 
   898 /* Return offset at which OBJECT has been dumped, or one of the dump_object_special_offset
   899    negative values, or DUMP_OBJECT_NOT_SEEN.  */
   900 static dump_off
   901 dump_recall_object (struct dump_context *ctx, Lisp_Object object)
   902 {
   903   Lisp_Object dumped = ctx->objects_dumped;
   904   return dump_off_from_lisp (Fgethash (object, dumped,
   905                                        make_fixnum (DUMP_OBJECT_NOT_SEEN)));
   906 }
   907 
   908 static void
   909 dump_remember_object (struct dump_context *ctx,
   910                       Lisp_Object object,
   911                       dump_off offset)
   912 {
   913   Fputhash (object,
   914             dump_off_to_lisp (offset),
   915             ctx->objects_dumped);
   916 }
   917 
   918 static void
   919 dump_note_reachable (struct dump_context *ctx, Lisp_Object object)
   920 {
   921   eassert (ctx->have_current_referrer);
   922   if (!dump_tracking_referrers_p (ctx))
   923     return;
   924   Lisp_Object referrer = ctx->current_referrer;
   925   Lisp_Object obj_referrers = Fgethash (object, ctx->referrers, Qnil);
   926   if (NILP (Fmemq (referrer, obj_referrers)))
   927     Fputhash (object, Fcons (referrer, obj_referrers), ctx->referrers);
   928 }
   929 
   930 /* If this object lives in the Emacs image and not on the heap, return
   931    a pointer to the object data.  Otherwise, return NULL.  */
   932 static void *
   933 dump_object_emacs_ptr (Lisp_Object lv)
   934 {
   935   if (SUBRP (lv) && !SUBR_NATIVE_COMPILEDP (lv))
   936     return XSUBR (lv);
   937   if (dump_builtin_symbol_p (lv))
   938     return XSYMBOL (lv);
   939   if (XTYPE (lv) == Lisp_Vectorlike
   940       && PSEUDOVECTOR_TYPEP (&XVECTOR (lv)->header, PVEC_THREAD)
   941       && main_thread_p (XTHREAD (lv)))
   942     return XTHREAD (lv);
   943   return NULL;
   944 }
   945 
   946 static void
   947 dump_queue_init (struct dump_queue *dump_queue)
   948 {
   949   dump_tailq_init (&dump_queue->zero_weight_objects);
   950   dump_tailq_init (&dump_queue->one_weight_normal_objects);
   951   dump_tailq_init (&dump_queue->one_weight_strong_objects);
   952   dump_tailq_init (&dump_queue->fancy_weight_objects);
   953   dump_queue->link_weights = make_eq_hash_table ();
   954   dump_queue->sequence_numbers = make_eq_hash_table ();
   955   dump_queue->next_sequence_number = 1;
   956 }
   957 
   958 static bool
   959 dump_queue_empty_p (struct dump_queue *dump_queue)
   960 {
   961   ptrdiff_t count = XHASH_TABLE (dump_queue->sequence_numbers)->count;
   962   bool is_empty = count == 0;
   963   eassert (count == XFIXNAT (Fhash_table_count (dump_queue->link_weights)));
   964   if (!is_empty)
   965     {
   966       eassert (!dump_tailq_empty_p (&dump_queue->zero_weight_objects)
   967                || !dump_tailq_empty_p (&dump_queue->one_weight_normal_objects)
   968                || !dump_tailq_empty_p (&dump_queue->one_weight_strong_objects)
   969                || !dump_tailq_empty_p (&dump_queue->fancy_weight_objects));
   970     }
   971   else
   972     {
   973       /* If we're empty, we can still have a few stragglers on one of
   974          the above queues.  */
   975     }
   976 
   977   return is_empty;
   978 }
   979 
   980 static void
   981 dump_queue_push_weight (Lisp_Object *weight_list,
   982                         dump_off basis,
   983                         struct link_weight weight)
   984 {
   985   if (EQ (*weight_list, Qt))
   986     *weight_list = Qnil;
   987   dump_push (weight_list, Fcons (dump_off_to_lisp (basis),
   988                                  dump_off_to_lisp (weight.value)));
   989 }
   990 
   991 static void
   992 dump_queue_enqueue (struct dump_queue *dump_queue,
   993                     Lisp_Object object,
   994                     dump_off basis,
   995                     struct link_weight weight)
   996 {
   997   Lisp_Object weights = Fgethash (object, dump_queue->link_weights, Qnil);
   998   Lisp_Object orig_weights = weights;
   999   /* N.B. want to find the last item of a given weight in each queue
  1000      due to prepend use.  */
  1001   bool use_single_queues = true;
  1002   if (NILP (weights))
  1003     {
  1004       /* Object is new.  */
  1005       EMACS_UINT uobj = XLI (object);
  1006       dump_trace ("new object %0*"pI"x weight=%d\n", EMACS_INT_XDIGITS, uobj,
  1007                   weight.value);
  1008 
  1009       if (weight.value == WEIGHT_NONE.value)
  1010         {
  1011           eassert (weight.value == 0);
  1012           dump_tailq_prepend (&dump_queue->zero_weight_objects, object);
  1013           weights = Qt;
  1014         }
  1015       else if (!use_single_queues)
  1016         {
  1017           dump_tailq_prepend (&dump_queue->fancy_weight_objects, object);
  1018           dump_queue_push_weight (&weights, basis, weight);
  1019         }
  1020       else if (weight.value == WEIGHT_NORMAL.value)
  1021         {
  1022           dump_tailq_prepend (&dump_queue->one_weight_normal_objects, object);
  1023           dump_queue_push_weight (&weights, basis, weight);
  1024         }
  1025       else if (weight.value == WEIGHT_STRONG.value)
  1026         {
  1027           dump_tailq_prepend (&dump_queue->one_weight_strong_objects, object);
  1028           dump_queue_push_weight (&weights, basis, weight);
  1029         }
  1030       else
  1031         {
  1032           emacs_abort ();
  1033         }
  1034 
  1035       Fputhash (object,
  1036                 dump_off_to_lisp(dump_queue->next_sequence_number++),
  1037                 dump_queue->sequence_numbers);
  1038     }
  1039   else
  1040     {
  1041       /* Object was already on the queue.  It's okay for an object to
  1042          be on multiple queues so long as we maintain order
  1043          invariants: attempting to dump an object multiple times is
  1044          harmless, and most of the time, an object is only referenced
  1045          once before being dumped, making this code path uncommon.  */
  1046       if (weight.value != WEIGHT_NONE.value)
  1047         {
  1048           if (EQ (weights, Qt))
  1049             {
  1050               /* Object previously had a zero weight.  Once we
  1051                  incorporate the link weight attached to this call,
  1052                  the object will have a single weight.  Put the object
  1053                  on the appropriate single-weight queue.  */
  1054               weights = Qnil;
  1055               struct dump_tailq *tailq;
  1056               if (!use_single_queues)
  1057                 tailq = &dump_queue->fancy_weight_objects;
  1058               else if (weight.value == WEIGHT_NORMAL.value)
  1059                 tailq = &dump_queue->one_weight_normal_objects;
  1060               else if (weight.value == WEIGHT_STRONG.value)
  1061                 tailq = &dump_queue->one_weight_strong_objects;
  1062               else
  1063                 emacs_abort ();
  1064               dump_tailq_prepend (tailq, object);
  1065             }
  1066           else if (use_single_queues && NILP (XCDR (weights)))
  1067             dump_tailq_prepend (&dump_queue->fancy_weight_objects, object);
  1068           dump_queue_push_weight (&weights, basis, weight);
  1069         }
  1070     }
  1071 
  1072   if (!BASE_EQ (weights, orig_weights))
  1073     Fputhash (object, weights, dump_queue->link_weights);
  1074 }
  1075 
  1076 static float
  1077 dump_calc_link_score (dump_off basis,
  1078                       dump_off link_basis,
  1079                       dump_off link_weight)
  1080 {
  1081   float distance = (float)(basis - link_basis);
  1082   eassert (distance >= 0);
  1083   float link_score = powf (distance, -0.2f);
  1084   return powf (link_score, (float) link_weight / 1000.0f);
  1085 }
  1086 
  1087 /* Compute the score for a queued object.
  1088 
  1089    OBJECT is the object to query, which must currently be queued for
  1090    dumping.  BASIS is the offset at which we would be
  1091    dumping the object; score is computed relative to BASIS and the
  1092    various BASIS values supplied to dump_add_link_weight --- the
  1093    further an object is from its referrers, the greater the
  1094    score.  */
  1095 static float
  1096 dump_queue_compute_score (struct dump_queue *dump_queue,
  1097                           Lisp_Object object,
  1098                           dump_off basis)
  1099 {
  1100   float score = 0;
  1101   Lisp_Object object_link_weights =
  1102     Fgethash (object, dump_queue->link_weights, Qnil);
  1103   if (EQ (object_link_weights, Qt))
  1104     object_link_weights = Qnil;
  1105   while (!NILP (object_link_weights))
  1106     {
  1107       Lisp_Object basis_weight_pair = dump_pop (&object_link_weights);
  1108       dump_off link_basis = dump_off_from_lisp (XCAR (basis_weight_pair));
  1109       dump_off link_weight = dump_off_from_lisp (XCDR (basis_weight_pair));
  1110       score += dump_calc_link_score (basis, link_basis, link_weight);
  1111     }
  1112   return score;
  1113 }
  1114 
  1115 /* Scan the fancy part of the dump queue.
  1116 
  1117    BASIS is the position at which to evaluate the score function,
  1118    usually ctx->offset.
  1119 
  1120    If we have at least one entry in the queue, return the pointer (in
  1121    the singly-linked list) to the cons containing the object via
  1122    *OUT_HIGHEST_SCORE_CONS_PTR and return its score.
  1123 
  1124    If the queue is empty, set *OUT_HIGHEST_SCORE_CONS_PTR to NULL
  1125    and return negative infinity.  */
  1126 static float
  1127 dump_queue_scan_fancy (struct dump_queue *dump_queue,
  1128                        dump_off basis,
  1129                        Lisp_Object **out_highest_score_cons_ptr)
  1130 {
  1131   Lisp_Object *cons_ptr = &dump_queue->fancy_weight_objects.head;
  1132   Lisp_Object *highest_score_cons_ptr = NULL;
  1133   float highest_score = -INFINITY;
  1134   bool first = true;
  1135 
  1136   while (!NILP (*cons_ptr))
  1137     {
  1138       Lisp_Object queued_object = XCAR (*cons_ptr);
  1139       float score = dump_queue_compute_score (dump_queue, queued_object, basis);
  1140       if (first || score >= highest_score)
  1141         {
  1142           highest_score_cons_ptr = cons_ptr;
  1143           highest_score = score;
  1144           if (first)
  1145             first = false;
  1146         }
  1147       cons_ptr = &XCONS (*cons_ptr)->u.s.u.cdr;
  1148     }
  1149 
  1150   *out_highest_score_cons_ptr = highest_score_cons_ptr;
  1151   return highest_score;
  1152 }
  1153 
  1154 /* Return the sequence number of OBJECT.
  1155 
  1156    Return -1 if object doesn't have a sequence number.  This situation
  1157    can occur when we've double-queued an object.  If this happens, we
  1158    discard the errant object and try again.  */
  1159 static dump_off
  1160 dump_queue_sequence (struct dump_queue *dump_queue,
  1161                      Lisp_Object object)
  1162 {
  1163   Lisp_Object n = Fgethash (object, dump_queue->sequence_numbers, Qnil);
  1164   return NILP (n) ? -1 : dump_off_from_lisp (n);
  1165 }
  1166 
  1167 /* Find score and sequence at head of a one-weight object queue.
  1168 
  1169    Transparently discard stale objects from head of queue.  BASIS
  1170    is the baseness for score computation.
  1171 
  1172    We organize these queues so that score is strictly decreasing, so
  1173    examining the head is sufficient.  */
  1174 static void
  1175 dump_queue_find_score_of_one_weight_queue (struct dump_queue *dump_queue,
  1176                                            dump_off basis,
  1177                                            struct dump_tailq *one_weight_queue,
  1178                                            float *out_score,
  1179                                            int *out_sequence)
  1180 {
  1181   /* Transparently discard stale objects from the head of this queue.  */
  1182   do
  1183     {
  1184       if (dump_tailq_empty_p (one_weight_queue))
  1185         {
  1186           *out_score = -INFINITY;
  1187           *out_sequence = 0;
  1188         }
  1189       else
  1190         {
  1191           Lisp_Object head = dump_tailq_peek (one_weight_queue);
  1192           *out_sequence = dump_queue_sequence (dump_queue, head);
  1193           if (*out_sequence < 0)
  1194             dump_tailq_pop (one_weight_queue);
  1195           else
  1196             *out_score =
  1197               dump_queue_compute_score (dump_queue, head, basis);
  1198         }
  1199     }
  1200   while (*out_sequence < 0);
  1201 }
  1202 
  1203 /* Pop the next object to dump from the dump queue.
  1204 
  1205    BASIS is the dump offset at which to evaluate score.
  1206 
  1207    The object returned is the queued object with the greatest score;
  1208    by side effect, the object is removed from the dump queue.
  1209    The dump queue must not be empty.  */
  1210 static Lisp_Object
  1211 dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis)
  1212 {
  1213   eassert (BASE_EQ (Fhash_table_count (dump_queue->sequence_numbers),
  1214                     Fhash_table_count (dump_queue->link_weights)));
  1215 
  1216   eassert (XFIXNUM (Fhash_table_count (dump_queue->sequence_numbers))
  1217            <= (dump_tailq_length (&dump_queue->fancy_weight_objects)
  1218                + dump_tailq_length (&dump_queue->zero_weight_objects)
  1219                + dump_tailq_length (&dump_queue->one_weight_normal_objects)
  1220                + dump_tailq_length (&dump_queue->one_weight_strong_objects)));
  1221 
  1222   dump_trace
  1223     (("dump_queue_dequeue basis=%"PRIdDUMP_OFF" fancy=%"PRIdPTR
  1224       " zero=%"PRIdPTR" normal=%"PRIdPTR" strong=%"PRIdPTR" hash=%td\n"),
  1225      basis,
  1226      dump_tailq_length (&dump_queue->fancy_weight_objects),
  1227      dump_tailq_length (&dump_queue->zero_weight_objects),
  1228      dump_tailq_length (&dump_queue->one_weight_normal_objects),
  1229      dump_tailq_length (&dump_queue->one_weight_strong_objects),
  1230      XHASH_TABLE (dump_queue->link_weights)->count);
  1231 
  1232   static const int nr_candidates = 3;
  1233   struct candidate
  1234   {
  1235     float score;
  1236     dump_off sequence;
  1237   } candidates[nr_candidates];
  1238 
  1239   Lisp_Object *fancy_cons = NULL;
  1240   candidates[0].sequence = 0;
  1241   do
  1242     {
  1243       if (candidates[0].sequence < 0)
  1244         *fancy_cons = XCDR (*fancy_cons);  /* Discard stale object.  */
  1245       candidates[0].score = dump_queue_scan_fancy (dump_queue, basis,
  1246                                                    &fancy_cons);
  1247       candidates[0].sequence =
  1248         candidates[0].score > -INFINITY
  1249         ? dump_queue_sequence (dump_queue, XCAR (*fancy_cons))
  1250         : 0;
  1251     }
  1252   while (candidates[0].sequence < 0);
  1253 
  1254   dump_queue_find_score_of_one_weight_queue
  1255     (dump_queue, basis,
  1256      &dump_queue->one_weight_normal_objects,
  1257      &candidates[1].score,
  1258      &candidates[1].sequence);
  1259 
  1260   dump_queue_find_score_of_one_weight_queue
  1261     (dump_queue, basis,
  1262      &dump_queue->one_weight_strong_objects,
  1263      &candidates[2].score,
  1264      &candidates[2].sequence);
  1265 
  1266   int best = -1;
  1267   for (int i = 0; i < nr_candidates; ++i)
  1268     {
  1269       eassert (candidates[i].sequence >= 0);
  1270       if (candidates[i].score > -INFINITY
  1271           && (best < 0
  1272               || candidates[i].score > candidates[best].score
  1273               || (candidates[i].score == candidates[best].score
  1274                   && candidates[i].sequence < candidates[best].sequence)))
  1275         best = i;
  1276     }
  1277 
  1278   Lisp_Object result;
  1279   const char *src;
  1280   if (best < 0)
  1281     {
  1282       src = "zero";
  1283       result = dump_tailq_pop (&dump_queue->zero_weight_objects);
  1284     }
  1285   else if (best == 0)
  1286     {
  1287       src = "fancy";
  1288       result = dump_tailq_pop (&dump_queue->fancy_weight_objects);
  1289     }
  1290   else if (best == 1)
  1291     {
  1292       src = "normal";
  1293       result = dump_tailq_pop (&dump_queue->one_weight_normal_objects);
  1294     }
  1295   else if (best == 2)
  1296     {
  1297       src = "strong";
  1298       result = dump_tailq_pop (&dump_queue->one_weight_strong_objects);
  1299     }
  1300   else
  1301     emacs_abort ();
  1302 
  1303   EMACS_UINT uresult = XLI (result);
  1304   dump_trace ("  result score=%f src=%s object=%0*"pI"x\n",
  1305               best < 0 ? -1.0 : (double) candidates[best].score,
  1306               src, EMACS_INT_XDIGITS, uresult);
  1307 
  1308   {
  1309     Lisp_Object weights = Fgethash (result, dump_queue->link_weights, Qnil);
  1310     while (!NILP (weights) && CONSP (weights))
  1311       {
  1312         Lisp_Object basis_weight_pair = dump_pop (&weights);
  1313         dump_off link_basis =
  1314           dump_off_from_lisp (XCAR (basis_weight_pair));
  1315         dump_off link_weight =
  1316           dump_off_from_lisp (XCDR (basis_weight_pair));
  1317         dump_trace
  1318           ("    link_basis=%d distance=%d weight=%d contrib=%f\n",
  1319            link_basis,
  1320            basis - link_basis,
  1321            link_weight,
  1322            (double) dump_calc_link_score (basis, link_basis, link_weight));
  1323       }
  1324   }
  1325 
  1326   Fremhash (result, dump_queue->link_weights);
  1327   Fremhash (result, dump_queue->sequence_numbers);
  1328   return result;
  1329 }
  1330 
  1331 /* Return whether we need to write OBJECT to the dump file.  */
  1332 static bool
  1333 dump_object_needs_dumping_p (Lisp_Object object)
  1334 {
  1335   /* Some objects, like symbols, are self-representing because they
  1336      have invariant bit patterns, but sometimes these objects have
  1337      associated data too, and these data-carrying objects need to be
  1338      included in the dump despite all references to them being
  1339      bitwise-invariant.  */
  1340   return (!dump_object_self_representing_p (object)
  1341           || dump_object_emacs_ptr (object));
  1342 }
  1343 
  1344 static void
  1345 dump_enqueue_object (struct dump_context *ctx,
  1346                      Lisp_Object object,
  1347                      struct link_weight weight)
  1348 {
  1349   if (dump_object_needs_dumping_p (object))
  1350     {
  1351       dump_off state = dump_recall_object (ctx, object);
  1352       bool already_dumped_object = state > DUMP_OBJECT_NOT_SEEN;
  1353       if (ctx->flags.assert_already_seen)
  1354         eassert (already_dumped_object);
  1355       if (!already_dumped_object)
  1356         {
  1357           if (state == DUMP_OBJECT_NOT_SEEN)
  1358             {
  1359               state = DUMP_OBJECT_ON_NORMAL_QUEUE;
  1360               dump_remember_object (ctx, object, state);
  1361             }
  1362           /* Note that we call dump_queue_enqueue even if the object
  1363              is already on the normal queue: multiple enqueue calls
  1364              can increase the object's weight.  */
  1365           if (state == DUMP_OBJECT_ON_NORMAL_QUEUE)
  1366             dump_queue_enqueue (&ctx->dump_queue,
  1367                                 object,
  1368                                 ctx->offset,
  1369                                 weight);
  1370         }
  1371     }
  1372   /* Always remember the path to this object.  */
  1373   dump_note_reachable (ctx, object);
  1374 }
  1375 
  1376 static void
  1377 print_paths_to_root_1 (struct dump_context *ctx,
  1378                        Lisp_Object object,
  1379                        int level)
  1380 {
  1381   Lisp_Object referrers = Fgethash (object, ctx->referrers, Qnil);
  1382   while (!NILP (referrers))
  1383     {
  1384       Lisp_Object referrer = XCAR (referrers);
  1385       referrers = XCDR (referrers);
  1386       Lisp_Object repr = Fprin1_to_string (referrer, Qnil, Qnil);
  1387       for (int i = 0; i < level; ++i)
  1388         putc (' ', stderr);
  1389       fwrite (SDATA (repr), 1, SBYTES (repr), stderr);
  1390       putc ('\n', stderr);
  1391       print_paths_to_root_1 (ctx, referrer, level + 1);
  1392     }
  1393 }
  1394 
  1395 static void
  1396 print_paths_to_root (struct dump_context *ctx, Lisp_Object object)
  1397 {
  1398   print_paths_to_root_1 (ctx, object, 0);
  1399 }
  1400 
  1401 static void
  1402 dump_remember_cold_op (struct dump_context *ctx,
  1403                        enum cold_op op,
  1404                        Lisp_Object arg)
  1405 {
  1406   if (ctx->flags.dump_object_contents)
  1407     dump_push (&ctx->cold_queue, Fcons (make_fixnum (op), arg));
  1408 }
  1409 
  1410 /* Add a dump relocation that points into Emacs.
  1411 
  1412    Add a relocation that updates the pointer stored at DUMP_OFFSET to
  1413    point into the Emacs binary upon dump load.  The pointer-sized
  1414    value at DUMP_OFFSET in the dump file should contain a number
  1415    relative to emacs_basis().  */
  1416 static void
  1417 dump_reloc_dump_to_emacs_ptr_raw (struct dump_context *ctx,
  1418                                   dump_off dump_offset)
  1419 {
  1420   if (ctx->flags.dump_object_contents)
  1421     dump_push (&ctx->dump_relocs[EARLY_RELOCS],
  1422                list2 (make_fixnum (RELOC_DUMP_TO_EMACS_PTR_RAW),
  1423                       dump_off_to_lisp (dump_offset)));
  1424 }
  1425 
  1426 /* Add a dump relocation that points a Lisp_Object back at the dump.
  1427 
  1428    Add a relocation that updates the Lisp_Object at DUMP_OFFSET in the
  1429    dump to point to another object in the dump.  The Lisp_Object-sized
  1430    value at DUMP_OFFSET in the dump file should contain the offset of
  1431    the target object relative to the start of the dump.  */
  1432 static void
  1433 dump_reloc_dump_to_dump_lv (struct dump_context *ctx,
  1434                             dump_off dump_offset,
  1435                             enum Lisp_Type type)
  1436 {
  1437   if (!ctx->flags.dump_object_contents)
  1438     return;
  1439 
  1440   int reloc_type;
  1441   switch (type)
  1442     {
  1443     case Lisp_Symbol:
  1444     case Lisp_String:
  1445     case Lisp_Vectorlike:
  1446     case Lisp_Cons:
  1447     case Lisp_Float:
  1448       reloc_type = RELOC_DUMP_TO_DUMP_LV + type;
  1449       break;
  1450     default:
  1451       emacs_abort ();
  1452     }
  1453 
  1454   dump_push (&ctx->dump_relocs[EARLY_RELOCS],
  1455              list2 (make_fixnum (reloc_type),
  1456                     dump_off_to_lisp (dump_offset)));
  1457 }
  1458 
  1459 /* Add a dump relocation that points a raw pointer back at the dump.
  1460 
  1461    Add a relocation that updates the raw pointer at DUMP_OFFSET in the
  1462    dump to point to another object in the dump.  The pointer-sized
  1463    value at DUMP_OFFSET in the dump file should contain the offset of
  1464    the target object relative to the start of the dump.  */
  1465 static void
  1466 dump_reloc_dump_to_dump_ptr_raw (struct dump_context *ctx,
  1467                                  dump_off dump_offset)
  1468 {
  1469   if (ctx->flags.dump_object_contents)
  1470     dump_push (&ctx->dump_relocs[EARLY_RELOCS],
  1471                list2 (make_fixnum (RELOC_DUMP_TO_DUMP_PTR_RAW),
  1472                       dump_off_to_lisp (dump_offset)));
  1473 }
  1474 
  1475 /* Add a dump relocation that points to a Lisp object in Emacs.
  1476 
  1477    Add a relocation that updates the Lisp_Object at DUMP_OFFSET in the
  1478    dump to point to a lisp object in Emacs.  The Lisp_Object-sized
  1479    value at DUMP_OFFSET in the dump file should contain the offset of
  1480    the target object relative to emacs_basis().  TYPE is the type of
  1481    Lisp value.  */
  1482 static void
  1483 dump_reloc_dump_to_emacs_lv (struct dump_context *ctx,
  1484                              dump_off dump_offset,
  1485                              enum Lisp_Type type)
  1486 {
  1487   if (!ctx->flags.dump_object_contents)
  1488     return;
  1489 
  1490   int reloc_type;
  1491   switch (type)
  1492     {
  1493     case Lisp_String:
  1494     case Lisp_Vectorlike:
  1495     case Lisp_Cons:
  1496     case Lisp_Float:
  1497       reloc_type = RELOC_DUMP_TO_EMACS_LV + type;
  1498       break;
  1499     default:
  1500       emacs_abort ();
  1501     }
  1502 
  1503   dump_push (&ctx->dump_relocs[EARLY_RELOCS],
  1504              list2 (make_fixnum (reloc_type),
  1505                     dump_off_to_lisp (dump_offset)));
  1506 }
  1507 
  1508 /* Add an Emacs relocation that copies arbitrary bytes from the dump.
  1509 
  1510    When the dump is loaded, Emacs copies SIZE bytes from OFFSET in
  1511    dump to LOCATION in the Emacs data section.  This copying happens
  1512    after other relocations, so it's all right to, say, copy a
  1513    Lisp_Object (since by the time we copy the Lisp_Object, it'll have
  1514    been adjusted to account for the location of the running Emacs and
  1515    dump file).  */
  1516 static void
  1517 dump_emacs_reloc_copy_from_dump (struct dump_context *ctx, dump_off dump_offset,
  1518                                  void *emacs_ptr, dump_off size)
  1519 {
  1520   eassert (size >= 0);
  1521   eassert (size < (1 << EMACS_RELOC_LENGTH_BITS));
  1522 
  1523   if (!ctx->flags.dump_object_contents)
  1524     return;
  1525 
  1526   if (size == 0)
  1527     return;
  1528 
  1529   eassert (dump_offset >= 0);
  1530   dump_push (&ctx->emacs_relocs,
  1531              list4 (make_fixnum (RELOC_EMACS_COPY_FROM_DUMP),
  1532                     dump_off_to_lisp (emacs_offset (emacs_ptr)),
  1533                     dump_off_to_lisp (dump_offset),
  1534                     dump_off_to_lisp (size)));
  1535 }
  1536 
  1537 /* Add an Emacs relocation that sets values to arbitrary bytes.
  1538 
  1539    When the dump is loaded, Emacs copies SIZE bytes from the
  1540    relocation itself to the adjusted location inside Emacs EMACS_PTR.
  1541    SIZE is the number of bytes to copy.  See struct emacs_reloc for
  1542    the maximum size that this mechanism can support.  The value comes
  1543    from VALUE_PTR.
  1544  */
  1545 static void
  1546 dump_emacs_reloc_immediate (struct dump_context *ctx,
  1547                             const void *emacs_ptr,
  1548                             const void *value_ptr,
  1549                             dump_off size)
  1550 {
  1551   if (!ctx->flags.dump_object_contents)
  1552     return;
  1553 
  1554   intmax_t value = 0;
  1555   eassert (size <= sizeof (value));
  1556   memcpy (&value, value_ptr, size);
  1557   dump_push (&ctx->emacs_relocs,
  1558              list4 (make_fixnum (RELOC_EMACS_IMMEDIATE),
  1559                     dump_off_to_lisp (emacs_offset (emacs_ptr)),
  1560                     intmax_t_to_lisp (value),
  1561                     dump_off_to_lisp (size)));
  1562 }
  1563 
  1564 #define DEFINE_EMACS_IMMEDIATE_FN(fnname, type)                         \
  1565   static void                                                           \
  1566   fnname (struct dump_context *ctx,                                     \
  1567           const type *emacs_ptr,                                        \
  1568           type value)                                                   \
  1569   {                                                                     \
  1570     dump_emacs_reloc_immediate (                                        \
  1571       ctx, emacs_ptr, &value, sizeof (value));                          \
  1572   }
  1573 
  1574 DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_lv, Lisp_Object)
  1575 DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_ptrdiff_t, ptrdiff_t)
  1576 DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_intmax_t, intmax_t)
  1577 DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_int, int)
  1578 DEFINE_EMACS_IMMEDIATE_FN (dump_emacs_reloc_immediate_bool, bool)
  1579 
  1580 /* Add an emacs relocation that makes a raw pointer in Emacs point
  1581    into the dump.  */
  1582 static void
  1583 dump_emacs_reloc_to_dump_ptr_raw (struct dump_context *ctx,
  1584                                   const void *emacs_ptr, dump_off dump_offset)
  1585 {
  1586   if (!ctx->flags.dump_object_contents)
  1587     return;
  1588 
  1589   dump_push (&ctx->emacs_relocs,
  1590              list3 (make_fixnum (RELOC_EMACS_DUMP_PTR_RAW),
  1591                     dump_off_to_lisp (emacs_offset (emacs_ptr)),
  1592                     dump_off_to_lisp (dump_offset)));
  1593 }
  1594 
  1595 /* Add an emacs relocation that points into the dump.
  1596 
  1597    When the dump is loaded, the Lisp_Object at EMACS_ROOT in Emacs to
  1598    point to VALUE.  VALUE can be any Lisp value; this function
  1599    automatically queues the value for dumping if necessary.  */
  1600 static void
  1601 dump_emacs_reloc_to_lv (struct dump_context *ctx,
  1602                         Lisp_Object const *emacs_ptr,
  1603                         Lisp_Object value)
  1604 {
  1605   if (dump_object_self_representing_p (value))
  1606     dump_emacs_reloc_immediate_lv (ctx, emacs_ptr, value);
  1607   else
  1608     {
  1609       if (ctx->flags.dump_object_contents)
  1610         /* Conditionally use RELOC_EMACS_EMACS_LV or
  1611            RELOC_EMACS_DUMP_LV depending on where the target object
  1612            lives.  We could just have decode_emacs_reloc pick the
  1613            right type, but we might as well maintain the invariant
  1614            that the types on ctx->emacs_relocs correspond to the types
  1615            of emacs_relocs we actually emit.  */
  1616         dump_push (&ctx->emacs_relocs,
  1617                    list3 (make_fixnum (dump_object_emacs_ptr (value)
  1618                                        ? RELOC_EMACS_EMACS_LV
  1619                                        : RELOC_EMACS_DUMP_LV),
  1620                           dump_off_to_lisp (emacs_offset (emacs_ptr)),
  1621                           value));
  1622       dump_enqueue_object (ctx, value, WEIGHT_NONE);
  1623     }
  1624 }
  1625 
  1626 /* Add an emacs relocation that makes a raw pointer in Emacs point
  1627    back into the Emacs image.  */
  1628 static void
  1629 dump_emacs_reloc_to_emacs_ptr_raw (struct dump_context *ctx, void *emacs_ptr,
  1630                                    void const *target_emacs_ptr)
  1631 {
  1632   if (!ctx->flags.dump_object_contents)
  1633     return;
  1634 
  1635   dump_push (&ctx->emacs_relocs,
  1636              list3 (make_fixnum (RELOC_EMACS_EMACS_PTR_RAW),
  1637                     dump_off_to_lisp (emacs_offset (emacs_ptr)),
  1638                     dump_off_to_lisp (emacs_offset (target_emacs_ptr))));
  1639 }
  1640 
  1641 /* Add an Emacs relocation that makes a raw pointer in Emacs point to
  1642    a different part of Emacs.  */
  1643 
  1644 enum dump_fixup_type
  1645   {
  1646     DUMP_FIXUP_LISP_OBJECT,
  1647     DUMP_FIXUP_LISP_OBJECT_RAW,
  1648     DUMP_FIXUP_PTR_DUMP_RAW,
  1649     DUMP_FIXUP_BIGNUM_DATA,
  1650   };
  1651 
  1652 enum dump_lv_fixup_type
  1653   {
  1654     LV_FIXUP_LISP_OBJECT,
  1655     LV_FIXUP_RAW_POINTER,
  1656   };
  1657 
  1658 /* Make something in the dump point to a lisp object.
  1659 
  1660    CTX is a dump context.  DUMP_OFFSET is the location in the dump to
  1661    fix.  VALUE is the object to which the location in the dump
  1662    should point.
  1663 
  1664    If FIXUP_SUBTYPE is LV_FIXUP_LISP_OBJECT, we expect a Lisp_Object
  1665    at DUMP_OFFSET.  If it's LV_FIXUP_RAW_POINTER, we expect a pointer.
  1666  */
  1667 static void
  1668 dump_remember_fixup_lv (struct dump_context *ctx,
  1669                         dump_off dump_offset,
  1670                         Lisp_Object value,
  1671                         enum dump_lv_fixup_type fixup_subtype)
  1672 {
  1673   if (!ctx->flags.dump_object_contents)
  1674     return;
  1675 
  1676   dump_push (&ctx->fixups,
  1677              list3 (make_fixnum (fixup_subtype == LV_FIXUP_LISP_OBJECT
  1678                                  ? DUMP_FIXUP_LISP_OBJECT
  1679                                  : DUMP_FIXUP_LISP_OBJECT_RAW),
  1680                     dump_off_to_lisp (dump_offset),
  1681                     value));
  1682 }
  1683 
  1684 /* Remember to fix up the dump file such that the pointer-sized value
  1685    at DUMP_OFFSET points to NEW_DUMP_OFFSET in the dump file and to
  1686    its absolute address at runtime.  */
  1687 static void
  1688 dump_remember_fixup_ptr_raw (struct dump_context *ctx,
  1689                              dump_off dump_offset,
  1690                              dump_off new_dump_offset)
  1691 {
  1692   if (!ctx->flags.dump_object_contents)
  1693     return;
  1694 
  1695   /* We should not be generating relocations into the
  1696      to-be-copied-into-Emacs dump region.  */
  1697   eassert (ctx->header.discardable_start == 0
  1698            || new_dump_offset < ctx->header.discardable_start
  1699            || (ctx->header.cold_start != 0
  1700                && new_dump_offset >= ctx->header.cold_start));
  1701 
  1702   dump_push (&ctx->fixups,
  1703              list3 (make_fixnum (DUMP_FIXUP_PTR_DUMP_RAW),
  1704                     dump_off_to_lisp (dump_offset),
  1705                     dump_off_to_lisp (new_dump_offset)));
  1706 }
  1707 
  1708 static void
  1709 dump_root_visitor (Lisp_Object const *root_ptr, enum gc_root_type type,
  1710                    void *data)
  1711 {
  1712   struct dump_context *ctx = data;
  1713   Lisp_Object value = *root_ptr;
  1714   if (type == GC_ROOT_C_SYMBOL)
  1715     {
  1716       eassert (dump_builtin_symbol_p (value));
  1717       /* Remember to dump the object itself later along with all the
  1718          rest of the copied-to-Emacs objects.  */
  1719       if (dump_set_referrer (ctx))
  1720         ctx->current_referrer = build_string ("built-in symbol list");
  1721       dump_enqueue_object (ctx, value, WEIGHT_NONE);
  1722       dump_clear_referrer (ctx);
  1723     }
  1724   else
  1725     {
  1726       if (type == GC_ROOT_STATICPRO)
  1727         Fputhash (dump_off_to_lisp (emacs_offset (root_ptr)),
  1728                   Qt,
  1729                   ctx->staticpro_table);
  1730       if (root_ptr != &Vinternal_interpreter_environment)
  1731         {
  1732           if (dump_set_referrer (ctx))
  1733             ctx->current_referrer
  1734               = dump_ptr_referrer ("emacs root", root_ptr);
  1735           dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr);
  1736           dump_clear_referrer (ctx);
  1737         }
  1738     }
  1739 }
  1740 
  1741 /* Kick off the dump process by queuing up the static GC roots.  */
  1742 static void
  1743 dump_roots (struct dump_context *ctx)
  1744 {
  1745   struct gc_root_visitor visitor = { .visit = dump_root_visitor,
  1746                                      .data = ctx };
  1747   visit_static_gc_roots (visitor);
  1748 }
  1749 
  1750 enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
  1751 
  1752 static dump_off
  1753 field_relpos (const void *in_start, const void *in_field)
  1754 {
  1755   ptrdiff_t in_start_val = (ptrdiff_t) in_start;
  1756   ptrdiff_t in_field_val = (ptrdiff_t) in_field;
  1757   eassert (in_start_val <= in_field_val);
  1758   ptrdiff_t relpos = in_field_val - in_start_val;
  1759   /* The following assertion attempts to detect bugs whereby IN_START
  1760      and IN_FIELD don't point to the same object/structure, on the
  1761      assumption that a too-large difference between them is
  1762      suspicious.  As of Apr 2019 the largest object we dump -- 'struct
  1763      buffer' -- is slightly smaller than 1KB, and we want to leave
  1764      some margin for future extensions.  If the assertion below is
  1765      ever violated, make sure the two pointers indeed point into the
  1766      same object, and if so, enlarge the value of PDUMPER_MAX_OBJECT_SIZE.  */
  1767   eassert (relpos < PDUMPER_MAX_OBJECT_SIZE);
  1768   return (dump_off) relpos;
  1769 }
  1770 
  1771 static void
  1772 cpyptr (void *out, const void *in)
  1773 {
  1774   memcpy (out, in, sizeof (void *));
  1775 }
  1776 
  1777 /* Convenience macro for regular assignment.  */
  1778 #define DUMP_FIELD_COPY(out, in, name) \
  1779   ((out)->name = (in)->name)
  1780 
  1781 static void
  1782 dump_field_lv_or_rawptr (struct dump_context *ctx,
  1783                          void *out,
  1784                          const void *in_start,
  1785                          const void *in_field,
  1786                          /* opt */ const enum Lisp_Type *ptr_raw_type,
  1787                          struct link_weight weight)
  1788 {
  1789   eassert (ctx->obj_offset > 0);
  1790 
  1791   Lisp_Object value;
  1792   dump_off relpos = field_relpos (in_start, in_field);
  1793   void *out_field = (char *) out + relpos;
  1794   bool is_ptr_raw = (ptr_raw_type != NULL);
  1795 
  1796   if (!is_ptr_raw)
  1797     {
  1798       memcpy (&value, in_field, sizeof (value));
  1799       if (dump_object_self_representing_p (value))
  1800         {
  1801           memcpy (out_field, &value, sizeof (value));
  1802           return;
  1803         }
  1804     }
  1805   else
  1806     {
  1807       void *ptrval;
  1808       cpyptr (&ptrval, in_field);
  1809       if (ptrval == NULL)
  1810         return; /* Nothing to do.  */
  1811       switch (*ptr_raw_type)
  1812         {
  1813         case Lisp_Symbol:
  1814           value = make_lisp_symbol (ptrval);
  1815           break;
  1816         case Lisp_String:
  1817         case Lisp_Vectorlike:
  1818         case Lisp_Cons:
  1819         case Lisp_Float:
  1820           value = make_lisp_ptr (ptrval, *ptr_raw_type);
  1821           break;
  1822         default:
  1823           emacs_abort ();
  1824         }
  1825     }
  1826 
  1827   /* Now value is the Lisp_Object to which we want to point whether or
  1828      not the field is a raw pointer (in which case we just synthesized
  1829      the Lisp_Object ourselves) or a Lisp_Object (in which case we
  1830      just copied the thing).  Add a fixup or relocation.  */
  1831 
  1832   intptr_t out_value;
  1833   dump_off out_field_offset = ctx->obj_offset + relpos;
  1834   dump_off target_offset = dump_recall_object (ctx, value);
  1835   enum { DANGEROUS = false };
  1836   if (DANGEROUS
  1837       && target_offset > 0 && dump_object_emacs_ptr (value) == NULL)
  1838     {
  1839       /* We've already dumped the referenced object, so we can emit
  1840          the value and a relocation directly instead of indirecting
  1841          through a fixup.  */
  1842       out_value = target_offset;
  1843       if (is_ptr_raw)
  1844         dump_reloc_dump_to_dump_ptr_raw (ctx, out_field_offset);
  1845       else
  1846         dump_reloc_dump_to_dump_lv (ctx, out_field_offset, XTYPE (value));
  1847     }
  1848   else
  1849     {
  1850       /* We don't know about the target object yet, so add a fixup.
  1851          When we process the fixup, we'll have dumped the target
  1852          object.  */
  1853       out_value = (intptr_t) 0xDEADF00D;
  1854       dump_remember_fixup_lv (ctx,
  1855                               out_field_offset,
  1856                               value,
  1857                               ( is_ptr_raw
  1858                                 ? LV_FIXUP_RAW_POINTER
  1859                                 : LV_FIXUP_LISP_OBJECT ));
  1860       dump_enqueue_object (ctx, value, weight);
  1861     }
  1862 
  1863   memcpy (out_field, &out_value, sizeof (out_value));
  1864 }
  1865 
  1866 /* Set a pointer field on an output object during dump.
  1867 
  1868    CTX is the dump context.  OFFSET is the offset at which the current
  1869    object starts.  OUT is a pointer to the dump output object.
  1870    IN_START is the start of the current Emacs object.  IN_FIELD is a
  1871    pointer to the field in that object.  TYPE is the type of pointer
  1872    to which IN_FIELD points.
  1873  */
  1874 static void
  1875 dump_field_lv_rawptr (struct dump_context *ctx,
  1876                       void *out,
  1877                       const void *in_start,
  1878                       const void *in_field,
  1879                       enum Lisp_Type type,
  1880                       struct link_weight weight)
  1881 {
  1882   dump_field_lv_or_rawptr (ctx, out, in_start, in_field, &type, weight);
  1883 }
  1884 
  1885 /* Set a Lisp_Object field on an output object during dump.
  1886 
  1887    CTX is a dump context.  OFFSET is the offset at which the current
  1888    object starts.  OUT is a pointer to the dump output object.
  1889    IN_START is the start of the current Emacs object.  IN_FIELD is a
  1890    pointer to a Lisp_Object field in that object.
  1891 
  1892    Arrange for the dump to contain fixups and relocations such that,
  1893    at load time, the given field of the output object contains a valid
  1894    Lisp_Object pointing to the same notional object that *IN_FIELD
  1895    contains now.
  1896 
  1897    See idomatic usage below.  */
  1898 static void
  1899 dump_field_lv (struct dump_context *ctx,
  1900                void *out,
  1901                const void *in_start,
  1902                const Lisp_Object *in_field,
  1903                struct link_weight weight)
  1904 {
  1905   dump_field_lv_or_rawptr (ctx, out, in_start, in_field, NULL, weight);
  1906 }
  1907 
  1908 /* Note that we're going to add a manual fixup for the given field
  1909    later.  */
  1910 static void
  1911 dump_field_fixup_later (struct dump_context *ctx,
  1912                         void *out,
  1913                         const void *in_start,
  1914                         const void *in_field)
  1915 {
  1916   /* TODO: more error checking.  */
  1917   (void) field_relpos (in_start, in_field);
  1918 }
  1919 
  1920 /* Mark an output object field, which is as wide as a pointer, as being
  1921    fixed up to point to a specific offset in the dump.  */
  1922 static void
  1923 dump_field_ptr_to_dump_offset (struct dump_context *ctx,
  1924                                void *out,
  1925                                const void *in_start,
  1926                                const void *in_field,
  1927                                dump_off target_dump_offset)
  1928 {
  1929   eassert (ctx->obj_offset > 0);
  1930   if (!ctx->flags.dump_object_contents)
  1931     return;
  1932 
  1933   dump_off relpos = field_relpos (in_start, in_field);
  1934   dump_reloc_dump_to_dump_ptr_raw (ctx, ctx->obj_offset + relpos);
  1935   intptr_t outval = target_dump_offset;
  1936   memcpy ((char *) out + relpos, &outval, sizeof (outval));
  1937 }
  1938 
  1939 /* Mark a field as pointing to a place inside Emacs.
  1940 
  1941    CTX is the dump context.  OUT points to the out-object for the
  1942    current dump function.  IN_START points to the start of the object
  1943    being dumped.  IN_FIELD points to the field inside the object being
  1944    dumped that we're dumping.  The contents of this field (which
  1945    should be as wide as a pointer) are the Emacs pointer to dump.
  1946 
  1947  */
  1948 static void
  1949 dump_field_emacs_ptr (struct dump_context *ctx,
  1950                       void *out,
  1951                       const void *in_start,
  1952                       const void *in_field)
  1953 {
  1954   eassert (ctx->obj_offset > 0);
  1955   if (!ctx->flags.dump_object_contents)
  1956     return;
  1957 
  1958   dump_off relpos = field_relpos (in_start, in_field);
  1959   void *abs_emacs_ptr;
  1960   cpyptr (&abs_emacs_ptr, in_field);
  1961   intptr_t rel_emacs_ptr = 0;
  1962   if (abs_emacs_ptr)
  1963     {
  1964       rel_emacs_ptr = emacs_offset ((void *)abs_emacs_ptr);
  1965       dump_reloc_dump_to_emacs_ptr_raw (ctx, ctx->obj_offset + relpos);
  1966     }
  1967   cpyptr ((char *) out + relpos, &rel_emacs_ptr);
  1968 }
  1969 
  1970 static void
  1971 _dump_object_start_pseudovector (struct dump_context *ctx,
  1972                                  union vectorlike_header *out_hdr,
  1973                                  const union vectorlike_header *in_hdr)
  1974 {
  1975   eassert (in_hdr->size & PSEUDOVECTOR_FLAG);
  1976   ptrdiff_t vec_size = vectorlike_nbytes (in_hdr);
  1977   dump_object_start (ctx, out_hdr, (dump_off) vec_size);
  1978   *out_hdr = *in_hdr;
  1979 }
  1980 
  1981 /* Need a macro for alloca.  */
  1982 #define START_DUMP_PVEC(ctx, hdr, type, out)                  \
  1983   const union vectorlike_header *_in_hdr = (hdr);             \
  1984   type *out = alloca (vectorlike_nbytes (_in_hdr));           \
  1985   _dump_object_start_pseudovector (ctx, &out->header, _in_hdr)
  1986 
  1987 static dump_off
  1988 finish_dump_pvec (struct dump_context *ctx,
  1989                   union vectorlike_header *out_hdr)
  1990 {
  1991   return dump_object_finish (ctx, out_hdr, vectorlike_nbytes (out_hdr));
  1992 }
  1993 
  1994 static void
  1995 dump_pseudovector_lisp_fields (struct dump_context *ctx,
  1996                                union vectorlike_header *out_hdr,
  1997                                const union vectorlike_header *in_hdr)
  1998 {
  1999   const struct Lisp_Vector *in = (const struct Lisp_Vector *) in_hdr;
  2000   struct Lisp_Vector *out = (struct Lisp_Vector *) out_hdr;
  2001   ptrdiff_t size = in->header.size;
  2002   eassert (size & PSEUDOVECTOR_FLAG);
  2003   size &= PSEUDOVECTOR_SIZE_MASK;
  2004   for (ptrdiff_t i = 0; i < size; ++i)
  2005     dump_field_lv (ctx, out, in, &in->contents[i], WEIGHT_STRONG);
  2006 }
  2007 
  2008 static dump_off
  2009 dump_cons (struct dump_context *ctx, const struct Lisp_Cons *cons)
  2010 {
  2011 #if CHECK_STRUCTS && !defined (HASH_Lisp_Cons_00EEE63F67)
  2012 # error "Lisp_Cons changed. See CHECK_STRUCTS comment in config.h."
  2013 #endif
  2014   struct Lisp_Cons out;
  2015   dump_object_start (ctx, &out, sizeof (out));
  2016   dump_field_lv (ctx, &out, cons, &cons->u.s.car, WEIGHT_STRONG);
  2017   dump_field_lv (ctx, &out, cons, &cons->u.s.u.cdr, WEIGHT_NORMAL);
  2018   return dump_object_finish (ctx, &out, sizeof (out));
  2019 }
  2020 
  2021 static dump_off
  2022 dump_interval_tree (struct dump_context *ctx,
  2023                     INTERVAL tree,
  2024                     dump_off parent_offset)
  2025 {
  2026 #if CHECK_STRUCTS && !defined (HASH_interval_1B38941C37)
  2027 # error "interval changed. See CHECK_STRUCTS comment in config.h."
  2028 #endif
  2029   /* TODO: output tree breadth-first?  */
  2030   struct interval out;
  2031   dump_object_start (ctx, &out, sizeof (out));
  2032   DUMP_FIELD_COPY (&out, tree, total_length);
  2033   DUMP_FIELD_COPY (&out, tree, position);
  2034   if (tree->left)
  2035     dump_field_fixup_later (ctx, &out, tree, &tree->left);
  2036   if (tree->right)
  2037     dump_field_fixup_later (ctx, &out, tree, &tree->right);
  2038   if (!tree->up_obj)
  2039     {
  2040       eassert (parent_offset != 0);
  2041       dump_field_ptr_to_dump_offset (ctx, &out, tree, &tree->up.interval,
  2042                                      parent_offset);
  2043     }
  2044   else
  2045     dump_field_lv (ctx, &out, tree, &tree->up.obj, WEIGHT_STRONG);
  2046   DUMP_FIELD_COPY (&out, tree, up_obj);
  2047   eassert (tree->gcmarkbit == 0);
  2048   DUMP_FIELD_COPY (&out, tree, write_protect);
  2049   DUMP_FIELD_COPY (&out, tree, visible);
  2050   DUMP_FIELD_COPY (&out, tree, front_sticky);
  2051   DUMP_FIELD_COPY (&out, tree, rear_sticky);
  2052   dump_field_lv (ctx, &out, tree, &tree->plist, WEIGHT_STRONG);
  2053   dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
  2054   if (tree->left)
  2055       dump_remember_fixup_ptr_raw
  2056         (ctx,
  2057          offset + dump_offsetof (struct interval, left),
  2058          dump_interval_tree (ctx, tree->left, offset));
  2059   if (tree->right)
  2060       dump_remember_fixup_ptr_raw
  2061         (ctx,
  2062          offset + dump_offsetof (struct interval, right),
  2063          dump_interval_tree (ctx, tree->right, offset));
  2064   return offset;
  2065 }
  2066 
  2067 static dump_off
  2068 dump_string (struct dump_context *ctx, const struct Lisp_String *string)
  2069 {
  2070 #if CHECK_STRUCTS && !defined (HASH_Lisp_String_03B2DF1C8E)
  2071 # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
  2072 #endif
  2073   /* If we have text properties, write them _after_ the string so that
  2074      at runtime, the prefetcher and cache will DTRT. (We access the
  2075      string before its properties.).
  2076 
  2077      There's special code to dump string data contiguously later on.
  2078      we seldom write to string data and never relocate it, so lumping
  2079      it together at the end of the dump saves on COW faults.
  2080 
  2081      If, however, the string's size_byte field is -2, the string data
  2082      is actually a pointer to Emacs data segment, so we can do even
  2083      better by emitting a relocation instead of bothering to copy the
  2084      string data.  */
  2085   struct Lisp_String out;
  2086   dump_object_start (ctx, &out, sizeof (out));
  2087   DUMP_FIELD_COPY (&out, string, u.s.size);
  2088   DUMP_FIELD_COPY (&out, string, u.s.size_byte);
  2089   if (string->u.s.intervals)
  2090     dump_field_fixup_later (ctx, &out, string, &string->u.s.intervals);
  2091 
  2092   if (string->u.s.size_byte == -2)
  2093     /* String literal in Emacs rodata.  */
  2094     dump_field_emacs_ptr (ctx, &out, string, &string->u.s.data);
  2095   else
  2096     {
  2097       dump_field_fixup_later (ctx, &out, string, &string->u.s.data);
  2098       dump_remember_cold_op (ctx,
  2099                              COLD_OP_STRING,
  2100                              make_lisp_ptr ((void *) string, Lisp_String));
  2101     }
  2102 
  2103   dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
  2104   if (string->u.s.intervals)
  2105     dump_remember_fixup_ptr_raw
  2106       (ctx,
  2107        offset + dump_offsetof (struct Lisp_String, u.s.intervals),
  2108        dump_interval_tree (ctx, string->u.s.intervals, 0));
  2109 
  2110   return offset;
  2111 }
  2112 
  2113 static dump_off
  2114 dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker)
  2115 {
  2116 #if CHECK_STRUCTS && !defined (HASH_Lisp_Marker_642DBAF866)
  2117 # error "Lisp_Marker changed. See CHECK_STRUCTS comment in config.h."
  2118 #endif
  2119 
  2120   START_DUMP_PVEC (ctx, &marker->header, struct Lisp_Marker, out);
  2121   dump_pseudovector_lisp_fields (ctx, &out->header, &marker->header);
  2122   DUMP_FIELD_COPY (out, marker, need_adjustment);
  2123   DUMP_FIELD_COPY (out, marker, insertion_type);
  2124   if (marker->buffer)
  2125     {
  2126       dump_field_lv_rawptr (ctx, out, marker, &marker->buffer,
  2127                             Lisp_Vectorlike, WEIGHT_NORMAL);
  2128       dump_field_lv_rawptr (ctx, out, marker, &marker->next,
  2129                             Lisp_Vectorlike, WEIGHT_STRONG);
  2130       DUMP_FIELD_COPY (out, marker, charpos);
  2131       DUMP_FIELD_COPY (out, marker, bytepos);
  2132     }
  2133   return finish_dump_pvec (ctx, &out->header);
  2134 }
  2135 
  2136 static dump_off
  2137 dump_interval_node (struct dump_context *ctx, struct itree_node *node,
  2138                     dump_off parent_offset)
  2139 {
  2140 #if CHECK_STRUCTS && !defined (HASH_itree_node_50DE304F13)
  2141 # error "itree_node changed. See CHECK_STRUCTS comment in config.h."
  2142 #endif
  2143   struct itree_node out;
  2144   dump_object_start (ctx, &out, sizeof (out));
  2145   if (node->parent)
  2146     dump_field_fixup_later (ctx, &out, node, &node->parent);
  2147   if (node->left)
  2148     dump_field_fixup_later (ctx, &out, node, &node->parent);
  2149   if (node->right)
  2150     dump_field_fixup_later (ctx, &out, node, &node->parent);
  2151   DUMP_FIELD_COPY (&out, node, begin);
  2152   DUMP_FIELD_COPY (&out, node, end);
  2153   DUMP_FIELD_COPY (&out, node, limit);
  2154   DUMP_FIELD_COPY (&out, node, offset);
  2155   DUMP_FIELD_COPY (&out, node, otick);
  2156   dump_field_lv (ctx, &out, node, &node->data, WEIGHT_STRONG);
  2157   DUMP_FIELD_COPY (&out, node, red);
  2158   DUMP_FIELD_COPY (&out, node, rear_advance);
  2159   DUMP_FIELD_COPY (&out, node, front_advance);
  2160   dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
  2161   if (node->parent)
  2162       dump_remember_fixup_ptr_raw
  2163         (ctx,
  2164          offset + dump_offsetof (struct itree_node, parent),
  2165          dump_interval_node (ctx, node->parent, offset));
  2166   if (node->left)
  2167       dump_remember_fixup_ptr_raw
  2168         (ctx,
  2169          offset + dump_offsetof (struct itree_node, left),
  2170          dump_interval_node (ctx, node->left, offset));
  2171   if (node->right)
  2172       dump_remember_fixup_ptr_raw
  2173         (ctx,
  2174          offset + dump_offsetof (struct itree_node, right),
  2175          dump_interval_node (ctx, node->right, offset));
  2176   return offset;
  2177 }
  2178 
  2179 static dump_off
  2180 dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay)
  2181 {
  2182 #if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_5F9D7E02FC)
  2183 # error "Lisp_Overlay changed. See CHECK_STRUCTS comment in config.h."
  2184 #endif
  2185   START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out);
  2186   dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header);
  2187   dump_field_fixup_later (ctx, &out, overlay, &overlay->interval);
  2188   dump_off offset = finish_dump_pvec (ctx, &out->header);
  2189   dump_remember_fixup_ptr_raw
  2190     (ctx,
  2191      offset + dump_offsetof (struct Lisp_Overlay, interval),
  2192      dump_interval_node (ctx, overlay->interval, offset));
  2193   return offset;
  2194 }
  2195 
  2196 static void
  2197 dump_field_finalizer_ref (struct dump_context *ctx,
  2198                           void *out,
  2199                           const struct Lisp_Finalizer *finalizer,
  2200                           struct Lisp_Finalizer *const *field)
  2201 {
  2202   if (*field == &finalizers || *field == &doomed_finalizers)
  2203     dump_field_emacs_ptr (ctx, out, finalizer, field);
  2204   else
  2205     dump_field_lv_rawptr (ctx, out, finalizer, field,
  2206                           Lisp_Vectorlike,
  2207                           WEIGHT_NORMAL);
  2208 }
  2209 
  2210 static dump_off
  2211 dump_finalizer (struct dump_context *ctx,
  2212                 const struct Lisp_Finalizer *finalizer)
  2213 {
  2214 #if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_D58E647CB8)
  2215 # error "Lisp_Finalizer changed. See CHECK_STRUCTS comment in config.h."
  2216 #endif
  2217   START_DUMP_PVEC (ctx, &finalizer->header, struct Lisp_Finalizer, out);
  2218   /* Do _not_ call dump_pseudovector_lisp_fields here: we dump the
  2219      only Lisp field, finalizer->function, manually, so we can give it
  2220      a low weight.  */
  2221   dump_field_lv (ctx, &out, finalizer, &finalizer->function, WEIGHT_NONE);
  2222   dump_field_finalizer_ref (ctx, &out, finalizer, &finalizer->prev);
  2223   dump_field_finalizer_ref (ctx, &out, finalizer, &finalizer->next);
  2224   return finish_dump_pvec (ctx, &out->header);
  2225 }
  2226 
  2227 struct bignum_reload_info
  2228 {
  2229   dump_off data_location;
  2230   dump_off nlimbs;
  2231 };
  2232 
  2233 static dump_off
  2234 dump_bignum (struct dump_context *ctx, Lisp_Object object)
  2235 {
  2236 #if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_661945DE2B)
  2237 # error "Lisp_Bignum changed. See CHECK_STRUCTS comment in config.h."
  2238 #endif
  2239   const struct Lisp_Bignum *bignum = XBIGNUM (object);
  2240   START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out);
  2241   verify (sizeof (out->value) >= sizeof (struct bignum_reload_info));
  2242   dump_field_fixup_later (ctx, out, bignum, xbignum_val (object));
  2243   dump_off bignum_offset = finish_dump_pvec (ctx, &out->header);
  2244   if (ctx->flags.dump_object_contents)
  2245     {
  2246       /* Export the bignum into a blob in the cold section.  */
  2247       dump_remember_cold_op (ctx, COLD_OP_BIGNUM, object);
  2248 
  2249       /* Write the offset of that exported blob here.  */
  2250       dump_off value_offset
  2251         = (bignum_offset
  2252            + (dump_off) offsetof (struct Lisp_Bignum, value));
  2253       dump_push (&ctx->fixups,
  2254                  list3 (make_fixnum (DUMP_FIXUP_BIGNUM_DATA),
  2255                         dump_off_to_lisp (value_offset),
  2256                         object));
  2257 
  2258       /* When we load the dump, slurp the data blob and turn it into a
  2259          real bignum.  Attach the relocation to the start of the
  2260          Lisp_Bignum instead of the actual mpz field so that the
  2261          relocation offset is aligned.  The relocation-application
  2262          code knows to actually advance past the header.  */
  2263       dump_push (&ctx->dump_relocs[EARLY_RELOCS],
  2264                  list2 (make_fixnum (RELOC_BIGNUM),
  2265                         dump_off_to_lisp (bignum_offset)));
  2266     }
  2267 
  2268   return bignum_offset;
  2269 }
  2270 
  2271 static dump_off
  2272 dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat)
  2273 {
  2274 #if CHECK_STRUCTS && !defined (HASH_Lisp_Float_7E7D284C02)
  2275 # error "Lisp_Float changed. See CHECK_STRUCTS comment in config.h."
  2276 #endif
  2277   eassert (ctx->header.cold_start);
  2278   struct Lisp_Float out;
  2279   dump_object_start (ctx, &out, sizeof (out));
  2280   DUMP_FIELD_COPY (&out, lfloat, u.data);
  2281   return dump_object_finish (ctx, &out, sizeof (out));
  2282 }
  2283 
  2284 static dump_off
  2285 dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd)
  2286 {
  2287 #if CHECK_STRUCTS && !defined HASH_Lisp_Intfwd_4D887A7387
  2288 # error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h."
  2289 #endif
  2290   dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar);
  2291   struct Lisp_Intfwd out;
  2292   dump_object_start (ctx, &out, sizeof (out));
  2293   DUMP_FIELD_COPY (&out, intfwd, type);
  2294   dump_field_emacs_ptr (ctx, &out, intfwd, &intfwd->intvar);
  2295   return dump_object_finish (ctx, &out, sizeof (out));
  2296 }
  2297 
  2298 static dump_off
  2299 dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd)
  2300 {
  2301 #if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC)
  2302 # error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment in config.h."
  2303 #endif
  2304   dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar);
  2305   struct Lisp_Boolfwd out;
  2306   dump_object_start (ctx, &out, sizeof (out));
  2307   DUMP_FIELD_COPY (&out, boolfwd, type);
  2308   dump_field_emacs_ptr (ctx, &out, boolfwd, &boolfwd->boolvar);
  2309   return dump_object_finish (ctx, &out, sizeof (out));
  2310 }
  2311 
  2312 static dump_off
  2313 dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd)
  2314 {
  2315 #if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC)
  2316 # error "Lisp_Objfwd changed. See CHECK_STRUCTS comment in config.h."
  2317 #endif
  2318   if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)),
  2319                       ctx->staticpro_table,
  2320                       Qnil)))
  2321     dump_emacs_reloc_to_lv (ctx, objfwd->objvar, *objfwd->objvar);
  2322   struct Lisp_Objfwd out;
  2323   dump_object_start (ctx, &out, sizeof (out));
  2324   DUMP_FIELD_COPY (&out, objfwd, type);
  2325   dump_field_emacs_ptr (ctx, &out, objfwd, &objfwd->objvar);
  2326   return dump_object_finish (ctx, &out, sizeof (out));
  2327 }
  2328 
  2329 static dump_off
  2330 dump_fwd_buffer_obj (struct dump_context *ctx,
  2331                      const struct Lisp_Buffer_Objfwd *buffer_objfwd)
  2332 {
  2333 #if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_611EBD13FF)
  2334 # error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment in config.h."
  2335 #endif
  2336   struct Lisp_Buffer_Objfwd out;
  2337   dump_object_start (ctx, &out, sizeof (out));
  2338   DUMP_FIELD_COPY (&out, buffer_objfwd, type);
  2339   DUMP_FIELD_COPY (&out, buffer_objfwd, offset);
  2340   dump_field_lv (ctx, &out, buffer_objfwd, &buffer_objfwd->predicate,
  2341                  WEIGHT_NORMAL);
  2342   return dump_object_finish (ctx, &out, sizeof (out));
  2343 }
  2344 
  2345 static dump_off
  2346 dump_fwd_kboard_obj (struct dump_context *ctx,
  2347                      const struct Lisp_Kboard_Objfwd *kboard_objfwd)
  2348 {
  2349 #if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069)
  2350 # error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h."
  2351 #endif
  2352   struct Lisp_Kboard_Objfwd out;
  2353   dump_object_start (ctx, &out, sizeof (out));
  2354   DUMP_FIELD_COPY (&out, kboard_objfwd, type);
  2355   DUMP_FIELD_COPY (&out, kboard_objfwd, offset);
  2356   return dump_object_finish (ctx, &out, sizeof (out));
  2357 }
  2358 
  2359 static dump_off
  2360 dump_fwd (struct dump_context *ctx, lispfwd fwd)
  2361 {
  2362 #if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E)
  2363 # error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment in config.h."
  2364 #endif
  2365   void const *p = fwd.fwdptr;
  2366   dump_off offset;
  2367 
  2368   switch (XFWDTYPE (fwd))
  2369     {
  2370     case Lisp_Fwd_Int:
  2371       offset = dump_fwd_int (ctx, p);
  2372       break;
  2373     case Lisp_Fwd_Bool:
  2374       offset = dump_fwd_bool (ctx, p);
  2375       break;
  2376     case Lisp_Fwd_Obj:
  2377       offset = dump_fwd_obj (ctx, p);
  2378       break;
  2379     case Lisp_Fwd_Buffer_Obj:
  2380       offset = dump_fwd_buffer_obj (ctx, p);
  2381       break;
  2382     case Lisp_Fwd_Kboard_Obj:
  2383       offset = dump_fwd_kboard_obj (ctx, p);
  2384       break;
  2385     default:
  2386       emacs_abort ();
  2387     }
  2388 
  2389   return offset;
  2390 }
  2391 
  2392 static dump_off
  2393 dump_blv (struct dump_context *ctx,
  2394           const struct Lisp_Buffer_Local_Value *blv)
  2395 {
  2396 #if CHECK_STRUCTS && !defined HASH_Lisp_Buffer_Local_Value_3C363FAC3C
  2397 # error "Lisp_Buffer_Local_Value changed. See CHECK_STRUCTS comment in config.h."
  2398 #endif
  2399   struct Lisp_Buffer_Local_Value out;
  2400   dump_object_start (ctx, &out, sizeof (out));
  2401   DUMP_FIELD_COPY (&out, blv, local_if_set);
  2402   DUMP_FIELD_COPY (&out, blv, found);
  2403   if (blv->fwd.fwdptr)
  2404     dump_field_fixup_later (ctx, &out, blv, &blv->fwd.fwdptr);
  2405   dump_field_lv (ctx, &out, blv, &blv->where, WEIGHT_NORMAL);
  2406   dump_field_lv (ctx, &out, blv, &blv->defcell, WEIGHT_STRONG);
  2407   dump_field_lv (ctx, &out, blv, &blv->valcell, WEIGHT_STRONG);
  2408   dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
  2409   if (blv->fwd.fwdptr)
  2410     dump_remember_fixup_ptr_raw
  2411       (ctx,
  2412        offset + dump_offsetof (struct Lisp_Buffer_Local_Value, fwd),
  2413        dump_fwd (ctx, blv->fwd));
  2414   return offset;
  2415 }
  2416 
  2417 static dump_off
  2418 dump_recall_symbol_aux (struct dump_context *ctx, Lisp_Object symbol)
  2419 {
  2420   Lisp_Object symbol_aux = ctx->symbol_aux;
  2421   if (NILP (symbol_aux))
  2422     return 0;
  2423   return dump_off_from_lisp (Fgethash (symbol, symbol_aux, make_fixnum (0)));
  2424 }
  2425 
  2426 static void
  2427 dump_remember_symbol_aux (struct dump_context *ctx,
  2428                           Lisp_Object symbol,
  2429                           dump_off offset)
  2430 {
  2431   Fputhash (symbol, dump_off_to_lisp (offset), ctx->symbol_aux);
  2432 }
  2433 
  2434 static void
  2435 dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
  2436 {
  2437   Lisp_Object symbol_lv = make_lisp_symbol (symbol);
  2438   eassert (!dump_recall_symbol_aux (ctx, symbol_lv));
  2439   if (dump_set_referrer (ctx))
  2440     ctx->current_referrer = symbol_lv;
  2441   switch (symbol->u.s.redirect)
  2442     {
  2443     case SYMBOL_LOCALIZED:
  2444       dump_remember_symbol_aux (ctx, symbol_lv,
  2445                                 dump_blv (ctx, symbol->u.s.val.blv));
  2446       break;
  2447     case SYMBOL_FORWARDED:
  2448       dump_remember_symbol_aux (ctx, symbol_lv,
  2449                                 dump_fwd (ctx, symbol->u.s.val.fwd));
  2450       break;
  2451     default:
  2452       break;
  2453     }
  2454   dump_clear_referrer (ctx);
  2455 }
  2456 
  2457 static dump_off
  2458 dump_symbol (struct dump_context *ctx,
  2459              Lisp_Object object,
  2460              dump_off offset)
  2461 {
  2462 #if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC
  2463 # error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h."
  2464 #endif
  2465 #if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113)
  2466 # error "symbol_redirect changed. See CHECK_STRUCTS comment in config.h."
  2467 #endif
  2468 
  2469   if (ctx->flags.defer_symbols)
  2470     {
  2471       if (offset != DUMP_OBJECT_ON_SYMBOL_QUEUE)
  2472         {
  2473           eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
  2474                    || offset == DUMP_OBJECT_NOT_SEEN);
  2475           dump_clear_referrer (ctx);
  2476           struct dump_flags old_flags = ctx->flags;
  2477           ctx->flags.dump_object_contents = false;
  2478           ctx->flags.defer_symbols = false;
  2479           dump_object (ctx, object);
  2480           ctx->flags = old_flags;
  2481           if (dump_set_referrer (ctx))
  2482             ctx->current_referrer = object;
  2483 
  2484           offset = DUMP_OBJECT_ON_SYMBOL_QUEUE;
  2485           dump_remember_object (ctx, object, offset);
  2486           dump_push (&ctx->deferred_symbols, object);
  2487         }
  2488       return offset;
  2489     }
  2490 
  2491   struct Lisp_Symbol *symbol = XSYMBOL (object);
  2492   struct Lisp_Symbol out;
  2493   dump_object_start (ctx, &out, sizeof (out));
  2494   eassert (symbol->u.s.gcmarkbit == 0);
  2495   DUMP_FIELD_COPY (&out, symbol, u.s.redirect);
  2496   DUMP_FIELD_COPY (&out, symbol, u.s.trapped_write);
  2497   DUMP_FIELD_COPY (&out, symbol, u.s.interned);
  2498   DUMP_FIELD_COPY (&out, symbol, u.s.declared_special);
  2499   DUMP_FIELD_COPY (&out, symbol, u.s.pinned);
  2500   dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG);
  2501   switch (symbol->u.s.redirect)
  2502     {
  2503     case SYMBOL_PLAINVAL:
  2504       dump_field_lv (ctx, &out, symbol, &symbol->u.s.val.value,
  2505                      WEIGHT_NORMAL);
  2506       break;
  2507     case SYMBOL_VARALIAS:
  2508       dump_field_lv_rawptr (ctx, &out, symbol,
  2509                             &symbol->u.s.val.alias, Lisp_Symbol,
  2510                             WEIGHT_NORMAL);
  2511       break;
  2512     case SYMBOL_LOCALIZED:
  2513       dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.blv);
  2514       break;
  2515     case SYMBOL_FORWARDED:
  2516       dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.fwd);
  2517       break;
  2518     default:
  2519       emacs_abort ();
  2520     }
  2521   dump_field_lv (ctx, &out, symbol, &symbol->u.s.function, WEIGHT_NORMAL);
  2522   dump_field_lv (ctx, &out, symbol, &symbol->u.s.plist, WEIGHT_NORMAL);
  2523   dump_field_lv_rawptr (ctx, &out, symbol, &symbol->u.s.next, Lisp_Symbol,
  2524                         WEIGHT_STRONG);
  2525 
  2526   offset = dump_object_finish (ctx, &out, sizeof (out));
  2527   dump_off aux_offset;
  2528 
  2529   switch (symbol->u.s.redirect)
  2530     {
  2531     case SYMBOL_LOCALIZED:
  2532       aux_offset = dump_recall_symbol_aux (ctx, make_lisp_symbol (symbol));
  2533       dump_remember_fixup_ptr_raw
  2534         (ctx,
  2535          offset + dump_offsetof (struct Lisp_Symbol, u.s.val.blv),
  2536          (aux_offset
  2537           ? aux_offset
  2538           : dump_blv (ctx, symbol->u.s.val.blv)));
  2539       break;
  2540     case SYMBOL_FORWARDED:
  2541       aux_offset = dump_recall_symbol_aux (ctx, make_lisp_symbol (symbol));
  2542       dump_remember_fixup_ptr_raw
  2543         (ctx,
  2544          offset + dump_offsetof (struct Lisp_Symbol, u.s.val.fwd),
  2545          (aux_offset
  2546           ? aux_offset
  2547           : dump_fwd (ctx, symbol->u.s.val.fwd)));
  2548       break;
  2549     default:
  2550       break;
  2551     }
  2552   return offset;
  2553 }
  2554 
  2555 static dump_off
  2556 dump_vectorlike_generic (struct dump_context *ctx,
  2557                          const union vectorlike_header *header)
  2558 {
  2559 #if CHECK_STRUCTS && !defined (HASH_vectorlike_header_00A5A4BFB2)
  2560 # error "vectorlike_header changed. See CHECK_STRUCTS comment in config.h."
  2561 #endif
  2562   const struct Lisp_Vector *v = (const struct Lisp_Vector *) header;
  2563   ptrdiff_t size = header->size;
  2564   enum pvec_type pvectype = PSEUDOVECTOR_TYPE (v);
  2565   dump_off offset;
  2566 
  2567   if (size & PSEUDOVECTOR_FLAG)
  2568     {
  2569       /* Assert that the pseudovector contains only Lisp values ---
  2570          but see the PVEC_SUB_CHAR_TABLE special case below.  We allow
  2571          one extra word of non-lisp data when Lisp_Object is shorter
  2572          than GCALIGN (e.g., on 32-bit builds) to account for
  2573          GCALIGN-enforcing struct padding.  We can't distinguish
  2574          between padding and some undumpable data member this way, but
  2575          we'll count on sizeof(Lisp_Object) >= GCALIGN builds to catch
  2576          this class of problem.
  2577          */
  2578       eassert ((size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_REST_BITS
  2579                <= (sizeof (Lisp_Object) < GCALIGNMENT));
  2580       size &= PSEUDOVECTOR_SIZE_MASK;
  2581     }
  2582 
  2583   dump_align_output (ctx, DUMP_ALIGNMENT);
  2584   dump_off prefix_start_offset = ctx->offset;
  2585 
  2586   dump_off skip;
  2587   if (pvectype == PVEC_SUB_CHAR_TABLE)
  2588     {
  2589       /* PVEC_SUB_CHAR_TABLE has a special case because it's a
  2590          variable-length vector (unlike other pseudovectors, which is
  2591          why we handle it here) and has its non-Lisp data _before_ the
  2592          variable-length Lisp part.  */
  2593       const struct Lisp_Sub_Char_Table *sct =
  2594         (const struct Lisp_Sub_Char_Table *) header;
  2595       struct Lisp_Sub_Char_Table out;
  2596       /* Don't use sizeof(out), since that incorporates unwanted
  2597          padding.  Instead, use the size through the last non-Lisp
  2598          field.  */
  2599       size_t sz = (char *)&out.min_char + sizeof (out.min_char) - (char *)&out;
  2600       eassert (sz < DUMP_OFF_MAX);
  2601       dump_object_start (ctx, &out, (dump_off) sz);
  2602       DUMP_FIELD_COPY (&out, sct, header.size);
  2603       DUMP_FIELD_COPY (&out, sct, depth);
  2604       DUMP_FIELD_COPY (&out, sct, min_char);
  2605       offset = dump_object_finish (ctx, &out, (dump_off) sz);
  2606       skip = SUB_CHAR_TABLE_OFFSET;
  2607     }
  2608   else
  2609     {
  2610       union vectorlike_header out;
  2611       dump_object_start (ctx, &out, sizeof (out));
  2612       DUMP_FIELD_COPY (&out, header, size);
  2613       offset = dump_object_finish (ctx, &out, sizeof (out));
  2614       skip = 0;
  2615     }
  2616 
  2617   /* We may have written a non-Lisp vector prefix above.  If we have,
  2618      pad to the lisp content start with zero, and make sure we didn't
  2619      scribble beyond that start.  */
  2620   dump_off prefix_size = ctx->offset - prefix_start_offset;
  2621   eassert (prefix_size > 0);
  2622   dump_off skip_start = ptrdiff_t_to_dump_off ((char *) &v->contents[skip]
  2623                                                - (char *) v);
  2624   eassert (skip_start >= prefix_size);
  2625   dump_write_zero (ctx, skip_start - prefix_size);
  2626 
  2627   /* dump_object_start isn't what records conservative-GC object
  2628      starts --- dump_object_1 does --- so the hack below of using
  2629      dump_object_start for each vector word doesn't cause GC problems
  2630      at runtime.  */
  2631   struct dump_flags old_flags = ctx->flags;
  2632   ctx->flags.pack_objects = true;
  2633   for (dump_off i = skip; i < size; ++i)
  2634     {
  2635       Lisp_Object out;
  2636       const Lisp_Object *vslot = &v->contents[i];
  2637       /* In the wide case, we're always misaligned.  */
  2638 #if INTPTR_MAX == EMACS_INT_MAX
  2639       eassert (ctx->offset % sizeof (out) == 0);
  2640 #endif
  2641       dump_object_start (ctx, &out, sizeof (out));
  2642       dump_field_lv (ctx, &out, vslot, vslot, WEIGHT_STRONG);
  2643       dump_object_finish (ctx, &out, sizeof (out));
  2644     }
  2645   ctx->flags = old_flags;
  2646   dump_align_output (ctx, DUMP_ALIGNMENT);
  2647   return offset;
  2648 }
  2649 
  2650 /* Return a vector of KEY, VALUE pairs in the given hash table H.  The
  2651    first H->count pairs are valid, and the rest are unbound.  */
  2652 static Lisp_Object
  2653 hash_table_contents (struct Lisp_Hash_Table *h)
  2654 {
  2655   if (h->test.hashfn == hashfn_user_defined)
  2656     error ("cannot dump hash tables with user-defined tests");  /* Bug#36769 */
  2657 
  2658   ptrdiff_t size = HASH_TABLE_SIZE (h);
  2659   Lisp_Object key_and_value = make_uninit_vector (2 * size);
  2660   ptrdiff_t n = 0;
  2661 
  2662   /* Make sure key_and_value ends up in the same order; charset.c
  2663      relies on it by expecting hash table indices to stay constant
  2664      across the dump.  */
  2665   for (ptrdiff_t i = 0; i < size; i++)
  2666     if (!NILP (HASH_HASH (h, i)))
  2667       {
  2668         ASET (key_and_value, n++, HASH_KEY (h, i));
  2669         ASET (key_and_value, n++, HASH_VALUE (h, i));
  2670       }
  2671 
  2672   while (n < 2 * size)
  2673     {
  2674       ASET (key_and_value, n++, Qunbound);
  2675       ASET (key_and_value, n++, Qnil);
  2676     }
  2677 
  2678   return key_and_value;
  2679 }
  2680 
  2681 static dump_off
  2682 dump_hash_table_list (struct dump_context *ctx)
  2683 {
  2684   if (!NILP (ctx->hash_tables))
  2685     return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables));
  2686   else
  2687     return 0;
  2688 }
  2689 
  2690 static void
  2691 hash_table_freeze (struct Lisp_Hash_Table *h)
  2692 {
  2693   ptrdiff_t npairs = ASIZE (h->key_and_value) / 2;
  2694   h->key_and_value = hash_table_contents (h);
  2695   h->next = h->hash = make_fixnum (npairs);
  2696   h->index = make_fixnum (ASIZE (h->index));
  2697   h->next_free = (npairs == h->count ? -1 : h->count);
  2698 }
  2699 
  2700 static void
  2701 hash_table_thaw (Lisp_Object hash)
  2702 {
  2703   struct Lisp_Hash_Table *h = XHASH_TABLE (hash);
  2704   h->hash = make_nil_vector (XFIXNUM (h->hash));
  2705   h->next = Fmake_vector (h->next, make_fixnum (-1));
  2706   h->index = Fmake_vector (h->index, make_fixnum (-1));
  2707 
  2708   hash_table_rehash (hash);
  2709 }
  2710 
  2711 static dump_off
  2712 dump_hash_table (struct dump_context *ctx,
  2713                  Lisp_Object object,
  2714                  dump_off offset)
  2715 {
  2716 #if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618
  2717 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
  2718 #endif
  2719   const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
  2720   struct Lisp_Hash_Table hash_munged = *hash_in;
  2721   struct Lisp_Hash_Table *hash = &hash_munged;
  2722 
  2723   hash_table_freeze (hash);
  2724   dump_push (&ctx->hash_tables, object);
  2725 
  2726   START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
  2727   dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
  2728   /* TODO: dump the hash bucket vectors synchronously here to keep
  2729      them as close to the hash table as possible.  */
  2730   DUMP_FIELD_COPY (out, hash, count);
  2731   DUMP_FIELD_COPY (out, hash, next_free);
  2732   DUMP_FIELD_COPY (out, hash, purecopy);
  2733   DUMP_FIELD_COPY (out, hash, mutable);
  2734   DUMP_FIELD_COPY (out, hash, rehash_threshold);
  2735   DUMP_FIELD_COPY (out, hash, rehash_size);
  2736   dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG);
  2737   dump_field_lv (ctx, out, hash, &hash->test.name, WEIGHT_STRONG);
  2738   dump_field_lv (ctx, out, hash, &hash->test.user_hash_function,
  2739                  WEIGHT_STRONG);
  2740   dump_field_lv (ctx, out, hash, &hash->test.user_cmp_function,
  2741                  WEIGHT_STRONG);
  2742   dump_field_emacs_ptr (ctx, out, hash, &hash->test.cmpfn);
  2743   dump_field_emacs_ptr (ctx, out, hash, &hash->test.hashfn);
  2744   eassert (hash->next_weak == NULL);
  2745   return finish_dump_pvec (ctx, &out->header);
  2746 }
  2747 
  2748 static dump_off
  2749 dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
  2750 {
  2751 #if CHECK_STRUCTS && !defined HASH_buffer_85D317CE74
  2752 # error "buffer changed. See CHECK_STRUCTS comment in config.h."
  2753 #endif
  2754   struct buffer munged_buffer = *in_buffer;
  2755   struct buffer *buffer = &munged_buffer;
  2756 
  2757   /* Clear some buffer state for correctness upon load.  */
  2758   if (buffer->base_buffer == NULL)
  2759     buffer->window_count = 0;
  2760   else
  2761     eassert (buffer->window_count == -1);
  2762   buffer->local_minor_modes_ = Qnil;
  2763   buffer->last_selected_window_ = Qnil;
  2764   buffer->display_count_ = make_fixnum (0);
  2765   buffer->clip_changed = 0;
  2766   buffer->last_window_start = -1;
  2767   buffer->point_before_scroll_ = Qnil;
  2768 
  2769   dump_off base_offset = 0;
  2770   if (buffer->base_buffer)
  2771     {
  2772       eassert (buffer->base_buffer->base_buffer == NULL);
  2773       base_offset = dump_object_for_offset
  2774         (ctx,
  2775          make_lisp_ptr (buffer->base_buffer, Lisp_Vectorlike));
  2776     }
  2777 
  2778   eassert ((base_offset == 0 && buffer->text == &in_buffer->own_text)
  2779            || (base_offset > 0 && buffer->text != &in_buffer->own_text));
  2780 
  2781   START_DUMP_PVEC (ctx, &buffer->header, struct buffer, out);
  2782   dump_pseudovector_lisp_fields (ctx, &out->header, &buffer->header);
  2783   if (base_offset == 0)
  2784     base_offset = ctx->obj_offset;
  2785   eassert (base_offset > 0);
  2786   if (buffer->base_buffer == NULL)
  2787     {
  2788       eassert (base_offset == ctx->obj_offset);
  2789 
  2790       if (BUFFER_LIVE_P (buffer))
  2791         {
  2792           dump_field_fixup_later (ctx, out, buffer, &buffer->own_text.beg);
  2793           dump_remember_cold_op (ctx, COLD_OP_BUFFER,
  2794                                  make_lisp_ptr ((void *) in_buffer,
  2795                                                 Lisp_Vectorlike));
  2796         }
  2797       else
  2798         eassert (buffer->own_text.beg == NULL);
  2799 
  2800       DUMP_FIELD_COPY (out, buffer, own_text.gpt);
  2801       DUMP_FIELD_COPY (out, buffer, own_text.z);
  2802       DUMP_FIELD_COPY (out, buffer, own_text.gpt_byte);
  2803       DUMP_FIELD_COPY (out, buffer, own_text.z_byte);
  2804       DUMP_FIELD_COPY (out, buffer, own_text.gap_size);
  2805       DUMP_FIELD_COPY (out, buffer, own_text.modiff);
  2806       DUMP_FIELD_COPY (out, buffer, own_text.chars_modiff);
  2807       DUMP_FIELD_COPY (out, buffer, own_text.save_modiff);
  2808       DUMP_FIELD_COPY (out, buffer, own_text.overlay_modiff);
  2809       DUMP_FIELD_COPY (out, buffer, own_text.compact);
  2810       DUMP_FIELD_COPY (out, buffer, own_text.beg_unchanged);
  2811       DUMP_FIELD_COPY (out, buffer, own_text.end_unchanged);
  2812       DUMP_FIELD_COPY (out, buffer, own_text.unchanged_modified);
  2813       DUMP_FIELD_COPY (out, buffer, own_text.overlay_unchanged_modified);
  2814       if (buffer->own_text.intervals)
  2815         dump_field_fixup_later (ctx, out, buffer, &buffer->own_text.intervals);
  2816       dump_field_lv_rawptr (ctx, out, buffer, &buffer->own_text.markers,
  2817                             Lisp_Vectorlike, WEIGHT_NORMAL);
  2818       DUMP_FIELD_COPY (out, buffer, own_text.inhibit_shrinking);
  2819       DUMP_FIELD_COPY (out, buffer, own_text.redisplay);
  2820     }
  2821 
  2822   eassert (ctx->obj_offset > 0);
  2823   dump_remember_fixup_ptr_raw
  2824     (ctx,
  2825      ctx->obj_offset + dump_offsetof (struct buffer, text),
  2826      base_offset + dump_offsetof (struct buffer, own_text));
  2827 
  2828   DUMP_FIELD_COPY (out, buffer, pt);
  2829   DUMP_FIELD_COPY (out, buffer, pt_byte);
  2830   DUMP_FIELD_COPY (out, buffer, begv);
  2831   DUMP_FIELD_COPY (out, buffer, begv_byte);
  2832   DUMP_FIELD_COPY (out, buffer, zv);
  2833   DUMP_FIELD_COPY (out, buffer, zv_byte);
  2834 
  2835   if (buffer->base_buffer)
  2836     {
  2837       eassert (ctx->obj_offset != base_offset);
  2838       dump_field_ptr_to_dump_offset (ctx, out, buffer, &buffer->base_buffer,
  2839                                      base_offset);
  2840     }
  2841 
  2842   DUMP_FIELD_COPY (out, buffer, indirections);
  2843   DUMP_FIELD_COPY (out, buffer, window_count);
  2844 
  2845   memcpy (out->local_flags,
  2846           &buffer->local_flags,
  2847           sizeof (out->local_flags));
  2848   DUMP_FIELD_COPY (out, buffer, modtime);
  2849   DUMP_FIELD_COPY (out, buffer, modtime_size);
  2850   DUMP_FIELD_COPY (out, buffer, auto_save_modified);
  2851   DUMP_FIELD_COPY (out, buffer, display_error_modiff);
  2852   DUMP_FIELD_COPY (out, buffer, auto_save_failure_time);
  2853   DUMP_FIELD_COPY (out, buffer, last_window_start);
  2854 
  2855   /* Not worth serializing these caches.  TODO: really? */
  2856   out->newline_cache = NULL;
  2857   out->width_run_cache = NULL;
  2858   out->bidi_paragraph_cache = NULL;
  2859 
  2860   DUMP_FIELD_COPY (out, buffer, prevent_redisplay_optimizations_p);
  2861   DUMP_FIELD_COPY (out, buffer, clip_changed);
  2862   DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks);
  2863   DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p);
  2864 
  2865   if (buffer->overlays && buffer->overlays->root != NULL)
  2866     /* We haven't implemented the code to dump overlays.  */
  2867     emacs_abort ();
  2868   else
  2869     out->overlays = NULL;
  2870 
  2871   dump_field_lv (ctx, out, buffer, &buffer->undo_list_,
  2872                  WEIGHT_STRONG);
  2873   dump_off offset = finish_dump_pvec (ctx, &out->header);
  2874   if (!buffer->base_buffer && buffer->own_text.intervals)
  2875     dump_remember_fixup_ptr_raw
  2876       (ctx,
  2877        offset + dump_offsetof (struct buffer, own_text.intervals),
  2878        dump_interval_tree (ctx, buffer->own_text.intervals, 0));
  2879 
  2880   return offset;
  2881 }
  2882 
  2883 static dump_off
  2884 dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v)
  2885 {
  2886 #if CHECK_STRUCTS && !defined (HASH_Lisp_Vector_3091289B35)
  2887 # error "Lisp_Vector changed. See CHECK_STRUCTS comment in config.h."
  2888 #endif
  2889   /* No relocation needed, so we don't need dump_object_start.  */
  2890   dump_align_output (ctx, DUMP_ALIGNMENT);
  2891   eassert (ctx->offset >= ctx->header.cold_start);
  2892   dump_off offset = ctx->offset;
  2893   ptrdiff_t nbytes = vector_nbytes ((struct Lisp_Vector *) v);
  2894   if (nbytes > DUMP_OFF_MAX)
  2895     error ("vector too large");
  2896   dump_write (ctx, v, ptrdiff_t_to_dump_off (nbytes));
  2897   return offset;
  2898 }
  2899 
  2900 static dump_off
  2901 dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
  2902 {
  2903 #if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_20B7443AD7)
  2904 # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h."
  2905 #endif
  2906   struct Lisp_Subr out;
  2907   dump_object_start (ctx, &out, sizeof (out));
  2908   DUMP_FIELD_COPY (&out, subr, header.size);
  2909 #ifdef HAVE_NATIVE_COMP
  2910   bool native_comp = !NILP (subr->native_comp_u);
  2911 #else
  2912   bool native_comp = false;
  2913 #endif
  2914   if (native_comp)
  2915     out.function.a0 = NULL;
  2916   else
  2917     dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
  2918   DUMP_FIELD_COPY (&out, subr, min_args);
  2919   DUMP_FIELD_COPY (&out, subr, max_args);
  2920   if (native_comp)
  2921     {
  2922       dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
  2923       dump_remember_cold_op (ctx,
  2924                              COLD_OP_NATIVE_SUBR,
  2925                              make_lisp_ptr ((void *) subr, Lisp_Vectorlike));
  2926       dump_field_lv (ctx, &out, subr, &subr->intspec.native, WEIGHT_NORMAL);
  2927       dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL);
  2928     }
  2929   else
  2930     {
  2931       dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
  2932       dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec.string);
  2933       dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes);
  2934     }
  2935   DUMP_FIELD_COPY (&out, subr, doc);
  2936 #ifdef HAVE_NATIVE_COMP
  2937   dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL);
  2938   if (!NILP (subr->native_comp_u))
  2939     dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name);
  2940 
  2941   dump_field_lv (ctx, &out, subr, &subr->lambda_list, WEIGHT_NORMAL);
  2942   dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL);
  2943 #endif
  2944   dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
  2945   if (native_comp && ctx->flags.dump_object_contents)
  2946     /* We'll do the final addr relocation during VERY_LATE_RELOCS time
  2947        after the compilation units has been loaded. */
  2948     dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
  2949                list2 (make_fixnum (RELOC_NATIVE_SUBR),
  2950                       dump_off_to_lisp (subr_off)));
  2951   return subr_off;
  2952 }
  2953 
  2954 #ifdef HAVE_NATIVE_COMP
  2955 static dump_off
  2956 dump_native_comp_unit (struct dump_context *ctx,
  2957                        struct Lisp_Native_Comp_Unit *comp_u)
  2958 {
  2959   if (!CONSP (comp_u->file))
  2960     error ("Trying to dump non fixed-up eln file");
  2961 
  2962   /* Have function documentation always lazy loaded to optimize load-time.  */
  2963   comp_u->data_fdoc_v = Qnil;
  2964   START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out);
  2965   dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header);
  2966   out->handle = NULL;
  2967 
  2968   dump_off comp_u_off = finish_dump_pvec (ctx, &out->header);
  2969   if (ctx->flags.dump_object_contents)
  2970     /* We'll do the real elf load during LATE_RELOCS relocation time. */
  2971     dump_push (&ctx->dump_relocs[LATE_RELOCS],
  2972                list2 (make_fixnum (RELOC_NATIVE_COMP_UNIT),
  2973                       dump_off_to_lisp (comp_u_off)));
  2974   return comp_u_off;
  2975 }
  2976 #endif
  2977 
  2978 static void
  2979 fill_pseudovec (union vectorlike_header *header, Lisp_Object item)
  2980 {
  2981   struct Lisp_Vector *v = (struct Lisp_Vector *) header;
  2982   eassert (v->header.size & PSEUDOVECTOR_FLAG);
  2983   ptrdiff_t size = v->header.size & PSEUDOVECTOR_SIZE_MASK;
  2984   for (ptrdiff_t idx = 0; idx < size; idx++)
  2985     v->contents[idx] = item;
  2986 }
  2987 
  2988 static dump_off
  2989 dump_nilled_pseudovec (struct dump_context *ctx,
  2990                        const union vectorlike_header *in)
  2991 {
  2992   START_DUMP_PVEC (ctx, in, struct Lisp_Vector, out);
  2993   fill_pseudovec (&out->header, Qnil);
  2994   return finish_dump_pvec (ctx, &out->header);
  2995 }
  2996 
  2997 static dump_off
  2998 dump_vectorlike (struct dump_context *ctx,
  2999                  Lisp_Object lv,
  3000                  dump_off offset)
  3001 {
  3002 #if CHECK_STRUCTS && !defined HASH_pvec_type_5F2059C47E
  3003 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
  3004 #endif
  3005   const struct Lisp_Vector *v = XVECTOR (lv);
  3006   switch (PSEUDOVECTOR_TYPE (v))
  3007     {
  3008     case PVEC_FONT:
  3009       /* There are three kinds of font objects that all use PVEC_FONT,
  3010          distinguished by their size.  Font specs and entities are
  3011          harmless data carriers that we can dump like other Lisp
  3012          objects.  Fonts themselves are window-system-specific and
  3013          need to be recreated on each startup.  */
  3014       if ((v->header.size & PSEUDOVECTOR_SIZE_MASK) != FONT_SPEC_MAX
  3015           && (v->header.size & PSEUDOVECTOR_SIZE_MASK) != FONT_ENTITY_MAX)
  3016         error_unsupported_dump_object(ctx, lv, "font");
  3017       FALLTHROUGH;
  3018     case PVEC_NORMAL_VECTOR:
  3019     case PVEC_COMPILED:
  3020     case PVEC_CHAR_TABLE:
  3021     case PVEC_SUB_CHAR_TABLE:
  3022     case PVEC_RECORD:
  3023       offset = dump_vectorlike_generic (ctx, &v->header);
  3024       break;
  3025     case PVEC_BOOL_VECTOR:
  3026       offset = dump_bool_vector(ctx, v);
  3027       break;
  3028     case PVEC_HASH_TABLE:
  3029       offset = dump_hash_table (ctx, lv, offset);
  3030       break;
  3031     case PVEC_BUFFER:
  3032       offset = dump_buffer (ctx, XBUFFER (lv));
  3033       break;
  3034     case PVEC_SUBR:
  3035       offset = dump_subr (ctx, XSUBR (lv));
  3036       break;
  3037     case PVEC_FRAME:
  3038     case PVEC_WINDOW:
  3039     case PVEC_PROCESS:
  3040     case PVEC_TERMINAL:
  3041       offset = dump_nilled_pseudovec (ctx, &v->header);
  3042       break;
  3043     case PVEC_MARKER:
  3044       offset = dump_marker (ctx, XMARKER (lv));
  3045       break;
  3046     case PVEC_OVERLAY:
  3047       offset = dump_overlay (ctx, XOVERLAY (lv));
  3048       break;
  3049     case PVEC_FINALIZER:
  3050       offset = dump_finalizer (ctx, XFINALIZER (lv));
  3051       break;
  3052     case PVEC_BIGNUM:
  3053       offset = dump_bignum (ctx, lv);
  3054       break;
  3055 #ifdef HAVE_NATIVE_COMP
  3056     case PVEC_NATIVE_COMP_UNIT:
  3057       offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
  3058       break;
  3059 #endif
  3060     case PVEC_WINDOW_CONFIGURATION:
  3061       error_unsupported_dump_object (ctx, lv, "window configuration");
  3062     case PVEC_OTHER:
  3063       error_unsupported_dump_object (ctx, lv, "other?!");
  3064     case PVEC_XWIDGET:
  3065       error_unsupported_dump_object (ctx, lv, "xwidget");
  3066     case PVEC_XWIDGET_VIEW:
  3067       error_unsupported_dump_object (ctx, lv, "xwidget view");
  3068     case PVEC_MISC_PTR:
  3069     case PVEC_USER_PTR:
  3070       error_unsupported_dump_object (ctx, lv, "smuggled pointers");
  3071     case PVEC_THREAD:
  3072       if (main_thread_p (v))
  3073         {
  3074           eassert (dump_object_emacs_ptr (lv));
  3075           return DUMP_OBJECT_IS_RUNTIME_MAGIC;
  3076         }
  3077       error_unsupported_dump_object (ctx, lv, "thread");
  3078     case PVEC_MUTEX:
  3079       error_unsupported_dump_object (ctx, lv, "mutex");
  3080     case PVEC_CONDVAR:
  3081       error_unsupported_dump_object (ctx, lv, "condvar");
  3082     case PVEC_SQLITE:
  3083       error_unsupported_dump_object (ctx, lv, "sqlite");
  3084     case PVEC_MODULE_FUNCTION:
  3085       error_unsupported_dump_object (ctx, lv, "module function");
  3086     case PVEC_SYMBOL_WITH_POS:
  3087       error_unsupported_dump_object (ctx, lv, "symbol with pos");
  3088     default:
  3089       error_unsupported_dump_object(ctx, lv, "weird pseudovector");
  3090     }
  3091 
  3092   return offset;
  3093 }
  3094 
  3095 /* Add an object to the dump.
  3096 
  3097    CTX is the dump context; OBJECT is the object to add.  Normally,
  3098    return OFFSET, the location (in bytes, from the start of the dump
  3099    file) where we wrote the object.  Valid OFFSETs are always greater
  3100    than zero.
  3101 
  3102    If we've already dumped an object, return the location where we put
  3103    it: dump_object is idempotent.
  3104 
  3105    The object must refer to an actual pointer-ish object of some sort.
  3106    Some self-representing objects are immediate values rather than
  3107    tagged pointers to Lisp heap structures and so have no individual
  3108    representation in the Lisp heap dump.
  3109 
  3110    May also return one of the DUMP_OBJECT_ON_*_QUEUE constants if we
  3111    "dumped" the object by remembering to process it specially later.
  3112    In this case, we don't have a valid offset.
  3113    Call dump_object_for_offset if you need a valid offset for
  3114    an object.
  3115  */
  3116 static dump_off
  3117 dump_object (struct dump_context *ctx, Lisp_Object object)
  3118 {
  3119 #if CHECK_STRUCTS && !defined (HASH_Lisp_Type_45F0582FD7)
  3120 # error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h."
  3121 #endif
  3122   eassert (!EQ (object, dead_object ()));
  3123 
  3124   dump_off offset = dump_recall_object (ctx, object);
  3125   if (offset > 0)
  3126     return offset;  /* Object already dumped.  */
  3127 
  3128   bool cold = BOOL_VECTOR_P (object) || FLOATP (object);
  3129   if (cold && ctx->flags.defer_cold_objects)
  3130     {
  3131       if (offset != DUMP_OBJECT_ON_COLD_QUEUE)
  3132         {
  3133           eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
  3134                    || offset == DUMP_OBJECT_NOT_SEEN);
  3135           offset = DUMP_OBJECT_ON_COLD_QUEUE;
  3136           dump_remember_object (ctx, object, offset);
  3137           dump_remember_cold_op (ctx, COLD_OP_OBJECT, object);
  3138         }
  3139       return offset;
  3140     }
  3141 
  3142   void *obj_in_emacs = dump_object_emacs_ptr (object);
  3143   if (obj_in_emacs && ctx->flags.defer_copied_objects)
  3144     {
  3145       if (offset != DUMP_OBJECT_ON_COPIED_QUEUE)
  3146         {
  3147           eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
  3148                    || offset == DUMP_OBJECT_NOT_SEEN);
  3149           /* Even though we're not going to dump this object right
  3150              away, we still want to scan and enqueue its
  3151              referents.  */
  3152           struct dump_flags old_flags = ctx->flags;
  3153           ctx->flags.dump_object_contents = false;
  3154           ctx->flags.defer_copied_objects = false;
  3155           dump_object (ctx, object);
  3156           ctx->flags = old_flags;
  3157 
  3158           offset = DUMP_OBJECT_ON_COPIED_QUEUE;
  3159           dump_remember_object (ctx, object, offset);
  3160           dump_push (&ctx->copied_queue, object);
  3161         }
  3162       return offset;
  3163     }
  3164 
  3165   /* Object needs to be dumped.  */
  3166   if (dump_set_referrer (ctx))
  3167     ctx->current_referrer = object;
  3168   switch (XTYPE (object))
  3169     {
  3170     case Lisp_String:
  3171       offset = dump_string (ctx, XSTRING (object));
  3172       break;
  3173     case Lisp_Vectorlike:
  3174       offset = dump_vectorlike (ctx, object, offset);
  3175       break;
  3176     case Lisp_Symbol:
  3177       offset = dump_symbol (ctx, object, offset);
  3178       break;
  3179     case Lisp_Cons:
  3180       offset = dump_cons (ctx, XCONS (object));
  3181       break;
  3182     case Lisp_Float:
  3183       offset = dump_float (ctx, XFLOAT (object));
  3184       break;
  3185     case_Lisp_Int:
  3186       eassert ("should not be dumping int: is self-representing" && 0);
  3187       abort ();
  3188     default:
  3189       emacs_abort ();
  3190     }
  3191   dump_clear_referrer (ctx);
  3192 
  3193   /* offset can be < 0 if we've deferred an object.  */
  3194   if (ctx->flags.dump_object_contents && offset > DUMP_OBJECT_NOT_SEEN)
  3195     {
  3196       eassert (offset % DUMP_ALIGNMENT == 0);
  3197       dump_remember_object (ctx, object, offset);
  3198       if (ctx->flags.record_object_starts)
  3199         {
  3200           eassert (!ctx->flags.pack_objects);
  3201           dump_push (&ctx->object_starts,
  3202                      list2 (dump_off_to_lisp (XTYPE (object)),
  3203                             dump_off_to_lisp (offset)));
  3204         }
  3205     }
  3206 
  3207   return offset;
  3208 }
  3209 
  3210 /* Like dump_object(), but assert that we get a valid offset.  */
  3211 static dump_off
  3212 dump_object_for_offset (struct dump_context *ctx, Lisp_Object object)
  3213 {
  3214   dump_off offset = dump_object (ctx, object);
  3215   eassert (offset > 0);
  3216   return offset;
  3217 }
  3218 
  3219 static dump_off
  3220 dump_charset (struct dump_context *ctx, int cs_i)
  3221 {
  3222 #if CHECK_STRUCTS && !defined (HASH_charset_317C49E291)
  3223 # error "charset changed. See CHECK_STRUCTS comment in config.h."
  3224 #endif
  3225   dump_align_output (ctx, alignof (struct charset));
  3226   const struct charset *cs = charset_table + cs_i;
  3227   struct charset out;
  3228   dump_object_start (ctx, &out, sizeof (out));
  3229   DUMP_FIELD_COPY (&out, cs, id);
  3230   DUMP_FIELD_COPY (&out, cs, hash_index);
  3231   DUMP_FIELD_COPY (&out, cs, dimension);
  3232   memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space));
  3233   if (cs_i < charset_table_used && cs->code_space_mask)
  3234     dump_field_fixup_later (ctx, &out, cs, &cs->code_space_mask);
  3235   DUMP_FIELD_COPY (&out, cs, code_linear_p);
  3236   DUMP_FIELD_COPY (&out, cs, iso_chars_96);
  3237   DUMP_FIELD_COPY (&out, cs, ascii_compatible_p);
  3238   DUMP_FIELD_COPY (&out, cs, supplementary_p);
  3239   DUMP_FIELD_COPY (&out, cs, compact_codes_p);
  3240   DUMP_FIELD_COPY (&out, cs, unified_p);
  3241   DUMP_FIELD_COPY (&out, cs, iso_final);
  3242   DUMP_FIELD_COPY (&out, cs, iso_revision);
  3243   DUMP_FIELD_COPY (&out, cs, emacs_mule_id);
  3244   DUMP_FIELD_COPY (&out, cs, method);
  3245   DUMP_FIELD_COPY (&out, cs, min_code);
  3246   DUMP_FIELD_COPY (&out, cs, max_code);
  3247   DUMP_FIELD_COPY (&out, cs, char_index_offset);
  3248   DUMP_FIELD_COPY (&out, cs, min_char);
  3249   DUMP_FIELD_COPY (&out, cs, max_char);
  3250   DUMP_FIELD_COPY (&out, cs, invalid_code);
  3251   memcpy (out.fast_map, &cs->fast_map, sizeof (cs->fast_map));
  3252   DUMP_FIELD_COPY (&out, cs, code_offset);
  3253   dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
  3254   if (cs_i < charset_table_used && cs->code_space_mask)
  3255     dump_remember_cold_op (ctx, COLD_OP_CHARSET,
  3256                            Fcons (dump_off_to_lisp (cs_i),
  3257                                   dump_off_to_lisp (offset)));
  3258   return offset;
  3259 }
  3260 
  3261 static dump_off
  3262 dump_charset_table (struct dump_context *ctx)
  3263 {
  3264   struct dump_flags old_flags = ctx->flags;
  3265   ctx->flags.pack_objects = true;
  3266   dump_align_output (ctx, DUMP_ALIGNMENT);
  3267   dump_off offset = ctx->offset;
  3268   /* We are dumping the entire table, not just the used slots, because
  3269      otherwise when we restore from the pdump file, the actual size of
  3270      the table will be smaller than charset_table_size, and we will
  3271      crash if/when a new charset is defined.  */
  3272   for (int i = 0; i < charset_table_size; ++i)
  3273     dump_charset (ctx, i);
  3274   dump_emacs_reloc_to_dump_ptr_raw (ctx, &charset_table, offset);
  3275   ctx->flags = old_flags;
  3276   return offset;
  3277 }
  3278 
  3279 static void
  3280 dump_finalizer_list_head_ptr (struct dump_context *ctx,
  3281                               struct Lisp_Finalizer **ptr)
  3282 {
  3283   struct Lisp_Finalizer *value = *ptr;
  3284   if (value != &finalizers && value != &doomed_finalizers)
  3285     dump_emacs_reloc_to_dump_ptr_raw
  3286       (ctx, ptr,
  3287        dump_object_for_offset (ctx,
  3288                                make_lisp_ptr (value, Lisp_Vectorlike)));
  3289 }
  3290 
  3291 static void
  3292 dump_metadata_for_pdumper (struct dump_context *ctx)
  3293 {
  3294   for (int i = 0; i < nr_dump_hooks; ++i)
  3295     dump_emacs_reloc_to_emacs_ptr_raw (ctx, &dump_hooks[i],
  3296                                        (void const *) dump_hooks[i]);
  3297   dump_emacs_reloc_immediate_int (ctx, &nr_dump_hooks, nr_dump_hooks);
  3298 
  3299   for (int i = 0; i < nr_dump_late_hooks; ++i)
  3300     dump_emacs_reloc_to_emacs_ptr_raw (ctx, &dump_late_hooks[i],
  3301                                        (void const *) dump_late_hooks[i]);
  3302   dump_emacs_reloc_immediate_int (ctx, &nr_dump_late_hooks,
  3303                                   nr_dump_late_hooks);
  3304 
  3305   for (int i = 0; i < nr_remembered_data; ++i)
  3306     {
  3307       dump_emacs_reloc_to_emacs_ptr_raw (ctx, &remembered_data[i].mem,
  3308                                          remembered_data[i].mem);
  3309       dump_emacs_reloc_immediate_int (ctx, &remembered_data[i].sz,
  3310                                       remembered_data[i].sz);
  3311     }
  3312   dump_emacs_reloc_immediate_int (ctx, &nr_remembered_data,
  3313                                   nr_remembered_data);
  3314 }
  3315 
  3316 /* Sort the list of copied objects in CTX.  */
  3317 static void
  3318 dump_sort_copied_objects (struct dump_context *ctx)
  3319 {
  3320   /* Sort the objects into the order in which they'll appear in the
  3321      Emacs: this way, on startup, we'll do both the IO from the dump
  3322      file and the copy into Emacs in-order, where prefetch will be
  3323      most effective.  */
  3324   ctx->copied_queue =
  3325     Fsort (Fnreverse (ctx->copied_queue),
  3326            Qdump_emacs_portable__sort_predicate_copied);
  3327 }
  3328 
  3329 /* Dump parts of copied objects we need at runtime.  */
  3330 static void
  3331 dump_hot_parts_of_discardable_objects (struct dump_context *ctx)
  3332 {
  3333   Lisp_Object copied_queue = ctx->copied_queue;
  3334   while (!NILP (copied_queue))
  3335     {
  3336       Lisp_Object copied = dump_pop (&copied_queue);
  3337       if (SYMBOLP (copied))
  3338         {
  3339           eassert (dump_builtin_symbol_p (copied));
  3340           dump_pre_dump_symbol (ctx, XSYMBOL (copied));
  3341         }
  3342     }
  3343 }
  3344 
  3345 static void
  3346 dump_drain_copied_objects (struct dump_context *ctx)
  3347 {
  3348   Lisp_Object copied_queue = ctx->copied_queue;
  3349   ctx->copied_queue = Qnil;
  3350 
  3351   struct dump_flags old_flags = ctx->flags;
  3352 
  3353   /* We should have already fully scanned these objects, so assert
  3354      that we're not adding more entries to the dump queue.  */
  3355   ctx->flags.assert_already_seen = true;
  3356 
  3357   /* Now we want to actually dump the copied objects, not just record
  3358      them.  */
  3359   ctx->flags.defer_copied_objects = false;
  3360 
  3361   /* Objects that we memcpy into Emacs shouldn't get object-start
  3362      records (which conservative GC looks at): we usually discard this
  3363      memory after we're finished memcpying, and even if we don't, the
  3364      "real" objects in this section all live in the Emacs image, not
  3365      in the dump.  */
  3366   ctx->flags.record_object_starts = false;
  3367 
  3368   /* Dump the objects and generate a copy relocation for each.  Don't
  3369      bother trying to reduce the number of copy relocations we
  3370      generate: we'll merge adjacent copy relocations upon output.
  3371      The overall result is that to the greatest extent possible while
  3372      maintaining strictly increasing address order, we copy into Emacs
  3373      in nice big chunks.  */
  3374   while (!NILP (copied_queue))
  3375     {
  3376       Lisp_Object copied = dump_pop (&copied_queue);
  3377       void *optr = dump_object_emacs_ptr (copied);
  3378       eassert (optr != NULL);
  3379       /* N.B. start_offset is beyond any padding we insert.  */
  3380       dump_off start_offset = dump_object (ctx, copied);
  3381       if (start_offset != DUMP_OBJECT_IS_RUNTIME_MAGIC)
  3382         {
  3383           dump_off size = ctx->offset - start_offset;
  3384           dump_emacs_reloc_copy_from_dump (ctx, start_offset, optr, size);
  3385         }
  3386     }
  3387 
  3388   ctx->flags = old_flags;
  3389 }
  3390 
  3391 static void
  3392 dump_cold_string (struct dump_context *ctx, Lisp_Object string)
  3393 {
  3394   /* Dump string contents.  */
  3395   dump_off string_offset = dump_recall_object (ctx, string);
  3396   eassert (string_offset > 0);
  3397   if (SBYTES (string) > DUMP_OFF_MAX - 1)
  3398     error ("string too large");
  3399   dump_off total_size = ptrdiff_t_to_dump_off (SBYTES (string) + 1);
  3400   eassert (total_size > 0);
  3401   dump_remember_fixup_ptr_raw
  3402     (ctx,
  3403      string_offset + dump_offsetof (struct Lisp_String, u.s.data),
  3404      ctx->offset);
  3405   dump_write (ctx, XSTRING (string)->u.s.data, total_size);
  3406 }
  3407 
  3408 static void
  3409 dump_cold_charset (struct dump_context *ctx, Lisp_Object data)
  3410 {
  3411   /* Dump charset lookup tables.  */
  3412   int cs_i = XFIXNUM (XCAR (data));
  3413   dump_off cs_dump_offset = dump_off_from_lisp (XCDR (data));
  3414   dump_remember_fixup_ptr_raw
  3415     (ctx,
  3416      cs_dump_offset + dump_offsetof (struct charset, code_space_mask),
  3417      ctx->offset);
  3418   struct charset *cs = charset_table + cs_i;
  3419   dump_write (ctx, cs->code_space_mask, 256);
  3420 }
  3421 
  3422 static void
  3423 dump_cold_buffer (struct dump_context *ctx, Lisp_Object data)
  3424 {
  3425   /* Dump buffer text.  */
  3426   dump_off buffer_offset = dump_recall_object (ctx, data);
  3427   eassert (buffer_offset > 0);
  3428   struct buffer *b = XBUFFER (data);
  3429   eassert (b->text == &b->own_text);
  3430   /* Zero the gap so we don't dump uninitialized bytes.  */
  3431   memset (BUF_GPT_ADDR (b), 0, BUF_GAP_SIZE (b));
  3432   /* See buffer.c for this calculation.  */
  3433   ptrdiff_t nbytes =
  3434     BUF_Z_BYTE (b)
  3435     - BUF_BEG_BYTE (b)
  3436     + BUF_GAP_SIZE (b)
  3437     + 1;
  3438   if (nbytes > DUMP_OFF_MAX)
  3439     error ("buffer too large");
  3440   dump_remember_fixup_ptr_raw
  3441     (ctx,
  3442      buffer_offset + dump_offsetof (struct buffer, own_text.beg),
  3443      ctx->offset);
  3444   dump_write (ctx, b->own_text.beg, ptrdiff_t_to_dump_off (nbytes));
  3445 }
  3446 
  3447 static void
  3448 dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
  3449 {
  3450   mpz_t const *n = xbignum_val (object);
  3451   size_t sz_nlimbs = mpz_size (*n);
  3452   eassert (sz_nlimbs < DUMP_OFF_MAX);
  3453   dump_align_output (ctx, alignof (mp_limb_t));
  3454   dump_off nlimbs = (dump_off) sz_nlimbs;
  3455   Lisp_Object descriptor
  3456     = list2 (dump_off_to_lisp (ctx->offset),
  3457              dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
  3458   Fputhash (object, descriptor, ctx->bignum_data);
  3459   for (mp_size_t i = 0; i < nlimbs; ++i)
  3460     {
  3461       mp_limb_t limb = mpz_getlimbn (*n, i);
  3462       dump_write (ctx, &limb, sizeof (limb));
  3463     }
  3464 }
  3465 
  3466 #ifdef HAVE_NATIVE_COMP
  3467 static void
  3468 dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr)
  3469 {
  3470   /* Dump subr contents.  */
  3471   dump_off subr_offset = dump_recall_object (ctx, subr);
  3472   eassert (subr_offset > 0);
  3473   dump_remember_fixup_ptr_raw
  3474     (ctx,
  3475      subr_offset + dump_offsetof (struct Lisp_Subr, symbol_name),
  3476      ctx->offset);
  3477   const char *symbol_name = XSUBR (subr)->symbol_name;
  3478   dump_write (ctx, symbol_name, 1 + strlen (symbol_name));
  3479 
  3480   dump_remember_fixup_ptr_raw
  3481     (ctx,
  3482      subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name),
  3483      ctx->offset);
  3484   const char *c_name = XSUBR (subr)->native_c_name;
  3485   dump_write (ctx, c_name, 1 + strlen (c_name));
  3486 }
  3487 #endif
  3488 
  3489 static void
  3490 dump_drain_cold_data (struct dump_context *ctx)
  3491 {
  3492   Lisp_Object cold_queue = Fnreverse (ctx->cold_queue);
  3493   ctx->cold_queue = Qnil;
  3494 
  3495   struct dump_flags old_flags = ctx->flags;
  3496 
  3497   /* We should have already scanned all objects to which our cold
  3498      objects refer, so die if an object points to something we haven't
  3499      seen.  */
  3500   ctx->flags.assert_already_seen = true;
  3501 
  3502   /* Actually dump cold objects instead of deferring them.  */
  3503   ctx->flags.defer_cold_objects = false;
  3504 
  3505   while (!NILP (cold_queue))
  3506     {
  3507       Lisp_Object item = dump_pop (&cold_queue);
  3508       enum cold_op op = (enum cold_op) XFIXNUM (XCAR (item));
  3509       Lisp_Object data = XCDR (item);
  3510       switch (op)
  3511         {
  3512         case COLD_OP_STRING:
  3513           dump_cold_string (ctx, data);
  3514           break;
  3515         case COLD_OP_CHARSET:
  3516           dump_cold_charset (ctx, data);
  3517           break;
  3518         case COLD_OP_BUFFER:
  3519           dump_cold_buffer (ctx, data);
  3520           break;
  3521         case COLD_OP_OBJECT:
  3522           /* Objects that we can put in the cold section
  3523              must not refer to other objects.  */
  3524           eassert (dump_queue_empty_p (&ctx->dump_queue));
  3525           eassert (ctx->flags.dump_object_contents);
  3526           dump_object (ctx, data);
  3527           eassert (dump_queue_empty_p (&ctx->dump_queue));
  3528           break;
  3529         case COLD_OP_BIGNUM:
  3530           dump_cold_bignum (ctx, data);
  3531           break;
  3532 #ifdef HAVE_NATIVE_COMP
  3533         case COLD_OP_NATIVE_SUBR:
  3534           dump_cold_native_subr (ctx, data);
  3535           break;
  3536 #endif
  3537         default:
  3538           emacs_abort ();
  3539         }
  3540     }
  3541 
  3542   ctx->flags = old_flags;
  3543 }
  3544 
  3545 static void
  3546 read_ptr_raw_and_lv (const void *mem,
  3547                      enum Lisp_Type type,
  3548                      void **out_ptr,
  3549                      Lisp_Object *out_lv)
  3550 {
  3551   memcpy (out_ptr, mem, sizeof (*out_ptr));
  3552   if (*out_ptr != NULL)
  3553     {
  3554       switch (type)
  3555         {
  3556         case Lisp_Symbol:
  3557           *out_lv = make_lisp_symbol (*out_ptr);
  3558           break;
  3559         case Lisp_String:
  3560         case Lisp_Vectorlike:
  3561         case Lisp_Cons:
  3562         case Lisp_Float:
  3563           *out_lv = make_lisp_ptr (*out_ptr, type);
  3564           break;
  3565         default:
  3566           emacs_abort ();
  3567         }
  3568     }
  3569 }
  3570 
  3571 /* Enqueue for dumping objects referenced by static non-Lisp_Object
  3572    pointers inside Emacs.  */
  3573 static void
  3574 dump_drain_user_remembered_data_hot (struct dump_context *ctx)
  3575 {
  3576   for (int i = 0; i < nr_remembered_data; ++i)
  3577     {
  3578       void *mem = remembered_data[i].mem;
  3579       int sz = remembered_data[i].sz;
  3580       if (sz <= 0)
  3581         {
  3582           enum Lisp_Type type = -sz;
  3583           void *value;
  3584           Lisp_Object lv;
  3585           read_ptr_raw_and_lv (mem, type, &value, &lv);
  3586           if (value != NULL)
  3587             {
  3588               if (dump_set_referrer (ctx))
  3589                 ctx->current_referrer = dump_ptr_referrer ("user data", mem);
  3590               dump_enqueue_object (ctx, lv, WEIGHT_NONE);
  3591               dump_clear_referrer (ctx);
  3592             }
  3593         }
  3594     }
  3595 }
  3596 
  3597 /* Dump user-specified non-relocated data.  */
  3598 static void
  3599 dump_drain_user_remembered_data_cold (struct dump_context *ctx)
  3600 {
  3601   for (int i = 0; i < nr_remembered_data; ++i)
  3602     {
  3603       void *mem = remembered_data[i].mem;
  3604       int sz = remembered_data[i].sz;
  3605       if (sz > 0)
  3606         {
  3607           /* Scalar: try to inline the value into the relocation if
  3608              it's small enough; if it's bigger than we can fit in a
  3609              relocation, we have to copy the data into the dump proper
  3610              and emit a copy relocation.  */
  3611           if (sz <= sizeof (intmax_t))
  3612             dump_emacs_reloc_immediate (ctx, mem, mem, sz);
  3613           else
  3614             {
  3615               dump_emacs_reloc_copy_from_dump (ctx, ctx->offset, mem, sz);
  3616               dump_write (ctx, mem, sz);
  3617             }
  3618         }
  3619       else
  3620         {
  3621           /* *mem is a raw pointer to a Lisp object of some sort.
  3622              The object to which it points should have already been
  3623              dumped by dump_drain_user_remembered_data_hot.  */
  3624           void *value;
  3625           Lisp_Object lv;
  3626           enum Lisp_Type type = -sz;
  3627           read_ptr_raw_and_lv (mem, type, &value, &lv);
  3628           if (value == NULL)
  3629             /* We can't just ignore NULL: the variable might have
  3630                transitioned from non-NULL to NULL, and we want to
  3631                record this fact.  */
  3632             dump_emacs_reloc_immediate_ptrdiff_t (ctx, mem, 0);
  3633           else
  3634             {
  3635               if (dump_object_emacs_ptr (lv) != NULL)
  3636                 {
  3637                   /* We have situation like this:
  3638 
  3639                      static Lisp_Symbol *foo;
  3640                      ...
  3641                      foo = XSYMBOL(Qt);
  3642                      ...
  3643                      pdumper_remember_lv_ptr_raw (&foo, Lisp_Symbol);
  3644 
  3645                      Built-in symbols like Qt aren't in the dump!
  3646                      They're actually in Emacs proper.  We need a
  3647                      special case to point this value back at Emacs
  3648                      instead of to something in the dump that
  3649                      isn't there.
  3650 
  3651                      An analogous situation applies to subrs, since
  3652                      Lisp_Subr structures always live in Emacs, not
  3653                      the dump.
  3654                   */
  3655                   dump_emacs_reloc_to_emacs_ptr_raw
  3656                     (ctx, mem, dump_object_emacs_ptr (lv));
  3657                 }
  3658               else
  3659                 {
  3660                   eassert (!dump_object_self_representing_p (lv));
  3661                   dump_off dump_offset = dump_recall_object (ctx, lv);
  3662                   if (dump_offset <= 0)
  3663                     error ("raw-pointer object not dumped?!");
  3664                   dump_emacs_reloc_to_dump_ptr_raw (ctx, mem, dump_offset);
  3665                 }
  3666             }
  3667         }
  3668     }
  3669 }
  3670 
  3671 static void
  3672 dump_unwind_cleanup (void *data)
  3673 {
  3674   struct dump_context *ctx = data;
  3675   if (ctx->fd >= 0)
  3676     emacs_close (ctx->fd);
  3677 #ifdef REL_ALLOC
  3678   if (ctx->blocked_ralloc)
  3679     r_alloc_inhibit_buffer_relocation (0);
  3680 #endif
  3681   Vpurify_flag = ctx->old_purify_flag;
  3682   Vpost_gc_hook = ctx->old_post_gc_hook;
  3683   Vprocess_environment = ctx->old_process_environment;
  3684 }
  3685 
  3686 /* Check that DUMP_OFFSET is within the heap.  */
  3687 static void
  3688 dump_check_dump_off (struct dump_context *ctx, dump_off dump_offset)
  3689 {
  3690   eassert (dump_offset > 0);
  3691   eassert (!ctx || dump_offset < ctx->end_heap);
  3692 }
  3693 
  3694 static void
  3695 dump_check_emacs_off (dump_off emacs_off)
  3696 {
  3697   eassert (labs (emacs_off) <= 60 * 1024 * 1024);
  3698 }
  3699 
  3700 static struct dump_reloc
  3701 dump_decode_dump_reloc (Lisp_Object lreloc)
  3702 {
  3703   struct dump_reloc reloc;
  3704   dump_reloc_set_type (&reloc,
  3705                        (enum dump_reloc_type) XFIXNUM (dump_pop (&lreloc)));
  3706   eassert (reloc.type <= RELOC_DUMP_TO_EMACS_LV + Lisp_Float);
  3707   dump_reloc_set_offset (&reloc, dump_off_from_lisp (dump_pop (&lreloc)));
  3708   eassert (NILP (lreloc));
  3709   return reloc;
  3710 }
  3711 
  3712 static void
  3713 dump_emit_dump_reloc (struct dump_context *ctx, Lisp_Object lreloc)
  3714 {
  3715   eassert (ctx->flags.pack_objects);
  3716   struct dump_reloc reloc;
  3717   dump_object_start (ctx, &reloc, sizeof (reloc));
  3718   reloc = dump_decode_dump_reloc (lreloc);
  3719   dump_check_dump_off (ctx, dump_reloc_get_offset (reloc));
  3720   dump_object_finish (ctx, &reloc, sizeof (reloc));
  3721   if (dump_reloc_get_offset (reloc) < ctx->header.discardable_start)
  3722     ctx->number_hot_relocations += 1;
  3723   else
  3724     ctx->number_discardable_relocations += 1;
  3725 }
  3726 
  3727 #ifdef ENABLE_CHECKING
  3728 static Lisp_Object
  3729 dump_check_overlap_dump_reloc (Lisp_Object lreloc_a,
  3730                                Lisp_Object lreloc_b)
  3731 {
  3732   struct dump_reloc reloc_a = dump_decode_dump_reloc (lreloc_a);
  3733   struct dump_reloc reloc_b = dump_decode_dump_reloc (lreloc_b);
  3734   eassert (dump_reloc_get_offset (reloc_a) < dump_reloc_get_offset (reloc_b));
  3735   return Qnil;
  3736 }
  3737 #endif
  3738 
  3739 /* Translate a Lisp Emacs-relocation descriptor (a list whose first
  3740    element is one of the EMACS_RELOC_* values, encoded as a fixnum)
  3741    into an emacs_reloc structure value suitable for writing to the
  3742    dump file.
  3743 */
  3744 static struct emacs_reloc
  3745 decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
  3746 {
  3747   struct emacs_reloc reloc = {0};
  3748   int type = XFIXNUM (dump_pop (&lreloc));
  3749   reloc.emacs_offset = dump_off_from_lisp (dump_pop (&lreloc));
  3750   dump_check_emacs_off (reloc.emacs_offset);
  3751   switch (type)
  3752     {
  3753     case RELOC_EMACS_COPY_FROM_DUMP:
  3754       {
  3755         emacs_reloc_set_type (&reloc, type);
  3756         reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc));
  3757         dump_check_dump_off (ctx, reloc.u.dump_offset);
  3758         dump_off length = dump_off_from_lisp (dump_pop (&lreloc));
  3759         reloc.length = length;
  3760         if (reloc.length != length)
  3761           error ("relocation copy length too large");
  3762       }
  3763       break;
  3764     case RELOC_EMACS_IMMEDIATE:
  3765       {
  3766         emacs_reloc_set_type (&reloc, type);
  3767         intmax_t value = intmax_t_from_lisp (dump_pop (&lreloc));
  3768         dump_off size = dump_off_from_lisp (dump_pop (&lreloc));
  3769         reloc.u.immediate = value;
  3770         reloc.length = size;
  3771         eassert (reloc.length == size);
  3772       }
  3773       break;
  3774     case RELOC_EMACS_EMACS_PTR_RAW:
  3775       emacs_reloc_set_type (&reloc, type);
  3776       reloc.u.emacs_offset2 = dump_off_from_lisp (dump_pop (&lreloc));
  3777       dump_check_emacs_off (reloc.u.emacs_offset2);
  3778       break;
  3779     case RELOC_EMACS_DUMP_PTR_RAW:
  3780       emacs_reloc_set_type (&reloc, type);
  3781       reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc));
  3782       dump_check_dump_off (ctx, reloc.u.dump_offset);
  3783       break;
  3784     case RELOC_EMACS_DUMP_LV:
  3785     case RELOC_EMACS_EMACS_LV:
  3786       {
  3787         emacs_reloc_set_type (&reloc, type);
  3788         Lisp_Object target_value = dump_pop (&lreloc);
  3789         /* If the object is self-representing,
  3790            dump_emacs_reloc_to_lv didn't do its job.
  3791            dump_emacs_reloc_to_lv should have added a
  3792            RELOC_EMACS_IMMEDIATE relocation instead.  */
  3793         eassert (!dump_object_self_representing_p (target_value));
  3794         int tag_type = XTYPE (target_value);
  3795         reloc.length = tag_type;
  3796         eassert (reloc.length == tag_type);
  3797 
  3798         if (type == RELOC_EMACS_EMACS_LV)
  3799           {
  3800             void *obj_in_emacs = dump_object_emacs_ptr (target_value);
  3801             eassert (obj_in_emacs);
  3802             reloc.u.emacs_offset2 = emacs_offset (obj_in_emacs);
  3803           }
  3804         else
  3805           {
  3806             eassume (ctx); /* Pacify GCC 9.2.1 -O3 -Wnull-dereference.  */
  3807             eassert (!dump_object_emacs_ptr (target_value));
  3808             reloc.u.dump_offset = dump_recall_object (ctx, target_value);
  3809             if (reloc.u.dump_offset <= 0)
  3810               {
  3811                 Lisp_Object repr = Fprin1_to_string (target_value, Qnil, Qnil);
  3812                 error ("relocation target was not dumped: %s", SDATA (repr));
  3813               }
  3814             dump_check_dump_off (ctx, reloc.u.dump_offset);
  3815           }
  3816       }
  3817       break;
  3818     default:
  3819       eassume (!"not reached");
  3820     }
  3821 
  3822   /* We should have consumed the whole relocation descriptor.  */
  3823   eassert (NILP (lreloc));
  3824 
  3825   return reloc;
  3826 }
  3827 
  3828 static void
  3829 dump_emit_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
  3830 {
  3831   eassert (ctx->flags.pack_objects);
  3832   struct emacs_reloc reloc;
  3833   dump_object_start (ctx, &reloc, sizeof (reloc));
  3834   reloc = decode_emacs_reloc (ctx, lreloc);
  3835   dump_object_finish (ctx, &reloc, sizeof (reloc));
  3836 }
  3837 
  3838 static Lisp_Object
  3839 dump_merge_emacs_relocs (Lisp_Object lreloc_a, Lisp_Object lreloc_b)
  3840 {
  3841   /* Combine copy relocations together if they're copying from
  3842      adjacent chunks to adjacent chunks.  */
  3843 
  3844 #ifdef ENABLE_CHECKING
  3845   {
  3846     dump_off off_a = dump_off_from_lisp (XCAR (XCDR (lreloc_a)));
  3847     dump_off off_b = dump_off_from_lisp (XCAR (XCDR (lreloc_b)));
  3848     eassert (off_a <= off_b);  /* Catch sort errors.  */
  3849     eassert (off_a < off_b);  /* Catch duplicate relocations.  */
  3850   }
  3851 #endif
  3852 
  3853   if (XFIXNUM (XCAR (lreloc_a)) != RELOC_EMACS_COPY_FROM_DUMP
  3854       || XFIXNUM (XCAR (lreloc_b)) != RELOC_EMACS_COPY_FROM_DUMP)
  3855     return Qnil;
  3856 
  3857   struct emacs_reloc reloc_a = decode_emacs_reloc (NULL, lreloc_a);
  3858   struct emacs_reloc reloc_b = decode_emacs_reloc (NULL, lreloc_b);
  3859 
  3860   eassert (reloc_a.type == RELOC_EMACS_COPY_FROM_DUMP);
  3861   eassert (reloc_b.type == RELOC_EMACS_COPY_FROM_DUMP);
  3862 
  3863   if (reloc_a.emacs_offset + reloc_a.length != reloc_b.emacs_offset)
  3864     return Qnil;
  3865 
  3866   if (reloc_a.u.dump_offset + reloc_a.length != reloc_b.u.dump_offset)
  3867     return Qnil;
  3868 
  3869   dump_off new_length = reloc_a.length + reloc_b.length;
  3870   reloc_a.length = new_length;
  3871   if (reloc_a.length != new_length)
  3872     return Qnil; /* Overflow */
  3873 
  3874   return list4 (make_fixnum (RELOC_EMACS_COPY_FROM_DUMP),
  3875                 dump_off_to_lisp (reloc_a.emacs_offset),
  3876                 dump_off_to_lisp (reloc_a.u.dump_offset),
  3877                 dump_off_to_lisp (reloc_a.length));
  3878 }
  3879 
  3880 typedef void (*drain_reloc_handler) (struct dump_context *, Lisp_Object);
  3881 typedef Lisp_Object (*drain_reloc_merger) (Lisp_Object a, Lisp_Object b);
  3882 
  3883 static void
  3884 drain_reloc_list (struct dump_context *ctx,
  3885                   drain_reloc_handler handler,
  3886                   drain_reloc_merger merger,
  3887                   Lisp_Object *reloc_list,
  3888                   struct dump_table_locator *out_locator)
  3889 {
  3890   struct dump_flags old_flags = ctx->flags;
  3891   ctx->flags.pack_objects = true;
  3892   Lisp_Object relocs = Fsort (Fnreverse (*reloc_list),
  3893                               Qdump_emacs_portable__sort_predicate);
  3894   *reloc_list = Qnil;
  3895   dump_align_output (ctx, max (alignof (struct dump_reloc),
  3896                                alignof (struct emacs_reloc)));
  3897   struct dump_table_locator locator = {0};
  3898   locator.offset = ctx->offset;
  3899   for (; !NILP (relocs); locator.nr_entries += 1)
  3900     {
  3901       Lisp_Object reloc = dump_pop (&relocs);
  3902       Lisp_Object merged;
  3903       while (merger != NULL
  3904              && !NILP (relocs)
  3905              && (merged = merger (reloc, XCAR (relocs)), !NILP (merged)))
  3906         {
  3907           reloc = merged;
  3908           relocs = XCDR (relocs);
  3909         }
  3910       handler (ctx, reloc);
  3911     }
  3912   *out_locator = locator;
  3913   ctx->flags = old_flags;
  3914 }
  3915 
  3916 static void
  3917 dump_do_fixup (struct dump_context *ctx,
  3918                Lisp_Object fixup,
  3919                Lisp_Object prev_fixup)
  3920 {
  3921   enum dump_fixup_type type =
  3922     (enum dump_fixup_type) XFIXNUM (dump_pop (&fixup));
  3923   dump_off dump_fixup_offset = dump_off_from_lisp (dump_pop (&fixup));
  3924 #ifdef ENABLE_CHECKING
  3925   if (!NILP (prev_fixup))
  3926     {
  3927       dump_off prev_dump_fixup_offset =
  3928         dump_off_from_lisp (XCAR (XCDR (prev_fixup)));
  3929       eassert (dump_fixup_offset - prev_dump_fixup_offset
  3930                >= sizeof (void *));
  3931     }
  3932 #endif
  3933   Lisp_Object arg = dump_pop (&fixup);
  3934   eassert (NILP (fixup));
  3935   dump_seek (ctx, dump_fixup_offset);
  3936   intptr_t dump_value;
  3937   bool do_write = true;
  3938   switch (type)
  3939     {
  3940     case DUMP_FIXUP_LISP_OBJECT:
  3941     case DUMP_FIXUP_LISP_OBJECT_RAW:
  3942       /* Dump wants a pointer to a Lisp object.
  3943          If DUMP_FIXUP_LISP_OBJECT_RAW, we should stick a C pointer in
  3944          the dump; otherwise, a Lisp_Object.  */
  3945       if (SUBRP (arg) && !SUBR_NATIVE_COMPILEDP (arg))
  3946         {
  3947           dump_value = emacs_offset (XSUBR (arg));
  3948           if (type == DUMP_FIXUP_LISP_OBJECT)
  3949             dump_reloc_dump_to_emacs_lv (ctx, ctx->offset, XTYPE (arg));
  3950           else
  3951             dump_reloc_dump_to_emacs_ptr_raw (ctx, ctx->offset);
  3952         }
  3953       else if (dump_builtin_symbol_p (arg))
  3954         {
  3955           eassert (dump_object_self_representing_p (arg));
  3956           /* These symbols are part of Emacs, so point there.  If we
  3957              want a Lisp_Object, we're set.  If we want a raw pointer,
  3958              we need to emit a relocation.  */
  3959           if (type == DUMP_FIXUP_LISP_OBJECT)
  3960             {
  3961               do_write = false;
  3962               dump_write (ctx, &arg, sizeof (arg));
  3963             }
  3964           else
  3965             {
  3966               dump_value = emacs_offset (XSYMBOL (arg));
  3967               dump_reloc_dump_to_emacs_ptr_raw (ctx, ctx->offset);
  3968             }
  3969         }
  3970       else
  3971         {
  3972           eassert (dump_object_emacs_ptr (arg) == NULL);
  3973           dump_value = dump_recall_object (ctx, arg);
  3974           if (dump_value <= 0)
  3975             error ("fixup object not dumped");
  3976           if (type == DUMP_FIXUP_LISP_OBJECT)
  3977             dump_reloc_dump_to_dump_lv (ctx, ctx->offset, XTYPE (arg));
  3978           else
  3979             dump_reloc_dump_to_dump_ptr_raw (ctx, ctx->offset);
  3980         }
  3981       break;
  3982     case DUMP_FIXUP_PTR_DUMP_RAW:
  3983       /* Dump wants a raw pointer to something that's not a lisp
  3984          object.  It knows the exact location it wants, so just
  3985          believe it.  */
  3986       dump_value = dump_off_from_lisp (arg);
  3987       dump_reloc_dump_to_dump_ptr_raw (ctx, ctx->offset);
  3988       break;
  3989     case DUMP_FIXUP_BIGNUM_DATA:
  3990       {
  3991         eassert (BIGNUMP (arg));
  3992         arg = Fgethash (arg, ctx->bignum_data, Qnil);
  3993         if (NILP (arg))
  3994           error ("bignum not dumped");
  3995         struct bignum_reload_info reload_info = { 0 };
  3996         reload_info.data_location = dump_off_from_lisp (dump_pop (&arg));
  3997         reload_info.nlimbs = dump_off_from_lisp (dump_pop (&arg));
  3998         eassert (NILP (arg));
  3999         dump_write (ctx, &reload_info, sizeof (reload_info));
  4000         do_write = false;
  4001         break;
  4002       }
  4003     default:
  4004       emacs_abort ();
  4005     }
  4006   if (do_write)
  4007     dump_write (ctx, &dump_value, sizeof (dump_value));
  4008 }
  4009 
  4010 static void
  4011 dump_do_fixups (struct dump_context *ctx)
  4012 {
  4013   dump_off saved_offset = ctx->offset;
  4014   Lisp_Object fixups = Fsort (Fnreverse (ctx->fixups),
  4015                               Qdump_emacs_portable__sort_predicate);
  4016   Lisp_Object prev_fixup = Qnil;
  4017   ctx->fixups = Qnil;
  4018   while (!NILP (fixups))
  4019     {
  4020       Lisp_Object fixup = dump_pop (&fixups);
  4021       dump_do_fixup (ctx, fixup, prev_fixup);
  4022       prev_fixup = fixup;
  4023     }
  4024   dump_seek (ctx, saved_offset);
  4025 }
  4026 
  4027 static void
  4028 dump_drain_normal_queue (struct dump_context *ctx)
  4029 {
  4030   while (!dump_queue_empty_p (&ctx->dump_queue))
  4031     dump_object (ctx, dump_queue_dequeue (&ctx->dump_queue, ctx->offset));
  4032 }
  4033 
  4034 static void
  4035 dump_drain_deferred_hash_tables (struct dump_context *ctx)
  4036 {
  4037   struct dump_flags old_flags = ctx->flags;
  4038 
  4039   /* Now we want to actually write the hash tables.  */
  4040   ctx->flags.defer_hash_tables = false;
  4041 
  4042   Lisp_Object deferred_hash_tables = Fnreverse (ctx->deferred_hash_tables);
  4043   ctx->deferred_hash_tables = Qnil;
  4044   while (!NILP (deferred_hash_tables))
  4045     dump_object (ctx, dump_pop (&deferred_hash_tables));
  4046   ctx->flags = old_flags;
  4047 }
  4048 
  4049 static void
  4050 dump_drain_deferred_symbols (struct dump_context *ctx)
  4051 {
  4052   struct dump_flags old_flags = ctx->flags;
  4053 
  4054   /* Now we want to actually write the symbols.  */
  4055   ctx->flags.defer_symbols = false;
  4056 
  4057   Lisp_Object deferred_symbols = Fnreverse (ctx->deferred_symbols);
  4058   ctx->deferred_symbols = Qnil;
  4059   while (!NILP (deferred_symbols))
  4060     dump_object (ctx, dump_pop (&deferred_symbols));
  4061   ctx->flags = old_flags;
  4062 }
  4063 
  4064 DEFUN ("dump-emacs-portable",
  4065        Fdump_emacs_portable, Sdump_emacs_portable,
  4066        1, 2, 0,
  4067        doc: /* Dump current state of Emacs into dump file FILENAME.
  4068 If TRACK-REFERRERS is non-nil, keep additional debugging information
  4069 that can help track down the provenance of unsupported object
  4070 types.  */)
  4071      (Lisp_Object filename, Lisp_Object track_referrers)
  4072 {
  4073   eassert (initialized);
  4074 
  4075   if (! noninteractive)
  4076     error ("Dumping Emacs currently works only in batch mode.  "
  4077            "If you'd like it to work interactively, please consider "
  4078            "contributing a patch to Emacs.");
  4079 
  4080   if (will_dump_with_unexec_p ())
  4081     error ("This Emacs instance was started under the assumption "
  4082            "that it would be dumped with unexec, not the portable "
  4083            "dumper.  Dumping with the portable dumper may produce "
  4084            "unexpected results.");
  4085 
  4086   if (!main_thread_p (current_thread))
  4087     error ("This function can be called only in the main thread");
  4088 
  4089   if (!NILP (XCDR (Fall_threads ())))
  4090     error ("No other Lisp threads can be running when this function is called");
  4091 
  4092   check_pure_size ();
  4093 
  4094   /* Clear out any detritus in memory.  */
  4095   do
  4096     {
  4097       number_finalizers_run = 0;
  4098       garbage_collect ();
  4099     }
  4100   while (number_finalizers_run);
  4101 
  4102   specpdl_ref count = SPECPDL_INDEX ();
  4103 
  4104   /* Bind `command-line-processed' to nil before dumping,
  4105      so that the dumped Emacs will process its command line
  4106      and set up to work with X windows if appropriate.  */
  4107   Lisp_Object symbol = intern ("command-line-processed");
  4108   specbind (symbol, Qnil);
  4109 
  4110   CHECK_STRING (filename);
  4111   filename = Fexpand_file_name (filename, Qnil);
  4112   filename = ENCODE_FILE (filename);
  4113 
  4114   struct dump_context ctx_buf = {0};
  4115   struct dump_context *ctx = &ctx_buf;
  4116   ctx->fd = -1;
  4117 
  4118   ctx->objects_dumped = make_eq_hash_table ();
  4119   dump_queue_init (&ctx->dump_queue);
  4120   ctx->deferred_hash_tables = Qnil;
  4121   ctx->deferred_symbols = Qnil;
  4122 
  4123   ctx->fixups = Qnil;
  4124   ctx->staticpro_table = Fmake_hash_table (0, NULL);
  4125   ctx->symbol_aux = Qnil;
  4126   ctx->copied_queue = Qnil;
  4127   ctx->cold_queue = Qnil;
  4128   for (int i = 0; i < RELOC_NUM_PHASES; ++i)
  4129     ctx->dump_relocs[i] = Qnil;
  4130   ctx->object_starts = Qnil;
  4131   ctx->emacs_relocs = Qnil;
  4132   ctx->bignum_data = make_eq_hash_table ();
  4133 
  4134   /* Ordinarily, dump_object should remember where it saw objects and
  4135      actually write the object contents to the dump file.  In special
  4136      circumstances below, we temporarily change this default
  4137      behavior.  */
  4138   ctx->flags.dump_object_contents = true;
  4139   ctx->flags.record_object_starts = true;
  4140 
  4141   /* We want to consolidate certain object types that we know are very likely
  4142      to be modified.  */
  4143   ctx->flags.defer_hash_tables = true;
  4144   /* ctx->flags.defer_symbols = true; XXX  */
  4145 
  4146   /* These objects go into special sections.  */
  4147   ctx->flags.defer_cold_objects = true;
  4148   ctx->flags.defer_copied_objects = true;
  4149 
  4150   ctx->current_referrer = Qnil;
  4151   if (!NILP (track_referrers))
  4152     ctx->referrers = make_eq_hash_table ();
  4153 
  4154   ctx->dump_filename = filename;
  4155 
  4156   record_unwind_protect_ptr (dump_unwind_cleanup, ctx);
  4157   block_input ();
  4158 
  4159 #ifdef REL_ALLOC
  4160   r_alloc_inhibit_buffer_relocation (1);
  4161   ctx->blocked_ralloc = true;
  4162 #endif
  4163 
  4164   ctx->old_purify_flag = Vpurify_flag;
  4165   Vpurify_flag = Qnil;
  4166 
  4167   /* Make sure various weird things are less likely to happen.  */
  4168   ctx->old_post_gc_hook = Vpost_gc_hook;
  4169   Vpost_gc_hook = Qnil;
  4170 
  4171   /* Reset process-environment -- this is for when they re-dump a
  4172      pdump-restored emacs, since set_initial_environment wants always
  4173      to cons it from scratch.  */
  4174   ctx->old_process_environment = Vprocess_environment;
  4175   Vprocess_environment = Qnil;
  4176 
  4177   ctx->fd = emacs_open (SSDATA (filename),
  4178                         O_RDWR | O_TRUNC | O_CREAT, 0666);
  4179   if (ctx->fd < 0)
  4180     report_file_error ("Opening dump output", filename);
  4181   verify (sizeof (ctx->header.magic) == sizeof (dump_magic));
  4182   memcpy (&ctx->header.magic, dump_magic, sizeof (dump_magic));
  4183   ctx->header.magic[0] = '!'; /* Note that dump is incomplete.  */
  4184 
  4185   verify (sizeof (fingerprint) == sizeof (ctx->header.fingerprint));
  4186   for (int i = 0; i < sizeof fingerprint; i++)
  4187     ctx->header.fingerprint[i] = fingerprint[i];
  4188 
  4189   const dump_off header_start = ctx->offset;
  4190   dump_fingerprint (stderr, "Dumping fingerprint", ctx->header.fingerprint);
  4191   dump_write (ctx, &ctx->header, sizeof (ctx->header));
  4192   const dump_off header_end = ctx->offset;
  4193 
  4194   const dump_off hot_start = ctx->offset;
  4195   /* Start the dump process by processing the static roots and
  4196      queuing up the objects to which they refer.   */
  4197   dump_roots (ctx);
  4198 
  4199   dump_charset_table (ctx);
  4200   dump_finalizer_list_head_ptr (ctx, &finalizers.prev);
  4201   dump_finalizer_list_head_ptr (ctx, &finalizers.next);
  4202   dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.prev);
  4203   dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.next);
  4204   dump_drain_user_remembered_data_hot (ctx);
  4205 
  4206   /* We've already remembered all the objects to which GC roots point,
  4207      but we have to manually save the list of GC roots itself.  */
  4208   dump_metadata_for_pdumper (ctx);
  4209   for (int i = 0; i < staticidx; ++i)
  4210     dump_emacs_reloc_to_emacs_ptr_raw (ctx, &staticvec[i], staticvec[i]);
  4211   dump_emacs_reloc_immediate_int (ctx, &staticidx, staticidx);
  4212 
  4213   /* Dump until while we keep finding objects to dump.  We add new
  4214      objects to the queue by side effect during dumping.
  4215      We accumulate some types of objects in special lists to get more
  4216      locality for these object types at runtime.  */
  4217   do
  4218     {
  4219       dump_drain_deferred_hash_tables (ctx);
  4220       dump_drain_deferred_symbols (ctx);
  4221       dump_drain_normal_queue (ctx);
  4222     }
  4223   while (!dump_queue_empty_p (&ctx->dump_queue)
  4224          || !NILP (ctx->deferred_hash_tables)
  4225          || !NILP (ctx->deferred_symbols));
  4226 
  4227   ctx->header.hash_list = ctx->offset;
  4228   dump_hash_table_list (ctx);
  4229 
  4230   do
  4231     {
  4232       dump_drain_deferred_hash_tables (ctx);
  4233       dump_drain_deferred_symbols (ctx);
  4234       dump_drain_normal_queue (ctx);
  4235     }
  4236   while (!dump_queue_empty_p (&ctx->dump_queue)
  4237          || !NILP (ctx->deferred_hash_tables)
  4238          || !NILP (ctx->deferred_symbols));
  4239 
  4240   dump_sort_copied_objects (ctx);
  4241 
  4242   /* While we copy built-in symbols into the Emacs image, these
  4243      built-in structures refer to non-Lisp heap objects that must live
  4244      in the dump; we stick these auxiliary data structures at the end
  4245      of the hot section and use a special hash table to remember them.
  4246      The actual symbol dump will pick them up below.  */
  4247   ctx->symbol_aux = make_eq_hash_table ();
  4248   dump_hot_parts_of_discardable_objects (ctx);
  4249 
  4250   /* Emacs, after initial dump loading, can forget about the portion
  4251      of the dump that runs from here to the start of the cold section.
  4252      This section consists of objects that need to be memcpy()ed into
  4253      the Emacs data section instead of just used directly.
  4254 
  4255      We don't need to align hot_end: the loader knows to actually
  4256      start discarding only at the next page boundary if the loader
  4257      implements discarding using page manipulation.  */
  4258   const dump_off hot_end = ctx->offset;
  4259   ctx->header.discardable_start = hot_end;
  4260 
  4261   dump_drain_copied_objects (ctx);
  4262   eassert (dump_queue_empty_p (&ctx->dump_queue));
  4263 
  4264   dump_off discardable_end = ctx->offset;
  4265   dump_align_output (ctx, dump_get_max_page_size ());
  4266   ctx->header.cold_start = ctx->offset;
  4267 
  4268   /* Start the cold section.  This section contains bytes that should
  4269      never change and so can be direct-mapped from the dump without
  4270      special processing.  */
  4271   dump_drain_cold_data (ctx);
  4272    /* dump_drain_user_remembered_data_cold needs to be after
  4273       dump_drain_cold_data in case dump_drain_cold_data dumps a lisp
  4274       object to which C code points.
  4275       dump_drain_user_remembered_data_cold assumes that all lisp
  4276       objects have been dumped.  */
  4277   dump_drain_user_remembered_data_cold (ctx);
  4278 
  4279   /* After this point, the dump file contains no data that can be part
  4280      of the Lisp heap.  */
  4281   ctx->end_heap = ctx->offset;
  4282 
  4283   /* Make remembered modifications to the dump file itself.  */
  4284   dump_do_fixups (ctx);
  4285 
  4286   drain_reloc_merger emacs_reloc_merger =
  4287 #ifdef ENABLE_CHECKING
  4288     dump_check_overlap_dump_reloc
  4289 #else
  4290     NULL
  4291 #endif
  4292     ;
  4293 
  4294   /* Emit instructions for Emacs to execute when loading the dump.
  4295      Note that this relocation information ends up in the cold section
  4296      of the dump.  */
  4297   for (int i = 0; i < RELOC_NUM_PHASES; ++i)
  4298     drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
  4299                       &ctx->dump_relocs[i], &ctx->header.dump_relocs[i]);
  4300   dump_off number_hot_relocations = ctx->number_hot_relocations;
  4301   ctx->number_hot_relocations = 0;
  4302   dump_off number_discardable_relocations = ctx->number_discardable_relocations;
  4303   ctx->number_discardable_relocations = 0;
  4304   drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
  4305                     &ctx->object_starts, &ctx->header.object_starts);
  4306   drain_reloc_list (ctx, dump_emit_emacs_reloc, dump_merge_emacs_relocs,
  4307                     &ctx->emacs_relocs, &ctx->header.emacs_relocs);
  4308 
  4309   const dump_off cold_end = ctx->offset;
  4310 
  4311   eassert (dump_queue_empty_p (&ctx->dump_queue));
  4312   eassert (NILP (ctx->copied_queue));
  4313   eassert (NILP (ctx->cold_queue));
  4314   eassert (NILP (ctx->deferred_symbols));
  4315   eassert (NILP (ctx->deferred_hash_tables));
  4316   eassert (NILP (ctx->fixups));
  4317   for (int i = 0; i < RELOC_NUM_PHASES; ++i)
  4318     eassert (NILP (ctx->dump_relocs[i]));
  4319   eassert (NILP (ctx->emacs_relocs));
  4320 
  4321   /* Dump is complete.  Go back to the header and write the magic
  4322      indicating that the dump is complete and can be loaded.  */
  4323   ctx->header.magic[0] = dump_magic[0];
  4324   dump_seek (ctx, 0);
  4325   dump_write (ctx, &ctx->header, sizeof (ctx->header));
  4326   if (emacs_write (ctx->fd, ctx->buf, ctx->max_offset) < ctx->max_offset)
  4327     report_file_error ("Could not write to dump file", ctx->dump_filename);
  4328   xfree (ctx->buf);
  4329   ctx->buf = NULL;
  4330   ctx->buf_size = 0;
  4331   ctx->max_offset = 0;
  4332 
  4333   dump_off
  4334     header_bytes = header_end - header_start,
  4335     hot_bytes = hot_end - hot_start,
  4336     discardable_bytes = discardable_end - ctx->header.discardable_start,
  4337     cold_bytes = cold_end - ctx->header.cold_start;
  4338   fprintf (stderr,
  4339            ("Dump complete\n"
  4340             "Byte counts: header=%"PRIdDUMP_OFF" hot=%"PRIdDUMP_OFF
  4341             " discardable=%"PRIdDUMP_OFF" cold=%"PRIdDUMP_OFF"\n"
  4342             "Reloc counts: hot=%"PRIdDUMP_OFF" discardable=%"PRIdDUMP_OFF"\n"),
  4343            header_bytes, hot_bytes, discardable_bytes, cold_bytes,
  4344            number_hot_relocations,
  4345            number_discardable_relocations);
  4346 
  4347   unblock_input ();
  4348   return unbind_to (count, Qnil);
  4349 }
  4350 
  4351 DEFUN ("dump-emacs-portable--sort-predicate",
  4352        Fdump_emacs_portable__sort_predicate,
  4353        Sdump_emacs_portable__sort_predicate,
  4354        2, 2, 0,
  4355        doc: /* Internal relocation sorting function.  */)
  4356      (Lisp_Object a, Lisp_Object b)
  4357 {
  4358   dump_off a_offset = dump_off_from_lisp (XCAR (XCDR (a)));
  4359   dump_off b_offset = dump_off_from_lisp (XCAR (XCDR (b)));
  4360   return a_offset < b_offset ? Qt : Qnil;
  4361 }
  4362 
  4363 DEFUN ("dump-emacs-portable--sort-predicate-copied",
  4364        Fdump_emacs_portable__sort_predicate_copied,
  4365        Sdump_emacs_portable__sort_predicate_copied,
  4366        2, 2, 0,
  4367        doc: /* Internal relocation sorting function.  */)
  4368      (Lisp_Object a, Lisp_Object b)
  4369 {
  4370   eassert (dump_object_emacs_ptr (a));
  4371   eassert (dump_object_emacs_ptr (b));
  4372   return dump_object_emacs_ptr (a) < dump_object_emacs_ptr (b) ? Qt : Qnil;
  4373 }
  4374 
  4375 void
  4376 pdumper_do_now_and_after_load_impl (pdumper_hook hook)
  4377 {
  4378   if (nr_dump_hooks == ARRAYELTS (dump_hooks))
  4379     fatal ("out of dump hooks: make dump_hooks[] bigger");
  4380   dump_hooks[nr_dump_hooks++] = hook;
  4381   hook ();
  4382 }
  4383 
  4384 void
  4385 pdumper_do_now_and_after_late_load_impl (pdumper_hook hook)
  4386 {
  4387   if (nr_dump_late_hooks == ARRAYELTS (dump_late_hooks))
  4388     fatal ("out of dump hooks: make dump_late_hooks[] bigger");
  4389   dump_late_hooks[nr_dump_late_hooks++] = hook;
  4390   hook ();
  4391 }
  4392 
  4393 static void
  4394 pdumper_remember_user_data_1 (void *mem, int nbytes)
  4395 {
  4396   if (nr_remembered_data == ARRAYELTS (remembered_data))
  4397     fatal ("out of remembered data slots: make remembered_data[] bigger");
  4398   remembered_data[nr_remembered_data].mem = mem;
  4399   remembered_data[nr_remembered_data].sz = nbytes;
  4400   nr_remembered_data += 1;
  4401 }
  4402 
  4403 void
  4404 pdumper_remember_scalar_impl (void *mem, ptrdiff_t nbytes)
  4405 {
  4406   eassert (0 <= nbytes && nbytes <= INT_MAX);
  4407   if (nbytes > 0)
  4408     pdumper_remember_user_data_1 (mem, (int) nbytes);
  4409 }
  4410 
  4411 void
  4412 pdumper_remember_lv_ptr_raw_impl (void *ptr, enum Lisp_Type type)
  4413 {
  4414   pdumper_remember_user_data_1 (ptr, -type);
  4415 }
  4416 
  4417 
  4418 #ifdef HAVE_NATIVE_COMP
  4419 /* This records the directory where the Emacs executable lives, to be
  4420    used for locating the native-lisp directory from which we need to
  4421    load the preloaded *.eln files.  See pdumper_set_emacs_execdir
  4422    below.  */
  4423 static char *emacs_execdir;
  4424 static ptrdiff_t execdir_size;
  4425 static ptrdiff_t execdir_len;
  4426 #endif
  4427 
  4428 /* Dump runtime */
  4429 enum dump_memory_protection
  4430 {
  4431   DUMP_MEMORY_ACCESS_NONE = 1,
  4432   DUMP_MEMORY_ACCESS_READ = 2,
  4433   DUMP_MEMORY_ACCESS_READWRITE = 3,
  4434 };
  4435 
  4436 #if VM_SUPPORTED == VM_MS_WINDOWS
  4437 static void *
  4438 dump_anonymous_allocate_w32 (void *base,
  4439                              size_t size,
  4440                              enum dump_memory_protection protection)
  4441 {
  4442   void *ret;
  4443   DWORD mem_type;
  4444   DWORD mem_prot;
  4445 
  4446   switch (protection)
  4447     {
  4448     case DUMP_MEMORY_ACCESS_NONE:
  4449       mem_type = MEM_RESERVE;
  4450       mem_prot = PAGE_NOACCESS;
  4451       break;
  4452     case DUMP_MEMORY_ACCESS_READ:
  4453       mem_type = MEM_COMMIT;
  4454       mem_prot = PAGE_READONLY;
  4455       break;
  4456     case DUMP_MEMORY_ACCESS_READWRITE:
  4457       mem_type = MEM_COMMIT;
  4458       mem_prot = PAGE_READWRITE;
  4459       break;
  4460     default:
  4461       emacs_abort ();
  4462     }
  4463 
  4464   ret = VirtualAlloc (base, size, mem_type, mem_prot);
  4465   if (ret == NULL)
  4466     errno = (base && GetLastError () == ERROR_INVALID_ADDRESS)
  4467       ? EBUSY
  4468       : EPERM;
  4469   return ret;
  4470 }
  4471 #endif
  4472 
  4473 #if VM_SUPPORTED == VM_POSIX
  4474 
  4475 /* Old versions of macOS only define MAP_ANON, not MAP_ANONYMOUS.
  4476    FIXME: This probably belongs elsewhere (gnulib/autoconf?)  */
  4477 # ifndef MAP_ANONYMOUS
  4478 #  define MAP_ANONYMOUS MAP_ANON
  4479 # endif
  4480 
  4481 static void *
  4482 dump_anonymous_allocate_posix (void *base,
  4483                                size_t size,
  4484                                enum dump_memory_protection protection)
  4485 {
  4486   void *ret;
  4487   int mem_prot;
  4488 
  4489   switch (protection)
  4490     {
  4491     case DUMP_MEMORY_ACCESS_NONE:
  4492       mem_prot = PROT_NONE;
  4493       break;
  4494     case DUMP_MEMORY_ACCESS_READ:
  4495       mem_prot = PROT_READ;
  4496       break;
  4497     case DUMP_MEMORY_ACCESS_READWRITE:
  4498       mem_prot = PROT_READ | PROT_WRITE;
  4499       break;
  4500     default:
  4501       emacs_abort ();
  4502     }
  4503 
  4504   int mem_flags = MAP_PRIVATE | MAP_ANONYMOUS;
  4505   if (mem_prot != PROT_NONE)
  4506     mem_flags |= MAP_POPULATE;
  4507   if (base)
  4508     mem_flags |= MAP_FIXED;
  4509 
  4510   bool retry;
  4511   do
  4512     {
  4513       retry = false;
  4514       ret = mmap (base, size, mem_prot, mem_flags, -1, 0);
  4515       if (ret == MAP_FAILED
  4516           && errno == EINVAL
  4517           && (mem_flags & MAP_POPULATE))
  4518         {
  4519           /* This system didn't understand MAP_POPULATE, so try
  4520              again without it.  */
  4521           mem_flags &= ~MAP_POPULATE;
  4522           retry = true;
  4523         }
  4524     }
  4525   while (retry);
  4526 
  4527   if (ret == MAP_FAILED)
  4528     ret = NULL;
  4529   return ret;
  4530 }
  4531 #endif
  4532 
  4533 /* Perform anonymous memory allocation.  */
  4534 static void *
  4535 dump_anonymous_allocate (void *base,
  4536                          const size_t size,
  4537                          enum dump_memory_protection protection)
  4538 {
  4539 #if VM_SUPPORTED == VM_POSIX
  4540   return dump_anonymous_allocate_posix (base, size, protection);
  4541 #elif VM_SUPPORTED == VM_MS_WINDOWS
  4542   return dump_anonymous_allocate_w32 (base, size, protection);
  4543 #else
  4544   errno = ENOSYS;
  4545   return NULL;
  4546 #endif
  4547 }
  4548 
  4549 /* Undo the effect of dump_reserve_address_space().  */
  4550 static void
  4551 dump_anonymous_release (void *addr, size_t size)
  4552 {
  4553   eassert (size >= 0);
  4554 #if VM_SUPPORTED == VM_MS_WINDOWS
  4555   (void) size;
  4556   if (!VirtualFree (addr, 0, MEM_RELEASE))
  4557     emacs_abort ();
  4558 #elif VM_SUPPORTED == VM_POSIX
  4559   if (munmap (addr, size) < 0)
  4560     emacs_abort ();
  4561 #else
  4562   (void) addr;
  4563   (void) size;
  4564   emacs_abort ();
  4565 #endif
  4566 }
  4567 
  4568 #if VM_SUPPORTED == VM_MS_WINDOWS
  4569 static void *
  4570 dump_map_file_w32 (void *base, int fd, off_t offset, size_t size,
  4571                    enum dump_memory_protection protection)
  4572 {
  4573   void *ret = NULL;
  4574   HANDLE section = NULL;
  4575   HANDLE file;
  4576 
  4577   uint64_t full_offset = offset;
  4578   uint32_t offset_high = (uint32_t) (full_offset >> 32);
  4579   uint32_t offset_low = (uint32_t) (full_offset & 0xffffffff);
  4580 
  4581   int error;
  4582   DWORD protect;
  4583   DWORD map_access;
  4584 
  4585   file = (HANDLE) _get_osfhandle (fd);
  4586   if (file == INVALID_HANDLE_VALUE)
  4587     goto out;
  4588 
  4589   switch (protection)
  4590     {
  4591     case DUMP_MEMORY_ACCESS_READWRITE:
  4592       protect = PAGE_WRITECOPY; /* for Windows 9X */
  4593       break;
  4594     default:
  4595     case DUMP_MEMORY_ACCESS_NONE:
  4596     case DUMP_MEMORY_ACCESS_READ:
  4597       protect = PAGE_READONLY;
  4598       break;
  4599     }
  4600 
  4601   section = CreateFileMapping (file,
  4602                                /*lpAttributes=*/NULL,
  4603                                protect,
  4604                                /*dwMaximumSizeHigh=*/0,
  4605                                /*dwMaximumSizeLow=*/0,
  4606                                /*lpName=*/NULL);
  4607   if (!section)
  4608     {
  4609       errno = EINVAL;
  4610       goto out;
  4611     }
  4612 
  4613   switch (protection)
  4614     {
  4615     case DUMP_MEMORY_ACCESS_NONE:
  4616     case DUMP_MEMORY_ACCESS_READ:
  4617       map_access = FILE_MAP_READ;
  4618       break;
  4619     case DUMP_MEMORY_ACCESS_READWRITE:
  4620       map_access = FILE_MAP_COPY;
  4621       break;
  4622     default:
  4623       emacs_abort ();
  4624     }
  4625 
  4626   ret = MapViewOfFileEx (section,
  4627                          map_access,
  4628                          offset_high,
  4629                          offset_low,
  4630                          size,
  4631                          base);
  4632 
  4633   error = GetLastError ();
  4634   if (ret == NULL)
  4635     errno = (error == ERROR_INVALID_ADDRESS ? EBUSY : EPERM);
  4636  out:
  4637   if (section && !CloseHandle (section))
  4638     emacs_abort ();
  4639   return ret;
  4640 }
  4641 #endif
  4642 
  4643 #if VM_SUPPORTED == VM_POSIX
  4644 static void *
  4645 dump_map_file_posix (void *base, int fd, off_t offset, size_t size,
  4646                      enum dump_memory_protection protection)
  4647 {
  4648   void *ret;
  4649   int mem_prot;
  4650   int mem_flags;
  4651 
  4652   switch (protection)
  4653     {
  4654     case DUMP_MEMORY_ACCESS_NONE:
  4655       mem_prot = PROT_NONE;
  4656       mem_flags = MAP_SHARED;
  4657       break;
  4658     case DUMP_MEMORY_ACCESS_READ:
  4659       mem_prot = PROT_READ;
  4660       mem_flags = MAP_SHARED;
  4661       break;
  4662     case DUMP_MEMORY_ACCESS_READWRITE:
  4663       mem_prot = PROT_READ | PROT_WRITE;
  4664       mem_flags = MAP_PRIVATE;
  4665       break;
  4666     default:
  4667       emacs_abort ();
  4668     }
  4669 
  4670   if (base)
  4671     mem_flags |= MAP_FIXED;
  4672 
  4673   ret = mmap (base, size, mem_prot, mem_flags, fd, offset);
  4674   if (ret == MAP_FAILED)
  4675     ret = NULL;
  4676   return ret;
  4677 }
  4678 #endif
  4679 
  4680 /* Map a file into memory.  */
  4681 static void *
  4682 dump_map_file (void *base, int fd, off_t offset, size_t size,
  4683                enum dump_memory_protection protection)
  4684 {
  4685 #if VM_SUPPORTED == VM_POSIX
  4686   return dump_map_file_posix (base, fd, offset, size, protection);
  4687 #elif VM_SUPPORTED == VM_MS_WINDOWS
  4688   return dump_map_file_w32 (base, fd, offset, size, protection);
  4689 #else
  4690   errno = ENOSYS;
  4691   return NULL;
  4692 #endif
  4693 }
  4694 
  4695 /* Remove a virtual memory mapping.
  4696 
  4697    On failure, abort Emacs.  For maximum platform compatibility, ADDR
  4698    and SIZE must match the mapping exactly.  */
  4699 static void
  4700 dump_unmap_file (void *addr, size_t size)
  4701 {
  4702   eassert (size >= 0);
  4703 #if !VM_SUPPORTED
  4704   (void) addr;
  4705   (void) size;
  4706   emacs_abort ();
  4707 #elif defined (WINDOWSNT)
  4708   (void) size;
  4709   if (!UnmapViewOfFile (addr))
  4710     emacs_abort ();
  4711 #else
  4712   if (munmap (addr, size) < 0)
  4713     emacs_abort ();
  4714 #endif
  4715 }
  4716 
  4717 struct dump_memory_map_spec
  4718 {
  4719   int fd;  /* File to map; anon zero if negative.  */
  4720   size_t size;  /* Number of bytes to map.  */
  4721   off_t offset;  /* Offset within fd.  */
  4722   enum dump_memory_protection protection;
  4723 };
  4724 
  4725 struct dump_memory_map
  4726 {
  4727   struct dump_memory_map_spec spec;
  4728   void *mapping;  /* Actual mapped memory.  */
  4729   void (*release) (struct dump_memory_map *);
  4730   void *private;
  4731 };
  4732 
  4733 /* Mark the pages as unneeded, potentially zeroing them, without
  4734    releasing the address space reservation.  */
  4735 static void
  4736 dump_discard_mem (void *mem, size_t size)
  4737 {
  4738 #if VM_SUPPORTED == VM_MS_WINDOWS
  4739       /* Discard COWed pages.  */
  4740       (void) VirtualFree (mem, size, MEM_DECOMMIT);
  4741       /* Release the commit charge for the mapping.  */
  4742       DWORD old_prot;
  4743       (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
  4744 #elif VM_SUPPORTED == VM_POSIX
  4745 # ifdef HAVE_POSIX_MADVISE
  4746       /* Discard COWed pages.  */
  4747       (void) posix_madvise (mem, size, POSIX_MADV_DONTNEED);
  4748 # endif
  4749       /* Release the commit charge for the mapping.  */
  4750       (void) mprotect (mem, size, PROT_NONE);
  4751 #endif
  4752 }
  4753 
  4754 static void
  4755 dump_mmap_discard_contents (struct dump_memory_map *map)
  4756 {
  4757   if (map->mapping)
  4758     dump_discard_mem (map->mapping, map->spec.size);
  4759 }
  4760 
  4761 static void
  4762 dump_mmap_reset (struct dump_memory_map *map)
  4763 {
  4764   map->mapping = NULL;
  4765   map->release = NULL;
  4766   map->private = NULL;
  4767 }
  4768 
  4769 static void
  4770 dump_mmap_release (struct dump_memory_map *map)
  4771 {
  4772   if (map->release)
  4773     map->release (map);
  4774   dump_mmap_reset (map);
  4775 }
  4776 
  4777 /* Allows heap-allocated dump_mmap to "free" maps individually.  */
  4778 struct dump_memory_map_heap_control_block
  4779 {
  4780   int refcount;
  4781   void *mem;
  4782 };
  4783 
  4784 static void
  4785 dump_mm_heap_cb_release (struct dump_memory_map_heap_control_block *cb)
  4786 {
  4787   eassert (cb->refcount > 0);
  4788   if (--cb->refcount == 0)
  4789     {
  4790       free (cb->mem);
  4791       free (cb);
  4792     }
  4793 }
  4794 
  4795 static void
  4796 dump_mmap_release_heap (struct dump_memory_map *map)
  4797 {
  4798   dump_mm_heap_cb_release (map->private);
  4799 }
  4800 
  4801 /* Implement dump_mmap using malloc and read.  */
  4802 static bool
  4803 dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps,
  4804                            size_t total_size)
  4805 {
  4806   bool ret = false;
  4807 
  4808   /* FIXME: This storage sometimes is never freed.
  4809      Beware: the simple patch 2019-03-11T15:20:54Z!eggert@cs.ucla.edu
  4810      is worse, as it sometimes frees this storage twice.  */
  4811   struct dump_memory_map_heap_control_block *cb = calloc (1, sizeof (*cb));
  4812   if (!cb)
  4813     goto out;
  4814   __lsan_ignore_object (cb);
  4815 
  4816   cb->refcount = 1;
  4817   cb->mem = malloc (total_size);
  4818   if (!cb->mem)
  4819     goto out;
  4820   char *mem = cb->mem;
  4821   for (int i = 0; i < nr_maps; ++i)
  4822     {
  4823       struct dump_memory_map *map = &maps[i];
  4824       const struct dump_memory_map_spec spec = map->spec;
  4825       if (!spec.size)
  4826         continue;
  4827       map->mapping = mem;
  4828       mem += spec.size;
  4829       map->release = dump_mmap_release_heap;
  4830       map->private = cb;
  4831       cb->refcount += 1;
  4832       if (spec.fd < 0)
  4833         memset (map->mapping, 0, spec.size);
  4834       else
  4835         {
  4836           if (lseek (spec.fd, spec.offset, SEEK_SET) < 0)
  4837             goto out;
  4838           ssize_t nb = dump_read_all (spec.fd,
  4839                                       map->mapping,
  4840                                       spec.size);
  4841           if (nb >= 0 && nb != spec.size)
  4842             errno = EIO;
  4843           if (nb != spec.size)
  4844             goto out;
  4845         }
  4846     }
  4847 
  4848   ret = true;
  4849  out:
  4850   dump_mm_heap_cb_release (cb);
  4851   if (!ret)
  4852     for (int i = 0; i < nr_maps; ++i)
  4853       dump_mmap_release (&maps[i]);
  4854   return ret;
  4855 }
  4856 
  4857 static void
  4858 dump_mmap_release_vm (struct dump_memory_map *map)
  4859 {
  4860   if (map->spec.fd < 0)
  4861     dump_anonymous_release (map->mapping, map->spec.size);
  4862   else
  4863     dump_unmap_file (map->mapping, map->spec.size);
  4864 }
  4865 
  4866 static bool
  4867 needs_mmap_retry_p (void)
  4868 {
  4869 #if defined CYGWIN || VM_SUPPORTED == VM_MS_WINDOWS || defined _AIX
  4870   return true;
  4871 #else
  4872   return false;
  4873 #endif
  4874 }
  4875 
  4876 static bool
  4877 dump_mmap_contiguous_vm (struct dump_memory_map *maps, int nr_maps,
  4878                          size_t total_size)
  4879 {
  4880   bool ret = false;
  4881   void *resv = NULL;
  4882   bool retry = false;
  4883   const bool need_retry = needs_mmap_retry_p ();
  4884 
  4885   do
  4886     {
  4887       if (retry)
  4888         {
  4889           eassert (need_retry);
  4890           retry = false;
  4891           for (int i = 0; i < nr_maps; ++i)
  4892             dump_mmap_release (&maps[i]);
  4893         }
  4894 
  4895       eassert (resv == NULL);
  4896       resv = dump_anonymous_allocate (NULL,
  4897                                       total_size,
  4898                                       DUMP_MEMORY_ACCESS_NONE);
  4899       if (!resv)
  4900         goto out;
  4901 
  4902       char *mem = resv;
  4903 
  4904       if (need_retry)
  4905         {
  4906           /* Windows lacks atomic mapping replace; need to release the
  4907              reservation so we can allocate within it.  Will retry the
  4908              loop if someone squats on our address space before we can
  4909              finish allocation.  On POSIX systems, we leave the
  4910              reservation around for atomicity.  */
  4911           dump_anonymous_release (resv, total_size);
  4912           resv = NULL;
  4913         }
  4914 
  4915       for (int i = 0; i < nr_maps; ++i)
  4916         {
  4917           struct dump_memory_map *map = &maps[i];
  4918           const struct dump_memory_map_spec spec = map->spec;
  4919           if (!spec.size)
  4920             continue;
  4921 
  4922           if (spec.fd < 0)
  4923             map->mapping = dump_anonymous_allocate (mem, spec.size,
  4924                                                     spec.protection);
  4925           else
  4926             map->mapping = dump_map_file (mem, spec.fd, spec.offset,
  4927                                           spec.size, spec.protection);
  4928           mem += spec.size;
  4929           if (need_retry && map->mapping == NULL
  4930               && (errno == EBUSY
  4931 #ifdef CYGWIN
  4932                   || errno == EINVAL
  4933 #endif
  4934                   ))
  4935             {
  4936               retry = true;
  4937               continue;
  4938             }
  4939           if (map->mapping == NULL)
  4940             goto out;
  4941           map->release = dump_mmap_release_vm;
  4942         }
  4943     }
  4944   while (retry);
  4945 
  4946   ret = true;
  4947   resv = NULL;
  4948  out:
  4949   if (resv)
  4950     dump_anonymous_release (resv, total_size);
  4951   if (!ret)
  4952     {
  4953       for (int i = 0; i < nr_maps; ++i)
  4954         {
  4955           if (need_retry)
  4956             dump_mmap_reset (&maps[i]);
  4957           else
  4958             dump_mmap_release (&maps[i]);
  4959         }
  4960     }
  4961   return ret;
  4962 }
  4963 
  4964 /* Map a range of addresses into a chunk of contiguous memory.
  4965 
  4966    Each dump_memory_map structure describes how to fill the
  4967    corresponding range of memory. On input, all members except MAPPING
  4968    are valid. On output, MAPPING contains the location of the given
  4969    chunk of memory. The MAPPING for MAPS[N] is MAPS[N-1].mapping +
  4970    MAPS[N-1].size.
  4971 
  4972    Each mapping SIZE must be a multiple of the system page size except
  4973    for the last mapping.
  4974 
  4975    Return true on success or false on failure with errno set.  */
  4976 static bool
  4977 dump_mmap_contiguous (struct dump_memory_map *maps, int nr_maps)
  4978 {
  4979   if (!nr_maps)
  4980     return true;
  4981 
  4982   size_t total_size = 0;
  4983   int worst_case_page_size = dump_get_max_page_size ();
  4984 
  4985   for (int i = 0; i < nr_maps; ++i)
  4986     {
  4987       eassert (maps[i].mapping == NULL);
  4988       eassert (maps[i].release == NULL);
  4989       eassert (maps[i].private == NULL);
  4990       if (i != nr_maps - 1)
  4991         eassert (maps[i].spec.size % worst_case_page_size == 0);
  4992       total_size += maps[i].spec.size;
  4993     }
  4994 
  4995   return (VM_SUPPORTED ? dump_mmap_contiguous_vm : dump_mmap_contiguous_heap)
  4996     (maps, nr_maps, total_size);
  4997 }
  4998 
  4999 typedef uint_fast32_t dump_bitset_word;
  5000 
  5001 struct dump_bitset
  5002 {
  5003   dump_bitset_word *restrict bits;
  5004   ptrdiff_t number_words;
  5005 };
  5006 
  5007 static bool
  5008 dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits)
  5009 {
  5010   int xword_size = sizeof (bitset[0].bits[0]);
  5011   int bits_per_word = xword_size * CHAR_BIT;
  5012   ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
  5013   dump_bitset_word *bits = calloc (words_needed, 2 * xword_size);
  5014   if (!bits)
  5015     return false;
  5016   bitset[0].bits = bits;
  5017   bitset[0].number_words = bitset[1].number_words = words_needed;
  5018   bitset[1].bits = memset (bits + words_needed, UCHAR_MAX,
  5019                            words_needed * xword_size);
  5020   return true;
  5021 }
  5022 
  5023 static dump_bitset_word *
  5024 dump_bitset__bit_slot (const struct dump_bitset *bitset,
  5025                        size_t bit_number)
  5026 {
  5027   int xword_size = sizeof (bitset->bits[0]);
  5028   int bits_per_word = xword_size * CHAR_BIT;
  5029   ptrdiff_t word_number = bit_number / bits_per_word;
  5030   eassert (word_number < bitset->number_words);
  5031   return &bitset->bits[word_number];
  5032 }
  5033 
  5034 static bool
  5035 dump_bitset_bit_set_p (const struct dump_bitset *bitset,
  5036                        size_t bit_number)
  5037 {
  5038   unsigned xword_size = sizeof (bitset->bits[0]);
  5039   unsigned bits_per_word = xword_size * CHAR_BIT;
  5040   dump_bitset_word bit = 1;
  5041   bit <<= bit_number % bits_per_word;
  5042   return *dump_bitset__bit_slot (bitset, bit_number) & bit;
  5043 }
  5044 
  5045 static void
  5046 dump_bitset__set_bit_value (struct dump_bitset *bitset,
  5047                             size_t bit_number,
  5048                             bool bit_is_set)
  5049 {
  5050   int xword_size = sizeof (bitset->bits[0]);
  5051   int bits_per_word = xword_size * CHAR_BIT;
  5052   dump_bitset_word *slot = dump_bitset__bit_slot (bitset, bit_number);
  5053   dump_bitset_word bit = 1;
  5054   bit <<= bit_number % bits_per_word;
  5055   if (bit_is_set)
  5056     *slot = *slot | bit;
  5057   else
  5058     *slot = *slot & ~bit;
  5059 }
  5060 
  5061 static void
  5062 dump_bitset_set_bit (struct dump_bitset *bitset, size_t bit_number)
  5063 {
  5064   dump_bitset__set_bit_value (bitset, bit_number, true);
  5065 }
  5066 
  5067 static void
  5068 dump_bitset_clear (struct dump_bitset *bitset)
  5069 {
  5070   /* Skip the memset if bitset->number_words == 0, because then bitset->bits
  5071      might be NULL and the memset would have undefined behavior.  */
  5072   if (bitset->number_words)
  5073     memset (bitset->bits, 0, bitset->number_words * sizeof bitset->bits[0]);
  5074 }
  5075 
  5076 struct pdumper_loaded_dump_private
  5077 {
  5078   /* Copy of the header we read from the dump.  */
  5079   struct dump_header header;
  5080   /* Mark bits for objects in the dump; used during GC.  */
  5081   struct dump_bitset mark_bits, last_mark_bits;
  5082   /* Time taken to load the dump.  */
  5083   double load_time;
  5084   /* Dump file name.  */
  5085   char *dump_filename;
  5086 };
  5087 
  5088 struct pdumper_loaded_dump dump_public;
  5089 static struct pdumper_loaded_dump_private dump_private;
  5090 
  5091 /* Return a pointer to offset OFFSET within the dump, which begins at
  5092    DUMP_BASE. DUMP_BASE must be equal to the current dump load
  5093    location; it's passed as a parameter for efficiency.
  5094 
  5095    The returned pointer points to the primary memory image of the
  5096    currently-loaded dump file.  The entire dump file is accessible
  5097    using this function.  */
  5098 static void *
  5099 dump_ptr (uintptr_t dump_base, dump_off offset)
  5100 {
  5101   eassert (dump_base == dump_public.start);
  5102   eassert (0 <= offset);
  5103   eassert (dump_public.start + offset < dump_public.end);
  5104   return (char *)dump_base + offset;
  5105 }
  5106 
  5107 /* Read a pointer-sized word of memory at OFFSET within the dump,
  5108    which begins at DUMP_BASE. DUMP_BASE must be equal to the current
  5109    dump load location; it's passed as a parameter for efficiency.  */
  5110 static uintptr_t
  5111 dump_read_word_from_dump (uintptr_t dump_base, dump_off offset)
  5112 {
  5113   uintptr_t value;
  5114   /* The compiler optimizes this memcpy into a read.  */
  5115   memcpy (&value, dump_ptr (dump_base, offset), sizeof (value));
  5116   return value;
  5117 }
  5118 
  5119 /* Write a word to the dump. DUMP_BASE and OFFSET are as for
  5120    dump_read_word_from_dump; VALUE is the word to write at the given
  5121    offset.  */
  5122 static void
  5123 dump_write_word_to_dump (uintptr_t dump_base,
  5124                          dump_off offset,
  5125                          uintptr_t value)
  5126 {
  5127   /* The compiler optimizes this memcpy into a write.  */
  5128   memcpy (dump_ptr (dump_base, offset), &value, sizeof (value));
  5129 }
  5130 
  5131 /* Write a Lisp_Object to the dump. DUMP_BASE and OFFSET are as for
  5132    dump_read_word_from_dump; VALUE is the Lisp_Object to write at the
  5133    given offset.  */
  5134 static void
  5135 dump_write_lv_to_dump (uintptr_t dump_base,
  5136                        dump_off offset,
  5137                        Lisp_Object value)
  5138 {
  5139   /* The compiler optimizes this memcpy into a write.  */
  5140   memcpy (dump_ptr (dump_base, offset), &value, sizeof (value));
  5141 }
  5142 
  5143 /* Search for a relocation given a relocation target.
  5144 
  5145    DUMP is the dump metadata structure.  TABLE is the relocation table
  5146    to search.  KEY is the dump offset to find.  Return the relocation
  5147    RELOC such that RELOC.offset is the smallest RELOC.offset that
  5148    satisfies the constraint KEY <= RELOC.offset --- that is, return
  5149    the first relocation at KEY or after KEY.  Return NULL if no such
  5150    relocation exists.  */
  5151 static const struct dump_reloc *
  5152 dump_find_relocation (const struct dump_table_locator *const table,
  5153                       const dump_off key)
  5154 {
  5155   const struct dump_reloc *const relocs = dump_ptr (dump_public.start,
  5156                                                     table->offset);
  5157   const struct dump_reloc *found = NULL;
  5158   ptrdiff_t idx_left = 0;
  5159   ptrdiff_t idx_right = table->nr_entries;
  5160 
  5161   eassert (key >= 0);
  5162 
  5163   while (idx_left < idx_right)
  5164     {
  5165       const ptrdiff_t idx_mid = idx_left + (idx_right - idx_left) / 2;
  5166       const struct dump_reloc *mid = &relocs[idx_mid];
  5167       if (key > dump_reloc_get_offset (*mid))
  5168         idx_left = idx_mid + 1;
  5169       else
  5170         {
  5171           found = mid;
  5172           idx_right = idx_mid;
  5173           if (idx_right <= idx_left
  5174               || key > dump_reloc_get_offset (relocs[idx_right - 1]))
  5175             break;
  5176         }
  5177    }
  5178 
  5179   return found;
  5180 }
  5181 
  5182 static bool
  5183 dump_loaded_p (void)
  5184 {
  5185   return dump_public.start != 0;
  5186 }
  5187 
  5188 bool
  5189 pdumper_cold_object_p_impl (const void *obj)
  5190 {
  5191   eassert (pdumper_object_p (obj));
  5192   eassert (pdumper_object_p_precise (obj));
  5193   dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start);
  5194   return offset >= dump_private.header.cold_start;
  5195 }
  5196 
  5197 int
  5198 pdumper_find_object_type_impl (const void *obj)
  5199 {
  5200   eassert (pdumper_object_p (obj));
  5201   dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start);
  5202   if (offset % DUMP_ALIGNMENT != 0)
  5203     return PDUMPER_NO_OBJECT;
  5204   ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
  5205   if (offset < dump_private.header.discardable_start
  5206       && !dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno))
  5207     return PDUMPER_NO_OBJECT;
  5208   const struct dump_reloc *reloc =
  5209     dump_find_relocation (&dump_private.header.object_starts, offset);
  5210   return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
  5211     ? reloc->type
  5212     : PDUMPER_NO_OBJECT;
  5213 }
  5214 
  5215 bool
  5216 pdumper_marked_p_impl (const void *obj)
  5217 {
  5218   eassert (pdumper_object_p (obj));
  5219   ptrdiff_t offset = (uintptr_t) obj - dump_public.start;
  5220   eassert (offset % DUMP_ALIGNMENT == 0);
  5221   eassert (offset < dump_private.header.cold_start);
  5222   eassert (offset < dump_private.header.discardable_start);
  5223   ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
  5224   return dump_bitset_bit_set_p (&dump_private.mark_bits, bitno);
  5225 }
  5226 
  5227 void
  5228 pdumper_set_marked_impl (const void *obj)
  5229 {
  5230   eassert (pdumper_object_p (obj));
  5231   ptrdiff_t offset = (uintptr_t) obj - dump_public.start;
  5232   eassert (offset % DUMP_ALIGNMENT == 0);
  5233   eassert (offset < dump_private.header.cold_start);
  5234   eassert (offset < dump_private.header.discardable_start);
  5235   ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
  5236   eassert (dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno));
  5237   dump_bitset_set_bit (&dump_private.mark_bits, bitno);
  5238 }
  5239 
  5240 void
  5241 pdumper_clear_marks_impl (void)
  5242 {
  5243   dump_bitset_word *swap = dump_private.last_mark_bits.bits;
  5244   dump_private.last_mark_bits.bits = dump_private.mark_bits.bits;
  5245   dump_private.mark_bits.bits = swap;
  5246   dump_bitset_clear (&dump_private.mark_bits);
  5247 }
  5248 
  5249 static ssize_t
  5250 dump_read_all (int fd, void *buf, size_t bytes_to_read)
  5251 {
  5252   /* We don't want to use emacs_read, since that relies on the lisp
  5253      world, and we're not in the lisp world yet.  */
  5254   size_t bytes_read = 0;
  5255   while (bytes_read < bytes_to_read)
  5256     {
  5257       /* Some platforms accept only int-sized values to read.
  5258          Round this down to a page size (see MAX_RW_COUNT in sysdep.c).  */
  5259       int max_rw_count = INT_MAX >> 18 << 18;
  5260       int chunk_to_read = min (bytes_to_read - bytes_read, max_rw_count);
  5261       ssize_t chunk = read (fd, (char *) buf + bytes_read, chunk_to_read);
  5262       if (chunk < 0)
  5263         return chunk;
  5264       if (chunk == 0)
  5265         break;
  5266       bytes_read += chunk;
  5267     }
  5268 
  5269   return bytes_read;
  5270 }
  5271 
  5272 /* Return the number of bytes written when we perform the given
  5273    relocation.  */
  5274 static int
  5275 dump_reloc_size (const struct dump_reloc reloc)
  5276 {
  5277   if (sizeof (Lisp_Object) == sizeof (void *))
  5278     return sizeof (Lisp_Object);
  5279   if (reloc.type == RELOC_DUMP_TO_EMACS_PTR_RAW
  5280       || reloc.type == RELOC_DUMP_TO_DUMP_PTR_RAW)
  5281     return sizeof (void *);
  5282   return sizeof (Lisp_Object);
  5283 }
  5284 
  5285 static Lisp_Object
  5286 dump_make_lv_from_reloc (const uintptr_t dump_base,
  5287                          const struct dump_reloc reloc)
  5288 {
  5289   const dump_off reloc_offset = dump_reloc_get_offset (reloc);
  5290   uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
  5291   enum Lisp_Type lisp_type;
  5292 
  5293   if (RELOC_DUMP_TO_DUMP_LV <= reloc.type
  5294       && reloc.type < RELOC_DUMP_TO_EMACS_LV)
  5295     {
  5296       lisp_type = reloc.type - RELOC_DUMP_TO_DUMP_LV;
  5297       value += dump_base;
  5298       eassert (pdumper_object_p ((void *) value));
  5299     }
  5300   else
  5301     {
  5302       eassert (RELOC_DUMP_TO_EMACS_LV <= reloc.type);
  5303       eassert (reloc.type < RELOC_DUMP_TO_EMACS_LV + 8);
  5304       lisp_type = reloc.type - RELOC_DUMP_TO_EMACS_LV;
  5305       value += emacs_basis ();
  5306     }
  5307 
  5308   eassert (lisp_type != Lisp_Int0 && lisp_type != Lisp_Int1);
  5309 
  5310   Lisp_Object lv;
  5311   if (lisp_type == Lisp_Symbol)
  5312     lv = make_lisp_symbol ((void *) value);
  5313   else
  5314     lv = make_lisp_ptr ((void *) value, lisp_type);
  5315 
  5316   return lv;
  5317 }
  5318 
  5319 /* Actually apply a dump relocation.  */
  5320 static inline void
  5321 dump_do_dump_relocation (const uintptr_t dump_base,
  5322                          const struct dump_reloc reloc)
  5323 {
  5324   const dump_off reloc_offset = dump_reloc_get_offset (reloc);
  5325 
  5326   /* We should never generate a relocation in the cold section.  */
  5327   eassert (reloc_offset < dump_private.header.cold_start);
  5328 
  5329   switch (reloc.type)
  5330     {
  5331     case RELOC_DUMP_TO_EMACS_PTR_RAW:
  5332       {
  5333         uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
  5334         eassert (dump_reloc_size (reloc) == sizeof (value));
  5335         value += emacs_basis ();
  5336         dump_write_word_to_dump (dump_base, reloc_offset, value);
  5337         break;
  5338       }
  5339     case RELOC_DUMP_TO_DUMP_PTR_RAW:
  5340       {
  5341         uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
  5342         eassert (dump_reloc_size (reloc) == sizeof (value));
  5343         value += dump_base;
  5344         dump_write_word_to_dump (dump_base, reloc_offset, value);
  5345         break;
  5346       }
  5347 #ifdef HAVE_NATIVE_COMP
  5348     case RELOC_NATIVE_COMP_UNIT:
  5349       {
  5350         static enum { UNKNOWN, LOCAL_BUILD, INSTALLED } installation_state;
  5351         struct Lisp_Native_Comp_Unit *comp_u =
  5352           dump_ptr (dump_base, reloc_offset);
  5353         comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq);
  5354         if (STRINGP (comp_u->file))
  5355           error ("Trying to load incoherent dumped eln file %s",
  5356                  SSDATA (comp_u->file));
  5357 
  5358         if (!CONSP (comp_u->file))
  5359           error ("Incoherent compilation unit for dump was dumped");
  5360 
  5361         /* emacs_execdir is always unibyte, but the file names in
  5362            comp_u->file could be multibyte, so we need to encode
  5363            them.  */
  5364         Lisp_Object cu_file1 = ENCODE_FILE (XCAR (comp_u->file));
  5365         Lisp_Object cu_file2 = ENCODE_FILE (XCDR (comp_u->file));
  5366         ptrdiff_t fn1_len = SBYTES (cu_file1), fn2_len = SBYTES (cu_file2);
  5367         Lisp_Object eln_fname;
  5368         char *fndata;
  5369 
  5370         /* Check just once if this is a local build or Emacs was installed.  */
  5371         /* Can't use expand-file-name here, because we are too early
  5372            in the startup, and we will crash at least on WINDOWSNT.  */
  5373         if (installation_state == UNKNOWN)
  5374           {
  5375             eln_fname = make_uninit_string (execdir_len + fn1_len);
  5376             fndata = SSDATA (eln_fname);
  5377             memcpy (fndata, emacs_execdir, execdir_len);
  5378             memcpy (fndata + execdir_len, SSDATA (cu_file1), fn1_len);
  5379             if (file_access_p (fndata, F_OK))
  5380               installation_state = INSTALLED;
  5381             else
  5382               {
  5383                 eln_fname = make_uninit_string (execdir_len + fn2_len);
  5384                 fndata = SSDATA (eln_fname);
  5385                 memcpy (fndata, emacs_execdir, execdir_len);
  5386                 memcpy (fndata + execdir_len, SSDATA (cu_file2), fn2_len);
  5387                 installation_state = LOCAL_BUILD;
  5388               }
  5389             fixup_eln_load_path (eln_fname);
  5390           }
  5391         else
  5392           {
  5393             ptrdiff_t fn_len =
  5394               installation_state == INSTALLED ? fn1_len : fn2_len;
  5395             Lisp_Object cu_file =
  5396               installation_state == INSTALLED ? cu_file1 : cu_file2;
  5397             eln_fname = make_uninit_string (execdir_len + fn_len);
  5398             fndata = SSDATA (eln_fname);
  5399             memcpy (fndata, emacs_execdir, execdir_len);
  5400             memcpy (fndata + execdir_len, SSDATA (cu_file), fn_len);
  5401           }
  5402 
  5403         /* FIXME: This records the names of the *.eln files in an
  5404            unexpanded form, with one or more ".." elements (and on
  5405            Windows with the first part using backslashes).  The file
  5406            names are also unibyte.  If we care about this, we need to
  5407            loop in startup.el over all the preloaded modules and run
  5408            their file names through expand-file-name and
  5409            decode-coding-string.  */
  5410         comp_u->file = eln_fname;
  5411         comp_u->handle = dynlib_open_for_eln (SSDATA (eln_fname));
  5412         if (!comp_u->handle)
  5413           {
  5414             fprintf (stderr, "Error using execdir %s:\n",
  5415                      emacs_execdir);
  5416             error ("%s", dynlib_error ());
  5417           }
  5418         load_comp_unit (comp_u, true, false);
  5419         break;
  5420       }
  5421     case RELOC_NATIVE_SUBR:
  5422       {
  5423         /* When resurrecting from a dump given non all the original
  5424            native compiled subrs may be still around we can't rely on
  5425            a 'top_level_run' mechanism, we revive them one-by-one
  5426            here.  */
  5427         struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
  5428         struct Lisp_Native_Comp_Unit *comp_u =
  5429           XNATIVE_COMP_UNIT (subr->native_comp_u);
  5430         if (!comp_u->handle)
  5431           error ("NULL handle in compilation unit %s", SSDATA (comp_u->file));
  5432         const char *c_name = subr->native_c_name;
  5433         eassert (c_name);
  5434         void *func = dynlib_sym (comp_u->handle, c_name);
  5435         if (!func)
  5436           error ("can't find function \"%s\" in compilation unit %s", c_name,
  5437                  SSDATA (comp_u->file));
  5438         subr->function.a0 = func;
  5439         Lisp_Object lambda_data_idx =
  5440           Fgethash (build_string (c_name), comp_u->lambda_c_name_idx_h, Qnil);
  5441         if (!NILP (lambda_data_idx))
  5442           {
  5443             /* This is an anonymous lambda.
  5444                We must fixup d_reloc_imp so the lambda can be referenced
  5445                by code.  */
  5446             Lisp_Object tem;
  5447             XSETSUBR (tem, subr);
  5448             Lisp_Object *fixup =
  5449               &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]);
  5450             eassert (EQ (*fixup, Qlambda_fixup));
  5451             *fixup = tem;
  5452             Fputhash (tem, Qt, comp_u->lambda_gc_guard_h);
  5453           }
  5454         break;
  5455       }
  5456 #endif
  5457     case RELOC_BIGNUM:
  5458       {
  5459         struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
  5460         struct bignum_reload_info reload_info;
  5461         verify (sizeof (reload_info) <= sizeof (*bignum_val (bignum)));
  5462         memcpy (&reload_info, bignum_val (bignum), sizeof (reload_info));
  5463         const mp_limb_t *limbs =
  5464           dump_ptr (dump_base, reload_info.data_location);
  5465         mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
  5466         break;
  5467       }
  5468     default: /* Lisp_Object in the dump; precise type in reloc.type */
  5469       {
  5470         Lisp_Object lv = dump_make_lv_from_reloc (dump_base, reloc);
  5471         eassert (dump_reloc_size (reloc) == sizeof (lv));
  5472         dump_write_lv_to_dump (dump_base, reloc_offset, lv);
  5473         break;
  5474       }
  5475     }
  5476 }
  5477 
  5478 static void
  5479 dump_do_all_dump_reloc_for_phase (const struct dump_header *const header,
  5480                                   const uintptr_t dump_base,
  5481                                   const enum reloc_phase phase)
  5482 {
  5483   struct dump_reloc *r = dump_ptr (dump_base, header->dump_relocs[phase].offset);
  5484   dump_off nr_entries = header->dump_relocs[phase].nr_entries;
  5485   for (dump_off i = 0; i < nr_entries; ++i)
  5486     dump_do_dump_relocation (dump_base, r[i]);
  5487 }
  5488 
  5489 static void
  5490 dump_do_emacs_relocation (const uintptr_t dump_base,
  5491                           const struct emacs_reloc reloc)
  5492 {
  5493   ptrdiff_t pval;
  5494   Lisp_Object lv;
  5495 
  5496   switch (reloc.type)
  5497     {
  5498     case RELOC_EMACS_COPY_FROM_DUMP:
  5499       eassume (reloc.length > 0);
  5500       memcpy (emacs_ptr_at (reloc.emacs_offset),
  5501               dump_ptr (dump_base, reloc.u.dump_offset),
  5502               reloc.length);
  5503       break;
  5504     case RELOC_EMACS_IMMEDIATE:
  5505       eassume (reloc.length > 0);
  5506       eassume (reloc.length <= sizeof (reloc.u.immediate));
  5507       memcpy (emacs_ptr_at (reloc.emacs_offset),
  5508               &reloc.u.immediate,
  5509               reloc.length);
  5510       break;
  5511     case RELOC_EMACS_DUMP_PTR_RAW:
  5512       pval = reloc.u.dump_offset + dump_base;
  5513       memcpy (emacs_ptr_at (reloc.emacs_offset), &pval, sizeof (pval));
  5514       break;
  5515     case RELOC_EMACS_EMACS_PTR_RAW:
  5516       pval = reloc.u.emacs_offset2 + emacs_basis ();
  5517       memcpy (emacs_ptr_at (reloc.emacs_offset), &pval, sizeof (pval));
  5518       break;
  5519     case RELOC_EMACS_DUMP_LV:
  5520     case RELOC_EMACS_EMACS_LV:
  5521       {
  5522         /* Lisp_Float is the maximum lisp type.  */
  5523         eassume (reloc.length <= Lisp_Float);
  5524         void *obj_ptr = reloc.type == RELOC_EMACS_DUMP_LV
  5525           ? dump_ptr (dump_base, reloc.u.dump_offset)
  5526           : emacs_ptr_at (reloc.u.emacs_offset2);
  5527         if (reloc.length == Lisp_Symbol)
  5528           lv = make_lisp_symbol (obj_ptr);
  5529         else
  5530           lv = make_lisp_ptr (obj_ptr, reloc.length);
  5531         memcpy (emacs_ptr_at (reloc.emacs_offset), &lv, sizeof (lv));
  5532         break;
  5533       }
  5534     default:
  5535       fatal ("unrecognied relocation type %d", (int) reloc.type);
  5536     }
  5537 }
  5538 
  5539 static void
  5540 dump_do_all_emacs_relocations (const struct dump_header *const header,
  5541                                const uintptr_t dump_base)
  5542 {
  5543   const dump_off nr_entries = header->emacs_relocs.nr_entries;
  5544   struct emacs_reloc *r = dump_ptr (dump_base, header->emacs_relocs.offset);
  5545   for (dump_off i = 0; i < nr_entries; ++i)
  5546     dump_do_emacs_relocation (dump_base, r[i]);
  5547 }
  5548 
  5549 #ifdef HAVE_NATIVE_COMP
  5550 /* Compute and record the directory of the Emacs executable given the
  5551    file name of that executable.  */
  5552 static void
  5553 pdumper_set_emacs_execdir (char *emacs_executable)
  5554 {
  5555   char *p = emacs_executable + strlen (emacs_executable);
  5556 
  5557   while (p > emacs_executable
  5558          && !IS_DIRECTORY_SEP (p[-1]))
  5559     --p;
  5560   eassert (p > emacs_executable);
  5561   emacs_execdir = xpalloc (emacs_execdir, &execdir_size,
  5562                            p - emacs_executable + 1 - execdir_size, -1, 1);
  5563   memcpy (emacs_execdir, emacs_executable, p - emacs_executable);
  5564   execdir_len = p - emacs_executable;
  5565   emacs_execdir[execdir_len] = '\0';
  5566 }
  5567 #endif
  5568 
  5569 enum dump_section
  5570   {
  5571    DS_HOT,
  5572    DS_DISCARDABLE,
  5573    DS_COLD,
  5574    NUMBER_DUMP_SECTIONS,
  5575   };
  5576 
  5577 /* Pointer to a stack variable to avoid having to staticpro it.  */
  5578 static Lisp_Object *pdumper_hashes = &zero_vector;
  5579 
  5580 /* Load a dump from DUMP_FILENAME.  Return an error code.
  5581 
  5582    N.B. We run very early in initialization, so we can't use lisp,
  5583    unwinding, xmalloc, and so on.  */
  5584 int
  5585 pdumper_load (const char *dump_filename, char *argv0)
  5586 {
  5587   intptr_t dump_size;
  5588   struct stat stat;
  5589   uintptr_t dump_base;
  5590   int dump_page_size;
  5591   dump_off adj_discardable_start;
  5592 
  5593   struct dump_bitset mark_bits[2];
  5594   size_t mark_bits_needed;
  5595 
  5596   struct dump_header header_buf = { 0 };
  5597   struct dump_header *header = &header_buf;
  5598   struct dump_memory_map sections[NUMBER_DUMP_SECTIONS];
  5599 
  5600   /* Use memset instead of "= { 0 }" to work around GCC bug 105961.  */
  5601   memset (sections, 0, sizeof sections);
  5602 
  5603   const struct timespec start_time = current_timespec ();
  5604   char *dump_filename_copy;
  5605 
  5606   /* Overwriting an initialized Lisp universe will not go well.  */
  5607   eassert (!initialized);
  5608 
  5609   /* We can load only one dump.  */
  5610   eassert (!dump_loaded_p ());
  5611 
  5612   int err;
  5613   int dump_fd = emacs_open_noquit (dump_filename, O_RDONLY, 0);
  5614   if (dump_fd < 0)
  5615     {
  5616       err = (errno == ENOENT || errno == ENOTDIR
  5617              ? PDUMPER_LOAD_FILE_NOT_FOUND
  5618              : PDUMPER_LOAD_ERROR + errno);
  5619       goto out;
  5620     }
  5621 
  5622   err = PDUMPER_LOAD_FILE_NOT_FOUND;
  5623   if (fstat (dump_fd, &stat) < 0)
  5624     goto out;
  5625 
  5626   err = PDUMPER_LOAD_BAD_FILE_TYPE;
  5627   if (stat.st_size > INTPTR_MAX)
  5628     goto out;
  5629   dump_size = (intptr_t) stat.st_size;
  5630 
  5631   err = PDUMPER_LOAD_BAD_FILE_TYPE;
  5632   if (dump_size < sizeof (*header))
  5633     goto out;
  5634 
  5635   err = PDUMPER_LOAD_BAD_FILE_TYPE;
  5636   if (dump_read_all (dump_fd,
  5637                      header,
  5638                      sizeof (*header)) < sizeof (*header))
  5639     goto out;
  5640 
  5641   if (memcmp (header->magic, dump_magic, sizeof (dump_magic)) != 0)
  5642     {
  5643       if (header->magic[0] == '!'
  5644           && (header->magic[0] = dump_magic[0],
  5645               memcmp (header->magic, dump_magic, sizeof (dump_magic)) == 0))
  5646         {
  5647           err = PDUMPER_LOAD_FAILED_DUMP;
  5648           goto out;
  5649         }
  5650       err = PDUMPER_LOAD_BAD_FILE_TYPE;
  5651       goto out;
  5652     }
  5653 
  5654   err = PDUMPER_LOAD_VERSION_MISMATCH;
  5655   verify (sizeof (header->fingerprint) == sizeof (fingerprint));
  5656   unsigned char desired[sizeof fingerprint];
  5657   for (int i = 0; i < sizeof fingerprint; i++)
  5658     desired[i] = fingerprint[i];
  5659   if (memcmp (header->fingerprint, desired, sizeof desired) != 0)
  5660     {
  5661       dump_fingerprint (stderr, "desired fingerprint", desired);
  5662       dump_fingerprint (stderr, "found fingerprint", header->fingerprint);
  5663       goto out;
  5664     }
  5665 
  5666   /* FIXME: The comment at the start of this function says it should
  5667      not use xmalloc, but xstrdup calls xmalloc.  Either fix the
  5668      comment or fix the following code.  */
  5669   dump_filename_copy = xstrdup (dump_filename);
  5670 
  5671   err = PDUMPER_LOAD_OOM;
  5672 
  5673   adj_discardable_start = header->discardable_start;
  5674   dump_page_size = dump_get_max_page_size ();
  5675   /* Snap to next page boundary.  */
  5676   adj_discardable_start = ROUNDUP (adj_discardable_start, dump_page_size);
  5677   eassert (adj_discardable_start % dump_page_size == 0);
  5678   eassert (adj_discardable_start <= header->cold_start);
  5679 
  5680   sections[DS_HOT].spec = (struct dump_memory_map_spec)
  5681     {
  5682      .fd = dump_fd,
  5683      .size = adj_discardable_start,
  5684      .offset = 0,
  5685      .protection = DUMP_MEMORY_ACCESS_READWRITE,
  5686     };
  5687 
  5688   sections[DS_DISCARDABLE].spec = (struct dump_memory_map_spec)
  5689     {
  5690      .fd = dump_fd,
  5691      .size = header->cold_start - adj_discardable_start,
  5692      .offset = adj_discardable_start,
  5693      .protection = DUMP_MEMORY_ACCESS_READWRITE,
  5694     };
  5695 
  5696   sections[DS_COLD].spec = (struct dump_memory_map_spec)
  5697     {
  5698      .fd = dump_fd,
  5699      .size = dump_size - header->cold_start,
  5700      .offset = header->cold_start,
  5701      .protection = DUMP_MEMORY_ACCESS_READWRITE,
  5702     };
  5703 
  5704   if (!dump_mmap_contiguous (sections, ARRAYELTS (sections)))
  5705     goto out;
  5706 
  5707   err = PDUMPER_LOAD_ERROR;
  5708   mark_bits_needed =
  5709     divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
  5710   if (!dump_bitsets_init (mark_bits, mark_bits_needed))
  5711     goto out;
  5712 
  5713   /* Point of no return.  */
  5714   err = PDUMPER_LOAD_SUCCESS;
  5715   dump_base = (uintptr_t) sections[DS_HOT].mapping;
  5716   gflags.dumped_with_pdumper_ = true;
  5717   dump_private.header = *header;
  5718   dump_private.mark_bits = mark_bits[0];
  5719   dump_private.last_mark_bits = mark_bits[1];
  5720   dump_public.start = dump_base;
  5721   dump_public.end = dump_public.start + dump_size;
  5722 
  5723   dump_do_all_dump_reloc_for_phase (header, dump_base, EARLY_RELOCS);
  5724   dump_do_all_emacs_relocations (header, dump_base);
  5725 
  5726   dump_mmap_discard_contents (&sections[DS_DISCARDABLE]);
  5727   for (int i = 0; i < ARRAYELTS (sections); ++i)
  5728     dump_mmap_reset (&sections[i]);
  5729 
  5730   Lisp_Object hashes = zero_vector;
  5731   if (header->hash_list)
  5732     {
  5733       struct Lisp_Vector *hash_tables =
  5734         (struct Lisp_Vector *) (dump_base + header->hash_list);
  5735       hashes = make_lisp_ptr (hash_tables, Lisp_Vectorlike);
  5736     }
  5737 
  5738   pdumper_hashes = &hashes;
  5739   /* Run the functions Emacs registered for doing post-dump-load
  5740      initialization.  */
  5741   for (int i = 0; i < nr_dump_hooks; ++i)
  5742     dump_hooks[i] ();
  5743 
  5744 #ifdef HAVE_NATIVE_COMP
  5745   pdumper_set_emacs_execdir (argv0);
  5746 #else
  5747   (void) argv0;
  5748 #endif
  5749 
  5750   dump_do_all_dump_reloc_for_phase (header, dump_base, LATE_RELOCS);
  5751   dump_do_all_dump_reloc_for_phase (header, dump_base, VERY_LATE_RELOCS);
  5752 
  5753   /* Run the functions Emacs registered for doing post-dump-load
  5754      initialization.  */
  5755   for (int i = 0; i < nr_dump_late_hooks; ++i)
  5756     dump_late_hooks[i] ();
  5757 
  5758   initialized = true;
  5759 
  5760   struct timespec load_timespec =
  5761     timespec_sub (current_timespec (), start_time);
  5762   dump_private.load_time = timespectod (load_timespec);
  5763   dump_private.dump_filename = dump_filename_copy;
  5764 
  5765  out:
  5766   for (int i = 0; i < ARRAYELTS (sections); ++i)
  5767     dump_mmap_release (&sections[i]);
  5768   if (dump_fd >= 0)
  5769     emacs_close (dump_fd);
  5770 
  5771   return err;
  5772 }
  5773 
  5774 /* Prepend the Emacs startup directory to dump_filename, if that is
  5775    relative, so that we could later make it absolute correctly.  */
  5776 void
  5777 pdumper_record_wd (const char *wd)
  5778 {
  5779   if (wd && !file_name_absolute_p (dump_private.dump_filename))
  5780     {
  5781       char *dfn = xmalloc (strlen (wd) + 1
  5782                            + strlen (dump_private.dump_filename) + 1);
  5783       splice_dir_file (dfn, wd, dump_private.dump_filename);
  5784       xfree (dump_private.dump_filename);
  5785       dump_private.dump_filename = dfn;
  5786     }
  5787 }
  5788 
  5789 DEFUN ("pdumper-stats", Fpdumper_stats, Spdumper_stats, 0, 0, 0,
  5790        doc: /* Return statistics about portable dumping used by this session.
  5791 If this Emacs session was started from a dump file,
  5792 the return value is an alist of the form:
  5793 
  5794   ((dumped-with-pdumper . t) (load-time . TIME) (dump-file-name . FILE))
  5795 
  5796 where TIME is the time in seconds it took to restore Emacs state
  5797 from the dump file, and FILE is the name of the dump file.
  5798 Value is nil if this session was not started using a dump file.*/)
  5799      (void)
  5800 {
  5801   if (!dumped_with_pdumper_p ())
  5802     return Qnil;
  5803 
  5804   Lisp_Object dump_fn;
  5805 #ifdef WINDOWSNT
  5806   char dump_fn_utf8[MAX_UTF8_PATH];
  5807   if (filename_from_ansi (dump_private.dump_filename, dump_fn_utf8) == 0)
  5808     dump_fn = DECODE_FILE (build_unibyte_string (dump_fn_utf8));
  5809   else
  5810     dump_fn = build_unibyte_string (dump_private.dump_filename);
  5811 #else
  5812   dump_fn = DECODE_FILE (build_unibyte_string (dump_private.dump_filename));
  5813 #endif
  5814 
  5815   dump_fn = Fexpand_file_name (dump_fn, Qnil);
  5816 
  5817   return list3 (Fcons (Qdumped_with_pdumper, Qt),
  5818                 Fcons (Qload_time, make_float (dump_private.load_time)),
  5819                 Fcons (Qdump_file_name, dump_fn));
  5820 }
  5821 
  5822 static void
  5823 thaw_hash_tables (void)
  5824 {
  5825   Lisp_Object hash_tables = *pdumper_hashes;
  5826   for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++)
  5827     hash_table_thaw (AREF (hash_tables, i));
  5828 }
  5829 
  5830 #endif /* HAVE_PDUMPER */
  5831 
  5832 
  5833 void
  5834 init_pdumper_once (void)
  5835 {
  5836 #ifdef HAVE_PDUMPER
  5837   pdumper_do_now_and_after_load (thaw_hash_tables);
  5838 #endif
  5839 }
  5840 
  5841 void
  5842 syms_of_pdumper (void)
  5843 {
  5844 #ifdef HAVE_PDUMPER
  5845   defsubr (&Sdump_emacs_portable);
  5846   defsubr (&Sdump_emacs_portable__sort_predicate);
  5847   defsubr (&Sdump_emacs_portable__sort_predicate_copied);
  5848   DEFSYM (Qdump_emacs_portable__sort_predicate,
  5849           "dump-emacs-portable--sort-predicate");
  5850   DEFSYM (Qdump_emacs_portable__sort_predicate_copied,
  5851           "dump-emacs-portable--sort-predicate-copied");
  5852   DEFSYM (Qdumped_with_pdumper, "dumped-with-pdumper");
  5853   DEFSYM (Qload_time, "load-time");
  5854   DEFSYM (Qdump_file_name, "dump-file-name");
  5855   DEFSYM (Qafter_pdump_load_hook, "after-pdump-load-hook");
  5856   defsubr (&Spdumper_stats);
  5857 #endif /* HAVE_PDUMPER */
  5858 }