xemacs-beta: src/specifier.c comparison

comparison src/specifier.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29

author	cvs
date	Mon, 13 Aug 2007 11:13:30 +0200
parents	bbff43aa5eb7
children	a86b2b5e0111

comparison

equal deleted inserted replaced

-:f4aeb21a5bad
+:74fd4e045ea6
 typedef struct
 {
 Dynarr_declare (specifier_type_entry);
 } specifier_type_entry_dynarr;
-specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
+static specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
+static const struct lrecord_description ste_description_1[] = {
+{ XD_LISP_OBJECT, offsetof (specifier_type_entry, symbol) },
+{ XD_STRUCT_PTR,  offsetof (specifier_type_entry, meths), 1, &specifier_methods_description },
+{ XD_END }
+};
+static const struct struct_description ste_description = {
+sizeof (specifier_type_entry),
+ste_description_1
+};
+static const struct lrecord_description sted_description_1[] = {
+XD_DYNARR_DESC (specifier_type_entry_dynarr, &ste_description),
+{ XD_END }
+};
+static const struct struct_description sted_description = {
+sizeof (specifier_type_entry_dynarr),
+sted_description_1
+};
 static Lisp_Object Vspecifier_type_list;
 static Lisp_Object Vcached_specifiers;
 /* Do NOT mark through this, or specifiers will never be GC'd. */
 for (rest = Vall_specifiers;
 !NILP (rest);
 rest = XSPECIFIER (rest)->next_specifier)
 {
-struct Lisp_Specifier *sp = XSPECIFIER (rest);
+Lisp_Specifier *sp = XSPECIFIER (rest);
 /* This effectively changes the specifier specs.
 	 However, there's no need to call
 	 recompute_cached_specifier_everywhere() or the
 	 after-change methods because the only specs we
 	 are removing are for dead objects, and they can
 for (rest = Vall_specifiers;
 !NILP (rest);
 rest = XSPECIFIER (rest)->next_specifier)
 {
-struct Lisp_Specifier *sp = XSPECIFIER (rest);
+Lisp_Specifier *sp = XSPECIFIER (rest);
 /* Make sure we're actually going to be changing something.
 	 Fremove_specifier() always calls
 	 recompute_cached_specifier_everywhere() (#### but should
 	 be smarter about this). */
 	Fremove_specifier (rest, buffer, Qnil, Qnil);
 }
 }
 static Lisp_Object
-mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_specifier (Lisp_Object obj)
 {
-struct Lisp_Specifier *specifier = XSPECIFIER (obj);
+Lisp_Specifier *specifier = XSPECIFIER (obj);
-markobj (specifier->global_specs);
+mark_object (specifier->global_specs);
-markobj (specifier->device_specs);
+mark_object (specifier->device_specs);
-markobj (specifier->frame_specs);
+mark_object (specifier->frame_specs);
-markobj (specifier->window_specs);
+mark_object (specifier->window_specs);
-markobj (specifier->buffer_specs);
+mark_object (specifier->buffer_specs);
-markobj (specifier->magic_parent);
+mark_object (specifier->magic_parent);
-markobj (specifier->fallback);
+mark_object (specifier->fallback);
 if (!GHOST_SPECIFIER_P (XSPECIFIER (obj)))
-MAYBE_SPECMETH (specifier, mark, (obj, markobj));
+MAYBE_SPECMETH (specifier, mark, (obj));
 return Qnil;
 }
 /* The idea here is that the specifier specs point to locales
 (windows, buffers, frames, and devices), and we want to make sure
 We now use weak lists for this purpose.
 */
 void
-prune_specifiers (int (*obj_marked_p) (Lisp_Object))
+prune_specifiers (void)
 {
 Lisp_Object rest, prev = Qnil;
 for (rest = Vall_specifiers;
-!GC_NILP (rest);
+!NILP (rest);
 rest = XSPECIFIER (rest)->next_specifier)
 {
-if (! obj_marked_p (rest))
+if (! marked_p (rest))
 	{
-	  struct Lisp_Specifier* sp = XSPECIFIER (rest);
+	  Lisp_Specifier* sp = XSPECIFIER (rest);
 	  /* A bit of assertion that we're removing both parts of the
 magic one altogether */
-	  assert (!GC_MAGIC_SPECIFIER_P(sp)
+	  assert (!MAGIC_SPECIFIER_P(sp)
-		  || (GC_BODILY_SPECIFIER_P(sp) && obj_marked_p (sp->fallback))
+		  || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback))
-		  || (GC_GHOST_SPECIFIER_P(sp) && obj_marked_p (sp->magic_parent)));
+		  || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent)));
 	  /* This specifier is garbage.  Remove it from the list. */
-	  if (GC_NILP (prev))
+	  if (NILP (prev))
 	    Vall_specifiers = sp->next_specifier;
 	  else
 	    XSPECIFIER (prev)->next_specifier = sp->next_specifier;
 	}
 else
 }
 static void
 print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
-struct Lisp_Specifier *sp = XSPECIFIER (obj);
+Lisp_Specifier *sp = XSPECIFIER (obj);
 char buf[100];
 int count = specpdl_depth ();
 Lisp_Object the_specs;
 if (print_readably)
 }
 static void
 finalize_specifier (void *header, int for_disksave)
 {
-struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header;
+Lisp_Specifier *sp = (Lisp_Specifier *) header;
 /* don't be snafued by the disksave finalization. */
-if (!for_disksave && !GC_GHOST_SPECIFIER_P(sp) && sp->caching)
+if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching)
 {
 xfree (sp->caching);
 sp->caching = 0;
 }
 }
 static int
 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-struct Lisp_Specifier *s1 = XSPECIFIER (obj1);
+Lisp_Specifier *s1 = XSPECIFIER (obj1);
-struct Lisp_Specifier *s2 = XSPECIFIER (obj2);
+Lisp_Specifier *s2 = XSPECIFIER (obj2);
 int retval;
 Lisp_Object old_inhibit_quit = Vinhibit_quit;
 /* This function can be called from within redisplay.
 internal_equal can trigger a quit.  That leads to Bad Things. */
 }
 static unsigned long
 specifier_hash (Lisp_Object obj, int depth)
 {
-struct Lisp_Specifier *s = XSPECIFIER (obj);
+Lisp_Specifier *s = XSPECIFIER (obj);
 /* specifier hashing is a bit problematic because there are so
 many places where data can be stored.  We pick what are perhaps
 the most likely places where interesting stuff will be. */
 return HASH5 ((HAS_SPECMETH_P (s, hash) ?
 		internal_hash (s->frame_specs,  depth + 1),
 		internal_hash (s->buffer_specs, depth + 1));
 }
 static size_t
-sizeof_specifier (CONST void *header)
+sizeof_specifier (const void *header)
 {
-if (GHOST_SPECIFIER_P ((struct Lisp_Specifier *) header))
+if (GHOST_SPECIFIER_P ((Lisp_Specifier *) header))
-return sizeof (struct Lisp_Specifier);
+return offsetof (Lisp_Specifier, data);
 else
 {
-CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header;
+const Lisp_Specifier *p = (const Lisp_Specifier *) header;
-return sizeof (*p) + p->methods->extra_data_size - 1;
+return offsetof (Lisp_Specifier, data) + p->methods->extra_data_size;
 }
 }
+static const struct lrecord_description specifier_methods_description_1[] = {
+{ XD_LISP_OBJECT, offsetof (struct specifier_methods, predicate_symbol) },
+{ XD_END }
+};
+const struct struct_description specifier_methods_description = {
+sizeof (struct specifier_methods),
+specifier_methods_description_1
+};
+static const struct lrecord_description specifier_caching_description_1[] = {
+{ XD_END }
+};
+static const struct struct_description specifier_caching_description = {
+sizeof (struct specifier_caching),
+specifier_caching_description_1
+};
+static const struct lrecord_description specifier_description[] = {
+{ XD_STRUCT_PTR,  offsetof (Lisp_Specifier, methods), 1, &specifier_methods_description },
+{ XD_LO_LINK,     offsetof (Lisp_Specifier, next_specifier) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, global_specs) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, device_specs) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) },
+{ XD_STRUCT_PTR,  offsetof (Lisp_Specifier, caching), 1, &specifier_caching_description },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) },
+{ XD_SPECIFIER_END }
+};
+const struct lrecord_description specifier_empty_extra_description[] = {
+{ XD_END }
+};
 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier,
 					mark_specifier, print_specifier,
 					finalize_specifier,
 					specifier_equal, specifier_hash,
+					specifier_description,
 					sizeof_specifier,
-					struct Lisp_Specifier);
+					Lisp_Specifier);
 /************************************************************************/
 /*                       Creating specifiers                            */
 /************************************************************************/
 static Lisp_Object
 make_specifier_internal (struct specifier_methods *spec_meths,
 			 size_t data_size, int call_create_meth)
 {
 Lisp_Object specifier;
-struct Lisp_Specifier *sp = (struct Lisp_Specifier *)
+Lisp_Specifier *sp = (Lisp_Specifier *)
-alloc_lcrecord (sizeof (struct Lisp_Specifier) +
+alloc_lcrecord (offsetof (Lisp_Specifier, data) + data_size,
-		    data_size - 1, lrecord_specifier);
+		    &lrecord_specifier);
 sp->methods = spec_meths;
 sp->global_specs = Qnil;
 sp->device_specs = Qnil;
 sp->frame_specs = Qnil;
 build_up_processed_list (Lisp_Object specifier, Lisp_Object locale,
 			 Lisp_Object inst_list)
 {
 /* The return value of this function must be GCPRO'd. */
 Lisp_Object rest, list_to_build_up = Qnil;
-struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+Lisp_Specifier *sp = XSPECIFIER (specifier);
 struct gcpro gcpro1;
 GCPRO1 (list_to_build_up);
 LIST_LOOP (rest, inst_list)
 {
 Lisp_Object tag_set = XCAR (XCAR (rest));
-Lisp_Object instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt);
 Lisp_Object sub_inst_list = Qnil;
+Lisp_Object instantiator;
 struct gcpro ngcpro1, ngcpro2;
+if (HAS_SPECMETH_P (sp, copy_instantiator))
+	instantiator = SPECMETH (sp, copy_instantiator,
+				 (XCDR (XCAR (rest))));
+else
+	instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt);
 NGCPRO2 (instantiator, sub_inst_list);
 /* call the will-add method; it may GC */
 sub_inst_list = HAS_SPECMETH_P (sp, going_to_add) ?
 	SPECMETH (sp, going_to_add,
 static void
 specifier_add_spec (Lisp_Object specifier, Lisp_Object locale,
 		    Lisp_Object inst_list, enum spec_add_meth add_meth)
 {
-struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+Lisp_Specifier *sp = XSPECIFIER (specifier);
 enum spec_locale_type type = locale_type_from_locale (locale);
 Lisp_Object *orig_inst_list, tem;
 Lisp_Object list_to_build_up = Qnil;
 struct gcpro gcpro1;
 global value. */
 void
 set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback)
 {
-struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+Lisp_Specifier *sp = XSPECIFIER (specifier);
 assert (SPECIFIERP (fallback) ||
 	  !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier))));
 if (SPECIFIERP (fallback))
 assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback)));
 if (BODILY_SPECIFIER_P (sp))
 				   Lisp_Object inst_list,
 				   Error_behavior errb, int no_quit,
 				   Lisp_Object depth)
 {
 /* This function can GC */
-struct Lisp_Specifier *sp;
+Lisp_Specifier *sp;
 Lisp_Object device;
 Lisp_Object rest;
 int count = specpdl_depth ();
 struct gcpro gcpro1, gcpro2;
 Lisp_Object window = Qnil;
 Lisp_Object frame = Qnil;
 Lisp_Object device = Qnil;
 Lisp_Object tag = Qnil;
 struct device *d;
-struct Lisp_Specifier *sp;
+Lisp_Specifier *sp;
 sp = XSPECIFIER (specifier);
 /* Attempt to determine buffer, window, frame, and device from the
 domain. */
 	 from Lisp). */
 depth = Qzero;
 goto do_fallback;
 }
 retry:
 /* First see if we can generate one from the window specifiers. */
 if (!NILP (window))
 CHECK_INSTANCE_ENTRY (window, matchspec, LOCALE_WINDOW);
 /* Next see if we can generate one from the buffer specifiers. */
 CHECK_INSTANCE_ENTRY (device, matchspec, LOCALE_DEVICE);
 /* Last and least try the global specifiers. */
 CHECK_INSTANCE_ENTRY (Qglobal, matchspec, LOCALE_GLOBAL);
 do_fallback:
 /* We're out of specifiers and we still haven't generated an
 instance.  At least try the fallback ...  If this fails,
 then we just return Qunbound. */
 if (no_fallback || NILP (sp->fallback))
 you should not use this function; use `specifier-instance' instead.
 */
 (specifier, domain, inst_list, default_))
 {
 Lisp_Object val = Qunbound;
-struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+Lisp_Specifier *sp = XSPECIFIER (specifier);
 struct gcpro gcpro1;
 Lisp_Object built_up_list = Qnil;
 CHECK_SPECIFIER (specifier);
 check_valid_domain (domain);
 works.
 */
 (specifier, matchspec, domain, inst_list, default_))
 {
 Lisp_Object val = Qunbound;
-struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+Lisp_Specifier *sp = XSPECIFIER (specifier);
 struct gcpro gcpro1;
 Lisp_Object built_up_list = Qnil;
 CHECK_SPECIFIER (specifier);
 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
 		       int struct_frame_offset,
 		       void (*value_changed_in_frame)
 		       (Lisp_Object specifier, struct frame *f,
 			Lisp_Object oldval))
 {
-struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+Lisp_Specifier *sp = XSPECIFIER (specifier);
 assert (!GHOST_SPECIFIER_P (sp));
 if (!sp->caching)
 sp->caching = xnew_and_zero (struct specifier_caching);
 sp->caching->offset_into_struct_window = struct_window_offset;
 void
 specifier_type_create (void)
 {
 the_specifier_type_entry_dynarr = Dynarr_new (specifier_type_entry);
+dumpstruct (&the_specifier_type_entry_dynarr, &sted_description);
 Vspecifier_type_list = Qnil;
 staticpro (&Vspecifier_type_list);
 INITIALIZE_SPECIFIER_TYPE (generic, "generic", "generic-specifier-p");
 SPECIFIER_HAS_METHOD (boolean, validate);
 INITIALIZE_SPECIFIER_TYPE (display_table, "display-table", "display-table-p");
 SPECIFIER_HAS_METHOD (display_table, validate);
+}
+void
+reinit_specifier_type_create (void)
+{
+REINITIALIZE_SPECIFIER_TYPE (generic);
+REINITIALIZE_SPECIFIER_TYPE (integer);
+REINITIALIZE_SPECIFIER_TYPE (natnum);
+REINITIALIZE_SPECIFIER_TYPE (boolean);
+REINITIALIZE_SPECIFIER_TYPE (display_table);
 }
 void
 vars_of_specifier (void)
 {
 staticpro (&Vcached_specifiers);
 /* Do NOT mark through this, or specifiers will never be GC'd.
 This is the same deal as for weak hash tables. */
 Vall_specifiers = Qnil;
+pdump_wire_list (&Vall_specifiers);
 Vuser_defined_tags = Qnil;
 staticpro (&Vuser_defined_tags);
 Vunlock_ghost_specifiers = Qnil;

Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 398:74fd4e045ea6 r21-2-29