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