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