git.chise.org Git - chise/xemacs-chise.git.1/blob - src/dumper.c

   1 /* Portable data dumper for XEmacs.
   2    Copyright (C) 1999-2000 Olivier Galibert
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25 #include "dump-id.h"
  26 #include "specifier.h"
  27 #include "alloc.h"
  28 #include "elhash.h"
  29 #include "sysfile.h"
  30 #include "console-stream.h"
  31 #include "dumper.h"
  32
  33 #ifdef WINDOWSNT
  34 #define WINDOWS_LEAN_AND_MEAN
  35 #include <windows.h>
  36 #define PATH_MAX MAXPATHLEN
  37 #else
  38 #ifdef HAVE_MMAP
  39 #include <sys/mman.h>
  40 #endif
  41 #endif
  42
  43 #ifndef SEPCHAR
  44 #define SEPCHAR ':'
  45 #endif
  46
  47 typedef struct
  48 {
  49   const struct lrecord_description *desc;
  50   int count;
  51 } pdump_reloc_table;
  52
  53 static char *pdump_rt_list = 0;
  54
  55 void
  56 pdump_objects_unmark (void)
  57 {
  58   int i;
  59   char *p = pdump_rt_list;
  60   if (p)
  61     for (;;)
  62       {
  63         pdump_reloc_table *rt = (pdump_reloc_table *)p;
  64         p += sizeof (pdump_reloc_table);
  65         if (rt->desc)
  66           {
  67             for (i=0; i<rt->count; i++)
  68               {
  69                 struct lrecord_header *lh = * (struct lrecord_header **) p;
  70                 if (! C_READONLY_RECORD_HEADER_P (lh))
  71                   UNMARK_RECORD_HEADER (lh);
  72                 p += sizeof (EMACS_INT);
  73               }
  74           } else
  75             break;
  76       }
  77 }
  78
  79
  80 /* The structure of the file
  81  *
  82  * 0                    - header
  83  * 256                  - dumped objects
  84  * stab_offset          - nb_staticpro*(Lisp_Object *) from staticvec
  85  *                      - nb_staticpro*(relocated Lisp_Object) pointed to by staticpro
  86  *                      - nb_structdmp*pair(void *, adr) for pointers to structures
  87  *                      - lrecord_implementations_table[]
  88  *                      - relocation table
  89  *                      - wired variable address/value couples with the count preceding the list
  90  */
  91
  92
  93 #define DUMP_SIGNATURE "XEmacsDP"
  94 #define DUMP_SIGNATURE_LEN (sizeof (DUMP_SIGNATURE) - 1)
  95
  96 typedef struct
  97 {
  98   char signature[DUMP_SIGNATURE_LEN];
  99   unsigned int id;
 100   EMACS_UINT stab_offset;
 101   EMACS_UINT reloc_address;
 102   int nb_staticpro;
 103   int nb_structdmp;
 104   int nb_opaquedmp;
 105 } dump_header;
 106
 107 char *pdump_start, *pdump_end;
 108 static size_t pdump_length;
 109
 110 #ifdef WINDOWSNT
 111 // Handle for the dump file
 112 HANDLE pdump_hFile = INVALID_HANDLE_VALUE;
 113 // Handle for the file mapping object for the dump file
 114 HANDLE pdump_hMap = INVALID_HANDLE_VALUE;
 115 #endif
 116
 117 void (*pdump_free) (void);
 118
 119 static const unsigned char align_table[256] =
 120 {
 121   8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 122   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 123   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 124   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 125   6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 126   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 127   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 128   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 129   7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 130   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 131   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 132   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 133   6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 134   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 135   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 136   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
 137 };
 138
 139 typedef struct pdump_entry_list_elmt
 140 {
 141   struct pdump_entry_list_elmt *next;
 142   const void *obj;
 143   size_t size;
 144   int count;
 145   int is_lrecord;
 146   EMACS_INT save_offset;
 147 } pdump_entry_list_elmt;
 148
 149 typedef struct
 150 {
 151   pdump_entry_list_elmt *first;
 152   int align;
 153   int count;
 154 } pdump_entry_list;
 155
 156 typedef struct pdump_struct_list_elmt
 157 {
 158   pdump_entry_list list;
 159   const struct struct_description *sdesc;
 160 } pdump_struct_list_elmt;
 161
 162 typedef struct
 163 {
 164   pdump_struct_list_elmt *list;
 165   int count;
 166   int size;
 167 } pdump_struct_list;
 168
 169 static pdump_entry_list pdump_object_table[256];
 170 static pdump_entry_list pdump_opaque_data_list;
 171 static pdump_struct_list pdump_struct_table;
 172 static pdump_entry_list_elmt *pdump_qnil;
 173
 174 static int pdump_alert_undump_object[256];
 175
 176 static unsigned long cur_offset;
 177 static size_t max_size;
 178 static int pdump_fd;
 179 static void *pdump_buf;
 180
 181 #define PDUMP_HASHSIZE 200001
 182
 183 static pdump_entry_list_elmt **pdump_hash;
 184
 185 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
 186 static int
 187 pdump_make_hash (const void *obj)
 188 {
 189   return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
 190 }
 191
 192 static pdump_entry_list_elmt *
 193 pdump_get_entry (const void *obj)
 194 {
 195   int pos = pdump_make_hash (obj);
 196   pdump_entry_list_elmt *e;
 197
 198   assert (obj != 0);
 199
 200   while ((e = pdump_hash[pos]) != 0)
 201     {
 202       if (e->obj == obj)
 203         return e;
 204
 205       pos++;
 206       if (pos == PDUMP_HASHSIZE)
 207         pos = 0;
 208     }
 209   return 0;
 210 }
 211
 212 static void
 213 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
 214 {
 215   pdump_entry_list_elmt *e;
 216   int align;
 217   int pos = pdump_make_hash (obj);
 218
 219   while ((e = pdump_hash[pos]) != 0)
 220     {
 221       if (e->obj == obj)
 222         return;
 223
 224       pos++;
 225       if (pos == PDUMP_HASHSIZE)
 226         pos = 0;
 227     }
 228
 229   e = xnew (pdump_entry_list_elmt);
 230
 231   e->next = list->first;
 232   e->obj = obj;
 233   e->size = size;
 234   e->count = count;
 235   e->is_lrecord = is_lrecord;
 236   list->first = e;
 237
 238   list->count += count;
 239   pdump_hash[pos] = e;
 240
 241   align = align_table[size & 255];
 242   if (align < 2 && is_lrecord)
 243     align = 2;
 244
 245   if (align < list->align)
 246     list->align = align;
 247 }
 248
 249 static pdump_entry_list *
 250 pdump_get_entry_list (const struct struct_description *sdesc)
 251 {
 252   int i;
 253   for (i=0; i<pdump_struct_table.count; i++)
 254     if (pdump_struct_table.list[i].sdesc == sdesc)
 255       return &pdump_struct_table.list[i].list;
 256
 257   if (pdump_struct_table.size <= pdump_struct_table.count)
 258     {
 259       if (pdump_struct_table.size == -1)
 260         pdump_struct_table.size = 10;
 261       else
 262         pdump_struct_table.size = pdump_struct_table.size * 2;
 263       pdump_struct_table.list = (pdump_struct_list_elmt *)
 264         xrealloc (pdump_struct_table.list,
 265                   pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
 266     }
 267   pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
 268   pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
 269   pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
 270   pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
 271
 272   return &pdump_struct_table.list[pdump_struct_table.count++].list;
 273 }
 274
 275 static struct
 276 {
 277   struct lrecord_header *obj;
 278   int position;
 279   int offset;
 280 } backtrace[65536];
 281
 282 static int depth;
 283
 284 static void pdump_backtrace (void)
 285 {
 286   int i;
 287   stderr_out ("pdump backtrace :\n");
 288   for (i=0;i<depth;i++)
 289     {
 290       if (!backtrace[i].obj)
 291         stderr_out ("  - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
 292       else
 293         {
 294           stderr_out ("  - %s (%d, %d)\n",
 295                    LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
 296                    backtrace[i].position,
 297                    backtrace[i].offset);
 298         }
 299     }
 300 }
 301
 302 static void pdump_register_object (Lisp_Object obj);
 303 static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
 304
 305 static EMACS_INT
 306 pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
 307 {
 308   EMACS_INT count;
 309   const void *irdata;
 310
 311   int line = XD_INDIRECT_VAL (code);
 312   int delta = XD_INDIRECT_DELTA (code);
 313
 314   irdata = ((char *)idata) + idesc[line].offset;
 315   switch (idesc[line].type)
 316     {
 317     case XD_SIZE_T:
 318       count = *(size_t *)irdata;
 319       break;
 320     case XD_INT:
 321       count = *(int *)irdata;
 322       break;
 323     case XD_LONG:
 324       count = *(long *)irdata;
 325       break;
 326     case XD_BYTECOUNT:
 327       count = *(Bytecount *)irdata;
 328       break;
 329     default:
 330       stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
 331       pdump_backtrace ();
 332       abort ();
 333     }
 334   count += delta;
 335   return count;
 336 }
 337
 338 static void
 339 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
 340 {
 341   int pos;
 342
 343  restart:
 344   for (pos = 0; desc[pos].type != XD_END; pos++)
 345     {
 346       const void *rdata = (const char *)data + desc[pos].offset;
 347
 348       backtrace[me].position = pos;
 349       backtrace[me].offset = desc[pos].offset;
 350
 351       switch (desc[pos].type)
 352         {
 353         case XD_SPECIFIER_END:
 354           pos = 0;
 355           desc = ((const Lisp_Specifier *)data)->methods->extra_description;
 356           goto restart;
 357         case XD_SIZE_T:
 358         case XD_INT:
 359         case XD_LONG:
 360         case XD_BYTECOUNT:
 361         case XD_LO_RESET_NIL:
 362         case XD_INT_RESET:
 363         case XD_LO_LINK:
 364           break;
 365         case XD_OPAQUE_DATA_PTR:
 366           {
 367             EMACS_INT count = desc[pos].data1;
 368             if (XD_IS_INDIRECT (count))
 369               count = pdump_get_indirect_count (count, desc, data);
 370
 371             pdump_add_entry (&pdump_opaque_data_list,
 372                              *(void **)rdata,
 373                              count,
 374                              1,
 375                              0);
 376             break;
 377           }
 378         case XD_C_STRING:
 379           {
 380             const char *str = *(const char **)rdata;
 381             if (str)
 382               pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
 383             break;
 384           }
 385         case XD_DOC_STRING:
 386           {
 387             const char *str = *(const char **)rdata;
 388             if ((EMACS_INT)str > 0)
 389               pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
 390             break;
 391           }
 392         case XD_LISP_OBJECT:
 393           {
 394             const Lisp_Object *pobj = (const Lisp_Object *)rdata;
 395
 396             assert (desc[pos].data1 == 0);
 397
 398             backtrace[me].offset = (const char *)pobj - (const char *)data;
 399             pdump_register_object (*pobj);
 400             break;
 401           }
 402         case XD_LISP_OBJECT_ARRAY:
 403           {
 404             int i;
 405             EMACS_INT count = desc[pos].data1;
 406             if (XD_IS_INDIRECT (count))
 407               count = pdump_get_indirect_count (count, desc, data);
 408
 409             for (i = 0; i < count; i++)
 410               {
 411                 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
 412                 Lisp_Object dobj = *pobj;
 413
 414                 backtrace[me].offset = (const char *)pobj - (const char *)data;
 415                 pdump_register_object (dobj);
 416               }
 417             break;
 418           }
 419         case XD_STRUCT_PTR:
 420           {
 421             EMACS_INT count = desc[pos].data1;
 422             const struct struct_description *sdesc = desc[pos].data2;
 423             const char *dobj = *(const char **)rdata;
 424             if (dobj)
 425               {
 426                 if (XD_IS_INDIRECT (count))
 427                   count = pdump_get_indirect_count (count, desc, data);
 428
 429                 pdump_register_struct (dobj, sdesc, count);
 430               }
 431             break;
 432           }
 433         default:
 434           stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
 435           pdump_backtrace ();
 436           abort ();
 437         };
 438     }
 439 }
 440
 441 static void
 442 pdump_register_object (Lisp_Object obj)
 443 {
 444   struct lrecord_header *objh;
 445
 446   if (!POINTER_TYPE_P (XTYPE (obj)))
 447     return;
 448
 449   objh = XRECORD_LHEADER (obj);
 450   if (!objh)
 451     return;
 452
 453   if (pdump_get_entry (objh))
 454     return;
 455
 456   if (LHEADER_IMPLEMENTATION (objh)->description)
 457     {
 458       int me = depth++;
 459       if (me>65536)
 460         {
 461           stderr_out ("Backtrace overflow, loop ?\n");
 462           abort ();
 463         }
 464       backtrace[me].obj = objh;
 465       backtrace[me].position = 0;
 466       backtrace[me].offset = 0;
 467
 468       pdump_add_entry (pdump_object_table + objh->type,
 469                        objh,
 470                        LHEADER_IMPLEMENTATION (objh)->static_size ?
 471                        LHEADER_IMPLEMENTATION (objh)->static_size :
 472                        LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh),
 473                        1,
 474                        1);
 475       pdump_register_sub (objh,
 476                           LHEADER_IMPLEMENTATION (objh)->description,
 477                           me);
 478       --depth;
 479     }
 480   else
 481     {
 482       pdump_alert_undump_object[objh->type]++;
 483       stderr_out ("Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name);
 484       pdump_backtrace ();
 485     }
 486 }
 487
 488 static void
 489 pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
 490 {
 491   if (data && !pdump_get_entry (data))
 492     {
 493       int me = depth++;
 494       int i;
 495       if (me>65536)
 496         {
 497           stderr_out ("Backtrace overflow, loop ?\n");
 498           abort ();
 499         }
 500       backtrace[me].obj = 0;
 501       backtrace[me].position = 0;
 502       backtrace[me].offset = 0;
 503
 504       pdump_add_entry (pdump_get_entry_list (sdesc),
 505                        data,
 506                        sdesc->size,
 507                        count,
 508                        0);
 509       for (i=0; i<count; i++)
 510         {
 511           pdump_register_sub (((char *)data) + sdesc->size*i,
 512                               sdesc->description,
 513                               me);
 514         }
 515       --depth;
 516     }
 517 }
 518
 519 static void
 520 pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
 521 {
 522   size_t size = elmt->size;
 523   int count = elmt->count;
 524   if (desc)
 525     {
 526       int pos, i;
 527       memcpy (pdump_buf, elmt->obj, size*count);
 528
 529       for (i=0; i<count; i++)
 530         {
 531           char *cur = ((char *)pdump_buf) + i*size;
 532         restart:
 533           for (pos = 0; desc[pos].type != XD_END; pos++)
 534             {
 535               void *rdata = cur + desc[pos].offset;
 536               switch (desc[pos].type)
 537                 {
 538                 case XD_SPECIFIER_END:
 539                   desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
 540                   goto restart;
 541                 case XD_SIZE_T:
 542                 case XD_INT:
 543                 case XD_LONG:
 544                 case XD_BYTECOUNT:
 545                   break;
 546                 case XD_LO_RESET_NIL:
 547                   {
 548                     EMACS_INT num = desc[pos].data1;
 549                     int j;
 550                     if (XD_IS_INDIRECT (num))
 551                       num = pdump_get_indirect_count (num, desc, elmt->obj);
 552                     for (j=0; j<num; j++)
 553                       ((EMACS_INT *)rdata)[j] = pdump_qnil->save_offset;
 554                     break;
 555                   }
 556                 case XD_INT_RESET:
 557                   {
 558                     EMACS_INT val = desc[pos].data1;
 559                     if (XD_IS_INDIRECT (val))
 560                       val = pdump_get_indirect_count (val, desc, elmt->obj);
 561                     *(int *)rdata = val;
 562                     break;
 563                   }
 564                 case XD_OPAQUE_DATA_PTR:
 565                 case XD_C_STRING:
 566                 case XD_STRUCT_PTR:
 567                   {
 568                     void *ptr = *(void **)rdata;
 569                     if (ptr)
 570                       *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
 571                     break;
 572                   }
 573                 case XD_LO_LINK:
 574                   {
 575                     Lisp_Object obj = *(Lisp_Object *)rdata;
 576                     pdump_entry_list_elmt *elmt1;
 577                     for (;;)
 578                       {
 579                         elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
 580                         if (elmt1)
 581                           break;
 582                         obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
 583                       }
 584                     *(EMACS_INT *)rdata = elmt1->save_offset;
 585                     break;
 586                   }
 587                 case XD_LISP_OBJECT:
 588                   {
 589                     Lisp_Object *pobj = (Lisp_Object *) rdata;
 590
 591                     assert (desc[pos].data1 == 0);
 592
 593                     if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
 594                       *(EMACS_INT *)pobj =
 595                         pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
 596                     break;
 597                   }
 598                 case XD_LISP_OBJECT_ARRAY:
 599                   {
 600                     EMACS_INT num = desc[pos].data1;
 601                     int j;
 602                     if (XD_IS_INDIRECT (num))
 603                       num = pdump_get_indirect_count (num, desc, elmt->obj);
 604
 605                     for (j=0; j<num; j++)
 606                       {
 607                         Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
 608                         if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
 609                           *(EMACS_INT *)pobj =
 610                             pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
 611                       }
 612                     break;
 613                   }
 614                 case XD_DOC_STRING:
 615                   {
 616                     EMACS_INT str = *(EMACS_INT *)rdata;
 617                     if (str > 0)
 618                       *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
 619                     break;
 620                   }
 621                 default:
 622                   stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
 623                   abort ();
 624                 };
 625             }
 626         }
 627     }
 628   write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
 629   if (elmt->is_lrecord && ((size*count) & 3))
 630     write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
 631 }
 632
 633 static void
 634 pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
 635 {
 636   int pos;
 637
 638  restart:
 639   for (pos = 0; desc[pos].type != XD_END; pos++)
 640     {
 641       void *rdata = (char *)data + desc[pos].offset;
 642       switch (desc[pos].type)
 643         {
 644         case XD_SPECIFIER_END:
 645           pos = 0;
 646           desc = ((const Lisp_Specifier *)data)->methods->extra_description;
 647           goto restart;
 648         case XD_SIZE_T:
 649         case XD_INT:
 650         case XD_LONG:
 651         case XD_BYTECOUNT:
 652         case XD_INT_RESET:
 653           break;
 654         case XD_OPAQUE_DATA_PTR:
 655         case XD_C_STRING:
 656         case XD_STRUCT_PTR:
 657         case XD_LO_LINK:
 658           {
 659             EMACS_INT ptr = *(EMACS_INT *)rdata;
 660             if (ptr)
 661               *(EMACS_INT *)rdata = ptr+delta;
 662             break;
 663           }
 664         case XD_LISP_OBJECT:
 665           {
 666             Lisp_Object *pobj = (Lisp_Object *) rdata;
 667
 668             assert (desc[pos].data1 == 0);
 669
 670             if (POINTER_TYPE_P (XTYPE (*pobj))
 671                 && ! EQ (*pobj, Qnull_pointer))
 672               XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta);
 673
 674             break;
 675           }
 676         case XD_LISP_OBJECT_ARRAY:
 677         case XD_LO_RESET_NIL:
 678           {
 679             EMACS_INT num = desc[pos].data1;
 680             int j;
 681             if (XD_IS_INDIRECT (num))
 682               num = pdump_get_indirect_count (num, desc, data);
 683
 684             for (j=0; j<num; j++)
 685               {
 686                 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
 687
 688                 if (POINTER_TYPE_P (XTYPE (*pobj))
 689                     && ! EQ (*pobj, Qnull_pointer))
 690                   XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta);
 691               }
 692             break;
 693           }
 694         case XD_DOC_STRING:
 695           {
 696             EMACS_INT str = *(EMACS_INT *)rdata;
 697             if (str > 0)
 698               *(EMACS_INT *)rdata = str + delta;
 699             break;
 700           }
 701         default:
 702           stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
 703           abort ();
 704         };
 705     }
 706 }
 707
 708 static void
 709 pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
 710 {
 711   size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
 712   elmt->save_offset = cur_offset;
 713   if (size>max_size)
 714     max_size = size;
 715   cur_offset += size;
 716 }
 717
 718 static void
 719 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
 720 {
 721   int align, i;
 722   const struct lrecord_description *idesc;
 723   pdump_entry_list_elmt *elmt;
 724   for (align=8; align>=0; align--)
 725     {
 726       for (i=0; i<lrecord_type_count; i++)
 727         if (pdump_object_table[i].align == align)
 728           {
 729             elmt = pdump_object_table[i].first;
 730             if (!elmt)
 731               continue;
 732             idesc = lrecord_implementations_table[i]->description;
 733             while (elmt)
 734               {
 735                 f (elmt, idesc);
 736                 elmt = elmt->next;
 737               }
 738           }
 739
 740       for (i=0; i<pdump_struct_table.count; i++)
 741         if (pdump_struct_table.list[i].list.align == align)
 742           {
 743             elmt = pdump_struct_table.list[i].list.first;
 744             idesc = pdump_struct_table.list[i].sdesc->description;
 745             while (elmt)
 746               {
 747                 f (elmt, idesc);
 748                 elmt = elmt->next;
 749               }
 750           }
 751
 752       elmt = pdump_opaque_data_list.first;
 753       while (elmt)
 754         {
 755           if (align_table[elmt->size & 255] == align)
 756             f (elmt, 0);
 757           elmt = elmt->next;
 758         }
 759     }
 760 }
 761
 762 static void
 763 pdump_dump_staticvec (void)
 764 {
 765   EMACS_INT *reloc = xnew_array (EMACS_INT, staticidx);
 766   int i;
 767   write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *));
 768
 769   for (i=0; i<staticidx; i++)
 770     {
 771       Lisp_Object obj = *staticvec[i];
 772       if (POINTER_TYPE_P (XTYPE (obj)))
 773         reloc[i] = pdump_get_entry (XRECORD_LHEADER (obj))->save_offset;
 774       else
 775         reloc[i] = *(EMACS_INT *)(staticvec[i]);
 776     }
 777   write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object));
 778   free (reloc);
 779 }
 780
 781 static void
 782 pdump_dump_structvec (void)
 783 {
 784   int i;
 785   for (i=0; i<dumpstructidx; i++)
 786     {
 787       EMACS_INT adr;
 788       write (pdump_fd, &(dumpstructvec[i].data), sizeof (void *));
 789       adr = pdump_get_entry (*(void **)(dumpstructvec[i].data))->save_offset;
 790       write (pdump_fd, &adr, sizeof (adr));
 791     }
 792 }
 793
 794 static void
 795 pdump_dump_opaquevec (void)
 796 {
 797   int i;
 798   for (i=0; i<dumpopaqueidx; i++)
 799     {
 800       write (pdump_fd, &(dumpopaquevec[i]), sizeof (dumpopaquevec[i]));
 801       write (pdump_fd, dumpopaquevec[i].data, dumpopaquevec[i].size);
 802     }
 803 }
 804
 805 static void
 806 pdump_dump_itable (void)
 807 {
 808   write (pdump_fd, lrecord_implementations_table, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
 809 }
 810
 811 static void
 812 pdump_dump_rtables (void)
 813 {
 814   int i, j;
 815   pdump_entry_list_elmt *elmt;
 816   pdump_reloc_table rt;
 817
 818   for (i=0; i<lrecord_type_count; i++)
 819     {
 820       elmt = pdump_object_table[i].first;
 821       if (!elmt)
 822         continue;
 823       rt.desc = lrecord_implementations_table[i]->description;
 824       rt.count = pdump_object_table[i].count;
 825       write (pdump_fd, &rt, sizeof (rt));
 826       while (elmt)
 827         {
 828           EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
 829           write (pdump_fd, &rdata, sizeof (rdata));
 830           elmt = elmt->next;
 831         }
 832     }
 833
 834   rt.desc = 0;
 835   rt.count = 0;
 836   write (pdump_fd, &rt, sizeof (rt));
 837
 838   for (i=0; i<pdump_struct_table.count; i++)
 839     {
 840       elmt = pdump_struct_table.list[i].list.first;
 841       rt.desc = pdump_struct_table.list[i].sdesc->description;
 842       rt.count = pdump_struct_table.list[i].list.count;
 843       write (pdump_fd, &rt, sizeof (rt));
 844       while (elmt)
 845         {
 846           EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
 847           for (j=0; j<elmt->count; j++)
 848             {
 849               write (pdump_fd, &rdata, sizeof (rdata));
 850               rdata += elmt->size;
 851             }
 852           elmt = elmt->next;
 853         }
 854     }
 855   rt.desc = 0;
 856   rt.count = 0;
 857   write (pdump_fd, &rt, sizeof (rt));
 858 }
 859
 860 static void
 861 pdump_dump_wired (void)
 862 {
 863   EMACS_INT count = pdump_wireidx + pdump_wireidx_list;
 864   int i;
 865
 866   write (pdump_fd, &count, sizeof (count));
 867
 868   for (i=0; i<pdump_wireidx; i++)
 869     {
 870       EMACS_INT obj = pdump_get_entry (XRECORD_LHEADER (*(pdump_wirevec[i])))->save_offset;
 871       write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i]));
 872       write (pdump_fd, &obj, sizeof (obj));
 873     }
 874
 875   for (i=0; i<pdump_wireidx_list; i++)
 876     {
 877       Lisp_Object obj = *(pdump_wirevec_list[i]);
 878       pdump_entry_list_elmt *elmt;
 879       EMACS_INT res;
 880
 881       for (;;)
 882         {
 883           const struct lrecord_description *desc;
 884           int pos;
 885           elmt = pdump_get_entry (XRECORD_LHEADER (obj));
 886           if (elmt)
 887             break;
 888           desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
 889           for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
 890             assert (desc[pos].type != XD_END);
 891
 892           obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
 893         }
 894       res = elmt->save_offset;
 895
 896       write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i]));
 897       write (pdump_fd, &res, sizeof (res));
 898     }
 899 }
 900
 901 void
 902 pdump (void)
 903 {
 904   int i;
 905   Lisp_Object t_console, t_device, t_frame;
 906   int none;
 907   dump_header hd;
 908
 909   /* These appear in a DEFVAR_LISP, which does a staticpro() */
 910   t_console = Vterminal_console;
 911   t_frame   = Vterminal_frame;
 912   t_device  = Vterminal_device;
 913
 914   Vterminal_console = Qnil;
 915   Vterminal_frame   = Qnil;
 916   Vterminal_device  = Qnil;
 917
 918   pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
 919
 920   for (i=0; i<lrecord_type_count; i++)
 921     {
 922       pdump_object_table[i].first = 0;
 923       pdump_object_table[i].align = 8;
 924       pdump_object_table[i].count = 0;
 925       pdump_alert_undump_object[i] = 0;
 926     }
 927   pdump_struct_table.count = 0;
 928   pdump_struct_table.size = -1;
 929
 930   pdump_opaque_data_list.first = 0;
 931   pdump_opaque_data_list.align = 8;
 932   pdump_opaque_data_list.count = 0;
 933   depth = 0;
 934
 935   for (i=0; i<staticidx; i++)
 936     pdump_register_object (*staticvec[i]);
 937   for (i=0; i<pdump_wireidx; i++)
 938     pdump_register_object (*pdump_wirevec[i]);
 939
 940   none = 1;
 941   for (i=0; i<lrecord_type_count; i++)
 942     if (pdump_alert_undump_object[i])
 943       {
 944         if (none)
 945           printf ("Undumpable types list :\n");
 946         none = 0;
 947         printf ("  - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
 948       }
 949   if (!none)
 950     return;
 951
 952   for (i=0; i<dumpstructidx; i++)
 953     pdump_register_struct (*(void **)(dumpstructvec[i].data), dumpstructvec[i].desc, 1);
 954
 955   memcpy (hd.signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN);
 956   hd.id = dump_id;
 957   hd.reloc_address = 0;
 958   hd.nb_staticpro = staticidx;
 959   hd.nb_structdmp = dumpstructidx;
 960   hd.nb_opaquedmp = dumpopaqueidx;
 961
 962   cur_offset = 256;
 963   max_size = 0;
 964
 965   pdump_scan_by_alignment (pdump_allocate_offset);
 966   pdump_qnil = pdump_get_entry (XRECORD_LHEADER (Qnil));
 967
 968   pdump_buf = xmalloc (max_size);
 969   /* Avoid use of the `open' macro.  We want the real function. */
 970 #undef open
 971   pdump_fd = open (EMACS_PROGNAME ".dmp",
 972                    O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
 973   hd.stab_offset = (cur_offset + 3) & ~3;
 974
 975   write (pdump_fd, &hd, sizeof (hd));
 976   lseek (pdump_fd, 256, SEEK_SET);
 977
 978   pdump_scan_by_alignment (pdump_dump_data);
 979
 980   lseek (pdump_fd, hd.stab_offset, SEEK_SET);
 981
 982   pdump_dump_staticvec ();
 983   pdump_dump_structvec ();
 984   pdump_dump_opaquevec ();
 985   pdump_dump_itable ();
 986   pdump_dump_rtables ();
 987   pdump_dump_wired ();
 988
 989   close (pdump_fd);
 990   free (pdump_buf);
 991
 992   free (pdump_hash);
 993
 994   Vterminal_console = t_console;
 995   Vterminal_frame   = t_frame;
 996   Vterminal_device  = t_device;
 997 }
 998
 999 static int pdump_load_check (void)
1000 {
1001   return (!memcmp (((dump_header *)pdump_start)->signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN)
1002           && ((dump_header *)pdump_start)->id == dump_id);
1003 }
1004
1005 static int pdump_load_finish (void)
1006 {
1007   int i;
1008   char *p;
1009   EMACS_INT delta;
1010   EMACS_INT count;
1011
1012   pdump_end = pdump_start + pdump_length;
1013
1014 #define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1))
1015
1016   staticidx = ((dump_header *)(pdump_start))->nb_staticpro;
1017   delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address;
1018   p = pdump_start + ((dump_header *)pdump_start)->stab_offset;
1019
1020   /* Put back the staticvec in place */
1021   memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *));
1022   p += staticidx*sizeof (Lisp_Object *);
1023   for (i=0; i<staticidx; i++)
1024     {
1025       Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
1026       if (POINTER_TYPE_P (XTYPE (obj)))
1027         XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta);
1028       *staticvec[i] = obj;
1029     }
1030
1031   /* Put back the dumpstructs */
1032   for (i=0; i<((dump_header *)pdump_start)->nb_structdmp; i++)
1033     {
1034       void **adr = PDUMP_READ (p, void **);
1035       *adr = (void *) (PDUMP_READ (p, char *) + delta);
1036     }
1037
1038   /* Put back the opaques */
1039   for (i=0; i<((dump_header *)pdump_start)->nb_opaquedmp; i++)
1040     {
1041       struct pdump_dumpopaqueinfo di = PDUMP_READ (p, struct pdump_dumpopaqueinfo);
1042       memcpy (di.data, p, di.size);
1043       p += di.size;
1044     }
1045
1046   /* Put back the lrecord_implementations_table */
1047   /* The (void *) cast is there to make Ben happy. */
1048   memcpy ((void *) lrecord_implementations_table, p, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
1049   p += lrecord_type_count*sizeof (lrecord_implementations_table[0]);
1050
1051   /* Reinitialize lrecord_markers from lrecord_implementations_table */
1052   for (i=0; i < lrecord_type_count; i++)
1053     if (lrecord_implementations_table[i])
1054       lrecord_markers[i] = lrecord_implementations_table[i]->marker;
1055
1056   /* Do the relocations */
1057   pdump_rt_list = p;
1058   count = 2;
1059   for (;;)
1060     {
1061       pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1062       if (rt.desc)
1063         {
1064           for (i=0; i < rt.count; i++)
1065             {
1066               char *adr = delta + *(char **)p;
1067               *(char **)p = adr;
1068               pdump_reloc_one (adr, delta, rt.desc);
1069               p += sizeof (char *);
1070             }
1071         } else
1072           if (!(--count))
1073             break;
1074     }
1075
1076   /* Put the pdump_wire variables in place */
1077   count = PDUMP_READ (p, EMACS_INT);
1078
1079   for (i=0; i<count; i++)
1080     {
1081       Lisp_Object *var = PDUMP_READ (p, Lisp_Object *);
1082       Lisp_Object  obj = PDUMP_READ (p, Lisp_Object);
1083
1084       if (POINTER_TYPE_P (XTYPE (obj)))
1085         XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta);
1086
1087       *var = obj;
1088     }
1089
1090   /* Final cleanups */
1091   /*   reorganize hash tables */
1092   p = pdump_rt_list;
1093   for (;;)
1094     {
1095       pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1096       if (!rt.desc)
1097         break;
1098       if (rt.desc == hash_table_description)
1099         {
1100           for (i=0; i < rt.count; i++)
1101             pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1102           break;
1103         } else
1104           p += sizeof (Lisp_Object) * rt.count;
1105     }
1106
1107   /* Put back noninteractive1 to its real value */
1108   noninteractive1 = noninteractive;
1109
1110   return 1;
1111 }
1112
1113 #ifdef WINDOWSNT
1114 /* Free the mapped file if we decide we don't want it after all */
1115 static void pdump_file_unmap(void)
1116 {
1117   UnmapViewOfFile (pdump_start);
1118   CloseHandle (pdump_hFile);
1119   CloseHandle (pdump_hMap);
1120 }
1121
1122 static int pdump_file_get(const char *path)
1123 {
1124
1125   pdump_hFile = CreateFile (path,
1126                             GENERIC_READ + GENERIC_WRITE,  /* Required for copy on write */
1127                             0,                      /* Not shared */
1128                             NULL,                   /* Not inheritable */
1129                             OPEN_EXISTING,
1130                             FILE_ATTRIBUTE_NORMAL,
1131                             NULL);                  /* No template file */
1132   if (pdump_hFile == INVALID_HANDLE_VALUE)
1133     return 0;
1134
1135   pdump_length = GetFileSize (pdump_hFile, NULL);
1136   pdump_hMap = CreateFileMapping (pdump_hFile,
1137                                   NULL,             /* No security attributes */
1138                                   PAGE_WRITECOPY,   /* Copy on write */
1139                                   0,                /* Max size, high half */
1140                                   0,                /* Max size, low half */
1141                                   NULL);            /* Unnamed */
1142   if (pdump_hMap == INVALID_HANDLE_VALUE)
1143     return 0;
1144
1145   pdump_start = MapViewOfFile (pdump_hMap,
1146                                FILE_MAP_COPY,  /* Copy on write */
1147                                0,             /* Start at zero */
1148                                0,
1149                                0);            /* Map all of it */
1150   pdump_free = pdump_file_unmap;
1151   return 1;
1152 }
1153
1154 /* pdump_resource_free is called (via the pdump_free pointer) to release
1155    any resources allocated by pdump_resource_get.  Since the Windows API
1156    specs specifically state that you don't need to (and shouldn't) free the
1157    resources allocated by FindResource, LoadResource, and LockResource this
1158    routine does nothing.  */
1159 static void pdump_resource_free (void)
1160 {
1161 }
1162
1163 static int pdump_resource_get (void)
1164 {
1165   HRSRC hRes;         /* Handle to dump resource */
1166   HRSRC hResLoad;             /* Handle to loaded dump resource */
1167
1168   /* See Q126630 which describes how Windows NT and 95 trap writes to
1169      resource sections and duplicate the page to allow the write to proceed.
1170      It also describes how to make the resource section read/write (and hence
1171      private to each process).  Doing this avoids the exceptions and related
1172      overhead, but causes the resource section to be private to each process
1173      that is running XEmacs.  Since the resource section contains little
1174      other than the dumped data, which should be private to each process, we
1175      make the whole resource section read/write so we don't have to copy it. */
1176
1177   hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1178   if (hRes == NULL)
1179     return 0;
1180
1181   /* Found it, use the data in the resource */
1182   hResLoad = LoadResource (NULL, hRes);
1183   if (hResLoad == NULL)
1184     return 0;
1185
1186   pdump_start = LockResource (hResLoad);
1187   if (pdump_start == NULL)
1188     return 0;
1189
1190   pdump_free = pdump_resource_free;
1191   pdump_length = SizeofResource (NULL, hRes);
1192   if (pdump_length <= sizeof(dump_header))
1193     {
1194       pdump_start = 0;
1195       return 0;
1196     }
1197
1198   return 1;
1199 }
1200
1201 #else /* !WINDOWSNT */
1202
1203 static void *pdump_mallocadr;
1204
1205 static void pdump_file_free(void)
1206 {
1207   xfree (pdump_mallocadr);
1208 }
1209
1210 #ifdef HAVE_MMAP
1211 static void pdump_file_unmap(void)
1212 {
1213   munmap (pdump_start, pdump_length);
1214 }
1215 #endif
1216
1217 static int pdump_file_get(const char *path)
1218 {
1219   int fd = open (path, O_RDONLY | OPEN_BINARY);
1220   if (fd<0)
1221     return 0;
1222
1223   pdump_length = lseek (fd, 0, SEEK_END);
1224   if (pdump_length < sizeof (dump_header))
1225     {
1226       close (fd);
1227       return 0;
1228     }
1229
1230   lseek (fd, 0, SEEK_SET);
1231
1232 #ifdef HAVE_MMAP
1233   pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1234   if (pdump_start != MAP_FAILED)
1235     {
1236       pdump_free = pdump_file_unmap;
1237       close (fd);
1238       return 1;
1239     }
1240 #endif
1241
1242   pdump_mallocadr = xmalloc(pdump_length+255);
1243   pdump_free = pdump_file_free;
1244   pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1245   read (pdump_fd, pdump_start, pdump_length);
1246
1247   close (pdump_fd);
1248   return 1;
1249 }
1250 #endif /* !WINDOWSNT */
1251
1252
1253 static int pdump_file_try(char *exe_path)
1254 {
1255   char *w;
1256
1257   w = exe_path + strlen(exe_path);
1258   do
1259     {
1260       sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1261       if (pdump_file_get (exe_path))
1262         {
1263           if (pdump_load_check ())
1264             return 1;
1265           pdump_free();
1266         }
1267
1268       sprintf (w, "-%08x.dmp", dump_id);
1269       if (pdump_file_get (exe_path))
1270         {
1271           if (pdump_load_check ())
1272             return 1;
1273           pdump_free();
1274         }
1275
1276       sprintf (w, ".dmp");
1277       if (pdump_file_get (exe_path))
1278         {
1279           if (pdump_load_check ())
1280             return 1;
1281           pdump_free();
1282         }
1283
1284       do
1285         w--;
1286       while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1287     }
1288   while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1289   return 0;
1290 }
1291
1292 int pdump_load(const char *argv0)
1293 {
1294   char exe_path[PATH_MAX];
1295 #ifdef WINDOWSNT
1296   GetModuleFileName (NULL, exe_path, PATH_MAX);
1297 #else /* !WINDOWSNT */
1298   char *w;
1299   const char *dir, *p;
1300
1301   dir = argv0;
1302   if (dir[0] == '-')
1303     {
1304       /* XEmacs as a login shell, oh goody! */
1305       dir = getenv("SHELL");
1306     }
1307
1308   p = dir + strlen(dir);
1309   while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1310
1311   if (p != dir)
1312     {
1313       /* invocation-name includes a directory component -- presumably it
1314          is relative to cwd, not $PATH */
1315       strcpy (exe_path, dir);
1316     }
1317   else
1318     {
1319       const char *path = getenv ("PATH");
1320       const char *name = p;
1321       for (;;)
1322         {
1323           p = path;
1324           while (*p && *p != SEPCHAR)
1325             p++;
1326           if (p == path)
1327             {
1328               exe_path[0] = '.';
1329               w = exe_path + 1;
1330             }
1331           else
1332             {
1333               memcpy (exe_path, path, p - path);
1334               w = exe_path + (p - path);
1335             }
1336           if (!IS_DIRECTORY_SEP (w[-1]))
1337             {
1338               *w++ = '/';
1339             }
1340           strcpy(w, name);
1341
1342           /* ### #$%$#^$^@%$^#%@$ ! */
1343 #ifdef access
1344 #undef access
1345 #endif
1346
1347           if (!access (exe_path, X_OK))
1348             break;
1349           if (!*p)
1350             {
1351               /* Oh well, let's have some kind of default */
1352               sprintf (exe_path, "./%s", name);
1353               break;
1354             }
1355           path = p+1;
1356         }
1357     }
1358 #endif /* WINDOWSNT */
1359
1360   if (pdump_file_try (exe_path))
1361     {
1362       pdump_load_finish ();
1363       return 1;
1364     }
1365
1366 #ifdef WINDOWSNT
1367   if (pdump_resource_get ())
1368     {
1369       if (pdump_load_check ())
1370         {
1371           pdump_load_finish ();
1372           return 1;
1373         }
1374       pdump_free ();
1375     }
1376 #endif
1377
1378   return 0;
1379 }