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