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