cgit.sxemacs.org Git - sxemacs/blob - src/dumper.c

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