Mercurial > hg > xemacs-beta
annotate src/dumper.c @ 5167:e374ea766cc1
clean up, rearrange allocation statistics code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-21 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (assert_proper_sizing):
* alloc.c (c_readonly):
* alloc.c (malloced_storage_size):
* alloc.c (fixed_type_block_overhead):
* alloc.c (lisp_object_storage_size):
* alloc.c (inc_lrecord_stats):
* alloc.c (dec_lrecord_stats):
* alloc.c (pluralize_word):
* alloc.c (object_memory_usage_stats):
* alloc.c (Fobject_memory_usage):
* alloc.c (compute_memusage_stats_length):
* alloc.c (disksave_object_finalization_1):
* alloc.c (Fgarbage_collect):
* mc-alloc.c:
* mc-alloc.c (mc_alloced_storage_size):
* mc-alloc.h:
No functionality change here. Collect the allocations-statistics
code that was scattered throughout alloc.c into one place. Add
remaining section headings so that all sections have headings
clearly identifying the start of the section and its purpose.
Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS;
this fixes build problems and is related to the export of
lisp_object_storage_size() and malloced_storage_size() when
non-MEMORY_USAGE_STATS in the previous change set.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sun, 21 Mar 2010 04:41:49 -0500 |
| parents | c8f90d61dcf3 |
| children | 6c6d78781d59 |
| rev | line source |
|---|---|
| 442 | 1 /* Portable data dumper for XEmacs. |
| 2551 | 2 Copyright (C) 1999-2000,2004 Olivier Galibert |
| 458 | 3 Copyright (C) 2001 Martin Buchholz |
|
5059
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
4 Copyright (C) 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing. |
| 442 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 2367 | 25 /* This file has been Mule-ized, Ben Wing, 10-10-04. */ |
| 26 | |
| 27 /* #### Put in much more assertions. Whenever we store fixups in the | |
| 28 process or writing out data, make sure the fixups (offsets) point to the | |
| 29 beginning of an object, i.e. are registered. Same whenever we read in | |
| 30 -- verify offsets as registered, and when compute a fixup, verify the | |
| 31 pointer is pointing within the pdump area. registered and check within | |
| 32 pdump area. For specific types of pointers (e.g. to Lisp_Objects), | |
| 33 check if they're pointing to the right kinds of types. It should be | |
| 34 possible to check that a putative Lisp_Object is really a Lisp_Object | |
| 35 since it will follow a strict format in its header. */ | |
| 800 | 36 |
| 442 | 37 #include <config.h> |
| 38 #include "lisp.h" | |
| 39 | |
| 40 #include "specifier.h" | |
| 771 | 41 #include "file-coding.h" |
| 442 | 42 #include "elhash.h" |
| 1204 | 43 #include "lstream.h" |
| 442 | 44 #include "sysfile.h" |
| 45 #include "console-stream.h" | |
| 46 | |
| 47 #ifdef WIN32_NATIVE | |
| 771 | 48 #include "syswindows.h" |
| 442 | 49 #else |
| 50 #ifdef HAVE_MMAP | |
| 51 #include <sys/mman.h> | |
| 52 #endif | |
| 2720 | 53 #ifdef DUMP_IN_EXEC |
| 2015 | 54 #include "dump-data.h" |
| 442 | 55 #endif |
| 2720 | 56 #endif |
| 442 | 57 |
| 58 typedef struct | |
| 59 { | |
| 2367 | 60 const void *blockaddr; |
| 665 | 61 Bytecount size; |
| 1204 | 62 const struct memory_description *desc; |
| 63 } pdump_root_block; | |
| 452 | 64 |
| 65 typedef struct | |
| 66 { | |
| 1204 | 67 Dynarr_declare (pdump_root_block); |
| 68 } pdump_root_block_dynarr; | |
| 452 | 69 |
| 70 typedef struct | |
| 71 { | |
| 72 void **ptraddress; | |
| 1204 | 73 const struct sized_memory_description *desc; |
| 2367 | 74 } pdump_root_block_ptr; |
| 452 | 75 |
| 76 typedef struct | |
| 77 { | |
| 2367 | 78 Dynarr_declare (pdump_root_block_ptr); |
| 79 } pdump_root_block_ptr_dynarr; | |
| 452 | 80 |
| 458 | 81 typedef struct |
| 82 { | |
| 2551 | 83 const void *object; |
| 84 void *data; | |
| 85 Bytecount size; | |
| 86 EMACS_INT offset; | |
| 87 EMACS_INT dest_offset; | |
| 88 EMACS_INT save_offset; | |
| 89 const struct opaque_convert_functions *fcts; | |
| 90 } pdump_cv_data_info; | |
| 91 | |
| 92 typedef struct | |
| 93 { | |
| 94 Dynarr_declare (pdump_cv_data_info); | |
| 95 } pdump_cv_data_info_dynarr; | |
| 96 | |
| 97 typedef struct | |
| 98 { | |
| 99 EMACS_INT dest_offset; | |
| 100 EMACS_INT save_offset; | |
| 101 Bytecount size; | |
| 102 } pdump_cv_data_dump_info; | |
| 103 | |
| 104 typedef struct | |
| 105 { | |
| 106 const void *object; | |
| 107 void *data; | |
| 108 Bytecount size; | |
| 109 EMACS_INT index; | |
| 110 EMACS_INT save_offset; | |
| 111 const struct opaque_convert_functions *fcts; | |
| 112 } pdump_cv_ptr_info; | |
| 113 | |
| 114 typedef struct | |
| 115 { | |
| 116 Dynarr_declare (pdump_cv_ptr_info); | |
| 117 } pdump_cv_ptr_info_dynarr; | |
| 118 | |
| 119 typedef struct | |
| 120 { | |
| 121 EMACS_INT save_offset; | |
| 122 Bytecount size; | |
| 123 } pdump_cv_ptr_dump_info; | |
| 124 | |
| 125 typedef struct | |
| 126 { | |
| 127 EMACS_INT save_offset; | |
| 128 Bytecount size; | |
| 129 void *adr; | |
| 130 } pdump_cv_ptr_load_info; | |
| 131 | |
| 132 typedef struct | |
| 133 { | |
| 458 | 134 Lisp_Object *address; |
| 135 Lisp_Object value; | |
| 136 } pdump_static_Lisp_Object; | |
| 137 | |
| 138 typedef struct | |
| 139 { | |
| 2367 | 140 Rawbyte **address; /* Rawbyte * for ease of doing relocation */ |
| 141 Rawbyte * value; | |
| 458 | 142 } pdump_static_pointer; |
| 143 | |
| 1204 | 144 static pdump_root_block_dynarr *pdump_root_blocks; |
| 2367 | 145 static pdump_root_block_ptr_dynarr *pdump_root_block_ptrs; |
| 1204 | 146 static Lisp_Object_ptr_dynarr *pdump_root_lisp_objects; |
| 452 | 147 static Lisp_Object_ptr_dynarr *pdump_weak_object_chains; |
| 2551 | 148 static pdump_cv_data_info_dynarr *pdump_cv_data; |
| 149 static pdump_cv_ptr_info_dynarr *pdump_cv_ptr; | |
| 452 | 150 |
| 2367 | 151 /* Mark SIZE bytes at non-heap address BLOCKADDR for dumping, described |
| 152 by DESC. Called by outside callers during XEmacs initialization. */ | |
| 153 | |
| 452 | 154 void |
| 2367 | 155 dump_add_root_block (const void *blockaddr, Bytecount size, |
| 1204 | 156 const struct memory_description *desc) |
| 452 | 157 { |
| 1204 | 158 pdump_root_block info; |
| 2367 | 159 info.blockaddr = blockaddr; |
| 452 | 160 info.size = size; |
| 1204 | 161 info.desc = desc; |
| 162 if (pdump_root_blocks == NULL) | |
| 163 pdump_root_blocks = Dynarr_new (pdump_root_block); | |
| 164 Dynarr_add (pdump_root_blocks, info); | |
| 452 | 165 } |
| 166 | |
| 2367 | 167 /* Mark the block described by DESC and pointed to by the pointer at |
| 168 non-heap address PTRADDRESS for dumping. | |
| 169 All the objects reachable from this pointer will also be dumped. | |
| 170 Called by outside callers during XEmacs initialization. */ | |
| 452 | 171 void |
| 2367 | 172 dump_add_root_block_ptr (void *ptraddress, |
| 173 const struct sized_memory_description *desc) | |
| 452 | 174 { |
| 2367 | 175 pdump_root_block_ptr info; |
| 452 | 176 info.ptraddress = (void **) ptraddress; |
| 177 info.desc = desc; | |
| 2367 | 178 if (pdump_root_block_ptrs == NULL) |
| 179 pdump_root_block_ptrs = Dynarr_new (pdump_root_block_ptr); | |
| 180 Dynarr_add (pdump_root_block_ptrs, info); | |
| 452 | 181 } |
| 182 | |
| 183 /* Mark the Lisp_Object at non-heap address VARADDRESS for dumping. | |
| 2367 | 184 All the objects reachable from this var will also be dumped. |
| 185 Called by outside callers during XEmacs initialization. */ | |
| 452 | 186 void |
| 1204 | 187 dump_add_root_lisp_object (Lisp_Object *varaddress) |
| 452 | 188 { |
| 1204 | 189 if (pdump_root_lisp_objects == NULL) |
| 190 pdump_root_lisp_objects = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); | |
| 191 Dynarr_add (pdump_root_lisp_objects, varaddress); | |
| 452 | 192 } |
| 193 | |
| 2367 | 194 /* Mark the list pointed to by the Lisp_Object at VARADDRESS for dumping. |
| 195 Called by outside callers during XEmacs initialization. */ | |
| 452 | 196 void |
| 197 dump_add_weak_object_chain (Lisp_Object *varaddress) | |
| 198 { | |
| 199 if (pdump_weak_object_chains == NULL) | |
| 200 pdump_weak_object_chains = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); | |
| 201 Dynarr_add (pdump_weak_object_chains, varaddress); | |
| 202 } | |
| 203 | |
| 204 | |
| 458 | 205 inline static void |
| 665 | 206 pdump_align_stream (FILE *stream, Bytecount alignment) |
| 458 | 207 { |
| 208 long offset = ftell (stream); | |
| 209 long adjustment = ALIGN_SIZE (offset, alignment) - offset; | |
| 210 if (adjustment) | |
| 211 fseek (stream, adjustment, SEEK_CUR); | |
| 212 } | |
| 213 | |
| 214 #define PDUMP_ALIGN_OUTPUT(type) pdump_align_stream (pdump_out, ALIGNOF (type)) | |
| 215 | |
| 216 #define PDUMP_WRITE(type, object) \ | |
| 771 | 217 retry_fwrite (&object, sizeof (object), 1, pdump_out); |
| 458 | 218 |
| 219 #define PDUMP_WRITE_ALIGNED(type, object) do { \ | |
| 220 PDUMP_ALIGN_OUTPUT (type); \ | |
| 221 PDUMP_WRITE (type, object); \ | |
| 222 } while (0) | |
| 223 | |
| 224 #define PDUMP_READ(ptr, type) \ | |
| 2367 | 225 (((type *) (ptr = (Rawbyte *) (((type *) ptr) + 1)))[-1]) |
| 458 | 226 |
| 227 #define PDUMP_READ_ALIGNED(ptr, type) \ | |
| 2367 | 228 ((ptr = (Rawbyte *) ALIGN_PTR (ptr, type)), PDUMP_READ (ptr, type)) |
| 458 | 229 |
| 230 | |
| 231 | |
| 452 | 232 typedef struct |
| 233 { | |
| 1204 | 234 const struct memory_description *desc; |
| 442 | 235 int count; |
| 236 } pdump_reloc_table; | |
| 237 | |
| 2367 | 238 static Rawbyte *pdump_rt_list = 0; |
| 442 | 239 |
| 3263 | 240 #ifndef NEW_GC |
| 442 | 241 void |
| 242 pdump_objects_unmark (void) | |
| 243 { | |
| 244 int i; | |
| 2367 | 245 Rawbyte *p = pdump_rt_list; |
| 442 | 246 if (p) |
| 247 for (;;) | |
| 248 { | |
| 249 pdump_reloc_table *rt = (pdump_reloc_table *)p; | |
| 250 p += sizeof (pdump_reloc_table); | |
| 251 if (rt->desc) | |
| 252 { | |
| 253 for (i=0; i<rt->count; i++) | |
| 254 { | |
| 255 struct lrecord_header *lh = * (struct lrecord_header **) p; | |
|
5059
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
256 #ifdef ALLOC_TYPE_STATS |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
257 if (C_READONLY_RECORD_HEADER_P (lh)) |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
258 tick_lrecord_stats (lh, ALLOC_IN_USE); |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
259 |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
260 else |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
261 { |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
262 tick_lrecord_stats (lh, MARKED_RECORD_HEADER_P (lh) ? |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
263 ALLOC_IN_USE : ALLOC_ON_FREE_LIST); |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
264 UNMARK_RECORD_HEADER (lh); |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
265 } |
|
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
266 #else /* not ALLOC_TYPE_STATS */ |
| 442 | 267 if (! C_READONLY_RECORD_HEADER_P (lh)) |
| 268 UNMARK_RECORD_HEADER (lh); | |
|
5059
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
269 #endif /* (not) ALLOC_TYPE_STATS */ |
| 442 | 270 p += sizeof (EMACS_INT); |
| 271 } | |
| 272 } else | |
| 273 break; | |
| 274 } | |
| 275 } | |
| 3263 | 276 #endif /* not NEW_GC */ |
| 277 | |
| 278 | |
| 279 #ifdef NEW_GC | |
| 2720 | 280 /* The structure of the dump file looks like this: |
| 281 0 - header | |
| 282 - dumped objects | |
| 283 stab_offset - mc allocation table (count, size, address) for individual | |
| 284 allocation and relocation at load time. | |
| 285 - nb_cv_data*struct(dest, adr) for in-object externally | |
| 286 represented data | |
| 287 - nb_cv_ptr*(adr) for pointed-to externally represented data | |
| 288 - relocation table | |
| 289 - nb_root_struct_ptrs*struct(void *, adr) | |
| 290 for global pointers to structures | |
| 291 - nb_root_blocks*struct(void *, size, info) for global | |
| 292 objects to restore | |
| 293 - root lisp object address/value couples with the count | |
| 294 preceding the list | |
| 295 */ | |
| 3263 | 296 #else /* not NEW_GC */ |
| 1204 | 297 /* The structure of the dump file looks like this: |
| 458 | 298 0 - header |
| 299 - dumped objects | |
| 2551 | 300 stab_offset - nb_cv_data*struct(dest, adr) for in-object externally |
| 301 represented data | |
| 302 - nb_cv_ptr*(adr) for pointed-to externally represented data | |
| 303 - nb_root_block_ptrs*struct(void *, adr) | |
| 2367 | 304 for global pointers to heap blocks |
| 1204 | 305 - nb_root_blocks*struct(void *, size, info) for global |
| 2367 | 306 data-segment blocks to restore |
| 458 | 307 - relocation table |
| 308 - root lisp object address/value couples with the count | |
| 309 preceding the list | |
| 442 | 310 */ |
| 3263 | 311 #endif /* not NEW_GC */ |
| 442 | 312 |
| 313 | |
| 452 | 314 #define PDUMP_SIGNATURE "XEmacsDP" |
| 315 #define PDUMP_SIGNATURE_LEN (sizeof (PDUMP_SIGNATURE) - 1) | |
| 442 | 316 |
| 317 typedef struct | |
| 318 { | |
| 452 | 319 char signature[PDUMP_SIGNATURE_LEN]; |
| 442 | 320 unsigned int id; |
| 321 EMACS_UINT stab_offset; | |
| 322 EMACS_UINT reloc_address; | |
| 2367 | 323 int nb_root_block_ptrs; |
| 1204 | 324 int nb_root_blocks; |
| 2551 | 325 int nb_cv_data; |
| 326 int nb_cv_ptr; | |
| 452 | 327 } pdump_header; |
| 442 | 328 |
| 2367 | 329 Rawbyte *pdump_start; |
| 330 Rawbyte *pdump_end; | |
| 665 | 331 static Bytecount pdump_length; |
| 442 | 332 |
| 2551 | 333 static pdump_cv_data_dump_info *pdump_loaded_cv_data; |
| 334 static pdump_cv_ptr_load_info *pdump_loaded_cv_ptr; | |
| 335 | |
| 442 | 336 #ifdef WIN32_NATIVE |
| 452 | 337 /* Handle for the dump file */ |
| 458 | 338 static HANDLE pdump_hFile = INVALID_HANDLE_VALUE; |
| 452 | 339 /* Handle for the file mapping object for the dump file */ |
| 458 | 340 static HANDLE pdump_hMap = INVALID_HANDLE_VALUE; |
| 442 | 341 #endif |
| 342 | |
| 458 | 343 static void (*pdump_free) (void); |
| 442 | 344 |
| 460 | 345 static unsigned char pdump_align_table[] = |
| 442 | 346 { |
| 460 | 347 64, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1, |
| 348 16, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1, | |
| 349 32, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1, | |
| 350 16, 1, 2, 1, 4, 1, 2, 1, 8, 1, 2, 1, 4, 1, 2, 1 | |
| 442 | 351 }; |
| 352 | |
| 647 | 353 static inline int |
| 665 | 354 pdump_size_to_align (Bytecount size) |
| 442 | 355 { |
| 460 | 356 return pdump_align_table[size % countof (pdump_align_table)]; |
| 357 } | |
| 358 | |
| 2367 | 359 /************************************************************************/ |
| 360 /* Registering memory blocks */ | |
| 361 /************************************************************************/ | |
| 362 | |
| 363 /* "Registering" or recording a heap memory block (which will need to be | |
| 364 written out, reloaded and relocated, and to which there may be pointers | |
| 365 from other heap blocks or from the data segment) happens both in a list | |
| 366 and in a hash table. There is a single hash table covering all | |
| 367 registered blocks, but different lists for different kinds of blocks. | |
| 368 There is one list for "opaque data" (stuff identified as | |
| 369 XD_OPAQUE_DATA_PTR, XD_ASCII_STRING, XD_DOC_STRING), one list for each | |
| 370 type of Lisp object, and one list for each different memory descriptor. | |
| 371 This lets similar-sized and aligned objects be grouped together when | |
| 372 they are written out, to save space. | |
| 373 | |
| 374 pdump_block_list is a list keeping track of registered memory blocks. | |
| 375 pdump_block_list_elt is a single entry through the list, and the list is | |
| 376 threaded through the NEXT pointer. The information in this list | |
| 377 associated with a particular block of memory is | |
| 378 | |
| 379 -- address of the beginning | |
| 380 -- number of elements at that address | |
| 381 -- size of each element | |
| 382 -- offset to this block in the dumped data | |
| 383 | |
| 384 pdump_desc_list is a list keeping track of the various descriptions | |
| 385 that we've seen. The primary purpose of this is so that memory blocks | |
| 386 can be grouped depending on the particular memory description | |
| 387 appropriate for them. The format of the list is different from | |
| 388 pdump_block_list -- a single array is used. (#### Dynarr should have | |
| 389 been used!!!). The information in this list associated with a | |
| 390 description is | |
| 391 | |
| 392 -- pointer to the description | |
| 393 -- a pdump_block_list of blocks using that description | |
| 394 | |
| 395 Functions for working with lists of memory blocks: | |
| 396 | |
| 397 -- Add a memory block to a list using pdump_add_block() | |
| 398 | |
| 399 -- Get a memory block from a pointer to its beginning using | |
| 400 pdump_get_block(). This uses the hash table, which lists everything. | |
| 401 | |
| 402 -- Return the memory-block list (pdump_block_list) associated with a | |
| 403 descriptor, using pdump_get_block_list(). If no entry found in the | |
| 404 pdump_desc_list, add a new one. | |
| 405 | |
| 406 */ | |
| 407 | |
| 408 typedef struct pdump_block_list_elt | |
| 460 | 409 { |
| 2367 | 410 struct pdump_block_list_elt *next; |
| 442 | 411 const void *obj; |
| 665 | 412 Bytecount size; |
| 442 | 413 int count; |
| 414 EMACS_INT save_offset; | |
| 2367 | 415 } pdump_block_list_elt; |
| 442 | 416 |
| 417 typedef struct | |
| 418 { | |
| 2367 | 419 pdump_block_list_elt *first; |
| 442 | 420 int align; |
| 421 int count; | |
| 2367 | 422 } pdump_block_list; |
| 442 | 423 |
| 2367 | 424 typedef struct pdump_desc_list_elt |
| 442 | 425 { |
| 2367 | 426 pdump_block_list list; |
| 1204 | 427 const struct memory_description *desc; |
| 2367 | 428 } pdump_desc_list_elt; |
| 442 | 429 |
| 430 typedef struct | |
| 431 { | |
| 2367 | 432 pdump_desc_list_elt *list; |
| 442 | 433 int count; |
| 434 int size; | |
| 2367 | 435 } pdump_desc_list; |
| 442 | 436 |
| 2367 | 437 static pdump_block_list *pdump_object_table; |
| 438 static pdump_block_list pdump_opaque_data_list; | |
| 439 static pdump_desc_list pdump_desc_table; | |
| 442 | 440 |
| 460 | 441 static int *pdump_alert_undump_object; |
| 442 | 442 |
| 443 static unsigned long cur_offset; | |
| 665 | 444 static Bytecount max_size; |
| 442 | 445 static int pdump_fd; |
| 446 static void *pdump_buf; | |
| 458 | 447 static FILE *pdump_out; |
| 442 | 448 |
| 3263 | 449 #ifdef NEW_GC |
| 2775 | 450 /* PDUMP_HASHSIZE is a large prime. */ |
| 451 #define PDUMP_HASHSIZE 1000003 | |
| 452 /* Nothing special about PDUMP_HASH_MULTIPLIER: arbitrary odd integer | |
| 453 smaller than PDUMP_HASHSIZE. */ | |
| 454 #define PDUMP_HASH_MULTIPLIER 12347 | |
| 455 /* Nothing special about PDUMP_HASH_STEP: arbitrary integer for linear | |
| 456 probing. */ | |
| 457 #define PDUMP_HASH_STEP 574853 | |
| 3263 | 458 #else /* not NEW_GC */ |
| 442 | 459 #define PDUMP_HASHSIZE 200001 |
| 3263 | 460 #endif /* not NEW_GC */ |
| 442 | 461 |
| 2367 | 462 static pdump_block_list_elt **pdump_hash; |
| 442 | 463 |
| 3263 | 464 #ifndef NEW_GC |
| 442 | 465 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */ |
| 3263 | 466 #endif /* not NEW_GC */ |
| 442 | 467 static int |
| 468 pdump_make_hash (const void *obj) | |
| 469 { | |
| 3263 | 470 #ifdef NEW_GC |
| 2775 | 471 return ((unsigned long)(obj) * PDUMP_HASH_MULTIPLIER) % PDUMP_HASHSIZE; |
| 3263 | 472 #else /* not NEW_GC */ |
| 442 | 473 return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE; |
| 3263 | 474 #endif /* not NEW_GC */ |
| 442 | 475 } |
| 476 | |
| 2367 | 477 /* Return the entry for an already-registered memory block at OBJ, |
| 478 or NULL if none. */ | |
| 479 | |
| 480 static pdump_block_list_elt * | |
| 481 pdump_get_block (const void *obj) | |
| 442 | 482 { |
| 483 int pos = pdump_make_hash (obj); | |
| 2367 | 484 pdump_block_list_elt *e; |
| 442 | 485 |
| 486 assert (obj != 0); | |
| 487 | |
| 488 while ((e = pdump_hash[pos]) != 0) | |
| 489 { | |
| 490 if (e->obj == obj) | |
| 491 return e; | |
| 492 | |
| 493 pos++; | |
| 494 if (pos == PDUMP_HASHSIZE) | |
| 495 pos = 0; | |
| 496 } | |
| 497 return 0; | |
| 498 } | |
| 499 | |
| 2367 | 500 /* Register a new memory block on Return the entry for an already-registered heap (?) memory block at OBJ, |
| 501 or NULL if none. */ | |
| 502 | |
| 442 | 503 static void |
| 2367 | 504 pdump_add_block (pdump_block_list *list, const void *obj, Bytecount size, |
| 458 | 505 int count) |
| 442 | 506 { |
| 2367 | 507 pdump_block_list_elt *e; |
| 442 | 508 int pos = pdump_make_hash (obj); |
| 509 | |
| 510 while ((e = pdump_hash[pos]) != 0) | |
| 511 { | |
| 512 if (e->obj == obj) | |
| 513 return; | |
| 514 | |
| 515 pos++; | |
| 516 if (pos == PDUMP_HASHSIZE) | |
| 517 pos = 0; | |
| 518 } | |
| 519 | |
| 2367 | 520 e = xnew (pdump_block_list_elt); |
| 442 | 521 |
| 522 e->next = list->first; | |
| 523 e->obj = obj; | |
| 524 e->size = size; | |
| 525 e->count = count; | |
| 526 list->first = e; | |
| 527 | |
| 528 list->count += count; | |
| 529 pdump_hash[pos] = e; | |
| 530 | |
| 460 | 531 { |
| 532 int align = pdump_size_to_align (size); | |
| 442 | 533 |
| 460 | 534 if (align < list->align) |
| 535 list->align = align; | |
| 536 } | |
| 442 | 537 } |
| 538 | |
| 3263 | 539 #ifdef NEW_GC |
| 2720 | 540 typedef struct mc_addr_elt |
| 541 { | |
| 542 const void *obj; | |
| 543 EMACS_INT addr; | |
| 544 } mc_addr_elt; | |
| 545 | |
| 546 static mc_addr_elt *pdump_mc_hash; | |
| 547 | |
| 548 /* Return the entry for an already-registered memory block at OBJ, | |
| 549 or NULL if none. */ | |
| 550 static EMACS_INT | |
| 551 pdump_get_mc_addr (const void *obj) | |
| 552 { | |
| 553 int pos = pdump_make_hash (obj); | |
| 554 mc_addr_elt *mc_addr; | |
| 555 | |
| 556 assert (obj != 0); | |
| 557 | |
| 2723 | 558 while (((mc_addr = &pdump_mc_hash[pos]) != 0) && (mc_addr->obj != 0)) |
| 2720 | 559 { |
| 560 if (mc_addr->obj == obj) | |
| 561 return mc_addr->addr; | |
| 562 | |
| 2775 | 563 pos += PDUMP_HASH_STEP; |
| 564 if (pos >= PDUMP_HASHSIZE) | |
| 565 pos -= PDUMP_HASHSIZE; | |
| 2720 | 566 } |
| 567 | |
| 568 /* If this code is reached, an heap address occurred which has not | |
| 569 been written to the lookup table before. | |
| 570 This is a bug! */ | |
| 571 ABORT(); | |
| 572 return 0; | |
| 573 } | |
| 574 | |
| 575 /* For indirect address lookups, needed for convertibles: Ptr points | |
| 576 to an address within an object. Indirect gives the offset by how | |
| 577 many bytes the address of the object has to be adjusted to do a | |
| 578 lookup in the mc_addr translation table and get the new location of | |
| 579 the data. */ | |
| 580 #define pdump_get_indirect_mc_addr(ptr, indirect) \ | |
| 581 pdump_get_mc_addr ((void *)((ptr) - indirect)) + indirect | |
| 582 | |
| 583 static void | |
| 584 pdump_put_mc_addr (const void *obj, EMACS_INT addr) | |
| 585 { | |
| 586 mc_addr_elt *mc_addr; | |
| 587 int pos = pdump_make_hash (obj); | |
| 588 | |
| 2723 | 589 while (((mc_addr = &pdump_mc_hash[pos]) != 0) && (mc_addr->obj != 0)) |
| 2720 | 590 { |
| 591 if (mc_addr->obj == obj) | |
| 592 return; | |
| 593 | |
| 2775 | 594 pos += PDUMP_HASH_STEP; |
| 595 if (pos >= PDUMP_HASHSIZE) | |
| 596 pos -= PDUMP_HASHSIZE; | |
| 2720 | 597 } |
| 598 | |
| 599 pdump_mc_hash[pos].obj = obj; | |
| 600 pdump_mc_hash[pos].addr = addr; | |
| 601 } | |
| 3263 | 602 #endif /* NEW_GC */ |
| 2720 | 603 |
| 2367 | 604 static pdump_block_list * |
| 605 pdump_get_block_list (const struct memory_description *desc) | |
| 442 | 606 { |
| 607 int i; | |
| 2367 | 608 for (i=0; i<pdump_desc_table.count; i++) |
| 609 if (pdump_desc_table.list[i].desc == desc) | |
| 610 return &pdump_desc_table.list[i].list; | |
| 442 | 611 |
| 2367 | 612 if (pdump_desc_table.size <= pdump_desc_table.count) |
| 442 | 613 { |
| 2367 | 614 if (pdump_desc_table.size == -1) |
| 615 pdump_desc_table.size = 10; | |
| 442 | 616 else |
| 2367 | 617 pdump_desc_table.size = pdump_desc_table.size * 2; |
| 618 pdump_desc_table.list = (pdump_desc_list_elt *) | |
| 619 xrealloc (pdump_desc_table.list, | |
| 620 pdump_desc_table.size * sizeof (pdump_desc_list_elt)); | |
| 442 | 621 } |
| 2367 | 622 pdump_desc_table.list[pdump_desc_table.count].list.first = 0; |
| 623 pdump_desc_table.list[pdump_desc_table.count].list.align = ALIGNOF (max_align_t); | |
| 624 pdump_desc_table.list[pdump_desc_table.count].list.count = 0; | |
| 625 pdump_desc_table.list[pdump_desc_table.count].desc = desc; | |
| 442 | 626 |
| 2367 | 627 return &pdump_desc_table.list[pdump_desc_table.count++].list; |
| 442 | 628 } |
| 629 | |
| 2551 | 630 static pdump_cv_ptr_info * |
| 631 pdump_find_in_cv_ptr_dynarr(const void *object) | |
| 632 { | |
| 633 int i; | |
| 634 for (i = 0; i < Dynarr_length (pdump_cv_ptr); i++) | |
| 635 if (Dynarr_at (pdump_cv_ptr, i).object == object) | |
| 636 return Dynarr_atp (pdump_cv_ptr, i); | |
| 637 return 0; | |
| 638 } | |
| 639 | |
| 2698 | 640 #define BACKTRACE_MAX 65536 |
| 641 | |
| 442 | 642 static struct |
| 643 { | |
| 644 struct lrecord_header *obj; | |
| 645 int position; | |
| 646 int offset; | |
| 2698 | 647 } backtrace[BACKTRACE_MAX]; |
| 442 | 648 |
| 1204 | 649 static int pdump_depth; |
| 442 | 650 |
| 1204 | 651 void |
| 452 | 652 pdump_backtrace (void) |
| 442 | 653 { |
| 654 int i; | |
| 655 stderr_out ("pdump backtrace :\n"); | |
| 1204 | 656 for (i = 0; i < pdump_depth; i++) |
| 442 | 657 { |
| 658 if (!backtrace[i].obj) | |
| 458 | 659 stderr_out (" - ind. (%d, %d)\n", |
| 660 backtrace[i].position, | |
| 661 backtrace[i].offset); | |
| 442 | 662 else |
| 663 { | |
| 664 stderr_out (" - %s (%d, %d)\n", | |
| 1204 | 665 LHEADER_IMPLEMENTATION (backtrace[i].obj)->name, |
| 666 backtrace[i].position, | |
| 667 backtrace[i].offset); | |
| 442 | 668 } |
| 669 } | |
| 670 } | |
| 671 | |
| 1204 | 672 static void |
| 1333 | 673 pdump_unsupported_dump_type (enum memory_description_type type, |
| 674 int do_backtrace) | |
| 675 { | |
| 676 stderr_out ("Unsupported dump type : %d\n", type); | |
| 677 #ifdef WIN32_NATIVE | |
| 678 stderr_out ("Are you compiling with SUPPORT_EDIT_AND_CONTINUE?\n"); | |
| 679 stderr_out ("See the PROBLEMS file.\n"); | |
| 680 #endif | |
| 681 if (do_backtrace) | |
| 682 pdump_backtrace (); | |
| 2500 | 683 ABORT (); |
| 1333 | 684 } |
| 685 | |
| 686 static void | |
| 1204 | 687 pdump_bump_depth (void) |
| 688 { | |
| 689 int me = pdump_depth++; | |
| 2698 | 690 if (me >= BACKTRACE_MAX) |
| 1204 | 691 { |
| 692 stderr_out ("Backtrace overflow, loop ?\n"); | |
| 2500 | 693 ABORT (); |
| 1204 | 694 } |
| 695 backtrace[me].obj = 0; | |
| 696 backtrace[me].position = 0; | |
| 697 backtrace[me].offset = 0; | |
| 698 } | |
| 699 | |
| 442 | 700 static void pdump_register_object (Lisp_Object obj); |
| 3092 | 701 #ifdef NEW_GC |
| 702 static void pdump_register_object_array (Lisp_Object data, | |
| 703 Bytecount size, | |
| 704 const struct memory_description *desc, | |
| 705 int count); | |
| 706 #endif /* NEW_GC */ | |
| 2367 | 707 static void pdump_register_block_contents (const void *data, |
| 708 Bytecount size, | |
| 709 const struct memory_description * | |
| 710 desc, | |
| 711 int count); | |
| 712 static void pdump_register_block (const void *data, | |
| 713 Bytecount size, | |
| 714 const struct memory_description *desc, | |
| 715 int count); | |
| 442 | 716 |
| 717 static void | |
| 1204 | 718 pdump_register_sub (const void *data, const struct memory_description *desc) |
| 442 | 719 { |
| 720 int pos; | |
| 1204 | 721 int me = pdump_depth - 1; |
| 442 | 722 |
| 723 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 724 { | |
| 1204 | 725 const struct memory_description *desc1 = &desc[pos]; |
| 726 EMACS_INT offset = lispdesc_indirect_count (desc1->offset, desc, | |
| 727 data); | |
| 2367 | 728 const void *rdata = (const Rawbyte *) data + offset; |
| 442 | 729 |
| 730 backtrace[me].position = pos; | |
| 1204 | 731 backtrace[me].offset = offset; |
| 732 | |
| 733 union_switcheroo: | |
| 442 | 734 |
| 1204 | 735 /* If the flag says don't dump, then don't dump. */ |
| 736 if ((desc1->flags) & XD_FLAG_NO_PDUMP) | |
| 737 continue; | |
| 738 | |
| 739 switch (desc1->type) | |
| 442 | 740 { |
| 665 | 741 case XD_BYTECOUNT: |
| 742 case XD_ELEMCOUNT: | |
| 743 case XD_HASHCODE: | |
| 442 | 744 case XD_INT: |
| 745 case XD_LONG: | |
| 746 case XD_INT_RESET: | |
| 747 case XD_LO_LINK: | |
| 748 break; | |
| 749 case XD_OPAQUE_DATA_PTR: | |
| 750 { | |
| 1204 | 751 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, |
| 752 data); | |
| 442 | 753 |
| 2367 | 754 pdump_add_block (&pdump_opaque_data_list, |
| 458 | 755 *(void **)rdata, count, 1); |
| 442 | 756 break; |
| 757 } | |
| 2367 | 758 case XD_ASCII_STRING: |
| 442 | 759 { |
| 2367 | 760 const Ascbyte *str = * (const Ascbyte **) rdata; |
| 442 | 761 if (str) |
| 2367 | 762 pdump_add_block (&pdump_opaque_data_list, str, strlen (str) + 1, |
| 1204 | 763 1); |
| 442 | 764 break; |
| 765 } | |
| 766 case XD_DOC_STRING: | |
| 767 { | |
| 2367 | 768 const Ascbyte *str = * (const Ascbyte **) rdata; |
| 1204 | 769 if ((EMACS_INT) str > 0) |
| 2367 | 770 pdump_add_block (&pdump_opaque_data_list, str, strlen (str) + 1, |
| 1204 | 771 1); |
| 442 | 772 break; |
| 773 } | |
| 774 case XD_LISP_OBJECT: | |
| 775 { | |
| 1204 | 776 const Lisp_Object *pobj = (const Lisp_Object *) rdata; |
| 442 | 777 |
| 1204 | 778 assert (desc1->data1 == 0); |
| 442 | 779 |
| 2367 | 780 backtrace[me].offset = |
| 781 (const Rawbyte *) pobj - (const Rawbyte *) data; | |
| 442 | 782 pdump_register_object (*pobj); |
| 783 break; | |
| 784 } | |
| 785 case XD_LISP_OBJECT_ARRAY: | |
| 786 { | |
| 787 int i; | |
| 1204 | 788 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, |
| 789 data); | |
| 442 | 790 |
| 791 for (i = 0; i < count; i++) | |
| 792 { | |
| 1204 | 793 const Lisp_Object *pobj = ((const Lisp_Object *) rdata) + i; |
| 442 | 794 Lisp_Object dobj = *pobj; |
| 795 | |
| 1204 | 796 backtrace[me].offset = |
| 2367 | 797 (const Rawbyte *) pobj - (const Rawbyte *) data; |
| 442 | 798 pdump_register_object (dobj); |
| 799 } | |
| 800 break; | |
| 801 } | |
| 3092 | 802 #ifdef NEW_GC |
| 803 case XD_LISP_OBJECT_BLOCK_PTR: | |
| 804 { | |
| 805 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, | |
| 806 data); | |
| 807 const struct sized_memory_description *sdesc = | |
| 808 lispdesc_indirect_description (data, desc1->data2.descr); | |
| 809 const Lisp_Object *pobj = (const Lisp_Object *) rdata; | |
| 810 if (pobj) | |
| 811 pdump_register_object_array | |
| 812 (*pobj, sdesc->size, sdesc->description, count); | |
| 813 break; | |
| 814 } | |
| 815 #endif /* NEW_GC */ | |
| 2367 | 816 case XD_BLOCK_PTR: |
| 442 | 817 { |
| 1204 | 818 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, |
| 819 data); | |
| 820 const struct sized_memory_description *sdesc = | |
| 2551 | 821 lispdesc_indirect_description (data, desc1->data2.descr); |
| 2367 | 822 const Rawbyte *dobj = *(const Rawbyte **)rdata; |
| 442 | 823 if (dobj) |
| 2367 | 824 pdump_register_block (dobj, sdesc->size, sdesc->description, |
| 825 count); | |
| 442 | 826 break; |
| 827 } | |
| 2367 | 828 case XD_BLOCK_ARRAY: |
| 771 | 829 { |
| 1204 | 830 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, |
| 831 data); | |
| 832 const struct sized_memory_description *sdesc = | |
| 2551 | 833 lispdesc_indirect_description (data, desc1->data2.descr); |
| 771 | 834 |
| 2367 | 835 pdump_register_block_contents (rdata, sdesc->size, |
| 836 sdesc->description, count); | |
| 771 | 837 break; |
| 838 } | |
| 839 case XD_UNION: | |
| 1204 | 840 case XD_UNION_DYNAMIC_SIZE: |
| 841 desc1 = lispdesc_process_xd_union (desc1, desc, data); | |
| 842 if (desc1) | |
| 843 goto union_switcheroo; | |
| 844 break; | |
| 2551 | 845 case XD_OPAQUE_PTR_CONVERTIBLE: |
| 846 { | |
| 847 pdump_cv_ptr_info info; | |
| 848 info.object = *(void **)rdata; | |
| 849 info.fcts = desc1->data2.funcs; | |
| 850 if (!pdump_find_in_cv_ptr_dynarr (info.object)) | |
| 851 { | |
| 852 info.fcts->convert(info.object, &info.data, &info.size); | |
| 853 Dynarr_add (pdump_cv_ptr, info); | |
| 854 } | |
| 855 break; | |
| 856 } | |
| 857 case XD_OPAQUE_DATA_CONVERTIBLE: | |
| 858 { | |
| 859 pdump_cv_data_info info; | |
| 860 info.object = data; | |
| 861 info.offset = offset; | |
| 862 info.fcts = desc1->data2.funcs; | |
| 863 | |
| 864 info.fcts->convert(rdata, &info.data, &info.size); | |
| 865 Dynarr_add (pdump_cv_data, info); | |
| 866 break; | |
| 867 } | |
| 771 | 868 |
| 442 | 869 default: |
| 1333 | 870 pdump_unsupported_dump_type (desc1->type, 1); |
| 1204 | 871 } |
| 442 | 872 } |
| 873 } | |
| 874 | |
| 875 static void | |
| 876 pdump_register_object (Lisp_Object obj) | |
| 877 { | |
| 878 struct lrecord_header *objh; | |
| 458 | 879 const struct lrecord_implementation *imp; |
| 442 | 880 |
| 881 if (!POINTER_TYPE_P (XTYPE (obj))) | |
| 882 return; | |
| 883 | |
| 884 objh = XRECORD_LHEADER (obj); | |
| 885 if (!objh) | |
| 886 return; | |
| 887 | |
| 2367 | 888 if (pdump_get_block (objh)) |
| 442 | 889 return; |
| 890 | |
| 458 | 891 imp = LHEADER_IMPLEMENTATION (objh); |
| 892 | |
| 934 | 893 if (imp->description |
| 3263 | 894 #ifdef NEW_GC |
| 895 /* Objects with finalizers cannot be dumped with the new | |
| 896 allocator's asynchronous finalization strategy. */ | |
| 897 && !imp->finalizer | |
| 898 #endif /* not NEW_GC */ | |
| 1204 | 899 && RECORD_DUMPABLE (objh)) |
| 442 | 900 { |
| 1204 | 901 pdump_bump_depth (); |
| 902 backtrace[pdump_depth - 1].obj = objh; | |
| 2367 | 903 pdump_add_block (pdump_object_table + objh->type, |
| 1204 | 904 objh, detagged_lisp_object_size (objh), 1); |
| 905 pdump_register_sub (objh, imp->description); | |
| 906 --pdump_depth; | |
| 442 | 907 } |
| 908 else | |
| 909 { | |
| 910 pdump_alert_undump_object[objh->type]++; | |
| 458 | 911 stderr_out ("Undumpable object type : %s\n", imp->name); |
| 442 | 912 pdump_backtrace (); |
| 913 } | |
| 914 } | |
| 915 | |
| 3092 | 916 #ifdef NEW_GC |
| 917 static void | |
| 918 pdump_register_object_array (Lisp_Object obj, | |
| 919 Bytecount size, | |
| 920 const struct memory_description *desc, | |
| 921 int count) | |
| 922 { | |
| 923 struct lrecord_header *objh; | |
| 924 const struct lrecord_implementation *imp; | |
| 925 | |
| 926 if (!POINTER_TYPE_P (XTYPE (obj))) | |
| 927 return; | |
| 928 | |
| 929 objh = XRECORD_LHEADER (obj); | |
| 930 if (!objh) | |
| 931 return; | |
| 932 | |
| 933 if (pdump_get_block (objh)) | |
| 934 return; | |
| 935 | |
| 936 imp = LHEADER_IMPLEMENTATION (objh); | |
| 937 | |
| 938 if (imp->description | |
| 939 && RECORD_DUMPABLE (objh)) | |
| 940 { | |
| 941 pdump_bump_depth (); | |
| 942 backtrace[pdump_depth - 1].obj = objh; | |
| 943 pdump_add_block (pdump_object_table + objh->type, | |
| 944 objh, lispdesc_block_size_1 (objh, size, desc), count); | |
| 945 pdump_register_block_contents (objh, size, desc, count); | |
| 946 --pdump_depth; | |
| 947 } | |
| 948 else | |
| 949 { | |
| 950 pdump_alert_undump_object[objh->type]++; | |
| 951 stderr_out ("Undumpable object type : %s\n", imp->name); | |
| 952 pdump_backtrace (); | |
| 953 } | |
| 954 } | |
| 955 #endif /* NEW_GC */ | |
| 956 | |
| 2367 | 957 /* Register the referenced objects in the array of COUNT blocks located at |
| 958 DATA; each block is described by SIZE and DESC. "Block" here simply | |
| 959 means any block of memory. | |
| 771 | 960 |
| 961 This does not register the block of memory itself; it may, for | |
| 962 example, be an array of structures inlined in another memory block | |
| 2367 | 963 and thus should not be registered. See pdump_register_block(), |
| 771 | 964 which does register the memory block. */ |
| 965 | |
| 966 static void | |
| 2367 | 967 pdump_register_block_contents (const void *data, |
| 968 Bytecount size, | |
| 969 const struct memory_description *desc, | |
| 970 int count) | |
| 771 | 971 { |
| 972 int i; | |
| 973 Bytecount elsize; | |
| 974 | |
| 1204 | 975 pdump_bump_depth (); |
| 2367 | 976 elsize = lispdesc_block_size_1 (data, size, desc); |
| 771 | 977 for (i = 0; i < count; i++) |
| 978 { | |
| 2367 | 979 pdump_register_sub (((Rawbyte *) data) + elsize * i, desc); |
| 771 | 980 } |
| 1204 | 981 --pdump_depth; |
| 771 | 982 } |
| 983 | |
| 2367 | 984 /* Register the array of COUNT blocks located at DATA; each block is |
| 985 described by SDESC. "Block" here simply means any block of memory, | |
| 986 which is more accurate and less confusing than terms like `struct' and | |
| 987 `object'. A `block' need not actually be a C "struct". It could be a | |
| 988 single integer or Lisp_Object, for example, as long as the description | |
| 989 is accurate. | |
| 771 | 990 |
| 2367 | 991 This is like pdump_register_block_contents() but also registers |
| 771 | 992 the memory block itself. */ |
| 993 | |
| 442 | 994 static void |
| 2367 | 995 pdump_register_block (const void *data, |
| 996 Bytecount size, | |
| 997 const struct memory_description *desc, | |
| 998 int count) | |
| 442 | 999 { |
| 2367 | 1000 if (data && !pdump_get_block (data)) |
| 442 | 1001 { |
| 2367 | 1002 pdump_add_block (pdump_get_block_list (desc), data, |
| 1003 lispdesc_block_size_1 (data, size, desc), count); | |
| 1004 pdump_register_block_contents (data, size, desc, count); | |
| 442 | 1005 } |
| 1006 } | |
| 1007 | |
| 2551 | 1008 |
| 1204 | 1009 /* Store the already-calculated new pointer offsets for all pointers in the |
| 1010 COUNT contiguous blocks of memory, each described by DESC and of size | |
| 1011 SIZE, whose original is located at ORIG_DATA and the modifiable copy at | |
| 1012 DATA. We examine the description to figure out where the pointers are, | |
| 2367 | 1013 and then look up the replacement values using pdump_get_block(). |
| 771 | 1014 |
| 1204 | 1015 This is done just before writing the modified block of memory to the |
| 1016 dump file. The new pointer offsets have been carefully calculated so | |
| 1017 that the data being pointed gets written at that offset in the dump | |
| 1018 file. That way, the dump file is a correct memory image except perhaps | |
| 1019 for a constant that needs to be added to all pointers. (#### In fact, we | |
| 1020 SHOULD be starting up a dumped XEmacs, seeing where the dumped file gets | |
| 1021 loaded into memory, and then rewriting the dumped file after relocating | |
| 1022 all the pointers relative to this memory location. That way, if the | |
| 1023 file gets loaded again at the same location, which will be common, we | |
| 1024 don't have to do any relocating, which is both faster at startup and | |
| 771 | 1025 allows the read-only part of the dumped data to be shared read-only |
| 1026 between different invocations of XEmacs.) | |
| 1027 | |
| 1028 #### Do we distinguish between read-only and writable dumped data? | |
| 1029 Should we? It's tricky because the dumped data, once loaded again, | |
| 1204 | 1030 cannot really be free()d or garbage collected since it's all stored in |
| 1031 one contiguous block of data with no malloc() headers, and we don't keep | |
| 1032 track of the pointers used internally in malloc() and the Lisp allocator | |
| 1033 to track allocated blocks of memory. */ | |
| 771 | 1034 |
| 1035 static void | |
| 1036 pdump_store_new_pointer_offsets (int count, void *data, const void *orig_data, | |
| 1204 | 1037 const struct memory_description *desc, |
| 771 | 1038 int size) |
| 1039 { | |
| 1040 int pos, i; | |
| 1041 /* Process each block one by one */ | |
| 1042 for (i = 0; i < count; i++) | |
| 1043 { | |
| 1044 /* CUR points to the beginning of each block in the new data. */ | |
| 2367 | 1045 Rawbyte *cur = ((Rawbyte *)data) + i * size; |
| 771 | 1046 /* Scan each line of the description for relocatable pointers */ |
| 1047 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 1048 { | |
| 1049 /* RDATA points to the beginning of each element in the new data. */ | |
| 1204 | 1050 const struct memory_description *desc1 = &desc[pos]; |
| 1051 /* #### Change ORIG_DATA to DATA. See below. */ | |
| 1052 void *rdata = cur + lispdesc_indirect_count (desc1->offset, desc, | |
| 1053 orig_data); | |
| 1054 union_switcheroo: | |
| 1055 | |
| 1056 /* If the flag says don't dump, then don't dump. */ | |
| 1057 if ((desc1->flags) & XD_FLAG_NO_PDUMP) | |
| 1058 continue; | |
| 1059 | |
| 1060 switch (desc1->type) | |
| 771 | 1061 { |
| 1062 case XD_BYTECOUNT: | |
| 1063 case XD_ELEMCOUNT: | |
| 1064 case XD_HASHCODE: | |
| 1065 case XD_INT: | |
| 1066 case XD_LONG: | |
| 1067 break; | |
| 1068 case XD_INT_RESET: | |
| 1069 { | |
| 1204 | 1070 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, |
| 1071 orig_data); | |
| 771 | 1072 * (int *) rdata = val; |
| 1073 break; | |
| 1074 } | |
| 3092 | 1075 #ifdef NEW_GC |
| 1076 case XD_LISP_OBJECT_BLOCK_PTR: | |
| 1077 #endif /* NEW_GC */ | |
| 771 | 1078 case XD_OPAQUE_DATA_PTR: |
| 2367 | 1079 case XD_ASCII_STRING: |
| 1080 case XD_BLOCK_PTR: | |
| 771 | 1081 { |
| 1082 void *ptr = * (void **) rdata; | |
| 1083 if (ptr) | |
| 2367 | 1084 * (EMACS_INT *) rdata = pdump_get_block (ptr)->save_offset; |
| 771 | 1085 break; |
| 1086 } | |
| 1087 case XD_LO_LINK: | |
| 1088 { | |
| 1089 /* As described in lrecord.h, this is a weak link. | |
| 1090 Thus, we need to link this object not (necessarily) | |
| 1091 to the object directly pointed to, but to the next | |
| 1092 referenced object in the chain. None of the | |
| 1093 intermediate objects will be written out, so we | |
| 1094 traverse down the chain of objects until we find a | |
| 1095 referenced one. (The Qnil or Qunbound that ends the | |
| 1096 chain will always be a referenced object.) */ | |
| 1097 Lisp_Object obj = * (Lisp_Object *) rdata; | |
| 2367 | 1098 pdump_block_list_elt *elt1; |
| 1204 | 1099 /* #### Figure out how to handle indirect offsets here. |
| 1100 #### In general, when computing indirect counts, do we | |
| 1101 really need to use the orig_data pointer? Why not just | |
| 1102 use the new stuff? | |
| 1103 | |
| 1104 No, we don't usually need orig_data. We only need it | |
| 1105 when fetching pointers out of the data, not integers. | |
| 1106 This currently occurs only with description maps. We | |
| 1107 should change the other places to DATA to emphasize | |
| 1108 this. */ | |
| 1109 assert (!XD_IS_INDIRECT (desc1->offset)); | |
| 771 | 1110 for (;;) |
| 1111 { | |
| 2367 | 1112 elt1 = pdump_get_block (XRECORD_LHEADER (obj)); |
| 771 | 1113 if (elt1) |
| 1114 break; | |
| 1204 | 1115 obj = * (Lisp_Object *) (desc1->offset + |
| 2367 | 1116 (Rawbyte *) |
| 1117 (XRECORD_LHEADER (obj))); | |
| 771 | 1118 } |
| 1119 * (EMACS_INT *) rdata = elt1->save_offset; | |
| 1120 break; | |
| 1121 } | |
| 1122 case XD_LISP_OBJECT: | |
| 1123 { | |
| 1124 Lisp_Object *pobj = (Lisp_Object *) rdata; | |
| 1125 | |
| 1204 | 1126 assert (desc1->data1 == 0); |
| 771 | 1127 |
| 1128 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) | |
| 1129 * (EMACS_INT *) pobj = | |
| 2367 | 1130 pdump_get_block (XRECORD_LHEADER (*pobj))->save_offset; |
| 771 | 1131 break; |
| 1132 } | |
| 1133 case XD_LISP_OBJECT_ARRAY: | |
| 1134 { | |
| 1204 | 1135 EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, |
| 1136 orig_data); | |
| 771 | 1137 int j; |
| 1138 | |
| 1139 for (j = 0; j < num; j++) | |
| 1140 { | |
| 1141 Lisp_Object *pobj = ((Lisp_Object *) rdata) + j; | |
| 1142 if (POINTER_TYPE_P (XTYPE (*pobj)) && | |
| 1143 XRECORD_LHEADER (*pobj)) | |
| 1144 * (EMACS_INT *) pobj = | |
| 2367 | 1145 pdump_get_block (XRECORD_LHEADER (*pobj))->save_offset; |
| 771 | 1146 } |
| 1147 break; | |
| 1148 } | |
| 1149 case XD_DOC_STRING: | |
| 1150 { | |
| 1151 EMACS_INT str = *(EMACS_INT *)rdata; | |
| 1152 if (str > 0) | |
| 1153 * (EMACS_INT *) rdata = | |
| 2367 | 1154 pdump_get_block ((void *)str)->save_offset; |
| 771 | 1155 break; |
| 1156 } | |
| 2367 | 1157 case XD_BLOCK_ARRAY: |
| 771 | 1158 { |
| 1204 | 1159 EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, |
| 1160 orig_data); | |
| 1161 const struct sized_memory_description *sdesc = | |
| 2551 | 1162 lispdesc_indirect_description (orig_data, desc1->data2.descr); |
| 771 | 1163 |
| 1164 pdump_store_new_pointer_offsets | |
| 1165 (num, rdata, | |
| 2367 | 1166 ((Rawbyte *) rdata - (Rawbyte *) data) + |
| 1167 (Rawbyte *) orig_data, | |
| 1204 | 1168 sdesc->description, |
| 2367 | 1169 lispdesc_block_size |
| 1170 (((Rawbyte *) rdata - (Rawbyte *) data) + | |
| 1171 (Rawbyte *) orig_data, sdesc)); | |
| 771 | 1172 break; |
| 1173 } | |
| 1174 case XD_UNION: | |
| 1204 | 1175 case XD_UNION_DYNAMIC_SIZE: |
| 1176 desc1 = lispdesc_process_xd_union (desc1, desc, orig_data); | |
| 1177 if (desc1) | |
| 1178 goto union_switcheroo; | |
| 1179 break; | |
| 771 | 1180 |
| 2551 | 1181 case XD_OPAQUE_PTR_CONVERTIBLE: |
| 1182 *(EMACS_INT *)rdata = pdump_find_in_cv_ptr_dynarr (*(void **)rdata)->index; | |
| 1183 break; | |
| 1184 | |
| 1185 case XD_OPAQUE_DATA_CONVERTIBLE: | |
| 1186 /* in-object, nothing to do */ | |
| 1187 break; | |
| 1188 | |
| 771 | 1189 default: |
| 1333 | 1190 pdump_unsupported_dump_type (desc1->type, 0); |
| 771 | 1191 } |
| 1192 } | |
| 1193 } | |
| 1194 } | |
| 1195 | |
| 1196 /* Write out to global file descriptor PDUMP_OUT the element (one or | |
| 1197 more contiguous blocks of identical size/description) recorded in | |
| 1198 ELT and described by DESC. The element is first copied to a buffer | |
| 1199 and then all pointers (this includes Lisp_Objects other than | |
| 1200 integer/character) are relocated to the (pre-computed) offset in | |
| 1201 the dump file. */ | |
| 1202 | |
| 442 | 1203 static void |
| 2367 | 1204 pdump_dump_data (pdump_block_list_elt *elt, |
| 1204 | 1205 const struct memory_description *desc) |
| 442 | 1206 { |
| 665 | 1207 Bytecount size = elt->size; |
| 460 | 1208 int count = elt->count; |
| 442 | 1209 if (desc) |
| 1210 { | |
| 771 | 1211 /* Copy to temporary buffer */ |
| 460 | 1212 memcpy (pdump_buf, elt->obj, size*count); |
| 442 | 1213 |
| 771 | 1214 /* Store new offsets into all pointers in block */ |
| 1215 pdump_store_new_pointer_offsets (count, pdump_buf, elt->obj, desc, size); | |
| 1216 } | |
| 1217 retry_fwrite (desc ? pdump_buf : elt->obj, size, count, pdump_out); | |
| 1218 } | |
| 442 | 1219 |
| 3263 | 1220 #ifdef NEW_GC |
| 2720 | 1221 /* To be able to relocate during load time, more information about the |
| 1222 dumped objects are needed: The count (for array-like data | |
| 1223 structures), the size of the object, and the location in the dumped | |
| 1224 data. | |
| 1225 */ | |
| 1226 static void | |
| 1227 pdump_dump_mc_data (pdump_block_list_elt *elt, | |
| 1228 const struct memory_description *UNUSED(desc)) | |
| 1229 { | |
| 1230 EMACS_INT rdata = pdump_get_block (elt->obj)->save_offset; | |
| 1231 int j; | |
| 1232 PDUMP_WRITE_ALIGNED (int, elt->count); | |
| 1233 PDUMP_WRITE_ALIGNED (Bytecount, elt->size); | |
| 1234 for (j = 0; j < elt->count; j++) | |
| 1235 { | |
| 1236 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); | |
| 1237 rdata += elt->size; | |
| 1238 } | |
| 1239 } | |
| 1240 | |
| 1241 static void | |
| 1242 pdump_scan_lisp_objects_by_alignment (void (*f) | |
| 1243 (pdump_block_list_elt *, | |
| 1244 const struct memory_description *)) | |
| 1245 { | |
| 1246 int align; | |
| 1247 | |
| 1248 for (align = ALIGNOF (max_align_t); align; align>>=1) | |
| 1249 { | |
| 1250 int i; | |
| 1251 pdump_block_list_elt *elt; | |
| 1252 | |
| 1253 for (i=0; i<lrecord_type_count; i++) | |
| 1254 if (pdump_object_table[i].align == align) | |
| 1255 for (elt = pdump_object_table[i].first; elt; elt = elt->next) | |
| 1256 { | |
| 1257 f (elt, lrecord_implementations_table[i]->description); | |
| 1258 } | |
| 1259 } | |
| 1260 } | |
| 1261 | |
| 1262 static void | |
| 1263 pdump_scan_non_lisp_objects_by_alignment (void (*f) | |
| 1264 (pdump_block_list_elt *, | |
| 1265 const struct memory_description *)) | |
| 1266 { | |
| 1267 int align; | |
| 1268 | |
| 1269 for (align = ALIGNOF (max_align_t); align; align>>=1) | |
| 1270 { | |
| 1271 int i; | |
| 1272 pdump_block_list_elt *elt; | |
| 1273 | |
| 1274 for (i=0; i<pdump_desc_table.count; i++) | |
| 1275 { | |
| 1276 pdump_desc_list_elt list = pdump_desc_table.list[i]; | |
| 1277 if (list.list.align == align) | |
| 1278 for (elt = list.list.first; elt; elt = elt->next) | |
| 1279 f (elt, list.desc); | |
| 1280 } | |
| 1281 | |
| 1282 for (elt = pdump_opaque_data_list.first; elt; elt = elt->next) | |
| 1283 if (pdump_size_to_align (elt->size) == align) | |
| 1284 f (elt, 0); | |
| 1285 } | |
| 1286 } | |
| 1287 | |
| 1288 | |
| 1289 | |
| 1290 static void | |
| 1291 pdump_reloc_one_mc (void *data, const struct memory_description *desc) | |
| 1292 { | |
| 1293 int pos; | |
| 1294 | |
| 1295 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 1296 { | |
| 1297 const struct memory_description *desc1 = &desc[pos]; | |
| 1298 void *rdata = | |
| 1299 (Rawbyte *) data + lispdesc_indirect_count (desc1->offset, | |
| 1300 desc, data); | |
| 1301 | |
| 1302 union_switcheroo: | |
| 1303 | |
| 1304 /* If the flag says don't dump, then don't dump. */ | |
| 1305 if ((desc1->flags) & XD_FLAG_NO_PDUMP) | |
| 1306 continue; | |
| 1307 | |
| 1308 switch (desc1->type) | |
| 1309 { | |
| 1310 case XD_BYTECOUNT: | |
| 1311 case XD_ELEMCOUNT: | |
| 1312 case XD_HASHCODE: | |
| 1313 case XD_INT: | |
| 1314 case XD_LONG: | |
| 1315 case XD_INT_RESET: | |
| 1316 break; | |
| 3092 | 1317 case XD_LISP_OBJECT_BLOCK_PTR: |
| 2720 | 1318 case XD_OPAQUE_DATA_PTR: |
| 1319 case XD_ASCII_STRING: | |
| 1320 case XD_BLOCK_PTR: | |
| 1321 case XD_LO_LINK: | |
| 1322 { | |
| 1323 EMACS_INT ptr = *(EMACS_INT *) rdata; | |
| 1324 if (ptr) | |
| 1325 *(EMACS_INT *) rdata = pdump_get_mc_addr ((void *) ptr); | |
| 1326 break; | |
| 1327 } | |
| 1328 case XD_LISP_OBJECT: | |
| 1329 { | |
| 1330 Lisp_Object *pobj = (Lisp_Object *) rdata; | |
| 1331 | |
| 1332 assert (desc1->data1 == 0); | |
| 1333 | |
| 1334 if (POINTER_TYPE_P (XTYPE (*pobj)) | |
| 1335 && ! EQ (*pobj, Qnull_pointer)) | |
| 3092 | 1336 *pobj = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr |
| 2720 | 1337 (XPNTR (*pobj))); |
| 1338 break; | |
| 1339 } | |
| 1340 case XD_LISP_OBJECT_ARRAY: | |
| 1341 { | |
| 1342 EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, | |
| 1343 data); | |
| 1344 int j; | |
| 1345 | |
| 1346 for (j=0; j<num; j++) | |
| 1347 { | |
| 1348 Lisp_Object *pobj = (Lisp_Object *) rdata + j; | |
| 1349 | |
| 1350 if (POINTER_TYPE_P (XTYPE (*pobj)) | |
| 1351 && ! EQ (*pobj, Qnull_pointer)) | |
| 3092 | 1352 *pobj = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr |
| 2775 | 1353 (XPNTR (*pobj))); |
| 2720 | 1354 } |
| 1355 break; | |
| 1356 } | |
| 1357 case XD_DOC_STRING: | |
| 1358 { | |
| 1359 EMACS_INT str = *(EMACS_INT *) rdata; | |
| 1360 if (str > 0) | |
| 1361 *(EMACS_INT *) rdata = pdump_get_mc_addr ((void *) str); | |
| 1362 break; | |
| 1363 } | |
| 1364 case XD_BLOCK_ARRAY: | |
| 1365 { | |
| 1366 EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, | |
| 1367 data); | |
| 1368 int j; | |
| 1369 const struct sized_memory_description *sdesc = | |
| 1370 lispdesc_indirect_description (data, desc1->data2.descr); | |
| 1371 Bytecount size = lispdesc_block_size (rdata, sdesc); | |
| 1372 | |
| 1373 /* Note: We are recursing over data in the block itself */ | |
| 1374 for (j = 0; j < num; j++) | |
| 1375 pdump_reloc_one_mc ((Rawbyte *) rdata + j * size, | |
| 1376 sdesc->description); | |
| 1377 | |
| 1378 break; | |
| 1379 } | |
| 1380 case XD_UNION: | |
| 1381 case XD_UNION_DYNAMIC_SIZE: | |
| 1382 desc1 = lispdesc_process_xd_union (desc1, desc, data); | |
| 1383 if (desc1) | |
| 1384 goto union_switcheroo; | |
| 1385 break; | |
| 1386 | |
| 1387 case XD_OPAQUE_PTR_CONVERTIBLE: | |
| 1388 { | |
| 1389 pdump_cv_ptr_load_info *p = pdump_loaded_cv_ptr + *(EMACS_INT *)rdata; | |
| 1390 if (!p->adr) | |
| 1391 p->adr = desc1->data2.funcs->deconvert(0, | |
| 1392 pdump_start + p->save_offset, | |
| 1393 p->size); | |
| 1394 *(void **)rdata = p->adr; | |
| 1395 break; | |
| 1396 } | |
| 1397 | |
| 1398 case XD_OPAQUE_DATA_CONVERTIBLE: | |
| 1399 { | |
| 1400 EMACS_INT dest_offset = (EMACS_INT) rdata; | |
| 1401 EMACS_INT indirect = | |
| 1402 lispdesc_indirect_count (desc1->offset, desc, data); | |
| 1403 pdump_cv_data_dump_info *p; | |
| 1404 | |
| 1405 for(p = pdump_loaded_cv_data; | |
| 1406 pdump_get_indirect_mc_addr (p->dest_offset, indirect) | |
| 1407 != dest_offset; | |
| 1408 p++); | |
| 1409 | |
| 1410 desc1->data2.funcs->deconvert(rdata, pdump_start + p->save_offset, | |
| 1411 p->size); | |
| 1412 break; | |
| 1413 } | |
| 1414 | |
| 1415 default: | |
| 1416 pdump_unsupported_dump_type (desc1->type, 0); | |
| 1417 } | |
| 1418 } | |
| 1419 } | |
| 3263 | 1420 #else /* not NEW_GC */ |
| 771 | 1421 /* Relocate a single memory block at DATA, described by DESC, from its |
| 1204 | 1422 assumed load location to its actual one by adding DELTA to all pointers |
| 1423 in the block. Does not recursively relocate any other memory blocks | |
| 1424 pointed to. (We already have a list of all memory blocks in the dump | |
| 1425 file.) This is used once the dump data has been loaded back in, both | |
| 2367 | 1426 for blocks sitting in the dumped data (former heap blocks) and in global |
| 1427 data-sgment blocks whose contents have been restored from the dumped | |
| 1428 data. */ | |
| 442 | 1429 |
| 1430 static void | |
| 458 | 1431 pdump_reloc_one (void *data, EMACS_INT delta, |
| 1204 | 1432 const struct memory_description *desc) |
| 442 | 1433 { |
| 1434 int pos; | |
| 1435 | |
| 1436 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 1437 { | |
| 1204 | 1438 const struct memory_description *desc1 = &desc[pos]; |
| 2367 | 1439 void *rdata = |
| 1440 (Rawbyte *) data + lispdesc_indirect_count (desc1->offset, | |
| 1441 desc, data); | |
| 1204 | 1442 |
| 1443 union_switcheroo: | |
| 1444 | |
| 1445 /* If the flag says don't dump, then don't dump. */ | |
| 1446 if ((desc1->flags) & XD_FLAG_NO_PDUMP) | |
| 1447 continue; | |
| 1448 | |
| 1449 switch (desc1->type) | |
| 442 | 1450 { |
| 665 | 1451 case XD_BYTECOUNT: |
| 1452 case XD_ELEMCOUNT: | |
| 1453 case XD_HASHCODE: | |
| 442 | 1454 case XD_INT: |
| 1455 case XD_LONG: | |
| 1456 case XD_INT_RESET: | |
| 1457 break; | |
| 1458 case XD_OPAQUE_DATA_PTR: | |
| 2367 | 1459 case XD_ASCII_STRING: |
| 1460 case XD_BLOCK_PTR: | |
| 442 | 1461 case XD_LO_LINK: |
| 1462 { | |
| 1463 EMACS_INT ptr = *(EMACS_INT *)rdata; | |
| 1464 if (ptr) | |
| 1465 *(EMACS_INT *)rdata = ptr+delta; | |
| 1466 break; | |
| 1467 } | |
| 1468 case XD_LISP_OBJECT: | |
| 1469 { | |
| 1470 Lisp_Object *pobj = (Lisp_Object *) rdata; | |
| 1471 | |
| 1204 | 1472 assert (desc1->data1 == 0); |
| 442 | 1473 |
| 1474 if (POINTER_TYPE_P (XTYPE (*pobj)) | |
| 1475 && ! EQ (*pobj, Qnull_pointer)) | |
| 2367 | 1476 *pobj = wrap_pointer_1 ((Rawbyte *) XPNTR (*pobj) + delta); |
| 442 | 1477 |
| 1478 break; | |
| 1479 } | |
| 1480 case XD_LISP_OBJECT_ARRAY: | |
| 1481 { | |
| 1204 | 1482 EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, |
| 1483 data); | |
| 442 | 1484 int j; |
| 1485 | |
| 1486 for (j=0; j<num; j++) | |
| 1487 { | |
| 1488 Lisp_Object *pobj = (Lisp_Object *) rdata + j; | |
| 1489 | |
| 1490 if (POINTER_TYPE_P (XTYPE (*pobj)) | |
| 1491 && ! EQ (*pobj, Qnull_pointer)) | |
| 2367 | 1492 *pobj = wrap_pointer_1 ((Rawbyte *) XPNTR (*pobj) + |
| 1493 delta); | |
| 442 | 1494 } |
| 1495 break; | |
| 1496 } | |
| 1497 case XD_DOC_STRING: | |
| 1498 { | |
| 1499 EMACS_INT str = *(EMACS_INT *)rdata; | |
| 1500 if (str > 0) | |
| 1501 *(EMACS_INT *)rdata = str + delta; | |
| 1502 break; | |
| 1503 } | |
| 2367 | 1504 case XD_BLOCK_ARRAY: |
| 771 | 1505 { |
| 1204 | 1506 EMACS_INT num = lispdesc_indirect_count (desc1->data1, desc, |
| 1507 data); | |
| 771 | 1508 int j; |
| 1204 | 1509 const struct sized_memory_description *sdesc = |
| 2551 | 1510 lispdesc_indirect_description (data, desc1->data2.descr); |
| 2367 | 1511 Bytecount size = lispdesc_block_size (rdata, sdesc); |
| 771 | 1512 |
| 1513 /* Note: We are recursing over data in the block itself */ | |
| 1514 for (j = 0; j < num; j++) | |
| 2367 | 1515 pdump_reloc_one ((Rawbyte *) rdata + j * size, delta, |
| 771 | 1516 sdesc->description); |
| 1517 | |
| 1518 break; | |
| 1519 } | |
| 1204 | 1520 case XD_UNION: |
| 1521 case XD_UNION_DYNAMIC_SIZE: | |
| 1522 desc1 = lispdesc_process_xd_union (desc1, desc, data); | |
| 1523 if (desc1) | |
| 1524 goto union_switcheroo; | |
| 1525 break; | |
| 771 | 1526 |
| 2551 | 1527 case XD_OPAQUE_PTR_CONVERTIBLE: |
| 1528 { | |
| 1529 pdump_cv_ptr_load_info *p = pdump_loaded_cv_ptr + *(EMACS_INT *)rdata; | |
| 1530 if (!p->adr) | |
| 1531 p->adr = desc1->data2.funcs->deconvert(0, pdump_start + | |
| 1532 p->save_offset, p->size); | |
| 1533 *(void **)rdata = p->adr; | |
| 1534 break; | |
| 1535 } | |
| 1536 | |
| 1537 case XD_OPAQUE_DATA_CONVERTIBLE: | |
| 1538 { | |
| 1539 EMACS_INT dest_offset = (Rawbyte *)rdata - pdump_start; | |
| 1540 pdump_cv_data_dump_info *p; | |
| 1541 | |
| 1542 for(p = pdump_loaded_cv_data; p->dest_offset != dest_offset; p++); | |
| 1543 | |
| 1544 desc1->data2.funcs->deconvert(rdata, pdump_start + p->save_offset, | |
| 1545 p->size); | |
| 1546 break; | |
| 1547 } | |
| 1548 | |
| 442 | 1549 default: |
| 1333 | 1550 pdump_unsupported_dump_type (desc1->type, 0); |
| 1204 | 1551 } |
| 442 | 1552 } |
| 1553 } | |
| 3263 | 1554 #endif /* not NEW_GC */ |
| 442 | 1555 |
| 1556 static void | |
| 2367 | 1557 pdump_allocate_offset (pdump_block_list_elt *elt, |
| 2286 | 1558 const struct memory_description *UNUSED (desc)) |
| 442 | 1559 { |
| 665 | 1560 Bytecount size = elt->count * elt->size; |
| 460 | 1561 elt->save_offset = cur_offset; |
| 2367 | 1562 if (size > max_size) |
| 442 | 1563 max_size = size; |
| 1564 cur_offset += size; | |
| 1565 } | |
| 1566 | |
| 2551 | 1567 /* Write out to global file descriptor PDUMP_OUT the result of an |
| 1568 external element. It's just opaque data. */ | |
| 1569 | |
| 1570 static void | |
| 1571 pdump_dump_cv_data (pdump_cv_data_info *elt) | |
| 1572 { | |
| 1573 retry_fwrite (elt->data, elt->size, 1, pdump_out); | |
| 1574 } | |
| 1575 | |
| 1576 static void | |
| 1577 pdump_dump_cv_ptr (pdump_cv_ptr_info *elt) | |
| 1578 { | |
| 1579 retry_fwrite (elt->data, elt->size, 1, pdump_out); | |
| 1580 } | |
| 1581 | |
| 1582 static void | |
| 1583 pdump_allocate_offset_cv_data (pdump_cv_data_info *elt) | |
| 1584 { | |
| 1585 elt->save_offset = cur_offset; | |
| 1586 if (elt->size>max_size) | |
| 1587 max_size = elt->size; | |
| 1588 cur_offset += elt->size; | |
| 1589 } | |
| 1590 | |
| 1591 static void | |
| 1592 pdump_allocate_offset_cv_ptr (pdump_cv_ptr_info *elt) | |
| 1593 { | |
| 1594 elt->save_offset = cur_offset; | |
| 1595 if (elt->size>max_size) | |
| 1596 max_size = elt->size; | |
| 1597 cur_offset += elt->size; | |
| 1598 } | |
| 1599 | |
| 2367 | 1600 /* Traverse through all the heap blocks, once the "register" stage of |
| 1601 dumping has finished. To compress space as much as possible, we | |
| 1602 logically sort all blocks by alignment, hitting all blocks with | |
| 1603 alignment == the maximum (which may be 8 bytes, for doubles), then | |
| 1604 all blocks with the next lower alignment (4 bytes), etc. | |
| 1605 | |
| 1606 Within each alignment we hit | |
| 1607 | |
| 1608 -- first the Lisp objects, type-by-type | |
| 1609 | |
| 1610 -- then the heap memory blocks that are not Lisp objects, description-by- | |
| 1611 description -- i.e. all blocks with the same description will be | |
| 1612 placed together | |
| 1613 | |
| 1614 -- then the "opaque" data objects declared as XD_OPAQUE_DATA_PTR, | |
| 1615 XD_ASCII_STRING and XD_DOC_STRING. | |
| 1616 | |
| 1617 The idea is to have as little blank space as possible in the laid-out | |
| 1618 data. | |
| 1619 | |
| 1620 For each item that we have hit, we process it by calling F, the function | |
| 1621 passed it. In dumper.c, pdump_scan_by_alignment() is called twice with | |
| 1622 two different functions -- pdump_allocate_offset() in stage 2 to compute | |
| 1623 the offset to each block, and pdump_dump_data() in stage 3 to | |
| 1624 successively write each block to disk. | |
| 1625 | |
| 1626 It's extremely important that the SAME traversal order gets invoked | |
| 1627 in both stage 2 and 3. | |
| 1628 */ | |
| 1629 | |
| 442 | 1630 static void |
| 2367 | 1631 pdump_scan_by_alignment (void (*f)(pdump_block_list_elt *, |
| 2551 | 1632 const struct memory_description *), |
| 1633 void (*g)(pdump_cv_data_info *), | |
| 1634 void (*h)(pdump_cv_ptr_info *)) | |
| 442 | 1635 { |
| 460 | 1636 int align; |
| 1637 | |
| 1638 for (align = ALIGNOF (max_align_t); align; align>>=1) | |
| 442 | 1639 { |
| 460 | 1640 int i; |
| 2367 | 1641 pdump_block_list_elt *elt; |
| 460 | 1642 |
| 442 | 1643 for (i=0; i<lrecord_type_count; i++) |
| 1644 if (pdump_object_table[i].align == align) | |
| 460 | 1645 for (elt = pdump_object_table[i].first; elt; elt = elt->next) |
| 1646 f (elt, lrecord_implementations_table[i]->description); | |
| 442 | 1647 |
| 2367 | 1648 for (i=0; i<pdump_desc_table.count; i++) |
| 460 | 1649 { |
| 2367 | 1650 pdump_desc_list_elt list = pdump_desc_table.list[i]; |
| 460 | 1651 if (list.list.align == align) |
| 1652 for (elt = list.list.first; elt; elt = elt->next) | |
| 1204 | 1653 f (elt, list.desc); |
| 460 | 1654 } |
| 442 | 1655 |
| 460 | 1656 for (elt = pdump_opaque_data_list.first; elt; elt = elt->next) |
| 1657 if (pdump_size_to_align (elt->size) == align) | |
| 1658 f (elt, 0); | |
| 2551 | 1659 |
| 1660 for (i=0; i < Dynarr_length (pdump_cv_data); i++) | |
| 1661 if (pdump_size_to_align (Dynarr_atp (pdump_cv_data, i)->size) == align) | |
| 1662 g (Dynarr_atp (pdump_cv_data, i)); | |
| 1663 | |
| 1664 for (i=0; i < Dynarr_length (pdump_cv_ptr); i++) | |
| 1665 if (pdump_size_to_align (Dynarr_atp (pdump_cv_ptr, i)->size) == align) | |
| 1666 h (Dynarr_atp (pdump_cv_ptr, i)); | |
| 442 | 1667 } |
| 1668 } | |
| 1669 | |
| 2551 | 1670 static void |
| 1671 pdump_dump_cv_data_info (void) | |
| 1672 { | |
| 1673 int i; | |
| 1674 Elemcount count = Dynarr_length (pdump_cv_data); | |
| 1675 pdump_cv_data_dump_info *data = alloca_array (pdump_cv_data_dump_info, count); | |
| 1676 for (i = 0; i < count; i++) | |
| 1677 { | |
| 1678 data[i].dest_offset = Dynarr_at (pdump_cv_data, i).dest_offset; | |
| 1679 data[i].save_offset = Dynarr_at (pdump_cv_data, i).save_offset; | |
| 1680 data[i].size = Dynarr_at (pdump_cv_data, i).size; | |
| 1681 } | |
| 1682 | |
| 1683 PDUMP_ALIGN_OUTPUT (pdump_cv_data_dump_info); | |
| 1684 retry_fwrite (data, sizeof (pdump_cv_data_dump_info), count, pdump_out); | |
| 1685 } | |
| 1686 | |
| 442 | 1687 static void |
| 2551 | 1688 pdump_dump_cv_ptr_info (void) |
| 1689 { | |
| 1690 int i; | |
| 1691 Elemcount count = Dynarr_length (pdump_cv_ptr); | |
| 1692 pdump_cv_ptr_dump_info *data = alloca_array (pdump_cv_ptr_dump_info, count); | |
| 1693 for (i = 0; i < count; i++) | |
| 1694 { | |
| 1695 data[i].save_offset = Dynarr_at (pdump_cv_ptr, i).save_offset; | |
| 1696 data[i].size = Dynarr_at (pdump_cv_ptr, i).size; | |
| 1697 } | |
| 1698 | |
| 1699 PDUMP_ALIGN_OUTPUT (pdump_cv_ptr_dump_info); | |
| 1700 retry_fwrite (data, sizeof (pdump_cv_ptr_dump_info), count, pdump_out); | |
| 1701 } | |
| 1702 | |
| 3103 | 1703 /* Dump out the root block pointers, part of stage 3 (the "WRITE" stage) of |
| 1704 dumping. For each pointer we dump out a structure containing the | |
| 1705 location of the pointer and its value, replaced by the appropriate | |
| 1706 offset into the dumped data. */ | |
| 1707 | |
| 2551 | 1708 static void |
| 2367 | 1709 pdump_dump_root_block_ptrs (void) |
| 442 | 1710 { |
| 1711 int i; | |
| 2367 | 1712 Elemcount count = Dynarr_length (pdump_root_block_ptrs); |
| 458 | 1713 pdump_static_pointer *data = alloca_array (pdump_static_pointer, count); |
| 1714 for (i = 0; i < count; i++) | |
| 442 | 1715 { |
| 1333 | 1716 data[i].address = |
| 2367 | 1717 (Rawbyte **) Dynarr_atp (pdump_root_block_ptrs, i)->ptraddress; |
| 1333 | 1718 data[i].value = |
| 2367 | 1719 (Rawbyte *) pdump_get_block (* data[i].address)->save_offset; |
| 442 | 1720 } |
| 458 | 1721 PDUMP_ALIGN_OUTPUT (pdump_static_pointer); |
| 771 | 1722 retry_fwrite (data, sizeof (pdump_static_pointer), count, pdump_out); |
| 442 | 1723 } |
| 1724 | |
| 2367 | 1725 /* Dump out the root blocks, part of stage 3 (the "WRITE" stage) of |
| 1726 dumping. For each block we dump a structure containing info about the | |
| 1727 block (its location, size and description) and then the block itself, | |
| 1728 with its pointers replaced with offsets into the dump data. */ | |
| 1729 | |
| 442 | 1730 static void |
| 1204 | 1731 pdump_dump_root_blocks (void) |
| 442 | 1732 { |
| 1733 int i; | |
| 1204 | 1734 for (i = 0; i < Dynarr_length (pdump_root_blocks); i++) |
| 442 | 1735 { |
| 2367 | 1736 pdump_root_block info = Dynarr_at (pdump_root_blocks, i); |
| 1737 PDUMP_WRITE_ALIGNED (pdump_root_block, info); | |
| 1738 | |
| 1739 if (info.desc) | |
| 1740 { | |
| 1741 /* Copy to temporary buffer */ | |
| 1742 memcpy (pdump_buf, info.blockaddr, info.size); | |
| 1743 | |
| 1744 /* Store new offsets into all pointers in block */ | |
| 1745 pdump_store_new_pointer_offsets (1, pdump_buf, info.blockaddr, | |
| 1746 info.desc, info.size); | |
| 1747 } | |
| 1748 retry_fwrite (info.desc ? pdump_buf : info.blockaddr, | |
| 1749 info.size, 1, pdump_out); | |
| 442 | 1750 } |
| 1751 } | |
| 1752 | |
| 1753 static void | |
| 1754 pdump_dump_rtables (void) | |
| 1755 { | |
| 452 | 1756 int i; |
| 2367 | 1757 pdump_block_list_elt *elt; |
| 442 | 1758 pdump_reloc_table rt; |
| 1759 | |
| 1760 for (i=0; i<lrecord_type_count; i++) | |
| 1761 { | |
| 460 | 1762 elt = pdump_object_table[i].first; |
| 1763 if (!elt) | |
| 442 | 1764 continue; |
| 1765 rt.desc = lrecord_implementations_table[i]->description; | |
| 1766 rt.count = pdump_object_table[i].count; | |
| 458 | 1767 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt); |
| 460 | 1768 while (elt) |
| 442 | 1769 { |
| 2367 | 1770 EMACS_INT rdata = pdump_get_block (elt->obj)->save_offset; |
| 3092 | 1771 #ifdef NEW_GC |
| 1772 int j; | |
| 1773 for (j=0; j<elt->count; j++) | |
| 1774 { | |
| 1775 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); | |
| 1776 rdata += elt->size; | |
| 1777 } | |
| 1778 #else /* not NEW_GC */ | |
| 458 | 1779 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); |
| 3092 | 1780 #endif /* not NEW_GC */ |
| 460 | 1781 elt = elt->next; |
| 442 | 1782 } |
| 1783 } | |
| 1784 | |
| 1785 rt.desc = 0; | |
| 1786 rt.count = 0; | |
| 458 | 1787 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt); |
| 442 | 1788 |
| 2367 | 1789 for (i=0; i<pdump_desc_table.count; i++) |
| 442 | 1790 { |
| 2367 | 1791 elt = pdump_desc_table.list[i].list.first; |
| 1792 rt.desc = pdump_desc_table.list[i].desc; | |
| 1793 rt.count = pdump_desc_table.list[i].list.count; | |
| 458 | 1794 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt); |
| 460 | 1795 while (elt) |
| 442 | 1796 { |
| 2367 | 1797 EMACS_INT rdata = pdump_get_block (elt->obj)->save_offset; |
| 452 | 1798 int j; |
| 460 | 1799 for (j=0; j<elt->count; j++) |
| 442 | 1800 { |
| 458 | 1801 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); |
| 460 | 1802 rdata += elt->size; |
| 442 | 1803 } |
| 460 | 1804 elt = elt->next; |
| 442 | 1805 } |
| 1806 } | |
| 1807 rt.desc = 0; | |
| 1808 rt.count = 0; | |
| 458 | 1809 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt); |
| 442 | 1810 } |
| 1811 | |
| 1812 static void | |
| 1204 | 1813 pdump_dump_root_lisp_objects (void) |
| 442 | 1814 { |
| 1204 | 1815 Elemcount count = (Dynarr_length (pdump_root_lisp_objects) + |
| 647 | 1816 Dynarr_length (pdump_weak_object_chains)); |
| 665 | 1817 Elemcount i; |
| 442 | 1818 |
| 665 | 1819 PDUMP_WRITE_ALIGNED (Elemcount, count); |
| 458 | 1820 PDUMP_ALIGN_OUTPUT (pdump_static_Lisp_Object); |
| 442 | 1821 |
| 1204 | 1822 for (i = 0; i < Dynarr_length (pdump_root_lisp_objects); i++) |
| 442 | 1823 { |
| 458 | 1824 pdump_static_Lisp_Object obj; |
| 1204 | 1825 obj.address = Dynarr_at (pdump_root_lisp_objects, i); |
| 458 | 1826 obj.value = * obj.address; |
| 460 | 1827 |
| 458 | 1828 if (POINTER_TYPE_P (XTYPE (obj.value))) |
| 619 | 1829 obj.value = |
| 2367 | 1830 wrap_pointer_1 ((void *) pdump_get_block (XRECORD_LHEADER |
| 617 | 1831 (obj.value))->save_offset); |
| 460 | 1832 |
| 458 | 1833 PDUMP_WRITE (pdump_static_Lisp_Object, obj); |
| 442 | 1834 } |
| 1835 | |
| 2367 | 1836 for (i = 0; i < Dynarr_length (pdump_weak_object_chains); i++) |
| 442 | 1837 { |
| 2367 | 1838 pdump_block_list_elt *elt; |
| 458 | 1839 pdump_static_Lisp_Object obj; |
| 442 | 1840 |
| 458 | 1841 obj.address = Dynarr_at (pdump_weak_object_chains, i); |
| 1842 obj.value = * obj.address; | |
| 460 | 1843 |
| 442 | 1844 for (;;) |
| 1845 { | |
| 1204 | 1846 const struct memory_description *desc; |
| 442 | 1847 int pos; |
| 2367 | 1848 elt = pdump_get_block (XRECORD_LHEADER (obj.value)); |
| 460 | 1849 if (elt) |
| 442 | 1850 break; |
| 458 | 1851 desc = XRECORD_LHEADER_IMPLEMENTATION (obj.value)->description; |
| 442 | 1852 for (pos = 0; desc[pos].type != XD_LO_LINK; pos++) |
| 1853 assert (desc[pos].type != XD_END); | |
| 1854 | |
| 1204 | 1855 /* #### Figure out how to handle indirect offsets here. */ |
| 1856 assert (!XD_IS_INDIRECT (desc[pos].offset)); | |
| 1857 obj.value = | |
| 1858 * (Lisp_Object *) (desc[pos].offset + | |
| 2367 | 1859 (Rawbyte *) (XRECORD_LHEADER (obj.value))); |
| 442 | 1860 } |
| 619 | 1861 obj.value = wrap_pointer_1 ((void *) elt->save_offset); |
| 442 | 1862 |
| 458 | 1863 PDUMP_WRITE (pdump_static_Lisp_Object, obj); |
| 442 | 1864 } |
| 1865 } | |
| 1866 | |
| 2367 | 1867 |
| 1868 /*######################################################################## | |
| 1869 # Pdump # | |
| 1870 ######################################################################## | |
| 1871 | |
| 1872 [ben] | |
| 1873 | |
| 1874 DISCUSSION OF DUMPING: | |
| 1875 | |
| 1876 The idea of dumping is to record the state of XEmacs in a file, so that | |
| 1877 it can be reloaded later. This avoids having to reload all of the basic | |
| 1878 Lisp code each time XEmacs is run, which is a rather time-consuming | |
| 1879 process. (Less so on new machines, but still noticeable. As an example | |
| 1880 of a program with similar issues but which does not have a dumping | |
| 1881 process and as a result has a slow startup time, consider Adobe Photoshop | |
| 1882 5.0 or Adobe Photoshop Elements 2.0.) | |
| 1883 | |
| 1884 We don't actually record ALL the state of XEmacs (some of it, for example, | |
| 1885 is dependent on the run-time environment and needs to be initialized | |
| 1886 whenever XEmacs is run), but whatever state we don't record needs to be | |
| 1887 reinitialized every time XEmacs is run. | |
| 1888 | |
| 1889 The old way of dumping was to make a new executable file with the data | |
| 1890 segment expanded to contain the heap and written out from memory. This | |
| 1891 is what the unex* files do. Unfortunately this process is extremely | |
| 1892 system-specific and breaks easily with OS changes. | |
| 1893 | |
| 1894 Another simple, more portable trick, the "static heap" method, involves | |
| 1895 replacing the allocator with our own allocator which allocates all space | |
| 1896 out of a very large array declared in our data segment until we run out, | |
| 1897 then uses the underlying malloc() to start allocating on the heap. If we | |
| 1898 ensure that the large array is big enough to hold all data allocated | |
| 1899 during the dump stage, then all of the data we need to save is in the | |
| 1900 data segment, and it's easy to calculate the location and size of the | |
| 1901 data segment we want to save (we don't want to record and reinitialize | |
| 1902 the data segment of library functions) by using appropriately declared | |
| 1903 variables in the first and last file linked. This method is known as the | |
| 1904 "static heap" method, and is used by the non-pdump version of the dumper | |
| 1905 under Cygwin, and was also used under VMS and in Win-Emacs. | |
| 1906 | |
| 1907 The "static heap" method works well in practice. Nonetheless, a more | |
| 1908 complex method of dumping was written by Olivier Galibert, which requires | |
| 1909 that structural descriptions of all data allocated in the heap be provided | |
| 1910 and the roots of all pointers into the heap be noted through function calls | |
| 1911 to the pdump API. This way, all the heap data can be traversed and written | |
| 1912 out to a file, and then reloaded at run-time and the pointers relocated to | |
| 1913 point at the new location of the loaded data. This is the "pdump" method | |
| 1914 used in this file. | |
| 1915 | |
| 1916 There are two potential advantages of "pdump" over the "static heap": | |
| 1917 | |
| 1918 (1) It doesn't require any tricks to calculate the beginning and end of | |
| 1919 the data segment, or even that the XEmacs section of the data segment | |
| 1920 be contiguous. (It's not clear whether this is an issue in practice.) | |
| 1921 (2) Potentially, it could handle an OS that does not always load the | |
| 1922 static data segment at a predictable location. The "static heap" | |
| 1923 method by its nature needs the data segment to stay in the same place | |
| 1924 from invocation to invocation, since it simply dumps out memory and | |
| 1925 reloads it, without any pointer relocation. I say "potentially" | |
| 1926 because as it is currently written pdump does assume that the data | |
| 1927 segment is never relocated. However, changing pdump to remove this | |
| 1928 assumption is probably not difficult, as all the mechanism to handle | |
| 1929 pointer relocation is already present. | |
| 1930 | |
| 1931 | |
| 1932 DISCUSSION OF PDUMP WORKINGS: | |
| 1933 | |
| 1934 See man/internals/internals.texi for more information. | |
| 1935 | |
| 1936 NOTE that we have two kinds of memory to handle: memory on the heap | |
| 1937 (i.e. allocated through malloc()) or the like, and static memory in the | |
| 1938 data segment of the program, i.e. stuff declared as global or static. | |
| 1939 All heap memory needs to be written out to the dump file and reproduced | |
| 1940 (i.e. reloaded and any necessary relocations performed). Data-segment | |
| 1941 memory that is not statically initialized (i.e. through declarations in | |
| 1942 the C code) needs either to be written out and reloaded, or | |
| 1943 reinitialized. In addition, any pointers in data-segment memory to heap | |
| 1944 memory must be written out, reloaded and relocated. | |
| 1945 | |
| 1946 NOTE that we currently don't handle relocation of pointers into data- | |
| 1947 segment memory. (See overview discussion above.) These are treated in | |
| 1948 the descriptions as opaque data not needing relocation. If this becomes a | |
| 1949 problem, it can be fixed through new kinds of types in | |
| 1950 enum memory_description_type. | |
| 1951 | |
| 1952 Three basic steps to dumping out: | |
| 1953 | |
| 1954 (1) "REGISTER": | |
| 1955 Starting with all sources of relocatable memory (currently this means | |
| 1956 all data-segment pointers to heap memory -- see above about pointers | |
| 1957 to data-segment memory), recursively traverse the tree of pointers | |
| 1958 and "register" (make a note of) every memory block seen. | |
| 1959 | |
| 1960 (2) "LAYOUT": | |
| 1961 Go through all of the registered blocks and compute the location of | |
| 1962 each one in the dump data (i.e. the "offset" that will be added to | |
| 1963 the address corresponding to start of the loaded-in data to get the | |
| 1964 new pointer referring to this block). The blocks will be laid out | |
| 1965 sequentially according to the order we traverse them. Also note the | |
| 1966 maximum-sized block for use in step 3. | |
| 1967 | |
| 1968 (3) "WRITE": | |
| 1969 After writing some header stuff, go through all of the registered | |
| 1970 blocks and write out each one to the dump file. Note that we are | |
| 1971 simply writing out the blocks sequentially as we see them, and our | |
| 1972 traversal path is identical to that in step 2, so blocks will end up | |
| 1973 at the locations computed for them. In order to write out a block, | |
| 1974 first copy it to a temporary location (hence the maximum-block-size | |
| 1975 computation in the previous step), then for each relocatable pointer | |
| 1976 in the block, write in its place the offset to the heap block in the | |
| 1977 dump data. When the dump data is loaded, the address of the | |
| 1978 beginning of the dump data will be added to the offset in each | |
| 1979 pointer, and thence become accurate. | |
| 1980 | |
| 1981 --ben | |
| 1982 */ | |
| 1983 | |
| 442 | 1984 void |
| 1985 pdump (void) | |
| 1986 { | |
| 1987 int i; | |
| 1988 Lisp_Object t_console, t_device, t_frame; | |
| 1989 int none; | |
| 458 | 1990 pdump_header header; |
| 442 | 1991 |
| 1204 | 1992 in_pdump = 1; |
| 1993 | |
| 2367 | 1994 pdump_object_table = xnew_array (pdump_block_list, lrecord_type_count); |
| 460 | 1995 pdump_alert_undump_object = xnew_array (int, lrecord_type_count); |
| 1996 | |
| 1997 assert (ALIGNOF (max_align_t) <= pdump_align_table[0]); | |
| 1998 | |
| 1999 for (i = 0; i < countof (pdump_align_table); i++) | |
| 2000 if (pdump_align_table[i] > ALIGNOF (max_align_t)) | |
| 2001 pdump_align_table[i] = ALIGNOF (max_align_t); | |
| 2002 | |
| 446 | 2003 flush_all_buffer_local_cache (); |
| 2004 | |
| 442 | 2005 /* These appear in a DEFVAR_LISP, which does a staticpro() */ |
| 452 | 2006 t_console = Vterminal_console; Vterminal_console = Qnil; |
| 2007 t_frame = Vterminal_frame; Vterminal_frame = Qnil; | |
| 2008 t_device = Vterminal_device; Vterminal_device = Qnil; | |
| 442 | 2009 |
| 452 | 2010 dump_add_opaque (&lrecord_implementations_table, |
| 1204 | 2011 lrecord_type_count * |
| 2012 sizeof (lrecord_implementations_table[0])); | |
| 1676 | 2013 #ifdef USE_KKCC |
| 2014 dump_add_opaque (&lrecord_memory_descriptions, | |
| 2015 lrecord_type_count | |
| 2016 * sizeof (lrecord_memory_descriptions[0])); | |
| 2017 #else /* not USE_KKCC */ | |
| 452 | 2018 dump_add_opaque (&lrecord_markers, |
| 2019 lrecord_type_count * sizeof (lrecord_markers[0])); | |
| 1676 | 2020 #endif /* not USE_KKCC */ |
| 442 | 2021 |
| 2367 | 2022 pdump_hash = xnew_array_and_zero (pdump_block_list_elt *, PDUMP_HASHSIZE); |
| 442 | 2023 |
| 2367 | 2024 for (i = 0; i<lrecord_type_count; i++) |
| 442 | 2025 { |
| 2026 pdump_object_table[i].first = 0; | |
| 460 | 2027 pdump_object_table[i].align = ALIGNOF (max_align_t); |
| 442 | 2028 pdump_object_table[i].count = 0; |
| 2029 pdump_alert_undump_object[i] = 0; | |
| 2030 } | |
| 2367 | 2031 pdump_desc_table.count = 0; |
| 2032 pdump_desc_table.size = -1; | |
| 442 | 2033 |
| 2034 pdump_opaque_data_list.first = 0; | |
| 460 | 2035 pdump_opaque_data_list.align = ALIGNOF (max_align_t); |
| 442 | 2036 pdump_opaque_data_list.count = 0; |
| 1204 | 2037 pdump_depth = 0; |
| 442 | 2038 |
| 2551 | 2039 pdump_cv_data = Dynarr_new2 (pdump_cv_data_info_dynarr, pdump_cv_data_info); |
| 2040 pdump_cv_ptr = Dynarr_new2 (pdump_cv_ptr_info_dynarr, pdump_cv_ptr_info); | |
| 2041 | |
| 2367 | 2042 /* (I) The "register" stage: Note all heap memory blocks to be relocated |
| 2043 */ | |
| 2044 | |
| 2045 /* Try various roots of accessibility: */ | |
| 2046 | |
| 2047 /* (1) Lisp objects, both those declared using DEFVAR_LISP*() and those | |
| 2048 staticpro()d. */ | |
| 1204 | 2049 for (i = 0; i < Dynarr_length (pdump_root_lisp_objects); i++) |
| 2050 pdump_register_object (* Dynarr_at (pdump_root_lisp_objects, i)); | |
| 442 | 2051 |
| 2052 none = 1; | |
| 2367 | 2053 for (i = 0; i < lrecord_type_count; i++) |
| 442 | 2054 if (pdump_alert_undump_object[i]) |
| 2055 { | |
| 2056 if (none) | |
| 2367 | 2057 stderr_out ("Undumpable types list :\n"); |
| 442 | 2058 none = 0; |
| 2367 | 2059 stderr_out (" - %s (%d)\n", lrecord_implementations_table[i]->name, |
| 2060 pdump_alert_undump_object[i]); | |
| 442 | 2061 } |
| 2062 if (!none) | |
| 1204 | 2063 { |
| 2064 in_pdump = 0; | |
| 2065 return; | |
| 2066 } | |
| 442 | 2067 |
| 2367 | 2068 /* (2) Register out the data-segment pointer variables to heap blocks */ |
| 2069 for (i = 0; i < Dynarr_length (pdump_root_block_ptrs); i++) | |
| 452 | 2070 { |
| 2367 | 2071 pdump_root_block_ptr info = Dynarr_at (pdump_root_block_ptrs, i); |
| 2072 pdump_register_block (*(info.ptraddress), info.desc->size, | |
| 2073 info.desc->description, 1); | |
| 452 | 2074 } |
| 442 | 2075 |
| 2367 | 2076 /* (3) Register out the data-segment blocks, maybe with pointers to heap |
| 2077 blocks */ | |
| 2078 for (i = 0; i < Dynarr_length (pdump_root_blocks); i++) | |
| 2079 { | |
| 2080 pdump_root_block *info = Dynarr_atp (pdump_root_blocks, i); | |
| 2081 if (info->desc) | |
| 2082 { | |
| 2083 /* Size may have been given as 0 meaning "compute later". | |
| 2084 Compute now and update. If no DESC, size must always be | |
| 2085 correct as there is no other way of computing it. */ | |
| 2086 info->size = lispdesc_block_size_1 (info->blockaddr, info->size, | |
| 2087 info->desc); | |
| 2088 pdump_register_block_contents (info->blockaddr, info->size, | |
| 2089 info->desc, 1); | |
| 2090 } | |
| 2091 } | |
| 2092 | |
| 2093 /* (II) The "layout" stage: Compute the offsets and max-size */ | |
| 2094 | |
| 2095 /* (1) Determine header size */ | |
| 458 | 2096 memcpy (header.signature, PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN); |
| 2097 header.id = dump_id; | |
| 2098 header.reloc_address = 0; | |
| 2367 | 2099 header.nb_root_block_ptrs = Dynarr_length (pdump_root_block_ptrs); |
| 1204 | 2100 header.nb_root_blocks = Dynarr_length (pdump_root_blocks); |
| 2551 | 2101 header.nb_cv_data = Dynarr_length (pdump_cv_data); |
| 2102 header.nb_cv_ptr = Dynarr_length (pdump_cv_ptr); | |
| 442 | 2103 |
| 826 | 2104 cur_offset = MAX_ALIGN_SIZE (sizeof (header)); |
| 442 | 2105 max_size = 0; |
| 2106 | |
| 2367 | 2107 /* (2) Traverse all heap blocks and compute their offsets; keep track |
| 2108 of maximum block size seen */ | |
| 2551 | 2109 pdump_scan_by_alignment (pdump_allocate_offset, |
| 2110 pdump_allocate_offset_cv_data, | |
| 2111 pdump_allocate_offset_cv_ptr); | |
| 826 | 2112 cur_offset = MAX_ALIGN_SIZE (cur_offset); |
| 458 | 2113 header.stab_offset = cur_offset; |
| 442 | 2114 |
| 2367 | 2115 /* (3) Update maximum size based on root (data-segment) blocks */ |
| 2116 for (i = 0; i < Dynarr_length (pdump_root_blocks); i++) | |
| 2117 { | |
| 2118 pdump_root_block info = Dynarr_at (pdump_root_blocks, i); | |
| 2119 | |
| 2120 /* If no DESC, no relocation needed and we copy directly instead of | |
| 2121 into a temp buffer. */ | |
| 2122 if (info.desc) | |
| 2123 { | |
| 2124 if (info.size > max_size) | |
| 2125 max_size = info.size; | |
| 2126 } | |
| 2127 } | |
| 2128 | |
| 2129 /* (III) The "write "stage: Dump out the data, storing the offsets in | |
| 2130 place of pointers whenever we write out memory blocks */ | |
| 2131 | |
| 442 | 2132 pdump_buf = xmalloc (max_size); |
| 2367 | 2133 /* EMACS_PROGNAME is entirely ASCII so this should be Mule-safe */ |
| 442 | 2134 pdump_fd = open (EMACS_PROGNAME ".dmp", |
| 2135 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666); | |
| 771 | 2136 if (pdump_fd < 0) |
| 2137 report_file_error ("Unable to open dump file", | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4388
diff
changeset
|
2138 build_ascstring (EMACS_PROGNAME ".dmp")); |
| 458 | 2139 pdump_out = fdopen (pdump_fd, "w"); |
| 771 | 2140 if (pdump_out < 0) |
| 2141 report_file_error ("Unable to open dump file for writing", | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4388
diff
changeset
|
2142 build_ascstring (EMACS_PROGNAME ".dmp")); |
| 442 | 2143 |
| 771 | 2144 retry_fwrite (&header, sizeof (header), 1, pdump_out); |
| 458 | 2145 PDUMP_ALIGN_OUTPUT (max_align_t); |
| 442 | 2146 |
| 2551 | 2147 for (i = 0; i < Dynarr_length (pdump_cv_data); i++) |
| 2148 { | |
| 2149 pdump_cv_data_info *elt = Dynarr_atp (pdump_cv_data, i); | |
| 2150 elt->dest_offset = | |
| 2151 pdump_get_block (elt->object)->save_offset + elt->offset; | |
| 2152 } | |
| 2153 | |
| 2154 for (i = 0; i < Dynarr_length (pdump_cv_ptr); i++) | |
| 2155 Dynarr_at (pdump_cv_ptr, i).index = i; | |
| 2156 | |
| 2157 pdump_scan_by_alignment (pdump_dump_data, pdump_dump_cv_data, pdump_dump_cv_ptr); | |
| 2158 | |
| 2159 for (i = 0; i < Dynarr_length (pdump_cv_data); i++) | |
| 2160 { | |
| 2161 pdump_cv_data_info *elt = Dynarr_atp (pdump_cv_data, i); | |
| 2162 if(elt->fcts->convert_free) | |
| 2163 elt->fcts->convert_free(elt->object, elt->data, elt->size); | |
| 2164 } | |
| 2165 | |
| 2166 for (i = 0; i < Dynarr_length (pdump_cv_ptr); i++) | |
| 2167 { | |
| 2168 pdump_cv_ptr_info *elt = Dynarr_atp (pdump_cv_ptr, i); | |
| 2169 if(elt->fcts->convert_free) | |
| 2170 elt->fcts->convert_free(elt->object, elt->data, elt->size); | |
| 2171 } | |
| 442 | 2172 |
| 458 | 2173 fseek (pdump_out, header.stab_offset, SEEK_SET); |
| 442 | 2174 |
| 3263 | 2175 #ifdef NEW_GC |
| 2720 | 2176 { |
| 2177 EMACS_INT zero = 0; | |
| 2178 pdump_scan_lisp_objects_by_alignment (pdump_dump_mc_data); | |
| 2179 PDUMP_WRITE_ALIGNED (EMACS_INT, zero); | |
| 2180 pdump_scan_non_lisp_objects_by_alignment (pdump_dump_mc_data); | |
| 2181 PDUMP_WRITE_ALIGNED (EMACS_INT, zero); | |
| 2182 } | |
| 3263 | 2183 #endif /* NEW_GC */ |
| 2551 | 2184 pdump_dump_cv_data_info (); |
| 2185 pdump_dump_cv_ptr_info (); | |
| 3263 | 2186 #ifdef NEW_GC |
| 2720 | 2187 pdump_dump_rtables (); |
| 3263 | 2188 #endif /* NEW_GC */ |
| 2367 | 2189 pdump_dump_root_block_ptrs (); |
| 1204 | 2190 pdump_dump_root_blocks (); |
| 3263 | 2191 #ifndef NEW_GC |
| 442 | 2192 pdump_dump_rtables (); |
| 3263 | 2193 #endif /* not NEW_GC */ |
| 1204 | 2194 pdump_dump_root_lisp_objects (); |
| 442 | 2195 |
| 771 | 2196 retry_fclose (pdump_out); |
| 3964 | 2197 /* pdump_fd is already closed by the preceding call to fclose. |
| 2198 retry_close (pdump_fd); */ | |
| 458 | 2199 |
| 442 | 2200 free (pdump_buf); |
| 2201 | |
| 2202 free (pdump_hash); | |
| 2203 | |
| 2204 Vterminal_console = t_console; | |
| 2205 Vterminal_frame = t_frame; | |
| 2206 Vterminal_device = t_device; | |
| 1204 | 2207 in_pdump = 0; |
| 442 | 2208 } |
| 2209 | |
| 452 | 2210 static int |
| 2211 pdump_load_check (void) | |
| 442 | 2212 { |
| 2367 | 2213 return (!memcmp (((pdump_header *) pdump_start)->signature, |
| 452 | 2214 PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN) |
| 2215 && ((pdump_header *)pdump_start)->id == dump_id); | |
| 442 | 2216 } |
| 2217 | |
| 458 | 2218 /*----------------------------------------------------------------------*/ |
| 2219 /* Reading the dump file */ | |
| 2220 /*----------------------------------------------------------------------*/ | |
| 452 | 2221 static int |
| 2222 pdump_load_finish (void) | |
| 442 | 2223 { |
| 2224 int i; | |
| 2367 | 2225 Rawbyte *p; |
| 442 | 2226 EMACS_INT delta; |
| 2227 EMACS_INT count; | |
| 1204 | 2228 pdump_header *header = (pdump_header *) pdump_start; |
| 442 | 2229 |
| 3092 | 2230 #ifdef NEW_GC |
| 2231 /* This is a DEFVAR_BOOL and gets dumped, but the actual value was | |
| 2232 already determined by vdb_install_signal_handler () in | |
| 2233 vdb-mprotect.c, which could be different from the value in the | |
| 2234 dump file. So store it here and restore it after loading the dump | |
| 2235 file. */ | |
| 2236 int allow_inc_gc = allow_incremental_gc; | |
| 2237 #endif /* NEW_GC */ | |
| 442 | 2238 pdump_end = pdump_start + pdump_length; |
| 2239 | |
| 1204 | 2240 delta = ((EMACS_INT) pdump_start) - header->reloc_address; |
| 458 | 2241 p = pdump_start + header->stab_offset; |
| 442 | 2242 |
| 3263 | 2243 #ifdef NEW_GC |
| 2720 | 2244 pdump_mc_hash = xnew_array_and_zero (mc_addr_elt, PDUMP_HASHSIZE); |
| 2245 | |
| 2246 /* Allocate space for each object individually. First the | |
| 2247 Lisp_Objects, then the blocks. */ | |
| 2248 count = 2; | |
| 2249 for (;;) | |
| 2250 { | |
| 2824 | 2251 EMACS_INT elt_count = PDUMP_READ_ALIGNED (p, EMACS_INT); |
| 2720 | 2252 if (elt_count) |
| 2253 { | |
| 2254 Rawbyte *mc_addr = 0; | |
| 2255 Bytecount size = PDUMP_READ_ALIGNED (p, Bytecount); | |
| 2256 for (i = 0; i < elt_count; i++) | |
| 2257 { | |
| 2258 EMACS_INT rdata = PDUMP_READ_ALIGNED (p, EMACS_INT); | |
| 2259 | |
| 2260 if (i == 0) | |
| 2261 { | |
| 2262 Bytecount real_size = size * elt_count; | |
| 2263 if (count == 2) | |
| 2775 | 2264 { |
| 3092 | 2265 if (elt_count <= 1) |
| 2266 mc_addr = (Rawbyte *) mc_alloc (real_size); | |
| 2267 else | |
| 2268 mc_addr = (Rawbyte *) mc_alloc_array (size, elt_count); | |
| 2994 | 2269 #ifdef ALLOC_TYPE_STATS |
| 2775 | 2270 inc_lrecord_stats (real_size, |
| 2271 (const struct lrecord_header *) | |
| 3092 | 2272 ((Rawbyte *) rdata + delta)); |
| 2994 | 2273 #endif /* ALLOC_TYPE_STATS */ |
| 2775 | 2274 } |
| 2720 | 2275 else |
| 2276 mc_addr = (Rawbyte *) xmalloc_and_zero (real_size); | |
| 2277 } | |
| 2278 else | |
| 2279 mc_addr += size; | |
| 2280 | |
| 2281 pdump_put_mc_addr ((void *) rdata, (EMACS_INT) mc_addr); | |
| 3092 | 2282 memcpy (mc_addr, (Rawbyte *) rdata + delta, size); |
| 2720 | 2283 } |
| 2284 } | |
| 2285 else if (!(--count)) | |
| 2286 break; | |
| 2287 } | |
| 3263 | 2288 #endif /* NEW_GC */ |
| 2720 | 2289 |
| 2551 | 2290 /* Get the cv_data array */ |
| 2553 | 2291 p = (Rawbyte *) ALIGN_PTR (p, pdump_cv_data_dump_info); |
| 2551 | 2292 pdump_loaded_cv_data = (pdump_cv_data_dump_info *)p; |
| 2293 p += header->nb_cv_data*sizeof(pdump_cv_data_dump_info); | |
| 2294 | |
| 2295 /* Build the cv_ptr array */ | |
| 2553 | 2296 p = (Rawbyte *) ALIGN_PTR (p, pdump_cv_ptr_dump_info); |
| 2551 | 2297 pdump_loaded_cv_ptr = |
| 2298 alloca_array (pdump_cv_ptr_load_info, header->nb_cv_ptr); | |
| 2299 for (i = 0; i < header->nb_cv_ptr; i++) | |
| 2300 { | |
| 2301 pdump_cv_ptr_dump_info info = PDUMP_READ (p, pdump_cv_ptr_dump_info); | |
| 2302 pdump_loaded_cv_ptr[i].save_offset = info.save_offset; | |
| 2303 pdump_loaded_cv_ptr[i].size = info.size; | |
| 2304 pdump_loaded_cv_ptr[i].adr = 0; | |
| 2305 } | |
| 2306 | |
| 3263 | 2307 #ifdef NEW_GC |
| 2720 | 2308 /* Relocate the heap objects */ |
| 2309 pdump_rt_list = p; | |
| 2310 count = 2; | |
| 2311 for (;;) | |
| 2312 { | |
| 2313 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table); | |
| 2314 p = (Rawbyte *) ALIGN_PTR (p, Rawbyte *); | |
| 2315 if (rt.desc) | |
| 2316 { | |
| 3092 | 2317 Rawbyte **reloc = (Rawbyte **) p; |
| 2720 | 2318 for (i = 0; i < rt.count; i++) |
| 2319 { | |
| 3092 | 2320 reloc[i] = (Rawbyte *) pdump_get_mc_addr (reloc[i]); |
| 2720 | 2321 pdump_reloc_one_mc (reloc[i], rt.desc); |
| 2322 } | |
| 3092 | 2323 p += rt.count * sizeof (Rawbyte *); |
| 2720 | 2324 } |
| 2325 else if (!(--count)) | |
| 2326 break; | |
| 2327 } | |
| 3263 | 2328 #endif /* NEW_GC */ |
| 2720 | 2329 |
| 2367 | 2330 /* Put back the pdump_root_block_ptrs */ |
| 2331 p = (Rawbyte *) ALIGN_PTR (p, pdump_static_pointer); | |
| 2332 for (i = 0; i < header->nb_root_block_ptrs; i++) | |
| 442 | 2333 { |
| 458 | 2334 pdump_static_pointer ptr = PDUMP_READ (p, pdump_static_pointer); |
| 3263 | 2335 #ifdef NEW_GC |
| 2720 | 2336 (* ptr.address) = (Rawbyte *) pdump_get_mc_addr (ptr.value); |
| 3263 | 2337 #else /* not NEW_GC */ |
| 458 | 2338 (* ptr.address) = ptr.value + delta; |
| 3263 | 2339 #endif /* not NEW_GC */ |
| 442 | 2340 } |
| 2341 | |
| 1204 | 2342 /* Put back the pdump_root_blocks and relocate */ |
| 2343 for (i = 0; i < header->nb_root_blocks; i++) | |
| 442 | 2344 { |
| 1204 | 2345 pdump_root_block info = PDUMP_READ_ALIGNED (p, pdump_root_block); |
| 2367 | 2346 memcpy ((void *) info.blockaddr, p, info.size); |
| 1204 | 2347 if (info.desc) |
| 3263 | 2348 #ifdef NEW_GC |
| 2720 | 2349 pdump_reloc_one_mc ((void *) info.blockaddr, info.desc); |
| 3263 | 2350 #else /* not NEW_GC */ |
| 2367 | 2351 pdump_reloc_one ((void *) info.blockaddr, delta, info.desc); |
| 3263 | 2352 #endif /* not NEW_GC */ |
| 452 | 2353 p += info.size; |
| 442 | 2354 } |
| 2355 | |
| 3263 | 2356 #ifndef NEW_GC |
| 1204 | 2357 /* Relocate the heap objects */ |
| 442 | 2358 pdump_rt_list = p; |
| 2359 count = 2; | |
| 2360 for (;;) | |
| 2361 { | |
| 458 | 2362 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table); |
| 2367 | 2363 p = (Rawbyte *) ALIGN_PTR (p, Rawbyte *); |
| 442 | 2364 if (rt.desc) |
| 2365 { | |
| 2367 | 2366 Rawbyte **reloc = (Rawbyte **) p; |
| 1204 | 2367 for (i = 0; i < rt.count; i++) |
| 442 | 2368 { |
| 458 | 2369 reloc[i] += delta; |
| 2370 pdump_reloc_one (reloc[i], delta, rt.desc); | |
| 442 | 2371 } |
| 2367 | 2372 p += rt.count * sizeof (Rawbyte *); |
| 1204 | 2373 } |
| 2374 else if (!(--count)) | |
| 2375 break; | |
| 442 | 2376 } |
| 3263 | 2377 #endif /* not NEW_GC */ |
| 442 | 2378 |
| 1204 | 2379 /* Put the pdump_root_lisp_objects variables in place */ |
| 665 | 2380 i = PDUMP_READ_ALIGNED (p, Elemcount); |
| 2367 | 2381 p = (Rawbyte *) ALIGN_PTR (p, pdump_static_Lisp_Object); |
| 458 | 2382 while (i--) |
| 442 | 2383 { |
| 458 | 2384 pdump_static_Lisp_Object obj = PDUMP_READ (p, pdump_static_Lisp_Object); |
| 442 | 2385 |
| 458 | 2386 if (POINTER_TYPE_P (XTYPE (obj.value))) |
| 3263 | 2387 #ifdef NEW_GC |
| 2720 | 2388 obj.value = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr |
| 2389 (XPNTR (obj.value))); | |
| 3263 | 2390 #else /* not NEW_GC */ |
| 2720 | 2391 obj.value = wrap_pointer_1 ((Rawbyte *) XPNTR (obj.value) + delta); |
| 3263 | 2392 #endif /* not NEW_GC */ |
| 442 | 2393 |
| 458 | 2394 (* obj.address) = obj.value; |
| 442 | 2395 } |
| 2396 | |
| 2397 /* Final cleanups */ | |
| 2398 /* reorganize hash tables */ | |
| 2399 p = pdump_rt_list; | |
| 2400 for (;;) | |
| 2401 { | |
| 458 | 2402 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table); |
| 2367 | 2403 p = (Rawbyte *) ALIGN_PTR (p, Lisp_Object); |
| 442 | 2404 if (!rt.desc) |
| 2405 break; | |
| 2406 if (rt.desc == hash_table_description) | |
| 2407 { | |
| 1204 | 2408 for (i = 0; i < rt.count; i++) |
| 442 | 2409 pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object)); |
| 2410 break; | |
| 1204 | 2411 } |
| 2412 else | |
| 2413 p += sizeof (Lisp_Object) * rt.count; | |
| 442 | 2414 } |
| 2415 | |
| 3263 | 2416 #ifdef NEW_GC |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2417 xfree (pdump_mc_hash); |
| 3263 | 2418 #endif /* NEW_GC */ |
| 2720 | 2419 |
| 3092 | 2420 #ifdef NEW_GC |
| 2421 allow_incremental_gc = allow_inc_gc; | |
| 2422 #endif /* NEW_GC */ | |
| 2423 | |
| 442 | 2424 return 1; |
| 2425 } | |
| 2426 | |
| 2427 #ifdef WIN32_NATIVE | |
| 2428 /* Free the mapped file if we decide we don't want it after all */ | |
| 452 | 2429 static void |
| 2430 pdump_file_unmap (void) | |
| 442 | 2431 { |
| 2432 UnmapViewOfFile (pdump_start); | |
| 2433 CloseHandle (pdump_hFile); | |
| 2434 CloseHandle (pdump_hMap); | |
| 2435 } | |
| 2436 | |
| 452 | 2437 static int |
| 2367 | 2438 pdump_file_get (const Wexttext *wpath) |
| 442 | 2439 { |
| 2367 | 2440 Extbyte *path; |
| 2441 if (XEUNICODE_P) | |
| 2442 path = (Extbyte *) wpath; | |
| 2443 else | |
| 2444 path = WEXTTEXT_TO_MULTIBYTE (wpath); | |
| 442 | 2445 |
| 2367 | 2446 pdump_hFile = |
| 2447 qxeCreateFile (path, | |
| 2448 GENERIC_READ + GENERIC_WRITE, /* Required for copy on | |
| 2449 write */ | |
| 2450 0, /* Not shared */ | |
| 2451 NULL, /* Not inheritable */ | |
| 2452 OPEN_EXISTING, | |
| 2453 FILE_ATTRIBUTE_NORMAL, | |
| 2454 NULL); /* No template file */ | |
| 442 | 2455 if (pdump_hFile == INVALID_HANDLE_VALUE) |
| 2456 return 0; | |
| 2457 | |
| 2458 pdump_length = GetFileSize (pdump_hFile, NULL); | |
| 2367 | 2459 pdump_hMap = |
| 2460 qxeCreateFileMapping (pdump_hFile, | |
| 2461 NULL, /* No security attributes */ | |
| 2462 PAGE_WRITECOPY, /* Copy on write */ | |
| 2463 0, /* Max size, high half */ | |
| 2464 0, /* Max size, low half */ | |
| 2465 NULL); /* Unnamed */ | |
| 442 | 2466 if (pdump_hMap == INVALID_HANDLE_VALUE) |
| 2467 return 0; | |
| 2468 | |
| 2367 | 2469 pdump_start = |
| 2470 (Rawbyte *) MapViewOfFile (pdump_hMap, | |
| 2471 FILE_MAP_COPY, /* Copy on write */ | |
| 2472 0, /* Start at zero */ | |
| 2473 0, | |
| 2474 0); /* Map all of it */ | |
| 442 | 2475 pdump_free = pdump_file_unmap; |
| 2476 return 1; | |
| 2477 } | |
| 2478 | |
| 2479 /* pdump_resource_free is called (via the pdump_free pointer) to release | |
| 2480 any resources allocated by pdump_resource_get. Since the Windows API | |
| 2481 specs specifically state that you don't need to (and shouldn't) free the | |
| 2482 resources allocated by FindResource, LoadResource, and LockResource this | |
| 2483 routine does nothing. */ | |
| 452 | 2484 static void |
| 2485 pdump_resource_free (void) | |
| 442 | 2486 { |
| 2487 } | |
| 2488 | |
| 452 | 2489 static int |
| 2490 pdump_resource_get (void) | |
| 442 | 2491 { |
| 452 | 2492 HRSRC hRes; /* Handle to dump resource */ |
| 2493 HRSRC hResLoad; /* Handle to loaded dump resource */ | |
| 442 | 2494 |
| 2495 /* See Q126630 which describes how Windows NT and 95 trap writes to | |
| 2496 resource sections and duplicate the page to allow the write to proceed. | |
| 2497 It also describes how to make the resource section read/write (and hence | |
| 2498 private to each process). Doing this avoids the exceptions and related | |
| 2499 overhead, but causes the resource section to be private to each process | |
| 2500 that is running XEmacs. Since the resource section contains little | |
| 2501 other than the dumped data, which should be private to each process, we | |
| 2502 make the whole resource section read/write so we don't have to copy it. */ | |
| 2503 | |
| 800 | 2504 hRes = FindResourceA (NULL, MAKEINTRESOURCE (101), "DUMP"); |
| 442 | 2505 if (hRes == NULL) |
| 2506 return 0; | |
| 2507 | |
| 2508 /* Found it, use the data in the resource */ | |
| 1204 | 2509 hResLoad = (HRSRC) LoadResource (NULL, hRes); |
| 442 | 2510 if (hResLoad == NULL) |
| 2511 return 0; | |
| 2512 | |
| 2367 | 2513 pdump_start = (Rawbyte *) LockResource (hResLoad); |
| 442 | 2514 if (pdump_start == NULL) |
| 2515 return 0; | |
| 2516 | |
| 2517 pdump_free = pdump_resource_free; | |
| 2518 pdump_length = SizeofResource (NULL, hRes); | |
| 665 | 2519 if (pdump_length <= (Bytecount) sizeof (pdump_header)) |
| 442 | 2520 { |
| 2521 pdump_start = 0; | |
| 2522 return 0; | |
| 2523 } | |
| 2524 | |
| 2525 return 1; | |
| 2526 } | |
| 2527 | |
| 2528 #else /* !WIN32_NATIVE */ | |
| 2529 | |
| 452 | 2530 static void |
| 2531 pdump_file_free (void) | |
| 442 | 2532 { |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2533 xfree (pdump_start); |
| 442 | 2534 } |
| 2535 | |
| 2536 #ifdef HAVE_MMAP | |
| 452 | 2537 static void |
| 2538 pdump_file_unmap (void) | |
| 442 | 2539 { |
| 2540 munmap (pdump_start, pdump_length); | |
| 2541 } | |
| 2542 #endif | |
| 2543 | |
| 452 | 2544 static int |
| 2367 | 2545 pdump_file_get (const Wexttext *path) |
| 442 | 2546 { |
| 2367 | 2547 int fd = wext_retry_open (path, O_RDONLY | OPEN_BINARY); |
| 2548 if (fd < 0) | |
| 442 | 2549 return 0; |
| 2550 | |
| 2551 pdump_length = lseek (fd, 0, SEEK_END); | |
| 665 | 2552 if (pdump_length < (Bytecount) sizeof (pdump_header)) |
| 442 | 2553 { |
| 771 | 2554 retry_close (fd); |
| 442 | 2555 return 0; |
| 2556 } | |
| 2557 | |
| 2558 lseek (fd, 0, SEEK_SET); | |
| 2559 | |
| 2560 #ifdef HAVE_MMAP | |
| 456 | 2561 /* Unix 98 requires that sys/mman.h define MAP_FAILED, |
| 2562 but many earlier implementations don't. */ | |
| 2563 # ifndef MAP_FAILED | |
| 2564 # define MAP_FAILED ((void *) -1L) | |
| 2565 # endif | |
| 2367 | 2566 pdump_start = |
| 2567 (Rawbyte *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, | |
| 2568 fd, 0); | |
| 2569 if (pdump_start != (Rawbyte *) MAP_FAILED) | |
| 442 | 2570 { |
| 2571 pdump_free = pdump_file_unmap; | |
| 771 | 2572 retry_close (fd); |
| 442 | 2573 return 1; |
| 2574 } | |
| 456 | 2575 #endif /* HAVE_MMAP */ |
| 442 | 2576 |
| 2367 | 2577 pdump_start = xnew_array (Rawbyte, pdump_length); |
| 442 | 2578 pdump_free = pdump_file_free; |
| 771 | 2579 retry_read (fd, pdump_start, pdump_length); |
| 442 | 2580 |
| 771 | 2581 retry_close (fd); |
| 442 | 2582 return 1; |
| 2583 } | |
| 2015 | 2584 |
| 2720 | 2585 #ifdef DUMP_IN_EXEC |
| 2015 | 2586 static int |
| 2587 pdump_ram_try (void) | |
| 2588 { | |
| 2367 | 2589 pdump_start = dumped_data_get (); |
| 2590 pdump_length = dumped_data_size (); | |
| 2015 | 2591 |
| 2367 | 2592 return pdump_load_check (); |
| 2015 | 2593 } |
| 2720 | 2594 #endif |
| 2015 | 2595 |
| 442 | 2596 #endif /* !WIN32_NATIVE */ |
| 2597 | |
| 2598 | |
| 452 | 2599 static int |
| 2367 | 2600 pdump_file_try (Wexttext *exe_path) |
| 442 | 2601 { |
| 2367 | 2602 Wexttext *w = exe_path + wext_strlen (exe_path); |
| 442 | 2603 |
| 2563 | 2604 /* We look for various names, including those with the version and dump ID, |
| 2605 those with just the dump ID, and those without either. We first try | |
| 2606 adding directly to the executable name, then lopping off any extension | |
| 2607 (e.g. .exe) or version name in the executable (xemacs-21.5.18). */ | |
| 442 | 2608 do |
| 2609 { | |
| 2367 | 2610 wext_sprintf (w, WEXTSTRING ("-%s-%08x.dmp"), WEXTSTRING (EMACS_VERSION), |
| 2611 dump_id); | |
| 442 | 2612 if (pdump_file_get (exe_path)) |
| 2613 { | |
| 2614 if (pdump_load_check ()) | |
| 2615 return 1; | |
| 452 | 2616 pdump_free (); |
| 442 | 2617 } |
| 2618 | |
| 2367 | 2619 wext_sprintf (w, WEXTSTRING ("-%08x.dmp"), dump_id); |
| 442 | 2620 if (pdump_file_get (exe_path)) |
| 2621 { | |
| 2622 if (pdump_load_check ()) | |
| 2623 return 1; | |
| 452 | 2624 pdump_free (); |
| 442 | 2625 } |
| 2626 | |
| 2367 | 2627 wext_sprintf (w, WEXTSTRING (".dmp")); |
| 442 | 2628 if (pdump_file_get (exe_path)) |
| 2629 { | |
| 2630 if (pdump_load_check ()) | |
| 2631 return 1; | |
| 452 | 2632 pdump_free (); |
| 442 | 2633 } |
| 2634 | |
| 2635 do | |
| 2636 w--; | |
| 2367 | 2637 /* !!#### See comment below about how this is unsafe. */ |
| 2638 while (w > exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && | |
| 2639 (*w != '.')); | |
| 442 | 2640 } |
| 2367 | 2641 while (w > exe_path && !IS_DIRECTORY_SEP (*w)); |
| 442 | 2642 return 0; |
| 2643 } | |
| 2644 | |
|
4388
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2645 #define DUMP_SLACK 100 /* Enough to include dump ID, version name, .DMP */ |
|
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2646 |
| 452 | 2647 int |
| 2367 | 2648 pdump_load (const Wexttext *argv0) |
| 442 | 2649 { |
| 2650 #ifdef WIN32_NATIVE | |
| 2421 | 2651 Wexttext *exe_path = NULL; |
| 2652 int bufsize = 4096; | |
| 2653 int cchpathsize; | |
| 2654 | |
| 2655 /* Copied from mswindows_get_module_file_name (). Not clear if it's | |
| 2656 kosher to malloc() yet. */ | |
| 2657 while (1) | |
| 2658 { | |
| 2659 exe_path = alloca_array (Wexttext, bufsize); | |
| 2660 cchpathsize = qxeGetModuleFileName (NULL, (Extbyte *) exe_path, | |
| 2661 bufsize); | |
| 2662 if (!cchpathsize) | |
| 2663 goto fail; | |
| 2563 | 2664 if (cchpathsize + DUMP_SLACK <= bufsize) |
| 2421 | 2665 break; |
| 2666 bufsize *= 2; | |
| 2667 } | |
| 2668 | |
| 2367 | 2669 if (!XEUNICODE_P) |
| 2670 { | |
| 2671 Wexttext *wexe = MULTIBYTE_TO_WEXTTEXT ((Extbyte *) exe_path); | |
| 2672 wext_strcpy (exe_path, wexe); | |
| 2673 } | |
| 442 | 2674 #else /* !WIN32_NATIVE */ |
|
4388
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2675 Wexttext *exe_path; |
| 2367 | 2676 Wexttext *w; |
| 2677 const Wexttext *dir, *p; | |
| 442 | 2678 |
| 2720 | 2679 #ifdef DUMP_IN_EXEC |
| 2367 | 2680 if (pdump_ram_try ()) |
| 2681 { | |
| 2682 pdump_load_finish (); | |
| 2683 in_pdump = 0; | |
| 2684 return 1; | |
| 2685 } | |
| 2720 | 2686 #endif |
| 2015 | 2687 |
| 1204 | 2688 in_pdump = 1; |
| 442 | 2689 dir = argv0; |
| 2690 if (dir[0] == '-') | |
| 2691 { | |
| 2692 /* XEmacs as a login shell, oh goody! */ | |
| 2367 | 2693 dir = wext_getenv ("SHELL"); /* not egetenv -- not yet initialized and we |
| 2694 want external-format data */ | |
| 442 | 2695 } |
| 2696 | |
| 2367 | 2697 p = dir + wext_strlen (dir); |
| 2698 /* !!#### This is bad as it may fail with certain non-ASCII-compatible | |
| 2699 external formats such as JIS. Maybe we should be using the mb*() | |
| 2700 routines in libc? But can we reliably trust them on all Unix | |
| 2701 platforms? (We can't convert to internal since those conversion | |
| 2702 routines aren't yet initialized) */ | |
| 2703 while (p != dir && !IS_ANY_SEP (p[-1])) | |
| 2704 p--; | |
| 442 | 2705 |
| 2706 if (p != dir) | |
| 2707 { | |
| 2708 /* invocation-name includes a directory component -- presumably it | |
| 4137 | 2709 is relative to cwd, not $PATH. */ |
|
4388
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2710 exe_path = alloca_array (Wexttext, 1 + wext_strlen (dir) + DUMP_SLACK); |
| 2367 | 2711 wext_strcpy (exe_path, dir); |
| 442 | 2712 } |
| 2713 else | |
| 2714 { | |
| 2367 | 2715 const Wexttext *path = wext_getenv ("PATH"); /* not egetenv -- |
|
4388
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2716 not yet init. */ |
| 2367 | 2717 const Wexttext *name = p; |
|
4388
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2718 exe_path = alloca_array (Wexttext, |
|
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2719 1 + DUMP_SLACK + max (wext_strlen (name), |
|
1a14c304cb8e
Don't use PATH_MAX_EXTERNAL, non-Win32.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4137
diff
changeset
|
2720 wext_strlen (path))); |
| 442 | 2721 for (;;) |
| 2722 { | |
| 2723 p = path; | |
| 2724 while (*p && *p != SEPCHAR) | |
| 2725 p++; | |
| 2726 if (p == path) | |
| 2727 { | |
| 2728 exe_path[0] = '.'; | |
| 2729 w = exe_path + 1; | |
| 2730 } | |
| 2731 else | |
| 2732 { | |
| 2367 | 2733 memcpy (exe_path, path, (p - path) * sizeof (Wexttext)); |
| 442 | 2734 w = exe_path + (p - path); |
| 2735 } | |
| 2736 if (!IS_DIRECTORY_SEP (w[-1])) | |
| 2367 | 2737 *w++ = '/'; |
| 2738 wext_strcpy (w, name); | |
| 1466 | 2739 |
| 2740 { | |
| 2741 struct stat statbuf; | |
| 2367 | 2742 if (wext_access (exe_path, X_OK) == 0 |
| 2743 && wext_stat (exe_path, &statbuf) == 0 | |
| 1466 | 2744 && ! S_ISDIR (statbuf.st_mode)) |
| 2745 break; | |
| 2746 } | |
| 2747 | |
| 442 | 2748 if (!*p) |
| 2749 { | |
| 2750 /* Oh well, let's have some kind of default */ | |
| 2367 | 2751 wext_sprintf (exe_path, "./%s", name); |
| 442 | 2752 break; |
| 2753 } | |
| 2421 | 2754 path = p + 1; |
| 442 | 2755 } |
| 2756 } | |
| 2757 #endif /* WIN32_NATIVE */ | |
| 2758 | |
| 2759 if (pdump_file_try (exe_path)) | |
| 2760 { | |
| 2761 pdump_load_finish (); | |
| 1204 | 2762 in_pdump = 0; |
| 3263 | 2763 #ifdef NEW_GC |
| 2720 | 2764 pdump_free (); |
| 3263 | 2765 #endif /* NEW_GC */ |
| 442 | 2766 return 1; |
| 2767 } | |
| 2768 | |
| 2769 #ifdef WIN32_NATIVE | |
| 2770 if (pdump_resource_get ()) | |
| 2771 { | |
| 2772 if (pdump_load_check ()) | |
| 2773 { | |
| 2774 pdump_load_finish (); | |
| 1204 | 2775 in_pdump = 0; |
| 3263 | 2776 #ifdef NEW_GC |
| 2720 | 2777 pdump_free (); |
| 3263 | 2778 #endif /* NEW_GC */ |
| 442 | 2779 return 1; |
| 2780 } | |
| 2781 pdump_free (); | |
| 2782 } | |
| 2421 | 2783 |
| 2784 fail: | |
| 442 | 2785 #endif |
| 2786 | |
| 1204 | 2787 in_pdump = 0; |
| 442 | 2788 return 0; |
| 2789 } |