home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / event-alloc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-10  |  7.8 KB  |  264 lines
  1. /* Event allocation and memory management.
  2.    Copyright (C) 1991, 1992 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "config.h"
  21. #include "lisp.h"
  22. #include "buffer.h"
  23. #include "window.h"
  24. #include "screen.h"
  25. #include "process.h"
  26. #include "events.h"
  27.  
  28. /* Where old events go when they are explicitly deallocated.
  29.    The event chain here is cut loose before GC, so these will be freed
  30.    eventually.
  31.  */
  32. static struct Lisp_Event *event_free_list;
  33.  
  34.  
  35. /* Events are allocated similarly to strings.  All events are embedded in
  36.    a linked list of event-block structures which are each 1k long; after the
  37.    mark pass of the garbage collector, all event-block structures which 
  38.    contain no marked events are freed.  If even one marked event remains,
  39.    it is not freed, and the unmarked events are chained onto event_free_list.
  40.    New events are added to the end of the last-allocated event block.  When
  41.    it fills up, a new event-block is allocated and added to the end.
  42.  
  43.    In the case where there are no more pointers to a sequence of events which
  44.    are adjascent to the end of the most recently allocated event-block, we
  45.    decrement the fill pointer of that block, so that the space is reused
  46.    immediately.
  47.  */
  48.  
  49. #define EVENT_BLOCK_SIZE \
  50.   ((1020 - sizeof (struct event_block *)) / sizeof (struct Lisp_Event))
  51.  
  52. struct event_block {
  53.   struct Lisp_Event events [EVENT_BLOCK_SIZE];
  54.   struct event_block *next;
  55. };
  56.  
  57. static struct event_block *event_blocks;
  58.  
  59. /* Make sure we lose quickly if we try to use this event */
  60. static void
  61. deinitialize_event (event)
  62.      struct Lisp_Event *event;
  63. {
  64.   int i;
  65.  
  66.   for (i = 0; i < ((sizeof (struct Lisp_Event)) / sizeof (int)); i++)
  67.     ((int *) event) [i] = 0xdeadbeef;
  68.   event->event_type = dead_event;
  69. }
  70.  
  71. static void
  72. get_more_events ()
  73. {
  74.   int i;
  75.   struct event_block *new  = (struct event_block *)
  76.     xmalloc (sizeof (struct event_block));
  77.  
  78.   /* Deinitialize events and put them on the free list */
  79.   for (i = 0; i < EVENT_BLOCK_SIZE; i++)
  80.     {
  81.       deinitialize_event (&new->events[i]);
  82.       new->events[i].next = event_free_list;
  83.       event_free_list = &new->events[i];
  84.     }
  85.   new->next = event_blocks;
  86.   event_blocks = new;
  87. }
  88.  
  89.  
  90. void
  91. free_unmarked_events ()            /* called from gc_sweep() */
  92. {
  93.   struct event_block *prev = 0;
  94.   struct event_block *current = event_blocks;
  95.   while (current)
  96.     {
  97.       int i;
  98.       int survivors = 0;
  99.       /* Save the old free list in case we free the entire block */
  100.       struct Lisp_Event *old_free_list = event_free_list;
  101.       
  102.       for (i = 0; i < EVENT_BLOCK_SIZE; i++)
  103.     {
  104.       if (XMARKBIT ((int) (current->events [i].event_type)))
  105.         {
  106.           XUNMARK (current->events [i].event_type);
  107.           survivors = 1;
  108.         }
  109.       else
  110.         {
  111.           deinitialize_event (¤t->events[i]);
  112.           current->events[i].next = event_free_list;
  113.           event_free_list = ¤t->events[i];
  114.         }
  115.     }
  116.       if (! survivors)
  117.     {
  118.       struct event_block *tmp = current;
  119.       current = current->next;
  120.       if (prev)
  121.         prev->next = current;
  122.       /* Restore the free list before we started this block */
  123.       event_free_list = old_free_list;
  124.       if (tmp == event_blocks)
  125.         event_blocks = current;
  126.       xfree (tmp);
  127.     } else {
  128.       prev = current;
  129.       current = current->next;
  130.     }
  131.     }
  132. }
  133.  
  134. void
  135. prepare_to_gc_events ()        /* called by Fgarbage_collect() */
  136. {
  137.   /* Flush the list of deallocated events.  No pointers to these should
  138.      still exist, but even if they do, they will be marked normally.
  139.    */
  140. #if 0
  141.   /* There's actually no need to go down the list and clear the next slots */
  142.   struct Lisp_Event *prev = 0, *event = event_free_list;
  143.   while (event) {
  144.     if (prev)
  145.       prev->next = 0;
  146.     prev = event;
  147.     event = event->next;
  148.     
  149.   }
  150. #endif
  151.   /* All we need to do is set the free list to 0 */
  152.   event_free_list = 0;
  153. }
  154.  
  155.  
  156. DEFUN ("allocate-event", Fallocate_event, Sallocate_event, 0, 0, 0,
  157.   "Returns an empty event structure.\n\
  158. WARNING, the event object returned may be a reused one; see the function\n\
  159. `deallocate-event'.")
  160.     ()
  161. {
  162.   Lisp_Object event;
  163.   if (! event_free_list)
  164.     get_more_events ();
  165.   XSET (event, Lisp_Event, (struct Lisp_Event *) event_free_list);
  166.   event_free_list = event_free_list->next;
  167.   XEVENT (event)->event_type = empty_event;
  168.   XEVENT (event)->next = 0;
  169.   XEVENT (event)->timestamp = 0;
  170.   XEVENT (event)->channel = Qnil;
  171.   return event;
  172. }
  173.  
  174. extern Lisp_Object Vlast_command_event;
  175. extern Lisp_Object Vlast_input_event, Vunread_command_event;
  176. extern Lisp_Object Vthis_command_keys, Vrecent_keys_ring;
  177.  
  178. DEFUN ("deallocate-event", Fdeallocate_event, Sdeallocate_event, 1, 1, 0,
  179.   "Allow the given event structure to be reused.  You MUST NOT use this \n\
  180. event object after calling this function with it.  You will lose.\n\
  181. It is not necessary to call this function, as event objects are garbage-\n\
  182. collected like all other objects; however, it may be more efficient to\n\
  183. explicitly deallocate events when you are sure that that is safe.")
  184.     (event)
  185.     Lisp_Object event;
  186. {
  187.   CHECK_EVENT (event, 0);
  188.   if (XEVENT (event)->event_type == dead_event)
  189.     error ("this event is already deallocated!");
  190.  
  191.   if (XEVENT (event)->event_type < first_event_type
  192.       || XEVENT (event)->event_type > last_event_type)
  193.     abort();
  194.  
  195. #if 0
  196.   if (EQ (event, Vlast_command_event))
  197.     abort ();
  198.   if (EQ (event, Vlast_input_event))
  199.     abort ();
  200.   if (EQ (event, Vunread_command_event))
  201.     abort ();
  202.   {
  203.     int i;
  204.     for (i = 0; i < XVECTOR (Vthis_command_keys)->size; i++)
  205.       if (EQ (event, XVECTOR (Vthis_command_keys)->contents [i]))
  206.     abort ();
  207.     for (i = 0; i < XVECTOR (Vrecent_keys_ring)->size; i++)
  208.       if (EQ (event, XVECTOR (Vrecent_keys_ring)->contents [i]))
  209.     abort ();
  210.   }
  211. #endif
  212.  
  213.   if (XEVENT (event) == event_free_list)
  214.     abort ();
  215.   deinitialize_event (XEVENT (event));
  216.   XEVENT (event)->next = event_free_list;
  217.   event_free_list = XEVENT (event);
  218.   return Qnil;
  219. }
  220.  
  221.  
  222. DEFUN ("copy-event", Fcopy_event, Scopy_event, 1, 2, 0,
  223.   "Make a copy of the given event object.  If a second argument is given,\n\
  224. the first event is copied into the second and the second is returned.\n\
  225. If the second argument is not supplied (or is nil) then a new event will\n\
  226. be made as with `allocate-event.'  See also the function `deallocate-event'.")
  227.      (event1, event2)
  228.      Lisp_Object event1, event2;
  229. {
  230.   struct Lisp_Event *save_next;
  231.   CHECK_EVENT (event1, 0);
  232.   if (NILP (event2))
  233.     event2 = Fallocate_event ();
  234.   else CHECK_EVENT (event2, 0);
  235.   if (EQ (event1, event2))
  236.     return Fsignal (Qerror, Fcons (build_string ("those events are eq."),
  237.                    Fcons (event1, Qnil)));
  238.   if ((XEVENT (event1)->event_type < first_event_type)
  239.       || (XEVENT (event1)->event_type > last_event_type)
  240.       || (XEVENT (event2)->event_type < first_event_type)
  241.       || (XEVENT (event2)->event_type > last_event_type))
  242.     abort ();
  243.   if ((XEVENT (event1)->event_type == dead_event) ||
  244.       (XEVENT (event2)->event_type == dead_event))
  245.     return Fsignal (Qerror,
  246.             Fcons (build_string
  247.                ("copy-event called with a deallocated event!"),
  248.                Fcons (event1, Fcons (event2, Qnil))));
  249.   save_next = XEVENT (event2)->next;
  250.   *XEVENT (event2) = *XEVENT (event1);
  251.   XEVENT (event2)->next = save_next;
  252.   return event2;
  253. }
  254.  
  255.  
  256. void
  257. syms_of_event_alloc ()
  258. {
  259.   event_free_list = 0;
  260.   defsubr (&Sallocate_event);
  261.   defsubr (&Sdeallocate_event);
  262.   defsubr (&Scopy_event);
  263. }
  264.