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 #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   /* pdump_fd is already closed by the preceding fclose call
1075   close (pdump_fd); */
1076
1077   free (pdump_buf);
1078
1079   free (pdump_hash);
1080
1081   Vterminal_console = t_console;
1082   Vterminal_frame   = t_frame;
1083   Vterminal_device  = t_device;
1084 }
1085
1086 static int
1087 pdump_load_check (void)
1088 {
1089   return (!memcmp (((pdump_header *)pdump_start)->signature,
1090                    PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1091           && ((pdump_header *)pdump_start)->id == dump_id);
1092 }
1093
1094 /*----------------------------------------------------------------------*/
1095 /*                      Reading the dump file                           */
1096 /*----------------------------------------------------------------------*/
1097 static int
1098 pdump_load_finish (void)
1099 {
1100   int i;
1101   char *p;
1102   EMACS_INT delta;
1103   EMACS_INT count;
1104   pdump_header *header = (pdump_header *)pdump_start;
1105
1106   pdump_end = pdump_start + pdump_length;
1107
1108   delta = ((EMACS_INT)pdump_start) - header->reloc_address;
1109   p = pdump_start + header->stab_offset;
1110
1111   /* Put back the pdump_root_struct_ptrs */
1112   p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_pointer));
1113   for (i=0; i<header->nb_root_struct_ptrs; i++)
1114     {
1115       pdump_static_pointer ptr = PDUMP_READ (p, pdump_static_pointer);
1116       (* ptr.address) = ptr.value + delta;
1117     }
1118
1119   /* Put back the pdump_opaques */
1120   for (i=0; i<header->nb_opaques; i++)
1121     {
1122       pdump_opaque info = PDUMP_READ_ALIGNED (p, pdump_opaque);
1123       memcpy (info.varaddress, p, info.size);
1124       p += info.size;
1125     }
1126
1127   /* Do the relocations */
1128   pdump_rt_list = p;
1129   count = 2;
1130   for (;;)
1131     {
1132       pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table);
1133       p = (char *) ALIGN_PTR (p, ALIGNOF (char *));
1134       if (rt.desc)
1135         {
1136           char **reloc = (char **)p;
1137           for (i=0; i < rt.count; i++)
1138             {
1139               reloc[i] += delta;
1140               pdump_reloc_one (reloc[i], delta, rt.desc);
1141             }
1142           p += rt.count * sizeof (char *);
1143         } else
1144           if (!(--count))
1145             break;
1146     }
1147
1148   /* Put the pdump_root_objects variables in place */
1149   i = PDUMP_READ_ALIGNED (p, size_t);
1150   p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_Lisp_Object));
1151   while (i--)
1152     {
1153       pdump_static_Lisp_Object obj = PDUMP_READ (p, pdump_static_Lisp_Object);
1154
1155       if (POINTER_TYPE_P (XTYPE (obj.value)))
1156         obj.value = wrap_object ((char *) XPNTR (obj.value) + delta);
1157
1158       (* obj.address) = obj.value;
1159     }
1160
1161   /* Final cleanups */
1162   /*   reorganize hash tables */
1163   p = pdump_rt_list;
1164   for (;;)
1165     {
1166       pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table);
1167       p = (char *) ALIGN_PTR (p, ALIGNOF (Lisp_Object));
1168       if (!rt.desc)
1169         break;
1170       if (rt.desc == hash_table_description)
1171         {
1172           for (i=0; i < rt.count; i++)
1173             pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1174           break;
1175         } else
1176           p += sizeof (Lisp_Object) * rt.count;
1177     }
1178
1179   return 1;
1180 }
1181
1182 #ifdef WIN32_NATIVE
1183 /* Free the mapped file if we decide we don't want it after all */
1184 static void
1185 pdump_file_unmap (void)
1186 {
1187   UnmapViewOfFile (pdump_start);
1188   CloseHandle (pdump_hFile);
1189   CloseHandle (pdump_hMap);
1190 }
1191
1192 static int
1193 pdump_file_get (const char *path)
1194 {
1195
1196   pdump_hFile = CreateFile (path,
1197                             GENERIC_READ + GENERIC_WRITE,  /* Required for copy on write */
1198                             0,                      /* Not shared */
1199                             NULL,                   /* Not inheritable */
1200                             OPEN_EXISTING,
1201                             FILE_ATTRIBUTE_NORMAL,
1202                             NULL);                  /* No template file */
1203   if (pdump_hFile == INVALID_HANDLE_VALUE)
1204     return 0;
1205
1206   pdump_length = GetFileSize (pdump_hFile, NULL);
1207   pdump_hMap = CreateFileMapping (pdump_hFile,
1208                                   NULL,             /* No security attributes */
1209                                   PAGE_WRITECOPY,   /* Copy on write */
1210                                   0,                /* Max size, high half */
1211                                   0,                /* Max size, low half */
1212                                   NULL);            /* Unnamed */
1213   if (pdump_hMap == INVALID_HANDLE_VALUE)
1214     return 0;
1215
1216   pdump_start = MapViewOfFile (pdump_hMap,
1217                                FILE_MAP_COPY, /* Copy on write */
1218                                0,             /* Start at zero */
1219                                0,
1220                                0);            /* Map all of it */
1221   pdump_free = pdump_file_unmap;
1222   return 1;
1223 }
1224
1225 /* pdump_resource_free is called (via the pdump_free pointer) to release
1226    any resources allocated by pdump_resource_get.  Since the Windows API
1227    specs specifically state that you don't need to (and shouldn't) free the
1228    resources allocated by FindResource, LoadResource, and LockResource this
1229    routine does nothing.  */
1230 static void
1231 pdump_resource_free (void)
1232 {
1233 }
1234
1235 static int
1236 pdump_resource_get (void)
1237 {
1238   HRSRC hRes;                   /* Handle to dump resource */
1239   HRSRC hResLoad;               /* Handle to loaded dump resource */
1240
1241   /* See Q126630 which describes how Windows NT and 95 trap writes to
1242      resource sections and duplicate the page to allow the write to proceed.
1243      It also describes how to make the resource section read/write (and hence
1244      private to each process).  Doing this avoids the exceptions and related
1245      overhead, but causes the resource section to be private to each process
1246      that is running XEmacs.  Since the resource section contains little
1247      other than the dumped data, which should be private to each process, we
1248      make the whole resource section read/write so we don't have to copy it. */
1249
1250   hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1251   if (hRes == NULL)
1252     return 0;
1253
1254   /* Found it, use the data in the resource */
1255   hResLoad = LoadResource (NULL, hRes);
1256   if (hResLoad == NULL)
1257     return 0;
1258
1259   pdump_start = LockResource (hResLoad);
1260   if (pdump_start == NULL)
1261     return 0;
1262
1263   pdump_free = pdump_resource_free;
1264   pdump_length = SizeofResource (NULL, hRes);
1265   if (pdump_length <= sizeof (pdump_header))
1266     {
1267       pdump_start = 0;
1268       return 0;
1269     }
1270
1271   return 1;
1272 }
1273
1274 #else /* !WIN32_NATIVE */
1275
1276 static void
1277 pdump_file_free (void)
1278 {
1279   xfree (pdump_start);
1280 }
1281
1282 #ifdef HAVE_MMAP
1283 static void
1284 pdump_file_unmap (void)
1285 {
1286   munmap (pdump_start, pdump_length);
1287 }
1288 #endif
1289
1290 static int
1291 pdump_file_get (const char *path)
1292 {
1293   int fd = open (path, O_RDONLY | OPEN_BINARY);
1294   if (fd<0)
1295     return 0;
1296
1297   pdump_length = lseek (fd, 0, SEEK_END);
1298   if (pdump_length < sizeof (pdump_header))
1299     {
1300       close (fd);
1301       return 0;
1302     }
1303
1304   lseek (fd, 0, SEEK_SET);
1305
1306 #ifdef HAVE_MMAP
1307 /* Unix 98 requires that sys/mman.h define MAP_FAILED,
1308    but many earlier implementations don't. */
1309 # ifndef MAP_FAILED
1310 #  define MAP_FAILED ((void *) -1L)
1311 # endif
1312   pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1313   if (pdump_start != (char *) MAP_FAILED)
1314     {
1315       pdump_free = pdump_file_unmap;
1316       close (fd);
1317       return 1;
1318     }
1319 #endif /* HAVE_MMAP */
1320
1321   pdump_start = xnew_array (char, pdump_length);
1322   pdump_free = pdump_file_free;
1323   read (fd, pdump_start, pdump_length);
1324
1325   close (fd);
1326   return 1;
1327 }
1328 #endif /* !WIN32_NATIVE */
1329
1330
1331 static int
1332 pdump_file_try (char *exe_path)
1333 {
1334   char *w = exe_path + strlen (exe_path);
1335
1336   do
1337     {
1338       sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1339       if (pdump_file_get (exe_path))
1340         {
1341           if (pdump_load_check ())
1342             return 1;
1343           pdump_free ();
1344         }
1345
1346       sprintf (w, "-%08x.dmp", dump_id);
1347       if (pdump_file_get (exe_path))
1348         {
1349           if (pdump_load_check ())
1350             return 1;
1351           pdump_free ();
1352         }
1353
1354       sprintf (w, ".dmp");
1355       if (pdump_file_get (exe_path))
1356         {
1357           if (pdump_load_check ())
1358             return 1;
1359           pdump_free ();
1360         }
1361
1362       do
1363         w--;
1364       while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1365     }
1366   while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1367   return 0;
1368 }
1369
1370 int
1371 pdump_load (const char *argv0)
1372 {
1373   char exe_path[PATH_MAX], real_exe_path[PATH_MAX];
1374 #ifdef WIN32_NATIVE
1375   GetModuleFileName (NULL, exe_path, PATH_MAX);
1376   /* #### urk, needed for xrealpath() below */
1377   Vdirectory_sep_char = make_char ('\\');
1378 #else /* !WIN32_NATIVE */
1379   char *w;
1380   const char *dir, *p;
1381
1382   dir = argv0;
1383   if (dir[0] == '-')
1384     {
1385       /* XEmacs as a login shell, oh goody! */
1386       dir = getenv ("SHELL");
1387     }
1388
1389   p = dir + strlen (dir);
1390   while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1391
1392   if (p != dir)
1393     {
1394       /* invocation-name includes a directory component -- presumably it
1395          is relative to cwd, not $PATH */
1396       strcpy (exe_path, dir);
1397     }
1398   else
1399     {
1400       const char *path = getenv ("PATH");
1401       const char *name = p;
1402       for (;;)
1403         {
1404           p = path;
1405           while (*p && *p != SEPCHAR)
1406             p++;
1407           if (p == path)
1408             {
1409               exe_path[0] = '.';
1410               w = exe_path + 1;
1411             }
1412           else
1413             {
1414               memcpy (exe_path, path, p - path);
1415               w = exe_path + (p - path);
1416             }
1417           if (!IS_DIRECTORY_SEP (w[-1]))
1418             {
1419               *w++ = '/';
1420             }
1421           strcpy (w, name);
1422
1423           /* Check that exe_path is executable and not a directory */
1424 #undef access /* avoid !@#$%^& encapsulated access */
1425 #undef stat   /* avoid !@#$%^& encapsulated stat */
1426           {
1427             struct stat statbuf;
1428             if (access (exe_path, X_OK) == 0
1429                 && stat (exe_path, &statbuf) == 0
1430                 && ! S_ISDIR (statbuf.st_mode))
1431               break;
1432           }
1433
1434           if (!*p)
1435             {
1436               /* Oh well, let's have some kind of default */
1437               sprintf (exe_path, "./%s", name);
1438               break;
1439             }
1440           path = p+1;
1441         }
1442     }
1443 #endif /* WIN32_NATIVE */
1444
1445   /* Save exe_path because pdump_file_try() modifies it */
1446   strcpy(real_exe_path, exe_path);
1447   if (pdump_file_try (exe_path)
1448       || (xrealpath(real_exe_path, real_exe_path)
1449           && pdump_file_try (real_exe_path)))
1450     {
1451       pdump_load_finish ();
1452       return 1;
1453     }
1454
1455 #ifdef WIN32_NATIVE
1456   if (pdump_resource_get ())
1457     {
1458       if (pdump_load_check ())
1459         {
1460           pdump_load_finish ();
1461           return 1;
1462         }
1463       pdump_free ();
1464     }
1465 #endif
1466
1467   return 0;
1468 }