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

   1 /* Portable data dumper for SXEmacs.
   2    Copyright (C) 1999-2000 Olivier Galibert
   3    Copyright (C) 2001 Martin Buchholz
   4
   5 This file is part of SXEmacs
   6
   7 SXEmacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 SXEmacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  19
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25
  26 #include "specifier.h"
  27 #include "elhash.h"
  28 #include "sysfile.h"
  29 #include "ui/console-stream.h"
  30 #include "dumper.h"
  31 #include "sysdep.h"
  32
  33 #ifdef HAVE_MMAP
  34 #include <sys/mman.h>
  35 #endif
  36
  37 #ifndef SEPCHAR
  38 #define SEPCHAR ':'
  39 #endif
  40
  41 typedef struct {
  42         void *varaddress;
  43         size_t size;
  44 } pdump_opaque;
  45
  46 typedef struct {
  47         Dynarr_declare(pdump_opaque);
  48 } pdump_opaque_dynarr;
  49
  50 typedef struct {
  51         void **ptraddress;
  52         const struct struct_description *desc;
  53 } pdump_root_struct_ptr;
  54
  55 typedef struct {
  56         Dynarr_declare(pdump_root_struct_ptr);
  57 } pdump_root_struct_ptr_dynarr;
  58
  59 typedef struct {
  60         Lisp_Object *address;
  61         Lisp_Object value;
  62 } pdump_static_Lisp_Object;
  63
  64 typedef struct {
  65         char **address;         /* char * for ease of doing relocation */
  66         char *value;
  67 } pdump_static_pointer;
  68
  69 static pdump_opaque_dynarr *pdump_opaques;
  70 static pdump_root_struct_ptr_dynarr *pdump_root_struct_ptrs;
  71 static Lisp_Object_ptr_dynarr *pdump_root_objects;
  72 static Lisp_Object_ptr_dynarr *pdump_weak_object_chains;
  73
  74 /* Mark SIZE bytes at non-heap address VARADDRESS for dumping as is,
  75    without any bit-twiddling. */
  76 void dump_add_opaque(void *varaddress, size_t size)
  77 {
  78         pdump_opaque info;
  79         info.varaddress = varaddress;
  80         info.size = size;
  81         if (pdump_opaques == NULL)
  82                 pdump_opaques = Dynarr_new(pdump_opaque);
  83         Dynarr_add(pdump_opaques, info);
  84 }
  85
  86 /* Mark the struct described by DESC and pointed to by the pointer at
  87    non-heap address VARADDRESS for dumping.
  88    All the objects reachable from this pointer will also be dumped. */
  89 void
  90 dump_add_root_struct_ptr(void *ptraddress,
  91                          const struct struct_description *desc)
  92 {
  93         pdump_root_struct_ptr info;
  94         info.ptraddress = (void **)ptraddress;
  95         info.desc = desc;
  96         if (pdump_root_struct_ptrs == NULL)
  97                 pdump_root_struct_ptrs = Dynarr_new(pdump_root_struct_ptr);
  98         Dynarr_add(pdump_root_struct_ptrs, info);
  99 }
 100
 101 /* Mark the Lisp_Object at non-heap address VARADDRESS for dumping.
 102    All the objects reachable from this var will also be dumped. */
 103 void dump_add_root_object(Lisp_Object * varaddress)
 104 {
 105         if (pdump_root_objects == NULL)
 106                 pdump_root_objects =
 107                     Dynarr_new2(Lisp_Object_ptr_dynarr, Lisp_Object *);
 108         Dynarr_add(pdump_root_objects, varaddress);
 109 }
 110
 111 /* Mark the list pointed to by the Lisp_Object at VARADDRESS for dumping. */
 112 void dump_add_weak_object_chain(Lisp_Object * varaddress)
 113 {
 114         if (pdump_weak_object_chains == NULL)
 115                 pdump_weak_object_chains =
 116                     Dynarr_new2(Lisp_Object_ptr_dynarr, Lisp_Object *);
 117         Dynarr_add(pdump_weak_object_chains, varaddress);
 118 }
 119 \f
 120 inline static void pdump_align_stream(FILE * stream, size_t alignment)
 121 {
 122         long offset = ftell(stream);
 123         long adjustment = ALIGN_SIZE(offset, alignment) - offset;
 124         if (adjustment)
 125                 fseek(stream, adjustment, SEEK_CUR);
 126 }
 127
 128 #define PDUMP_ALIGN_OUTPUT(type) pdump_align_stream (pdump_out, ALIGNOF (type))
 129
 130 #define PDUMP_WRITE(type, object) \
 131 fwrite (&object, sizeof (object), 1, pdump_out);
 132
 133 #define PDUMP_WRITE_ALIGNED(type, object) do {  \
 134   PDUMP_ALIGN_OUTPUT (type);                    \
 135   PDUMP_WRITE (type, object);                   \
 136 } while (0)
 137
 138 #define PDUMP_READ(ptr, type) \
 139 (((type *) (ptr = (char*) (((type *) ptr) + 1)))[-1])
 140
 141 #define PDUMP_READ_ALIGNED(ptr, type) \
 142 ((ptr = (char *) ALIGN_PTR (ptr, ALIGNOF (type))), PDUMP_READ (ptr, type))
 143 \f
 144 typedef struct {
 145         const struct lrecord_description *desc;
 146         int count;
 147 } pdump_reloc_table;
 148
 149 static char *pdump_rt_list = 0;
 150
 151 void pdump_objects_unmark(void)
 152 {
 153         int i;
 154         char *p = pdump_rt_list;
 155         if (p)
 156                 for (;;) {
 157                         pdump_reloc_table *rt = (pdump_reloc_table *) p;
 158                         p += sizeof(pdump_reloc_table);
 159                         if (rt->desc) {
 160                                 for (i = 0; i < rt->count; i++) {
 161                                         struct lrecord_header *lh =
 162                                             *(struct lrecord_header **)p;
 163                                         if (!C_READONLY_RECORD_HEADER_P(lh))
 164                                                 UNMARK_RECORD_HEADER(lh);
 165                                         p += sizeof(EMACS_INT);
 166                                 }
 167                         } else
 168                                 break;
 169                 }
 170 }
 171
 172 /* The structure of the file
 173  0              - header
 174                 - dumped objects
 175  stab_offset    - nb_root_struct_ptrs*pair(void *, adr)
 176                   for pointers to structures
 177                 - nb_opaques*pair(void *, size) for raw bits to restore
 178                 - relocation table
 179                 - root lisp object address/value couples with the count
 180                   preceding the list
 181  */
 182
 183 #define PDUMP_SIGNATURE "SXEmacsDP"
 184 #define PDUMP_SIGNATURE_LEN (sizeof (PDUMP_SIGNATURE) - 1)
 185
 186 typedef struct {
 187         char signature[PDUMP_SIGNATURE_LEN];
 188         unsigned int id;
 189         EMACS_UINT stab_offset;
 190         EMACS_UINT reloc_address;
 191         int nb_root_struct_ptrs;
 192         int nb_opaques;
 193 } pdump_header;
 194
 195 char *pdump_start;
 196 char *pdump_end;
 197 static off_t pdump_length;
 198
 199
 200 static void (*pdump_free) (void);
 201
 202 static unsigned char pdump_align_table[] = {
 203         64, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1,
 204         16, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1,
 205         32, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1,
 206         16, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1
 207 };
 208
 209 static inline unsigned int pdump_size_to_align(size_t size)
 210 {
 211         return pdump_align_table[size % countof(pdump_align_table)];
 212 }
 213
 214 typedef struct pdump_entry_list_elt {
 215         struct pdump_entry_list_elt *next;
 216         const void *obj;
 217         size_t size;
 218         int count;
 219         EMACS_INT save_offset;
 220 } pdump_entry_list_elt;
 221
 222 typedef struct {
 223         pdump_entry_list_elt *first;
 224         int align;
 225         int count;
 226 } pdump_entry_list;
 227
 228 typedef struct pdump_struct_list_elt {
 229         pdump_entry_list list;
 230         const struct struct_description *sdesc;
 231 } pdump_struct_list_elt;
 232
 233 typedef struct {
 234         pdump_struct_list_elt *list;
 235         int count;
 236         int size;
 237 } pdump_struct_list;
 238
 239 static pdump_entry_list *pdump_object_table;
 240 static pdump_entry_list pdump_opaque_data_list;
 241 static pdump_struct_list pdump_struct_table;
 242
 243 static int *pdump_alert_undump_object;
 244
 245 static unsigned long cur_offset;
 246 static size_t max_size;
 247 static int pdump_fd;
 248 static void *pdump_buf;
 249 static FILE *pdump_out;
 250
 251 #define PDUMP_HASHSIZE 200001
 252
 253 static pdump_entry_list_elt **pdump_hash;
 254
 255 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
 256 static int pdump_make_hash(const void *obj)
 257 {
 258         return ((unsigned long)(obj) >> 3) % PDUMP_HASHSIZE;
 259 }
 260
 261 static pdump_entry_list_elt *pdump_get_entry(const void *obj)
 262 {
 263         int pos = pdump_make_hash(obj);
 264         pdump_entry_list_elt *e;
 265
 266         assert(obj != 0);
 267
 268         while ((e = pdump_hash[pos]) != 0) {
 269                 if (e->obj == obj)
 270                         return e;
 271
 272                 pos++;
 273                 if (pos == PDUMP_HASHSIZE)
 274                         pos = 0;
 275         }
 276         return 0;
 277 }
 278
 279 static void
 280 pdump_add_entry(pdump_entry_list *l, const void *obj, size_t size, int count)
 281 {
 282         pdump_entry_list_elt *e;
 283         int pos = pdump_make_hash(obj);
 284
 285         while ((e = pdump_hash[pos]) != 0) {
 286                 if (e->obj == obj) {
 287                         return;
 288                 }
 289                 pos++;
 290                 if (pos == PDUMP_HASHSIZE) {
 291                         pos = 0;
 292                 }
 293         }
 294
 295         e = xnew(pdump_entry_list_elt);
 296
 297         e->next = l->first;
 298         e->obj = obj;
 299         e->size = size;
 300         e->count = count;
 301         l->first = e;
 302
 303         l->count += count;
 304         pdump_hash[pos] = e;
 305
 306         {
 307                 int align = pdump_size_to_align(size);
 308
 309                 if (align < l->align) {
 310                         l->align = align;
 311                 }
 312         }
 313         return;
 314 }
 315
 316 static pdump_entry_list*
 317 pdump_get_entry_list(const struct struct_description *sdesc)
 318 {
 319         int i;
 320         for (i = 0; i < pdump_struct_table.count; i++)
 321                 if (pdump_struct_table.list[i].sdesc == sdesc)
 322                         return &pdump_struct_table.list[i].list;
 323
 324         if (pdump_struct_table.size <= pdump_struct_table.count) {
 325                 if (pdump_struct_table.size == -1)
 326                         pdump_struct_table.size = 10;
 327                 else
 328                         pdump_struct_table.size = pdump_struct_table.size * 2;
 329                 pdump_struct_table.list = (pdump_struct_list_elt *)
 330                     xrealloc(pdump_struct_table.list,
 331                              pdump_struct_table.size *
 332                              sizeof(pdump_struct_list_elt));
 333         }
 334         pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
 335         pdump_struct_table.list[pdump_struct_table.count].list.align =
 336             ALIGNOF(max_align_t);
 337         pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
 338         pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
 339
 340         return &pdump_struct_table.list[pdump_struct_table.count++].list;
 341 }
 342
 343 static struct {
 344         struct lrecord_header *obj;
 345         int position;
 346         int offset;
 347 } backtrace[65536];
 348
 349 static int depth;
 350
 351 static void pdump_backtrace(void)
 352 {
 353         int i;
 354         stderr_out("pdump backtrace :\n");
 355         for (i = 0; i < depth; i++) {
 356                 if (!backtrace[i].obj)
 357                         stderr_out("  - ind. (%d, %d)\n",
 358                                    backtrace[i].position, backtrace[i].offset);
 359                 else {
 360                         stderr_out("  - %s (%d, %d)\n",
 361                                    LHEADER_IMPLEMENTATION(backtrace[i].obj)->
 362                                    name, backtrace[i].position,
 363                                    backtrace[i].offset);
 364                 }
 365         }
 366 }
 367
 368 static void pdump_register_object(Lisp_Object obj);
 369 static void pdump_register_struct(const void *data,
 370                                   const struct struct_description *sdesc,
 371                                   int count);
 372
 373 static EMACS_INT
 374 pdump_get_indirect_count(EMACS_INT code,
 375                          const struct lrecord_description *idesc,
 376                          const void *idata)
 377 {
 378         EMACS_INT count = 0;    /* initialize to shut up GCC */
 379         const void *irdata;
 380
 381         int line = XD_INDIRECT_VAL(code);
 382         int delta = XD_INDIRECT_DELTA(code);
 383
 384         irdata = ((const char *)idata) + idesc[line].offset;
 385         switch (idesc[line].type) {
 386         case XD_SIZE_T:
 387                 count = *(const size_t*)irdata;
 388                 break;
 389         case XD_INT:
 390                 count = *(const int*)irdata;
 391                 break;
 392         case XD_LONG:
 393                 count = *(const long*)irdata;
 394                 break;
 395         case XD_BYTECOUNT:
 396                 count = *(const Bytecount*)irdata;
 397                 break;
 398
 399                 /* list the rest here */
 400         case XD_LISP_OBJECT_ARRAY:
 401         case XD_LISP_OBJECT:
 402         case XD_LO_LINK:
 403         case XD_OPAQUE_PTR:
 404         case XD_STRUCT_PTR:
 405         case XD_OPAQUE_DATA_PTR:
 406         case XD_C_STRING:
 407         case XD_DOC_STRING:
 408         case XD_INT_RESET:
 409         case XD_END:
 410         case XD_SPECIFIER_END:
 411
 412         default:
 413                 stderr_out
 414                     ("Unsupported count type : %d (line = %d, code=%ld)\n",
 415                      idesc[line].type, line, (long)code);
 416                 pdump_backtrace();
 417                 abort();
 418         }
 419         count += delta;
 420         return count;
 421 }
 422
 423 static void
 424 pdump_register_sub(const void *data, const struct lrecord_description *desc,
 425                    int me)
 426 {
 427         int pos;
 428
 429 restart:
 430         for (pos = 0; desc[pos].type != XD_END; pos++) {
 431                 const void *rdata = (const char *)data + desc[pos].offset;
 432
 433                 backtrace[me].position = pos;
 434                 backtrace[me].offset = desc[pos].offset;
 435
 436                 switch (desc[pos].type) {
 437                 case XD_SPECIFIER_END:
 438                         pos = 0;
 439                         desc =
 440                             ((const Lisp_Specifier *)data)->methods->
 441                             extra_description;
 442                         goto restart;
 443                 case XD_SIZE_T:
 444                 case XD_INT:
 445                 case XD_LONG:
 446                 case XD_BYTECOUNT:
 447                 case XD_INT_RESET:
 448                 case XD_LO_LINK:
 449                         break;
 450                 case XD_OPAQUE_DATA_PTR: {
 451                         EMACS_INT count = desc[pos].data1;
 452                         if (XD_IS_INDIRECT(count)) {
 453                                 count = pdump_get_indirect_count(
 454                                         count, desc, data);
 455                         }
 456                         pdump_add_entry(&pdump_opaque_data_list,
 457                                         *(const void *const*)rdata, count, 1);
 458                         break;
 459                 }
 460                 case XD_C_STRING: {
 461                         const char *str = *(const char *const*)rdata;
 462                         if (str) {
 463                                 size_t str_sz = strlen(str);
 464                                 pdump_add_entry(&pdump_opaque_data_list,
 465                                                 str, str_sz + 1, 1);
 466                         }
 467                         break;
 468                 }
 469                 case XD_DOC_STRING: {
 470                         const char *str = *(const char *const*)rdata;
 471                         if ((EMACS_INT)str > 0) {
 472                                 pdump_add_entry(&pdump_opaque_data_list,
 473                                                 str, strlen(str) + 1, 1);
 474                         }
 475                         break;
 476                 }
 477                 case XD_LISP_OBJECT: {
 478                         const Lisp_Object *pobj = (const Lisp_Object*)rdata;
 479
 480                         assert(desc[pos].data1 == 0);
 481
 482                         backtrace[me].offset =
 483                                 (const char *)pobj - (const char *)data;
 484                         pdump_register_object(*pobj);
 485                         break;
 486                 }
 487                 case XD_LISP_OBJECT_ARRAY: {
 488                         int i;
 489                         EMACS_INT count = desc[pos].data1;
 490
 491                         if (XD_IS_INDIRECT(count)) {
 492                                 count = pdump_get_indirect_count(
 493                                         count, desc, data);
 494                         }
 495                         for (i = 0; i < count; i++) {
 496                                 const Lisp_Object *pobj =
 497                                         ((const Lisp_Object*)rdata) + i;
 498                                 Lisp_Object dobj = *pobj;
 499
 500                                 backtrace[me].offset =
 501                                         (const char *)pobj -
 502                                         (const char *)data;
 503                                 pdump_register_object(dobj);
 504                         }
 505                         break;
 506                 }
 507                 case XD_STRUCT_PTR: {
 508                         EMACS_INT count = desc[pos].data1;
 509                         const struct struct_description *sdesc =
 510                                 desc[pos].data2;
 511                         const char *dobj = *(const char *const*)rdata;
 512
 513                         if (dobj) {
 514                                 if (XD_IS_INDIRECT(count)) {
 515                                         count = pdump_get_indirect_count(
 516                                                 count, desc, data);
 517                                 }
 518                                 pdump_register_struct(dobj, sdesc, count);
 519                         }
 520                         break;
 521                 }
 522
 523                 case XD_OPAQUE_PTR:
 524                 case XD_END:
 525                 default:
 526                         stderr_out("Unsupported dump type : %d\n",
 527                                    desc[pos].type);
 528                         pdump_backtrace();
 529                         abort();
 530                 };
 531         }
 532 }
 533
 534 static void
 535 pdump_register_object(Lisp_Object obj)
 536 {
 537         struct lrecord_header *objh;
 538         const struct lrecord_implementation *imp;
 539
 540         if (!POINTER_TYPE_P(XTYPE(obj))) {
 541                 return;
 542         }
 543
 544         objh = XRECORD_LHEADER(obj);
 545         if (!objh) {
 546                 return;
 547         }
 548
 549         if (pdump_get_entry(objh)) {
 550                 return;
 551         }
 552
 553         imp = LHEADER_IMPLEMENTATION(objh);
 554
 555         if (imp->description) {
 556                 int me = depth++;
 557                 if (me >= 65536) {
 558                         stderr_out("Backtrace overflow, loop ?\n");
 559                         abort();
 560                         return;
 561                 }
 562                 backtrace[me].obj = objh;
 563                 backtrace[me].position = 0;
 564                 backtrace[me].offset = 0;
 565
 566                 pdump_add_entry(pdump_object_table + objh->type,
 567                                 objh,
 568                                 imp->static_size ?
 569                                 imp->static_size :
 570                                 imp->size_in_bytes_method(objh), 1);
 571                 pdump_register_sub(objh, imp->description, me);
 572                 --depth;
 573         } else {
 574                 pdump_alert_undump_object[objh->type]++;
 575                 stderr_out("Undumpable object type : %s\n", imp->name);
 576                 pdump_backtrace();
 577         }
 578 }
 579
 580 static void
 581 pdump_register_struct(const void *data,
 582                       const struct struct_description *sdesc, int count)
 583 {
 584         if (data && !pdump_get_entry(data)) {
 585                 int me = depth++;
 586                 int i;
 587                 if (me >= 65536) {
 588                         stderr_out("Backtrace overflow, loop ?\n");
 589                         abort();
 590                 } else {
 591                         backtrace[me].obj = 0;
 592                         backtrace[me].position = 0;
 593                         backtrace[me].offset = 0;
 594
 595                         pdump_add_entry(pdump_get_entry_list(sdesc),
 596                                         data, sdesc->size, count);
 597                         for (i = 0; i < count; i++) {
 598                                 pdump_register_sub(
 599                                         ((const char*)data) + sdesc->size * i,
 600                                         sdesc->description, me);
 601                         }
 602                         --depth;
 603                 }
 604         }
 605 }
 606
 607 static void
 608 pdump_dump_data(pdump_entry_list_elt * elt,
 609                 const struct lrecord_description *desc)
 610 {
 611         size_t size = elt->size;
 612         int count = elt->count;
 613         if (desc) {
 614                 int pos, i;
 615                 memcpy(pdump_buf, elt->obj, size * count);
 616
 617                 for (i = 0; i < count; i++) {
 618                         char *cur = ((char *)pdump_buf) + i * size;
 619                       restart:
 620                         for (pos = 0; desc[pos].type != XD_END; pos++) {
 621                                 void *rdata = cur + desc[pos].offset;
 622                                 switch (desc[pos].type) {
 623                                 case XD_SPECIFIER_END:
 624                                         desc = ((const Lisp_Specifier *)
 625                                                 (elt->obj))->
 626                                                 methods->extra_description;
 627                                         goto restart;
 628                                 case XD_SIZE_T:
 629                                 case XD_INT:
 630                                 case XD_LONG:
 631                                 case XD_BYTECOUNT:
 632                                         break;
 633                                 case XD_INT_RESET: {
 634                                         EMACS_INT val = desc[pos].data1;
 635                                         if (XD_IS_INDIRECT(val))
 636                                                 val = pdump_get_indirect_count(
 637                                                         val, desc, elt->obj);
 638                                         *(int *)rdata = val;
 639                                         break;
 640                                 }
 641                                 case XD_OPAQUE_DATA_PTR:
 642                                 case XD_C_STRING:
 643                                 case XD_STRUCT_PTR: {
 644                                         void *ptr = *(void**)rdata;
 645                                         if (ptr) {
 646                                                 *(EMACS_INT*) rdata =
 647                                                         pdump_get_entry
 648                                                         (ptr)->save_offset;
 649                                         }
 650                                         break;
 651                                 }
 652                                 case XD_LO_LINK: {
 653                                         Lisp_Object obj = *(Lisp_Object*)rdata;
 654                                         pdump_entry_list_elt *elt1;
 655
 656                                         for (;;) {
 657                                                 elt1 = pdump_get_entry(
 658                                                         XRECORD_LHEADER(obj));
 659                                                 if (elt1) {
 660                                                         break;
 661                                                 }
 662                                                 obj = *(Lisp_Object*)(
 663                                                         desc[pos].offset +
 664                                                         (char*)
 665                                                         (XRECORD_LHEADER(obj)));
 666                                         }
 667                                         *(EMACS_INT *) rdata =
 668                                                 elt1->save_offset;
 669                                         break;
 670                                 }
 671                                 case XD_LISP_OBJECT: {
 672                                         Lisp_Object *pobj =
 673                                                 (Lisp_Object*)rdata;
 674
 675                                         assert(desc[pos].data1 == 0);
 676
 677                                         if (POINTER_TYPE_P(XTYPE(*pobj))
 678                                             && XRECORD_LHEADER(*pobj)) {
 679                                                 *(EMACS_INT*)pobj =
 680                                                         pdump_get_entry
 681                                                         (XRECORD_LHEADER(*pobj))
 682                                                         ->save_offset;
 683                                         }
 684                                         break;
 685                                 }
 686                                 case XD_LISP_OBJECT_ARRAY: {
 687                                         EMACS_INT num = desc[pos].data1;
 688                                         int j;
 689
 690                                         if (XD_IS_INDIRECT(num)) {
 691                                                 num = pdump_get_indirect_count(
 692                                                         num, desc, elt->obj);
 693                                         }
 694                                         for (j = 0; j < num; j++) {
 695                                                 Lisp_Object *pobj =
 696                                                         ((Lisp_Object*)rdata) +
 697                                                         j;
 698                                                 if (POINTER_TYPE_P(
 699                                                             XTYPE(*pobj)) &&
 700                                                     XRECORD_LHEADER(*pobj)) {
 701                                                         *(EMACS_INT *)
 702                                                                 pobj =
 703                                                                 pdump_get_entry
 704                                                                 (XRECORD_LHEADER
 705                                                                  (*pobj))->
 706                                                                 save_offset;
 707                                                 }
 708                                         }
 709                                         break;
 710                                 }
 711                                 case XD_DOC_STRING: {
 712                                         EMACS_INT str = *(EMACS_INT*)rdata;
 713                                         if (str > 0) {
 714                                                 *(EMACS_INT*)rdata =
 715                                                         pdump_get_entry(
 716                                                                 (void *)str)
 717                                                         ->save_offset;
 718                                         }
 719                                         break;
 720                                 }
 721
 722                                 case XD_OPAQUE_PTR:
 723                                 case XD_END:
 724                                 default:
 725                                         stderr_out
 726                                             ("Unsupported dump type : %d\n",
 727                                              desc[pos].type);
 728                                         abort();
 729                                 }
 730                         }
 731                 }
 732         }
 733         fwrite(desc ? pdump_buf : elt->obj, size, count, pdump_out);
 734 }
 735
 736 static void
 737 pdump_reloc_one(void *data, EMACS_INT delta,
 738                 const struct lrecord_description *desc)
 739 {
 740         int pos;
 741
 742 restart:
 743         for (pos = 0; desc[pos].type != XD_END; pos++) {
 744                 void *rdata = (char *)data + desc[pos].offset;
 745                 switch (desc[pos].type) {
 746                 case XD_SPECIFIER_END:
 747                         pos = 0;
 748                         desc = ((const Lisp_Specifier *)data)->methods->
 749                                 extra_description;
 750                         goto restart;
 751                 case XD_SIZE_T:
 752                 case XD_INT:
 753                 case XD_LONG:
 754                 case XD_BYTECOUNT:
 755                 case XD_INT_RESET:
 756                         break;
 757                 case XD_OPAQUE_DATA_PTR:
 758                 case XD_C_STRING:
 759                 case XD_STRUCT_PTR:
 760                 case XD_LO_LINK: {
 761                         EMACS_INT ptr = *(EMACS_INT *) rdata;
 762                         if (ptr) {
 763                                 *(EMACS_INT *) rdata = ptr + delta;
 764                         }
 765                         break;
 766                 }
 767                 case XD_LISP_OBJECT: {
 768                         Lisp_Object *pobj = (Lisp_Object *) rdata;
 769
 770                         assert(desc[pos].data1 == 0);
 771
 772                         if (POINTER_TYPE_P(XTYPE(*pobj))
 773                             && !EQ(*pobj, Qnull_pointer))
 774                                 XSETOBJ(*pobj,
 775                                         (char *)XPNTR(*pobj) + delta);
 776
 777                         break;
 778                 }
 779                 case XD_LISP_OBJECT_ARRAY: {
 780                         EMACS_INT num = desc[pos].data1;
 781                         int j;
 782                         if (XD_IS_INDIRECT(num)) {
 783                                 num = pdump_get_indirect_count(num, desc, data);
 784                         }
 785                         for (j = 0; j < num; j++) {
 786                                 Lisp_Object *pobj = (Lisp_Object*)rdata + j;
 787
 788                                 if (POINTER_TYPE_P(XTYPE(*pobj))
 789                                     && !EQ(*pobj, Qnull_pointer)) {
 790                                         XSETOBJ(*pobj,
 791                                                 (char *)XPNTR(*pobj) + delta);
 792                                 }
 793                         }
 794                         break;
 795                 }
 796                 case XD_DOC_STRING: {
 797                         EMACS_INT str = *(EMACS_INT *) rdata;
 798                         if (str > 0) {
 799                                 *(EMACS_INT *) rdata = str + delta;
 800                         }
 801                         break;
 802                 }
 803
 804                 case XD_OPAQUE_PTR:
 805                 case XD_END:
 806                 default:
 807                         stderr_out("Unsupported dump type : %d\n",
 808                                    desc[pos].type);
 809                         abort();
 810                 };
 811         }
 812 }
 813
 814 static void
 815 pdump_allocate_offset(pdump_entry_list_elt * elt,
 816                       const struct lrecord_description *desc)
 817 {
 818         size_t size = elt->count * elt->size;
 819         elt->save_offset = cur_offset;
 820         if (size > max_size)
 821                 max_size = size;
 822         cur_offset += size;
 823 }
 824
 825 static void
 826 pdump_scan_by_alignment(void (*f) (pdump_entry_list_elt *,
 827                                    const struct lrecord_description *))
 828 {
 829         int align;
 830
 831         for (align = ALIGNOF(max_align_t); align; align >>= 1) {
 832                 size_t i;
 833                 pdump_entry_list_elt *elt;
 834
 835                 for (i = 0; i < lrecord_type_count; i++)
 836                         if (pdump_object_table[i].align == align)
 837                                 for (elt = pdump_object_table[i].first; elt;
 838                                      elt = elt->next)
 839                                         f(elt,
 840                                           lrecord_implementations_table[i]->
 841                                           description);
 842
 843                 for (i = 0; i < (size_t)pdump_struct_table.count; i++) {
 844                         pdump_struct_list_elt list = pdump_struct_table.list[i];
 845                         if (list.list.align == align)
 846                                 for (elt = list.list.first; elt;
 847                                      elt = elt->next)
 848                                         f(elt, list.sdesc->description);
 849                 }
 850
 851                 for (elt = pdump_opaque_data_list.first; elt; elt = elt->next)
 852                         if (pdump_size_to_align(elt->size) ==
 853                             (unsigned int)align)
 854                                 f(elt, 0);
 855         }
 856 }
 857
 858 static void pdump_dump_root_struct_ptrs(void)
 859 {
 860         size_t i;
 861         size_t count = Dynarr_length(pdump_root_struct_ptrs);
 862         pdump_static_pointer *data = alloca_array(pdump_static_pointer, count);
 863         for (i = 0; i < count; i++) {
 864                 data[i].address =
 865                     (char **)Dynarr_atp(pdump_root_struct_ptrs, i)->ptraddress;
 866                 data[i].value =
 867                     (char *)pdump_get_entry(*data[i].address)->save_offset;
 868         }
 869         PDUMP_ALIGN_OUTPUT(pdump_static_pointer);
 870         fwrite(data, sizeof(pdump_static_pointer), count, pdump_out);
 871 }
 872
 873 static void pdump_dump_opaques(void)
 874 {
 875         int i;
 876         for (i = 0; i < Dynarr_length(pdump_opaques); i++) {
 877                 pdump_opaque *info = Dynarr_atp(pdump_opaques, i);
 878                 PDUMP_WRITE_ALIGNED(pdump_opaque, *info);
 879                 fwrite(info->varaddress, info->size, 1, pdump_out);
 880         }
 881 }
 882
 883 static void pdump_dump_rtables(void)
 884 {
 885         size_t i;
 886         pdump_entry_list_elt *elt;
 887         pdump_reloc_table rt;
 888
 889         for (i = 0; i < lrecord_type_count; i++) {
 890                 elt = pdump_object_table[i].first;
 891                 if (!elt)
 892                         continue;
 893                 rt.desc = lrecord_implementations_table[i]->description;
 894                 rt.count = pdump_object_table[i].count;
 895                 PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 896                 while (elt) {
 897                         EMACS_INT rdata =
 898                             pdump_get_entry(elt->obj)->save_offset;
 899                         PDUMP_WRITE_ALIGNED(EMACS_INT, rdata);
 900                         elt = elt->next;
 901                 }
 902         }
 903
 904         rt.desc = 0;
 905         rt.count = 0;
 906         PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 907
 908         for (i = 0; i < (size_t)pdump_struct_table.count; i++) {
 909                 elt = pdump_struct_table.list[i].list.first;
 910                 rt.desc = pdump_struct_table.list[i].sdesc->description;
 911                 rt.count = pdump_struct_table.list[i].list.count;
 912                 PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 913                 while (elt) {
 914                         EMACS_INT rdata =
 915                             pdump_get_entry(elt->obj)->save_offset;
 916                         int j;
 917                         for (j = 0; j < elt->count; j++) {
 918                                 PDUMP_WRITE_ALIGNED(EMACS_INT, rdata);
 919                                 rdata += elt->size;
 920                         }
 921                         elt = elt->next;
 922                 }
 923         }
 924         rt.desc = 0;
 925         rt.count = 0;
 926         PDUMP_WRITE_ALIGNED(pdump_reloc_table, rt);
 927 }
 928
 929 static void pdump_dump_root_objects(void)
 930 {
 931         size_t count = (Dynarr_length(pdump_root_objects) +
 932                         Dynarr_length(pdump_weak_object_chains));
 933         EMACS_INT i;
 934
 935         PDUMP_WRITE_ALIGNED(size_t, count);
 936         PDUMP_ALIGN_OUTPUT(pdump_static_Lisp_Object);
 937
 938         for (i = 0; i < Dynarr_length(pdump_root_objects); i++) {
 939                 pdump_static_Lisp_Object obj;
 940                 obj.address = Dynarr_at(pdump_root_objects, i);
 941                 obj.value = *obj.address;
 942
 943                 if (POINTER_TYPE_P(XTYPE(obj.value)))
 944                         obj.value =
 945                             wrap_object((void *)
 946                                         pdump_get_entry(XRECORD_LHEADER
 947                                                         (obj.value))->
 948                                         save_offset);
 949
 950                 PDUMP_WRITE(pdump_static_Lisp_Object, obj);
 951         }
 952
 953         for (i = 0; i < Dynarr_length(pdump_weak_object_chains); i++) {
 954                 pdump_entry_list_elt *elt;
 955                 pdump_static_Lisp_Object obj;
 956
 957                 obj.address = Dynarr_at(pdump_weak_object_chains, i);
 958                 obj.value = *obj.address;
 959
 960                 for (;;) {
 961                         const struct lrecord_description *desc;
 962                         int pos;