git.chise.org Git - chise/xemacs-chise.git.1/blob - src/dumper.c

   1 /* Portable data dumper for XEmacs.
   2    Copyright (C) 1999-2000 Olivier Galibert
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25 #include "dump-id.h"
  26 #include "specifier.h"
  27 #include "alloc.h"
  28 #include "elhash.h"
  29 #include "sysfile.h"
  30 #include "console-stream.h"
  31 #include "dumper.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 {
  43   const struct lrecord_description *desc;
  44   int count;
  45 } pdump_reloc_table;
  46
  47 static char *pdump_rt_list = 0;
  48
  49 void
  50 pdump_objects_unmark (void)
  51 {
  52   int i;
  53   char *p = pdump_rt_list;
  54   if (p)
  55     for (;;)
  56       {
  57         pdump_reloc_table *rt = (pdump_reloc_table *)p;
  58         p += sizeof (pdump_reloc_table);
  59         if (rt->desc)
  60           {
  61             for (i=0; i<rt->count; i++)
  62               {
  63                 struct lrecord_header *lh = * (struct lrecord_header **) p;
  64                 if (! C_READONLY_RECORD_HEADER_P (lh))
  65                   UNMARK_RECORD_HEADER (lh);
  66                 p += sizeof (EMACS_INT);
  67               }
  68           } else
  69             break;
  70       }
  71 }
  72
  73
  74 /* The structure of the file
  75  *
  76  * 0                    - header
  77  * 256                  - dumped objects
  78  * stab_offset          - nb_staticpro*(Lisp_Object *) from staticvec
  79  *                      - nb_staticpro*(relocated Lisp_Object) pointed to by staticpro
  80  *                      - nb_structdmp*pair(void *, adr) for pointers to structures
  81  *                      - lrecord_implementations_table[]
  82  *                      - relocation table
  83  *                      - wired variable address/value couples with the count preceding the list
  84  */
  85
  86
  87 #define DUMP_SIGNATURE "XEmacsDP"
  88 #define DUMP_SIGNATURE_LEN (sizeof (DUMP_SIGNATURE) - 1)
  89
  90 typedef struct
  91 {
  92   char signature[DUMP_SIGNATURE_LEN];
  93   unsigned int id;
  94   EMACS_UINT stab_offset;
  95   EMACS_UINT reloc_address;
  96   int nb_staticpro;
  97   int nb_structdmp;
  98   int nb_opaquedmp;
  99 } dump_header;
 100
 101 char *pdump_start, *pdump_end;
 102 static size_t pdump_length;
 103 void (*pdump_free) (void);
 104
 105 static const unsigned char align_table[256] =
 106 {
 107   8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 108   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 109   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 110   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 111   6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 112   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 113   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 114   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 115   7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 116   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 117   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 118   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 119   6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 120   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 121   5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
 122   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
 123 };
 124
 125 typedef struct pdump_entry_list_elmt
 126 {
 127   struct pdump_entry_list_elmt *next;
 128   const void *obj;
 129   size_t size;
 130   int count;
 131   int is_lrecord;
 132   EMACS_INT save_offset;
 133 } pdump_entry_list_elmt;
 134
 135 typedef struct
 136 {
 137   pdump_entry_list_elmt *first;
 138   int align;
 139   int count;
 140 } pdump_entry_list;
 141
 142 typedef struct pdump_struct_list_elmt
 143 {
 144   pdump_entry_list list;
 145   const struct struct_description *sdesc;
 146 } pdump_struct_list_elmt;
 147
 148 typedef struct
 149 {
 150   pdump_struct_list_elmt *list;
 151   int count;
 152   int size;
 153 } pdump_struct_list;
 154
 155 static pdump_entry_list pdump_object_table[256];
 156 static pdump_entry_list pdump_opaque_data_list;
 157 static pdump_struct_list pdump_struct_table;
 158 static pdump_entry_list_elmt *pdump_qnil;
 159
 160 static int pdump_alert_undump_object[256];
 161
 162 static unsigned long cur_offset;
 163 static size_t max_size;
 164 static int pdump_fd;
 165 static void *pdump_buf;
 166
 167 #define PDUMP_HASHSIZE 200001
 168
 169 static pdump_entry_list_elmt **pdump_hash;
 170
 171 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
 172 static int
 173 pdump_make_hash (const void *obj)
 174 {
 175   return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
 176 }
 177
 178 static pdump_entry_list_elmt *
 179 pdump_get_entry (const void *obj)
 180 {
 181   int pos = pdump_make_hash (obj);
 182   pdump_entry_list_elmt *e;
 183
 184   assert (obj != 0);
 185
 186   while ((e = pdump_hash[pos]) != 0)
 187     {
 188       if (e->obj == obj)
 189         return e;
 190
 191       pos++;
 192       if (pos == PDUMP_HASHSIZE)
 193         pos = 0;
 194     }
 195   return 0;
 196 }
 197
 198 static void
 199 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
 200 {
 201   pdump_entry_list_elmt *e;
 202   int align;
 203   int pos = pdump_make_hash (obj);
 204
 205   while ((e = pdump_hash[pos]) != 0)
 206     {
 207       if (e->obj == obj)
 208         return;
 209
 210       pos++;
 211       if (pos == PDUMP_HASHSIZE)
 212         pos = 0;
 213     }
 214
 215   e = xnew (pdump_entry_list_elmt);
 216
 217   e->next = list->first;
 218   e->obj = obj;
 219   e->size = size;
 220   e->count = count;
 221   e->is_lrecord = is_lrecord;
 222   list->first = e;
 223
 224   list->count += count;
 225   pdump_hash[pos] = e;
 226
 227   align = align_table[size & 255];
 228   if (align < 2 && is_lrecord)
 229     align = 2;
 230
 231   if (align < list->align)
 232     list->align = align;
 233 }
 234
 235 static pdump_entry_list *
 236 pdump_get_entry_list (const struct struct_description *sdesc)
 237 {
 238   int i;
 239   for (i=0; i<pdump_struct_table.count; i++)
 240     if (pdump_struct_table.list[i].sdesc == sdesc)
 241       return &pdump_struct_table.list[i].list;
 242
 243   if (pdump_struct_table.size <= pdump_struct_table.count)
 244     {
 245       if (pdump_struct_table.size == -1)
 246         pdump_struct_table.size = 10;
 247       else
 248         pdump_struct_table.size = pdump_struct_table.size * 2;
 249       pdump_struct_table.list = (pdump_struct_list_elmt *)
 250         xrealloc (pdump_struct_table.list,
 251                   pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
 252     }
 253   pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
 254   pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
 255   pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
 256   pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
 257
 258   return &pdump_struct_table.list[pdump_struct_table.count++].list;
 259 }
 260
 261 static struct
 262 {
 263   struct lrecord_header *obj;
 264   int position;
 265   int offset;
 266 } backtrace[65536];
 267
 268 static int depth;
 269
 270 static void pdump_backtrace (void)
 271 {
 272   int i;
 273   stderr_out ("pdump backtrace :\n");
 274   for (i=0;i<depth;i++)
 275     {
 276       if (!backtrace[i].obj)
 277         stderr_out ("  - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
 278       else
 279         {
 280           stderr_out ("  - %s (%d, %d)\n",
 281                    LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
 282                    backtrace[i].position,
 283                    backtrace[i].offset);
 284         }
 285     }
 286 }
 287
 288 static void pdump_register_object (Lisp_Object obj);
 289 static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
 290
 291 static EMACS_INT
 292 pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
 293 {
 294   EMACS_INT count;
 295   const void *irdata;
 296
 297   int line = XD_INDIRECT_VAL (code);
 298   int delta = XD_INDIRECT_DELTA (code);
 299
 300   irdata = ((char *)idata) + idesc[line].offset;
 301   switch (idesc[line].type)
 302     {
 303     case XD_SIZE_T:
 304       count = *(size_t *)irdata;
 305       break;
 306     case XD_INT:
 307       count = *(int *)irdata;
 308       break;
 309     case XD_LONG:
 310       count = *(long *)irdata;
 311       break;
 312     case XD_BYTECOUNT:
 313       count = *(Bytecount *)irdata;
 314       break;
 315     default:
 316       stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
 317       pdump_backtrace ();
 318       abort ();
 319     }
 320   count += delta;
 321   return count;
 322 }
 323
 324 static void
 325 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
 326 {
 327   int pos;
 328
 329  restart:
 330   for (pos = 0; desc[pos].type != XD_END; pos++)
 331     {
 332       const void *rdata = (const char *)data + desc[pos].offset;
 333
 334       backtrace[me].position = pos;
 335       backtrace[me].offset = desc[pos].offset;
 336
 337       switch (desc[pos].type)
 338         {
 339         case XD_SPECIFIER_END:
 340           pos = 0;
 341           desc = ((const Lisp_Specifier *)data)->methods->extra_description;
 342           goto restart;
 343         case XD_SIZE_T:
 344         case XD_INT:
 345         case XD_LONG:
 346         case XD_BYTECOUNT:
 347         case XD_LO_RESET_NIL:
 348         case XD_INT_RESET:
 349         case XD_LO_LINK:
 350           break;
 351         case XD_OPAQUE_DATA_PTR:
 352           {
 353             EMACS_INT count = desc[pos].data1;
 354             if (XD_IS_INDIRECT (count))
 355               count = pdump_get_indirect_count (count, desc, data);
 356
 357             pdump_add_entry (&pdump_opaque_data_list,
 358                              *(void **)rdata,
 359                              count,
 360                              1,
 361                              0);
 362             break;
 363           }
 364         case XD_C_STRING:
 365           {
 366             const char *str = *(const char **)rdata;
 367             if (str)
 368               pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
 369             break;
 370           }
 371         case XD_DOC_STRING:
 372           {
 373             const char *str = *(const char **)rdata;
 374             if ((EMACS_INT)str > 0)
 375               pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
 376             break;
 377           }
 378         case XD_LISP_OBJECT:
 379           {
 380             const Lisp_Object *pobj = (const Lisp_Object *)rdata;
 381
 382             assert (desc[pos].data1 == 0);
 383
 384             backtrace[me].offset = (const char *)pobj - (const char *)data;
 385             pdump_register_object (*pobj);
 386             break;
 387           }
 388         case XD_LISP_OBJECT_ARRAY:
 389           {
 390             int i;
 391             EMACS_INT count = desc[pos].data1;
 392             if (XD_IS_INDIRECT (count))
 393               count = pdump_get_indirect_count (count, desc, data);
 394
 395             for (i = 0; i < count; i++)
 396               {
 397                 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
 398                 Lisp_Object dobj = *pobj;
 399
 400                 backtrace[me].offset = (const char *)pobj - (const char *)data;
 401                 pdump_register_object (dobj);
 402               }
 403             break;
 404           }
 405         case XD_STRUCT_PTR:
 406           {
 407             EMACS_INT count = desc[pos].data1;
 408             const struct struct_description *sdesc = desc[pos].data2;
 409             const char *dobj = *(const char **)rdata;
 410             if (dobj)
 411               {
 412                 if (XD_IS_INDIRECT (count))
 413                   count = pdump_get_indirect_count (count, desc, data);
 414
 415                 pdump_register_struct (dobj, sdesc, count);
 416               }
 417             break;
 418           }
 419         default:
 420           stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
 421           pdump_backtrace ();
 422           abort ();
 423         };
 424     }
 425 }
 426
 427 static void
 428 pdump_register_object (Lisp_Object obj)
 429 {
 430   struct lrecord_header *objh;
 431
 432   if (!POINTER_TYPE_P (XTYPE (obj)))
 433     return;
 434
 435   objh = XRECORD_LHEADER (obj);
 436   if (!objh)
 437     return;
 438
 439   if (pdump_get_entry (objh))
 440     return;
 441
 442   if (LHEADER_IMPLEMENTATION (objh)->description)
 443     {
 444       int me = depth++;
 445       if (me>65536)
 446         {
 447           stderr_out ("Backtrace overflow, loop ?\n");
 448           abort ();
 449         }
 450       backtrace[me].obj = objh;
 451       backtrace[me].position = 0;
 452       backtrace[me].offset = 0;
 453
 454       pdump_add_entry (pdump_object_table + objh->type,
 455                        objh,
 456                        LHEADER_IMPLEMENTATION (objh)->static_size ?
 457                        LHEADER_IMPLEMENTATION (objh)->static_size :
 458                        LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh),
 459                        1,
 460                        1);
 461       pdump_register_sub (objh,
 462                           LHEADER_IMPLEMENTATION (objh)->description,
 463                           me);
 464       --depth;
 465     }
 466   else
 467     {
 468       pdump_alert_undump_object[objh->type]++;
 469       stderr_out ("Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name);
 470       pdump_backtrace ();
 471     }
 472 }
 473
 474 static void
 475 pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
 476 {
 477   if (data && !pdump_get_entry (data))
 478     {
 479       int me = depth++;
 480       int i;
 481       if (me>65536)
 482         {
 483           stderr_out ("Backtrace overflow, loop ?\n");
 484           abort ();
 485         }
 486       backtrace[me].obj = 0;
 487       backtrace[me].position = 0;
 488       backtrace[me].offset = 0;
 489
 490       pdump_add_entry (pdump_get_entry_list (sdesc),
 491                        data,
 492                        sdesc->size,
 493                        count,
 494                        0);
 495       for (i=0; i<count; i++)
 496         {
 497           pdump_register_sub (((char *)data) + sdesc->size*i,
 498                               sdesc->description,
 499                               me);
 500         }
 501       --depth;
 502     }
 503 }
 504
 505 static void
 506 pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
 507 {
 508   size_t size = elmt->size;
 509   int count = elmt->count;
 510   if (desc)
 511     {
 512       int pos, i;
 513       memcpy (pdump_buf, elmt->obj, size*count);
 514
 515       for (i=0; i<count; i++)
 516         {
 517           char *cur = ((char *)pdump_buf) + i*size;
 518         restart:
 519           for (pos = 0; desc[pos].type != XD_END; pos++)
 520             {
 521               void *rdata = cur + desc[pos].offset;
 522               switch (desc[pos].type)
 523                 {
 524                 case XD_SPECIFIER_END:
 525                   desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
 526                   goto restart;
 527                 case XD_SIZE_T:
 528                 case XD_INT:
 529                 case XD_LONG:
 530                 case XD_BYTECOUNT:
 531                   break;
 532                 case XD_LO_RESET_NIL:
 533                   {
 534                     EMACS_INT num = desc[pos].data1;
 535                     int j;
 536                     if (XD_IS_INDIRECT (num))
 537                       num = pdump_get_indirect_count (num, desc, elmt->obj);
 538                     for (j=0; j<num; j++)
 539                       ((EMACS_INT *)rdata)[j] = pdump_qnil->save_offset;
 540                     break;
 541                   }
 542                 case XD_INT_RESET:
 543                   {
 544                     EMACS_INT val = desc[pos].data1;
 545                     if (XD_IS_INDIRECT (val))
 546                       val = pdump_get_indirect_count (val, desc, elmt->obj);
 547                     *(int *)rdata = val;
 548                     break;
 549                   }
 550                 case XD_OPAQUE_DATA_PTR:
 551                 case XD_C_STRING:
 552                 case XD_STRUCT_PTR:
 553                   {
 554                     void *ptr = *(void **)rdata;
 555                     if (ptr)
 556                       *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
 557                     break;
 558                   }
 559                 case XD_LO_LINK:
 560                   {
 561                     Lisp_Object obj = *(Lisp_Object *)rdata;
 562                     pdump_entry_list_elmt *elmt1;
 563                     for (;;)
 564                       {
 565                         elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
 566                         if (elmt1)
 567                           break;
 568                         obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
 569                       }
 570                     *(EMACS_INT *)rdata = elmt1->save_offset;
 571                     break;
 572                   }
 573                 case XD_LISP_OBJECT:
 574                   {
 575                     Lisp_Object *pobj = (Lisp_Object *) rdata;
 576
 577                     assert (desc[pos].data1 == 0);
 578
 579                     if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
 580                       *(EMACS_INT *)pobj =
 581                         pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
 582                     break;
 583                   }
 584                 case XD_LISP_OBJECT_ARRAY:
 585                   {
 586                     EMACS_INT num = desc[pos].data1;
 587                     int j;
 588                     if (XD_IS_INDIRECT (num))
 589                       num = pdump_get_indirect_count (num, desc, elmt->obj);
 590
 591                     for (j=0; j<num; j++)
 592                       {
 593                         Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
 594                         if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
 595                           *(EMACS_INT *)pobj =
 596                             pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
 597                       }
 598                     break;
 599                   }
 600                 case XD_DOC_STRING:
 601                   {
 602                     EMACS_INT str = *(EMACS_INT *)rdata;
 603                     if (str > 0)
 604                       *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
 605                     break;
 606                   }
 607                 default:
 608                   stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
 609                   abort ();
 610                 };
 611             }
 612         }
 613     }
 614   write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
 615   if (elmt->is_lrecord && ((size*count) & 3))
 616     write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
 617 }
 618
 619 static void
 620 pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
 621 {
 622   int pos;
 623
 624  restart:
 625   for (pos = 0; desc[pos].type != XD_END; pos++)
 626     {
 627       void *rdata = (char *)data + desc[pos].offset;
 628       switch (desc[pos].type)
 629         {
 630         case XD_SPECIFIER_END:
 631           pos = 0;
 632           desc = ((const Lisp_Specifier *)data)->methods->extra_description;
 633           goto restart;
 634         case XD_SIZE_T:
 635         case XD_INT:
 636         case XD_LONG:
 637         case XD_BYTECOUNT:
 638         case XD_INT_RESET:
 639           break;
 640         case XD_OPAQUE_DATA_PTR:
 641         case XD_C_STRING:
 642         case XD_STRUCT_PTR:
 643         case XD_LO_LINK:
 644           {
 645             EMACS_INT ptr = *(EMACS_INT *)rdata;
 646             if (ptr)
 647               *(EMACS_INT *)rdata = ptr+delta;
 648             break;
 649           }
 650         case XD_LISP_OBJECT:
 651           {
 652             Lisp_Object *pobj = (Lisp_Object *) rdata;
 653
 654             assert (desc[pos].data1 == 0);
 655
 656             if (POINTER_TYPE_P (XTYPE (*pobj))
 657                 && ! EQ (*pobj, Qnull_pointer))
 658               XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta);
 659
 660             break;
 661           }
 662         case XD_LISP_OBJECT_ARRAY:
 663         case XD_LO_RESET_NIL:
 664           {
 665             EMACS_INT num = desc[pos].data1;
 666             int j;
 667             if (XD_IS_INDIRECT (num))
 668               num = pdump_get_indirect_count (num, desc, data);
 669
 670             for (j=0; j<num; j++)
 671               {
 672                 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
 673
 674                 if (POINTER_TYPE_P (XTYPE (*pobj))
 675                     && ! EQ (*pobj, Qnull_pointer))
 676                   XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta);
 677               }
 678             break;
 679           }
 680         case XD_DOC_STRING:
 681           {
 682             EMACS_INT str = *(EMACS_INT *)rdata;
 683             if (str > 0)
 684               *(EMACS_INT *)rdata = str + delta;
 685             break;
 686           }
 687         default:
 688           stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
 689           abort ();
 690         };
 691     }
 692 }
 693
 694 static void
 695 pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
 696 {
 697   size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
 698   elmt->save_offset = cur_offset;
 699   if (size>max_size)
 700     max_size = size;
 701   cur_offset += size;
 702 }
 703
 704 static void
 705 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
 706 {
 707   int align, i;
 708   const struct lrecord_description *idesc;
 709   pdump_entry_list_elmt *elmt;
 710   for (align=8; align>=0; align--)
 711     {
 712       for (i=0; i<lrecord_type_count; i++)
 713         if (pdump_object_table[i].align == align)
 714           {
 715             elmt = pdump_object_table[i].first;
 716             if (!elmt)
 717               continue;
 718             idesc = lrecord_implementations_table[i]->description;
 719             while (elmt)
 720               {
 721                 f (elmt, idesc);
 722                 elmt = elmt->next;
 723               }
 724           }
 725
 726       for (i=0; i<pdump_struct_table.count; i++)
 727         if (pdump_struct_table.list[i].list.align == align)
 728           {
 729             elmt = pdump_struct_table.list[i].list.first;
 730             idesc = pdump_struct_table.list[i].sdesc->description;
 731             while (elmt)
 732               {
 733                 f (elmt, idesc);
 734                 elmt = elmt->next;
 735               }
 736           }
 737
 738       elmt = pdump_opaque_data_list.first;
 739       while (elmt)
 740         {
 741           if (align_table[elmt->size & 255] == align)
 742             f (elmt, 0);
 743           elmt = elmt->next;
 744         }
 745     }
 746 }
 747
 748 static void
 749 pdump_dump_staticvec (void)
 750 {
 751   EMACS_INT *reloc = xnew_array (EMACS_INT, staticidx);
 752   int i;
 753   write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *));
 754
 755   for (i=0; i<staticidx; i++)
 756     {
 757       Lisp_Object obj = *staticvec[i];
 758       if (POINTER_TYPE_P (XTYPE (obj)))
 759         reloc[i] = pdump_get_entry (XRECORD_LHEADER (obj))->save_offset;
 760       else
 761         reloc[i] = *(EMACS_INT *)(staticvec[i]);
 762     }
 763   write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object));
 764   free (reloc);
 765 }
 766
 767 static void
 768 pdump_dump_structvec (void)
 769 {
 770   int i;
 771   for (i=0; i<dumpstructidx; i++)
 772     {
 773       EMACS_INT adr;
 774       write (pdump_fd, &(dumpstructvec[i].data), sizeof (void *));
 775       adr = pdump_get_entry (*(void **)(dumpstructvec[i].data))->save_offset;
 776       write (pdump_fd, &adr, sizeof (adr));
 777     }
 778 }
 779
 780 static void
 781 pdump_dump_opaquevec (void)
 782 {
 783   int i;
 784   for (i=0; i<dumpopaqueidx; i++)
 785     {
 786       write (pdump_fd, &(dumpopaquevec[i]), sizeof (dumpopaquevec[i]));
 787       write (pdump_fd, dumpopaquevec[i].data, dumpopaquevec[i].size);
 788     }
 789 }
 790
 791 static void
 792 pdump_dump_itable (void)
 793 {
 794   write (pdump_fd, lrecord_implementations_table, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
 795 }
 796
 797 static void
 798 pdump_dump_rtables (void)
 799 {
 800   int i, j;
 801   pdump_entry_list_elmt *elmt;
 802   pdump_reloc_table rt;
 803
 804   for (i=0; i<lrecord_type_count; i++)
 805     {
 806       elmt = pdump_object_table[i].first;
 807       if (!elmt)
 808         continue;
 809       rt.desc = lrecord_implementations_table[i]->description;
 810       rt.count = pdump_object_table[i].count;
 811       write (pdump_fd, &rt, sizeof (rt));
 812       while (elmt)
 813         {
 814           EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
 815           write (pdump_fd, &rdata, sizeof (rdata));
 816           elmt = elmt->next;
 817         }
 818     }
 819
 820   rt.desc = 0;
 821   rt.count = 0;
 822   write (pdump_fd, &rt, sizeof (rt));
 823
 824   for (i=0; i<pdump_struct_table.count; i++)
 825     {
 826       elmt = pdump_struct_table.list[i].list.first;
 827       rt.desc = pdump_struct_table.list[i].sdesc->description;
 828       rt.count = pdump_struct_table.list[i].list.count;
 829       write (pdump_fd, &rt, sizeof (rt));
 830       while (elmt)
 831         {
 832           EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
 833           for (j=0; j<elmt->count; j++)
 834             {
 835               write (pdump_fd, &rdata, sizeof (rdata));
 836               rdata += elmt->size;
 837             }
 838           elmt = elmt->next;
 839         }
 840     }
 841   rt.desc = 0;
 842   rt.count = 0;
 843   write (pdump_fd, &rt, sizeof (rt));
 844 }
 845
 846 static void
 847 pdump_dump_wired (void)
 848 {
 849   EMACS_INT count = pdump_wireidx + pdump_wireidx_list;
 850   int i;
 851
 852   write (pdump_fd, &count, sizeof (count));
 853
 854   for (i=0; i<pdump_wireidx; i++)
 855     {
 856       EMACS_INT obj = pdump_get_entry (XRECORD_LHEADER (*(pdump_wirevec[i])))->save_offset;
 857       write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i]));
 858       write (pdump_fd, &obj, sizeof (obj));
 859     }
 860
 861   for (i=0; i<pdump_wireidx_list; i++)
 862     {
 863       Lisp_Object obj = *(pdump_wirevec_list[i]);
 864       pdump_entry_list_elmt *elmt;
 865       EMACS_INT res;
 866
 867       for (;;)
 868         {
 869           const struct lrecord_description *desc;
 870           int pos;
 871           elmt = pdump_get_entry (XRECORD_LHEADER (obj));
 872           if (elmt)
 873             break;
 874           desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
 875           for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
 876             assert (desc[pos].type != XD_END);
 877
 878           obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
 879         }
 880       res = elmt->save_offset;
 881
 882       write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i]));
 883       write (pdump_fd, &res, sizeof (res));
 884     }
 885 }
 886
 887 void
 888 pdump (void)
 889 {
 890   int i;
 891   Lisp_Object t_console, t_device, t_frame;
 892   int none;
 893   dump_header hd;
 894
 895   /* These appear in a DEFVAR_LISP, which does a staticpro() */
 896   t_console = Vterminal_console;
 897   t_frame   = Vterminal_frame;
 898   t_device  = Vterminal_device;
 899
 900   Vterminal_console = Qnil;
 901   Vterminal_frame   = Qnil;
 902   Vterminal_device  = Qnil;
 903
 904   pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
 905
 906   for (i=0; i<lrecord_type_count; i++)
 907     {
 908       pdump_object_table[i].first = 0;
 909       pdump_object_table[i].align = 8;
 910       pdump_object_table[i].count = 0;
 911       pdump_alert_undump_object[i] = 0;
 912     }
 913   pdump_struct_table.count = 0;
 914   pdump_struct_table.size = -1;
 915
 916   pdump_opaque_data_list.first = 0;
 917   pdump_opaque_data_list.align = 8;
 918   pdump_opaque_data_list.count = 0;
 919   depth = 0;
 920
 921   for (i=0; i<staticidx; i++)
 922     pdump_register_object (*staticvec[i]);
 923   for (i=0; i<pdump_wireidx; i++)
 924     pdump_register_object (*pdump_wirevec[i]);
 925
 926   none = 1;
 927   for (i=0; i<lrecord_type_count; i++)
 928     if (pdump_alert_undump_object[i])
 929       {
 930         if (none)
 931           printf ("Undumpable types list :\n");
 932         none = 0;
 933         printf ("  - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
 934       }
 935   if (!none)
 936     return;
 937
 938   for (i=0; i<dumpstructidx; i++)
 939     pdump_register_struct (*(void **)(dumpstructvec[i].data), dumpstructvec[i].desc, 1);
 940
 941   memcpy (hd.signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN);
 942   hd.id = dump_id;
 943   hd.reloc_address = 0;
 944   hd.nb_staticpro = staticidx;
 945   hd.nb_structdmp = dumpstructidx;
 946   hd.nb_opaquedmp = dumpopaqueidx;
 947
 948   cur_offset = 256;
 949   max_size = 0;
 950
 951   pdump_scan_by_alignment (pdump_allocate_offset);
 952   pdump_qnil = pdump_get_entry (XRECORD_LHEADER (Qnil));
 953
 954   pdump_buf = xmalloc (max_size);
 955   /* Avoid use of the `open' macro.  We want the real function. */
 956 #undef open
 957   pdump_fd = open (EMACS_PROGNAME ".dmp",
 958                    O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
 959   hd.stab_offset = (cur_offset + 3) & ~3;
 960
 961   write (pdump_fd, &hd, sizeof (hd));
 962   lseek (pdump_fd, 256, SEEK_SET);
 963
 964   pdump_scan_by_alignment (pdump_dump_data);
 965
 966   lseek (pdump_fd, hd.stab_offset, SEEK_SET);
 967
 968   pdump_dump_staticvec ();
 969   pdump_dump_structvec ();
 970   pdump_dump_opaquevec ();
 971   pdump_dump_itable ();
 972   pdump_dump_rtables ();
 973   pdump_dump_wired ();
 974
 975   close (pdump_fd);
 976   free (pdump_buf);
 977
 978   free (pdump_hash);
 979
 980   Vterminal_console = t_console;
 981   Vterminal_frame   = t_frame;
 982   Vterminal_device  = t_device;
 983 }
 984
 985 static int pdump_load_check (void)
 986 {
 987   return (!memcmp (((dump_header *)pdump_start)->signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN)
 988           && ((dump_header *)pdump_start)->id == dump_id);
 989 }
 990
 991 static int pdump_load_finish (void)
 992 {
 993   int i;
 994   char *p;
 995   EMACS_INT delta;
 996   EMACS_INT count;
 997
 998   pdump_end = pdump_start + pdump_length;
 999
1000 #define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1))
1001
1002   staticidx = ((dump_header *)(pdump_start))->nb_staticpro;
1003   delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address;
1004   p = pdump_start + ((dump_header *)pdump_start)->stab_offset;
1005
1006   /* Put back the staticvec in place */
1007   memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *));
1008   p += staticidx*sizeof (Lisp_Object *);
1009   for (i=0; i<staticidx; i++)
1010     {
1011       Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
1012       if (POINTER_TYPE_P (XTYPE (obj)))
1013         XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta);
1014       *staticvec[i] = obj;
1015     }
1016
1017   /* Put back the dumpstructs */
1018   for (i=0; i<((dump_header *)pdump_start)->nb_structdmp; i++)
1019     {
1020       void **adr = PDUMP_READ (p, void **);
1021       *adr = (void *) (PDUMP_READ (p, char *) + delta);
1022     }
1023
1024   /* Put back the opaques */
1025   for (i=0; i<((dump_header *)pdump_start)->nb_opaquedmp; i++)
1026     {
1027       struct pdump_dumpopaqueinfo di = PDUMP_READ (p, struct pdump_dumpopaqueinfo);
1028       memcpy (di.data, p, di.size);
1029       p += di.size;
1030     }
1031
1032   /* Put back the lrecord_implementations_table */
1033   /* The (void *) cast is there to make Ben happy. */
1034   memcpy ((void *) lrecord_implementations_table, p, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
1035   p += lrecord_type_count*sizeof (lrecord_implementations_table[0]);
1036
1037   /* Reinitialize lrecord_markers from lrecord_implementations_table */
1038   for (i=0; i < lrecord_type_count; i++)
1039     if (lrecord_implementations_table[i])
1040       lrecord_markers[i] = lrecord_implementations_table[i]->marker;
1041
1042   /* Do the relocations */
1043   pdump_rt_list = p;
1044   count = 2;
1045   for (;;)
1046     {
1047       pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1048       if (rt.desc)
1049         {
1050           for (i=0; i < rt.count; i++)
1051             {
1052               char *adr = delta + *(char **)p;
1053               *(char **)p = adr;
1054               pdump_reloc_one (adr, delta, rt.desc);
1055               p += sizeof (char *);
1056             }
1057         } else
1058           if (!(--count))
1059             break;
1060     }
1061
1062   /* Put the pdump_wire variables in place */
1063   count = PDUMP_READ (p, EMACS_INT);
1064
1065   for (i=0; i<count; i++)
1066     {
1067       Lisp_Object *var = PDUMP_READ (p, Lisp_Object *);
1068       Lisp_Object  obj = PDUMP_READ (p, Lisp_Object);
1069
1070       if (POINTER_TYPE_P (XTYPE (obj)))
1071         XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta);
1072
1073       *var = obj;
1074     }
1075
1076   /* Final cleanups */
1077   /*   reorganize hash tables */
1078   p = pdump_rt_list;
1079   for (;;)
1080     {
1081       pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1082       if (!rt.desc)
1083         break;
1084       if (rt.desc == hash_table_description)
1085         {
1086           for (i=0; i < rt.count; i++)
1087             pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1088           break;
1089         } else
1090           p += sizeof (Lisp_Object) * rt.count;
1091     }
1092
1093   /* Put back noninteractive1 to its real value */
1094   noninteractive1 = noninteractive;
1095
1096   return 1;
1097 }
1098
1099 #ifdef WINDOWSNT
1100 static void pdump_file_unmap(void)
1101 {
1102 }
1103
1104 static int pdump_file_get(const char *path)
1105 {
1106   HANDLE hFile;
1107   HANDLE hMap;
1108
1109   hFile = CreateFile (path,
1110                       GENERIC_READ + GENERIC_WRITE,  /* Required for copy on write */
1111                       0,                    /* Not shared */
1112                       NULL,                 /* Not inheritable */
1113                       OPEN_EXISTING,
1114                       FILE_ATTRIBUTE_NORMAL,
1115                       NULL);                /* No template file */
1116   if (hFile == INVALID_HANDLE_VALUE)
1117     return 0;
1118
1119   pdump_length = GetFileSize (hFile, NULL);
1120   hMap = CreateFileMapping (hFile,
1121                             NULL,                   /* No security attributes */
1122                             PAGE_WRITECOPY,   /* Copy on write */
1123                             0,              /* Max size, high half */
1124                             0,              /* Max size, low half */
1125                             NULL);          /* Unnamed */
1126   if (hMap == INVALID_HANDLE_VALUE)
1127     return 0;
1128
1129   pdump_start = MapViewOfFile (hMap,
1130                                FILE_MAP_COPY,  /* Copy on write */
1131                                0,             /* Start at zero */
1132                                0,
1133                                0);            /* Map all of it */
1134   pdump_free = pdump_file_unmap;
1135   return 1;
1136 }
1137
1138 static void pdump_resource_free (void)
1139 static int pdump_resource_get (void)
1140 {
1141   HRSRC hRes;         /* Handle to dump resource */
1142   HRSRC hResLoad;             /* Handle to loaded dump resource */
1143
1144   /* See Q126630 which describes how Windows NT and 95 trap writes to
1145      resource sections and duplicate the page to allow the write to proceed.
1146      It also describes how to make the resource section read/write (and hence
1147      private to each process).  Doing this avoids the exceptions and related
1148      overhead, but causes the resource section to be private to each process
1149      that is running XEmacs.  Since the resource section contains little
1150      other than the dumped data, which should be private to each process, we
1151      make the whole resource section read/write so we don't have to copy it. */
1152
1153   hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1154   if (hRes == NULL)
1155     return 0;
1156
1157   /* Found it, use the data in the resource */
1158   hResLoad = LoadResource (NULL, hRes);
1159   if (hResLoad == NULL)
1160     return 0;
1161
1162   pdump_start = LockResource (hResLoad);
1163   if (pdump_start == NULL)
1164     return 0;
1165
1166   pdump_free = pdump_resource_free;
1167   pdump_length = SizeofResource (NULL, hRes);
1168   if (pdump_length <= sizeof(dump_header))
1169     {
1170       pdump_start = 0;
1171       return 0;
1172     }
1173
1174   return 1;
1175 }
1176
1177 #else /* !WINDOWSNT */
1178
1179 static void *pdump_mallocadr;
1180
1181 static void pdump_file_free(void)
1182 {
1183   xfree (pdump_mallocadr);
1184 }
1185
1186 #ifdef HAVE_MMAP
1187 static void pdump_file_unmap(void)
1188 {
1189   munmap (pdump_start, pdump_length);
1190 }
1191 #endif
1192
1193 static int pdump_file_get(const char *path)
1194 {
1195   int fd = open (path, O_RDONLY | OPEN_BINARY);
1196   if (fd<0)
1197     return 0;
1198
1199   pdump_length = lseek (fd, 0, SEEK_END);
1200   if (pdump_length < sizeof (dump_header))
1201     {
1202       close (fd);
1203       return 0;
1204     }
1205
1206   lseek (fd, 0, SEEK_SET);
1207
1208 #ifdef HAVE_MMAP
1209   pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1210   if (pdump_start != MAP_FAILED)
1211     {
1212       pdump_free = pdump_file_unmap;
1213       close (fd);
1214       return 1;
1215     }
1216 #endif
1217
1218   pdump_mallocadr = xmalloc(pdump_length+255);
1219   pdump_free = pdump_file_free;
1220   pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1221   read (pdump_fd, pdump_start, pdump_length);
1222
1223   close (pdump_fd);
1224   return 1;
1225 }
1226 #endif /* !WINDOWSNT */
1227
1228
1229 static int pdump_file_try(char *exe_path)
1230 {
1231   char *w;
1232
1233   w = exe_path + strlen(exe_path);
1234   do
1235     {
1236       sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1237       if (pdump_file_get (exe_path))
1238         {
1239           if (pdump_load_check ())
1240             return 1;
1241           pdump_free();
1242         }
1243
1244       sprintf (w, "-%08x.dmp", dump_id);
1245       if (pdump_file_get (exe_path))
1246         {
1247           if (pdump_load_check ())
1248             return 1;
1249           pdump_free();
1250         }
1251
1252       sprintf (w, ".dmp");
1253       if (pdump_file_get (exe_path))
1254         {
1255           if (pdump_load_check ())
1256             return 1;
1257           pdump_free();
1258         }
1259
1260       do
1261         w--;
1262       while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1263     }
1264   while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1265   return 0;
1266 }
1267
1268 int pdump_load(const char *argv0)
1269 {
1270   char exe_path[PATH_MAX];
1271   char *w;
1272 #ifdef WINDOWSNT
1273   GetModuleFileName (NULL, exe_name, PATH_MAX);
1274 #else /* !WINDOWSNT */
1275   const char *dir, *p;
1276
1277   dir = argv0;
1278   if (dir[0] == '-')
1279     {
1280       /* XEmacs as a login shell, oh goody! */
1281       dir = getenv("SHELL");
1282     }
1283
1284   p = dir + strlen(dir);
1285   while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1286
1287   if (p != dir)
1288     {
1289       /* invocation-name includes a directory component -- presumably it
1290          is relative to cwd, not $PATH */
1291       strcpy (exe_path, dir);
1292     }
1293   else
1294     {
1295       const char *path = getenv ("PATH");
1296       const char *name = p;
1297       for (;;)
1298         {
1299           p = path;
1300           while (*p && *p != SEPCHAR)
1301             p++;
1302           if (p == path)
1303             {
1304               exe_path[0] = '.';
1305               w = exe_path + 1;
1306             }
1307           else
1308             {
1309               memcpy (exe_path, path, p - path);
1310               w = exe_path + (p - path);
1311             }
1312           if (!IS_DIRECTORY_SEP (w[-1]))
1313             {
1314               *w++ = '/';
1315             }
1316           strcpy(w, name);
1317
1318           /* ### #$%$#^$^@%$^#%@$ ! */
1319 #ifdef access
1320 #undef access
1321 #endif
1322
1323           if (!access (exe_path, X_OK))
1324             break;
1325           if (!*p)
1326             {
1327               /* Oh well, let's have some kind of default */
1328               sprintf (exe_path, "./%s", name);
1329               break;
1330             }
1331           path = p+1;
1332         }
1333     }
1334 #endif /* WINDOWSNT */
1335
1336   if (pdump_file_try (exe_path))
1337     {
1338       pdump_load_finish ();
1339       return 1;
1340     }
1341
1342 #ifdef WINDOWSNT
1343   if (pdump_resource_get ())
1344     {
1345       if (pdump_load_check ())
1346         {
1347           pdump_load_finish ();
1348           return 1;
1349         }
1350       pdump_free ();
1351     }
1352 #endif
1353
1354   return 0;
1355 }