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