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                 }
 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 static void
 607 pdump_dump_data(pdump_entry_list_elt * elt,
 608                 const struct lrecord_description *desc)
 609 {
 610         size_t size = elt->size;
 611         int count = elt->count;
 612         if (desc) {
 613                 int pos, i;
 614                 memcpy(pdump_buf, elt->obj, size * count);
 615
 616                 for (i = 0; i < count; i++) {
 617                         char *cur = ((char *)pdump_buf) + i * size;
 618                       restart:
 619                         for (pos = 0; desc[pos].type != XD_END; pos++) {
 620                                 void *rdata = cur + desc[pos].offset;
 621                                 switch (desc[pos].type) {
 622                                 case XD_SPECIFIER_END:
 623                                         desc = ((const Lisp_Specifier *)
 624                                                 (elt->obj))->
 625                                                 methods->extra_description;
 626                                         goto restart;
 627                                 case XD_SIZE_T:
 628                                 case XD_INT:
 629                                 case XD_LONG:
 630                                 case XD_BYTECOUNT:
 631                                         break;
 632                                 case XD_INT_RESET: {
 633                                         EMACS_INT val = desc[pos].data1;
 634                                         if (XD_IS_INDIRECT(val))
 635                                                 val = pdump_get_indirect_count(
 636                                                         val, desc, elt->obj);
 637                                         *(int *)rdata = val;
 638                                         break;
 639                                 }
 640                                 case XD_OPAQUE_DATA_PTR:
 641                                 case XD_C_STRING:
 642                                 case XD_STRUCT_PTR: {
 643                                         void *ptr = *(void**)rdata;
 644                                         if (ptr) {
 645                                                 *(EMACS_INT*) rdata =
 646                                                         pdump_get_entry
 647                                                         (ptr)->save_offset;
 648                                         }
 649                                         break;
 650                                 }
 651                                 case XD_LO_LINK: {
 652                                         Lisp_Object obj = *(Lisp_Object*)rdata;
 653                                         pdump_entry_list_elt *elt1;
 654
 655                                         for (;;) {
 656                                                 elt1 = pdump_get_entry(
 657                                                         XRECORD_LHEADER(obj));
 658                                                 if (elt1) {
 659                                                         break;
 660                                                 }
 661                                                 obj = *(Lisp_Object*)(
 662                                                         desc[pos].offset +
 663                                                         (char*)
 664                                                         (XRECORD_LHEADER(obj)));
 665                                         }
 666                                         *(EMACS_INT *) rdata =
 667                                                 elt1->save_offset;
 668                                         break;
 669                                 }
 670                                 case XD_LISP_OBJECT: {
 671                                         Lisp_Object *pobj =
 672                                                 (Lisp_Object*)rdata;
 673
 674                                         assert(desc[pos].data1 == 0);
 675
 676                                         if (POINTER_TYPE_P(XTYPE(*pobj))
 677                                             && XRECORD_LHEADER(*pobj)) {
 678                                                 *(EMACS_INT*)pobj =
 679                                                         pdump_get_entry
 680                                                         (XRECORD_LHEADER(*pobj))
 681                                                         ->save_offset;
 682                                         }
 683                                         break;
 684                                 }
 685                                 case XD_LISP_OBJECT_ARRAY: {
 686                                         EMACS_INT num = desc[pos].data1;
 687                                         int j;
 688
 689                                         if (XD_IS_INDIRECT(num)) {
 690                                                 num = pdump_get_indirect_count(
 691                                                         num, desc, elt->obj);
 692                                         }
 693                                         for (j = 0; j < num; j++) {
 694                                                 Lisp_Object *pobj =
 695                                                         ((Lisp_Object*)rdata) +
 696                                                         j;
 697                                                 if (POINTER_TYPE_P(
 698                                                             XTYPE(*pobj)) &&
 699                                                     XRECORD_LHEADER(*pobj)) {
 700                                                         *(EMACS_INT *)
 701                                                                 pobj =
 702                                                                 pdump_get_entry
 703                                                                 (XRECORD_LHEADER
 704                                                                  (*pobj))->
 705                                                                 save_offset;
 706                                                 }
 707                                         }
 708                                         break;
 709                                 }
 710                                 case XD_DOC_STRING: {
 711                                         EMACS_INT str = *(EMACS_INT*)rdata;
 712                                         if (str > 0) {
 713                                                 *(EMACS_INT*)rdata =
 714                                                         pdump_get_entry(
 715                                                                 (void *)str)
 716                                                         ->save_offset;
 717                                         }
 718                                         break;
 719                                 }
 720
 721                                 case XD_OPAQUE_PTR:
 722                                 case XD_END:
 723                                 default:
 724                                         stderr_out
 725                                             ("Unsupported dump type : %d\n",
 726                                              desc[pos].type);
 727                                         abort();
 728                                 }
 729                         }
 730                 }
 731         }
 732         fwrite(desc ? pdump_buf : elt->obj, size, count, pdump_out);
 733 }
 734
 735 static void
 736 pdump_reloc_one(void *data, EMACS_INT delta,
 737                 const struct lrecord_description *desc)
 738 {
 739         int pos;
 740
 741 restart:
 742         for (pos = 0; desc[pos].type != XD_END; pos++) {
 743                 void *rdata = (char *)data + desc[pos].offset;
 744                 switch (desc[pos].type) {
 745                 case XD_SPECIFIER_END:
 746                         pos = 0;
 747                         desc = ((const Lisp_Specifier *)data)->methods->
 748                                 extra_description;
 749                         goto restart;
 750                 case XD_SIZE_T:
 751                 case XD_INT:
 752                 case XD_LONG:
 753                 case XD_BYTECOUNT:
 754                 case XD_INT_RESET:
 755                         break;
 756                 case XD_OPAQUE_DATA_PTR:
 757                 case XD_C_STRING:
 758                 case XD_STRUCT_PTR:
 759                 case XD_LO_LINK: {
 760                         EMACS_INT ptr = *(EMACS_INT *) rdata;
 761                         if (ptr) {
 762                                 *(EMACS_INT *) rdata = ptr + delta;
 763                         }
 764                         break;
 765                 }
 766                 case XD_LISP_OBJECT: {
 767                         Lisp_Object *pobj = (Lisp_Object *) rdata;
 768
 769                         assert(desc[pos].data1 == 0);
 770
 771                         if (POINTER_TYPE_P(XTYPE(*pobj))
 772                             && !EQ(*pobj, Qnull_pointer))
 773                                 XSETOBJ(*pobj,
 774                                         (char *)XPNTR(*pobj) + delta);
 775
 776                         break;
 777                 }
 778                 case XD_LISP_OBJECT_ARRAY: {
 779                         EMACS_INT num = desc[pos].data1;
 780                         int j;
 781                         if (XD_IS_INDIRECT(num)) {
 782                                 num = pdump_get_indirect_count(num, desc, data);
 783                         }
 784                         for (j = 0; j < num; j++) {
 785                                 Lisp_Object *pobj = (Lisp_Object*)rdata + j;
 786
 787                                 if (POINTER_TYPE_P(XTYPE(*pobj))
 788                                     && !EQ(*pobj, Qnull_pointer)) {
 789                                         XSETOBJ(*pobj,
 790                                                 (char *)XPNTR(*pobj) + delta);
 791                                 }
 792                         }
 793                         break;
 794                 }
 795                 case XD_DOC_STRING: {
 796                         EMACS_INT str = *(EMACS_INT *) rdata;
 797                         if (str > 0) {
 798                                 *(EMACS_INT *) rdata = str + delta;
 799                         }
 800                         break;
 801                 }
 802
 803                 case XD_OPAQUE_PTR:
 804                 case XD_END:
 805                 default:
 806                         stderr_out("Unsupported dump type : %d\n",
 807                                    desc[pos].type);
 808                         abort();
 809                 };
 810         }
 811 }
 812
 813 static void
 814 pdump_allocate_offset(pdump_entry_list_elt * elt,
 815                       const struct lrecord_description *desc)
 816 {
 817         size_t size = elt->count * elt->size;
 818         elt->save_offset = cur_offset;
 819         if (size > max_size)
 820                 max_size = size;
 821         cur_offset += size;
 822 }
 823
 824 static void
 825 pdump_scan_by_alignment(void (*f) (pdump_entry_list_elt *,
 826                                    const struct lrecord_description *))
 827 {
 828         int align;
 829
 830         for (align = ALIGNOF(max_align_t); align; align >>= 1) {
 831                 size_t i;
 832                 pdump_entry_list_elt *elt;
 833
 834                 for (i = 0; i < lrecord_type_count; i++)
 835                         if (pdump_object_table[i].align == align)
 836                                 for (elt = pdump_object_table[i].first; elt;
 837                                      elt = elt->next)
 838                                         f(elt,
 839                                           lrecord_implementations_table[i]->
 840                                           description);
 841
 842                 for (i = 0; i < (size_t)pdump_struct_table.count; i++) {
 843                         pdump_struct_list_elt list = pdump_struct_table.list[i];
 844                         if (list.list.align == align)
 845                                 for (elt = list.list.first; elt;
 846                                      elt = elt->next)
 847                                         f(elt, list.sdesc->description);
 848                 }
 849
 850                 for (elt = pdump_opaque_data_list.first; elt; elt = elt->next)
 851                         if (pdump_size_to_align(elt->size) ==
 852                             (unsigned int)align)
 853                                 f(elt, 0);
 854         }
 855 }
 856
 857 static void pdump_dump_root_struct_ptrs(void)
 858 {
 859         size_t i;
 860         size_t count = Dynarr_length(pdump_root_struct_ptrs);
 861         pdump_static_pointer *data = alloca_array(pdump_static_pointer, count);
 862         for (i = 0; i < count; i++) {
 863                 data[i].address =
 864                     (char **)Dynarr_atp(pdump_root_struct_ptrs, i)->ptraddress;
 865                 data[i].value =
 866                     (char *)pdump_get_entry(*data[i].address)->save_offset;
 867         }
 868         PDUMP_ALIGN_OUTPUT(pdump_static_pointer);
 869         fwrite(data, sizeof(pdump_static_pointer), count, pdump_out);
 870 }
 871
 872 static void pdump_dump_opaques(void)
 873 {
 874         int i;
 875         for (i = 0; i < Dynarr_length(pdump_opaques); i++) {
 876                 pdump_opaque *info = Dynarr_atp(pdump_opaques, i);
 877                 PDUMP_WRITE_ALIGNED(pdump_opaque, *info);
 878                 fwrite(info->varaddress, info->size, 1, pdump_out);
 879         }
 880 }
 881
 882 static void pdump_dump_rtables(void)
 883 {
 884         size_t i;
 885         pdump_entry_list_elt *elt;
 886         pdump_reloc_table rt;
 887
 888         for (i = 0; i < lrecord_type_count; i++) {
 889                 elt = pdump_object_table[i].first;
 890                 if (!elt)
 891                         continue;
 892                 rt.desc = lrecord_implementations_table[i]->description;
 893                 rt.count = pdump_object_table[i].count;
 894                 PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 895                 while (elt) {
 896                         EMACS_INT rdata =
 897                             pdump_get_entry(elt->obj)->save_offset;
 898                         PDUMP_WRITE_ALIGNED(EMACS_INT, rdata);
 899                         elt = elt->next;
 900                 }
 901         }
 902
 903         rt.desc = 0;
 904         rt.count = 0;
 905         PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 906
 907         for (i = 0; i < (size_t)pdump_struct_table.count; i++) {
 908                 elt = pdump_struct_table.list[i].list.first;
 909                 rt.desc = pdump_struct_table.list[i].sdesc->description;
 910                 rt.count = pdump_struct_table.list[i].list.count;
 911                 PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 912                 while (elt) {
 913                         EMACS_INT rdata =
 914                             pdump_get_entry(elt->obj)->save_offset;
 915                         int j;
 916                         for (j = 0; j < elt->count; j++) {
 917                                 PDUMP_WRITE_ALIGNED(EMACS_INT, rdata);
 918                                 rdata += elt->size;
 919                         }
 920                         elt = elt->next;
 921                 }
 922         }
 923         rt.desc = 0;
 924         rt.count = 0;
 925         PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 926 }
 927
 928 static void pdump_dump_root_objects(void)
 929 {
 930         size_t count = (Dynarr_length(pdump_root_objects) +
 931                         Dynarr_length(pdump_weak_object_chains));
 932         EMACS_INT i;
 933
 934         PDUMP_WRITE_ALIGNED(size_t, count);
 935         PDUMP_ALIGN_OUTPUT(pdump_static_Lisp_Object);
 936
 937         for (i = 0; i < Dynarr_length(pdump_root_objects); i++) {
 938                 pdump_static_Lisp_Object obj;
 939                 obj.address = Dynarr_at(pdump_root_objects, i);
 940                 obj.value = *obj.address;
 941
 942                 if (POINTER_TYPE_P(XTYPE(obj.value)))
 943                         obj.value =
 944                             wrap_object((void *)
 945                                         pdump_get_entry(XRECORD_LHEADER
 946                                                         (obj.value))->
 947                                         save_offset);
 948
 949                 PDUMP_WRITE(pdump_static_Lisp_Object, obj);
 950         }
 951
 952         for (i = 0; i < Dynarr_length(pdump_weak_object_chains); i++) {
 953                 pdump_entry_list_elt *elt;
 954                 pdump_static_Lisp_Object obj;
 955
 956                 obj.address = Dynarr_at(pdump_weak_object_chains, i);
 957                 obj.value = *obj.address;
 958
 959                 for (;;) {
 960                         const struct lrecord_description *desc;
 961                         int pos;
 962                         elt = pdump_get_entry(XRECORD_LHEADER(obj.value));
 963                         if (elt)
 964                                 break;
 965                         desc =
 966                             XRECORD_LHEADER_IMPLEMENTATION(obj.value)->
 967                             description;
 968                         for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
 969                                 assert(desc[pos].type != XD_END);
 970
 971                         obj.value =
 972                             *(Lisp_Object *) (desc[pos].offset +
 973                                               (char
 974                                                *)(XRECORD_LHEADER(obj.value)));
 975                 }
 976                 obj.value = wrap_object((void *)elt->save_offset);
 977
 978                 PDUMP_WRITE(pdump_static_Lisp_Object, obj);
 979         }
 980 }
 981
 982 void
 983 pdump(const char *dumpfile)
 984 {
 985         size_t i;
 986         Lisp_Object t_console, t_device, t_frame;
 987         int none;
 988         pdump_header header;
 989
 990         pdump_object_table = xnew_array(pdump_entry_list, lrecord_type_count);
 991         pdump_alert_undump_object = xnew_array(int, lrecord_type_count);
 992
 993         assert(ALIGNOF(max_align_t) <= pdump_align_table[0]);
 994
 995         for (i = 0; i < countof(pdump_align_table); i++)
 996                 if (pdump_align_table[i] > ALIGNOF(max_align_t))
 997                         pdump_align_table[i] = ALIGNOF(max_align_t);
 998
 999         flush_all_buffer_local_cache();
1000
1001         /* These appear in a DEFVAR_LISP, which does a staticpro() */
1002         t_console = Vterminal_console;
1003         Vterminal_console = Qnil;
1004         t_frame = Vterminal_frame;
1005         Vterminal_frame = Qnil;
1006         t_device = Vterminal_device;
1007         Vterminal_device = Qnil;
1008
1009         dump_add_opaque((void *)&lrecord_implementations_table,
1010                         lrecord_type_count *
1011                         sizeof(lrecord_implementations_table[0]));
1012         dump_add_opaque(&lrecord_markers,
1013                         lrecord_type_count * sizeof(lrecord_markers[0]));
1014
1015         pdump_hash = xnew_array_and_zero(pdump_entry_list_elt*, PDUMP_HASHSIZE);
1016
1017         for (i = 0; i < lrecord_type_count; i++) {
1018                 pdump_object_table[i].first = 0;
1019                 pdump_object_table[i].align = ALIGNOF(max_align_t);
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 = ALIGNOF(max_align_t);
1028         pdump_opaque_data_list.count = 0;
1029         depth = 0;
1030
1031         for (i = 0; i < (size_t)Dynarr_length(pdump_root_objects); i++) {
1032                 pdump_register_object(*Dynarr_at(pdump_root_objects, i));
1033         }
1034
1035         none = 1;
1036         for (i = 0; i < lrecord_type_count; i++)
1037                 if (pdump_alert_undump_object[i]) {
1038                         if (none)
1039                                 printf("Undumpable types list :\n");
1040                         none = 0;
1041                         printf("  - %s (%d)\n",
1042                                lrecord_implementations_table[i]->name,
1043                                pdump_alert_undump_object[i]);
1044                 }
1045         if (!none) {
1046                 return;
1047         }
1048
1049         for (i = 0; i < (size_t) Dynarr_length(pdump_root_struct_ptrs); i++) {
1050                 pdump_root_struct_ptr info =
1051                         Dynarr_at(pdump_root_struct_ptrs, i);
1052                 pdump_register_struct(*(info.ptraddress), info.desc, 1);
1053         }
1054
1055         memcpy(header.signature, PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN);
1056         header.id = dump_id;
1057         header.reloc_address = 0;
1058         header.nb_root_struct_ptrs = Dynarr_length(pdump_root_struct_ptrs);
1059         header.nb_opaques = Dynarr_length(pdump_opaques);
1060
1061         cur_offset = ALIGN_SIZE(sizeof(header), ALIGNOF(max_align_t));
1062         max_size = 0;
1063
1064         pdump_scan_by_alignment(pdump_allocate_offset);
1065         cur_offset = ALIGN_SIZE(cur_offset, ALIGNOF(max_align_t));
1066         header.stab_offset = cur_offset;
1067
1068         pdump_buf = xmalloc_atomic(max_size);
1069         /* Avoid use of the `open' macro.  We want the real function. */
1070 #undef open
1071         pdump_fd = open(dumpfile,
1072                         O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
1073         if ( pdump_fd < 0 ) {
1074                 stderr_out("Could not open dump file: %s", dumpfile);
1075                 abort();
1076         } else {
1077                 pdump_out = fdopen(pdump_fd, "w");
1078                 if ( pdump_out < 0 ) {
1079                         stderr_out("Could not fdopen dump file: %s %d",
1080                                    dumpfile, pdump_fd);
1081                         abort();
1082                 } else {
1083
1084                         fwrite(&header, sizeof(header), 1, pdump_out);
1085                         PDUMP_ALIGN_OUTPUT(max_align_t);
1086
1087                         pdump_scan_by_alignment(pdump_dump_data);
1088
1089                         fseek(pdump_out, header.stab_offset, SEEK_SET);
1090
1091                         pdump_dump_root_struct_ptrs();
1092                         pdump_dump_opaques();
1093                         pdump_dump_rtables();
1094                         pdump_dump_root_objects();
1095
1096                         fclose(pdump_out);
1097                         close(pdump_fd);
1098
1099                         xfree(pdump_buf);
1100
1101                         xfree(pdump_hash);
1102
1103                         Vterminal_console = t_console;
1104                         Vterminal_frame = t_frame;
1105                         Vterminal_device = t_device;
1106                 }
1107         }
1108 }
1109
1110 static int pdump_load_check(void)
1111 {
1112         return (!memcmp(((pdump_header*)pdump_start)->signature,
1113                         PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1114                 && ((pdump_header *)pdump_start)->id == dump_id);
1115 }
1116
1117 /*----------------------------------------------------------------------*/
1118 /*                      Reading the dump file                           */
1119 /*----------------------------------------------------------------------*/
1120 static int
1121 pdump_load_finish(void)
1122 {
1123         char *p;
1124         EMACS_INT delta;
1125         pdump_header *header = (pdump_header*)pdump_start;
1126
1127 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1128         int cache_GC_dont_gc = GC_dont_gc;
1129
1130         GC_dont_gc = 1;
1131 #endif  /* BDWGC */
1132
1133         pdump_end = pdump_start + pdump_length;
1134
1135         delta = ((EMACS_INT)pdump_start) - header->reloc_address;
1136         p = pdump_start + header->stab_offset;
1137
1138         /* Put back the pdump_root_struct_ptrs */
1139         p = (char*)ALIGN_PTR(p, ALIGNOF(pdump_static_pointer));
1140         for (int i = 0; i < header->nb_root_struct_ptrs; i++) {
1141                 pdump_static_pointer ptr = PDUMP_READ(p, pdump_static_pointer);
1142                 (*ptr.address) = ptr.value + delta;
1143         }
1144
1145         /* Put back the pdump_opaques */
1146         for (int i = 0; i < header->nb_opaques; i++) {
1147                 pdump_opaque info = PDUMP_READ_ALIGNED(p, pdump_opaque);
1148                 memcpy(info.varaddress, p, info.size);
1149                 p += info.size;
1150         }
1151
1152         /* Do the relocations */
1153         pdump_rt_list = p;
1154         for (EMACS_INT count = 2;;) {
1155                 pdump_reloc_table rt = PDUMP_READ_ALIGNED(p, pdump_reloc_table);
1156                 p = (char*)ALIGN_PTR(p, ALIGNOF(char*));
1157                 if (rt.desc) {
1158                         char **reloc = (char**)p;
1159                         for (int i = 0; i < rt.count; i++) {
1160                                 reloc[i] += delta;
1161                                 pdump_reloc_one(reloc[i], delta, rt.desc);
1162                         }
1163                         p += rt.count * sizeof(char *);
1164                 } else if (!(--count)) {
1165                         break;
1166                 }
1167         }
1168
1169         /* Put the pdump_root_objects variables in place */
1170         p = (char*)ALIGN_PTR(p, ALIGNOF(pdump_static_Lisp_Object));
1171
1172         for (int i = PDUMP_READ_ALIGNED(p, size_t); i--; ) {
1173                 pdump_static_Lisp_Object obj =
1174                         PDUMP_READ(p, pdump_static_Lisp_Object);
1175
1176                 if (POINTER_TYPE_P(XTYPE(obj.value))) {
1177                         obj.value =
1178                                 wrap_object((char*)XPNTR(obj.value) + delta);
1179                 }
1180                 (*obj.address) = obj.value;
1181         }
1182
1183         /* Final cleanups */
1184         /* reorganize hash tables */
1185         p = pdump_rt_list;
1186         for (;;) {
1187                 pdump_reloc_table rt = PDUMP_READ_ALIGNED(p, pdump_reloc_table);
1188                 p = (char*)ALIGN_PTR(p, ALIGNOF(Lisp_Object));
1189
1190                 if (!rt.desc) {
1191                         break;
1192                 }
1193                 if (rt.desc == hash_table_description) {
1194                         for (int i = 0; i < rt.count; i++) {
1195                                 pdump_reorganize_hash_table(
1196                                         PDUMP_READ(p, Lisp_Object));
1197                         }
1198                         break;
1199                 } else {
1200                         p += sizeof(Lisp_Object) * rt.count;
1201                 }
1202         }
1203
1204 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1205         GC_dont_gc = cache_GC_dont_gc;
1206 #endif  /* BDWGC */
1207         return 1;
1208 }
1209
1210
1211 static void pdump_file_free(void)
1212 {
1213         xfree(pdump_start);
1214         return;
1215 }
1216
1217 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1218 # if defined HAVE_MMAP
1219 static void pdump_file_unmap(void)
1220 {
1221         munmap(pdump_start, pdump_length);
1222 }
1223 # endif  /* HAVE_MMAP */
1224 #endif  /* !BDWGC */
1225
1226 static int pdump_file_get(const char *path)
1227 {
1228         int fd = open(path, O_RDONLY | OPEN_BINARY);
1229
1230         if (UNLIKELY(fd < 0)) {
1231                 return 0;
1232         }
1233
1234         pdump_length = lseek(fd, 0, SEEK_END);
1235         if (UNLIKELY(pdump_length < sizeof(pdump_header))) {
1236                 close(fd);
1237                 return 0;
1238         }
1239
1240         lseek(fd, 0, SEEK_SET);
1241
1242 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1243 # if defined HAVE_MMAP
1244 /* Unix 98 requires that sys/mman.h define MAP_FAILED,
1245    but many earlier implementations don't. */
1246 #  ifndef MAP_FAILED
1247 #   define MAP_FAILED ((void*)-1L)
1248 #  endif  /* MAP_FAILED */
1249         pdump_start = (char*)mmap(0, pdump_length,
1250                                   PROT_READ | PROT_WRITE, MAP_PRIVATE,
1251                                   fd, 0);
1252         if (LIKELY(pdump_start != (char*)MAP_FAILED)) {
1253                 pdump_free = pdump_file_unmap;
1254                 close(fd);
1255                 return 1;
1256         }
1257 # endif /* HAVE_MMAP */
1258 #endif  /* !BDWGC */
1259
1260         pdump_start = xnew_array(char, pdump_length);
1261         pdump_free = pdump_file_free;
1262         read(fd, pdump_start, pdump_length);
1263
1264         close(fd);
1265         return 1;
1266 }
1267
1268 static int pdump_file_try(char *exe_path, size_t size)
1269 {
1270         char *w = exe_path + strlen(exe_path);
1271         int sz;
1272         size -= strlen(exe_path);
1273
1274         do {
1275
1276 #ifdef EMACS_PATCH_LEVEL
1277                 sz = snprintf(w, size, "-%d.%d.%d-%08x.dmp",
1278                          EMACS_MAJOR_VERSION, EMACS_MINOR_VERSION,
1279                          EMACS_PATCH_LEVEL, dump_id);
1280                 if (sz >=0 && sz < size && pdump_file_get(exe_path)) {
1281                         if (pdump_load_check()) {
1282                                 return 1;
1283                         }
1284                         pdump_free();
1285                 }
1286 #endif  /* EMACS_PATCH_LEVEL */
1287 #ifdef EMACS_BETA_VERSION
1288                 sz = snprintf(w, size, "-%d.%d.%d-%08x.dmp",
1289                          EMACS_MAJOR_VERSION, EMACS_MINOR_VERSION,
1290                          EMACS_BETA_VERSION, dump_id);
1291                 if (sz >=0 && (size_t)sz < size && pdump_file_get(exe_path)) {
1292                         if (pdump_load_check()) {
1293                                 return 1;
1294                         }
1295                         pdump_free();
1296                 }
1297 #endif  /* EMACS_BETA_VERSION */
1298
1299                 sz = snprintf(w, size, "-%08x.dmp", dump_id);
1300                 if (sz >=0 && (size_t)sz < size && pdump_file_get(exe_path)) {
1301                         if (pdump_load_check()) {
1302                                 return 1;
1303                         }
1304                         pdump_free();
1305                 }
1306
1307                 sz = snprintf(w, size, ".dmp");
1308                 if (sz >=0 && (size_t)sz < size && pdump_file_get(exe_path)) {
1309                         if (pdump_load_check()) {
1310                                 return 1;
1311                         }
1312                         pdump_free();
1313                 }
1314
1315                 do {
1316                         w--;
1317                 } while (w > exe_path && !IS_DIRECTORY_SEP(*w) && (*w != '-')
1318                          && (*w != '.'));
1319         } while (w > exe_path && !IS_DIRECTORY_SEP(*w));
1320         return 0;
1321 }
1322
1323 static inline void
1324 wipe_out_libtool_stuff(char *path)
1325 {
1326 #define dotlibs         ".libs/"
1327 #define ltdash          "lt-"
1328         char *p;
1329
1330         for (p = strchr(path, '.'); p; p = strchr(p+1, '.')) {
1331                 short dotlibsp =
1332                         strncmp(p, dotlibs, sizeof(dotlibs)-1);
1333                 short ltdashp =
1334                         strncmp(p+sizeof(dotlibs)-1, ltdash, sizeof(ltdash)-1);
1335                 if ((dotlibsp || ltdashp) == 0) {
1336                         /* cut out the `.libs/lt-' portion */
1337                         size_t offs = sizeof(dotlibs)-1+sizeof(ltdash)-1;
1338                         size_t rest = strlen(p + offs);
1339                         memmove(p, p + offs, rest);
1340                         p[rest] = '\0';
1341                         return;
1342                 } else if (dotlibsp == 0) {
1343                         /* cut out the `.libs/' portion */
1344                         size_t offs = sizeof(dotlibs)-1;
1345                         size_t rest = strlen(p + offs);
1346                         memmove(p, p + offs, rest);
1347                         p[rest] = '\0';
1348                         return;
1349                 }
1350         }
1351 #undef dotlibs
1352 #undef ltdash
1353 }
1354
1355 int pdump_load(const char *argv0)
1356 {
1357         char exe_path[PATH_MAX], real_exe_path[PATH_MAX];
1358         char *w;
1359         const char *dir, *p;
1360
1361         dir = argv0;
1362         if (dir[0] == '-') {
1363                 /* SXEmacs as a login shell, oh goody! */
1364                 dir = getenv("SHELL");
1365                 assert(dir != NULL);
1366         }
1367
1368         p = dir + strlen(dir);
1369         while (p != dir && !IS_ANY_SEP(p[-1])) {
1370                 p--;
1371         }
1372
1373         if (p != dir) {
1374                 /* invocation-name includes a directory component -- presumably it
1375                    is relative to cwd, not $PATH */
1376                 assert(strlen(dir) < sizeof(exe_path));
1377                 strncpy(exe_path, dir, sizeof(exe_path)-1);
1378                 exe_path[sizeof(exe_path)-1]='\0';
1379         } else {
1380                 const char *path = getenv("PATH");
1381                 const char *name = p;
1382
1383                 assert(path != NULL);
1384                 for (;;) {
1385                         int remain = sizeof(exe_path)-1;
1386                         exe_path[remain] = '\0';
1387
1388                         p = path;
1389                         while (*p && *p != SEPCHAR) {
1390                                 p++;
1391                         }
1392                         if (p == path) {
1393                                 exe_path[0] = '.';
1394                                 w = exe_path + 1;
1395                                 --remain;
1396                         } else {
1397                                 size_t len = (p - path) <= remain
1398                                            ? (p-path)
1399                                            : remain;
1400                                 memcpy(exe_path, path, len);
1401                                 w = exe_path + len;
1402                                 remain -= len;
1403                         }
1404                         if (!IS_DIRECTORY_SEP(w[-1]) && (remain > 0) ) {
1405                                 *w++ = '/';
1406                                 remain--;
1407                         }
1408                         if (remain > 0) {
1409                                 strncpy(w, name, remain);
1410                                 w[remain]='\0';
1411                         }
1412
1413                         /* Check that exe_path is executable and not a
1414                          * directory */
1415 #undef access                   /* avoid !@#$%^& encapsulated access */
1416 #undef stat                     /* avoid !@#$%^& encapsulated stat */
1417                         {
1418                                 struct stat statbuf;
1419                                 if (access(exe_path, X_OK) == 0
1420                                     && stat(exe_path, &statbuf) == 0
1421                                     && !S_ISDIR(statbuf.st_mode))
1422                                         break;
1423                         }
1424
1425                         if (!*p) {
1426                                 /* Oh well, let's have some kind of default */
1427                                 int sz = snprintf(exe_path, sizeof(exe_path),
1428                                                   "./%s", name);
1429                                 assert(sz >= 0 && (size_t)sz < sizeof(exe_path));
1430                                 break;
1431                         }
1432                         path = p + 1;
1433                 }
1434         }
1435
1436 #if 0
1437         /* do not use this one now as we follow libtool's concept of
1438          * convenience libraries and binaries */
1439         wipe_out_libtool_stuff(exe_path);
1440 #endif
1441
1442         /* Save exe_path because pdump_file_try() modifies it */
1443         assert(strlen(exe_path) < sizeof(real_exe_path));
1444         strcpy(real_exe_path, exe_path);
1445         if (pdump_file_try(exe_path,sizeof(exe_path))
1446             || (xrealpath(real_exe_path, real_exe_path)
1447                 && pdump_file_try(real_exe_path,sizeof(real_exe_path)))) {
1448                 pdump_load_finish();
1449                 return 1;
1450         }
1451
1452         return 0;
1453 }
1454
1455 /* dumper.c ends here */