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