home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / os2msg.c < prev    next >
C/C++ Source or Header  |  2000-12-05  |  27KB  |  979 lines
  1. /* -*-C-*-
  2.  
  3. $Id: os2msg.c,v 1.14 2000/12/05 21:23:46 cph Exp $
  4.  
  5. Copyright (c) 1994-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* Master Message Queue */
  23.  
  24. #include "os2.h"
  25.  
  26. extern void EXFUN (tty_set_next_interrupt_char, (cc_t c));
  27. extern void * OS2_malloc_noerror (unsigned int);
  28.  
  29. static qid_t allocate_qid (void);
  30. static void OS2_initialize_message_lengths (void);
  31. static void write_subqueue (msg_t *);
  32. static msg_t * read_subqueue (qid_t);
  33. static int subqueue_emptyp (qid_t);
  34. static msg_t * read_tqueue (tqueue_t *, int);
  35. static void write_tqueue (tqueue_t *, msg_t *);
  36. static msg_t * read_std_tqueue (tqueue_t *, int);
  37. static void write_std_tqueue (tqueue_t *, msg_t *);
  38. static tqueue_t * make_scm_tqueue (void);
  39. static msg_t * read_scm_tqueue (tqueue_t *, int);
  40. static void write_scm_tqueue (tqueue_t *, msg_t *);
  41. static void process_interrupt_messages (void);
  42.  
  43. typedef struct
  44. {
  45.   unsigned int allocatedp : 1;    /* queue allocated? */
  46.   qid_t twin;            /* other end of connection */
  47.   qid_receive_filter_t filter;    /* filter for received messages */
  48.   tqueue_t * tqueue;        /* thread queue for reception */
  49.   void * subqueue;        /* receiving subqueue */
  50.   HMTX lock;
  51. } iqid_t;
  52.  
  53. static iqid_t queue_array [QID_MAX + 1];
  54. static HMTX qid_lock;
  55.  
  56. tqueue_t * OS2_scheme_tqueue;
  57. static qid_t OS2_interrupt_qid_local;
  58. qid_t OS2_interrupt_qid;
  59.  
  60. #define _QID(q) (queue_array [(q)])
  61. #define QID_ALLOCATEDP(q) ((_QID (q)) . allocatedp)
  62. #define QID_TWIN(q) ((_QID (q)) . twin)
  63. #define QID_FILTER(q) ((_QID (q)) . filter)
  64. #define QID_TQUEUE(q) ((_QID (q)) . tqueue)
  65. #define QID_SUBQUEUE(q) ((_QID (q)) . subqueue)
  66. #define QID_LOCK(q) ((_QID (q)) . lock)
  67.  
  68. void
  69. OS2_initialize_message_queues (void)
  70. {
  71.   {
  72.     qid_t qid = 0;
  73.     while (1)
  74.       {
  75.     (QID_ALLOCATEDP (qid)) = 0;
  76.     (QID_TWIN (qid)) = QID_NONE;
  77.     (QID_FILTER (qid)) = 0;
  78.     (QID_TQUEUE (qid)) = 0;
  79.     (QID_SUBQUEUE (qid)) = 0;
  80.     (QID_LOCK (qid)) = NULLHANDLE;
  81.     if (qid == QID_MAX)
  82.       break;
  83.     qid += 1;
  84.       }
  85.   }
  86.   OS2_initialize_message_lengths ();
  87.   SET_MSG_TYPE_LENGTH (mt_init, sm_init_t);
  88.   SET_MSG_TYPE_LENGTH (mt_console_interrupt, sm_console_interrupt_t);
  89.   SET_MSG_TYPE_LENGTH (mt_timer_event, sm_timer_event_t);
  90.   SET_MSG_TYPE_LENGTH (mt_generic_reply, sm_generic_reply_t);
  91.   qid_lock = (OS2_create_mutex_semaphore (0, 0));
  92.   OS2_scheme_tqueue = (make_scm_tqueue ());
  93.   OS2_make_qid_pair ((&OS2_interrupt_qid_local), (&OS2_interrupt_qid));
  94.   OS2_open_qid (OS2_interrupt_qid_local, OS2_scheme_tqueue);
  95. }
  96.  
  97. void
  98. OS2_make_qid_pair (qid_t * pq1, qid_t * pq2)
  99. {
  100.   qid_t q1 = (allocate_qid ());
  101.   qid_t q2 = (allocate_qid ());
  102.   (QID_TWIN (q1)) = q2;
  103.   (QID_TWIN (q2)) = q1;
  104.   (*pq1) = q1;
  105.   (*pq2) = q2;
  106. }
  107.  
  108. static qid_t
  109. allocate_qid (void)
  110. {
  111.   unsigned int qid = 0;
  112.   OS2_request_mutex_semaphore (qid_lock);
  113.   while (1)
  114.     {
  115.       if ((QID_ALLOCATEDP (qid)) == 0)
  116.     break;
  117.       if (qid == QID_MAX)
  118.     OS2_logic_error ("No more QIDs available.");
  119.       qid += 1;
  120.     }
  121.   (QID_ALLOCATEDP (qid)) = 1;
  122.   (QID_TWIN (qid)) = QID_NONE;
  123.   OS2_release_mutex_semaphore (qid_lock);
  124.   (QID_FILTER (qid)) = 0;
  125.   (QID_TQUEUE (qid)) = 0;
  126.   (QID_SUBQUEUE (qid)) = (OS2_create_msg_fifo ());
  127.   if ((QID_LOCK (qid)) == NULLHANDLE)
  128.     (QID_LOCK (qid)) = (OS2_create_mutex_semaphore (0, 0));
  129.   return (qid);
  130. }
  131.  
  132. void
  133. OS2_open_qid (qid_t qid, tqueue_t * tqueue)
  134. {
  135.   if ((QID_TQUEUE (qid)) != 0)
  136.     OS2_logic_error ("Reopening already open QID.");
  137.   if (tqueue == 0)
  138.     OS2_logic_error ("Null tqueue passed to OS2_open_qid.");
  139.   (QID_TQUEUE (qid)) = tqueue;
  140. }
  141.  
  142. int
  143. OS2_qid_openp (qid_t qid)
  144. {
  145.   return ((QID_TQUEUE (qid)) != 0);
  146. }
  147.  
  148. void
  149. OS2_close_qid (qid_t qid)
  150. {
  151.   OS2_request_mutex_semaphore (QID_LOCK (qid));
  152.   while (1)
  153.     {
  154.       msg_t * msg = (OS2_msg_fifo_remove (QID_SUBQUEUE (qid)));
  155.       if (msg == 0)
  156.     break;
  157.       OS2_destroy_message (msg);
  158.     }
  159.   OS2_destroy_msg_fifo (QID_SUBQUEUE (qid));
  160.   (QID_FILTER (qid)) = 0;
  161.   (QID_TQUEUE (qid)) = 0;
  162.   (QID_SUBQUEUE (qid)) = 0;
  163.   OS2_release_mutex_semaphore (QID_LOCK (qid));
  164.   OS2_request_mutex_semaphore (qid_lock);
  165.   {
  166.     qid_t twin = (QID_TWIN (qid));
  167.     if (twin != QID_NONE)
  168.       {
  169.     (QID_TWIN (twin)) = QID_NONE;
  170.     (QID_TWIN (qid)) = QID_NONE;
  171.       }
  172.   }
  173.   (QID_ALLOCATEDP (qid)) = 0;
  174.   OS2_release_mutex_semaphore (qid_lock);
  175. }
  176.  
  177. tqueue_t *
  178. OS2_qid_tqueue (qid_t qid)
  179. {
  180.   return (QID_TQUEUE (qid));
  181. }
  182.  
  183. qid_t
  184. OS2_qid_twin (qid_t qid)
  185. {
  186.   qid_t twin;
  187.   OS2_request_mutex_semaphore (qid_lock);
  188.   twin
  189.     = (((QID_ALLOCATEDP (qid))
  190.     && ((QID_TWIN (qid)) != QID_NONE)
  191.     && (QID_ALLOCATEDP (QID_TWIN (qid))))
  192.        ? (QID_TWIN (qid))
  193.        : QID_NONE);
  194.   OS2_release_mutex_semaphore (qid_lock);
  195.   return (twin);
  196. }
  197.  
  198. void
  199. OS2_close_qid_pair (qid_t qid)
  200. {
  201.   /* This is safe because it is used only in a particular way.  The
  202.      twin of this qid is never received from, and qid is never sent
  203.      to, and the twin will never be closed by the other thread.  Thus,
  204.      even though the unlocked sections of OS2_close_qid are
  205.      manipulating structures that belong to the other thread, the
  206.      other thread won't be manipulating them so no conflict will
  207.      arise.  It's important not to use this procedure in any other
  208.      situation!  */
  209.   if (QID_ALLOCATEDP (qid))
  210.     {
  211.       qid_t twin = (OS2_qid_twin (qid));
  212.       if (twin != QID_NONE)
  213.     OS2_close_qid (twin);
  214.       OS2_close_qid (qid);
  215.     }
  216. }
  217.  
  218. void
  219. OS2_set_qid_receive_filter (qid_t qid, qid_receive_filter_t filter)
  220. {
  221.   (QID_FILTER (qid)) = filter;
  222. }
  223.  
  224. /* Message Lengths */
  225.  
  226. #define MESSAGE_LENGTH(t) (message_lengths [(unsigned int) (t)])
  227. static msg_length_t message_lengths [MSG_TYPE_SUP];
  228.  
  229. static void
  230. OS2_initialize_message_lengths (void)
  231. {
  232.   unsigned int type = 0;
  233.   while (1)
  234.     {
  235.       (MESSAGE_LENGTH (type)) = 0;
  236.       if (type == MSG_TYPE_MAX)
  237.     break;
  238.       type += 1;
  239.     }
  240. }
  241.  
  242. void
  243. OS2_check_message_length_initializations (void)
  244. {
  245.   unsigned int type = 0;
  246.   while (1)
  247.     {
  248.       if ((MESSAGE_LENGTH (type)) == 0)
  249.     {
  250.       char buffer [64];
  251.       sprintf (buffer, "Message type %d not initialized.", type);
  252.       OS2_logic_error (buffer);
  253.     }
  254.       if (type == MSG_TYPE_MAX)
  255.     break;
  256.       type += 1;
  257.     }
  258. }
  259.  
  260. msg_length_t
  261. OS2_message_type_length (msg_type_t type)
  262. {
  263.   msg_length_t length;
  264.   if (type > MSG_TYPE_MAX)
  265.     {
  266.       char buffer [64];
  267.       sprintf (buffer, "Message type %d out of range.", type);
  268.       OS2_logic_error (buffer);
  269.     }
  270.   length = (MESSAGE_LENGTH (type));
  271.   if (length == 0)
  272.     {
  273.       char buffer [64];
  274.       sprintf (buffer, "Message type %d has unknown length.", type);
  275.       OS2_logic_error (buffer);
  276.     }
  277.   return (length);
  278. }
  279.  
  280. void
  281. OS2_set_message_type_length (msg_type_t type, msg_length_t length)
  282. {
  283.   (MESSAGE_LENGTH (type)) = length;
  284. }
  285.  
  286. msg_t *
  287. OS2_create_message_1 (msg_type_t type, msg_length_t extra)
  288. {
  289.   /* Do allocation carefully to prevent infinite loop when signalling
  290.      "out of memory" condition.  */
  291.   msg_t * message =
  292.     (OS2_malloc_noerror (((unsigned long) (OS2_message_type_length (type)))
  293.              + extra));
  294.   if (message == 0)
  295.     if ((type == mt_syscall_error)
  296.     && ((SM_SYSCALL_ERROR_CODE (message)) == ERROR_NOT_ENOUGH_MEMORY)
  297.     && ((SM_SYSCALL_ERROR_NAME (message)) == syscall_malloc))
  298.       OS2_logic_error ("Unable to allocate memory for error message.");
  299.     else
  300.       OS2_error_system_call (ERROR_NOT_ENOUGH_MEMORY, syscall_malloc);
  301.   (MSG_TYPE (message)) = type;
  302.   return (message);
  303. }
  304.  
  305. void
  306. OS2_destroy_message (msg_t * message)
  307. {
  308.   OS_free (message);
  309. }
  310.  
  311. /* Message Transmission and Reception */
  312.  
  313. void
  314. OS2_send_message (qid_t qid, msg_t * message)
  315. {
  316.   qid_t twin = (QID_TWIN (qid));
  317.   tqueue_t * tqueue;
  318.   if ((twin == QID_NONE) || ((tqueue = (QID_TQUEUE (twin))) == 0))
  319.     /* Other end of connection has been closed, so discard the
  320.        message.  We used to signal an error here, but this can happen
  321.        pretty easily when closing windows or exiting Scheme.  The only
  322.        way to avoid this is to force synchronization of communicating
  323.        threads, which can be tricky.  For example, when closing a PM
  324.        window, it's not obvious when the last message will be
  325.        generated by the PM thread.  So it's just simpler to ignore
  326.        messages after the receiver decides it's no longer interested
  327.        in them.  */
  328.     OS2_destroy_message (message);
  329.   else
  330.     {
  331.       (MSG_SENDER (message)) = twin;
  332.       write_tqueue (tqueue, message);
  333.     }
  334. }
  335.  
  336. msg_t *
  337. OS2_receive_message (qid_t qid, int blockp, int interruptp)
  338. {
  339.   tqueue_t * tqueue = (QID_TQUEUE (qid));
  340.   msg_t * message;
  341.   if (tqueue == 0)
  342.     {
  343.       if ((OS2_current_tid ()) != OS2_scheme_tid)
  344.     /* This behavior is a little random, but it's based on the
  345.        idea that if an inferior thread is reading from a closed
  346.        channel, this is due to a race condition, and the fact that
  347.        the channel is closed means that the thread is no longer
  348.        needed.  So far this has only happened under one
  349.        circumstance, and in that case, this is the correct action.  */
  350.     OS2_endthread ();
  351.       else
  352.     OS2_error_anonymous ();
  353.     }
  354.   while (1)
  355.     {
  356.       while ((read_tqueue (tqueue, 0)) != 0)
  357.     ;
  358.       if ((TQUEUE_TYPE (tqueue)) == tqt_scm)
  359.     {
  360.       process_interrupt_messages ();
  361.       if (interruptp)
  362.         deliver_pending_interrupts ();
  363.     }
  364.       message = (read_subqueue (qid));
  365.       if ((!blockp) || (message != 0))
  366.     break;
  367.       (void) read_tqueue (tqueue, 1);
  368.     }
  369.   return (message);
  370. }
  371.  
  372. msg_avail_t
  373. OS2_message_availablep (qid_t qid, int blockp)
  374. {
  375.   tqueue_t * tqueue = (QID_TQUEUE (qid));
  376.   if (tqueue == 0)
  377.     return (mat_not_available);
  378.   while (1)
  379.     {
  380.       while ((read_tqueue (tqueue, 0)) != 0)
  381.     ;
  382.       if ((TQUEUE_TYPE (tqueue)) == tqt_scm)
  383.     {
  384.       process_interrupt_messages ();
  385.       if (pending_interrupts_p ())
  386.         return (mat_interrupt);
  387.     }
  388.       if (!subqueue_emptyp (qid))
  389.     return (mat_available);
  390.       if (!blockp)
  391.     return (mat_not_available);
  392.       (void) read_tqueue (tqueue, 1);
  393.     }
  394. }
  395.  
  396. msg_t *
  397. OS2_wait_for_message (qid_t qid, msg_type_t reply_type)
  398. {
  399.   msg_t * reply = (OS2_receive_message (qid, 1, 0));
  400.   if (OS2_error_message_p (reply))
  401.     OS2_handle_error_message (reply);
  402.   if ((MSG_TYPE (reply)) != reply_type)
  403.     OS2_logic_error ("Incorrect reply message type.");
  404.   return (reply);
  405. }
  406.  
  407. msg_t *
  408. OS2_message_transaction (qid_t qid, msg_t * request, msg_type_t reply_type)
  409. {
  410.   OS2_send_message (qid, request);
  411.   return (OS2_wait_for_message (qid, reply_type));
  412. }
  413.  
  414. static void
  415. write_subqueue (msg_t * message)
  416. {
  417.   qid_t qid = (MSG_SENDER (message));
  418.   qid_receive_filter_t filter = (QID_FILTER (qid));
  419.   if (filter != 0)
  420.     {
  421.       message = ((* filter) (message));
  422.       if (message == 0)
  423.     return;
  424.     }
  425.   OS2_request_mutex_semaphore (QID_LOCK (qid));
  426.   if (QID_SUBQUEUE (qid))
  427.     OS2_msg_fifo_insert ((QID_SUBQUEUE (qid)), message);
  428.   else
  429.     /* If subqueue is gone, qid has been closed. */
  430.     OS2_destroy_message (message);
  431.   OS2_release_mutex_semaphore (QID_LOCK (qid));
  432. }
  433.  
  434. static msg_t *
  435. read_subqueue (qid_t qid)
  436. {
  437.   msg_t * result;
  438.   OS2_request_mutex_semaphore (QID_LOCK (qid));
  439.   result = (OS2_msg_fifo_remove (QID_SUBQUEUE (qid)));
  440.   OS2_release_mutex_semaphore (QID_LOCK (qid));
  441.   return (result);
  442. }
  443.  
  444. void
  445. OS2_unread_message (qid_t qid, msg_t * message)
  446. {
  447.   OS2_request_mutex_semaphore (QID_LOCK (qid));
  448.   OS2_msg_fifo_insert_front ((QID_SUBQUEUE (qid)), message);
  449.   OS2_release_mutex_semaphore (QID_LOCK (qid));
  450. }
  451.  
  452. static int
  453. subqueue_emptyp (qid_t qid)
  454. {
  455.   int result;
  456.   OS2_request_mutex_semaphore (QID_LOCK (qid));
  457.   result = (OS2_msg_fifo_emptyp (QID_SUBQUEUE (qid)));
  458.   OS2_release_mutex_semaphore (QID_LOCK (qid));
  459.   return (result);
  460. }
  461.  
  462. int
  463. OS2_tqueue_select (tqueue_t * tqueue, int blockp)
  464. {
  465.   msg_t * message = (read_tqueue (tqueue, blockp));
  466.   if ((TQUEUE_TYPE (tqueue)) == tqt_scm)
  467.     {
  468.       process_interrupt_messages ();
  469.       if (pending_interrupts_p ())
  470.     return (-2);
  471.     }
  472.   return ((message != 0) ? (MSG_SENDER (message)) : (-1));
  473. }
  474.  
  475. static msg_t *
  476. read_tqueue (tqueue_t * tqueue, int blockp)
  477. {
  478.   switch (TQUEUE_TYPE (tqueue))
  479.     {
  480.     case tqt_std:
  481.       return (read_std_tqueue (tqueue, blockp));
  482.     case tqt_scm:
  483.       return (read_scm_tqueue (tqueue, blockp));
  484.     case tqt_pm:
  485.       return (OS2_read_pm_tqueue (tqueue, blockp));
  486.     }
  487. }
  488.  
  489. static void
  490. write_tqueue (tqueue_t * tqueue, msg_t * message)
  491. {
  492.   switch (TQUEUE_TYPE (tqueue))
  493.     {
  494.     case tqt_std:
  495.       write_std_tqueue (tqueue, message);
  496.       break;
  497.     case tqt_scm:
  498.       write_scm_tqueue (tqueue, message);
  499.       break;
  500.     case tqt_pm:
  501.       OS2_write_pm_tqueue (tqueue, message);
  502.       break;
  503.     }
  504. }
  505.  
  506. /* Uncomment the following definition in order to use OS/2 queues.
  507.  
  508.    There seems to be some kind of bug when using them, which manifests
  509.    itself as an access violation while reading from a socket.  I don't
  510.    understand this and have been unable to debug it successfully.
  511.  
  512.    Since my intention was to find a way to speed up the
  513.    message-handling mechanism, and there is no noticeable improvement,
  514.    it probably isn't worth much more effort to find the bug.  */
  515.  
  516. /* #define USE_OS2_QUEUES */
  517. #ifdef USE_OS2_QUEUES
  518.  
  519. typedef struct
  520. {
  521.   tqueue_type_t type;
  522.   HQUEUE fifo;
  523.   HEV event;            /* event semaphore */
  524. } std_tqueue_t;
  525. #define STD_TQUEUE_FIFO(q) (((std_tqueue_t *) (q)) -> fifo)
  526. #define STD_TQUEUE_EVENT(q) (((std_tqueue_t *) (q)) -> event)
  527.  
  528. tqueue_t *
  529. OS2_make_std_tqueue (void)
  530. {
  531.   tqueue_t * tqueue = (OS_malloc (sizeof (std_tqueue_t)));
  532.   (TQUEUE_TYPE (tqueue)) = tqt_std;
  533.   (STD_TQUEUE_FIFO (tqueue)) = (OS2_create_queue (QUE_FIFO));
  534.   (STD_TQUEUE_EVENT (tqueue)) = (OS2_create_event_semaphore (0, 0));
  535.   return (tqueue);
  536. }
  537.  
  538. static msg_t *
  539. read_std_tqueue_1 (tqueue_t * tqueue, int blockp)
  540. {
  541.   ULONG type;
  542.   ULONG length;
  543.   PVOID data;
  544.   return
  545.     ((OS2_read_queue ((STD_TQUEUE_FIFO (tqueue)),
  546.               (&type),
  547.               (&length),
  548.               (&data),
  549.               (blockp ? 0 : (STD_TQUEUE_EVENT (tqueue)))))
  550.      ? data
  551.      : 0);
  552. }
  553.  
  554. void
  555. OS2_close_std_tqueue (tqueue_t * tqueue)
  556. {
  557.   while (1)
  558.     {
  559.       msg_t * msg = (read_std_tqueue_1 (tqueue, 0));
  560.       if (msg == 0)
  561.     break;
  562.       OS2_destroy_message (msg);
  563.     }
  564.   OS2_close_queue (STD_TQUEUE_FIFO (tqueue));
  565.   OS2_close_event_semaphore (STD_TQUEUE_EVENT (tqueue));
  566.   OS_free (tqueue);
  567. }
  568.  
  569. static msg_t *
  570. read_std_tqueue (tqueue_t * tqueue, int blockp)
  571. {
  572.   msg_t * message = (read_std_tqueue_1 (tqueue, blockp));
  573.   if (message)
  574.     write_subqueue (message);
  575.   return (message);
  576. }
  577.  
  578. static void
  579. write_std_tqueue (tqueue_t * tqueue, msg_t * message)
  580. {
  581.   OS2_write_queue ((STD_TQUEUE_FIFO (tqueue)), 0, 0, message, 0);
  582. }
  583.  
  584. #else /* not USE_OS2_QUEUES */
  585.  
  586. typedef struct
  587. {
  588.   tqueue_type_t type;
  589.   void * fifo;
  590.   unsigned int n_blocked;    /* # of blocked threads */
  591.   HMTX mutex;            /* mutex semaphore */
  592.   HEV event;            /* event semaphore */
  593. } std_tqueue_t;
  594. #define STD_TQUEUE_FIFO(q) (((std_tqueue_t *) (q)) -> fifo)
  595. #define STD_TQUEUE_MUTEX(q) (((std_tqueue_t *) (q)) -> mutex)
  596. #define STD_TQUEUE_EVENT(q) (((std_tqueue_t *) (q)) -> event)
  597. #define STD_TQUEUE_N_BLOCKED(q) (((std_tqueue_t *) (q)) -> n_blocked)
  598.  
  599. tqueue_t *
  600. OS2_make_std_tqueue (void)
  601. {
  602.   tqueue_t * tqueue = (OS_malloc (sizeof (std_tqueue_t)));
  603.   (TQUEUE_TYPE (tqueue)) = tqt_std;
  604.   (STD_TQUEUE_FIFO (tqueue)) = (OS2_create_msg_fifo ());
  605.   (STD_TQUEUE_N_BLOCKED (tqueue)) = 0;
  606.   (STD_TQUEUE_MUTEX (tqueue)) = (OS2_create_mutex_semaphore (0, 0));
  607.   (STD_TQUEUE_EVENT (tqueue)) = (OS2_create_event_semaphore (0, 0));
  608.   return (tqueue);
  609. }
  610.  
  611. void
  612. OS2_close_std_tqueue (tqueue_t * tqueue)
  613. {
  614.   OS2_close_event_semaphore (STD_TQUEUE_EVENT (tqueue));
  615.   OS2_close_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  616.   while (1)
  617.     {
  618.       msg_t * msg = (OS2_msg_fifo_remove (STD_TQUEUE_FIFO (tqueue)));
  619.       if (msg == 0)
  620.     break;
  621.       OS2_destroy_message (msg);
  622.     }
  623.   OS_free (tqueue);
  624. }
  625.  
  626. static msg_t *
  627. read_std_tqueue (tqueue_t * tqueue, int blockp)
  628. {
  629.   OS2_request_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  630.   while (1)
  631.     {
  632.       msg_t * message = (OS2_msg_fifo_remove (STD_TQUEUE_FIFO (tqueue)));
  633.       if (message != 0)
  634.     {
  635.       OS2_release_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  636.       write_subqueue (message);
  637.       return (message);
  638.     }
  639.       if (!blockp)
  640.     {
  641.       OS2_release_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  642.       return (0);
  643.     }
  644.       (void) OS2_reset_event_semaphore (STD_TQUEUE_EVENT (tqueue));
  645.       (STD_TQUEUE_N_BLOCKED (tqueue)) += 1;
  646.       OS2_release_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  647.       (void) OS2_wait_event_semaphore ((STD_TQUEUE_EVENT (tqueue)), 1);
  648.       OS2_request_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  649.       (STD_TQUEUE_N_BLOCKED (tqueue)) -= 1;
  650.       /* This prevents the 16 bit counter inside the event
  651.      semaphore from overflowing.  */
  652.       if ((STD_TQUEUE_N_BLOCKED (tqueue)) == 0)
  653.     (void) OS2_reset_event_semaphore (STD_TQUEUE_EVENT (tqueue));
  654.       /* Don't wait more than once; the caller must be prepared to
  655.      call again if a message is required.  The reason this is
  656.      necessary is that two threads may be waiting on the same
  657.      tqueue at the same time, and when a message shows up, the
  658.      wrong thread might read it.  If we allowed the loop to
  659.      continue, the thread that was waiting for the message would
  660.      wake up, see no message, and go to sleep; meanwhile, the
  661.      other thread has already stored the message in the correct
  662.      subqueue.  */
  663.       blockp = 0;
  664.     }
  665. }
  666.  
  667. static void
  668. write_std_tqueue (tqueue_t * tqueue, msg_t * message)
  669. {
  670.   OS2_request_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  671.   OS2_msg_fifo_insert ((STD_TQUEUE_FIFO (tqueue)), message);
  672.   if ((STD_TQUEUE_N_BLOCKED (tqueue)) > 0)
  673.     {
  674.       (void) OS2_post_event_semaphore (STD_TQUEUE_EVENT (tqueue));
  675.       OS2_release_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  676.       /* Immediately transfer control to the receiver.
  677.      This should improve responsiveness of the system.  */
  678.       (void) DosSleep (0);
  679.     }
  680.   else
  681.     OS2_release_mutex_semaphore (STD_TQUEUE_MUTEX (tqueue));
  682. }
  683.  
  684. #endif /* not USE_OS2_QUEUES */
  685.  
  686. static tqueue_t *
  687. make_scm_tqueue (void)
  688. {
  689.   tqueue_t * tqueue = (OS2_make_std_tqueue ());
  690.   (TQUEUE_TYPE (tqueue)) = tqt_scm;
  691.   return (tqueue);
  692. }
  693.  
  694. char OS2_scheme_tqueue_avail_map [QID_MAX + 1];
  695.  
  696. static msg_t *
  697. read_scm_tqueue (tqueue_t * tqueue, int blockp)
  698. {
  699.   /* The handling of the interrupt bit is a little tricky.  We clear
  700.      the bit, then handle any events, and finally clear the bit again.
  701.      If the bit is set during the second clear, we must loop since
  702.      another event might have been queued in the window between the
  703.      last read and the second clear -- and since we cleared the bit no
  704.      one else is going to look at the queue until another event comes
  705.      along.
  706.      
  707.      This code serves two purposes.  First, this is the only way to
  708.      reliably clear the interrupt bit to avoid having an event stuck
  709.      in the queue and the Scheme thread not bothering to look.
  710.      Second, if we arrive at this read-dispatch loop by some means
  711.      other than the attention-interrupt mechanism, this will clear the
  712.      bit and thus avoid ever invoking the mechanism.  */
  713.   msg_t * result = 0;
  714.   (void) test_and_clear_attention_interrupt ();
  715.   do
  716.     {
  717.       msg_t * message = (read_std_tqueue (tqueue, blockp));
  718.       if (message != 0)
  719.     {
  720.       (OS2_scheme_tqueue_avail_map [MSG_SENDER (message)]) = 1;
  721.       result = message;
  722.       /* At most one message needs to be read in blocking mode.  */
  723.       blockp = 0;
  724.     }
  725.     }
  726.   while (test_and_clear_attention_interrupt ());
  727.   return (result);
  728. }
  729.  
  730. static void
  731. write_scm_tqueue (tqueue_t * tqueue, msg_t * message)
  732. {
  733.   write_std_tqueue (tqueue, message);
  734.   request_attention_interrupt ();
  735. }
  736.  
  737. void
  738. OS2_handle_attention_interrupt (void)
  739. {
  740.   tqueue_t * tqueue = (QID_TQUEUE (OS2_interrupt_qid_local));
  741.   while ((read_tqueue (tqueue, 0)) != 0)
  742.     ;
  743.   process_interrupt_messages ();
  744. }
  745.  
  746. static void
  747. process_interrupt_messages (void)
  748. {
  749.   /* Reads all of the interrupts out of the interrupt queue, and sets
  750.      the corresponding bits in the interrupt word.  */
  751.   while (1)
  752.     {
  753.       msg_t * message = (read_subqueue (OS2_interrupt_qid_local));
  754.       if (message == 0)
  755.     break;
  756.       switch (MSG_TYPE (message))
  757.     {
  758.     case mt_console_interrupt:
  759.       tty_set_next_interrupt_char (SM_CONSOLE_INTERRUPT_CODE (message));
  760.       break;
  761.     case mt_timer_event:
  762.       request_timer_interrupt ();
  763.       break;
  764.     default:
  765.       OS2_logic_error ("Illegal message type in interrupt queue.");
  766.       break;
  767.     }
  768.       OS2_destroy_message (message);
  769.     }
  770. }
  771.  
  772. #define BUFFER_MIN_LENGTH 16
  773.  
  774. typedef struct
  775. {
  776.   unsigned int start;
  777.   unsigned int end;
  778.   unsigned int count;
  779.   unsigned int buffer_length;
  780.   void ** buffer;
  781. } msg_fifo_t;
  782.  
  783. void *
  784. OS2_create_msg_fifo (void)
  785. {
  786.   msg_fifo_t * fifo = (OS_malloc (sizeof (msg_fifo_t)));
  787.   (fifo -> start) = 0;
  788.   (fifo -> end) = 0;
  789.   (fifo -> count) = 0;
  790.   (fifo -> buffer_length) = BUFFER_MIN_LENGTH;
  791.   (fifo -> buffer)
  792.     = (OS_malloc ((fifo -> buffer_length) * (sizeof (void *))));
  793.   return (fifo);
  794. }
  795.  
  796. void
  797. OS2_destroy_msg_fifo (void * fp)
  798. {
  799.   OS_free (((msg_fifo_t *) fp) -> buffer);
  800.   OS_free (fp);
  801. }
  802.  
  803. #define MAYBE_GROW_BUFFER(fifo)                        \
  804. {                                    \
  805.   if ((fifo -> count) >= (fifo -> buffer_length))            \
  806.     msg_fifo_grow (fifo);                        \
  807. }
  808.  
  809. #define MAYBE_SHRINK_BUFFER(fifo)                    \
  810. {                                    \
  811.   if (((fifo -> buffer_length) > BUFFER_MIN_LENGTH)            \
  812.       && ((fifo -> count) < ((fifo -> buffer_length) / 4)))        \
  813.     msg_fifo_shrink (fifo);                        \
  814. }
  815.  
  816. #define REALLOC_BUFFER(fifo, new_length)                \
  817. {                                    \
  818.   ((fifo) -> buffer_length) = (new_length);                \
  819.   ((fifo) -> buffer)                            \
  820.     = (OS_realloc (((fifo) -> buffer),                    \
  821.            (((fifo) -> buffer_length) * (sizeof (void *)))));    \
  822. }
  823.  
  824. static void
  825. msg_fifo_grow (msg_fifo_t * fifo)
  826. {
  827.   unsigned int old_length = (fifo -> buffer_length);
  828.   REALLOC_BUFFER (fifo, (old_length * 2));
  829.   if ((fifo -> end) <= (fifo -> start))
  830.     {
  831.       void ** from = (fifo -> buffer);
  832.       void ** stop = ((fifo -> buffer) + (fifo -> end));
  833.       void ** to = ((fifo -> buffer) + old_length);
  834.       while (from < stop)
  835.     (*to++) = (*from++);
  836.       (fifo -> end) += old_length;
  837.     }
  838. }
  839.  
  840. static void
  841. msg_fifo_shrink (msg_fifo_t * fifo)
  842. {
  843.   unsigned int new_length = ((fifo -> buffer_length) / 2);
  844.   if ((fifo -> end) < (fifo -> start))
  845.     {
  846.       void ** from = ((fifo -> buffer) + (fifo -> start));
  847.       void ** stop = ((fifo -> buffer) + (fifo -> buffer_length));
  848.       void ** to = (from - new_length);
  849.       while (from < stop)
  850.     (*to++) = (*from++);
  851.       (fifo -> start) -= new_length;
  852.     }
  853.   else if ((fifo -> end) > new_length)
  854.     {
  855.       void ** from = ((fifo -> buffer) + (fifo -> start));
  856.       void ** stop = ((fifo -> buffer) + (fifo -> end));
  857.       void ** to = (fifo -> buffer);
  858.       while (from < stop)
  859.     (*to++) = (*from++);
  860.       (fifo -> end) -= (fifo -> start);
  861.       (fifo -> start) = 0;
  862.     }
  863.   REALLOC_BUFFER (fifo, new_length);
  864. }
  865.  
  866. void
  867. OS2_msg_fifo_insert (void * fp, void * element)
  868. {
  869.   msg_fifo_t * fifo = fp;
  870.   MAYBE_GROW_BUFFER (fifo);
  871.   if ((fifo -> end) == (fifo -> buffer_length))
  872.     (fifo -> end) = 0;
  873.   ((fifo -> buffer) [(fifo -> end) ++]) = element;
  874.   (fifo -> count) += 1;
  875. }
  876.  
  877. void
  878. OS2_msg_fifo_insert_front (void * fp, void * element)
  879. {
  880.   msg_fifo_t * fifo = fp;
  881.   MAYBE_GROW_BUFFER (fifo);
  882.   if ((fifo -> start) == 0)
  883.     (fifo -> start) = (fifo -> buffer_length);
  884.   ((fifo -> buffer) [-- (fifo -> start)]) = element;
  885.   (fifo -> count) += 1;
  886. }
  887.  
  888. void *
  889. OS2_msg_fifo_remove (void * fp)
  890. {
  891.   msg_fifo_t * fifo = fp;
  892.   void * element;
  893.   if ((fifo -> count) == 0)
  894.     return (0);
  895.   element = ((fifo -> buffer) [(fifo -> start) ++]);
  896.   if ((fifo -> start) == (fifo -> buffer_length))
  897.     (fifo -> start) = 0;
  898.   if ((-- (fifo -> count)) == 0)
  899.     {
  900.       (fifo -> start) = 0;
  901.       (fifo -> end) = 0;
  902.     }
  903.   MAYBE_SHRINK_BUFFER (fifo);
  904.   return (element);
  905. }
  906.  
  907. void *
  908. OS2_msg_fifo_remove_last (void * fp)
  909. {
  910.   msg_fifo_t * fifo = fp;
  911.   void * element;
  912.   if ((fifo -> count) == 0)
  913.     return (0);
  914.   element = ((fifo -> buffer) [-- (fifo -> end)]);
  915.   if ((fifo -> end) == 0)
  916.     (fifo -> end) = (fifo -> buffer_length);
  917.   if ((-- (fifo -> count)) == 0)
  918.     {
  919.       (fifo -> start) = 0;
  920.       (fifo -> end) = 0;
  921.     }
  922.   MAYBE_SHRINK_BUFFER (fifo);
  923.   return (element);
  924. }
  925.  
  926. void **
  927. OS2_msg_fifo_remove_all (void * fp)
  928. {
  929.   msg_fifo_t * fifo = fp;
  930.   void ** result = (OS_malloc (((fifo -> count) + 1) * (sizeof (void *))));
  931.   void ** from = ((fifo -> buffer) + (fifo -> start));
  932.   void ** stop;
  933.   void ** to = result;
  934.   if ((fifo -> start) < (fifo -> end))
  935.     {
  936.       stop = ((fifo -> buffer) + (fifo -> end));
  937.       while (from < stop)
  938.     (*to++) = (*from++);
  939.     }
  940.   else if ((fifo -> count) > 0)
  941.     {
  942.       stop = ((fifo -> buffer) + (fifo -> buffer_length));
  943.       while (from < stop)
  944.     (*to++) = (*from++);
  945.       from = (fifo -> buffer);
  946.       stop = ((fifo -> buffer) + (fifo -> end));
  947.       while (from < stop)
  948.     (*to++) = (*from++);
  949.     }
  950.   (*to) = 0;
  951.   (fifo -> start) = 0;
  952.   (fifo -> end) = 0;
  953.   (fifo -> count) = 0;
  954.   if ((fifo -> buffer_length) > BUFFER_MIN_LENGTH)
  955.     REALLOC_BUFFER (fifo, BUFFER_MIN_LENGTH);
  956.   return (result);
  957. }
  958.  
  959. int
  960. OS2_msg_fifo_emptyp (void * fp)
  961. {
  962.   msg_fifo_t * fifo = fp;
  963.   return ((fifo -> count) == 0);
  964. }
  965.  
  966. unsigned int
  967. OS2_msg_fifo_count (void * fp)
  968. {
  969.   msg_fifo_t * fifo = fp;
  970.   return (fifo -> count);
  971. }
  972.  
  973. void *
  974. OS2_msg_fifo_last (void * fp)
  975. {
  976.   msg_fifo_t * fifo = fp;
  977.   return (((fifo -> count) == 0) ? 0 : ((fifo -> buffer) [(fifo -> end) - 1]));
  978. }
  979.