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 size_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                         size_t str_sz = strlen(str);
 463                         if (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         pdump_out = fdopen(pdump_fd, "w");
1073
1074         fwrite(&header, sizeof(header), 1, pdump_out);
1075         PDUMP_ALIGN_OUTPUT(max_align_t);
1076
1077         pdump_scan_by_alignment(pdump_dump_data);
1078
1079         fseek(pdump_out, header.stab_offset, SEEK_SET);
1080
1081         pdump_dump_root_struct_ptrs();
1082         pdump_dump_opaques();
1083         pdump_dump_rtables();
1084         pdump_dump_root_objects();
1085
1086         fclose(pdump_out);
1087         close(pdump_fd);
1088
1089         xfree(pdump_buf);
1090
1091         xfree(pdump_hash);
1092
1093         Vterminal_console = t_console;
1094         Vterminal_frame = t_frame;
1095         Vterminal_device = t_device;
1096 }
1097
1098 static int pdump_load_check(void)
1099 {
1100         return (!memcmp(((pdump_header*)pdump_start)->signature,
1101                         PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1102                 && ((pdump_header *)pdump_start)->id == dump_id);
1103 }
1104
1105 /*----------------------------------------------------------------------*/
1106 /*                      Reading the dump file                           */
1107 /*----------------------------------------------------------------------*/
1108 static int
1109 pdump_load_finish(void)
1110 {
1111         char *p;
1112         EMACS_INT delta;
1113         pdump_header *header = (pdump_header*)pdump_start;
1114
1115 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1116         int cache_GC_dont_gc = GC_dont_gc;
1117
1118         GC_dont_gc = 1;
1119 #endif  /* BDWGC */
1120
1121         pdump_end = pdump_start + pdump_length;
1122
1123         delta = ((EMACS_INT)pdump_start) - header->reloc_address;
1124         p = pdump_start + header->stab_offset;
1125
1126         /* Put back the pdump_root_struct_ptrs */
1127         p = (char*)ALIGN_PTR(p, ALIGNOF(pdump_static_pointer));
1128         for (int i = 0; i < header->nb_root_struct_ptrs; i++) {
1129                 pdump_static_pointer ptr = PDUMP_READ(p, pdump_static_pointer);
1130                 (*ptr.address) = ptr.value + delta;
1131         }
1132
1133         /* Put back the pdump_opaques */
1134         for (int i = 0; i < header->nb_opaques; i++) {
1135                 pdump_opaque info = PDUMP_READ_ALIGNED(p, pdump_opaque);
1136                 memcpy(info.varaddress, p, info.size);
1137                 p += info.size;
1138         }
1139
1140         /* Do the relocations */
1141         pdump_rt_list = p;
1142         for (EMACS_INT count = 2;;) {
1143                 pdump_reloc_table rt = PDUMP_READ_ALIGNED(p, pdump_reloc_table);
1144                 p = (char*)ALIGN_PTR(p, ALIGNOF(char*));
1145                 if (rt.desc) {
1146                         char **reloc = (char**)p;
1147                         for (int i = 0; i < rt.count; i++) {
1148                                 reloc[i] += delta;
1149                                 pdump_reloc_one(reloc[i], delta, rt.desc);
1150                         }
1151                         p += rt.count * sizeof(char *);
1152                 } else if (!(--count)) {
1153                         break;
1154                 }
1155         }
1156
1157         /* Put the pdump_root_objects variables in place */
1158         p = (char*)ALIGN_PTR(p, ALIGNOF(pdump_static_Lisp_Object));
1159
1160         for (int i = PDUMP_READ_ALIGNED(p, size_t); i--; ) {
1161                 pdump_static_Lisp_Object obj =
1162                         PDUMP_READ(p, pdump_static_Lisp_Object);
1163
1164                 if (POINTER_TYPE_P(XTYPE(obj.value))) {
1165                         obj.value =
1166                                 wrap_object((char*)XPNTR(obj.value) + delta);
1167                 }
1168                 (*obj.address) = obj.value;
1169         }
1170
1171         /* Final cleanups */
1172         /* reorganize hash tables */
1173         p = pdump_rt_list;
1174         for (;;) {
1175                 pdump_reloc_table rt = PDUMP_READ_ALIGNED(p, pdump_reloc_table);
1176                 p = (char*)ALIGN_PTR(p, ALIGNOF(Lisp_Object));
1177
1178                 if (!rt.desc) {
1179                         break;
1180                 }
1181                 if (rt.desc == hash_table_description) {
1182                         for (int i = 0; i < rt.count; i++) {
1183                                 pdump_reorganize_hash_table(
1184                                         PDUMP_READ(p, Lisp_Object));
1185                         }
1186                         break;
1187                 } else {
1188                         p += sizeof(Lisp_Object) * rt.count;
1189                 }
1190         }
1191
1192 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1193         GC_dont_gc = cache_GC_dont_gc;
1194 #endif  /* BDWGC */
1195         return 1;
1196 }
1197
1198
1199 static void pdump_file_free(void)
1200 {
1201         xfree(pdump_start);
1202         return;
1203 }
1204
1205 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1206 # if defined HAVE_MMAP
1207 static void pdump_file_unmap(void)
1208 {
1209         munmap(pdump_start, pdump_length);
1210 }
1211 # endif  /* HAVE_MMAP */
1212 #endif  /* !BDWGC */
1213
1214 static int pdump_file_get(const char *path)
1215 {
1216         int fd = open(path, O_RDONLY | OPEN_BINARY);
1217
1218         if (UNLIKELY(fd < 0)) {
1219                 return 0;
1220         }
1221
1222         pdump_length = lseek(fd, 0, SEEK_END);
1223         if (UNLIKELY(pdump_length < sizeof(pdump_header))) {
1224                 close(fd);
1225                 return 0;
1226         }
1227
1228         lseek(fd, 0, SEEK_SET);
1229
1230 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1231 # if defined HAVE_MMAP
1232 /* Unix 98 requires that sys/mman.h define MAP_FAILED,
1233    but many earlier implementations don't. */
1234 #  ifndef MAP_FAILED
1235 #   define MAP_FAILED ((void*)-1L)
1236 #  endif  /* MAP_FAILED */
1237         pdump_start = (char*)mmap(0, pdump_length,
1238                                   PROT_READ | PROT_WRITE, MAP_PRIVATE,
1239                                   fd, 0);
1240         if (LIKELY(pdump_start != (char*)MAP_FAILED)) {
1241                 pdump_free = pdump_file_unmap;
1242                 close(fd);
1243                 return 1;
1244         }
1245 # endif /* HAVE_MMAP */
1246 #endif  /* !BDWGC */
1247
1248         pdump_start = xnew_array(char, pdump_length);
1249         pdump_free = pdump_file_free;
1250         read(fd, pdump_start, pdump_length);
1251
1252         close(fd);
1253         return 1;
1254 }
1255
1256 static int pdump_file_try(char *exe_path, size_t size)
1257 {
1258         char *w = exe_path + strlen(exe_path);
1259         size -= strlen(exe_path);
1260
1261         do {
1262
1263 #ifdef EMACS_PATCH_LEVEL
1264                 snprintf(w, size, "-%d.%d.%d-%08x.dmp",
1265                          EMACS_MAJOR_VERSION, EMACS_MINOR_VERSION,
1266                          EMACS_PATCH_LEVEL, dump_id);
1267                 if (pdump_file_get(exe_path)) {
1268                         if (pdump_load_check()) {
1269                                 return 1;
1270                         }
1271                         pdump_free();
1272                 }
1273 #endif  /* EMACS_PATCH_LEVEL */
1274 #ifdef EMACS_BETA_VERSION
1275                 snprintf(w, size, "-%d.%d.%d-%08x.dmp",
1276                          EMACS_MAJOR_VERSION, EMACS_MINOR_VERSION,
1277                          EMACS_BETA_VERSION, dump_id);
1278                 if (pdump_file_get(exe_path)) {
1279                         if (pdump_load_check()) {
1280                                 return 1;
1281                         }
1282                         pdump_free();
1283                 }
1284 #endif  /* EMACS_BETA_VERSION */
1285
1286                 snprintf(w, size, "-%08x.dmp", dump_id);
1287                 if (pdump_file_get(exe_path)) {
1288                         if (pdump_load_check()) {
1289                                 return 1;
1290                         }
1291                         pdump_free();
1292                 }
1293
1294                 snprintf(w, size, ".dmp");
1295                 if (pdump_file_get(exe_path)) {
1296                         if (pdump_load_check()) {
1297                                 return 1;
1298                         }
1299                         pdump_free();
1300                 }
1301
1302                 do {
1303                         w--;
1304                 } while (w > exe_path && !IS_DIRECTORY_SEP(*w) && (*w != '-')
1305                          && (*w != '.'));
1306         } while (w > exe_path && !IS_DIRECTORY_SEP(*w));
1307         return 0;
1308 }
1309
1310 static inline void
1311 wipe_out_libtool_stuff(char *path)
1312 {
1313 #define dotlibs         ".libs/"
1314 #define ltdash          "lt-"
1315         char *p;
1316
1317         for (p = strchr(path, '.'); p; p = strchr(p+1, '.')) {
1318                 short dotlibsp =
1319                         strncmp(p, dotlibs, sizeof(dotlibs)-1);
1320                 short ltdashp =
1321                         strncmp(p+sizeof(dotlibs)-1, ltdash, sizeof(ltdash)-1);
1322                 if ((dotlibsp || ltdashp) == 0) {
1323                         /* cut out the `.libs/lt-' portion */
1324                         size_t offs = sizeof(dotlibs)-1+sizeof(ltdash)-1;
1325                         size_t rest = strlen(p + offs);
1326                         memmove(p, p + offs, rest);
1327                         p[rest] = '\0';
1328                         return;
1329                 } else if (dotlibsp == 0) {
1330                         /* cut out the `.libs/' portion */
1331                         size_t offs = sizeof(dotlibs)-1;
1332                         size_t rest = strlen(p + offs);
1333                         memmove(p, p + offs, rest);
1334                         p[rest] = '\0';
1335                         return;
1336                 }
1337         }
1338 #undef dotlibs
1339 #undef ltdash
1340 }
1341
1342 int pdump_load(const char *argv0)
1343 {
1344         char exe_path[PATH_MAX], real_exe_path[PATH_MAX];
1345         char *w;
1346         const char *dir, *p;
1347
1348         dir = argv0;
1349         if (dir[0] == '-') {
1350                 /* SXEmacs as a login shell, oh goody! */
1351                 dir = getenv("SHELL");
1352         }
1353
1354         p = dir + strlen(dir);
1355         while (p != dir && !IS_ANY_SEP(p[-1])) {
1356                 p--;
1357         }
1358
1359         if (p != dir) {
1360                 /* invocation-name includes a directory component -- presumably it
1361                    is relative to cwd, not $PATH */
1362                 assert(strlen(dir) < sizeof(exe_path));
1363                 strcpy(exe_path, dir);
1364         } else {
1365                 const char *path = getenv("PATH");
1366                 const char *name = p;
1367                 for (;;) {
1368                         int remain = sizeof(exe_path)-1;
1369                         exe_path[remain] = '\0';
1370
1371                         p = path;
1372                         while (*p && *p != SEPCHAR) {
1373                                 p++;
1374                         }
1375                         if (p == path) {
1376                                 exe_path[0] = '.';
1377                                 w = exe_path + 1;
1378                                 --remain;
1379                         } else {
1380                                 size_t len = (p - path) <= remain
1381                                            ? (p-path)
1382                                            : remain;
1383                                 memcpy(exe_path, path, len);
1384                                 w = exe_path + len;
1385                                 remain -= len;
1386                         }
1387                         if (!IS_DIRECTORY_SEP(w[-1]) && (remain > 0) ) {
1388                                 *w++ = '/';
1389                                 remain--;
1390                         }
1391                         if (remain > 0) {
1392                                 strncpy(w, name, remain);
1393                                 w[remain]='\0';
1394                         }
1395
1396                         /* Check that exe_path is executable and not a
1397                          * directory */
1398 #undef access                   /* avoid !@#$%^& encapsulated access */
1399 #undef stat                     /* avoid !@#$%^& encapsulated stat */
1400                         {
1401                                 struct stat statbuf;
1402                                 if (access(exe_path, X_OK) == 0
1403                                     && stat(exe_path, &statbuf) == 0
1404                                     && !S_ISDIR(statbuf.st_mode))
1405                                         break;
1406                         }
1407
1408                         if (!*p) {
1409                                 /* Oh well, let's have some kind of default */
1410                                 snprintf(exe_path, sizeof(exe_path),
1411                                          "./%s", name);
1412                                 break;
1413                         }
1414                         path = p + 1;
1415                 }
1416         }
1417
1418 #if 0
1419         /* do not use this one now as we follow libtool's concept of
1420          * convenience libraries and binaries */
1421         wipe_out_libtool_stuff(exe_path);
1422 #endif
1423
1424         /* Save exe_path because pdump_file_try() modifies it */
1425         assert(strlen(exe_path) < sizeof(real_exe_path));
1426         strcpy(real_exe_path, exe_path);
1427         if (pdump_file_try(exe_path,sizeof(exe_path))
1428             || (xrealpath(real_exe_path, real_exe_path)
1429                 && pdump_file_try(real_exe_path,sizeof(real_exe_path)))) {
1430                 pdump_load_finish();
1431                 return 1;
1432         }
1433
1434         return 0;
1435 }
1436
1437 /* dumper.c ends here */