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