[Message Prev][Message Next][Thread Prev][Thread Next][Message Index][Thread Index]
[MD:2866]Emacs 21.1 portable dumper (was Re: Portable dumper TODO)
- X-ml-count: 2866
- Subject: [MD:2866]Emacs 21.1 portable dumper (was Re: Portable dumper TODO)
- From: Yoshiki Hayashi <yoshiki@xxxxxxxxxx>
- Date: 22 Jan 2002 16:57:25 +0900
- User-agent: T-gnus/6.15.3 (based on Oort Gnus v0.03) (revision 06)
Yoshiki Hayashi <yoshiki@xxxxxxxxxx> writes:
> Keiichiro Nagano (永野圭一郎) <knagano@xxxxxxxxx> writes:
>
> > At 21 Jan 2002 18:20:59 +0900,
> > Yoshiki Hayashi wrote:
> > > * Meadow 2 への準備
> > >
> > > Emacs 21.1 へ移植。
> >
> > これをやらせて下さい。
> # hash table は dump 前に load される elisp は使っていないよ
> # うなので、serialize 用の code を書かなくても一応動くと思い
> # ます。(^^;;
と書いたものの、ちょっと bug fix をしてもう少し先まで行くよ
うにすると見事に hash table がでてきました。いくつか面倒なの
があるので、がんばってください。:-)
主に、変更すべき点は二つに大別されて、heap の dump と global
variable の dump になります。ここで、今回面倒なのは heap の
dump の code を書き足さなければならない方なので、それを先に
説明します。
20.7 と 21.1 の alloc.c を見比べるとわかりますが、大きな変更
が二つあります。
一つは、Lisp_String で、20.7 では raw byte data もまとめて
block から取得していたのですが、21.1 では XEmacs と同じよう
に、data は別の string data block から取るようになっています。
これが嬉しいのは、compaction しても Lisp_String への pointer
は変更しなくて良いので、compaction が全部 Lisp_String の中だ
けで閉じる、ということなのですが、それは portable dumper に
はそんなに影響しません (Lisp_Symbol の name field くらい)。
むしろ、影響するのは data の pointer を別領域に dump して、
load 時は relocation の対象にしなければならない、という点で
す。これは、似たようなことしている code があるので、それを参
考にすればそんなに難しくはないでしょう。
もう一つは Lisp_Hash_Table で、おそらく hash の key は
Lisp_Object の値 (つまり、shift された pointer) なので、load
時に relocate 後に rehash して正しい位置に object が収まるよ
うにしなければなりません。理想的には、dump 時にも rehash し
たものを dump して、relocation しないときは rehash しなくて
良いようにするのが良いと思いますが、とりあえずは常に rehash
するような code を書くのが良いでしょう。Load 時の scan のた
めに、enum pdump_object_type に新しく PDUMP_HASH_TABLE か何
かを作って hash table だけ別のところに dump すると load 時に
ちょっと楽になるかもしれません。これは hash table の code を
読む必要があるので、ちょっと面倒でしょう。
後、Lisp_String の interval は NULL であることを仮定して
20.7 の code ではさぼっていたのですが、21.1 では NULL でない
場合があるので、struct interval の dump and load routine も
必要になります。あんまり見ていないので良くわかりませんが、こ
れもちょっと面倒そうです。
もう一つの global variable の方は、Emacs 20.7 と Emacs 21.1
の diff を取って、追加されている global variable を適切に
dump や reinitialize したり、削除されている global variable
への対応をする、というものです。例えば、buffer.c では
permanent local variable の扱いが変わっているので、
buffer_local_permanent_flags と last_per_buffer_idx を dump
and load するように変更する必要がでてきます。ざっと diff を
眺めた限りでは、alloc.c, buffer.c, hash table, bytecode.c,
coding.c, dispnew.c, buffer.c, fontset.c, keyboard.c,
lread.c, print.c, window.c, xfaces.c, xfns.c, xterm.c あたり
に global variable が変更されているものがあるようです。
最後に Emacs 21.1 に対する patch を付けておきます。当然、こ
のままでは上に挙げたものに対する code がないので動きません。
(^^;
Index: src/keyboard.c
===================================================================
--- src/keyboard.c
+++ tmp.62000.00001 Tue Jan 22 16:15:35 2002
@@ -10717,6 +10717,7 @@
"Normal hook run when clearing the echo area.");
#endif
Qecho_area_clear_hook = intern ("echo-area-clear-hook");
+ staticpro (&Qecho_area_clear_hook);
XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
Index: src/xfaces.c
===================================================================
--- src/xfaces.c
+++ tmp.62000.00001 Tue Jan 22 16:15:35 2002
@@ -441,7 +441,7 @@
/* The next ID to assign to Lisp faces. */
-static int next_lface_id;
+int next_lface_id;
/* A vector mapping Lisp face Id's to face names. */
Index: src/dispnew.c
===================================================================
--- src/dispnew.c
+++ tmp.62000.00001 Tue Jan 22 16:15:36 2002
@@ -6617,6 +6617,12 @@
***********************************************************************/
void
+reinit_syms_of_display ()
+{
+ frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda);
+}
+
+void
syms_of_display ()
{
defsubr (&Sredraw_frame);
@@ -6634,8 +6640,8 @@
defsubr (&Sdump_redisplay_history);
#endif
- frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda);
- staticpro (&frame_and_buffer_state);
+ reinit_syms_of_display ();
+ staticpro_nopdump (&frame_and_buffer_state);
Qdisplay_table = intern ("display-table");
staticpro (&Qdisplay_table);
Index: src/xfns.c
===================================================================
--- src/xfns.c
+++ tmp.62000.00001 Tue Jan 22 16:15:36 2002
@@ -11426,11 +11426,29 @@
***********************************************************************/
void
-syms_of_xfns ()
+reinit_syms_of_xfns ()
{
/* This is zero if not using X windows. */
x_in_use = 0;
+ /* Setting callback functions for fontset handler. */
+ get_font_info_func = x_get_font_info;
+
+#if 0 /* This function pointer doesn't seem to be used anywhere.
+ And the pointer assigned has the wrong type, anyway. */
+ list_fonts_func = x_list_fonts;
+#endif
+
+ load_font_func = x_load_font;
+ find_ccl_program_func = x_find_ccl_program;
+ query_font_func = x_query_font;
+ set_frame_fontset_func = x_set_font;
+ check_window_system_func = check_x;
+}
+
+void
+syms_of_xfns ()
+{
/* The section below is built by the lisp expression at the top of the file,
just above where these variables are declared. */
/*&&& init symbols here &&&*/
@@ -11516,6 +11534,7 @@
Vtext_property_default_nonsticky
= Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
+ reinit_syms_of_xfns ();
Qlaplace = intern ("laplace");
staticpro (&Qlaplace);
@@ -11705,20 +11724,6 @@
defsubr (&Sx_focus_frame);
defsubr (&Sx_backspace_delete_keys_p);
- /* Setting callback functions for fontset handler. */
- get_font_info_func = x_get_font_info;
-
-#if 0 /* This function pointer doesn't seem to be used anywhere.
- And the pointer assigned has the wrong type, anyway. */
- list_fonts_func = x_list_fonts;
-#endif
-
- load_font_func = x_load_font;
- find_ccl_program_func = x_find_ccl_program;
- query_font_func = x_query_font;
- set_frame_fontset_func = x_set_font;
- check_window_system_func = check_x;
-
/* Images. */
Qxbm = intern ("xbm");
staticpro (&Qxbm);
Index: src/w32fns.c
===================================================================
--- src/w32fns.c
+++ tmp.62000.00001 Tue Jan 22 16:15:37 2002
@@ -13449,11 +13449,30 @@
return value;
}
-syms_of_w32fns ()
+reinit_syms_of_w32fns ()
{
/* This is zero if not using MS-Windows. */
w32_in_use = 0;
+ /* Setting callback functions for fontset handler. */
+ get_font_info_func = w32_get_font_info;
+
+#if 0 /* This function pointer doesn't seem to be used anywhere.
+ And the pointer assigned has the wrong type, anyway. */
+ list_fonts_func = w32_list_fonts;
+#endif
+
+ load_font_func = w32_load_font;
+ find_ccl_program_func = w32_find_ccl_program;
+ query_font_func = w32_query_font;
+ set_frame_fontset_func = x_set_font;
+ check_window_system_func = check_w32;
+}
+
+syms_of_w32fns ()
+{
+ reinit_syms_of_w32fns ();
+
/* The section below is built by the lisp expression at the top of the file,
just above where these variables are declared. */
/*&&& init symbols here &&&*/
@@ -13862,6 +13881,7 @@
staticpro (&Qw32_charset_unicode);
Qw32_charset_unicode = intern ("w32-charset-unicode");
+ }
#endif
defsubr (&Sx_get_resource);
@@ -13911,20 +13931,6 @@
defsubr (&Sw32_find_bdf_fonts);
defsubr (&Sfile_system_info);
-
- /* Setting callback functions for fontset handler. */
- get_font_info_func = w32_get_font_info;
-
-#if 0 /* This function pointer doesn't seem to be used anywhere.
- And the pointer assigned has the wrong type, anyway. */
- list_fonts_func = w32_list_fonts;
-#endif
-
- load_font_func = w32_load_font;
- find_ccl_program_func = w32_find_ccl_program;
- query_font_func = w32_query_font;
- set_frame_fontset_func = x_set_font;
- check_window_system_func = check_w32;
#if 0 /* TODO Image support for W32 */
/* Images. */
Index: src/w32menu.c
===================================================================
--- src/w32menu.c
+++ tmp.62000.00001 Tue Jan 22 16:15:37 2002
@@ -2206,10 +2206,15 @@
#endif /* HAVE_MENUS */
-syms_of_w32menu ()
+reinit_syms_of_w32menu ()
{
- staticpro (&menu_items);
menu_items = Qnil;
+}
+
+syms_of_w32menu ()
+{
+ staticpro_nopdump (&menu_items);
+ reinit_syms_of_w32menu ();
Qdebug_on_next_call = intern ("debug-on-next-call");
staticpro (&Qdebug_on_next_call);
Index: src/lisp.h
===================================================================
--- src/lisp.h
+++ tmp.62000.00001 Tue Jan 22 16:15:37 2002
@@ -1422,7 +1422,7 @@
#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname (); \
struct Lisp_Subr sname = \
- { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
+ { PVEC_SUBR | PSEUDOVECTOR_FLAG | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
fnname, minargs, maxargs, lname, prompt, 0}; \
Lisp_Object fnname
@@ -1433,7 +1433,7 @@
#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
struct Lisp_Subr sname = \
- { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
+ { PVEC_SUBR | PSEUDOVECTOR_FLAG | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
fnname, minargs, maxargs, lname, prompt, 0}; \
Lisp_Object fnname
Index: src/category.c
===================================================================
--- src/category.c
+++ tmp.62000.00001 Tue Jan 22 16:15:37 2002
@@ -632,6 +632,12 @@
}
void
+reinit_syms_of_category ()
+{
+ category_table_version = 0;
+}
+
+void
syms_of_category ()
{
Qcategoryp = intern ("categoryp");
@@ -699,5 +705,5 @@
defsubr (&Smodify_category_entry);
defsubr (&Sdescribe_categories);
- category_table_version = 0;
+ reinit_syms_of_category ();
}
Index: src/w32.c
===================================================================
--- src/w32.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -3478,7 +3478,9 @@
}
/* Check to see if Emacs has been installed correctly. */
+#ifndef PDUMP /* #### FIXME */
check_windows_init_file ();
+#endif
}
/* end of nt.c */
Index: src/makefile.nt
===================================================================
--- src/makefile.nt
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -212,7 +212,8 @@
#
emacs: $(EMACS)
$(EMACS): $(DOC) $(TEMACS)
- $(MAKEDIR)\$(BLD)\temacs.exe -batch -l loadup dump
+ $(MAKEDIR)\$(BLD)\temacs.exe -nd -batch -l loadup dump
+ $(CP) $(MAKEDIR)\$(BLD)\temacs.exe $(MAKEDIR)\$(BLD)\emacs.exe
#
# The undumped executable
@@ -292,6 +293,7 @@
install: all
- mkdir $(INSTALL_DIR)\bin
$(CP) $(EMACS) $(INSTALL_DIR)\bin
+ $(CP) $(BLD)\emacs.dmp $(INSTALL_DIR)\bin
#
# Maintenance
Index: src/callint.c
===================================================================
--- src/callint.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -825,10 +825,19 @@
}
void
-syms_of_callint ()
+reinit_syms_of_callint ()
{
point_marker = Fmake_marker ();
- staticpro (&point_marker);
+
+ callint_message_size = 100;
+ callint_message = (char *) xmalloc (callint_message_size);
+}
+
+void
+syms_of_callint ()
+{
+ reinit_syms_of_callint ();
+ staticpro_nopdump (&point_marker);
preserved_fns = Fcons (intern ("region-beginning"),
Fcons (intern ("region-end"),
@@ -862,9 +871,6 @@
Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
staticpro (&Qmouse_leave_buffer_hook);
-
- callint_message_size = 100;
- callint_message = (char *) xmalloc (callint_message_size);
DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
Index: src/w32proc.c
===================================================================
--- src/w32proc.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -2124,6 +2124,8 @@
{
Qhigh = intern ("high");
Qlow = intern ("low");
+ staticpro (&Qhigh);
+ staticpro (&Qlow);
#ifdef HAVE_SOCKETS
defsubr (&Sw32_has_winsock);
Index: src/buffer.c
===================================================================
--- src/buffer.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -116,7 +116,7 @@
/* Flags indicating which built-in buffer-local variables
are permanent locals. */
-static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
+char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
/* Number of per-buffer variables used. */
@@ -4697,6 +4697,35 @@
Initialization
***********************************************************************/
+#ifdef PDUMP
+int
+pdump_global_buffer_p (Lisp_Object obj)
+{
+ return (obj == Vbuffer_defaults || obj == Vbuffer_local_symbols);
+}
+#endif
+
+void
+reinit_buffer_once_1 ()
+{
+ Vbuffer_alist = Qnil;
+ current_buffer = 0;
+ all_buffers = 0;
+}
+
+void
+reinit_buffer_once_2 ()
+{
+ Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
+
+ /* super-magic invisible buffer */
+ Vbuffer_alist = Qnil;
+
+ Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
+
+ inhibit_modification_hooks = 0;
+}
+
void
init_buffer_once ()
{
@@ -4833,11 +4862,8 @@
if (idx >= MAX_PER_BUFFER_VARS)
abort ();
last_per_buffer_idx = idx;
-
- Vbuffer_alist = Qnil;
- current_buffer = 0;
- all_buffers = 0;
+ reinit_buffer_once_1 ();
QSFundamental = build_string ("Fundamental");
Qfundamental_mode = intern ("fundamental-mode");
@@ -4851,14 +4877,7 @@
Qkill_buffer_hook = intern ("kill-buffer-hook");
- Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
-
- /* super-magic invisible buffer */
- Vbuffer_alist = Qnil;
-
- Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
-
- inhibit_modification_hooks = 0;
+ reinit_buffer_once_2 ();
}
void
@@ -4942,12 +4961,12 @@
last_overlay_modification_hooks
= Fmake_vector (make_number (10), Qnil);
- staticpro (&Vbuffer_defaults);
- staticpro (&Vbuffer_local_symbols);
+ staticpro_nopdump (&Vbuffer_defaults);
+ staticpro_nopdump (&Vbuffer_local_symbols);
staticpro (&Qfundamental_mode);
staticpro (&Qmode_class);
staticpro (&QSFundamental);
- staticpro (&Vbuffer_alist);
+ staticpro_nopdump (&Vbuffer_alist);
staticpro (&Qprotected_field);
staticpro (&Qpermanent_local);
staticpro (&Qkill_buffer_hook);
Index: src/lread.c
===================================================================
--- src/lread.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -2226,10 +2226,12 @@
separate characters, treat them as separate characters now. */
nchars = p - read_buffer;
+#ifndef PDUMP
if (read_pure)
return make_pure_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
+#endif
return make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
@@ -2578,7 +2580,11 @@
tem = read_list (1, readcharfun);
len = Flength (tem);
+#ifdef PDUMP
+ vector = Fmake_vector (len, Qnil);
+#else
vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
+#endif
size = XVECTOR (vector)->size;
ptr = XVECTOR (vector)->contents;
@@ -2801,9 +2807,13 @@
}
return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
}
+#ifdef PDUMP
+ tem = Fcons (elt, Qnil);
+#else
tem = (read_pure && flag <= 0
? pure_cons (elt, Qnil)
: Fcons (elt, Qnil));
+#endif
if (!NILP (tail))
XCDR (tail) = tem;
else
@@ -2871,9 +2881,13 @@
{
int len = strlen (str);
+#ifdef PDUMP
+ return Fmake_symbol (make_string (str, len));
+#else
return Fmake_symbol ((!NILP (Vpurify_flag)
? make_pure_string (str, len, len, 0)
: make_string (str, len)));
+#endif
}
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
@@ -3121,6 +3135,13 @@
#define OBARRAY_SIZE 1511
void
+reinit_obarray ()
+{
+ read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
+ read_buffer = (char *) malloc (read_buffer_size);
+}
+
+void
init_obarray ()
{
Lisp_Object oblength;
@@ -3129,7 +3150,11 @@
XSETFASTINT (oblength, OBARRAY_SIZE);
+#ifdef PDUMP
+ Qnil = Fmake_symbol (make_string ("nil", 3));
+#else
Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
+#endif
Vobarray = Fmake_vector (oblength, make_number (0));
initial_obarray = Vobarray;
staticpro (&initial_obarray);
@@ -3142,7 +3167,11 @@
tem = &XVECTOR (Vobarray)->contents[hash];
*tem = Qnil;
+#ifdef PDUMP
+ Qunbound = Fmake_symbol (make_string ("unbound", 7));
+#else
Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
+#endif
XSYMBOL (Qnil)->function = Qunbound;
XSYMBOL (Qunbound)->value = Qunbound;
XSYMBOL (Qunbound)->function = Qunbound;
@@ -3158,8 +3187,7 @@
Qvariable_documentation = intern ("variable-documentation");
staticpro (&Qvariable_documentation);
- read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
- read_buffer = (char *) xmalloc (read_buffer_size);
+ reinit_obarray ();
}
void
Index: src/eval.c
===================================================================
--- src/eval.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -198,7 +198,7 @@
extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
void
-init_eval_once ()
+reinit_eval_once ()
{
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
@@ -206,6 +206,12 @@
max_specpdl_size = 600;
max_lisp_eval_depth = 300;
+}
+
+void
+init_eval_once ()
+{
+ reinit_eval_once ();
Vrun_hooks = Qnil;
}
Index: src/print.c
===================================================================
--- src/print.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -2073,7 +2073,7 @@
Vprint_number_table = Qnil;
/* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
- staticpro (&Vprin1_to_string_buffer);
+ staticpro_nopdump (&Vprin1_to_string_buffer);
defsubr (&Sprin1);
defsubr (&Sprin1_to_string);
Index: src/Makefile.in
===================================================================
--- src/Makefile.in
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -514,6 +514,11 @@
#define UNEXEC_SRC unexec.c
#endif
+#ifdef PDUMP
+#undef UNEXEC
+#define UNEXEC
+#endif
+
INTERVAL_SRC = intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
@@ -834,6 +839,9 @@
all: emacs OTHER_FILES
emacs: temacs ${etc}DOC ${lisp}
+#ifdef PDUMP
+ ./temacs -nd -batch -l loadup dump
+#else
#ifdef CANNOT_DUMP
rm -f emacs
ln temacs emacs
@@ -844,6 +852,7 @@
LC_ALL=C ./temacs -batch -l loadup dump
#endif /* ! defined (HAVE_SHM) */
#endif /* ! defined (CANNOT_DUMP) */
+#endif /* ! defined (PDUMP) */
-./emacs -q -batch -f list-load-path-shadows
/* We run make-docfile twice because the command line may get too long
Index: src/emacs.c
===================================================================
--- src/emacs.c
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -699,6 +699,29 @@
#endif /* DOUG_LEA_MALLOC */
+static void
+print_version_and_exit ()
+{
+ Lisp_Object tem;
+ tem = Fsymbol_value (intern ("emacs-version"));
+ if (!STRINGP (tem))
+ {
+ fprintf (stderr, "Invalid value of `emacs-version'\n");
+ exit (1);
+ }
+ else
+ {
+ printf ("GNU Emacs %s\n", XSTRING (tem)->data);
+ printf ("Copyright (C) 2001 Free Software Foundation, Inc.\n");
+ printf ("GNU Emacs comes with ABSOLUTELY NO WARRANTY.\n");
+ printf ("You may redistribute copies of Emacs\n");
+ printf ("under the terms of the GNU General Public License.\n");
+ printf ("For more information about these matters, ");
+ printf ("see the file named COPYING.\n");
+ exit (0);
+ }
+}
+
/* ARGSUSED */
int
main (argc, argv, envp)
@@ -719,6 +742,10 @@
struct rlimit rlim;
#endif
int no_loadup = 0;
+#ifdef PDUMP
+ int print_version = 0;
+ int no_dump = 0;
+#endif
#if GC_MARK_STACK
extern Lisp_Object *stack_base;
@@ -741,28 +768,23 @@
if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args)
/* We don't know the version number unless this is a dumped Emacs.
So ignore --version otherwise. */
- && initialized)
+#ifndef PDUMP
+ && initialized
+#endif
+ )
{
- Lisp_Object tem;
- tem = Fsymbol_value (intern ("emacs-version"));
- if (!STRINGP (tem))
- {
- fprintf (stderr, "Invalid value of `emacs-version'\n");
- exit (1);
- }
- else
- {
- printf ("GNU Emacs %s\n", XSTRING (tem)->data);
- printf ("Copyright (C) 2001 Free Software Foundation, Inc.\n");
- printf ("GNU Emacs comes with ABSOLUTELY NO WARRANTY.\n");
- printf ("You may redistribute copies of Emacs\n");
- printf ("under the terms of the GNU General Public License.\n");
- printf ("For more information about these matters, ");
- printf ("see the file named COPYING.\n");
- exit (0);
- }
+#ifdef PDUMP
+ print_version = 1;
+#else
+ print_version_and_exit ();
+#endif
}
+#ifdef PDUMP
+ if (argmatch (argv, argc, "-nd", "--no-dump-file", 6, NULL, &skip_args))
+ no_dump = 1;
+#endif
+
/* Map in shared memory, if we are using that. */
#ifdef HAVE_SHM
if (argmatch (argv, argc, "-nl", "--no-shared-memory", 6, NULL, &skip_args))
@@ -818,7 +840,11 @@
might define a smaller stack limit at that time. */
if (1
#ifndef CANNOT_DUMP
- && (!noninteractive || initialized)
+ && (!noninteractive
+#ifndef PDUMP
+ || initialized
+#endif
+ )
#endif
&& !getrlimit (RLIMIT_STACK, &rlim))
{
@@ -919,6 +945,9 @@
#endif
inhibit_window_system = 0;
+#ifdef PDUMP
+ initialized = ! no_dump;
+#endif
/* Handle the -t switch, which specifies filename to use as terminal */
while (1)
@@ -1002,7 +1031,8 @@
if (
#ifndef CANNOT_DUMP
- ! noninteractive || initialized
+ ! noninteractive
+ || initialized
#else
1
#endif
@@ -1136,6 +1166,29 @@
init_window_once (); /* Init the window system */
init_fileio_once (); /* Must precede any path manipulation. */
}
+#ifdef PDUMP
+ else
+ {
+ if (pdump_load (argv[0]))
+ {
+ fprintf (stderr, "emacs: failed to load dumped file\n");
+ exit (1);
+ }
+ reinit_alloc_once ();
+ reinit_obarray ();
+ reinit_eval_once ();
+ reinit_charset_once ();
+ reinit_coding_once (1);
+ init_syntax_once ();
+ reinit_buffer_once_1 ();
+ reinit_buffer_once_2 ();
+ reinit_minibuf_once ();
+ reinit_window_once (1);
+ /* #### Oh, my. init_buffer depends on this. */
+ reinit_syms_of_search (1);
+ noninteractive1 = noninteractive;
+ }
+#endif
init_alloc ();
@@ -1439,6 +1492,38 @@
keys_of_window ();
keys_of_frame ();
}
+#ifdef PDUMP
+ else
+ {
+ reinit_syms_of_abbrev ();
+ reinit_syms_of_callint ();
+ reinit_syms_of_category ();
+ Fsetup_special_charsets ();
+ /* Reinitialize cache from Vcoding_category_list */
+ Fupdate_coding_systems_internal ();
+ Fset_coding_priority_internal ();
+ reinit_syms_of_display ();
+ reinit_syms_of_editfns ();
+ reinit_syms_of_insdel ();
+#ifdef HAVE_X_WINDOWS
+ reinit_syms_of_xfns ();
+#ifdef HAVE_X11
+ reinit_syms_of_xselect ();
+#endif
+#endif /* HAVE_X_WINDOWS */
+
+#ifndef HAVE_NTGUI
+ reinit_syms_of_xmenu ();
+#endif
+
+#ifdef HAVE_NTGUI
+ reinit_syms_of_w32fns ();
+ reinit_syms_of_w32menu ();
+#endif
+ if (print_version)
+ print_version_and_exit ();
+ }
+#endif
if (!noninteractive)
{
@@ -1571,6 +1656,9 @@
#ifdef VMS
{ "-map", "--map-data", 130, 0 },
#endif
+#ifdef PDUMP
+ { "-nd", "--no-dump-file", 125, 0},
+#endif
{ "-t", "--terminal", 120, 1 },
{ "-nw", "--no-windows", 110, 0 },
{ "-batch", "--batch", 100, 0 },
@@ -1827,6 +1915,10 @@
if (STRINGP (Vauto_save_list_file_name))
unlink (XSTRING (Vauto_save_list_file_name)->data);
+#ifdef PDUMP
+ pdump_free ();
+#endif
+
exit (INTEGERP (arg) ? XINT (arg)
#ifdef VMS
: 1
@@ -1993,6 +2085,10 @@
symfile = Fexpand_file_name (symfile, Qnil);
}
+#ifdef PDUMP
+ Fgarbage_collect ();
+#endif /* PDUMP */
+
tem = Vpurify_flag;
Vpurify_flag = Qnil;
@@ -2017,6 +2113,12 @@
memory_warnings (my_edata, malloc_warning);
#endif /* not WINDOWSNT */
#endif
+#ifdef PDUMP
+ pdump ();
+#ifndef WINDOWSNT
+ Fadd_name_to_file (build_string ("temacs"), build_string ("emacs"), Qt);
+#endif
+#else
#ifdef DOUG_LEA_MALLOC
malloc_state_ptr = malloc_get_state ();
#endif
@@ -2033,6 +2135,7 @@
free (malloc_state_ptr);
#endif
#endif /* not VMS */
+#endif /* not PDUMP */
Vpurify_flag = tem;
Index: src/config.in
===================================================================
--- src/config.in
+++ tmp.62000.00001 Tue Jan 22 16:15:38 2002
@@ -37,7 +37,7 @@
/* Define REL_ALLOC if you want to use the relocating allocator for
buffer space. */
#undef REL_ALLOC
-
+
/* Define HAVE_X_WINDOWS if you want to use the X window system. */
#undef HAVE_X_WINDOWS
@@ -446,6 +446,9 @@
#ifndef SIGTYPE
#define SIGTYPE RETSIGTYPE
#endif
+
+/* Define this if you are building with portable dumper. */
+#undef PDUMP
#ifdef emacs /* Don't do this for lib-src. */
/* Tell regex.c to use a type compatible with Emacs. */
Index: src/minibuf.c
===================================================================
--- src/minibuf.c
+++ tmp.62000.00001 Tue Jan 22 16:15:39 2002
@@ -2295,16 +2295,28 @@
}
void
-init_minibuf_once ()
+reinit_minibuf_once ()
{
Vminibuffer_list = Qnil;
- staticpro (&Vminibuffer_list);
}
void
-syms_of_minibuf ()
+init_minibuf_once ()
+{
+ reinit_minibuf_once ();
+ staticpro_nopdump (&Vminibuffer_list);
+}
+
+void
+reinit_syms_of_minibuf ()
{
minibuf_level = 0;
+}
+
+void
+syms_of_minibuf ()
+{
+ reinit_syms_of_minibuf ();
minibuf_prompt = Qnil;
staticpro (&minibuf_prompt);
Index: src/charset.c
===================================================================
--- src/charset.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -1690,6 +1690,19 @@
}
void
+reinit_charset_once ()
+{
+ int i;
+
+ for (i = 0; i < 256; i++)
+ bytes_by_char_head[i] = 1;
+ bytes_by_char_head[LEADING_CODE_PRIVATE_11] = 3;
+ bytes_by_char_head[LEADING_CODE_PRIVATE_12] = 3;
+ bytes_by_char_head[LEADING_CODE_PRIVATE_21] = 4;
+ bytes_by_char_head[LEADING_CODE_PRIVATE_22] = 4;
+}
+
+void
init_charset_once ()
{
int i, j, k;
@@ -1723,12 +1736,7 @@
for (k = 0; k < 128; k++)
iso_charset_table [i][j][k] = -1;
- for (i = 0; i < 256; i++)
- bytes_by_char_head[i] = 1;
- bytes_by_char_head[LEADING_CODE_PRIVATE_11] = 3;
- bytes_by_char_head[LEADING_CODE_PRIVATE_12] = 3;
- bytes_by_char_head[LEADING_CODE_PRIVATE_21] = 4;
- bytes_by_char_head[LEADING_CODE_PRIVATE_22] = 4;
+ reinit_charset_once ();
for (i = 0; i < 128; i++)
width_by_char_head[i] = 1;
Index: src/xmenu.c
===================================================================
--- src/xmenu.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -2840,10 +2840,19 @@
#endif /* HAVE_MENUS */
void
-syms_of_xmenu ()
+reinit_syms_of_xmenu ()
{
- staticpro (&menu_items);
+#ifdef USE_X_TOOLKIT
+ widget_id_tick = (1<<16);
+ next_menubar_widget_id = 1;
+#endif
menu_items = Qnil;
+}
+
+void
+syms_of_xmenu ()
+{
+ staticpro_nopdump (&menu_items);
Qdebug_on_next_call = intern ("debug-on-next-call");
staticpro (&Qdebug_on_next_call);
@@ -2853,10 +2862,7 @@
The enable predicate for a menu command should check this variable.");
Vmenu_updating_frame = Qnil;
-#ifdef USE_X_TOOLKIT
- widget_id_tick = (1<<16);
- next_menubar_widget_id = 1;
-#endif
+ reinit_syms_of_xmenu ();
defsubr (&Sx_popup_menu);
#ifdef HAVE_MENUS
Index: src/coding.c
===================================================================
--- src/coding.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -6935,25 +6935,10 @@
/*** 9. Post-amble ***/
void
-init_coding_once ()
+reinit_coding_once (int reinit)
{
int i;
- /* Emacs' internal format specific initialize routine. */
- for (i = 0; i <= 0x20; i++)
- emacs_code_class[i] = EMACS_control_code;
- emacs_code_class[0x0A] = EMACS_linefeed_code;
- emacs_code_class[0x0D] = EMACS_carriage_return_code;
- for (i = 0x21 ; i < 0x7F; i++)
- emacs_code_class[i] = EMACS_ascii_code;
- emacs_code_class[0x7F] = EMACS_control_code;
- for (i = 0x80; i < 0xFF; i++)
- emacs_code_class[i] = EMACS_invalid_code;
- emacs_code_class[LEADING_CODE_PRIVATE_11] = EMACS_leading_code_3;
- emacs_code_class[LEADING_CODE_PRIVATE_12] = EMACS_leading_code_3;
- emacs_code_class[LEADING_CODE_PRIVATE_21] = EMACS_leading_code_4;
- emacs_code_class[LEADING_CODE_PRIVATE_22] = EMACS_leading_code_4;
-
/* ISO2022 specific initialize routine. */
for (i = 0; i < 0x20; i++)
iso_code_class[i] = ISO_control_0;
@@ -6974,11 +6959,6 @@
iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
- setup_coding_system (Qnil, &keyboard_coding);
- setup_coding_system (Qnil, &terminal_coding);
- setup_coding_system (Qnil, &safe_terminal_coding);
- setup_coding_system (Qnil, &default_buffer_file_coding);
-
bzero (coding_system_table, sizeof coding_system_table);
bzero (ascii_skip_code, sizeof ascii_skip_code);
@@ -6992,6 +6972,44 @@
#endif
inhibit_pre_post_conversion = 0;
+
+ if (reinit)
+ {
+ Fset_keyboard_coding_system_internal (keyboard_coding.symbol);
+ Fset_terminal_coding_system_internal (terminal_coding.symbol);
+ Fset_safe_terminal_coding_system_internal (safe_terminal_coding.symbol);
+ setup_coding_system (default_buffer_file_coding.symbol,
+ &default_buffer_file_coding);
+ }
+ else
+ {
+ setup_coding_system (Qnil, &keyboard_coding);
+ setup_coding_system (Qnil, &terminal_coding);
+ setup_coding_system (Qnil, &safe_terminal_coding);
+ setup_coding_system (Qnil, &default_buffer_file_coding);
+ }
+}
+
+void
+init_coding_once ()
+{
+ int i;
+ reinit_coding_once (0);
+ /* Emacs' internal format specific initialize routine. */
+ for (i = 0; i <= 0x20; i++)
+ emacs_code_class[i] = EMACS_control_code;
+ emacs_code_class[0x0A] = EMACS_linefeed_code;
+ emacs_code_class[0x0D] = EMACS_carriage_return_code;
+ for (i = 0x21 ; i < 0x7F; i++)
+ emacs_code_class[i] = EMACS_ascii_code;
+ emacs_code_class[0x7F] = EMACS_control_code;
+ for (i = 0x80; i < 0xFF; i++)
+ emacs_code_class[i] = EMACS_invalid_code;
+ emacs_code_class[LEADING_CODE_PRIVATE_11] = EMACS_leading_code_3;
+ emacs_code_class[LEADING_CODE_PRIVATE_12] = EMACS_leading_code_3;
+ emacs_code_class[LEADING_CODE_PRIVATE_21] = EMACS_leading_code_4;
+ emacs_code_class[LEADING_CODE_PRIVATE_22] = EMACS_leading_code_4;
+
}
#ifdef emacs
Index: src/puresize.h
===================================================================
--- src/puresize.h
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -60,14 +60,21 @@
#endif
/* Signal an error if OBJ is pure. */
+#ifdef PDUMP
+#define CHECK_IMPURE(obj)
+#else
#define CHECK_IMPURE(obj) \
{ if (PURE_P (obj)) \
pure_write_error (); }
+#endif
extern void pure_write_error P_ ((void));
/* Define PURE_P. */
+#ifdef PDUMP
+#define PURE_P(obj) 0
+#else
#ifdef VIRT_ADDR_VARIES
/* For machines like APOLLO where text and data can go anywhere
in virtual memory. */
@@ -96,3 +103,4 @@
#endif /* PNTR_COMPARISON_TYPE */
#endif /* VIRT_ADDRESS_VARIES */
+#endif /* PDUMP */
Index: src/keymap.c
===================================================================
--- src/keymap.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -3367,10 +3367,12 @@
meta_map = Fmake_keymap (Qnil);
Fset (intern ("esc-map"), meta_map);
Ffset (intern ("ESC-prefix"), meta_map);
+ staticpro (&meta_map);
control_x_map = Fmake_keymap (Qnil);
Fset (intern ("ctl-x-map"), control_x_map);
Ffset (intern ("Control-X-prefix"), control_x_map);
+ staticpro (&control_x_map);
DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
"List of commands given new key bindings recently.\n\
Index: src/frame.c
===================================================================
--- src/frame.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -2512,7 +2512,7 @@
\n\
This variable is local to the current terminal and cannot be buffer-local.");
- staticpro (&Vframe_list);
+ staticpro_nopdump (&Vframe_list);
defsubr (&Sactive_minibuffer_window);
defsubr (&Sframep);
Index: src/abbrev.c
===================================================================
--- src/abbrev.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -536,6 +536,12 @@
}
void
+reinit_syms_of_abbrev ()
+{
+ current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
+}
+
+void
syms_of_abbrev ()
{
DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
@@ -554,7 +560,7 @@
DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
"The abbrev table of mode-specific abbrevs for Fundamental Mode.");
Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
- current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
+ reinit_syms_of_abbrev ();
buffer_defaults.abbrev_table = Vfundamental_mode_abbrev_table;
DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
Index: src/xselect.c
===================================================================
--- src/xselect.c
+++ tmp.31112.00001 Tue Jan 22 16:15:39 2002
@@ -2323,6 +2323,16 @@
#endif
void
+reinit_syms_of_xselect ()
+{
+ reading_selection_window = 0;
+ reading_which_selection = 0;
+
+ property_change_wait_list = 0;
+ prop_location_identifier = 0;
+}
+
+void
syms_of_xselect ()
{
defsubr (&Sx_get_selection_internal);
@@ -2339,11 +2349,9 @@
reading_selection_reply = Fcons (Qnil, Qnil);
staticpro (&reading_selection_reply);
- reading_selection_window = 0;
- reading_which_selection = 0;
- property_change_wait_list = 0;
- prop_location_identifier = 0;
+ reinit_syms_of_xselect ();
+
property_change_reply = Fcons (Qnil, Qnil);
staticpro (&property_change_reply);
Index: src/search.c
===================================================================
--- src/search.c
+++ tmp.31112.00001 Tue Jan 22 16:15:40 2002
@@ -2876,7 +2876,7 @@
}
void
-syms_of_search ()
+reinit_syms_of_search (int reinit)
{
register int i;
@@ -2886,11 +2886,18 @@
searchbufs[i].buf.buffer = (unsigned char *) malloc (100);
searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
searchbufs[i].regexp = Qnil;
- staticpro (&searchbufs[i].regexp);
+ if (! reinit)
+ staticpro (&searchbufs[i].regexp);
searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
}
searchbuf_head = &searchbufs[0];
+}
+
+void
+syms_of_search ()
+{
+ reinit_syms_of_search (0);
Qsearch_failed = intern ("search-failed");
staticpro (&Qsearch_failed);
Qinvalid_regexp = intern ("invalid-regexp");
Index: src/window.c
===================================================================
--- src/window.c
+++ tmp.31112.00001 Tue Jan 22 16:15:40 2002
@@ -5665,7 +5665,7 @@
}
void
-init_window_once ()
+reinit_window_once (int reinit)
{
struct frame *f = make_terminal_frame ();
XSETFRAME (selected_frame, f);
@@ -5673,8 +5673,16 @@
minibuf_window = f->minibuffer_window;
selected_window = f->selected_window;
last_nonminibuf_frame = f;
+ if (reinit)
+ XFRAME (selected_frame)->face_alist = Fsymbol_value (intern ("global-face-data"));
window_initialized = 1;
+}
+
+void
+init_window_once ()
+{
+ reinit_window_once (0);
}
void
Index: src/insdel.c
===================================================================
--- src/insdel.c
+++ tmp.31112.00001 Tue Jan 22 16:15:40 2002
@@ -2144,11 +2144,17 @@
}
void
+reinit_syms_of_insdel ()
+{
+ combine_after_change_buffer = Qnil;
+}
+
+void
syms_of_insdel ()
{
staticpro (&combine_after_change_list);
combine_after_change_list = Qnil;
- combine_after_change_buffer = Qnil;
+ reinit_syms_of_insdel ();
DEFVAR_BOOL ("check-markers-debug-flag", &check_markers_debug_flag,
"Non-nil means enable debugging checks for invalid marker positions.");
Index: src/alloc.c
===================================================================
--- src/alloc.c
+++ tmp.31112.00001 Tue Jan 22 16:15:40 2002
@@ -401,6 +401,10 @@
int staticidx = 0;
+#define NSTATICSP 20
+Lisp_Object *staticpvec[NSTATICSP] = {0};
+int staticpidx = 0;
+
static POINTER_TYPE *pure_alloc P_ ((size_t, int));
@@ -2434,10 +2438,14 @@
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
+#ifdef PDUMP
+ val = Fmake_vector (len, Qnil);
+#else
if (!NILP (Vpurify_flag))
val = make_pure_vector ((EMACS_INT) nargs);
else
val = Fmake_vector (len, Qnil);
+#endif
if (STRINGP (args[1]) && STRING_MULTIBYTE (args[1]))
/* BYTECODE-STRING must have been produced by Emacs 20.2 or the
@@ -3903,6 +3911,9 @@
(obj)
register Lisp_Object obj;
{
+#ifdef PDUMP
+ return obj;
+#else
if (NILP (Vpurify_flag))
return obj;
@@ -3938,6 +3949,7 @@
error ("Attempt to copy a marker to pure storage");
return obj;
+#endif
}
@@ -3958,6 +3970,15 @@
abort ();
}
+void
+staticpro_nopdump (varaddress)
+ Lisp_Object *varaddress;
+{
+ staticpvec[staticpidx++] = varaddress;
+ if (staticpidx >= NSTATICSP)
+ abort ();
+}
+
struct catchtag
{
Lisp_Object tag;
@@ -4090,6 +4111,8 @@
for (i = 0; i < staticidx; i++)
mark_object (staticvec[i]);
+ for (i = 0; i < staticpidx; i++)
+ mark_object (staticpvec[i]);
#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
|| GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
@@ -4373,8 +4396,10 @@
loop2:
XUNMARK (obj);
+#ifndef PDUMP
if (PURE_POINTER_P (XPNTR (obj)))
return;
+#endif
last_marked[last_marked_index++] = objptr;
if (last_marked_index == LAST_MARKED_SIZE)
@@ -4735,6 +4760,9 @@
abort ();
}
+#ifdef PDUMP
+ unmark_pdumped_objects ();
+#endif
#undef CHECK_LIVE
#undef CHECK_ALLOCATED
#undef CHECK_ALLOCATED_AND_LIVE
@@ -4912,6 +4940,9 @@
/* Sweep: find all structures not marked, and free them. */
+#ifdef PDUMP
+static void unmark_pdumped_objects ();
+#endif
static void
gc_sweep ()
@@ -5350,53 +5381,1750 @@
file, line, msg);
abort ();
}
-
-/* Initialization */
+#ifdef PDUMP
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <sys/file.h>
+#ifdef HAVE_MMAP
+#include <sys/mman.h>
+#endif
+#include <assert.h>
+#include "coding.h"
-void
-init_alloc_once ()
+/* Struct to hold a Lisp_Object data in a hash table. */
+typedef struct pdump_forward_t
{
- /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
- pure_bytes_used = 0;
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
- mem_init ();
- Vdead = make_pure_string ("DEAD", 4, 4, 0);
-#endif
-#ifdef HAVE_SHM
- pure_size = PURESIZE;
-#endif
- all_vectors = 0;
- ignore_warnings = 1;
-#ifdef DOUG_LEA_MALLOC
- mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
- mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
- mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
+ Lisp_Object obj; /* object itself */
+ unsigned long offset; /* Offset from the start of dumped file */
+ long size; /* size of object */
+} pdump_forward_t;
+
+/* Struct to hold DEFVAR_INT and DEFVAR_BOOL'ed variable. */
+typedef struct pdump_forward_pointer_t
+{
+ long address;
+ int value;
+} pdump_forward_pointer_t;
+
+/* Struct to hold doc pointer in Lisp_Subr. */
+typedef struct pdump_forward_subr_doc_t
+{
+ long address;
+ char *value;
+} pdump_forward_subr_doc_t;
+
+/* Header of dumped data. */
+typedef struct pdump_header_t
+{
+ long offset; /* Base offset of Lisp_Object address. */
+ long root_objects_length; /* Number of root objects */
+ long objects_size; /* Size of Lisp_Object data */
+ long pointers_length; /* Length of pointer data */
+ long subr_docs_length; /* Length of pointer to subr doc */
+ long cons_length, misc_length;
+ long small_string_length, large_string_length;
+ long symbol_length, float_length, vector_length;
+#ifdef PDUMP_DEBUG
+ long cons_size, misc_size;
+ long small_string_size, large_string_size;
+ long symbol_size, float_size, vector_size;
#endif
- init_strings ();
- init_cons ();
- init_symbol ();
- init_marker ();
- init_float ();
- init_intervals ();
+} pdump_header_t;
-#ifdef REL_ALLOC
- malloc_hysteresis = 32;
-#else
- malloc_hysteresis = 0;
+/* Struct to hold root object data. */
+typedef struct pdump_root_t
+{
+ long address;
+ long val;
+} pdump_root_t;
+
+#define HASH_SIZE 200009
+#define OBJECT_ARRAY_SIZE 100009
+#define POINTERS_SIZE 200
+#define SUBR_DOC_SIZE 1000
+#define PDUMP_OFFSET 12288
+static pdump_forward_t **pdump_hash;
+
+enum pdump_load_scheme
+{
+ PDUMP_NONE,
+ PDUMP_MMAP,
+ PDUMP_MALLOC
+};
+
+static enum pdump_load_scheme pdump_current_load_scheme;
+
+/* The order of types in this enum and pdump_write_objects must be the same. */
+enum pdump_object_type
+{
+ PDUMP_CONS,
+ PDUMP_MISC,
+ PDUMP_SMALL_STRING,
+ PDUMP_LARGE_STRING,
+ PDUMP_SYMBOL,
+ PDUMP_FLOAT,
+ PDUMP_VECTOR,
+ PDUMP_OBJECT_LIMIT
+};
+
+typedef struct pdump_type_objects_t
+{
+ Lisp_Object objects[OBJECT_ARRAY_SIZE];
+ int index;
+ int size;
+} pdump_type_objects_t;
+
+static pdump_type_objects_t *pdump_lisp_object;
+static pdump_forward_pointer_t *pdump_pointers;
+static int pdump_pointers_index;
+static pdump_forward_subr_doc_t *pdump_subr_doc;
+static int pdump_subr_doc_index;
+
+static pdump_header_t pdump_header;
+static char *pdump_objects_start;
+
+static int pdump_open_dumped_file (char *argv0);
+static void pdump_relocate_objects (long offset);
+
+static int
+pdump_hash_value (Lisp_Object obj)
+{
+ return ((long) obj >> 3) % HASH_SIZE;
+}
+
+static void
+pdump_put_hash (Lisp_Object obj, long offset, long size)
+{
+ pdump_forward_t *f;
+ int idx = pdump_hash_value (obj);
+
+ while ((f = pdump_hash[idx]) != 0)
+ {
+ if (f->obj == obj)
+ return;
+ idx++;
+ if (idx == HASH_SIZE)
+ idx = 0;
+ }
+ f = (pdump_forward_t *) xmalloc (sizeof (*f));
+ f->obj = obj;
+ f->offset = offset;
+ f->size = size;
+ pdump_hash[idx] = f;
+}
+
+static pdump_forward_t *
+pdump_get_hash (Lisp_Object obj)
+{
+ int idx = pdump_hash_value (obj);
+ pdump_forward_t *f;
+
+ while ((f = pdump_hash[idx]) != 0)
+ {
+ if (f->obj == obj)
+ return f;
+
+ idx++;
+ if (idx == HASH_SIZE)
+ idx = 0;
+ }
+ return 0;
+}
+
+static void
+pdump_register_object (Lisp_Object obj, size_t size,
+ enum pdump_object_type type)
+{
+ assert (pdump_get_hash (obj) == 0);
+ pdump_put_hash (obj, pdump_lisp_object[type].size, size);
+ pdump_lisp_object[type].size += size;
+ pdump_lisp_object[type].objects[pdump_lisp_object[type].index++] = obj;
+ assert (pdump_lisp_object[type].index <= OBJECT_ARRAY_SIZE);
+}
+
+static void
+pdump_register_pointer (int *ptr)
+{
+ pdump_forward_pointer_t fp;
+
+ fp.address = (long) ptr;
+ fp.value = *ptr;
+ pdump_pointers[pdump_pointers_index++] = fp;
+ assert (pdump_pointers_index <= POINTERS_SIZE);
+}
+
+static void
+pdump_register_subr_doc (char **ptr)
+{
+ pdump_forward_subr_doc_t fp;
+
+ fp.address = (long) ptr;
+ fp.value = *ptr;
+ pdump_subr_doc[pdump_subr_doc_index++] = fp;
+ assert (pdump_subr_doc_index <= SUBR_DOC_SIZE);
+}
+
+static void
+pdump_add_object (Lisp_Object obj)
+{
+ if (pdump_get_hash (obj))
+ return;
+
+ switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+ {
+ case Lisp_String:
+ {
+ struct Lisp_String *ptr = XSTRING (obj);
+ pdump_register_object (obj, STRING_BYTES (ptr),
+ PDUMP_SMALL_STRING);
+#if 0 /* #### */
+ assert (ptr->intervals == NULL);
#endif
+ break;
+ }
+ case Lisp_Vectorlike:
+ if (BUFFERP (obj) || WINDOWP (obj) || WINDOW_CONFIGURATIONP (obj)
+ || FRAMEP (obj))
+ abort ();
+ else if (SUBRP (obj))
+ {
+ /* This might be done multiple times because SUBR is not
+ registered in hash table. I think it is OK since
+ there's not many defaliases. */
+ pdump_register_subr_doc (&XSUBR (obj)->doc);
+ break;
+ }
+ else if (VECTORP (obj) || COMPILEDP (obj) || CHAR_TABLE_P (obj))
+ {
+ struct Lisp_Vector *ptr = XVECTOR (obj);
+ EMACS_INT size = ptr->size;
+ int i;
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ pdump_register_object (obj, (sizeof (struct Lisp_Vector)
+ + (size - 1) * sizeof (Lisp_Object)),
+ PDUMP_VECTOR);
+ for (i = 0; i < size; i++)
+ pdump_add_object (ptr->contents[i]);
+ break;
+ }
+ else if (BOOL_VECTOR_P (obj))
+ {
+ struct Lisp_Bool_Vector *ptr = XBOOL_VECTOR (obj);
+ pdump_register_object (obj,
+ (sizeof (struct Lisp_Vector)
+ + ptr->size * sizeof (unsigned char)
+ - sizeof (Lisp_Object)),
+ PDUMP_VECTOR);
+ break;
+ }
+ else
+ {
+ abort ();
+ break;
+ }
+ case Lisp_Symbol:
+ {
+ struct Lisp_Symbol *volatile ptr = XSYMBOL (obj);
+ pdump_register_object (obj, sizeof (struct Lisp_Symbol), PDUMP_SYMBOL);
+ pdump_add_object (ptr->value);
+ pdump_add_object (ptr->function);
+ pdump_add_object (ptr->plist);
+ pdump_add_object (ptr->obarray);
+ {
+ Lisp_Object tmp_obj;
+ XSETSTRING (tmp_obj, ptr->name);
+ pdump_add_object (tmp_obj);
+ }
+ if (ptr->next)
+ {
+ Lisp_Object tmp_obj;
+ XSETSYMBOL (tmp_obj, ptr->next);
+ pdump_add_object (tmp_obj);
+ }
+ break;
+ }
+ case Lisp_Misc:
+ switch (XMISCTYPE (obj))
+ {
+ case Lisp_Misc_Marker:
+ {
+ struct Lisp_Marker *ptr = XMARKER (obj);
+ assert (ptr->buffer == NULL);
+ pdump_register_object (obj, sizeof (struct Lisp_Marker),
+ PDUMP_MISC);
+ break;
+ }
+ case Lisp_Misc_Buffer_Local_Value:
+ case Lisp_Misc_Some_Buffer_Local_Value:
+ {
+ struct Lisp_Buffer_Local_Value *ptr = XBUFFER_LOCAL_VALUE (obj);
+ pdump_register_object (obj,
+ sizeof (struct Lisp_Buffer_Local_Value),
+ PDUMP_MISC);
+ pdump_add_object (ptr->realvalue);
+ /* #### Should flush local variable first */
+ pdump_add_object (ptr->cdr);
+ break;
+ }
+ case Lisp_Misc_Intfwd:
+ {
+ struct Lisp_Intfwd *ptr = XINTFWD (obj);
+ pdump_register_object (obj, sizeof (struct Lisp_Intfwd),
+ PDUMP_MISC);
+ pdump_register_pointer (ptr->intvar);
+ break;
+ }
+ case Lisp_Misc_Boolfwd:
+ {
+ struct Lisp_Boolfwd *ptr = XBOOLFWD (obj);
+ pdump_register_object (obj, sizeof (struct Lisp_Boolfwd),
+ PDUMP_MISC);
+ pdump_register_pointer (ptr->boolvar);
+ break;
+ }
+ case Lisp_Misc_Objfwd:
+ {
+ pdump_register_object (obj, sizeof (struct Lisp_Objfwd),
+ PDUMP_MISC);
+ break;
+ }
+ case Lisp_Misc_Buffer_Objfwd:
+ {
+ pdump_register_object (obj, sizeof (struct Lisp_Buffer_Objfwd),
+ PDUMP_MISC);
+ break;
+ }
+ case Lisp_Misc_Kboard_Objfwd:
+ {
+ pdump_register_object (obj, sizeof (struct Lisp_Kboard_Objfwd),
+ PDUMP_MISC);
+ break;
+ }
+ case Lisp_Misc_Overlay:
+ {
+ struct Lisp_Overlay *ptr = XOVERLAY (obj);
+ pdump_register_object (obj, sizeof (struct Lisp_Overlay),
+ PDUMP_MISC);
+ pdump_add_object (ptr->start);
+ pdump_add_object (ptr->end);
+ pdump_add_object (ptr->plist);
+ break;
+ }
+ default:
+ abort ();
+ }
+ break;
+ case Lisp_Cons:
+ {
+ struct Lisp_Cons *ptr = XCONS (obj);
+ pdump_register_object (obj, sizeof (struct Lisp_Cons), PDUMP_CONS);
+ pdump_add_object (ptr->car);
+ pdump_add_object (ptr->cdr);
+ break;
+ }
+ case Lisp_Float:
+ {
+ pdump_register_object (obj, sizeof (struct Lisp_Float), PDUMP_FLOAT);
+ break;
+ }
+ case Lisp_Int:
+ break;
+ default:
+ abort ();
+ }
+}
- spare_memory = (char *) malloc (SPARE_MEMORY);
+static enum pdump_object_type
+pdump_object_to_enum (Lisp_Object obj)
+{
+ if (CONSP (obj))
+ return PDUMP_CONS;
+ else if (SYMBOLP (obj))
+ return PDUMP_SYMBOL;
+ else if (MISCP (obj))
+ return PDUMP_MISC;
+ else if (STRINGP (obj))
+ {
+ struct Lisp_String *ptr = XSTRING (obj);
+ if (ptr->size & MARKBIT)
+ return PDUMP_LARGE_STRING;
+ else
+ return PDUMP_SMALL_STRING;
+ }
+ else if (FLOATP (obj))
+ return PDUMP_FLOAT;
+ else if (VECTORLIKEP (obj))
+ return PDUMP_VECTOR;
+ else
+ abort ();
+}
- ignore_warnings = 0;
- gcprolist = 0;
- byte_stack_list = 0;
- staticidx = 0;
- consing_since_gc = 0;
- gc_cons_threshold = 100000 * sizeof (Lisp_Object);
-#ifdef VIRT_ADDR_VARIES
- malloc_sbrk_unused = 1<<22; /* A large number */
- malloc_sbrk_used = 100000; /* as reasonable as any number */
-#endif /* VIRT_ADDR_VARIES */
+static Lisp_Object
+pdump_forward_object (Lisp_Object obj)
+{
+ pdump_forward_t *f;
+ Lisp_Object new_obj;
+ unsigned long addr;
+ int i;
+ enum pdump_object_type type;
+
+ if (INTEGERP (obj) || SUBRP (obj))
+ return obj;
+ type = pdump_object_to_enum (obj);
+ f = pdump_get_hash (obj);
+ assert (f);
+ addr = f->offset + PDUMP_OFFSET + sizeof (pdump_header_t);
+ for (i = 0; i < type; i++)
+ addr += pdump_lisp_object[i].size;
+ XSET (new_obj, XTYPE (obj), addr);
+ return new_obj;
+}
+
+static long
+pdump_size (Lisp_Object obj)
+{
+ pdump_forward_t *f = pdump_get_hash (obj);
+ assert (f);
+ return f->size;
+}
+
+static void
+pdump_write_objects (FILE *pdump_stream)
+{
+ int i;
+ for (i = 0; i < pdump_lisp_object[PDUMP_CONS].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_CONS].objects[i];
+ struct Lisp_Cons *ptr = XCONS (obj);
+ struct Lisp_Cons new;
+ long size = pdump_size (obj);
+ memcpy (&new, ptr, size);
+ new.car = pdump_forward_object (ptr->car);
+ new.cdr = pdump_forward_object (ptr->cdr);
+ fwrite (&new, size, 1, pdump_stream);
+ }
+ for (i = 0; i < pdump_lisp_object[PDUMP_MISC].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_MISC].objects[i];
+ switch (XMISCTYPE (obj))
+ {
+ case Lisp_Misc_Marker:
+ {
+ struct Lisp_Marker *ptr = XMARKER (obj);
+ fwrite (ptr, pdump_size (obj), 1, pdump_stream);
+ break;
+ }
+ case Lisp_Misc_Buffer_Local_Value:
+ case Lisp_Misc_Some_Buffer_Local_Value:
+ {
+ struct Lisp_Buffer_Local_Value *ptr = XBUFFER_LOCAL_VALUE (obj);
+ struct Lisp_Buffer_Local_Value new;
+ long size = pdump_size (obj);
+ memcpy (&new, ptr, size);
+ new.realvalue = pdump_forward_object (ptr->realvalue);
+ /* #### Hack */
+ new.buffer = pdump_forward_object (Qnil);
+ new.frame = pdump_forward_object (Qnil);
+ new.cdr = pdump_forward_object (ptr->cdr);
+ fwrite (&new, size, 1, pdump_stream);
+ break;
+ }
+ case Lisp_Misc_Intfwd:
+ case Lisp_Misc_Boolfwd:
+ case Lisp_Misc_Objfwd:
+ case Lisp_Misc_Buffer_Objfwd:
+ case Lisp_Misc_Kboard_Objfwd:
+ {
+ fwrite ((void *) XPNTR (obj), pdump_size (obj), 1, pdump_stream);
+ break;
+ }
+ case Lisp_Misc_Overlay:
+ {
+ struct Lisp_Overlay *ptr = XOVERLAY (obj);
+ struct Lisp_Overlay new;
+ long size = pdump_size (obj);
+ memcpy (&new, ptr, size);
+ new.start = pdump_forward_object (ptr->start);
+ new.end = pdump_forward_object (ptr->end);
+ new.plist = pdump_forward_object (ptr->plist);
+ fwrite (&new, size, 1, pdump_stream);
+ break;
+ }
+ default:
+ abort ();
+ }
+ }
+ for (i = 0; i < pdump_lisp_object[PDUMP_SMALL_STRING].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_SMALL_STRING].objects[i];
+ struct Lisp_String *ptr = XSTRING (obj);
+ fwrite (ptr, pdump_size (obj), 1, pdump_stream);
+ }
+ for (i = 0; i < pdump_lisp_object[PDUMP_LARGE_STRING].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_LARGE_STRING].objects[i];
+ struct Lisp_String *ptr = XSTRING (obj);
+ fwrite (ptr, pdump_size (obj), 1, pdump_stream);
+ }
+ for (i = 0; i < pdump_lisp_object[PDUMP_SYMBOL].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_SYMBOL].objects[i];
+ struct Lisp_Symbol *volatile ptr = XSYMBOL (obj);
+ struct Lisp_Symbol new;
+ long size = pdump_size (obj);
+ memcpy (&new, ptr, size);
+ new.value = pdump_forward_object (ptr->value);
+ new.function = pdump_forward_object (ptr->function);
+ new.plist = pdump_forward_object (ptr->plist);
+ new.obarray = pdump_forward_object (ptr->obarray);
+ {
+ Lisp_Object tmp_obj;
+ XSETSTRING (tmp_obj, ptr->name);
+ new.name = XSTRING (pdump_forward_object (tmp_obj));
+ }
+ if (ptr->next)
+ {
+ Lisp_Object tmp_obj;
+ XSETSYMBOL (tmp_obj, ptr->next);
+ new.next = XSYMBOL (pdump_forward_object (tmp_obj));
+ }
+ fwrite (&new, size, 1, pdump_stream);
+ }
+ for (i = 0; i < pdump_lisp_object[PDUMP_FLOAT].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_FLOAT].objects[i];
+ fwrite (XFLOAT (obj), sizeof (struct Lisp_Float), 1, pdump_stream);
+ }
+ for (i = 0; i < pdump_lisp_object[PDUMP_VECTOR].index; i++)
+ {
+ Lisp_Object obj = pdump_lisp_object[PDUMP_VECTOR].objects[i];
+ if (BUFFERP (obj) || WINDOWP (obj) || WINDOW_CONFIGURATIONP (obj)
+ || FRAMEP (obj) || SUBRP (obj))
+ {
+ abort ();
+ }
+ else if (VECTORP (obj) || COMPILEDP (obj) || CHAR_TABLE_P (obj))
+ {
+ struct Lisp_Vector *ptr = XVECTOR (obj);
+ int j;
+ long total_size = pdump_size (obj);
+ struct Lisp_Vector *new = (struct Lisp_Vector *) xmalloc (total_size);
+ EMACS_INT size = ptr->size;
+
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ memcpy (new, ptr, total_size);
+ for (j = 0; j < size; j++)
+ new->contents[j] = pdump_forward_object (new->contents[j]);
+ fwrite (new, total_size, 1, pdump_stream);
+ xfree (new);
+ }
+ else if (BOOL_VECTOR_P (obj))
+ {
+ struct Lisp_Bool_Vector *ptr = XBOOL_VECTOR (obj);
+ long total_size = pdump_size (obj);
+ struct Lisp_Bool_Vector *new
+ = (struct Lisp_Bool_Vector *) xmalloc (total_size);
+
+ memcpy (new, ptr, total_size);
+ fwrite (new, total_size, 1, pdump_stream);
+ xfree (new);
+ }
+ else
+ abort ();
+ }
+}
+
+static void
+pdump_add_special_buffers ()
+{
+ int i, offset;
+ struct buffer *buffers[] = {&buffer_defaults,
+ &buffer_local_symbols,
+ NULL};
+ for (i = 0; buffers[i]; i++)
+ {
+ for (offset = (char *)&buffers[i]->undo_list - (char *)buffers[i];
+ offset < sizeof (struct buffer);
+ offset += (sizeof (Lisp_Object)))
+ pdump_add_object (*(Lisp_Object *)(offset + (char *)buffers[i]));
+ }
+}
+
+static void
+pdump_write_special_buffers (FILE *pdump_stream)
+{
+ int i, offset;
+ struct buffer *buffers[] = {&buffer_defaults,
+ &buffer_local_symbols,
+ &buffer_local_types,
+ NULL};
+
+ /* This one is special because all the fields are int, which are
+ immediate values. */
+ fwrite (&buffer_local_flags.undo_list,
+ (sizeof (struct buffer) + (char *)&buffer_local_flags
+ - (char *)&buffer_local_flags.undo_list),
+ 1, pdump_stream);
+
+ for (i = 0; buffers[i]; i++)
+ for (offset = (char *)&buffers[i]->undo_list - (char *)buffers[i];
+ offset < sizeof (struct buffer);
+ offset += (sizeof (Lisp_Object)))
+ {
+ Lisp_Object new;
+ new = pdump_forward_object (*(Lisp_Object *)(offset
+ + (char *)buffers[i]));
+ fwrite (&new, sizeof (Lisp_Object), 1, pdump_stream);
+ }
+}
+
+static void
+pdump_write_coding_symbols (FILE *pdump_stream)
+{
+ struct coding_system *coding_systems[] = {&terminal_coding,
+ &safe_terminal_coding,
+ &keyboard_coding,
+ &default_buffer_file_coding,
+ NULL};
+ int i;
+ for (i = 0; coding_systems[i]; i++)
+ {
+ Lisp_Object symbol = pdump_forward_object (coding_systems[i]->symbol);
+ fwrite (&symbol, sizeof (symbol), 1, pdump_stream);
+ }
+}
+
+/* These two are DEFVAR'ed. */
+extern Lisp_Object Vterminal_frame;
+
+extern int next_lface_id;
+
+void
+pdump ()
+{
+ int i;
+ pdump_header_t header;
+ FILE *pdump_stream;
+ Lisp_Object saved_terminal_frame;
+ saved_terminal_frame = Vterminal_frame;
+ Vterminal_frame = Qnil;
+
+ pdump_hash = (pdump_forward_t **) xmalloc (sizeof (*pdump_hash) * HASH_SIZE);
+ bzero (pdump_hash, sizeof (*pdump_hash) * HASH_SIZE);
+ pdump_lisp_object = (pdump_type_objects_t *)
+ xmalloc (sizeof (*pdump_lisp_object) * PDUMP_OBJECT_LIMIT);
+ pdump_pointers = (pdump_forward_pointer_t *)
+ xmalloc (sizeof (*pdump_pointers) * POINTERS_SIZE);
+ pdump_subr_doc = (pdump_forward_subr_doc_t *)
+ xmalloc (sizeof (*pdump_subr_doc) * SUBR_DOC_SIZE);
+
+ pdump_stream = fopen ("emacs.dmp", "w");
+
+ for (i = 0; i < staticidx; i++)
+ pdump_add_object (*staticvec[i]);
+ pdump_add_special_buffers ();
+
+ header.offset = PDUMP_OFFSET;
+ header.root_objects_length = staticidx;
+ header.objects_size = 0;
+ for (i = 0; i < PDUMP_OBJECT_LIMIT; i++)
+ header.objects_size += pdump_lisp_object[i].size;
+ header.pointers_length = pdump_pointers_index;
+ header.subr_docs_length = pdump_subr_doc_index;
+ {
+ long *addr = &header.cons_length;
+ for (i = 0;
+ i < PDUMP_OBJECT_LIMIT;
+ i++)
+ {
+ addr[i] = pdump_lisp_object[i].index;
+#ifdef PDUMP_DEBUG
+ addr[i + PDUMP_OBJECT_LIMIT] = pdump_lisp_object[i].size;
+#endif
+ }
+ }
+ fwrite (&header, sizeof (header), 1, pdump_stream);
+
+ pdump_write_objects (pdump_stream);
+ for (i = 0; i < staticidx; i++)
+ {
+ pdump_root_t root;
+ root.address = (long) staticvec[i];
+ root.val = pdump_forward_object (*staticvec[i]);
+ fwrite (&root, sizeof (root), 1, pdump_stream);
+ }
+
+ fwrite (&staticpidx, sizeof (staticpidx), 1, pdump_stream);
+ fwrite (staticpvec, sizeof (staticpvec[0]), staticpidx, pdump_stream);
+ fwrite (pdump_pointers, sizeof (pdump_pointers[0]),
+ pdump_pointers_index, pdump_stream);
+ fwrite (pdump_subr_doc, sizeof (*pdump_subr_doc),
+ pdump_subr_doc_index, pdump_stream);
+ pdump_write_special_buffers (pdump_stream);
+ fwrite (width_by_char_head, sizeof (*width_by_char_head), 256, pdump_stream);
+ {
+ int j, k;
+ for (i = 0; i < 2; i++)
+ for (j = 0; j < 2; j++)
+ for (k = 0; k < 128; k++)
+ fwrite (&iso_charset_table[i][j][k], sizeof (int), 1, pdump_stream);
+ }
+ fwrite (emacs_code_class, sizeof (int), 256, pdump_stream);
+ pdump_write_coding_symbols (pdump_stream);
+ fwrite (&next_lface_id, sizeof (next_lface_id), 1, pdump_stream);
+
+ fclose (pdump_stream);
+ Vterminal_frame = saved_terminal_frame;
+ xfree (pdump_subr_doc);
+ xfree (pdump_pointers);
+ xfree (pdump_lisp_object);
+ xfree (pdump_hash);
+}
+
+#define PDUMP_RELOCATE(obj, offset) \
+do \
+{ \
+ char *p_r_ptr = (char *) ((unsigned long) XPNTR (obj) + offset); \
+ if (! INTEGERP (obj) \
+ && pdump_objects_start <= p_r_ptr \
+ && p_r_ptr < pdump_objects_start + pdump_header.objects_size) \
+ XSET ((obj), XTYPE (obj), p_r_ptr); \
+} \
+while (0)
+
+static void
+pdump_read_coding_symbols (int fd, long offset)
+{
+ struct coding_system *coding_systems[] = {&terminal_coding,
+ &safe_terminal_coding,
+ &keyboard_coding,
+ &default_buffer_file_coding,
+ NULL};
+ int i;
+ for (i = 0; coding_systems[i]; i++)
+ {
+ read (fd, &coding_systems[i]->symbol, sizeof (Lisp_Object));
+ PDUMP_RELOCATE (coding_systems[i]->symbol, offset);
+ }
+}
+
+int
+pdump_load (char *argv0)
+{
+ int i;
+ int fd;
+ char *ret;
+ long offset;
+
+ if ((fd = pdump_open_dumped_file (argv0)) < 0)
+ return 1;
+ read (fd, &pdump_header, sizeof (pdump_header));
+ lseek (fd, 0, SEEK_SET);
+#ifdef HAVE_MMAP
+ ret = (char *)mmap ((void *)pdump_header.offset, pdump_header.objects_size
+ + sizeof (pdump_header_t),
+ PROT_READ|PROT_WRITE, MAP_PRIVATE,
+ fd, 0);
+ pdump_current_load_scheme = PDUMP_MMAP;
+ if ((long) ret == -1)
+ return 1;
+ else if ((unsigned long)ret & ~VALMASK)
+#endif /* HAVE_MMAP */
+ {
+#ifdef HAVE_MMAP
+ munmap (ret, pdump_header.objects_size + sizeof (pdump_header_t));
+#endif
+#ifdef DOUG_LEA_MALLOC
+ /* Prevent mmap'ing the chunk. */
+ mallopt (M_MMAP_MAX, 0);
+#endif
+ ret = (char *) xmalloc (pdump_header.objects_size + sizeof (pdump_header_t));
+#ifdef DOUG_LEA_MALLOC
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+#endif
+ pdump_current_load_scheme = PDUMP_MALLOC;
+ if ((unsigned long)ret & ~VALMASK)
+ {
+ fprintf (stderr, "emacs: malloc returned high address\n");
+ return 1;
+ }
+ read (fd, ret, pdump_header.objects_size + sizeof (pdump_header_t));
+ }
+ pdump_objects_start = ret + sizeof (pdump_header_t);
+ offset = (long) ret - pdump_header.offset;
+ lseek (fd, pdump_header.objects_size + sizeof (pdump_header_t), SEEK_SET);
+ for (staticidx = 0; staticidx < pdump_header.root_objects_length; staticidx++)
+ {
+ pdump_root_t root;
+ read (fd, &root, sizeof (root));
+ staticvec[staticidx] = (Lisp_Object *)root.address;
+ if (offset != 0)
+ PDUMP_RELOCATE (root.val, offset);
+ *staticvec[staticidx] = root.val;
+ }
+ if (offset != 0)
+ pdump_relocate_objects (offset);
+ read (fd, &staticpidx, sizeof (staticpidx));
+ read (fd, &staticpvec, sizeof (staticpvec[0]) * staticpidx);
+ for (i = 0; i < pdump_header.pointers_length; i++)
+ {
+ pdump_forward_pointer_t fp;
+ read (fd, &fp, sizeof (fp));
+ *(int *)fp.address = fp.value;
+ }
+ for (i = 0; i < pdump_header.subr_docs_length; i++)
+ {
+ pdump_forward_subr_doc_t fsp;
+ read (fd, &fsp, sizeof (fsp));
+ *(char **)fsp.address = fsp.value;
+ }
+ read (fd, &buffer_local_flags.undo_list,
+ (sizeof (struct buffer) + (char *)&buffer_local_flags
+ - (char *)&buffer_local_flags.undo_list));
+ read (fd, &buffer_defaults.undo_list,
+ (sizeof (struct buffer) + (char *)&buffer_defaults
+ - (char *)&buffer_defaults.undo_list));
+ read (fd, &buffer_local_symbols.undo_list,
+ (sizeof (struct buffer) + (char *)&buffer_local_symbols
+ - (char *)&buffer_local_symbols.undo_list));
+ read (fd, &buffer_local_types.undo_list,
+ (sizeof (struct buffer) + (char *)&buffer_local_types
+ - (char *)&buffer_local_types.undo_list));
+ read (fd, width_by_char_head, sizeof (*width_by_char_head) * 256);
+ if (offset != 0)
+ {
+ int i, buff_offset;
+ struct buffer *buffers[] = {&buffer_defaults,
+ &buffer_local_symbols,
+ &buffer_local_types,
+ NULL};
+ for (i = 0; buffers[i]; i++)
+ for (buff_offset = (char *)&buffers[i]->undo_list - (char *)buffers[i];
+ buff_offset < sizeof (struct buffer);
+ buff_offset += (sizeof (Lisp_Object)))
+ PDUMP_RELOCATE (*(Lisp_Object *)(buff_offset + (char *)buffers[i]),
+ offset);
+ }
+ {
+ int j, k;
+ for (i = 0; i < 2; i++)
+ for (j = 0; j < 2; j++)
+ for (k = 0; k < 128; k++)
+ read (fd, &iso_charset_table[i][j][k], sizeof (int));
+ }
+ read (fd, &emacs_code_class, sizeof (int) * 256);
+ pdump_read_coding_symbols (fd, offset);
+ read (fd, &next_lface_id, sizeof (next_lface_id));
+
+ close (fd);
+
+ return 0;
+}
+
+void
+pdump_free ()
+{
+ switch (pdump_current_load_scheme)
+ {
+ case PDUMP_MMAP:
+ {
+#ifdef HAVE_MMAP
+ munmap (pdump_objects_start - sizeof (pdump_header_t),
+ pdump_header.objects_size + sizeof (pdump_header_t));
+#else
+ abort ();
+#endif
+ break;
+ }
+ case PDUMP_MALLOC:
+ {
+ xfree (pdump_objects_start - sizeof (pdump_header_t));
+ break;
+ }
+ default:
+ ;
+ }
+}
+
+static void
+unmark_pdumped_objects ()
+{
+ char *obj_ptr = pdump_objects_start;
+ int i;
+ for (i = 0; i < pdump_header.cons_length; i++)
+ {
+ struct Lisp_Cons *ptr = (struct Lisp_Cons *) obj_ptr;
+ if (XMARKBIT (ptr->car))
+ XUNMARK (ptr->car);
+ obj_ptr += sizeof (struct Lisp_Cons);
+ }
+ for (i = 0; i < pdump_header.misc_length; i++)
+ {
+ switch (((union Lisp_Misc *)obj_ptr)->u_marker.type)
+ {
+ case Lisp_Misc_Marker:
+ {
+ struct Lisp_Marker *ptr = (struct Lisp_Marker *)obj_ptr;
+ if (XMARKBIT (ptr->chain))
+ XUNMARK (ptr->chain);
+ obj_ptr += sizeof (struct Lisp_Marker);
+ break;
+ }
+ case Lisp_Misc_Buffer_Local_Value:
+ case Lisp_Misc_Some_Buffer_Local_Value:
+ {
+ struct Lisp_Buffer_Local_Value *ptr =
+ (struct Lisp_Buffer_Local_Value *)obj_ptr;
+ if (XMARKBIT (ptr->realvalue))
+ XUNMARK (ptr->realvalue);
+ obj_ptr += sizeof (struct Lisp_Buffer_Local_Value);
+ break;
+ }
+ case Lisp_Misc_Intfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Intfwd);
+ break;
+ }
+ case Lisp_Misc_Boolfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Boolfwd);
+ break;
+ }
+ case Lisp_Misc_Objfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Buffer_Objfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Buffer_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Kboard_Objfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Kboard_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Overlay:
+ {
+ struct Lisp_Overlay *ptr = (struct Lisp_Overlay *)obj_ptr;
+ if (XMARKBIT (ptr->plist))
+ XUNMARK (ptr->plist);
+ obj_ptr += sizeof (struct Lisp_Overlay);
+ break;
+ }
+ default:
+ abort ();
+ }
+ }
+ for (i = 0; i < pdump_header.small_string_length; i++)
+ {
+ struct Lisp_String *ptr = (struct Lisp_String *)obj_ptr;
+ EMACS_INT size = ptr->size;
+ EMACS_INT size_byte = ptr->size_byte;
+ if (STRING_MARKED_P (ptr))
+ {
+ UNMARK_STRING (ptr);
+ if (size_byte < 0)
+ size_byte = size;
+ size = ptr->size;
+ ptr->size = size;
+ if (! NULL_INTERVAL_P (ptr->intervals))
+ UNMARK_BALANCE_INTERVALS (ptr->intervals);
+ }
+ else if (size_byte < 0)
+ size_byte = size;
+ obj_ptr += STRING_BYTES (ptr);
+ }
+ for (i = 0; i < pdump_header.large_string_length; i++)
+ {
+ struct Lisp_String *ptr = (struct Lisp_String *)obj_ptr;
+ if (ptr->size & ARRAY_MARK_FLAG)
+ ptr->size &= ~ARRAY_MARK_FLAG & ~MARKBIT;
+ obj_ptr += ptr->size;
+ }
+ for (i = 0; i < pdump_header.symbol_length; i++)
+ {
+ struct Lisp_Symbol *ptr = (struct Lisp_Symbol *)obj_ptr;
+ if (XMARKBIT (ptr->plist))
+ XUNMARK (ptr->plist);
+ ptr->name = XSTRING (*(Lisp_Object *)&ptr->name);
+ obj_ptr += sizeof (struct Lisp_Symbol);
+ }
+ for (i = 0; i < pdump_header.float_length; i++)
+ {
+ struct Lisp_Float *ptr = (struct Lisp_Float *)obj_ptr;
+ if (XMARKBIT (ptr->type))
+ XUNMARK (ptr->type);
+ obj_ptr += sizeof (struct Lisp_Float);
+ }
+ for (i = 0; i < pdump_header.vector_length; i++)
+ {
+ struct Lisp_Vector *ptr = (struct Lisp_Vector *)obj_ptr;
+ EMACS_INT size;
+ if (ptr->size & ARRAY_MARK_FLAG)
+ ptr->size &= ~ARRAY_MARK_FLAG;
+ size = ptr->size;
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ if ((((struct Lisp_Vector *)obj_ptr)->size
+ & (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+ == (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+ {
+ struct Lisp_Bool_Vector *ptr = (struct Lisp_Bool_Vector *) obj_ptr;
+ obj_ptr += (sizeof (struct Lisp_Vector)
+ + ptr->size * sizeof (unsigned char)
+ - sizeof (Lisp_Object));
+ }
+ else
+ obj_ptr += (sizeof (struct Lisp_Vector)
+ + (size - 1) * sizeof (Lisp_Object));
+ }
+}
+
+static void
+pdump_relocate_objects (long offset)
+{
+ char *obj_ptr = pdump_objects_start;
+ int i;
+ for (i = 0; i < pdump_header.cons_length; i++)
+ {
+ struct Lisp_Cons *ptr = (struct Lisp_Cons *) obj_ptr;
+ PDUMP_RELOCATE (ptr->car, offset);
+ PDUMP_RELOCATE (ptr->cdr, offset);
+ obj_ptr += sizeof (struct Lisp_Cons);
+ }
+ for (i = 0; i < pdump_header.misc_length; i++)
+ {
+ switch (((union Lisp_Misc *)obj_ptr)->u_marker.type)
+ {
+ case Lisp_Misc_Marker:
+ {
+ obj_ptr += sizeof (struct Lisp_Marker);
+ break;
+ }
+ case Lisp_Misc_Buffer_Local_Value:
+ case Lisp_Misc_Some_Buffer_Local_Value:
+ {
+ struct Lisp_Buffer_Local_Value *ptr =
+ (struct Lisp_Buffer_Local_Value *)obj_ptr;
+ PDUMP_RELOCATE (ptr->buffer, offset);
+ PDUMP_RELOCATE (ptr->frame, offset);
+ PDUMP_RELOCATE (ptr->realvalue, offset);
+ PDUMP_RELOCATE (ptr->cdr, offset);
+ obj_ptr += sizeof (struct Lisp_Buffer_Local_Value);
+ break;
+ }
+ case Lisp_Misc_Intfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Intfwd);
+ break;
+ }
+ case Lisp_Misc_Boolfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Boolfwd);
+ break;
+ }
+ case Lisp_Misc_Objfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Buffer_Objfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Buffer_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Kboard_Objfwd:
+ {
+ obj_ptr += sizeof (struct Lisp_Kboard_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Overlay:
+ {
+ struct Lisp_Overlay *ptr = (struct Lisp_Overlay *)obj_ptr;
+ PDUMP_RELOCATE (ptr->start, offset);
+ PDUMP_RELOCATE (ptr->end, offset);
+ PDUMP_RELOCATE (ptr->plist, offset);
+ obj_ptr += sizeof (struct Lisp_Overlay);
+ break;
+ }
+ default:
+ abort ();
+ }
+ }
+ for (i = 0; i < pdump_header.small_string_length; i++)
+ {
+ struct Lisp_String *ptr = (struct Lisp_String *)obj_ptr;
+ EMACS_INT size_byte = ptr->size_byte;
+ if (size_byte < 0)
+ size_byte = ptr->size;
+ obj_ptr += STRING_BYTES (ptr);
+ }
+ for (i = 0; i < pdump_header.large_string_length; i++)
+ {
+ struct Lisp_String *ptr = (struct Lisp_String *)obj_ptr;
+ obj_ptr += ptr->size;
+ }
+ for (i = 0; i < pdump_header.symbol_length; i++)
+ {
+ struct Lisp_Symbol *ptr = (struct Lisp_Symbol *)obj_ptr;
+ PDUMP_RELOCATE (ptr->value, offset);
+ PDUMP_RELOCATE (ptr->function, offset);
+ PDUMP_RELOCATE (ptr->plist, offset);
+ PDUMP_RELOCATE (ptr->obarray, offset);
+ ptr->name = (struct Lisp_String *) ((char *)ptr->name + offset);
+ if (ptr->next)
+ ptr->next = (struct Lisp_Symbol *) ((char *)ptr->next + offset);
+ obj_ptr += sizeof (struct Lisp_Symbol);
+ }
+ for (i = 0; i < pdump_header.float_length; i++)
+ obj_ptr += sizeof (struct Lisp_Float);
+ for (i = 0; i < pdump_header.vector_length; i++)
+ {
+ if ((((struct Lisp_Vector *)obj_ptr)->size
+ & (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+ == (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+ {
+ struct Lisp_Bool_Vector *ptr = (struct Lisp_Bool_Vector *) obj_ptr;
+ obj_ptr += (sizeof (struct Lisp_Vector)
+ + ptr->size * sizeof (unsigned char)
+ - sizeof (Lisp_Object));
+ }
+ else
+ {
+ struct Lisp_Vector *ptr = (struct Lisp_Vector *)obj_ptr;
+ EMACS_INT size = ptr->size;
+ int i;
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ for (i = 0; i < size; i++)
+ PDUMP_RELOCATE (ptr->contents[i], offset);
+
+ obj_ptr += (sizeof (struct Lisp_Vector)
+ + (size - 1) * sizeof (Lisp_Object));
+ }
+ }
+}
+
+#ifdef PDUMP_DEBUG
+static int
+dumped_p (char *ptr)
+{
+ return (pdump_objects_start <= ptr
+ && ptr < pdump_objects_start + pdump_header.objects_size);
+}
+
+static char *
+pdump_object_start_address (enum pdump_object_type type)
+{
+ int i;
+ long *addr = &pdump_header.cons_size;
+ long ret = 0;
+ for (i = 0; i < type; i++)
+ ret += addr[i];
+ return (char *)(ret + pdump_objects_start);
+}
+
+static void
+pdump_check_object_validity (Lisp_Object obj)
+{
+ char *ptr = (char *)XPNTR (obj);
+ switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+ {
+ case Lisp_String:
+ {
+ if (dumped_p (ptr))
+ {
+ int found = 0;
+ if (((struct Lisp_String *)ptr)->size & MARKBIT)
+ {
+ /* Large string */
+ char *large_string_start
+ = pdump_object_start_address (PDUMP_LARGE_STRING);
+ char *string_ptr;
+ assert (ptr < (large_string_start
+ + pdump_header.large_string_size));
+ for (string_ptr = large_string_start;
+ string_ptr <= ptr;
+ )
+ {
+ EMACS_INT size_byte;
+
+ if (string_ptr == ptr)
+ {
+ found = 1;
+ break;
+ }
+
+ size_byte = ((struct Lisp_String *)string_ptr)->size_byte;
+ if (size_byte < 0)
+ size_byte = ((struct Lisp_String *)string_ptr)->size;
+ string_ptr += STRING_FULLSIZE (size_byte);
+ }
+ }
+ else
+ {
+ /* Small string */
+ char *small_string_start
+ = pdump_object_start_address (PDUMP_SMALL_STRING);
+ char *string_ptr;
+ assert (ptr < (small_string_start
+ + pdump_header.small_string_size));
+ for (string_ptr = small_string_start;
+ string_ptr <= ptr;
+ )
+ {
+ EMACS_INT size_byte;
+
+ if (string_ptr == ptr)
+ {
+ found = 1;
+ break;
+ }
+
+ size_byte = ((struct Lisp_String *)string_ptr)->size_byte;
+ if (size_byte < 0)
+ size_byte = ((struct Lisp_String *)string_ptr)->size;
+ string_ptr += STRING_FULLSIZE (size_byte);
+ }
+ }
+ assert (found);
+ }
+ else
+ {
+ int found = 0;
+ if (((struct Lisp_String *)ptr)->size & MARKBIT)
+ {
+ /* Large String */
+ struct string_block *sb;
+ for (sb = large_string_blocks; sb; sb = sb->next)
+ {
+ struct Lisp_String *str
+ = (struct Lisp_String *) &sb->chars[0];
+ if ((char *)str == ptr)
+ {
+ found = 1;
+ break;
+ }
+ }
+ }
+ else
+ {
+ /* Small String */
+ struct string_block *sb;
+ for (sb = first_string_block; sb && !found; sb = sb->next)
+ {
+ int pos;
+ for (pos = 0; pos < sb->pos;)
+ {
+ struct Lisp_String *str
+ = (struct Lisp_String *) &sb->chars[pos];
+ EMACS_INT size_byte = str->size_byte;
+ if (size_byte < 0)
+ size_byte = str->size;
+ if ((char *)str == ptr)
+ {
+ found = 1;
+ break;
+ }
+ pos += STRING_FULLSIZE (size_byte);
+ }
+ }
+ }
+ assert (found);
+ }
+ break;
+ }
+ case Lisp_Vectorlike:
+ if (BUFFERP (obj))
+ {
+ assert (! dumped_p (ptr));
+ if (! pdump_global_buffer_p (obj))
+ {
+ struct buffer *buffer;
+ int found = 0;
+ for (buffer = all_buffers; buffer; buffer = buffer->next)
+ if ((char *)buffer == ptr)
+ {
+ found = 1;
+ break;
+ }
+ assert (found);
+ }
+ break;
+ }
+ else if (SUBRP (obj))
+ break;
+ else
+ {
+ int found = 0;
+ if (dumped_p (ptr))
+ {
+ char *vector_start = pdump_object_start_address (PDUMP_VECTOR);
+ char *vector_ptr;
+ assert (ptr < vector_start + pdump_header.vector_size);
+ for (vector_ptr = vector_start; vector_ptr <= ptr;)
+ {
+ if (vector_ptr == ptr)
+ {
+ found = 1;
+ break;
+ }
+
+ if ((((struct Lisp_Vector *)vector_ptr)->size
+ & (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+ == (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+ {
+ struct Lisp_Bool_Vector *boolvec_ptr;
+ boolvec_ptr = ((struct Lisp_Bool_Vector *)vector_ptr);
+ vector_ptr += (sizeof (struct Lisp_Vector)
+ + boolvec_ptr->size * sizeof (unsigned char)
+ - sizeof (Lisp_Object));
+ }
+ else
+ {
+ EMACS_INT size = ((struct Lisp_Vector *)vector_ptr)->size;
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+
+ vector_ptr += (sizeof (struct Lisp_Vector)
+ + (size - 1) * sizeof (Lisp_Object));
+ }
+ }
+ }
+ else
+ {
+ struct Lisp_Vector *vector;
+ for (vector = all_vectors; vector; vector = vector->next)
+ if ((char *)vector == ptr)
+ {
+ found = 1;
+ break;
+ }
+ }
+ assert (found);
+ break;
+ }
+ case Lisp_Symbol:
+ {
+ if (dumped_p (ptr))
+ {
+ char *symbol_start = pdump_object_start_address (PDUMP_SYMBOL);
+ assert (symbol_start <= ptr
+ && ptr <= symbol_start + pdump_header.symbol_size
+ && ((ptr - symbol_start) % (sizeof (struct Lisp_Symbol))
+ == 0));
+ }
+ else
+ {
+ struct symbol_block *sblk;
+ struct symbol_block **sprev = &symbol_block;
+ int limit = symbol_block_index;
+ int found = 0;
+ for (sblk = symbol_block; sblk; sblk = *sprev)
+ {
+ if ((char *) sblk->symbols <= ptr
+ && ptr < (char *)sblk->symbols + limit)
+ {
+ assert ((ptr - (char *) sblk->symbols) % sizeof (struct Lisp_Symbol)
+ == 0);
+ found = 1;
+ break;
+ }
+ limit = SYMBOL_BLOCK_SIZE;
+ sprev = &sblk->next;
+ }
+ assert (found);
+ }
+
+ break;
+ }
+ case Lisp_Misc:
+ {
+ int found = 0;
+ if (dumped_p (ptr))
+ {
+ char *misc_start = pdump_object_start_address (PDUMP_MISC);
+ char *misc_ptr;
+ assert (ptr < misc_start + pdump_header.misc_size);
+ for (misc_ptr = misc_start;
+ misc_ptr <= ptr;
+ )
+ {
+ if (misc_ptr == ptr)
+ {
+ found = 1;
+ break;
+ }
+ switch (((union Lisp_Misc *)misc_ptr)->u_marker.type)
+ {
+ case Lisp_Misc_Marker:
+ {
+ misc_ptr += sizeof (struct Lisp_Marker);
+ break;
+ }
+ case Lisp_Misc_Buffer_Local_Value:
+ case Lisp_Misc_Some_Buffer_Local_Value:
+ {
+ misc_ptr += sizeof (struct Lisp_Buffer_Local_Value);
+ break;
+ }
+ case Lisp_Misc_Intfwd:
+ {
+ misc_ptr += sizeof (struct Lisp_Intfwd);
+ break;
+ }
+ case Lisp_Misc_Boolfwd:
+ {
+ misc_ptr += sizeof (struct Lisp_Boolfwd);
+ break;
+ }
+ case Lisp_Misc_Objfwd:
+ {
+ misc_ptr += sizeof (struct Lisp_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Buffer_Objfwd:
+ {
+ misc_ptr += sizeof (struct Lisp_Buffer_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Kboard_Objfwd:
+ {
+ misc_ptr += sizeof (struct Lisp_Kboard_Objfwd);
+ break;
+ }
+ case Lisp_Misc_Overlay:
+ {
+ misc_ptr += sizeof (struct Lisp_Overlay);
+ break;
+ }
+ default:
+ abort ();
+ }
+ }
+ }
+ else
+ {
+ struct marker_block *mblk;
+ struct marker_block **mprev = &marker_block;
+ int limit = marker_block_index;
+ for (mblk = marker_block; mblk; mblk = *mprev)
+ {
+ if ((char *)mblk->markers <= ptr
+ && ptr < (char *)mblk->markers + limit)
+ {
+ assert ((ptr - (char *) mblk->markers) % sizeof (union Lisp_Misc)
+ == 0);
+ found = 1;
+ break;
+ }
+ limit = MARKER_BLOCK_SIZE;
+ mprev = &mblk->next;
+ }
+ }
+ assert (found);
+ break;
+ }
+ case Lisp_Cons:
+ {
+ if (dumped_p (ptr))
+ assert (ptr < pdump_objects_start + pdump_header.cons_size
+ && ((ptr - pdump_objects_start) % sizeof (struct Lisp_Cons)
+ == 0));
+
+ else
+ {
+ struct cons_block *cblk;
+ struct cons_block **cprev = &cons_block;
+ int limit = cons_block_index;
+ int found = 0;
+ for (cblk = cons_block; cblk; cblk = *cprev)
+ {
+ if ((char *)cblk->conses <= ptr
+ && ptr < (cblk *)char->conses + limit)
+ {
+ assert ((ptr - (char *) cblk->conses) % sizeof (struct Lisp_Cons)
+ == 0);
+ found = 1;
+ break;
+ }
+ limit = CONS_BLOCK_SIZE;
+ cprev = &cblk->next;
+ }
+ assert (found);
+ }
+ break;
+ }
+ case Lisp_Float:
+ {
+ if (dumped_p (ptr))
+ {
+ char *float_start = pdump_object_start_address (PDUMP_FLOAT);
+ assert (float_start <= ptr
+ && ptr <= float_start + pdump_header.float_size
+ && ((ptr - float_start) % (sizeof (struct Lisp_Float))
+ == 0));
+ }
+ else
+ {
+ struct float_block *fblk;
+ struct float_block **fprev = &float_block;
+ int limit = float_block_index;
+ int found = 0;
+ for (fblk = float_block; fblk; fblk = *fprev)
+ {
+ if ((char *)fblk->floats <= ptr
+ && ptr < (char *)fblk->floats + limit)
+ {
+ assert ((ptr - (char *) fblk->floats) % sizeof (struct Lisp_Float)
+ == 0);
+ found = 1;
+ break;
+ }
+ limit = FLOAT_BLOCK_SIZE;
+ fprev = &fblk->next;
+ }
+ assert (found);
+ }
+ break;
+ }
+ case Lisp_Int:
+ break;
+ default:
+ abort ();
+ }
+}
+
+void
+pdump_check_root_objects ()
+{
+ int i;
+ for (i = 0; i < staticidx; i++)
+ pdump_check_object_validity (*staticvec[i]);
+ for (i = 0; i < staticpidx; i++)
+ pdump_check_object_validity (*staticpvec[i]);
+}
+
+#endif
+
+
+/* dumped file search */
+#include <sys/param.h>
+
+/* FIXME: this should be merged with emacs.c */
+#ifndef SEPCHAR
+#define SEPCHAR ':'
+#endif
+
+static int
+pdump_file_check_readable (char *filename)
+{
+#ifndef WINDOWSNT
+ struct stat stat_buf;
+ /* fprintf(stderr, "trying dumped file %s...\n", filename); */
+ if (stat (filename, &stat_buf) == 0)
+ if ((stat_buf.st_mode & S_IRUSR) != 0)
+ {
+ /* fprintf(stderr, "trying dumped file %s... ok\n", filename); */
+ return 1;
+ }
+ /* fprintf(stderr, "trying dumped file %s... ng\n", filename); */
+ return 0;
+#else
+ DWORD attr = GetFileAttributes (filename);
+ if (attr == 0xFFFFFFFF)
+ return 0;
+ else
+ return 1;
+#endif
+}
+
+#ifndef PATH_MAX
+#define PATH_MAX MAX_PATH
+#endif
+
+static int
+pdump_find_exe_path (char *argv0, char *exe_path)
+{
+#ifdef WINDOWSNT
+ GetModuleFileName (NULL, exe_path, PATH_MAX);
+#else /* !WINDOWSNT */
+ char *w;
+ const char *dir, *p;
+
+ dir = argv0;
+ if (dir[0] == '-')
+ {
+ /* Emacs as a login shell, how religious! */
+ dir = getenv ("SHELL");
+ }
+
+ p = dir + strlen (dir);
+ while (p != dir && !IS_ANY_SEP (p[-1])) p--;
+
+ if (p != dir)
+ {
+ /* invocation-name includes a directory component -- presumably it
+ is relative to cwd, not $PATH */
+ strcpy (exe_path, dir);
+ }
+ else
+ {
+ const char *path = getenv ("PATH");
+ const char *name = p;
+ for (;;)
+ {
+ p = path;
+ while (*p && *p != SEPCHAR)
+ p++;
+ if (p == path)
+ {
+ exe_path[0] = '.';
+ w = exe_path + 1;
+ }
+ else
+ {
+ memcpy (exe_path, path, p - path);
+ w = exe_path + (p - path);
+ }
+ if (!IS_DIRECTORY_SEP (w[-1]))
+ {
+ *w++ = '/';
+ }
+ strcpy (w, name);
+
+ /* ### #$%$#^$^@%$^#%@$ ! */
+#ifdef access
+#undef access
+#endif
+
+ if (!access (exe_path, X_OK))
+ break;
+ if (!*p)
+ {
+ /* Oh well, let's have some kind of default */
+ sprintf (exe_path, "./%s", name);
+ break;
+ }
+ path = p+1;
+ }
+ }
+#endif /* WINDOWSNT */
+
+ return 1;
+}
+
+static int
+pdump_find_dumped_file (char *exe_path)
+{
+ char *w = exe_path + strlen (exe_path);
+
+ do
+ {
+ /* ### FIXME: the versioning and dump_id are not implemented yet */
+#if 0
+ sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
+ if (pdump_file_check_readable (exe_path))
+ return 1;
+
+ sprintf (w, "-%08x.dmp", dump_id);
+ if (pdump_file_check_readable (exe_path))
+ return 1;
+
+#endif
+ sprintf (w, ".dmp");
+ if (pdump_file_check_readable (exe_path))
+ return 1;
+
+ do
+ w--;
+ while (w > exe_path
+ && !IS_DIRECTORY_SEP (*w)
+ && (*w != '-')
+ && (*w != '.'));
+ }
+ while (w > exe_path && !IS_DIRECTORY_SEP (*w));
+
+ /* ### FIXME: temporal logic; try to find fixed name `emacs.dmp' */
+ sprintf (w+1, "emacs.dmp");
+ if (pdump_file_check_readable (exe_path))
+ return 1;
+
+ return 0;
+}
+
+static int
+pdump_open_dumped_file (char *argv0)
+{
+ char path[PATH_MAX];
+ if (pdump_find_exe_path (argv0, path))
+ if (pdump_find_dumped_file (path))
+ return open (path, O_RDONLY);
+ return -1;
+}
+
+#endif /* PDUMP */
+
+/* Initialization */
+
+void
+reinit_alloc_once ()
+{
+ /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
+ pure_bytes_used = 0;
+#if GC_MARK_STACK || defined GC_MALLOC_CHECK
+ mem_init ();
+ Vdead = make_pure_string ("DEAD", 4, 4, 0);
+#endif
+#ifdef HAVE_SHM
+ pure_size = PURESIZE;
+#endif
+ all_vectors = 0;
+ ignore_warnings = 1;
+#ifdef DOUG_LEA_MALLOC
+ mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
+ mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
+#endif
+ init_strings ();
+ init_cons ();
+ init_symbol ();
+ init_marker ();
+ init_float ();
+ init_intervals ();
+
+#ifdef REL_ALLOC
+ malloc_hysteresis = 32;
+#else
+ malloc_hysteresis = 0;
+#endif
+
+ spare_memory = (char *) malloc (SPARE_MEMORY);
+
+ ignore_warnings = 0;
+ gcprolist = 0;
+ byte_stack_list = 0;
+ consing_since_gc = 0;
+#ifdef VIRT_ADDR_VARIES
+ malloc_sbrk_unused = 1<<22; /* A large number */
+ malloc_sbrk_used = 100000; /* as reasonable as any number */
+#endif /* VIRT_ADDR_VARIES */
+}
+
+void
+init_alloc_once ()
+{
+ reinit_alloc_once ();
+ staticidx = 0;
+ gc_cons_threshold = 100000 * sizeof (Lisp_Object);
}
void
Index: src/editfns.c
===================================================================
--- src/editfns.c
+++ tmp.31112.00001 Tue Jan 22 16:15:40 2002
@@ -3933,11 +3933,22 @@
}
+reinit_syms_of_editfns ()
+{
+ Lisp_Object obuf;
+ extern Lisp_Object Vprin1_to_string_buffer;
+ obuf = Fcurrent_buffer ();
+ /* Do this here, because init_buffer_once is too early--it won't work. */
+ Fset_buffer (Vprin1_to_string_buffer);
+ /* Make sure buffer-access-fontify-functions is nil in this buffer. */
+ Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
+ Qnil);
+ Fset_buffer (obuf);
+}
+
void
syms_of_editfns ()
{
- environbuf = 0;
-
Qbuffer_access_fontify_functions
= intern ("buffer-access-fontify-functions");
staticpro (&Qbuffer_access_fontify_functions);
@@ -3953,17 +3964,7 @@
of the buffer being accessed.");
Vbuffer_access_fontify_functions = Qnil;
- {
- Lisp_Object obuf;
- extern Lisp_Object Vprin1_to_string_buffer;
- obuf = Fcurrent_buffer ();
- /* Do this here, because init_buffer_once is too early--it won't work. */
- Fset_buffer (Vprin1_to_string_buffer);
- /* Make sure buffer-access-fontify-functions is nil in this buffer. */
- Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
- Qnil);
- Fset_buffer (obuf);
- }
+ reinit_syms_of_editfns ();
DEFVAR_LISP ("buffer-access-fontified-property",
&Vbuffer_access_fontified_property,
Index: nt/config.nt
===================================================================
--- nt/config.nt
+++ tmp.18936.00001 Tue Jan 22 16:15:40 2002
@@ -358,6 +358,9 @@
#define SIGTYPE RETSIGTYPE
#endif
+/* Define this if you are building with portable dumper. */
+#define PDUMP 1
+
#ifdef emacs /* Don't do this for lib-src. */
/* Tell regex.c to use a type compatible with Emacs. */
#define RE_TRANSLATE_TYPE Lisp_Object
Index: configure.in
===================================================================
--- configure.in
+++ tmp.19992.00001 Tue Jan 22 16:15:41 2002
@@ -99,6 +99,13 @@
AC_ARG_WITH(xim,
[ --without-xim don't use X11 XIM])
+AC_ARG_WITH(pdump,
+[ --with-pdump use portable dumper],
+[ case "${withval}" in
+ n | no ) ;;
+ *) AC_DEFINE(PDUMP) ;;
+ esac
+])
#### Make srcdir absolute, if it isn't already. It's important to
#### avoid running the path through pwd unnecessarily, since pwd can
#### give you automounter prefixes, which can go away. We do all this
--
Yoshiki Hayashi