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