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