Function: dump-emacs-portable

dump-emacs-portable is a function defined in pdumper.c.

Signature

(dump-emacs-portable FILENAME &optional TRACK-REFERRERS)

Documentation

Dump current state of Emacs into dump file FILENAME.

If TRACK-REFERRERS is non-nil, keep additional debugging information that can help track down the provenance of unsupported object types.

Source Code

// Defined in /usr/src/emacs/src/pdumper.c
// Skipping highlighting due to helpful-max-highlight.
{
  eassert (initialized);

  if (! noninteractive)
    error ("Dumping Emacs currently works only in batch mode.  "
           "If you'd like it to work interactively, please consider "
           "contributing a patch to Emacs.");

  if (will_dump_with_unexec_p ())
    error ("This Emacs instance was started under the assumption "
           "that it would be dumped with unexec, not the portable "
           "dumper.  Dumping with the portable dumper may produce "
           "unexpected results.");

  if (!main_thread_p (current_thread))
    error ("This function can be called only in the main thread");

  if (!NILP (XCDR (Fall_threads ())))
    error ("No other Lisp threads can be running when this function is called");

  /* Clear out any detritus in memory.  */
  do
    {
      number_finalizers_run = 0;
      garbage_collect ();
    }
  while (number_finalizers_run);

  ptrdiff_t count = SPECPDL_INDEX ();

  /* Bind `command-line-processed' to nil before dumping,
     so that the dumped Emacs will process its command line
     and set up to work with X windows if appropriate.  */
  Lisp_Object symbol = intern ("command-line-processed");
  specbind (symbol, Qnil);

  CHECK_STRING (filename);
  filename = Fexpand_file_name (filename, Qnil);
  filename = ENCODE_FILE (filename);

  struct dump_context ctx_buf = {0};
  struct dump_context *ctx = &ctx_buf;
  ctx->fd = -1;

  ctx->objects_dumped = make_eq_hash_table ();
  dump_queue_init (&ctx->dump_queue);
  ctx->deferred_hash_tables = Qnil;
  ctx->deferred_symbols = Qnil;

  ctx->fixups = Qnil;
  ctx->staticpro_table = Fmake_hash_table (0, NULL);
  ctx->symbol_aux = Qnil;
  ctx->copied_queue = Qnil;
  ctx->cold_queue = Qnil;
  for (int i = 0; i < RELOC_NUM_PHASES; ++i)
    ctx->dump_relocs[i] = Qnil;
  ctx->object_starts = Qnil;
  ctx->emacs_relocs = Qnil;
  ctx->bignum_data = make_eq_hash_table ();

  /* Ordinarily, dump_object should remember where it saw objects and
     actually write the object contents to the dump file.  In special
     circumstances below, we temporarily change this default
     behavior.  */
  ctx->flags.dump_object_contents = true;
  ctx->flags.record_object_starts = true;

  /* We want to consolidate certain object types that we know are very likely
     to be modified.  */
  ctx->flags.defer_hash_tables = true;
  /* ctx->flags.defer_symbols = true; XXX  */

  /* These objects go into special sections.  */
  ctx->flags.defer_cold_objects = true;
  ctx->flags.defer_copied_objects = true;

  ctx->current_referrer = Qnil;
  if (!NILP (track_referrers))
    ctx->referrers = make_eq_hash_table ();

  ctx->dump_filename = filename;

  record_unwind_protect_ptr (dump_unwind_cleanup, ctx);
  block_input ();

#ifdef REL_ALLOC
  r_alloc_inhibit_buffer_relocation (1);
  ctx->blocked_ralloc = true;
#endif

  ctx->old_purify_flag = Vpurify_flag;
  Vpurify_flag = Qnil;

  /* Make sure various weird things are less likely to happen.  */
  ctx->old_post_gc_hook = Vpost_gc_hook;
  Vpost_gc_hook = Qnil;

  /* Reset process-environment -- this is for when they re-dump a
     pdump-restored emacs, since set_initial_environment wants always
     to cons it from scratch.  */
  ctx->old_process_environment = Vprocess_environment;
  Vprocess_environment = Qnil;

  ctx->fd = emacs_open (SSDATA (filename),
                        O_RDWR | O_TRUNC | O_CREAT, 0666);
  if (ctx->fd < 0)
    report_file_error ("Opening dump output", filename);
  verify (sizeof (ctx->header.magic) == sizeof (dump_magic));
  memcpy (&ctx->header.magic, dump_magic, sizeof (dump_magic));
  ctx->header.magic[0] = '!'; /* Note that dump is incomplete.  */

  verify (sizeof (fingerprint) == sizeof (ctx->header.fingerprint));
  for (int i = 0; i < sizeof fingerprint; i++)
    ctx->header.fingerprint[i] = fingerprint[i];

  const dump_off header_start = ctx->offset;
  dump_fingerprint ("Dumping fingerprint", ctx->header.fingerprint);
  dump_write (ctx, &ctx->header, sizeof (ctx->header));
  const dump_off header_end = ctx->offset;

  const dump_off hot_start = ctx->offset;
  /* Start the dump process by processing the static roots and
     queuing up the objects to which they refer.   */
  dump_roots (ctx);

  dump_charset_table (ctx);
  dump_finalizer_list_head_ptr (ctx, &finalizers.prev);
  dump_finalizer_list_head_ptr (ctx, &finalizers.next);
  dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.prev);
  dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.next);
  dump_drain_user_remembered_data_hot (ctx);

  /* We've already remembered all the objects to which GC roots point,
     but we have to manually save the list of GC roots itself.  */
  dump_metadata_for_pdumper (ctx);
  for (int i = 0; i < staticidx; ++i)
    dump_emacs_reloc_to_emacs_ptr_raw (ctx, &staticvec[i], staticvec[i]);
  dump_emacs_reloc_immediate_int (ctx, &staticidx, staticidx);

  /* Dump until while we keep finding objects to dump.  We add new
     objects to the queue by side effect during dumping.
     We accumulate some types of objects in special lists to get more
     locality for these object types at runtime.  */
  do
    {
      dump_drain_deferred_hash_tables (ctx);
      dump_drain_deferred_symbols (ctx);
      dump_drain_normal_queue (ctx);
    }
  while (!dump_queue_empty_p (&ctx->dump_queue)
	 || !NILP (ctx->deferred_hash_tables)
	 || !NILP (ctx->deferred_symbols));

  ctx->header.hash_list = ctx->offset;
  dump_hash_table_list (ctx);

  do
    {
      dump_drain_deferred_hash_tables (ctx);
      dump_drain_deferred_symbols (ctx);
      dump_drain_normal_queue (ctx);
    }
  while (!dump_queue_empty_p (&ctx->dump_queue)
	 || !NILP (ctx->deferred_hash_tables)
	 || !NILP (ctx->deferred_symbols));

  dump_sort_copied_objects (ctx);

  /* While we copy built-in symbols into the Emacs image, these
     built-in structures refer to non-Lisp heap objects that must live
     in the dump; we stick these auxiliary data structures at the end
     of the hot section and use a special hash table to remember them.
     The actual symbol dump will pick them up below.  */
  ctx->symbol_aux = make_eq_hash_table ();
  dump_hot_parts_of_discardable_objects (ctx);

  /* Emacs, after initial dump loading, can forget about the portion
     of the dump that runs from here to the start of the cold section.
     This section consists of objects that need to be memcpy()ed into
     the Emacs data section instead of just used directly.

     We don't need to align hot_end: the loader knows to actually
     start discarding only at the next page boundary if the loader
     implements discarding using page manipulation.  */
  const dump_off hot_end = ctx->offset;
  ctx->header.discardable_start = hot_end;

  dump_drain_copied_objects (ctx);
  eassert (dump_queue_empty_p (&ctx->dump_queue));

  dump_off discardable_end = ctx->offset;
  dump_align_output (ctx, dump_get_page_size ());
  ctx->header.cold_start = ctx->offset;

  /* Start the cold section.  This section contains bytes that should
     never change and so can be direct-mapped from the dump without
     special processing.  */
  dump_drain_cold_data (ctx);
   /* dump_drain_user_remembered_data_cold needs to be after
      dump_drain_cold_data in case dump_drain_cold_data dumps a lisp
      object to which C code points.
      dump_drain_user_remembered_data_cold assumes that all lisp
      objects have been dumped.  */
  dump_drain_user_remembered_data_cold (ctx);

  /* After this point, the dump file contains no data that can be part
     of the Lisp heap.  */
  ctx->end_heap = ctx->offset;

  /* Make remembered modifications to the dump file itself.  */
  dump_do_fixups (ctx);

  drain_reloc_merger emacs_reloc_merger =
#ifdef ENABLE_CHECKING
    dump_check_overlap_dump_reloc
#else
    NULL
#endif
    ;

  /* Emit instructions for Emacs to execute when loading the dump.
     Note that this relocation information ends up in the cold section
     of the dump.  */
  for (int i = 0; i < RELOC_NUM_PHASES; ++i)
    drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
		      &ctx->dump_relocs[i], &ctx->header.dump_relocs[i]);
  dump_off number_hot_relocations = ctx->number_hot_relocations;
  ctx->number_hot_relocations = 0;
  dump_off number_discardable_relocations = ctx->number_discardable_relocations;
  ctx->number_discardable_relocations = 0;
  drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
		    &ctx->object_starts, &ctx->header.object_starts);
  drain_reloc_list (ctx, dump_emit_emacs_reloc, dump_merge_emacs_relocs,
		    &ctx->emacs_relocs, &ctx->header.emacs_relocs);

  const dump_off cold_end = ctx->offset;

  eassert (dump_queue_empty_p (&ctx->dump_queue));
  eassert (NILP (ctx->copied_queue));
  eassert (NILP (ctx->cold_queue));
  eassert (NILP (ctx->deferred_symbols));
  eassert (NILP (ctx->deferred_hash_tables));
  eassert (NILP (ctx->fixups));
  for (int i = 0; i < RELOC_NUM_PHASES; ++i)
    eassert (NILP (ctx->dump_relocs[i]));
  eassert (NILP (ctx->emacs_relocs));

  /* Dump is complete.  Go back to the header and write the magic
     indicating that the dump is complete and can be loaded.  */
  ctx->header.magic[0] = dump_magic[0];
  dump_seek (ctx, 0);
  dump_write (ctx, &ctx->header, sizeof (ctx->header));
  if (emacs_write (ctx->fd, ctx->buf, ctx->max_offset) < ctx->max_offset)
    report_file_error ("Could not write to dump file", ctx->dump_filename);
  xfree (ctx->buf);
  ctx->buf = NULL;
  ctx->buf_size = 0;
  ctx->max_offset = 0;

  dump_off
    header_bytes = header_end - header_start,
    hot_bytes = hot_end - hot_start,
    discardable_bytes = discardable_end - ctx->header.discardable_start,
    cold_bytes = cold_end - ctx->header.cold_start;
  fprintf (stderr,
	   ("Dump complete\n"
	    "Byte counts: header=%"PRIdDUMP_OFF" hot=%"PRIdDUMP_OFF
	    " discardable=%"PRIdDUMP_OFF" cold=%"PRIdDUMP_OFF"\n"
	    "Reloc counts: hot=%"PRIdDUMP_OFF" discardable=%"PRIdDUMP_OFF"\n"),
	   header_bytes, hot_bytes, discardable_bytes, cold_bytes,
           number_hot_relocations,
           number_discardable_relocations);

  unblock_input ();
  return unbind_to (count, Qnil);
}