1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 
 15 /****^  HISTORY COMMENTS:
 16   1) change(86-09-17,LJAdams), approve(86-11-11,MCR7485),
 17      audit(86-12-16,Margolin), install(87-01-06,MR12.0-1255):
 18      Correct stringrange problem - after function was completed it continued to
 19      loop until stack was exhausted.
 20                                                    END HISTORY COMMENTS */
 21 
 22 
 23 /* Benson I. Margulies, sometime in 1981 */
 24 /* format: style2,linecom,^indnoniterdo,indcomtxt,^inditerdo,dclind5,idind25 */
 25 
 26 /* Modified 24 May 1982 by William M. York to eliminate an optimization
 27    for the first level of block which led to a loop sending and receiving
 28    wakeups. */
 29 /* Modified 14 September 1982 by WMY to add the $internal entrypoint.  This
 30    is intended for use by other parts of tc_ (e.g. check_echonego in tc_input)
 31    which want to block with protocol, but have no window_ level request
 32    structure to pass in. */
 33 /* Modified 20 September 1982 by WMY to remove the $internal entrypoint.  We
 34    must ALWAYS block on the behalf of some particular window for the async
 35    stuff to work right, so all callers will just have to be changed to pass
 36    in a request_ptr. */
 37 /* Modified 7 February 1985 by Jon Rochlis to add RESTORE_MASK so we can
 38    restore the user's ips mask before we block, instead of just unmasking
 39    everything. */
 40 
 41 tc_block:
 42      procedure (TC_data_ptr, Request_ptr, mask_type);
 43 
 44           declare TC_data_ptr              pointer;
 45           declare Request_ptr              pointer;
 46 
 47 /* ordinarily, we unmask for the block, but in the case of awaiting a mark
 48    we want to allow only quit. This is to prevent other stuff from
 49    happening when we are doing a critical sync, because if the async thing
 50    should need to sync to a mark, we would lack one to give it.
 51 
 52    This is really poor, a major limitation on async input.
 53 
 54    (Now instead of unmasking, we usually restore the old mask ... JR 2/7/85)
 55 */
 56 
 57           declare mask_type                bit (36) aligned;
 58 
 59           declare UNMASK_ALL               bit (36) aligned initial (""b) internal static options (constant);
 60           declare UNMASK_QUIT_ONLY         bit (36) aligned initial ("1"b) internal static options (constant);
 61           declare UNMASK_NOTHING           bit (36) aligned initial ("01"b) internal static options (constant);
 62           declare RESTORE_MASK             bit (36) aligned initial ("001"b) internal static options (constant);
 63 
 64           declare 1 EWI                    aligned like event_wait_info automatic;
 65           declare 1 event_wait             aligned,
 66                     2 n_channels           fixed bin,
 67                     2 pad                  bit (36) aligned,
 68                     2 channels             (2) fixed bin (71);
 69 
 70           declare ipc_$block               entry (ptr, ptr, fixed bin (35));
 71           declare ipc_$create_ev_chn       entry (fixed bin (71), fixed bin (35));
 72           declare tc_error                 entry (fixed bin (35), character (*));
 73           declare (
 74                   tc_mask$close,
 75                   tc_mask$open_all,
 76                   tc_mask$open_quit
 77                   )                        external entry;
 78 
 79           declare tc_mask$restore          entry (bit (36) aligned);
 80 
 81           declare hcs_$get_ips_mask        entry (bit (36) aligned);
 82 
 83           declare ips_mask                 bit (36) aligned;
 84           declare saved_change_pclock      fixed bin (35);
 85           declare code                     fixed bin (35);
 86           declare cleanup                  condition;
 87           declare addr                     builtin;
 88 ^L
 89 
 90           tc_data_ptr = TC_data_ptr;
 91           request_ptr = Request_ptr;
 92 
 93           state.pending.count = tc_data.state.pending.count + 1;
 94           state_have_sent_protocol (tc_data.state.pending.count) = "0"b;
 95           state_async_same_window (tc_data.state.pending.count) = "0"b;
 96 
 97           tc_data.state.pending.blocked_windows (tc_data.state.pending.count) = request_header.window_id;
 98 
 99           event_wait.n_channels = 0;
100 
101           event_wait.pad = ""b;
102           event_wait.channels (1) = tc_data.event;
103 
104 /* Set up a second event channel to block on in conjunction with
105    the actual input channel. A wakeup will be sent on this protocol
106    channel by later (recursive) invocations of tc_block when they
107    receive real input wakeups. */
108 
109           event_wait.n_channels = 2;
110           if tc_data.state.pending.protocol_evs (tc_data.state.pending.count) = 0
111           then do;
112                call ipc_$create_ev_chn (event_wait.channels (2), (0));
113                tc_data.state.pending.protocol_evs (tc_data.state.pending.count) = event_wait.channels (2);
114           end;
115           else event_wait.channels (2) = tc_data.state.pending.protocol_evs (tc_data.state.pending.count);
116 
117           ips_mask = request_header.saved_ips_mask;
118 
119           on cleanup
120                begin;
121                     state.pending.count = state.pending.count - 1;
122                     if mask_type = RESTORE_MASK
123                     then call hcs_$get_ips_mask (request_header.saved_ips_mask);
124                end;
125 
126           saved_change_pclock = tc_data.change_pclock;
127 
128           if mask_type = UNMASK_QUIT_ONLY                   /* actually, this lets trm_ and sus_ and neti through, as well */
129           then call tc_mask$open_quit;
130           else if mask_type = UNMASK_ALL
131           then call tc_mask$open_all;
132           else if mask_type = UNMASK_NOTHING
133           then ;
134           else if mask_type = RESTORE_MASK
135           then call tc_mask$restore (ips_mask);
136 
137           call ipc_$block (addr (event_wait), addr (EWI), code);
138 
139           call tc_mask$close ();                            /* superfluous if we didnt unmask */
140           revert cleanup;
141           tc_data.state.pending.count = tc_data.state.pending.count - 1;
142 
143           if code ^= 0
144           then call tc_error (code, "Terminal Control could not block.");
145 
146 
147           if (tc_data.change_pclock ^= saved_change_pclock)
148           then do;
149                request_header.async_interruption = "1"b;
150 
151                if state_async_same_window (tc_data.state.pending.count + 1)
152                then request_header.this_window = "1"b;
153           end;
154 
155 start_if_we_have_to:
156           begin;
157 
158                declare hcs_$wakeup              entry (bit (*), fixed bin (71), fixed bin (71), fixed bin (35));
159                declare get_process_id_          entry () returns (bit (36));
160 
161 /* This code checks to see if anyone is waiting on protocol
162    wakeups (i.e. this is a recursive call), and sends a wakeup
163    to the protocol channel one above us.  Only one wakeup will
164    be sent on each level. */
165 
166                if tc_data.state.pending.count > 0
167                then if ^state_have_sent_protocol (tc_data.state.pending.count)
168                     then do;                                /* Somebody is blocked */
169                          call hcs_$wakeup (get_process_id_ (),
170                               tc_data.state.pending.protocol_evs (tc_data.state.pending.count), 0, code);
171 
172                          if code ^= 0
173                          then call tc_error (code, "wakeup failed");
174                          state_have_sent_protocol (tc_data.state.pending.count) = "1"b;
175                                                             /* only send ONE wakeup */
176                     end;
177           end start_if_we_have_to;
178 
179 
180 %page;
181 %include tc_data_;
182 %include tc_operations_;
183 %include event_wait_info;
184 
185      end tc_block;