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