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