X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Falloc.c;h=0c4325da73768046b741a16f9722a9955d2e5ff0;hp=74b65598445fafd105fb8cdfd6907e6982d56e35;hb=2fd9701a4f902054649dde9143a3f77809afee8f;hpb=efab7bccd7d7da13ff3979d2890a417a048ec960 diff --git a/src/alloc.c b/src/alloc.c index 74b6559..0c4325d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -36,12 +36,13 @@ Boston, MA 02111-1307, USA. */ Added lcrecord lists for 19.14. slb: Lots of work on the purification and dump time code. Synched Doug Lea malloc support from Emacs 20.2. - og: Killed the purespace. Portable dumper. + og: Killed the purespace. Portable dumper (moved to dumper.c) */ #include #include "lisp.h" +#include "alloc.h" #include "backtrace.h" #include "buffer.h" #include "bytecode.h" @@ -56,6 +57,7 @@ Boston, MA 02111-1307, USA. */ #include "redisplay.h" #include "specifier.h" #include "sysfile.h" +#include "sysdep.h" #include "window.h" #include "console-stream.h" @@ -63,19 +65,8 @@ Boston, MA 02111-1307, USA. */ #include #endif -#ifdef HAVE_MMAP -#include -#include -#endif - #ifdef PDUMP -typedef struct -{ - const struct lrecord_description *desc; - int count; -} pdump_reloc_table; - -static char *pdump_rt_list = 0; +#include "dumper.h" #endif EXFUN (Fgarbage_collect, 0); @@ -393,7 +384,7 @@ alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation (! (implementation->hash == NULL && implementation->equal != NULL))); lcheader = (struct lcrecord_header *) allocate_lisp_storage (size); - set_lheader_implementation (&(lcheader->lheader), implementation); + set_lheader_implementation (&lcheader->lheader, implementation); lcheader->next = all_lcrecords; #if 1 /* mly prefers to see small ID numbers */ lcheader->uid = lrecord_uid_counter++; @@ -657,7 +648,7 @@ dbg_eq (Lisp_Object obj1, Lisp_Object obj2) This is called when a relocatable block is freed in ralloc.c. */ void refill_memory_reserve (void); void -refill_memory_reserve () +refill_memory_reserve (void) { if (breathing_space == 0) breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD); @@ -796,12 +787,18 @@ do \ You have some weird system and need to supply a reasonable value here. #endif +/* The construct (* (void **) (ptr)) would cause aliasing problems + with modern optimizing compilers like `gcc -O3 -fstrict-aliasing'. + But `char *' can legally alias any pointer. Hence this union trick. */ +typedef union { char c; void *p; } *aliasing_voidpp; +#define ALIASING_VOIDPP_DEREFERENCE(ptr) \ + (((aliasing_voidpp) (ptr))->p) #define FREE_STRUCT_P(ptr) \ - (* (void **) ptr == (void *) INVALID_POINTER_VALUE) + (ALIASING_VOIDPP_DEREFERENCE (ptr) == (void *) INVALID_POINTER_VALUE) #define MARK_STRUCT_AS_FREE(ptr) \ - (* (void **) ptr = (void *) INVALID_POINTER_VALUE) + (ALIASING_VOIDPP_DEREFERENCE (ptr) = (void *) INVALID_POINTER_VALUE) #define MARK_STRUCT_AS_NOT_FREE(ptr) \ - (* (void **) ptr = 0) + (ALIASING_VOIDPP_DEREFERENCE (ptr) = 0) #ifdef ERROR_CHECK_GC @@ -923,7 +920,7 @@ Create a new cons, give it CAR and CDR as components, and return it. Lisp_Cons *c; ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); - set_lheader_implementation (&(c->lheader), &lrecord_cons); + set_lheader_implementation (&c->lheader, &lrecord_cons); XSETCONS (val, c); c->car = car; c->cdr = cdr; @@ -940,7 +937,7 @@ noseeum_cons (Lisp_Object car, Lisp_Object cdr) Lisp_Cons *c; NOSEEUM_ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); - set_lheader_implementation (&(c->lheader), &lrecord_cons); + set_lheader_implementation (&c->lheader, &lrecord_cons); XSETCONS (val, c); XCAR (val) = car; XCDR (val) = cdr; @@ -1057,7 +1054,7 @@ make_float (double float_value) if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f)) xzero (*f); - set_lheader_implementation (&(f->lheader), &lrecord_float); + set_lheader_implementation (&f->lheader, &lrecord_float); float_data (f) = float_value; XSETFLOAT (val, f); return val; @@ -1297,7 +1294,7 @@ make_bit_vector_internal (size_t sizei) size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei); size_t sizem = offsetof (Lisp_Bit_Vector, bits[num_longs]); Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem); - set_lheader_implementation (&(p->lheader), &lrecord_bit_vector); + set_lheader_implementation (&p->lheader, &lrecord_bit_vector); INCREMENT_CONS_COUNTER (sizem, "bit-vector"); @@ -1401,7 +1398,7 @@ make_compiled_function (void) Lisp_Object fun; ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f); - set_lheader_implementation (&(f->lheader), &lrecord_compiled_function); + set_lheader_implementation (&f->lheader, &lrecord_compiled_function); f->stack_depth = 0; f->specpdl_depth = 0; @@ -1485,7 +1482,7 @@ This is terrible behavior which is retained for compatibility with old f->constants = constants; CHECK_NATNUM (stack_depth); - f->stack_depth = XINT (stack_depth); + f->stack_depth = (unsigned short) XINT (stack_depth); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK if (!NILP (Vcurrent_compiled_function_annotation)) @@ -1548,7 +1545,7 @@ Its value and function definition are void, and its property list is nil. CHECK_STRING (name); ALLOCATE_FIXED_TYPE (symbol, Lisp_Symbol, p); - set_lheader_implementation (&(p->lheader), &lrecord_symbol); + set_lheader_implementation (&p->lheader, &lrecord_symbol); p->name = XSTRING (name); p->plist = Qnil; p->value = Qunbound; @@ -1572,7 +1569,7 @@ allocate_extent (void) struct extent *e; ALLOCATE_FIXED_TYPE (extent, struct extent, e); - set_lheader_implementation (&(e->lheader), &lrecord_extent); + set_lheader_implementation (&e->lheader, &lrecord_extent); extent_object (e) = Qnil; set_extent_start (e, -1); set_extent_end (e, -1); @@ -1602,7 +1599,7 @@ allocate_event (void) Lisp_Event *e; ALLOCATE_FIXED_TYPE (event, Lisp_Event, e); - set_lheader_implementation (&(e->lheader), &lrecord_event); + set_lheader_implementation (&e->lheader, &lrecord_event); XSETEVENT (val, e); return val; @@ -1625,7 +1622,7 @@ Return a new marker which does not point at any place. Lisp_Marker *p; ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); - set_lheader_implementation (&(p->lheader), &lrecord_marker); + set_lheader_implementation (&p->lheader, &lrecord_marker); p->buffer = 0; p->memind = 0; marker_next (p) = 0; @@ -1642,7 +1639,7 @@ noseeum_make_marker (void) Lisp_Marker *p; NOSEEUM_ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); - set_lheader_implementation (&(p->lheader), &lrecord_marker); + set_lheader_implementation (&p->lheader, &lrecord_marker); p->buffer = 0; p->memind = 0; marker_next (p) = 0; @@ -1862,7 +1859,7 @@ make_uninit_string (Bytecount length) /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); - set_lheader_implementation (&(s->lheader), &lrecord_string); + set_lheader_implementation (&s->lheader, &lrecord_string); set_string_data (s, BIG_STRING_FULLSIZE_P (fullsize) ? xnew_array (Bufbyte, length + 1) @@ -2166,7 +2163,7 @@ make_string_nocopy (const Bufbyte *contents, Bytecount length) /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); - set_lheader_implementation (&(s->lheader), &lrecord_string); + set_lheader_implementation (&s->lheader, &lrecord_string); SET_C_READONLY_RECORD_HEADER (&s->lheader); s->plist = Qnil; set_string_data (s, (Bufbyte *)contents); @@ -2348,9 +2345,6 @@ Does not copy symbols. /* Garbage Collection */ /************************************************************************/ -/* This will be used more extensively In The Future */ -static int last_lrecord_type_index_assigned; - /* All the built-in lisp object types are enumerated in `enum lrecord_type'. Additional ones may be defined by a module (none yet). We leave some room in `lrecord_implementations_table' for such new lisp object types. */ @@ -2372,108 +2366,89 @@ struct gcpro *gcprolist; #else #define NSTATICS 2000 #endif -/* Not "static" because of linker lossage on some systems */ -Lisp_Object *staticvec[NSTATICS] - /* Force it into data space! */ - = {0}; -static int staticidx; + +/* Not "static" because used by dumper.c */ +Lisp_Object *staticvec[NSTATICS]; +int staticidx; /* Put an entry in staticvec, pointing at the variable whose address is given */ void staticpro (Lisp_Object *varaddress) { - if (staticidx >= countof (staticvec)) - /* #### This is now a dubious abort() since this routine may be called */ - /* by Lisp attempting to load a DLL. */ - abort (); + /* #### This is now a dubious assert() since this routine may be called */ + /* by Lisp attempting to load a DLL. */ + assert (staticidx < countof (staticvec)); staticvec[staticidx++] = varaddress; } -/* Not "static" because of linker lossage on some systems */ -Lisp_Object *staticvec_nodump[200] - /* Force it into data space! */ - = {0}; -static int staticidx_nodump; + +Lisp_Object *staticvec_nodump[200]; +int staticidx_nodump; /* Put an entry in staticvec_nodump, pointing at the variable whose address is given */ void staticpro_nodump (Lisp_Object *varaddress) { - if (staticidx_nodump >= countof (staticvec_nodump)) - /* #### This is now a dubious abort() since this routine may be called */ - /* by Lisp attempting to load a DLL. */ - abort (); + /* #### This is now a dubious assert() since this routine may be called */ + /* by Lisp attempting to load a DLL. */ + assert (staticidx_nodump < countof (staticvec_nodump)); staticvec_nodump[staticidx_nodump++] = varaddress; } -/* Not "static" because of linker lossage on some systems */ -struct -{ - void *data; - const struct struct_description *desc; -} dumpstructvec[200]; -static int dumpstructidx; +struct pdump_dumpstructinfo dumpstructvec[200]; +int dumpstructidx; /* Put an entry in dumpstructvec, pointing at the variable whose address is given */ void dumpstruct (void *varaddress, const struct struct_description *desc) { - if (dumpstructidx >= countof (dumpstructvec)) - abort (); + assert (dumpstructidx < countof (dumpstructvec)); dumpstructvec[dumpstructidx].data = varaddress; dumpstructvec[dumpstructidx].desc = desc; dumpstructidx++; } -/* Not "static" because of linker lossage on some systems */ -struct dumpopaque_info -{ - void *data; - size_t size; -} dumpopaquevec[200]; - -static int dumpopaqueidx; +struct pdump_dumpopaqueinfo dumpopaquevec[250]; +int dumpopaqueidx; /* Put an entry in dumpopaquevec, pointing at the variable whose address is given */ void dumpopaque (void *varaddress, size_t size) { - if (dumpopaqueidx >= countof (dumpopaquevec)) - abort (); + assert (dumpopaqueidx < countof (dumpopaquevec)); + dumpopaquevec[dumpopaqueidx].data = varaddress; dumpopaquevec[dumpopaqueidx].size = size; dumpopaqueidx++; } Lisp_Object *pdump_wirevec[50]; -static int pdump_wireidx; +int pdump_wireidx; /* Put an entry in pdump_wirevec, pointing at the variable whose address is given */ void pdump_wire (Lisp_Object *varaddress) { - if (pdump_wireidx >= countof (pdump_wirevec)) - abort (); + assert (pdump_wireidx < countof (pdump_wirevec)); pdump_wirevec[pdump_wireidx++] = varaddress; } Lisp_Object *pdump_wirevec_list[50]; -static int pdump_wireidx_list; +int pdump_wireidx_list; /* Put an entry in pdump_wirevec_list, pointing at the variable whose address is given */ void pdump_wire_list (Lisp_Object *varaddress) { - if (pdump_wireidx_list >= countof (pdump_wirevec_list)) - abort (); + assert (pdump_wireidx_list < countof (pdump_wirevec_list)); pdump_wirevec_list[pdump_wireidx_list++] = varaddress; } @@ -2481,7 +2456,7 @@ pdump_wire_list (Lisp_Object *varaddress) #define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ struct lrecord_header * GCLI_lh = (lheader); \ assert (GCLI_lh != 0); \ - assert (GCLI_lh->type <= last_lrecord_type_index_assigned); \ + assert (GCLI_lh->type < lrecord_type_count); \ assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \ (MARKED_RECORD_HEADER_P (GCLI_lh) && \ LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \ @@ -3075,8 +3050,7 @@ compact_string_chars (void) size = string_length (string); fullsize = STRING_FULLSIZE (size); - if (BIG_STRING_FULLSIZE_P (fullsize)) - abort (); + gc_checking_assert (! BIG_STRING_FULLSIZE_P (fullsize)); /* Just skip it if it isn't marked. */ if (! MARKED_RECORD_HEADER_P (&(string->lheader))) @@ -3138,7 +3112,7 @@ debug_string_purity_print (Lisp_String *p) { Charcount i; Charcount s = string_char_length (p); - putc ('\"', stderr); + stderr_out ("\""); for (i = 0; i < s; i++) { Emchar ch = string_char (p, i); @@ -3266,28 +3240,7 @@ gc_sweep (void) sweep_events (); #ifdef PDUMP - /* Unmark all dumped objects */ - { - int i; - char *p = pdump_rt_list; - if (p) - for (;;) - { - pdump_reloc_table *rt = (pdump_reloc_table *)p; - p += sizeof (pdump_reloc_table); - if (rt->desc) - { - for (i=0; icount; i++) - { - struct lrecord_header *lh = * (struct lrecord_header **) p; - if (! C_READONLY_RECORD_HEADER_P (lh)) - UNMARK_RECORD_HEADER (lh); - p += sizeof (EMACS_INT); - } - } else - break; - } - } + pdump_objects_unmark (); #endif } @@ -3652,7 +3605,7 @@ Garbage collection happens automatically if you cons more than garbage_collect_1 (); - for (i = 0; i <= last_lrecord_type_index_assigned; i++) + for (i = 0; i < lrecord_type_count; i++) { if (lcrecord_stats[i].bytes_in_use != 0 || lcrecord_stats[i].bytes_freed != 0 @@ -3993,8 +3946,6 @@ init_alloc_once_early (void) { reinit_alloc_once_early (); - last_lrecord_type_index_assigned = lrecord_type_count - 1; - { int i; for (i = 0; i < countof (lrecord_implementations_table); i++) @@ -4135,1047 +4086,3 @@ complex_vars_of_alloc (void) { Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer); } - - -#ifdef PDUMP - -/* The structure of the file - * - * 0 - header - * 256 - dumped objects - * stab_offset - nb_staticpro*(Lisp_Object *) from staticvec - * - nb_staticpro*(relocated Lisp_Object) pointed to by staticpro - * - nb_structdmp*pair(void *, adr) for pointers to structures - * - lrecord_implementations_table[] - * - relocation table - * - wired variable address/value couples with the count preceding the list - */ -typedef struct -{ - char signature[8]; - EMACS_UINT stab_offset; - EMACS_UINT reloc_address; - int nb_staticpro; - int nb_structdmp; - int nb_opaquedmp; - int last_type; -} dump_header; - -char *pdump_start, *pdump_end; - -static const unsigned char align_table[256] = -{ - 8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, - 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0 -}; - -typedef struct pdump_entry_list_elmt -{ - struct pdump_entry_list_elmt *next; - const void *obj; - size_t size; - int count; - int is_lrecord; - EMACS_INT save_offset; -} pdump_entry_list_elmt; - -typedef struct -{ - pdump_entry_list_elmt *first; - int align; - int count; -} pdump_entry_list; - -typedef struct pdump_struct_list_elmt -{ - pdump_entry_list list; - const struct struct_description *sdesc; -} pdump_struct_list_elmt; - -typedef struct -{ - pdump_struct_list_elmt *list; - int count; - int size; -} pdump_struct_list; - -static pdump_entry_list pdump_object_table[256]; -static pdump_entry_list pdump_opaque_data_list; -static pdump_struct_list pdump_struct_table; -static pdump_entry_list_elmt *pdump_qnil; - -static int pdump_alert_undump_object[256]; - -static unsigned long cur_offset; -static size_t max_size; -static int pdump_fd; -static void *pdump_buf; - -#define PDUMP_HASHSIZE 200001 - -static pdump_entry_list_elmt **pdump_hash; - -/* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */ -static int -pdump_make_hash (const void *obj) -{ - return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE; -} - -static pdump_entry_list_elmt * -pdump_get_entry (const void *obj) -{ - int pos = pdump_make_hash (obj); - pdump_entry_list_elmt *e; - - assert (obj != 0); - - while ((e = pdump_hash[pos]) != 0) - { - if (e->obj == obj) - return e; - - pos++; - if (pos == PDUMP_HASHSIZE) - pos = 0; - } - return 0; -} - -static void -pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord) -{ - pdump_entry_list_elmt *e; - int align; - int pos = pdump_make_hash (obj); - - while ((e = pdump_hash[pos]) != 0) - { - if (e->obj == obj) - return; - - pos++; - if (pos == PDUMP_HASHSIZE) - pos = 0; - } - - e = xnew (pdump_entry_list_elmt); - - e->next = list->first; - e->obj = obj; - e->size = size; - e->count = count; - e->is_lrecord = is_lrecord; - list->first = e; - - list->count += count; - pdump_hash[pos] = e; - - align = align_table[size & 255]; - if (align < 2 && is_lrecord) - align = 2; - - if (align < list->align) - list->align = align; -} - -static pdump_entry_list * -pdump_get_entry_list (const struct struct_description *sdesc) -{ - int i; - for (i=0; iname, - backtrace[i].position, - backtrace[i].offset); - } - } -} - -static void pdump_register_object (Lisp_Object obj); -static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count); - -static EMACS_INT -pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata) -{ - EMACS_INT count; - const void *irdata; - - int line = XD_INDIRECT_VAL (code); - int delta = XD_INDIRECT_DELTA (code); - - irdata = ((char *)idata) + idesc[line].offset; - switch (idesc[line].type) - { - case XD_SIZE_T: - count = *(size_t *)irdata; - break; - case XD_INT: - count = *(int *)irdata; - break; - case XD_LONG: - count = *(long *)irdata; - break; - case XD_BYTECOUNT: - count = *(Bytecount *)irdata; - break; - default: - fprintf (stderr, "Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code); - pdump_backtrace (); - abort (); - } - count += delta; - return count; -} - -static void -pdump_register_sub (const void *data, const struct lrecord_description *desc, int me) -{ - int pos; - - restart: - for (pos = 0; desc[pos].type != XD_END; pos++) - { - const void *rdata = (const char *)data + desc[pos].offset; - - backtrace[me].position = pos; - backtrace[me].offset = desc[pos].offset; - - switch (desc[pos].type) - { - case XD_SPECIFIER_END: - pos = 0; - desc = ((const Lisp_Specifier *)data)->methods->extra_description; - goto restart; - case XD_SIZE_T: - case XD_INT: - case XD_LONG: - case XD_BYTECOUNT: - case XD_LO_RESET_NIL: - case XD_INT_RESET: - case XD_LO_LINK: - break; - case XD_OPAQUE_DATA_PTR: - { - EMACS_INT count = desc[pos].data1; - if (XD_IS_INDIRECT (count)) - count = pdump_get_indirect_count (count, desc, data); - - pdump_add_entry (&pdump_opaque_data_list, - *(void **)rdata, - count, - 1, - 0); - break; - } - case XD_C_STRING: - { - const char *str = *(const char **)rdata; - if (str) - pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0); - break; - } - case XD_DOC_STRING: - { - const char *str = *(const char **)rdata; - if ((EMACS_INT)str > 0) - pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0); - break; - } - case XD_LISP_OBJECT: - { - const Lisp_Object *pobj = (const Lisp_Object *)rdata; - - assert (desc[pos].data1 == 0); - - backtrace[me].offset = (const char *)pobj - (const char *)data; - pdump_register_object (*pobj); - break; - } - case XD_LISP_OBJECT_ARRAY: - { - int i; - EMACS_INT count = desc[pos].data1; - if (XD_IS_INDIRECT (count)) - count = pdump_get_indirect_count (count, desc, data); - - for (i = 0; i < count; i++) - { - const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i; - Lisp_Object dobj = *pobj; - - backtrace[me].offset = (const char *)pobj - (const char *)data; - pdump_register_object (dobj); - } - break; - } - case XD_STRUCT_PTR: - { - EMACS_INT count = desc[pos].data1; - const struct struct_description *sdesc = desc[pos].data2; - const char *dobj = *(const char **)rdata; - if (dobj) - { - if (XD_IS_INDIRECT (count)) - count = pdump_get_indirect_count (count, desc, data); - - pdump_register_struct (dobj, sdesc, count); - } - break; - } - default: - fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type); - pdump_backtrace (); - abort (); - }; - } -} - -static void -pdump_register_object (Lisp_Object obj) -{ - struct lrecord_header *objh; - - if (!POINTER_TYPE_P (XTYPE (obj))) - return; - - objh = XRECORD_LHEADER (obj); - if (!objh) - return; - - if (pdump_get_entry (objh)) - return; - - if (LHEADER_IMPLEMENTATION (objh)->description) - { - int me = depth++; - if (me>65536) - { - fprintf (stderr, "Backtrace overflow, loop ?\n"); - abort (); - } - backtrace[me].obj = objh; - backtrace[me].position = 0; - backtrace[me].offset = 0; - - pdump_add_entry (pdump_object_table + objh->type, - objh, - LHEADER_IMPLEMENTATION (objh)->static_size ? - LHEADER_IMPLEMENTATION (objh)->static_size : - LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh), - 1, - 1); - pdump_register_sub (objh, - LHEADER_IMPLEMENTATION (objh)->description, - me); - --depth; - } - else - { - pdump_alert_undump_object[objh->type]++; - fprintf (stderr, "Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name); - pdump_backtrace (); - } -} - -static void -pdump_register_struct (const void *data, const struct struct_description *sdesc, int count) -{ - if (data && !pdump_get_entry (data)) - { - int me = depth++; - int i; - if (me>65536) - { - fprintf (stderr, "Backtrace overflow, loop ?\n"); - abort (); - } - backtrace[me].obj = 0; - backtrace[me].position = 0; - backtrace[me].offset = 0; - - pdump_add_entry (pdump_get_entry_list (sdesc), - data, - sdesc->size, - count, - 0); - for (i=0; isize*i, - sdesc->description, - me); - } - --depth; - } -} - -static void -pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc) -{ - size_t size = elmt->size; - int count = elmt->count; - if (desc) - { - int pos, i; - memcpy (pdump_buf, elmt->obj, size*count); - - for (i=0; iobj))->methods->extra_description; - goto restart; - case XD_SIZE_T: - case XD_INT: - case XD_LONG: - case XD_BYTECOUNT: - break; - case XD_LO_RESET_NIL: - { - EMACS_INT count = desc[pos].data1; - int i; - if (XD_IS_INDIRECT (count)) - count = pdump_get_indirect_count (count, desc, elmt->obj); - for (i=0; isave_offset; - break; - } - case XD_INT_RESET: - { - EMACS_INT val = desc[pos].data1; - if (XD_IS_INDIRECT (val)) - val = pdump_get_indirect_count (val, desc, elmt->obj); - *(int *)rdata = val; - break; - } - case XD_OPAQUE_DATA_PTR: - case XD_C_STRING: - case XD_STRUCT_PTR: - { - void *ptr = *(void **)rdata; - if (ptr) - *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset; - break; - } - case XD_LO_LINK: - { - Lisp_Object obj = *(Lisp_Object *)rdata; - pdump_entry_list_elmt *elmt1; - for (;;) - { - elmt1 = pdump_get_entry (XRECORD_LHEADER (obj)); - if (elmt1) - break; - obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj))); - } - *(EMACS_INT *)rdata = elmt1->save_offset; - break; - } - case XD_LISP_OBJECT: - { - Lisp_Object *pobj = (Lisp_Object *) rdata; - - assert (desc[pos].data1 == 0); - - if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) - *(EMACS_INT *)pobj = - pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; - break; - } - case XD_LISP_OBJECT_ARRAY: - { - EMACS_INT count = desc[pos].data1; - int i; - if (XD_IS_INDIRECT (count)) - count = pdump_get_indirect_count (count, desc, elmt->obj); - - for (i=0; isave_offset; - } - break; - } - case XD_DOC_STRING: - { - EMACS_INT str = *(EMACS_INT *)rdata; - if (str > 0) - *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset; - break; - } - default: - fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type); - abort (); - }; - } - } - } - write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count); - if (elmt->is_lrecord && ((size*count) & 3)) - write (pdump_fd, "\0\0\0", 4-((size*count) & 3)); -} - -static void -pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc) -{ - int pos; - - restart: - for (pos = 0; desc[pos].type != XD_END; pos++) - { - void *rdata = (char *)data + desc[pos].offset; - switch (desc[pos].type) - { - case XD_SPECIFIER_END: - pos = 0; - desc = ((const Lisp_Specifier *)data)->methods->extra_description; - goto restart; - case XD_SIZE_T: - case XD_INT: - case XD_LONG: - case XD_BYTECOUNT: - case XD_INT_RESET: - break; - case XD_OPAQUE_DATA_PTR: - case XD_C_STRING: - case XD_STRUCT_PTR: - case XD_LO_LINK: - { - EMACS_INT ptr = *(EMACS_INT *)rdata; - if (ptr) - *(EMACS_INT *)rdata = ptr+delta; - break; - } - case XD_LISP_OBJECT: - { - Lisp_Object *pobj = (Lisp_Object *) rdata; - - assert (desc[pos].data1 == 0); - - if (POINTER_TYPE_P (XTYPE (*pobj)) - && ! EQ (*pobj, Qnull_pointer)) - XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta); - - break; - } - case XD_LISP_OBJECT_ARRAY: - case XD_LO_RESET_NIL: - { - EMACS_INT count = desc[pos].data1; - int i; - if (XD_IS_INDIRECT (count)) - count = pdump_get_indirect_count (count, desc, data); - - for (i=0; i 0) - *(EMACS_INT *)rdata = str + delta; - break; - } - default: - fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type); - abort (); - }; - } -} - -static void -pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc) -{ - size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count; - elmt->save_offset = cur_offset; - if (size>max_size) - max_size = size; - cur_offset += size; -} - -static void -pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *)) -{ - int align, i; - const struct lrecord_description *idesc; - pdump_entry_list_elmt *elmt; - for (align=8; align>=0; align--) - { - for (i=0; i<=last_lrecord_type_index_assigned; i++) - if (pdump_object_table[i].align == align) - { - elmt = pdump_object_table[i].first; - if (!elmt) - continue; - idesc = lrecord_implementations_table[i]->description; - while (elmt) - { - f (elmt, idesc); - elmt = elmt->next; - } - } - - for (i=0; idescription; - while (elmt) - { - f (elmt, idesc); - elmt = elmt->next; - } - } - - elmt = pdump_opaque_data_list.first; - while (elmt) - { - if (align_table[elmt->size & 255] == align) - f (elmt, 0); - elmt = elmt->next; - } - } -} - -static void -pdump_dump_staticvec (void) -{ - EMACS_INT *reloc = xnew_array (EMACS_INT, staticidx); - int i; - write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *)); - - for (i=0; isave_offset; - else - reloc[i] = *(EMACS_INT *)(staticvec[i]); - } - write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object)); - free (reloc); -} - -static void -pdump_dump_structvec (void) -{ - int i; - for (i=0; isave_offset; - write (pdump_fd, &adr, sizeof (adr)); - } -} - -static void -pdump_dump_opaquevec (void) -{ - int i; - for (i=0; idescription; - rt.count = pdump_object_table[i].count; - write (pdump_fd, &rt, sizeof (rt)); - while (elmt) - { - EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset; - write (pdump_fd, &rdata, sizeof (rdata)); - elmt = elmt->next; - } - } - - rt.desc = 0; - rt.count = 0; - write (pdump_fd, &rt, sizeof (rt)); - - for (i=0; idescription; - rt.count = pdump_struct_table.list[i].list.count; - write (pdump_fd, &rt, sizeof (rt)); - while (elmt) - { - EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset; - for (j=0; jcount; j++) - { - write (pdump_fd, &rdata, sizeof (rdata)); - rdata += elmt->size; - } - elmt = elmt->next; - } - } - rt.desc = 0; - rt.count = 0; - write (pdump_fd, &rt, sizeof (rt)); -} - -static void -pdump_dump_wired (void) -{ - EMACS_INT count = pdump_wireidx + pdump_wireidx_list; - int i; - - write (pdump_fd, &count, sizeof (count)); - - for (i=0; isave_offset; - write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i])); - write (pdump_fd, &obj, sizeof (obj)); - } - - for (i=0; idescription; - for (pos = 0; desc[pos].type != XD_LO_LINK; pos++) - if (desc[pos].type == XD_END) - abort (); - - obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj))); - } - res = elmt->save_offset; - - write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i])); - write (pdump_fd, &res, sizeof (res)); - } -} - -void -pdump (void) -{ - int i; - Lisp_Object t_console, t_device, t_frame; - int none; - dump_header hd; - - /* These appear in a DEFVAR_LISP, which does a staticpro() */ - t_console = Vterminal_console; - t_frame = Vterminal_frame; - t_device = Vterminal_device; - - Vterminal_console = Qnil; - Vterminal_frame = Qnil; - Vterminal_device = Qnil; - - pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE); - - for (i=0; i<=last_lrecord_type_index_assigned; i++) - { - pdump_object_table[i].first = 0; - pdump_object_table[i].align = 8; - pdump_object_table[i].count = 0; - pdump_alert_undump_object[i] = 0; - } - pdump_struct_table.count = 0; - pdump_struct_table.size = -1; - - pdump_opaque_data_list.first = 0; - pdump_opaque_data_list.align = 8; - pdump_opaque_data_list.count = 0; - depth = 0; - - for (i=0; iname, pdump_alert_undump_object[i]); - } - if (!none) - return; - - for (i=0; inb_staticpro; - last_lrecord_type_index_assigned = ((dump_header *)pdump_start)->last_type; - delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address; - p = pdump_start + ((dump_header *)pdump_start)->stab_offset; - - /* Put back the staticvec in place */ - memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *)); - p += staticidx*sizeof (Lisp_Object *); - for (i=0; inb_structdmp; i++) - { - void **adr = PDUMP_READ (p, void **); - *adr = (void *) (PDUMP_READ (p, char *) + delta); - } - - /* Put back the opaques */ - for (i=0; i<((dump_header *)pdump_start)->nb_opaquedmp; i++) - { - struct dumpopaque_info di = PDUMP_READ (p, struct dumpopaque_info); - memcpy (di.data, p, di.size); - p += di.size; - } - - /* Put back the lrecord_implementations_table */ - memcpy (lrecord_implementations_table, p, sizeof (lrecord_implementations_table)); - p += sizeof (lrecord_implementations_table); - - /* Reinitialize lrecord_markers from lrecord_implementations_table */ - for (i=0; i < countof (lrecord_implementations_table); i++) - if (lrecord_implementations_table[i]) - lrecord_markers[i] = lrecord_implementations_table[i]->marker; - - /* Do the relocations */ - pdump_rt_list = p; - count = 2; - for (;;) - { - pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table); - if (rt.desc) - { - for (i=0; i < rt.count; i++) - { - char *adr = delta + *(char **)p; - *(char **)p = adr; - pdump_reloc_one (adr, delta, rt.desc); - p += sizeof (char *); - } - } else - if (!(--count)) - break; - } - - /* Put the pdump_wire variables in place */ - count = PDUMP_READ (p, EMACS_INT); - - for (i=0; i