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