diff src/events.c @ 5178:97eb4942aec8

merge
author Ben Wing <ben@xemacs.org>
date Mon, 29 Mar 2010 21:28:13 -0500
parents 1fae11d56ad2
children 71ee43b8a74d
line wrap: on
line diff
--- a/src/events.c	Tue Feb 23 07:28:35 2010 -0600
+++ b/src/events.c	Mon Mar 29 21:28:13 2010 -0500
@@ -62,7 +62,7 @@
 /*                       definition of event object                     */
 /************************************************************************/
 
-/* #### Ad-hoc hack.  Should be part of define_lrecord_implementation */
+/* #### Ad-hoc hack.  Should be an object method. */
 void
 clear_event_resource (void)
 {
@@ -74,14 +74,10 @@
 deinitialize_event (Lisp_Object ev)
 {
   Lisp_Event *event = XEVENT (ev);
-  int i;
-  /* Preserve the old UID for this event, for tracking it */
-  unsigned int old_uid = event->lheader.uid;
 
-  for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
-    ((int *) event) [i] = 0xdeadbeef; /* -559038737 base 10 */
-  set_lheader_implementation (&event->lheader, &lrecord_event);
-  event->lheader.uid = old_uid;
+  deadbeef_memory ((Rawbyte *) event + sizeof (event->lheader),
+		   sizeof (*event) - sizeof (event->lheader));
+
   set_event_type (event, dead_event);
   SET_EVENT_CHANNEL (event, Qnil);
   XSET_EVENT_NEXT (ev, Qnil);
@@ -91,12 +87,7 @@
 void
 zero_event (Lisp_Event *e)
 {
-  /* Preserve the old UID for this event, for tracking it */
-  unsigned int old_uid = e->lheader.uid;
-
-  xzero (*e);
-  set_lheader_implementation (&e->lheader, &lrecord_event);
-  e->lheader.uid = old_uid;
+  zero_nonsized_lisp_object (wrap_event (e));
   set_event_type (e, empty_event);
   SET_EVENT_CHANNEL (e, Qnil);
   SET_EVENT_NEXT (e, Qnil);
@@ -212,59 +203,50 @@
 
 #ifdef EVENT_DATA_AS_OBJECTS
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("key-data", key_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     key_data_description, 
-				     Lisp_Key_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("key-data", key_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      key_data_description, 
+				      Lisp_Key_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("button-data", button_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     button_data_description, 
-				     Lisp_Button_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("button-data", button_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      button_data_description, 
+				      Lisp_Button_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("motion-data", motion_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     motion_data_description,
-				     Lisp_Motion_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("motion-data", motion_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      motion_data_description,
+				      Lisp_Motion_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("process-data", process_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     process_data_description,
-				     Lisp_Process_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("process-data", process_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      process_data_description,
+				      Lisp_Process_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("timeout-data", timeout_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     timeout_data_description,
-				     Lisp_Timeout_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("timeout-data", timeout_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      timeout_data_description,
+				      Lisp_Timeout_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("eval-data", eval_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     eval_data_description,
-				     Lisp_Eval_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("eval-data", eval_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      eval_data_description,
+				      Lisp_Eval_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("misc-user-data", misc_user_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     misc_user_data_description, 
-				     Lisp_Misc_User_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("misc-user-data", misc_user_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      misc_user_data_description, 
+				      Lisp_Misc_User_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-eval-data", magic_eval_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     magic_eval_data_description, 
-				     Lisp_Magic_Eval_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("magic-eval-data", magic_eval_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      magic_eval_data_description, 
+				      Lisp_Magic_Eval_Data);
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-data", magic_data,
-				     0, /*dumpable-flag*/
-				     0, 0, 0, 0, 0,
-				     magic_data_description,
-				     Lisp_Magic_Data);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("magic-data", magic_data,
+				      0, internal_object_printer, 0, 0, 0,
+				      magic_data_description,
+				      Lisp_Magic_Data);
 
 #endif /* EVENT_DATA_AS_OBJECTS */
 
@@ -322,7 +304,7 @@
 	     int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_object ("#<event>");
+    printing_unreadable_object_fmt ("#<event 0x%x>", LISP_OBJECT_UID (obj));
 
   switch (XEVENT (obj)->event_type)
     {
@@ -380,7 +362,7 @@
 	write_ascstring (printcharfun, "#<UNKNOWN-EVENT-TYPE");
 	break;
       }
-  write_ascstring (printcharfun, ">");
+  write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
 }
 
 static int
@@ -507,11 +489,11 @@
   return 0; /* unreached */
 }
 
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
-				     0, /*dumpable-flag*/
-				     mark_event, print_event, 0, event_equal,
-				     event_hash, event_description,
-				     Lisp_Event);
+DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("event", event,
+				      mark_event, print_event, 0,
+				      event_equal, event_hash,
+				      event_description,
+				      Lisp_Event);
 
 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
 Return a new event of type TYPE, with properties described by PLIST.
@@ -2556,17 +2538,17 @@
 void
 syms_of_events (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (event);
+  INIT_LISP_OBJECT (event);
 #ifdef EVENT_DATA_AS_OBJECTS
-  INIT_LRECORD_IMPLEMENTATION (key_data);
-  INIT_LRECORD_IMPLEMENTATION (button_data);
-  INIT_LRECORD_IMPLEMENTATION (motion_data);
-  INIT_LRECORD_IMPLEMENTATION (process_data);
-  INIT_LRECORD_IMPLEMENTATION (timeout_data);
-  INIT_LRECORD_IMPLEMENTATION (eval_data);
-  INIT_LRECORD_IMPLEMENTATION (misc_user_data);
-  INIT_LRECORD_IMPLEMENTATION (magic_eval_data);
-  INIT_LRECORD_IMPLEMENTATION (magic_data);
+  INIT_LISP_OBJECT (key_data);
+  INIT_LISP_OBJECT (button_data);
+  INIT_LISP_OBJECT (motion_data);
+  INIT_LISP_OBJECT (process_data);
+  INIT_LISP_OBJECT (timeout_data);
+  INIT_LISP_OBJECT (eval_data);
+  INIT_LISP_OBJECT (misc_user_data);
+  INIT_LISP_OBJECT (magic_eval_data);
+  INIT_LISP_OBJECT (magic_data);
 #endif /* EVENT_DATA_AS_OBJECTS */  
 
   DEFSUBR (Fcharacter_to_event);
@@ -2639,7 +2621,7 @@
 {
   Vevent_resource = Qnil;
 #ifdef NEW_GC
-  staticpro (&Vevent_resource);
+  staticpro_nodump (&Vevent_resource);
 #endif /* NEW_GC */
 }