[Message Prev][Message Next][Thread Prev][Thread Next][Message Index][Thread Index]
[MD:2814]Portable dumper
- X-ml-count: 2814
- Subject: [MD:2814]Portable dumper
- From: Yoshiki Hayashi <yoshiki@xxxxxxxxxx>
- Date: 16 Jan 2002 19:27:41 +0900
- User-agent: T-gnus/6.15.3 (based on Oort Gnus v0.03) (revision 06)
Yoshiki Hayashi <yoshiki@xxxxxxxxxx> writes:
> というのを書いてから二ヶ月も経過していますが、ようやく
> portable dumper そのものの説明を書いてみました。明らかに最後
> の方は息切れしていますが、実際にどのように実装しているかの説
> 明は code と共に出します。
というわけで、Emacs 20.7 に対する patch です。まだ作業中です
が、だいたいの雰囲気は掴めると思います。Meadow に対する
patch はもうちょっと後になります。いろいろと適当に実装してい
るところもありますが、それはこれから修正していきます。たぶん
だいたい動作するんではないか、と思いますが、よほどの物好きで
ない限り、この code の使用はおすすめしません。
Portable dumper 付きの Emacs を作るには、この patch を Emacs
20.7 の source tree にあてて、普通にcompile してください。
Build は
Finding pointers to doc strings...
Finding pointers to doc strings...done
Wrote /home/penny/work/emacs/lib-src/fns-20.7.1.el
Dumping under names emacs and emacs-20.7.1
0 pure bytes used
Adding new name: no such file or directory, /home/penny/work/emacs/src/emacs, /home/penny/work/emacs/src/emacs-20.7.1
make: *** [emacs] Error 255
というようなことを言って途中で止まります。ここで、src
directory に移動して ./temacs と入力すると普通の Emacs が立
ち上がります。他の directory からだと dump された data がみ
つからないので、bare Emacs が起動してしまいます。いまのとこ
ろ、lisp.h で無理矢理 #define PDUMP していますので、
configure の option は不要です。たぶん、
#undef PDUMP な code は compile できないでしょう。
この patch がやっていることは、簡単に言うと
1. pure space の排除
2. dump 時に unuexec の代わりに pdump を実行
3. 起動時に emacs.dmp という file を探して、見つかれば
pdump_load を実行。Global variable を再初期化
です。
ChangeLog はありません。手元の Subversion の repository には
それなりにまじめに log を書いていますので、必要ならどっかに
置きます。tar.gz で 16M くらいです。
# 当然 Subversion を install する必要があります。:-)
いろいろと改良は必要ですが、簡単そうなのをいくつか挙げると、
* Emacs の終了時に munmap を呼ぶ
* buffer local variable の扱いをまともにする
(dump 時に buffer と frame を無理矢理 nil にしているが、そ
れが正しいか検証する。)
* Lisp_Subr の doc pointer を dump している code をまともに
する
** hash table に Lisp_Subr の address を登録して、複数
回 dump されないようにする
** pdump_pointers の使い回しをせずに、char * 用の補助デー
タ構造を作る。dump routine も変更する必要があるのでちょっ
と面倒かも
* emacs.dmp をまじめに探すようにする (current directory じゃ
なくて、executable のある directory を探す)
* #undef PDUMP のときに普通の Emacs が compile できるように
する
* configure に --with-pdump option を追加する
* Makefile.in を修正して pdump 時は executable の file 名を
temacs から emacs にかえる
* alloc.c で pdump 用の配列を static に allocate しているの
を、dump 時だけに allocate するようにする。
* alloc.c で、pdump_hash の memory leak を fix する
* pdump 前に変数を無理矢理 nil にしないで、staticpro_nopdump
という関数を作る
というのがあります。手伝ってくださる人を募集しています。上の
ものは簡単に書いてますので、やってもいい、というものを挙げて
くださると、もっと詳しく説明します。私は今は test case の作
成と、Meadow への移植、Emacs 21.1 への移植の準備をしています。
Meadow 版が出た暁には test をよろしくおねがいします。Index: ./keyboard.c
===================================================================
--- ./keyboard.c
+++ ./keyboard.c Sun Jan 13 22:16:08 2002
@@ -9416,6 +9416,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: ./xfaces.c
===================================================================
--- ./xfaces.c
+++ ./xfaces.c Tue Jan 15 13:50:10 2002
@@ -31,7 +31,7 @@
#include "frame.h"
/* The number of face-id's in use (same for all frames). */
-static int next_face_id;
+int next_face_id;
#ifdef HAVE_FACES
Index: ./dispnew.c
===================================================================
--- ./dispnew.c
+++ ./dispnew.c Sun Jan 13 23:15:03 2002
@@ -1955,7 +1955,7 @@
session's frames, frame names, buffers, buffer-read-only flags, and
buffer-modified-flags, and a trailing sentinel (so we don't need to
add length checks). */
-static Lisp_Object frame_and_buffer_state;
+Lisp_Object frame_and_buffer_state;
DEFUN ("frame-or-buffer-changed-p", Fframe_or_buffer_changed_p,
Sframe_or_buffer_changed_p, 0, 0, 0,
Index: ./xfns.c
===================================================================
--- ./xfns.c
+++ ./xfns.c Mon Jan 14 01:36:06 2002
@@ -5239,11 +5239,24 @@
}
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;
+ list_fonts_func = x_list_fonts;
+ 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 &&&*/
@@ -5454,14 +5467,7 @@
defsubr (&Sx_display_list);
defsubr (&Sx_synchronize);
- /* Setting callback functions for fontset handler. */
- get_font_info_func = x_get_font_info;
- list_fonts_func = x_list_fonts;
- 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;
+ reinit_syms_of_xfns ();
}
#endif /* HAVE_X_WINDOWS */
Index: ./w32fns.c
===================================================================
--- ./w32fns.c
+++ ./w32fns.c Mon Jan 14 11:40:30 2002
@@ -7310,10 +7310,15 @@
return Qnil;
}
-syms_of_w32fns ()
+reinit_syms_of_w32fns ()
{
/* This is zero if not using MS-Windows. */
w32_in_use = 0;
+}
+
+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. */
Index: ./lisp.h
===================================================================
--- ./lisp.h
+++ ./lisp.h Sat Jan 12 12:13:42 2002
@@ -19,6 +19,7 @@
Boston, MA 02111-1307, USA. */
+#define PDUMP
/* These are default choices for the types to use. */
#ifndef EMACS_INT
#define EMACS_INT int
@@ -1234,7 +1235,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
@@ -1245,7 +1246,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: ./category.c
===================================================================
--- ./category.c
+++ ./category.c Sun Jan 13 19:32:31 2002
@@ -629,6 +629,12 @@
}
void
+reinit_syms_of_category ()
+{
+ category_table_version = 0;
+}
+
+void
syms_of_category ()
{
Qcategoryp = intern ("categoryp");
@@ -695,5 +701,5 @@
defsubr (&Smodify_category_entry);
defsubr (&Sdescribe_categories);
- category_table_version = 0;
+ reinit_syms_of_category ();
}
Index: ./callint.c
===================================================================
--- ./callint.c
+++ ./callint.c Sun Jan 13 19:31:22 2002
@@ -50,7 +50,7 @@
static Lisp_Object preserved_fns;
/* Marker used within call-interactively to refer to point. */
-static Lisp_Object point_marker;
+Lisp_Object point_marker;
/* Buffer for the prompt text used in Fcall_interactively. */
static char *callint_message;
@@ -818,9 +818,18 @@
}
void
-syms_of_callint ()
+reinit_syms_of_callint ()
{
point_marker = Fmake_marker ();
+
+ callint_message_size = 100;
+ callint_message = (char *) xmalloc (callint_message_size);
+}
+
+void
+syms_of_callint ()
+{
+ reinit_syms_of_callint ();
staticpro (&point_marker);
preserved_fns = Fcons (intern ("region-beginning"),
@@ -855,9 +864,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: ./w32proc.c
===================================================================
--- ./w32proc.c
+++ ./w32proc.c Mon Jan 14 11:31:42 2002
@@ -2108,6 +2108,8 @@
{
Qhigh = intern ("high");
Qlow = intern ("low");
+ staticpro (&Qhigh);
+ staticpro (&Qlow);
#ifdef HAVE_SOCKETS
defsubr (&Sw32_has_winsock);
Index: ./buffer.c
===================================================================
--- ./buffer.c
+++ ./buffer.c Tue Jan 15 22:46:16 2002
@@ -68,7 +68,7 @@
/* A Lisp_Object pointer to the above, used for staticpro */
-static Lisp_Object Vbuffer_defaults;
+Lisp_Object Vbuffer_defaults;
/* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults.
@@ -100,7 +100,7 @@
struct buffer buffer_local_symbols;
/* A Lisp_Object pointer to the above, used for staticpro */
-static Lisp_Object Vbuffer_local_symbols;
+Lisp_Object Vbuffer_local_symbols;
/* This structure holds the required types for the values in the
buffer-local slots. If a slot contains Qnil, then the
@@ -3824,11 +3824,43 @@
}
void
+reinit_buffer_once_1 ()
+{
+ buffer_permanent_local_flags = 0;
+
+#ifdef DOS_NET
+ /* Make buffer_file_typee a permanent local. */
+ buffer_permanent_local_flags |= 0x4000;
+#endif
+ /* Make buffer_file_coding_system a permanent local. */
+ buffer_permanent_local_flags |= 0x80000;
+
+ Vbuffer_alist = Qnil;
+ current_buffer = 0;
+ all_buffers = 0;
+}
+
+void
+reinit_buffer_once_2 ()
+{
+ buffer_defaults.major_mode = Qfundamental_mode;
+
+ 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 ()
{
register Lisp_Object tem;
- buffer_permanent_local_flags = 0;
+ reinit_buffer_once_1 ();
/* Make sure all markable slots in buffer_defaults
are initialized reasonably, so mark_buffer won't choke. */
@@ -3931,25 +3963,16 @@
XSETFASTINT (buffer_local_flags.display_table, 0x2000);
#ifdef DOS_NT
XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
- /* Make this one a permanent local. */
- buffer_permanent_local_flags |= 0x4000;
#endif
XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
XSETFASTINT (buffer_local_flags.category_table, 0x20000);
XSETFASTINT (buffer_local_flags.direction_reversed, 0x40000);
XSETFASTINT (buffer_local_flags.buffer_file_coding_system, 0x80000);
- /* Make this one a permanent local. */
- buffer_permanent_local_flags |= 0x80000;
-
- Vbuffer_alist = Qnil;
- current_buffer = 0;
- all_buffers = 0;
QSFundamental = build_string ("Fundamental");
Qfundamental_mode = intern ("fundamental-mode");
- buffer_defaults.major_mode = Qfundamental_mode;
Qmode_class = intern ("mode-class");
@@ -3959,14 +3982,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
Index: ./lread.c
===================================================================
--- ./lread.c
+++ ./lread.c Wed Jan 9 23:06:36 2002
@@ -1998,10 +1998,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)));
@@ -2251,7 +2253,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;
@@ -2474,9 +2480,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))
XCONS (tail)->cdr = tem;
else
@@ -2544,9 +2554,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,
@@ -2788,6 +2802,13 @@
#define OBARRAY_SIZE 1511
void
+reinit_obarray ()
+{
+ read_buffer_size = 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM;
+ read_buffer = (char *) malloc (read_buffer_size);
+}
+
+void
init_obarray ()
{
Lisp_Object oblength;
@@ -2796,7 +2817,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);
@@ -2809,7 +2834,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;
@@ -2825,8 +2854,7 @@
Qvariable_documentation = intern ("variable-documentation");
staticpro (&Qvariable_documentation);
- read_buffer_size = 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM;
- read_buffer = (char *) malloc (read_buffer_size);
+ reinit_obarray ();
}
void
Index: ./eval.c
===================================================================
--- ./eval.c
+++ ./eval.c Wed Jan 9 23:11:20 2002
@@ -168,7 +168,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));
@@ -176,6 +176,12 @@
max_specpdl_size = 600;
max_lisp_eval_depth = 300;
+}
+
+void
+init_eval_once ()
+{
+ reinit_eval_once ();
Vrun_hooks = Qnil;
}
Index: ./emacs.c
===================================================================
--- ./emacs.c
+++ ./emacs.c Wed Jan 16 13:07:44 2002
@@ -621,6 +621,18 @@
argc = 0;
while (argv[argc]) argc++;
+#ifdef PDUMP
+ {
+ /* Looks like this has to be after sort_args.
+ It uses xmalloc and malloc_initialize_hook depends on the value
+ of initislized. */
+ struct stat stat_ignored;
+ if (stat ("emacs.dmp", &stat_ignored) == 0)
+ initialized = 1;
+ }
+#endif
+
+ /* #### FIXME. Pdump should handle this option later. */
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. */
@@ -666,7 +678,11 @@
{
extern int malloc_cookie;
/* This helps out unexnext.c. */
+#ifdef PDUMP
+ if (0)
+#else
if (initialized)
+#endif /* PDUMP */
if (malloc_jumpstart (malloc_cookie) != 0)
printf ("malloc jumpstart failed!\n");
}
@@ -846,7 +862,9 @@
if (! noninteractive)
{
#ifdef BSD_PGRPS
+#ifndef PDUMP
if (initialized)
+#endif
{
inherited_pgroup = EMACS_GETPGRP (0);
setpgrp (0, getpid ());
@@ -865,8 +883,10 @@
/* Don't catch SIGHUP if dumping. */
if (1
#ifndef CANNOT_DUMP
+#ifndef PDUMP
&& initialized
#endif
+#endif
)
{
sigblock (sigmask (SIGHUP));
@@ -981,6 +1001,31 @@
init_window_once (); /* Init the window system */
init_fileio_once (); /* Must precede any path manipulation. */
}
+#ifdef PDUMP
+ else
+ {
+ if (pdump_load ("emacs.dmp"))
+ {
+ fprintf (stderr, "emacs: failed to load dumped file\n");
+ exit (1);
+ }
+ reinit_alloc_once ();
+ reinit_obarray ();
+ reinit_eval_once ();
+ reinit_charset_once ();
+ /* #### You should save and restore the values of keyboard
+ system etc. */
+ reinit_coding_once ();
+ 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 ();
init_eval ();
@@ -1264,6 +1309,36 @@
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_editfns_1 ();
+ reinit_syms_of_editfns_2 ();
+ reinit_syms_of_insdel ();
+#ifdef HAVE_X_WINDOWS
+ reinit_syms_of_xfns ();
+ reinit_syms_of_fontset ();
+#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 ();
+#endif
+ }
+#endif
if (!noninteractive)
{
@@ -1799,6 +1874,10 @@
symfile = Fexpand_file_name (symfile, Qnil);
}
+#ifdef PDUMP
+ Fgarbage_collect ();
+#endif /* PDUMP */
+
tem = Vpurify_flag;
Vpurify_flag = Qnil;
@@ -1823,6 +1902,9 @@
memory_warnings (my_edata, malloc_warning);
#endif /* not WINDOWSNT */
#endif
+#ifdef PDUMP
+ pdump ();
+#else
#ifdef DOUG_LEA_MALLOC
malloc_state_ptr = malloc_get_state ();
#endif
@@ -1832,6 +1914,7 @@
free (malloc_state_ptr);
#endif
#endif /* not VMS */
+#endif /* not PDUMP */
Vpurify_flag = tem;
Index: ./minibuf.c
===================================================================
--- ./minibuf.c
+++ ./minibuf.c Mon Jan 14 11:38:34 2002
@@ -2114,16 +2114,28 @@
}
void
-init_minibuf_once ()
+reinit_minibuf_once ()
{
Vminibuffer_list = Qnil;
+}
+
+void
+init_minibuf_once ()
+{
+ reinit_minibuf_once ();
staticpro (&Vminibuffer_list);
}
void
-syms_of_minibuf ()
+reinit_syms_of_minibuf ()
{
minibuf_level = 0;
+}
+
+void
+syms_of_minibuf ()
+{
+ reinit_syms_of_minibuf ();
minibuf_prompt = Qnil;
staticpro (&minibuf_prompt);
Index: ./charset.c
===================================================================
--- ./charset.c
+++ ./charset.c Sun Jan 13 21:17:17 2002
@@ -1978,38 +1978,9 @@
}
void
-init_charset_once ()
+reinit_charset_once ()
{
- int i, j, k;
-
- staticpro (&Vcharset_table);
- staticpro (&Vcharset_symbol_table);
- staticpro (&Vgeneric_character_list);
-
- /* This has to be done here, before we call Fmake_char_table. */
- Qcharset_table = intern ("charset-table");
- staticpro (&Qcharset_table);
-
- /* Intern this now in case it isn't already done.
- Setting this variable twice is harmless.
- But don't staticpro it here--that is done in alloc.c. */
- Qchar_table_extra_slots = intern ("char-table-extra-slots");
-
- /* Now we are ready to set up this property, so we can
- create the charset table. */
- Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
- Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
-
- Qunknown = intern ("unknown");
- staticpro (&Qunknown);
- Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1),
- Qunknown);
-
- /* Setup tables. */
- for (i = 0; i < 2; i++)
- for (j = 0; j < 2; j++)
- for (k = 0; k < 128; k++)
- iso_charset_table [i][j][k] = -1;
+ int i;
bzero (cmpchar_hash_table, sizeof cmpchar_hash_table);
cmpchar_table_size = n_cmpchars = 0;
@@ -2056,6 +2027,44 @@
val = Fcons (make_number (GENERIC_COMPOSITION_CHAR), val);
Vgeneric_character_list = Fnreverse (val);
}
+
+}
+
+void
+init_charset_once ()
+{
+ int i, j, k;
+
+ staticpro (&Vcharset_table);
+ staticpro (&Vcharset_symbol_table);
+ staticpro (&Vgeneric_character_list);
+
+ /* This has to be done here, before we call Fmake_char_table. */
+ Qcharset_table = intern ("charset-table");
+ staticpro (&Qcharset_table);
+
+ /* Intern this now in case it isn't already done.
+ Setting this variable twice is harmless.
+ But don't staticpro it here--that is done in alloc.c. */
+ Qchar_table_extra_slots = intern ("char-table-extra-slots");
+
+ /* Now we are ready to set up this property, so we can
+ create the charset table. */
+ Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
+ Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
+
+ Qunknown = intern ("unknown");
+ staticpro (&Qunknown);
+ Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1),
+ Qunknown);
+
+ /* Setup tables. */
+ for (i = 0; i < 2; i++)
+ for (j = 0; j < 2; j++)
+ for (k = 0; k < 128; k++)
+ iso_charset_table [i][j][k] = -1;
+
+ reinit_charset_once ();
nonascii_insert_offset = 0;
Vnonascii_translation_table = Qnil;
Index: ./xmenu.c
===================================================================
--- ./xmenu.c
+++ ./xmenu.c Mon Jan 14 11:37:34 2002
@@ -2632,6 +2632,15 @@
#endif /* HAVE_MENUS */
void
+reinit_syms_of_xmenu ()
+{
+#ifdef USE_X_TOOLKIT
+ widget_id_tick = (1<<16);
+ next_menubar_widget_id = 1;
+#endif
+}
+
+void
syms_of_xmenu ()
{
staticpro (&menu_items);
@@ -2645,10 +2654,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: ./coding.c
===================================================================
--- ./coding.c
+++ ./coding.c Tue Jan 15 18:51:27 2002
@@ -5447,26 +5447,10 @@
}
void
-init_coding_once ()
+reinit_coding_once ()
{
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;
- emacs_code_class[0x80] = EMACS_leading_code_composition;
- for (i = 0x81; 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_code;
@@ -5494,8 +5478,6 @@
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);
for (i = 0; i < 128; i++)
ascii_skip_code[i] = 1;
@@ -5505,6 +5487,31 @@
#else
system_eol_type = CODING_EOL_LF;
#endif
+
+ bzero (coding_system_table, sizeof coding_system_table);
+}
+
+void
+init_coding_once ()
+{
+ int i;
+ reinit_coding_once ();
+
+ /* 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;
+ emacs_code_class[0x80] = EMACS_leading_code_composition;
+ for (i = 0x81; 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: ./puresize.h
===================================================================
--- ./puresize.h
+++ ./puresize.h Sat Jan 12 21:33:47 2002
@@ -60,9 +60,13 @@
#endif
/* Signal an error if OBJ is pure. */
+#if 1
+#define CHECK_IMPURE(obj)
+#else
#define CHECK_IMPURE(obj) \
{ if (PURE_P (obj)) \
pure_write_error (); }
+#endif
extern void pure_write_error P_ ((void));
@@ -74,9 +78,13 @@
extern EMACS_INT pure[];
+#if 1
+#define PURE_P(obj) 0
+#else
#define PURE_P(obj) \
((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) \
&& (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
+#endif /* 1 */
#else /* not VIRT_ADDR_VARIES */
#ifdef PNTR_COMPARISON_TYPE
Index: ./keymap.c
===================================================================
--- ./keymap.c
+++ ./keymap.c Mon Jan 14 11:48:30 2002
@@ -3272,10 +3272,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: ./abbrev.c
===================================================================
--- ./abbrev.c
+++ ./abbrev.c Mon Jan 14 11:18:58 2002
@@ -521,6 +521,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,
@@ -539,7 +545,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 ();
DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
"The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.");
Index: ./xselect.c
===================================================================
--- ./xselect.c
+++ ./xselect.c Mon Jan 14 11:35:42 2002
@@ -2253,6 +2253,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);
@@ -2269,11 +2279,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: ./fontset.c
===================================================================
--- ./fontset.c
+++ ./fontset.c Mon Jan 14 11:33:37 2002
@@ -800,14 +800,19 @@
XVECTOR (info)->contents[2] = val;
return info;
}
-
void
-syms_of_fontset ()
+reinit_syms_of_fontset ()
{
int i;
for (i = 0; i < 256; i++)
my_strcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i;
+}
+
+void
+syms_of_fontset ()
+{
+ reinit_syms_of_fontset ();
if (!load_font_func)
/* Window system initializer should have set proper functions. */
Index: ./search.c
===================================================================
--- ./search.c
+++ ./search.c Sat Jan 12 10:49:30 2002
@@ -2778,7 +2778,7 @@
}
void
-syms_of_search ()
+reinit_syms_of_search (int reinit)
{
register int i;
@@ -2788,11 +2788,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: ./window.c
===================================================================
--- ./window.c
+++ ./window.c Tue Jan 15 08:38:13 2002
@@ -3884,15 +3884,23 @@
}
void
-init_window_once ()
+reinit_window_once (int reinit)
{
selected_frame = make_terminal_frame ();
XSETFRAME (Vterminal_frame, selected_frame);
minibuf_window = selected_frame->minibuffer_window;
selected_window = selected_frame->selected_window;
last_nonminibuf_frame = selected_frame;
+ if (reinit)
+ selected_frame->face_alist = Fsymbol_value (intern ("global-face-data"));
window_initialized = 1;
+}
+
+void
+init_window_once ()
+{
+ reinit_window_once (0);
}
void
Index: ./insdel.c
===================================================================
--- ./insdel.c
+++ ./insdel.c Mon Jan 14 11:26:04 2002
@@ -2682,11 +2682,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: ./alloc.c
===================================================================
--- ./alloc.c
+++ ./alloc.c Wed Jan 16 17:25:54 2002
@@ -957,10 +957,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
p = XVECTOR (val);
for (index = 0; index < nargs; index++)
{
@@ -1524,6 +1528,7 @@
it may be able to hold conses that point to that string;
then the string is not protected from gc. */
+#ifndef PDUMP
Lisp_Object
make_pure_string (data, length, length_byte, multibyte)
char *data;
@@ -1622,6 +1627,7 @@
XVECTOR (new)->size = len;
return new;
}
+#endif
DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
"Make a copy of OBJECT in pure storage.\n\
@@ -1630,6 +1636,9 @@
(obj)
register Lisp_Object obj;
{
+#ifdef PDUMP
+ return obj;
+#else
if (NILP (Vpurify_flag))
return obj;
@@ -1668,6 +1677,7 @@
error ("Attempt to copy a marker to pure storage");
else
return obj;
+#endif
}
/* Recording what needs to be marked for gc. */
@@ -2412,6 +2422,9 @@
}
/* Sweep: find all structures not marked, and free them. */
+#ifdef PDUMP
+static void unmark_pdumped_objects ();
+#endif
static void
gc_sweep ()
@@ -2802,6 +2815,9 @@
}
}
}
+#ifdef PDUMP
+ unmark_pdumped_objects ();
+#endif
}
/* Compactify strings, relocate references, and free empty string blocks. */
@@ -3012,10 +3028,1060 @@
Qnil)))))));
}
+#include <sys/file.h>
+#include <sys/mman.h>
+#include <assert.h>
+
+/* Struct to hold a Lisp_Object data in a hash table. */
+typedef struct pdump_forward_t
+{
+ Lisp_Object obj; /* object itself */
+ 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;
+
+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 cons_length, symbol_length, misc_length;
+ long small_string_length, large_string_length;
+ long float_length, vector_length;
+} pdump_header_t;
+
+typedef struct pdump_root_t
+{
+ long address;
+ long val;
+} pdump_root_t;
+
+/* #### You should allocate this only when dumping. */
+#define HASH_SIZE 200009
+#define ARRAY_SIZE 1000
+#if 0
+#define PDUMP_OFFSET 12288
+#else
+#define PDUMP_OFFSET 10000
+#endif
+static pdump_forward_t *pdump_hash[HASH_SIZE];
+
+/* 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[HASH_SIZE];
+ int index;
+ int size;
+} pdump_type_objects_t;
+
+static pdump_type_objects_t pdump_lisp_object[PDUMP_OBJECT_LIMIT];
+
+static pdump_forward_pointer_t pdump_pointers[ARRAY_SIZE];
+static int pdump_pointers_index;
+
+static pdump_header_t pdump_header;
+
+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 <= HASH_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 <= ARRAY_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);
+ EMACS_INT size_byte = ptr->size_byte;
+ if (size_byte < 0)
+ size_byte = ptr->size;
+ pdump_register_object (obj, STRING_FULLSIZE (size_byte),
+ ptr->size & MARKBIT ? PDUMP_LARGE_STRING
+ : PDUMP_SMALL_STRING);
+ assert (ptr->intervals == NULL);
+ break;
+ }
+ case Lisp_Vectorlike:
+ if (BUFFERP (obj) || WINDOWP (obj) || WINDOW_CONFIGURATIONP (obj)
+ || FRAMEP (obj))
+ {
+ const char *msg;
+ if (BUFFERP (obj))
+ msg = "buffer";
+ else if (WINDOWP (obj))
+ msg = "obj";
+ else if (WINDOW_CONFIGURATIONP (obj))
+ msg = "window configuration";
+ else if (FRAMEP (obj))
+ msg = "frame";
+ else
+ msg = "";
+ fprintf (stderr, "Trying to dump undumpable object %s %d\n",
+ msg, obj);
+ break;
+ }
+ else if (SUBRP (obj))
+ {
+ /* #### Relies on sizeof (char *) == sizeof (int)
+ Should be fixed. This is the only object that dumps
+ part of it without registering. Because of this, it is not
+ guaranteed that this information isn't dumped twice. */
+ pdump_register_pointer (&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_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);
+ break;
+ }
+ else
+ {
+ fprintf (stderr, "unsupported object %d\n", obj);
+ 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 ();
+ }
+}
+
+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 ();
+}
+
+static Lisp_Object
+pdump_forward_object (Lisp_Object obj)
+{
+ pdump_forward_t *f;
+ Lisp_Object new_obj;
+ Lisp_Object 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_Vector *ptr = XVECTOR (obj);
+ 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);
+ fwrite (new, total_size, 1, pdump_stream);
+ xfree (new);
+ }
+ else
+ {
+ abort ();
+ }
+ }
+}
+
+static void
+pdump_add_special_buffers ()
+{
+ int i, offset;
+ struct buffer *buffers[3];
+ buffers[0] = &buffer_defaults;
+ buffers[1] = &buffer_local_symbols;
+ buffers[2] = 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[4];
+
+ /* 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);
+
+ buffers[0] = &buffer_defaults;
+ buffers[1] = &buffer_local_symbols;
+ buffers[2] = &buffer_local_types;
+ buffers[3] = NULL;
+ for (i = 0; buffers[i]; i++)
+ for (offset = (char *)&buffers[i]->undo_list - (char *)buffers[i];
+ offset < sizeof (struct buffer);
+ offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == 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 char *pdump_objects_start;
+extern Lisp_Object Vminibuffer_list;
+extern Lisp_Object Vprin1_to_string_buffer;
+extern Lisp_Object Vbuffer_defaults, Vbuffer_local_symbols, Vbuffer_alist;
+extern Lisp_Object Vframe_list, Vterminal_frame;
+extern Lisp_Object point_marker;
+extern Lisp_Object frame_and_buffer_state;
+#include "coding.h" /* for emacs_code_class */
+void
+pdump ()
+{
+ int i, offset;
+ pdump_header_t header;
+ int pdump_fd; /* File descriptor of dumped data. */
+ FILE *pdump_stream; /* Stream of dumped data. */
+ Lisp_Object saved_minibuf_list = Vminibuffer_list;
+ Lisp_Object saved_prin1_to_string_buffer = Vprin1_to_string_buffer;
+ Lisp_Object saved_buffer_defaults = Vbuffer_defaults;
+ Lisp_Object saved_buffer_local_symbols = Vbuffer_local_symbols;
+ Lisp_Object saved_buffer_alist = Vbuffer_alist;
+ Lisp_Object saved_frame_list = Vframe_list;
+ Lisp_Object saved_terminal_frame = Vterminal_frame;
+ Lisp_Object saved_point_marker = point_marker;
+ Lisp_Object saved_frame_and_buffer_state = frame_and_buffer_state;
+ Vminibuffer_list = Qnil;
+ Vprin1_to_string_buffer = Qnil;
+ Vbuffer_defaults = Qnil;
+ Vbuffer_local_symbols = Qnil;
+ Vbuffer_alist = Qnil;
+ Vframe_list = Qnil;
+ Vterminal_frame = Qnil;
+ point_marker = Qnil;
+ frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda);
+
+#undef open
+ pdump_fd = open ("emacs.dmp", O_WRONLY | O_CREAT | O_TRUNC, 0666);
+ pdump_stream = fdopen (pdump_fd, "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.cons_length = pdump_lisp_object[PDUMP_CONS].index;
+ header.symbol_length = pdump_lisp_object[PDUMP_SYMBOL].index;
+ header.misc_length = pdump_lisp_object[PDUMP_MISC].index;
+ header.small_string_length = pdump_lisp_object[PDUMP_SMALL_STRING].index;
+ header.large_string_length = pdump_lisp_object[PDUMP_LARGE_STRING].index;
+ header.float_length = pdump_lisp_object[PDUMP_FLOAT].index;
+ header.vector_length = pdump_lisp_object[PDUMP_VECTOR].index;
+ 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 (pdump_pointers, sizeof (pdump_pointers[0]),
+ pdump_pointers_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);
+ {
+ extern int next_face_id;
+ fwrite (&next_face_id, sizeof (next_face_id), 1, pdump_stream);
+ }
+ fclose (pdump_stream);
+ close (pdump_fd);
+ Vminibuffer_list = saved_minibuf_list;
+ Vprin1_to_string_buffer = saved_prin1_to_string_buffer;
+ Vbuffer_defaults = saved_buffer_defaults;
+ Vbuffer_local_symbols = saved_prin1_to_string_buffer;
+ Vbuffer_alist = saved_buffer_alist;
+ Vframe_list = saved_frame_list;
+ Vterminal_frame = saved_terminal_frame;
+ point_marker = saved_point_marker;
+ frame_and_buffer_state = saved_frame_and_buffer_state;
+}
+
+#define PDUMP_RELOCATE(obj, offset) \
+do \
+{ \
+ char *p_r_ptr = (char *) ((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), (char *) XPNTR (obj) + offset); \
+} \
+while (0)
+
+static void pdump_relocate_objects (long offset);
+int
+pdump_load (const char *filename)
+{
+ int i;
+ int fd = open (filename, O_RDONLY);
+ char *ret;
+ long offset;
+
+ read (fd, &pdump_header, sizeof (pdump_header));
+ lseek (fd, 0, SEEK_SET);
+ ret = (char *)mmap (pdump_header.offset, pdump_header.objects_size
+ + sizeof (pdump_header_t),
+ PROT_READ|PROT_WRITE, MAP_PRIVATE,
+ fd, 0);
+ if ((long) ret == -1)
+ return 1;
+ pdump_objects_start = ret + sizeof (pdump_header_t);
+ offset = 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] = root.address;
+ if (offset != 0)
+ PDUMP_RELOCATE (root.val, offset);
+ *staticvec[staticidx] = root.val;
+ }
+ if (offset != 0)
+ pdump_relocate_objects (ret - pdump_header.offset);
+ for (i = 0; i < pdump_header.pointers_length; i++)
+ {
+ pdump_forward_pointer_t fp;
+ read (fd, &fp, sizeof (fp));
+ *(int *)fp.address = fp.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[4];
+ buffers[0] = &buffer_defaults;
+ buffers[1] = &buffer_local_symbols;
+ buffers[2] = &buffer_local_types;
+ buffers[3] = 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 (EMACS_INT))) /* sizeof EMACS_INT == 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);
+ {
+ extern int next_face_id;
+ read (fd, &next_face_id, sizeof (next_face_id));
+ }
+ return 0;
+}
+
+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 (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE)
+ {
+ while (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE)
+ {
+ if (size & DONT_COPY_FLAG)
+ size ^= MARKBIT | DONT_COPY_FLAG;
+ size = *(EMACS_INT *)size & ~MARKBIT;
+ }
+ if (size_byte < 0)
+ size_byte = size;
+ size = ptr->size;
+ while (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE)
+ {
+ register Lisp_Object *objptr;
+ if (size & DONT_COPY_FLAG)
+ size ^= MARKBIT | DONT_COPY_FLAG;
+ objptr = (Lisp_Object *)size;
+
+ size = XFASTINT (*objptr) & ~MARKBIT;
+ if (XMARKBIT (*objptr))
+ {
+ XSETSTRING (*objptr, ptr);
+ XMARK (*objptr);
+ }
+ else
+ XSETSTRING (*objptr, ptr);
+ }
+ ptr->size = size;
+#ifdef USE_TEXT_PROPERTIES
+ /* Now that the string has been relocated, rebalance its
+ interval tree, and update the tree's parent pointer. */
+ if (! NULL_INTERVAL_P (ptr->intervals))
+ {
+ UNMARK_BALANCE_INTERVALS (ptr->intervals);
+ XSETSTRING (* (Lisp_Object *) &ptr->intervals->parent,
+ ptr);
+ }
+#endif /* USE_TEXT_PROPERTIES */
+ }
+ else if (size_byte < 0)
+ size_byte = size;
+ obj_ptr += STRING_FULLSIZE (size_byte);
+ }
+ 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;
+ 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->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_FULLSIZE (size_byte);
+ }
+ 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++)
+ {
+ struct Lisp_Float *ptr = (struct Lisp_Float *)obj_ptr;
+ 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_Vector *ptr = (struct Lisp_Vector *) obj_ptr;
+ EMACS_INT size = ptr->size;
+ int i;
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ obj_ptr += (sizeof (struct Lisp_Vector)
+ + (size - 1) * 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));
+ }
+ }
+}
+
+
/* Initialization */
void
-init_alloc_once ()
+reinit_alloc_once ()
{
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
pureptr = 0;
@@ -3048,13 +4114,19 @@
ignore_warnings = 0;
gcprolist = 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 */
+}
+
+void
+init_alloc_once ()
+{
+ reinit_alloc_once ();
+ staticidx = 0;
+ gc_cons_threshold = 100000 * sizeof (Lisp_Object);
}
void
Index: ./editfns.c
===================================================================
--- ./editfns.c
+++ ./editfns.c Sun Jan 13 19:38:46 2002
@@ -3243,9 +3243,28 @@
void
-syms_of_editfns ()
+reinit_syms_of_editfns_1 ()
{
environbuf = 0;
+}
+
+reinit_syms_of_editfns_2 ()
+{
+ 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 ()
+{
+ reinit_syms_of_editfns_1 ();
Qbuffer_access_fontify_functions
= intern ("buffer-access-fontify-functions");
@@ -3258,17 +3277,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_2 ();
DEFVAR_LISP ("buffer-access-fontified-property",
&Vbuffer_access_fontified_property,
--
Yoshiki Hayashi