From 0ef81303fb6a0cb1b52e0e3483907eb4a02064a7 Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Thu, 13 Jun 2024 10:59:39 +0200 Subject: [PATCH 5/5] Remove the code that is now generated * src/igc.c: --- src/igc.c | 1824 ++++++----------------------------------------------- 1 file changed, 177 insertions(+), 1647 deletions(-) diff --git a/src/igc.c b/src/igc.c index 41d99419dbd..7d16449d6a7 100644 --- a/src/igc.c +++ b/src/igc.c @@ -745,78 +745,6 @@ scan_staticvec (mps_ss_t ss, void *start, void *end, void *closure) return MPS_RES_OK; } -#if 0 -static mps_res_t -fix_fwd (mps_ss_t ss, lispfwd fwd) -{ - MPS_SCAN_BEGIN (ss) - { - switch (XFWDTYPE (fwd)) - { - case Lisp_Fwd_Int: - case Lisp_Fwd_Bool: - case Lisp_Fwd_Kboard_Obj: - break; - - case Lisp_Fwd_Obj: - { - /* It is not guaranteed that we see all of these when - scanning staticvec because of DEFVAR_LISP_NOPRO. */ - struct Lisp_Objfwd *o = (void *) fwd.fwdptr; - IGC_FIX12_OBJ (ss, o->objvar); - } - break; - - case Lisp_Fwd_Buffer_Obj: - { - struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr; - IGC_FIX12_OBJ (ss, &b->predicate); - } - break; - } - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_OBJ (ss, &sym->u.s.name); - IGC_FIX12_OBJ (ss, &sym->u.s.function); - IGC_FIX12_OBJ (ss, &sym->u.s.plist); -#ifdef IN_MY_FORK - IGC_FIX12_OBJ (ss, &sym->u.s.package); -#else - IGC_FIX12_RAW (ss, &sym->u.s.next); -#endif - switch (sym->u.s.redirect) - { - case SYMBOL_PLAINVAL: - IGC_FIX12_OBJ (ss, &sym->u.s.val.value); - break; - - case SYMBOL_VARALIAS: - IGC_FIX12_RAW (ss, &sym->u.s.val.alias); - break; - - case SYMBOL_LOCALIZED: - IGC_FIX12_RAW (ss, &sym->u.s.val.blv); - break; - - case SYMBOL_FORWARDED: - IGC_FIX_CALL (ss, fix_fwd (ss, sym->u.s.val.fwd)); - break; - } - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif /* This exists because we need access to a threads' current specpdl pointer, which means we need access to the thread_state, which can @@ -1306,1055 +1234,221 @@ dflt_skip (mps_addr_t base_addr) return next; } -#if 0 static mps_res_t -fix_string (mps_ss_t ss, struct Lisp_String *s) +dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, + void *closure) { MPS_SCAN_BEGIN (ss) { - IGC_FIX12_RAW (ss, &s->u.s.data); - IGC_FIX12_RAW (ss, &s->u.s.intervals); + mps_addr_t base = base_start; + mps_addr_t client = base_to_client (base); + struct igc_header *header = base; + + if (closure) + { + struct igc_stats *st = closure; + mps_word_t obj_type = header->obj_type; + igc_assert (obj_type < IGC_OBJ_NUM_TYPES); + st->obj[obj_type].nbytes += header_nbytes (header); + st->obj[obj_type].nobjs += 1; + if (obj_type == IGC_OBJ_VECTOR) + { + struct Lisp_Vector *v = (struct Lisp_Vector *)client; + enum pvec_type pvec_type = pseudo_vector_type (v->header); + igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX); + st->pvec[pvec_type].nbytes += header_nbytes (header); + st->pvec[pvec_type].nobjs += 1; + } + } + + IGC_FIX_CALL (ss, dflt_scan_object (ss, base)); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 static mps_res_t -fix_interval (mps_ss_t ss, struct interval *iv) +dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, + void *closure) { MPS_SCAN_BEGIN (ss) { - IGC_FIX12_RAW (ss, &iv->left); - IGC_FIX12_RAW (ss, &iv->right); - if (iv->up_obj) - IGC_FIX12_OBJ (ss, &iv->up.obj); - else if (iv->up.interval) - IGC_FIX12_RAW (ss, &iv->up.interval); - IGC_FIX12_OBJ (ss, &iv->plist); + for (mps_addr_t base = base_start; base < base_limit; + base = dflt_skip (base)) + IGC_FIX_CALL (ss, dflt_scanx_obj (ss, base, base_limit, closure)); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 static mps_res_t -fix_itree_tree (mps_ss_t ss, struct itree_tree *t) +dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit) { MPS_SCAN_BEGIN (ss) { - if (t->root) - IGC_FIX12_RAW (ss, &t->root); + for (mps_addr_t base = base_start; base < base_limit; + base = dflt_skip (base)) + IGC_FIX_CALL (ss, dflt_scan_object (ss, base)); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 +/* This is here because main_thread is, for some reason, a variable in + the data segment, and not like other threads. */ + static mps_res_t -fix_itree_node (mps_ss_t ss, struct itree_node *n) +scan_main_thread (mps_ss_t ss, void *start, void *end, void *closure) { + igc_assert (start == (void *) &main_thread); MPS_SCAN_BEGIN (ss) { - if (n->parent) - IGC_FIX12_RAW (ss, &n->parent); - if (n->left) - IGC_FIX12_RAW (ss, &n->left); - if (n->right) - IGC_FIX12_RAW (ss, &n->right); - IGC_FIX12_OBJ (ss, &n->data); + struct thread_state *s = start; + IGC_FIX_CALL (ss, fix_thread (ss, s)); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 +#ifdef HAVE_XWIDGETS + static mps_res_t -fix_image (mps_ss_t ss, struct image *i) +fix_xwidget (mps_ss_t ss, struct xwidget *w) { MPS_SCAN_BEGIN (ss) { -#ifdef HAVE_WINDOW_SYSTEM - IGC_FIX12_OBJ (ss, &i->spec); - IGC_FIX12_OBJ (ss, &i->dependencies); - IGC_FIX12_OBJ (ss, &i->lisp_data); - IGC_FIX12_RAW (ss, &i->next); - IGC_FIX12_RAW (ss, &i->prev); -#endif + IGC_FIX_CALL_FN (ss, struct Lisp_Vector, w, fix_vectorlike); + igc_assert (!"xwidget"); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 static mps_res_t -fix_image_cache (mps_ss_t ss, struct image_cache *c) +fix_xwidget_view (mps_ss_t ss, struct xwidget_view *v) { MPS_SCAN_BEGIN (ss) { -#ifdef HAVE_WINDOW_SYSTEM - IGC_FIX12_RAW (ss, &c->images); - IGC_FIX12_RAW (ss, &c->buckets); -#endif + IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike); + igc_assert (!"xwidget_view"); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 -static mps_res_t -fix_face (mps_ss_t ss, struct face *f) +#endif // HAVE_XWIDGETS + +static igc_scan_result_t +scan_cell_callback (struct igc_opaque *op, Lisp_Object *addr) { + mps_ss_t ss = (mps_ss_t)op; MPS_SCAN_BEGIN (ss) { - IGC_FIX12_NOBJS (ss, f->lface, ARRAYELTS (f->lface)); - IGC_FIX12_RAW (ss, &f->font); - IGC_FIX12_RAW (ss, &f->next); - IGC_FIX12_RAW (ss, &f->prev); - IGC_FIX12_RAW (ss, &f->ascii_face); -#if defined HAVE_XFT || defined HAVE_FREETYPE - IGC_FIX12_RAW (ss, &f->extra); -#endif + IGC_FIX12_OBJ (ss, addr); } MPS_SCAN_END (ss); return MPS_RES_OK; } -#endif -#if 0 -static mps_res_t -fix_face_cache (mps_ss_t ss, struct face_cache *c) +#pragma GCC diagnostic pop + +static igc_root_list * +root_create (struct igc *gc, void *start, void *end, mps_rank_t rank, + mps_area_scan_t scan, void *closure, bool ambig) { - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_RAW (ss, &c->f); - IGC_FIX12_RAW (ss, &c->faces_by_id); - IGC_FIX12_RAW (ss, &c->buckets); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; + mps_root_t root; + mps_res_t res + = mps_root_create_area (&root, gc->arena, rank, 0, start, end, scan, + closure); + IGC_CHECK_RES (res); + return register_root (gc, root, start, end, ambig); } -#endif -#if 0 -static mps_res_t -fix_ptr_vec (mps_ss_t ss, void *client) +static igc_root_list * +root_create_ambig (struct igc *gc, void *start, void *end) { - MPS_SCAN_BEGIN (ss) - { - void **v = client; - size_t n = object_nelems (client, sizeof *v); - for (size_t i = 0; i < n; ++i) - IGC_FIX12_RAW (ss, &v[i]); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; + return root_create (gc, start, end, mps_rank_ambig (), scan_ambig, NULL, + true); } -#endif -#if 0 -static mps_res_t -fix_obj_vec (mps_ss_t ss, Lisp_Object *v) +static igc_root_list * +root_create_exact (struct igc *gc, void *start, void *end, + mps_area_scan_t scan) { - MPS_SCAN_BEGIN (ss) - { - size_t n = object_nelems (v, sizeof *v); - for (size_t i = 0; i < n; ++i) - IGC_FIX12_OBJ (ss, &v[i]); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; + return root_create (gc, start, end, mps_rank_exact (), scan, NULL, false); } -#endif -#if 0 -static mps_res_t -fix_cons (mps_ss_t ss, struct Lisp_Cons *cons) +static void +root_create_staticvec (struct igc *gc) { - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_OBJ (ss, &cons->u.s.car); - IGC_FIX12_OBJ (ss, &cons->u.s.u.cdr); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; + root_create_exact (gc, staticvec, staticvec + ARRAYELTS (staticvec), + scan_staticvec); } -#endif -#if 0 -static mps_res_t -fix_blv (mps_ss_t ss, struct Lisp_Buffer_Local_Value *blv) +static void +root_create_lispsym (struct igc *gc) { - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_OBJ (ss, &blv->where); - IGC_FIX12_OBJ (ss, &blv->defcell); - IGC_FIX12_OBJ (ss, &blv->valcell); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; + root_create_exact (gc, lispsym, lispsym + ARRAYELTS (lispsym), scan_lispsym); } -#endif -#if 0 -static mps_res_t -fix_handler (mps_ss_t ss, struct handler *h) +static void +root_create_buffer (struct igc *gc, struct buffer *b) { - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_OBJ (ss, &h->tag_or_ch); - IGC_FIX12_OBJ (ss, &h->val); - IGC_FIX12_RAW (ss, &h->next); - IGC_FIX12_RAW (ss, &h->nextfree); - // FIXME: What about bytecode_top? - } - MPS_SCAN_END (ss); - return MPS_RES_OK; + void *start = &b->name_, *end = &b->own_text; + root_create_ambig (gc, start, end); } -#endif - -#if 0 -static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v); -#endif -#if 0 -static mps_res_t -dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, - void *closure) +static void +root_create_terminal_list (struct igc *gc) { - MPS_SCAN_BEGIN (ss) - { - mps_addr_t base = base_start; - mps_addr_t client = base_to_client (base); - struct igc_header *header = base; + void *start = &terminal_list; + void *end = (char *) start + sizeof (terminal_list); + root_create_ambig (gc, start, end); +} - if (closure) - { - struct igc_stats *st = closure; - mps_word_t obj_type = header->obj_type; - igc_assert (obj_type < IGC_OBJ_NUM_TYPES); - st->obj[obj_type].nbytes += header_nbytes (header); - st->obj[obj_type].nobjs += 1; - if (obj_type == IGC_OBJ_VECTOR) - { - struct Lisp_Vector* v = (struct Lisp_Vector*) client; - enum pvec_type pvec_type = pseudo_vector_type (v); - igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX); - st->pvec[pvec_type].nbytes += header_nbytes (header); - st->pvec[pvec_type].nobjs += 1; - } - } +static void +root_create_main_thread (struct igc *gc) +{ + void *start = &main_thread; + void *end = (char *) &main_thread + sizeof (main_thread); + root_create_exact (gc, start, end, scan_main_thread); +} - switch (header->obj_type) - { - case IGC_OBJ_INVALID: - case IGC_OBJ_BUILTIN_SYMBOL: - case IGC_OBJ_BUILTIN_THREAD: - case IGC_OBJ_BUILTIN_SUBR: - emacs_abort (); - - case IGC_OBJ_PAD: - case IGC_OBJ_FWD: - continue; +void +igc_root_create_ambig (void *start, void *end) +{ + root_create_ambig (global_igc, start, end); +} - case IGC_OBJ_HANDLER: - IGC_FIX_CALL_FN (ss, struct handler, client, fix_handler); - break; +void +igc_root_create_exact (Lisp_Object *start, Lisp_Object *end) +{ + root_create_exact (global_igc, start, end, scan_exact); +} - case IGC_OBJ_PTR_VEC: - IGC_FIX_CALL_FN (ss, void *, client, fix_ptr_vec); - break; +void +igc_root_create_exact_ptr (void *var_addr) +{ + void *start = var_addr; + void *end = (char *) start + sizeof (void *); + root_create_exact (global_igc, start, end, scan_ptr_exact); +} - case IGC_OBJ_OBJ_VEC: - case IGC_OBJ_HASH_VEC: - IGC_FIX_CALL_FN (ss, Lisp_Object, client, fix_obj_vec); - break; - - case IGC_OBJ_CONS: - IGC_FIX_CALL_FN (ss, struct Lisp_Cons, client, fix_cons); - break; - - case IGC_OBJ_STRING_DATA: - case IGC_OBJ_FLOAT: - case IGC_OBJ_BYTES: - /* Can occur in the dump. */ - break; - - case IGC_OBJ_NUM_TYPES: - emacs_abort (); - - case IGC_OBJ_SYMBOL: - IGC_FIX_CALL_FN (ss, struct Lisp_Symbol, client, fix_symbol); - break; - - case IGC_OBJ_INTERVAL: - IGC_FIX_CALL_FN (ss, struct interval, client, fix_interval); - break; - - case IGC_OBJ_STRING: - IGC_FIX_CALL_FN (ss, struct Lisp_String, client, fix_string); - break; - - case IGC_OBJ_VECTOR: - case IGC_OBJ_VECTOR_WEAK: - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, client, fix_vector); - break; - - case IGC_OBJ_ITREE_TREE: - IGC_FIX_CALL_FN (ss, struct itree_tree, client, fix_itree_tree); - break; - - case IGC_OBJ_ITREE_NODE: - IGC_FIX_CALL_FN (ss, struct itree_node, client, fix_itree_node); - break; - - case IGC_OBJ_IMAGE: - IGC_FIX_CALL_FN (ss, struct image, client, fix_image); - break; - - case IGC_OBJ_IMAGE_CACHE: - IGC_FIX_CALL_FN (ss, struct image_cache, client, fix_image_cache); - break; - - case IGC_OBJ_FACE: - IGC_FIX_CALL_FN (ss, struct face, client, fix_face); - break; - - case IGC_OBJ_FACE_CACHE: - IGC_FIX_CALL_FN (ss, struct face_cache, client, fix_face_cache); - break; - - case IGC_OBJ_BLV: - IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client, fix_blv); - break; - } - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -static mps_res_t -dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, - void *closure) -{ - MPS_SCAN_BEGIN (ss) - { - mps_addr_t base = base_start; - mps_addr_t client = base_to_client (base); - struct igc_header *header = base; - - if (closure) - { - struct igc_stats *st = closure; - mps_word_t obj_type = header->obj_type; - igc_assert (obj_type < IGC_OBJ_NUM_TYPES); - st->obj[obj_type].nbytes += header_nbytes (header); - st->obj[obj_type].nobjs += 1; - if (obj_type == IGC_OBJ_VECTOR) - { - struct Lisp_Vector *v = (struct Lisp_Vector *)client; - enum pvec_type pvec_type = pseudo_vector_type (v->header); - igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX); - st->pvec[pvec_type].nbytes += header_nbytes (header); - st->pvec[pvec_type].nobjs += 1; - } - } - - IGC_FIX_CALL (ss, dflt_scan_object (ss, base)); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -static mps_res_t -dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, - void *closure) -{ - MPS_SCAN_BEGIN (ss) - { - for (mps_addr_t base = base_start; base < base_limit; - base = dflt_skip (base)) - IGC_FIX_CALL (ss, dflt_scanx_obj (ss, base, base_limit, closure)); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -static mps_res_t -dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit) -{ - MPS_SCAN_BEGIN (ss) - { - for (mps_addr_t base = base_start; base < base_limit; - base = dflt_skip (base)) - IGC_FIX_CALL (ss, dflt_scan_object (ss, base)); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -#if 0 -static mps_res_t -fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v) -{ - MPS_SCAN_BEGIN (ss) - { - size_t size = vector_size (v); - IGC_FIX12_NOBJS (ss, v->contents, size); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_buffer (mps_ss_t ss, struct buffer *b) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, b, fix_vectorlike); - IGC_FIX12_RAW (ss, &b->own_text.intervals); - IGC_FIX12_OBJ (ss, &b->own_text.markers); - IGC_FIX12_RAW (ss, &b->overlays); - - IGC_FIX12_RAW (ss, &b->base_buffer); - if (b->base_buffer) - b->text = &b->base_buffer->own_text; - else - b->text = &b->own_text; - - // FIXME: special handling of undo_list? - IGC_FIX12_OBJ (ss, &b->undo_list_); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_frame (mps_ss_t ss, struct frame *f) -{ - MPS_SCAN_BEGIN (ss) - { - // FIXME - // output_data; - // terminal - // glyph_pool - // glyph matrices - // struct font_driver_list *font_driver_list; - // struct text_conversion_state conversion; - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, f, fix_vectorlike); - IGC_FIX12_RAW (ss, &f->face_cache); - if (f->terminal) - IGC_FIX12_RAW (ss, &f->terminal); - IGC_FIX_CALL_FN (ss, struct frame, f, fix_frame_quirks); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_window (mps_ss_t ss, struct window *w) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, w, fix_vectorlike); - if (w->current_matrix) - IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->current_matrix)); - if (w->desired_matrix) - IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->desired_matrix)); - - /* FIXME: The following two are handled specially in the old GC: - Both are lists from which entries for non-live buffers are - removed (mark_window -> mark_discard_killed_buffers). - So, they are kind of weak lists. I think this could be done - from a timer. */ - IGC_FIX12_OBJ (ss, &w->prev_buffers); - IGC_FIX12_OBJ (ss, &w->next_buffers); - -#ifdef HAVE_NS - void *pr[4]; - int n = ns_emacs_scroller_refs (w, pr, ARRAYELTS (pr)); - for (int i = 0; i < n; ++i) - IGC_FIX12_RAW (ss, pr[i]); -#endif - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h) -{ - MPS_SCAN_BEGIN (ss) - { - // FIXME: weak - IGC_FIX12_RAW (ss, &h->key); - IGC_FIX12_RAW (ss, &h->value); - IGC_FIX12_RAW (ss, &h->hash); - IGC_FIX12_RAW (ss, &h->next); - IGC_FIX12_RAW (ss, &h->index); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_char_table (mps_ss_t ss, struct Lisp_Char_Table *v) -{ - MPS_SCAN_BEGIN (ss) - { - for (size_t i = vector_start (v), n = vector_size (v); i < n; ++i) - IGC_FIX12_OBJ (ss, &v->contents[i]); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_sub_char_table (mps_ss_t ss, struct Lisp_Sub_Char_Table *v) -{ - MPS_SCAN_BEGIN (ss) - { - int size = v->header.size & PSEUDOVECTOR_SIZE_MASK; - IGC_FIX12_NOBJS (ss, v->contents, size - SUB_CHAR_TABLE_OFFSET); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_overlay (mps_ss_t ss, struct Lisp_Overlay *o) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_RAW (ss, &o->buffer); - IGC_FIX12_OBJ (ss, &o->plist); - IGC_FIX12_RAW (ss, &o->interval); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_subr (mps_ss_t ss, struct Lisp_Subr *s) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_OBJ (ss, &s->command_modes); -#ifdef HAVE_NATIVE_COMP - IGC_FIX12_OBJ (ss, &s->intspec.native); - IGC_FIX12_OBJ (ss, &s->command_modes); - IGC_FIX12_OBJ (ss, &s->native_comp_u); - IGC_FIX12_OBJ (ss, &s->lambda_list); - IGC_FIX12_OBJ (ss, &s->type); -#endif - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_misc_ptr (mps_ss_t ss, struct Lisp_Misc_Ptr *p) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, p, fix_vectorlike); - IGC_FIX12_RAW (ss, &p->pointer); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_user_ptr (mps_ss_t ss, struct Lisp_User_Ptr *p) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, p, fix_vectorlike); - IGC_FIX12_RAW (ss, &p->p); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_thread (mps_ss_t ss, struct thread_state *s) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, s, fix_vectorlike); - IGC_FIX12_RAW (ss, &s->m_current_buffer); - IGC_FIX12_RAW (ss, &s->next_thread); - IGC_FIX12_RAW (ss, &s->m_handlerlist); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -/* This is here because main_thread is, for some reason, a variable in - the data segment, and not like other threads. */ - -static mps_res_t -scan_main_thread (mps_ss_t ss, void *start, void *end, void *closure) -{ - igc_assert (start == (void *) &main_thread); - MPS_SCAN_BEGIN (ss) - { - struct thread_state *s = start; - IGC_FIX_CALL (ss, fix_thread (ss, s)); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -#if 0 -static mps_res_t -fix_mutex (mps_ss_t ss, struct Lisp_Mutex *m) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, m, fix_vectorlike); - IGC_FIX12_RAW (ss, &m->name); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_terminal (mps_ss_t ss, struct terminal *t) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, t, fix_vectorlike); - IGC_FIX12_RAW (ss, &t->next_terminal); -#ifdef HAVE_WINDOW_SYSTEM - IGC_FIX12_RAW (ss, &t->image_cache); -#endif - // These are malloc'd, so they can be accessed. - IGC_FIX_CALL_FN (ss, struct coding_system, t->keyboard_coding, fix_coding); - IGC_FIX_CALL_FN (ss, struct coding_system, t->terminal_coding, fix_coding); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_marker (mps_ss_t ss, struct Lisp_Marker *m) -{ - MPS_SCAN_BEGIN (ss) - { - if (m->buffer) - IGC_FIX12_RAW (ss, &m->buffer); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, f, fix_vectorlike); - IGC_FIX12_RAW (ss, &f->next); - IGC_FIX12_RAW (ss, &f->prev); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#if 0 -static mps_res_t -fix_comp_unit (mps_ss_t ss, struct Lisp_Native_Comp_Unit *u) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, u, fix_vectorlike); - /* FIXME: Cannot scan things within the shared object because we - don't have exclusive (synchronized) access to them. Instead of - storing Lisp_Object references in vectors in the dylib data - segment it would be much nicer to store them in MPS and give - the dylib a pointer to them. */ - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -#ifdef HAVE_XWIDGETS - -static mps_res_t -fix_xwidget (mps_ss_t ss, struct xwidget *w) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, w, fix_vectorlike); - igc_assert (!"xwidget"); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -static mps_res_t -fix_xwidget_view (mps_ss_t ss, struct xwidget_view *v) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike); - igc_assert (!"xwidget_view"); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -#endif // HAVE_XWIDGETS - -#ifdef HAVE_MODULES -#if 0 -static mps_res_t -fix_global_ref (mps_ss_t ss, struct module_global_reference *r) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, r, fix_vectorlike); - IGC_FIX12_OBJ (ss, &r->value.v); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif -#endif - -#ifndef IN_MY_FORK -#if 0 -static mps_res_t -fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_RAW (ss, &o->buckets); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif -#endif - -#if 0 -static mps_res_t -fix_font (mps_ss_t ss, struct Lisp_Vector *v) -{ - MPS_SCAN_BEGIN (ss) - { - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike); - /* See font.h for the magic numbers. */ - switch (vector_size (v)) - { - case FONT_SPEC_MAX: - case FONT_ENTITY_MAX: - break; - case FONT_OBJECT_MAX: - { - struct font *f = (struct font *)v; - const Lisp_Object *type = &f->driver->type; - IGC_FIX12_OBJ (ss, igc_const_cast (Lisp_Object *, type)); - } - break; - default: - emacs_abort (); - } - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -/* Note that there is a small window after committing a vectorlike - allocation where the object is zeroed, and so the vector header is - also zero. This doesn't have an adverse effect. */ - -#if 0 -static mps_res_t -fix_vector (mps_ss_t ss, struct Lisp_Vector *v) -{ - MPS_SCAN_BEGIN (ss) - { - switch (pseudo_vector_type (v->header)) - { -#ifndef IN_MY_FORK - case PVEC_OBARRAY: - IGC_FIX_CALL_FN (ss, struct Lisp_Obarray, v, fix_obarray); - break; -#endif - - case PVEC_BUFFER: - IGC_FIX_CALL_FN (ss, struct buffer, v, fix_buffer); - break; - - case PVEC_FRAME: - IGC_FIX_CALL_FN (ss, struct frame, v, fix_frame); - break; - - case PVEC_WINDOW: - IGC_FIX_CALL_FN (ss, struct window, v, fix_window); - break; - - case PVEC_HASH_TABLE: - IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table); - break; - - case PVEC_CHAR_TABLE: - IGC_FIX_CALL_FN (ss, struct Lisp_Char_Table, v, fix_char_table); - break; - - case PVEC_SUB_CHAR_TABLE: - IGC_FIX_CALL_FN (ss, struct Lisp_Sub_Char_Table, v, - fix_sub_char_table); - break; - - case PVEC_BOOL_VECTOR: - break; - - case PVEC_OVERLAY: - IGC_FIX_CALL_FN (ss, struct Lisp_Overlay, v, fix_overlay); - break; - - case PVEC_SUBR: - IGC_FIX_CALL_FN (ss, struct Lisp_Subr, v, fix_subr); - break; - - case PVEC_FREE: - emacs_abort (); - - case PVEC_FINALIZER: - IGC_FIX_CALL_FN (ss, struct Lisp_Finalizer, v, fix_finalizer); - break; - - case PVEC_MISC_PTR: - IGC_FIX_CALL_FN (ss, struct Lisp_Misc_Ptr, v, fix_misc_ptr); - break; - - case PVEC_USER_PTR: - IGC_FIX_CALL_FN (ss, struct Lisp_User_Ptr, v, fix_user_ptr); - break; - -#ifdef HAVE_XWIDGETS - case PVEC_XWIDGET: - IGC_FIX_CALL_FN (ss, struct xwidget, v, fix_xwidget); - break; - - case PVEC_XWIDGET_VIEW: - IGC_FIX_CALL_FN (ss, struct xwidget_view, v, fix_xwidget_view); - break; -#endif - - case PVEC_THREAD: - IGC_FIX_CALL_FN (ss, struct thread_state, v, fix_thread); - break; - - case PVEC_MUTEX: - IGC_FIX_CALL_FN (ss, struct Lisp_Mutex, v, fix_mutex); - break; - - case PVEC_TERMINAL: - IGC_FIX_CALL_FN (ss, struct terminal, v, fix_terminal); - break; - - case PVEC_MARKER: - IGC_FIX_CALL_FN (ss, struct Lisp_Marker, v, fix_marker); - break; - - case PVEC_BIGNUM: - break; - - case PVEC_NATIVE_COMP_UNIT: - IGC_FIX_CALL_FN (ss, struct Lisp_Native_Comp_Unit, v, fix_comp_unit); - break; - - case PVEC_MODULE_GLOBAL_REFERENCE: -#ifdef HAVE_MODULES - IGC_FIX_CALL_FN (ss, struct module_global_reference, v, fix_global_ref); -#endif - break; - - case PVEC_FONT: - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_font); - break; - - case PVEC_NORMAL_VECTOR: - case PVEC_SYMBOL_WITH_POS: - case PVEC_PROCESS: - case PVEC_WINDOW_CONFIGURATION: - case PVEC_XWIDGET: - case PVEC_XWIDGET_VIEW: - case PVEC_MODULE_FUNCTION: - case PVEC_CONDVAR: - case PVEC_TS_COMPILED_QUERY: - case PVEC_TS_NODE: - case PVEC_TS_PARSER: - case PVEC_SQLITE: - case PVEC_CLOSURE: - case PVEC_RECORD: - case PVEC_OTHER: -#ifdef IN_MY_FORK - case PVEC_PACKAGE: -#endif - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike); - break; - } - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} -#endif - -static igc_scan_result_t -scan_cell_callback (struct igc_opaque *op, Lisp_Object *addr) -{ - mps_ss_t ss = (mps_ss_t)op; - MPS_SCAN_BEGIN (ss) - { - IGC_FIX12_OBJ (ss, addr); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - -#pragma GCC diagnostic pop - -static igc_root_list * -root_create (struct igc *gc, void *start, void *end, mps_rank_t rank, - mps_area_scan_t scan, void *closure, bool ambig) -{ - mps_root_t root; - mps_res_t res - = mps_root_create_area (&root, gc->arena, rank, 0, start, end, scan, - closure); - IGC_CHECK_RES (res); - return register_root (gc, root, start, end, ambig); -} - -static igc_root_list * -root_create_ambig (struct igc *gc, void *start, void *end) -{ - return root_create (gc, start, end, mps_rank_ambig (), scan_ambig, NULL, - true); -} - -static igc_root_list * -root_create_exact (struct igc *gc, void *start, void *end, - mps_area_scan_t scan) -{ - return root_create (gc, start, end, mps_rank_exact (), scan, NULL, false); -} - -static void -root_create_staticvec (struct igc *gc) -{ - root_create_exact (gc, staticvec, staticvec + ARRAYELTS (staticvec), - scan_staticvec); -} - -static void -root_create_lispsym (struct igc *gc) -{ - root_create_exact (gc, lispsym, lispsym + ARRAYELTS (lispsym), scan_lispsym); -} - -static void -root_create_buffer (struct igc *gc, struct buffer *b) -{ - void *start = &b->name_, *end = &b->own_text; - root_create_ambig (gc, start, end); -} - -static void -root_create_terminal_list (struct igc *gc) -{ - void *start = &terminal_list; - void *end = (char *) start + sizeof (terminal_list); - root_create_ambig (gc, start, end); -} - -static void -root_create_main_thread (struct igc *gc) -{ - void *start = &main_thread; - void *end = (char *) &main_thread + sizeof (main_thread); - root_create_exact (gc, start, end, scan_main_thread); -} - -void -igc_root_create_ambig (void *start, void *end) -{ - root_create_ambig (global_igc, start, end); -} - -void -igc_root_create_exact (Lisp_Object *start, Lisp_Object *end) -{ - root_create_exact (global_igc, start, end, scan_exact); -} - -void -igc_root_create_exact_ptr (void *var_addr) -{ - void *start = var_addr; - void *end = (char *) start + sizeof (void *); - root_create_exact (global_igc, start, end, scan_ptr_exact); -} - -static void -root_create_specpdl (struct igc_thread_list *t) -{ - struct igc *gc = t->d.gc; - struct thread_state *ts = t->d.ts; - igc_assert (ts->m_specpdl != NULL); - igc_assert (t->d.specpdl_root == NULL); - mps_root_t root; - mps_res_t res - = mps_root_create_area (&root, gc->arena, mps_rank_exact (), 0, - ts->m_specpdl, ts->m_specpdl_end, scan_specpdl, t); - IGC_CHECK_RES (res); - t->d.specpdl_root - = register_root (gc, root, ts->m_specpdl, ts->m_specpdl_end, false); -} +static void +root_create_specpdl (struct igc_thread_list *t) +{ + struct igc *gc = t->d.gc; + struct thread_state *ts = t->d.ts; + igc_assert (ts->m_specpdl != NULL); + igc_assert (t->d.specpdl_root == NULL); + mps_root_t root; + mps_res_t res + = mps_root_create_area (&root, gc->arena, mps_rank_exact (), 0, + ts->m_specpdl, ts->m_specpdl_end, scan_specpdl, t); + IGC_CHECK_RES (res); + t->d.specpdl_root + = register_root (gc, root, ts->m_specpdl, ts->m_specpdl_end, false); +} static void root_create_bc (struct igc_thread_list *t) @@ -4146,430 +3240,81 @@ mirror_lisp_obj (struct igc_mirror *m, Lisp_Object *pobj) { mps_addr_t base = client_to_base (client); mps_addr_t mirror = lookup_copy (m, base); - igc_assert (mirror != NULL); - client = base_to_client (mirror); - *p = (mps_word_t) client | tag; - } - } -} - -static void -mirror_raw (struct igc_mirror *m, mps_addr_t *p) -{ - mps_addr_t client = *p; - if (pdumper_object_p (client)) - { - mps_addr_t base = client_to_base (client); - mps_addr_t mirror = lookup_copy (m, base); - igc_assert (mirror != NULL); - *p = base_to_client (mirror); - } -} - -#define IGC_MIRROR_OBJ(m, obj) mirror_lisp_obj ((m), (obj)) -#define IGC_MIRROR_RAW(m, pp) mirror_raw ((m), (mps_addr_t *) (pp)) - -static void -mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n) -{ - for (size_t i = 0; i < n; ++i) - IGC_MIRROR_OBJ (m, &array[i]); -} - -static void -mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n) -{ - for (size_t i = 0; i < n; ++i) - mirror_raw (m, &array[i]); -} - -#define IGC_MIRROR_NOBJS(m, a, n) mirror_nobj (m, a, n) - -static void -mirror_fwd (struct igc_mirror *m, lispfwd fwd) -{ - switch (XFWDTYPE (fwd)) - { - case Lisp_Fwd_Int: - case Lisp_Fwd_Bool: - case Lisp_Fwd_Kboard_Obj: - break; - - case Lisp_Fwd_Obj: - { - struct Lisp_Objfwd *o = (void *) fwd.fwdptr; - IGC_MIRROR_OBJ (m, o->objvar); - } - break; - - case Lisp_Fwd_Buffer_Obj: - { - struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr; - IGC_MIRROR_OBJ (m, &b->predicate); - } - break; - } -} - -#if 0 -static void -mirror_symbol (struct igc_mirror *m, struct Lisp_Symbol *sym) -{ - IGC_MIRROR_OBJ (m, &sym->u.s.name); - IGC_MIRROR_OBJ (m, &sym->u.s.function); - IGC_MIRROR_OBJ (m, &sym->u.s.plist); -#ifdef IN_MY_FORK - IGC_MIRROR_OBJ (m, &sym->u.s.package); -#else - IGC_MIRROR_RAW (m, &sym->u.s.next); -#endif - switch (sym->u.s.redirect) - { - case SYMBOL_PLAINVAL: - IGC_MIRROR_OBJ (m, &sym->u.s.val.value); - break; - - case SYMBOL_VARALIAS: - IGC_MIRROR_RAW (m, &sym->u.s.val.alias); - break; - - case SYMBOL_LOCALIZED: - IGC_MIRROR_RAW (m, &sym->u.s.val.blv); - break; - - case SYMBOL_FORWARDED: - mirror_fwd (m, sym->u.s.val.fwd); - break; - } -} -#endif - -#if 0 -static void -mirror_string (struct igc_mirror *m, struct Lisp_String *s) -{ - IGC_MIRROR_RAW (m, &s->u.s.data); - IGC_MIRROR_RAW (m, &s->u.s.intervals); -} -#endif - -#if 0 -static void -mirror_interval (struct igc_mirror *m, struct interval *i) -{ - IGC_MIRROR_RAW (m, &i->left); - IGC_MIRROR_RAW (m, &i->right); - if (i->up_obj) - IGC_MIRROR_OBJ (m, &i->up.obj); - else if (i->up.interval) - IGC_MIRROR_RAW (m, &i->up.interval); - IGC_MIRROR_OBJ (m, &i->plist); -} -#endif - -#if 0 -static void -mirror_itree_tree (struct igc_mirror *m, struct itree_tree *t) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_itree_node (struct igc_mirror *m, struct itree_node *n) -{ - if (n->parent) - IGC_MIRROR_RAW (m, &n->parent); - if (n->left) - IGC_MIRROR_RAW (m, &n->left); - if (n->right) - IGC_MIRROR_RAW (m, &n->right); - IGC_MIRROR_OBJ (m, &n->data); -} -#endif - -#if 0 -static void -mirror_image (struct igc_mirror *m, struct image *i) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_image_cache (struct igc_mirror *m, struct image_cache *c) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_face (struct igc_mirror *m, struct face *f) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_face_cache (struct igc_mirror *m, struct face_cache *c) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_ptr_vec (struct igc_mirror *m, void *p) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_obj_vec (struct igc_mirror *m, Lisp_Object *v) -{ - size_t n = object_nelems (v, sizeof *v); - for (size_t i = 0; i < n; ++i) - IGC_MIRROR_OBJ (m, &v[i]); -} -#endif - -#if 0 -static void -mirror_handler (struct igc_mirror *m, struct handler *h) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_cons (struct igc_mirror *m, struct Lisp_Cons *c) -{ - IGC_MIRROR_OBJ (m, &c->u.s.car); - IGC_MIRROR_OBJ (m, &c->u.s.u.cdr); -} -#endif - -#if 0 -static void -mirror_blv (struct igc_mirror *m, struct Lisp_Buffer_Local_Value *blv) -{ - IGC_MIRROR_OBJ (m, &blv->where); - IGC_MIRROR_OBJ (m, &blv->defcell); - IGC_MIRROR_OBJ (m, &blv->valcell); -} -#endif - -static void -mirror_vectorlike_ (struct igc_mirror *m, struct Lisp_Vector *v) -{ - ptrdiff_t size = vector_size (v); - IGC_MIRROR_NOBJS (m, v->contents, size); -} - -#define IGC_MIRROR_VECTORLIKE(m, v) \ - mirror_vectorlike_ ((m), (struct Lisp_Vector *) (v)) - -#ifndef IN_MY_FORK -#if 0 -static void -mirror_obarray (struct igc_mirror *m, struct Lisp_Obarray *o) -{ - IGC_MIRROR_RAW (m, &o->buckets); -} -#endif -#endif - -#if 0 -static void -mirror_font (struct igc_mirror *m, struct Lisp_Vector *v) -{ - IGC_MIRROR_VECTORLIKE (m, v); - switch (vector_size (v)) - { - case FONT_SPEC_MAX: - case FONT_ENTITY_MAX: - break; - - case FONT_OBJECT_MAX: - { - struct font *f = (struct font *) v; - Lisp_Object const *type = &f->driver->type; - IGC_MIRROR_OBJ (m, igc_const_cast (Lisp_Object *, type)); - } - break; - - default: - emacs_abort (); - } -} -#endif - -#if 0 -static void -mirror_mutex (struct igc_mirror *m, struct Lisp_Mutex *x) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif - -#if 0 -static void -mirror_buffer (struct igc_mirror *m, struct buffer *b) -{ - IGC_MIRROR_VECTORLIKE (m, b); - IGC_MIRROR_RAW (m, &b->own_text.intervals); - IGC_MIRROR_OBJ (m, &b->own_text.markers); - IGC_MIRROR_RAW (m, &b->overlays); - - IGC_MIRROR_RAW (m, &b->base_buffer); - if (b->base_buffer) - b->text = &b->base_buffer->own_text; - else - b->text = &b->own_text; - - IGC_MIRROR_OBJ (m, &b->undo_list_); -} -#endif - -#if 0 -static void -mirror_frame (struct igc_mirror *m, struct frame *f) -{ - IGC_MIRROR_VECTORLIKE (m, f); - IGC_MIRROR_RAW (m, &f->face_cache); - if (f->terminal) - IGC_MIRROR_RAW (m, &f->terminal); -#ifdef HAVE_WINDOW_SYSTEM - igc_assert (!FRAME_WINDOW_P (f)); -#endif -} -#endif - -#if 0 -static void -mirror_window (struct igc_mirror *m, struct window *w) -{ - IGC_MIRROR_VECTORLIKE (m, w); - igc_assert (w->current_matrix == NULL); - igc_assert (w->desired_matrix == NULL); - IGC_MIRROR_OBJ (m, &w->prev_buffers); - IGC_MIRROR_OBJ (m, &w->next_buffers); + igc_assert (mirror != NULL); + client = base_to_client (mirror); + *p = (mps_word_t) client | tag; + } + } } -#endif -#if 0 static void -mirror_hash_table (struct igc_mirror *m, struct Lisp_Hash_Table *h) +mirror_raw (struct igc_mirror *m, mps_addr_t *p) { - IGC_MIRROR_RAW (m, &h->key); - IGC_MIRROR_RAW (m, &h->value); - IGC_MIRROR_RAW (m, &h->hash); - IGC_MIRROR_RAW (m, &h->next); - IGC_MIRROR_RAW (m, &h->index); - igc_assert (!pdumper_object_p (h->key)); - igc_assert (!pdumper_object_p (h->value)); + mps_addr_t client = *p; + if (pdumper_object_p (client)) + { + mps_addr_t base = client_to_base (client); + mps_addr_t mirror = lookup_copy (m, base); + igc_assert (mirror != NULL); + *p = base_to_client (mirror); + } } -#endif -#if 0 -static void -mirror_char_table (struct igc_mirror *m, struct Lisp_Vector *v) -{ - for (size_t i = vector_start (v), n = vector_size (v); i < n; ++i) - IGC_MIRROR_OBJ (m, &v->contents[i]); -} -#endif +#define IGC_MIRROR_OBJ(m, obj) mirror_lisp_obj ((m), (obj)) +#define IGC_MIRROR_RAW(m, pp) mirror_raw ((m), (mps_addr_t *) (pp)) -#if 0 static void -mirror_overlay (struct igc_mirror *m, struct Lisp_Overlay *o) +mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n) { - IGC_MIRROR_RAW (m, &o->buffer); - IGC_MIRROR_OBJ (m, &o->plist); - IGC_MIRROR_RAW (m, &o->interval); + for (size_t i = 0; i < n; ++i) + IGC_MIRROR_OBJ (m, &array[i]); } -#endif -#if 0 static void -mirror_subr (struct igc_mirror *m, struct Lisp_Subr *s) +mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n) { - IGC_MIRROR_OBJ (m, &s->command_modes); -#ifdef HAVE_NATIVE_COMP - IGC_MIRROR_OBJ (m, &s->intspec.native); - IGC_MIRROR_OBJ (m, &s->command_modes); - IGC_MIRROR_OBJ (m, &s->native_comp_u); - IGC_MIRROR_OBJ (m, &s->lambda_list); - IGC_MIRROR_OBJ (m, &s->type); -#endif + for (size_t i = 0; i < n; ++i) + mirror_raw (m, &array[i]); } -#endif -#if 0 -static void -mirror_misc_ptr (struct igc_mirror *m, struct Lisp_Misc_Ptr *p) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif +#define IGC_MIRROR_NOBJS(m, a, n) mirror_nobj (m, a, n) -#if 0 static void -mirror_user_ptr (struct igc_mirror *m, struct Lisp_User_Ptr *p) +mirror_fwd (struct igc_mirror *m, lispfwd fwd) { - IGC_NOT_IMPLEMENTED (); -} -#endif + switch (XFWDTYPE (fwd)) + { + case Lisp_Fwd_Int: + case Lisp_Fwd_Bool: + case Lisp_Fwd_Kboard_Obj: + break; -#if 0 -static void -mirror_thread (struct igc_mirror *m, struct thread_state *s) -{ - IGC_MIRROR_VECTORLIKE (m, s); - IGC_MIRROR_RAW (m, &s->m_current_buffer); - IGC_MIRROR_RAW (m, &s->next_thread); - IGC_MIRROR_RAW (m, &s->m_handlerlist); -} -#endif + case Lisp_Fwd_Obj: + { + struct Lisp_Objfwd *o = (void *) fwd.fwdptr; + IGC_MIRROR_OBJ (m, o->objvar); + } + break; -#if 0 -static void -mirror_terminal (struct igc_mirror *m, struct terminal *t) -{ - IGC_NOT_IMPLEMENTED (); + case Lisp_Fwd_Buffer_Obj: + { + struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr; + IGC_MIRROR_OBJ (m, &b->predicate); + } + break; + } } -#endif -#if 0 static void -mirror_marker (struct igc_mirror *m, struct Lisp_Marker *ma) +mirror_vectorlike_ (struct igc_mirror *m, struct Lisp_Vector *v) { - IGC_MIRROR_RAW (m, &ma->buffer); + ptrdiff_t size = vector_size (v); + IGC_MIRROR_NOBJS (m, v->contents, size); } -#endif -#if 0 -static void -mirror_finalizer (struct igc_mirror *m, struct Lisp_Finalizer *f) -{ - IGC_NOT_IMPLEMENTED (); -} -#endif +#define IGC_MIRROR_VECTORLIKE(m, v) \ + mirror_vectorlike_ ((m), (struct Lisp_Vector *) (v)) -#if 0 -static void -mirror_comp_unit (struct igc_mirror *m, struct Lisp_Native_Comp_Unit *u) -{ - IGC_MIRROR_VECTORLIKE (m, u); -} -#endif #ifdef HAVE_XWIDGETS static void @@ -4593,221 +3338,6 @@ mirror_global_ref (struct igc_mirror *m, struct module_global_reference *r) } #endif -#if 0 -static void -mirror_vector (struct igc_mirror *m, struct Lisp_Vector *client) -{ - switch (pseudo_vector_type (client->header)) - { -#ifndef IN_MY_FORK - case PVEC_OBARRAY: - mirror_obarray (m, client); - break; -#endif - - case PVEC_BUFFER: - mirror_buffer (m, client); - break; - - case PVEC_FRAME: - mirror_frame (m, client); - break; - - case PVEC_WINDOW: - mirror_window (m, client); - break; - - case PVEC_HASH_TABLE: - mirror_hash_table (m, client); - break; - - case PVEC_CHAR_TABLE: - case PVEC_SUB_CHAR_TABLE: - mirror_char_table (m, client); - break; - - case PVEC_BOOL_VECTOR: - break; - - case PVEC_OVERLAY: - mirror_overlay (m, client); - break; - - case PVEC_SUBR: - mirror_subr (m, client); - break; - - case PVEC_FREE: - emacs_abort (); - - case PVEC_FINALIZER: - mirror_finalizer (m, client); - break; - - case PVEC_MISC_PTR: - mirror_misc_ptr (m, client); - break; - - case PVEC_USER_PTR: - mirror_user_ptr (m, client); - break; - -#ifdef HAVE_XWIDGETS - case PVEC_XWIDGET: - mirror_xwidget (c, client); - break; - - case PVEC_XWIDGET_VIEW: - mirror_widget_view (c, client); - break; -#endif - - case PVEC_THREAD: - mirror_thread (m, client); - break; - - case PVEC_MUTEX: - mirror_mutex (m, client); - break; - - case PVEC_TERMINAL: - mirror_terminal (m, client); - break; - - case PVEC_MARKER: - mirror_marker (m, client); - break; - - case PVEC_BIGNUM: - break; - - case PVEC_NATIVE_COMP_UNIT: - mirror_comp_unit (m, client); - break; - - case PVEC_MODULE_GLOBAL_REFERENCE: -#ifdef HAVE_MODULES - mirror_global_ref (m, client); -#endif - break; - - case PVEC_FONT: - mirror_font (m, client); - break; - - case PVEC_NORMAL_VECTOR: - case PVEC_SYMBOL_WITH_POS: - case PVEC_PROCESS: - case PVEC_WINDOW_CONFIGURATION: - case PVEC_XWIDGET: - case PVEC_XWIDGET_VIEW: - case PVEC_MODULE_FUNCTION: - case PVEC_CONDVAR: - case PVEC_TS_COMPILED_QUERY: - case PVEC_TS_NODE: - case PVEC_TS_PARSER: - case PVEC_SQLITE: - case PVEC_CLOSURE: - case PVEC_RECORD: - case PVEC_OTHER: -#ifdef IN_MY_FORK - case PVEC_PACKAGE: -#endif - IGC_MIRROR_VECTORLIKE (m, client); - break; - } -} -#endif - -#if 0 -static void -mirror (struct igc_mirror *m, void *org_base, void *copy_base) -{ - void *client = base_to_client (copy_base); - struct igc_header *h = copy_base; - switch (h->obj_type) - { - case IGC_OBJ_BUILTIN_SYMBOL: - case IGC_OBJ_BUILTIN_THREAD: - case IGC_OBJ_BUILTIN_SUBR: - break; - - case IGC_OBJ_PAD: - case IGC_OBJ_FWD: - case IGC_OBJ_INVALID: - case IGC_OBJ_NUM_TYPES: - emacs_abort (); - - case IGC_OBJ_OBJ_VEC: - case IGC_OBJ_HASH_VEC: - mirror_obj_vec (m, client); - break; - - case IGC_OBJ_HANDLER: - mirror_handler (m, client); - break; - - case IGC_OBJ_PTR_VEC: - mirror_ptr_vec (m, client); - break; - - case IGC_OBJ_CONS: - mirror_cons (m, client); - break; - - case IGC_OBJ_STRING_DATA: - case IGC_OBJ_FLOAT: - case IGC_OBJ_BYTES: - break; - - case IGC_OBJ_SYMBOL: - mirror_symbol (m, client); - break; - - case IGC_OBJ_INTERVAL: - mirror_interval (m, client); - break; - - case IGC_OBJ_STRING: - mirror_string (m, client); - break; - - case IGC_OBJ_VECTOR: - case IGC_OBJ_VECTOR_WEAK: - mirror_vector (m, client); - break; - - case IGC_OBJ_ITREE_TREE: - mirror_itree_tree (m, client); - break; - - case IGC_OBJ_ITREE_NODE: - mirror_itree_node (m, client); - break; - - case IGC_OBJ_IMAGE: - mirror_image (m, client); - break; - - case IGC_OBJ_IMAGE_CACHE: - mirror_image_cache (m, client); - break; - - case IGC_OBJ_FACE: - mirror_face (m, client); - break; - - case IGC_OBJ_FACE_CACHE: - mirror_face_cache (m, client); - break; - - case IGC_OBJ_BLV: - mirror_blv (m, client); - break; - } -} -#endif - static void mirror_references (struct igc_mirror *m) { -- 2.39.2