1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 
 10 /****^  HISTORY COMMENTS:
 11   1) change(86-07-08,Coren), approve(86-07-08,MCR7300),
 12      audit(86-07-08,Beattie), install(86-07-08,MR12.0-1089):
 13      Changed to use v1_echo_neg_data for compatibility.
 14   2) change(86-07-15,LJAdams), approve(86-11-11,MCR7485),
 15      audit(86-12-16,Margolin), install(87-01-06,MR12.0-1255):
 16      Modified to support MOWSE.
 17   3) change(86-11-26,LJAdams), approve(86-11-26,MCR7584),
 18      audit(86-12-16,Margolin), install(87-01-06,MR12.0-1255):
 19      Initial DSA coding has been maintained in a non-executable form.
 20   4) change(87-02-10,LJAdams), approve(87-03-19,MCR7642),
 21      audit(87-04-24,Gilcrease), install(87-05-14,MR12.1-1030):
 22      Passing a (-1) parameter to ws_tty_$read_echoed on the initial read.
 23   5) change(87-02-12,RBarstad), approve(87-03-19,MCR7642),
 24      audit(87-04-24,Gilcrease), install(87-05-14,MR12.1-1030):
 25      Don't try to reset the break table if operation is OP_READ_ONE.
 26      The break table is not needed on read one char and it was never
 27      init'ed in the request_read structure by window_ anyway.
 28   6) change(87-02-17,RBarstad), approve(87-03-19,MCR7642),
 29      audit(87-04-24,Gilcrease), install(87-05-14,MR12.1-1030):
 30      Added block bit to read_with_mark call.
 31   7) change(87-06-02,RBarstad), approve(87-02-17,MCR7485),
 32      audit(87-06-30,Gilcrease), install(87-08-04,MR12.1-1055):
 33      In ...$read_and_buffer changed the (-1) back to "dummy" and added the
 34      "screen_left" variable for readability.
 35   8) change(87-06-15,LJAdams), approve(87-06-15,MCR7584),
 36      audit(87-06-30,Gilcrease), install(87-08-04,MR12.1-1055):
 37      When calling dsa_tty_$read_echoed set return code to 0 to prevent
 38      blockage of interactive messages.
 39   9) change(88-09-27,LJAdams), approve(88-09-27,MCR8001),
 40      audit(88-10-06,Farley), install(88-10-07,MR12.2-1148):
 41      There was a problem with the bounds of the data and/or control buffers
 42      being pointed to by the input buffer being exceeded; to correct this a
 43      check has been implemented in add_1_to_buffer, and common to ensure
 44      that the current buffer length as kept track of in the input_buffer
 45      structure plus the characters to be added will not exceed bounds of
 46      the existing data/control buffer arrays. If the check fails the
 47      push_buffer routine is called to push the data down by eliminating
 48      those characters marked for deletion.  If this fails the size of
 49      the data_buffer and the control_buffer is increased by calling the
 50      grow_buffer routine.
 51                                                    END HISTORY COMMENTS */
 52 
 53 /* Terminal Control
 54    Input Processing -- low level
 55    Initial implementation -- May 1981
 56 
 57    This program accesses hcs_$tty_* directly. This programmed is destined
 58    to stay in Terminal Control when it is divested from the video system.
 59 
 60    Design and Initial Coding by Benson I. Margulies,
 61    inspiration by JRD, BSG, the cow's stomach,
 62    and lots of help from MND.
 63 
 64 */
 65 /* Modified April 82 by William York to call the new tty_read_echoed
 66    entrypoint, the replacement for echo_negotiate_get_chars. */
 67 /* Modified 23 June 82 by WMY to fix a bug in try_to_satisfy which
 68    caused spurious double echoing of asynchronous output that interrupted
 69    get_echoed_chars calls. */
 70 /* Modified 19 August 1982 by WMY to go blocked waiting for FNP interrupt
 71    when we get the echnego_awaiting_stop_sync code back from
 72    tty_read_echoed while closing out echo negotiation.  This FINALLY
 73    fixes the "looping while reading input" bug. */
 74 /* Modified 24 August 1982 to fix a bug in the above fix.  The close_out_echnego
 75    routine now calls ipc_$block directly instead of tc_block, since it
 76    doesn't want to deal with request structures from the caller. */
 77 /* Modified 10 September 1982 by WMY to fix a bug in the fix to the above
 78    fix.  It now calls tc_block$internal to make sure that protocol wakeups
 79    happen. */
 80 /* Modified 20 September 1982 by WMY.  Oh well, one more time.  Changed the
 81    check_echnego entry to take a request_ptr as a parameter, and call regular
 82    tc_block with that request_ptr.  We ALWAYS have to block on the behalf of
 83    some particular window for async stuff to work right. */
 84 /* Modified 22 September 1982 by WMY to remove the code that attempts to
 85    sync to the output already written if the input buffer length is 0.  This
 86    code went blocked until the user typed something, waiting for ring 0 to
 87    return the mark.  This was useless, and until ring 0 can be changed to
 88    return the mark without actually waiting for new input, tc_input will just
 89    return if the input buffer size is 0. */
 90 /* Modified 14 August 1984 by Jon A. Rochlis to remove the Code parameter from
 91    the init entry, since it is never used. It appears never to be used by the
 92    tc_input entry either, and I am real tempted to remove it altogether. */
 93 /* Modified 7 February 1985 by JR to use RESTORE_MASK instead of
 94    UNMASK_ALL when calling tc_block.  This will restore the user's mask
 95    instead of arbitrarly unmasking everything. */
 96 /* Modified June 1985 by Roger Negaret to support DSA networks. */
 97 
 98 /* format: style2,linecom,^indnoniterdo,indcomtxt,^inditerdo,dclind5,idind25 */
 99 tc_input:
100      procedure (TC_data_ptr, Request_ptr, Code);
101           go to do_input;                                   /* skip over all these dcls */
102 ^L
103 
104 /* Parameters */
105 
106           declare (
107                   Request_ptr              pointer,
108                   TC_data_ptr              pointer,
109                   Code                     fixed bin (35)
110                   )                        parameter;
111 
112 
113 %page;
114 %include net_event_message;
115 %include tc_operations_;
116 %page;
117 %include tc_data_;
118 %page;
119 %include tc_input_buffer_;
120 %page;
121 %include mcs_echo_neg;
122 %page;
123 
124           declare code                     fixed bin (35);
125           declare tty_state                fixed bin;
126 
127           declare dsa_tty_$read_echoed     entry (fixed bin (35), ptr, fixed bin (21), fixed bin (21), fixed bin (21),
128                                            fixed bin (21), fixed bin, fixed bin, fixed bin (35));
129 
130           declare ws_tty_$read_echoed      entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (21),
131                                            fixed bin (21), fixed bin, fixed bin, fixed bin (35));
132 
133           declare add_char_offset_         entry (ptr, fixed bin (21)) returns (ptr) reducible;
134           declare tc_request$write_echo    entry (pointer, char (*));
135           declare tc_error                 entry (fixed binary (35), character (*));
136 
137           declare tc_screen$text           entry (pointer, fixed bin, fixed bin, bit (1) aligned, character (*));
138 
139           declare tc_disconnect$check      entry (pointer, fixed bin (35));
140 
141           declare (
142                   video_et_$tc_tty_error,
143                   video_et_$tc_mark_missing
144                   )                        external static fixed bin (35);
145 
146           declare BUF_LEN                  fixed bin internal static options (constant) init (2048);
147           declare UNMASK_NOTHING           bit (36) aligned initial ("01"b) internal static options (constant);
148           declare RESTORE_MASK             bit (36) aligned initial ("001"b) internal static options (constant);
149 
150           declare (addr, byte, hbound, index, length, min, null, rank, rtrim, string, substr, unspec)
151                                            builtin;
152 ^L
153 
154 init:
155      entry (TC_data_ptr);
156 
157 /* The structure tc_data must be already allocated .
158    This program fills in the input side data */
159 
160           tc_data_ptr = TC_data_ptr;
161           state.echnego_outstanding = "0"b;
162 
163           allocate input_buffer set (input_buffer_ptr);
164           tc_data.input_buffer_ptr = input_buffer_ptr;
165           input_buffer.buffer_length = BUF_LEN;
166           allocate control_buffer set (input_buffer.control_ptr);
167           allocate data_buffer set (input_buffer.data_ptr);
168           input_buffer.n_valid = 0;
169           input_buffer.n_shifts = 0;
170           input_buffer.n_chars_valid = 0;
171           return;
172 ^L
173 
174 shut:
175      entry (TC_data_ptr);
176 
177           tc_data_ptr = TC_data_ptr;
178           input_buffer_ptr = tc_data.input_buffer_ptr;
179 
180           free data_buffer;
181           free control_buffer;
182           free input_buffer;
183           tc_data.input_buffer_ptr = null ();
184           return;
185 ^L
186 
187 do_input:
188           tc_data_ptr = TC_data_ptr;
189           input_buffer_ptr = tc_data.input_buffer_ptr;
190           Code = 0;
191           request_ptr = Request_ptr;
192 
193           declare 1 i_op                   aligned automatic,
194                                                             /* the stack is the q */
195                     2 buffer_ptr           pointer,
196                     2 buffer_length        fixed bin (21),
197                     2 cur_buffer_ptr       pointer,
198                     2 cur_buffer_length    fixed bin (21),
199                     2 write_buffer_count   fixed bin (21),
200                     2 flags                aligned,
201                       3 echo               bit (1) unaligned,
202                       3 mark_was_outstanding
203                                            bit (1) unaligned,
204                       3 write_sync_read    bit (1) unaligned,
205                       3 just_one_char      bit (1) unaligned,
206                       3 pad                bit (32) unaligned,
207                     2 buffer_index         fixed bin (21);  /* last place we scanned, relative to  buffers */
208 
209 /* ASSERT echonegotiation cannot be pending. */
210 /* ASSERT the request is get_chars_no_echo, get_chars_echo, read_status, or
211    write_sync_get_chars_no_echo */
212 
213 
214           if request_header.operation = OP_READ_STATUS
215           then do;
216                call read_status;
217                return;
218           end;
219 
220 /* ASSERT that a mark is cast after each output by tc_request */
221 
222 /* There are two limitations on the current mark implementation.
223 
224    (1) There is only one mark.
225 
226    (2) We cannot get the mark back unless there is some other
227    input from the terminal.
228 
229    As a result, the only available strategy for now is this:
230 
231    After each output, cast the mark. If it is already outstanding,
232    then it is lost.
233 
234    For an asyncronous request for input, we wait for the last mark
235    left out. This syncs us correctly.
236 
237    For a write-sync-read, the prompt has already been written and
238    marked, and we were called masked. */
239 
240 
241 /* One final case - a zero-length input request of any flavor is interpreted
242    as a request to sync input to output, using the last mark we put out */
243 /* Ring zero cannot currently return us the mark unless new input is typed
244    by the user after the mark is written.  This causes us to go blocked
245    waiting for some input if we want to read the mark.  Since that is pretty
246    useless, we will give up this sync attempt until ring 0 can be changed to
247    return the mark if it is there  without requiring that new input be typed.
248    -WMY 9/22/82  */
249 
250 
251 /* Old code to sync to mark, currently out of service.
252 
253    if request_read.buffer_length = 0
254    then do;
255    if mark_outstanding ()
256    then call retrieve_mark;
257    go to request_satisfied;
258    end;
259 
260 */
261 
262           if request_read.buffer_length = 0
263           then goto request_satisfied;
264 
265           unspec (i_op) = ""b;                              /* turn all the flags off */
266           i_op.mark_was_outstanding = mark_outstanding ();
267 
268           i_op.write_sync_read = (request_header.operation = OP_WRITE_SYNC_GET_CHARS_NO_ECHO);
269           i_op.just_one_char = (request_header.operation = OP_READ_ONE);
270 
271           i_op.buffer_index = 1;                            /* assume this request is interested in whole buffer. If it requires a mark, this will get reset by retrieve_mark */
272 
273 /* ASSERT mark_outstanding, trust tc_request to have wrote mark after cursorpos */
274 
275           if i_op.write_sync_read
276           then call retrieve_mark;
277 
278 
279           i_op.buffer_ptr, i_op.cur_buffer_ptr = request_read.buffer_ptr;
280           i_op.buffer_length, i_op.cur_buffer_length = request_read.buffer_length;
281 
282           if request_header.operation = OP_GET_CHARS_ECHO
283           then i_op.echo = "1"b;
284 
285           if request_header.operation ^= OP_READ_ONE
286           then if (request_read.breaks ^= tc_data.breaktest)
287                then call set_break_table;
288 
289           request_read.returned_length = 0;
290           if i_op.just_one_char
291           then do;
292                if ^request_read.returned_break_flag         /* This is really a block_flag */
293                then do;
294                     call read_to_mark_no_block (RESTORE_MASK);
295                     request_read.returned_break_flag = try_to_satisfy ();
296                     go to request_satisfied;
297                end;
298           end;
299 
300 /* The count of 1 in the READ_ONE call will cause the following to do the right thing */
301 
302 
303           do while (^try_to_satisfy ());
304                call read_and_buffer;
305           end;
306 
307 
308 request_satisfied:                                          /* move the buffer down if we can */
309           if tc_data.state.pending.count = 0                /** **/
310                & input_buffer.n_valid ^< 1
311           then begin;
312                     declare (i, first_valid_x)       fixed bin (21);
313 
314                     do first_valid_x = 1 to input_buffer.n_valid while (control_buffer (first_valid_x).deleted);
315                     end;                                    /* set i to first nondeleted */
316 
317                     if first_valid_x ^> input_buffer.n_valid/** **/
318                          & first_valid_x > 1
319                     then do;
320                          do i = first_valid_x to input_buffer.n_valid;
321                               control_buffer (i - first_valid_x + 1) = control_buffer (i);
322                               data_buffer (i - first_valid_x + 1) = data_buffer (i);
323                          end;
324                          input_buffer.n_valid = input_buffer.n_valid - first_valid_x + 1;
325                     end;
326 
327                     else if first_valid_x > input_buffer.n_valid
328                     then do;
329                          if input_buffer.n_valid + 1 > input_buffer.buffer_length
330                          then call grow_buffer;
331                          else input_buffer.n_valid = 0;
332                     end;
333                end;
334 
335           return;
336 
337 /* ASSERT the ips mask is masked down */
338 
339 check_echnego:
340      entry (TC_data_ptr, Request_ptr);
341 
342           tc_data_ptr = TC_data_ptr;
343           request_ptr = Request_ptr;
344           input_buffer_ptr = tc_data.input_buffer_ptr;
345 
346           if state.echnego_outstanding
347           then call close_out_echnego;
348 
349           else if state.pending.count > 0
350           then call read_to_mark_no_block (UNMASK_NOTHING);
351 
352           return;
353 ^L
354 
355 
356 mark_outstanding:
357      procedure returns (bit (1) aligned);
358 
359           return (state.last_mark_back < state.current_mark);
360      end mark_outstanding;
361 
362 mark_in_buffer:
363      procedure (mark) returns (bit (1) aligned);
364 
365 /* Search the buffer for a mark, if it is there return 1
366    and set buffer_index to point to just after it. */
367 
368           declare mark                     fixed bin (9) unsigned;
369           declare s_pos                    fixed bin (21);  /* we start looking here */
370           declare m_pos                    fixed bin (21);
371           declare mark_ptr                 pointer;
372           declare MARK                     character (1);
373 
374           unspec (MARK) = MARK_CONTROL;
375           s_pos = 1;
376           do while (s_pos < input_buffer.n_valid);
377 
378                m_pos = index (substr (control_buffer_as_chars, s_pos, input_buffer.n_valid - s_pos + 1), MARK);
379                if m_pos = 0
380                then return ("0"b);                          /* no marks at all */
381 
382                m_pos = s_pos + m_pos - 1;                   /* index of mark in real buffer */
383 
384                mark_ptr = addr (data_buffer (m_pos));
385                if mark_ptr -> data_mark.mark_number = mark
386                then do;
387                     i_op.buffer_index = m_pos + 1;
388                     return ("1"b);
389                end;
390 
391                s_pos = m_pos + 1;                           /* look again after this mark */
392           end;                                              /* the do loop */
393 
394           return ("0"b);
395      end mark_in_buffer;
396 ^L
397 
398 read_to_mark:
399      procedure (mask_type);
400 
401 /* do a tty read to mark to try to find the outstanding mark */
402 
403           declare mark_index               fixed bin (21);
404           declare n_chars_read             fixed bin (21);
405           declare mask_type                bit (36) aligned;
406           declare hcs_$tty_read_with_mark  entry (fixed bin, character (*), fixed bin (21), fixed bin (21), fixed bin,
407                                            fixed bin (35));
408           declare ws_tty_$read_with_mark   entry (ptr, char (*), bit (1) aligned, fixed bin (21), fixed bin (21),
409                                            fixed bin, fixed bin (35));
410           declare dsa_tty_$read_with_mark  entry (fixed bin (35), character (*), fixed bin (21), fixed bin (21),
411                                            fixed bin, fixed bin (35));
412           declare never_block              bit (1) aligned;
413 
414           never_block = "0"b;
415           go to read_common;
416 
417 read_to_mark_no_block:
418      entry (mask_type);
419 
420           never_block = "1"b;
421 
422 read_common:
423 read:                                                       /* goto here after block returns */
424           n_chars_read = 0;                                 /* WRITE AROUND A HARDCORE BUG, that INTERPRESTS THIS AS A BUFFER OFFSET */
425 
426           if tc_data.network_type = DSA_NETWORK_TYPE
427           then                                              /* DSA */
428                call dsa_tty_$read_with_mark (tc_data.tty_handle, tc_data.tty_read_buffer, n_chars_read, mark_index,
429                     tty_state, code);
430           else if tc_data.network_type = MOWSE_NETWORK_TYPE
431           then                                              /* MOWSE */
432                call ws_tty_$read_with_mark (tc_data.mowse_terminal_iocb_ptr, tc_data.tty_read_buffer, never_block,
433                     n_chars_read, mark_index, tty_state, code);
434           else                                              /* MCS */
435                call hcs_$tty_read_with_mark (tc_data.devx, tc_data.tty_read_buffer, n_chars_read, mark_index, tty_state,
436                     code);
437 
438           if code ^= 0
439           then call tc_disconnect$check (tc_data_ptr, code);
440           if code ^= 0
441           then call tty_read_error (code);                  /* this is not supposed to happen */
442 
443           if mark_index > 0
444           then do;                                          /* the prodigal returneth */
445                if mark_index > 1
446                then call add_chars_to_buffer (1, mark_index - 1);
447                                                             /* mark_index is index if first character after */
448 
449 
450 /* Until we have multiple marks, the only one we find can be the current one */
451 
452                call add_mark_to_buffer (state.current_mark);
453                state.last_mark_back = state.current_mark;
454 
455                call add_chars_to_buffer (mark_index, n_chars_read - mark_index + 1);
456           end;
457 
458           else if n_chars_read > 0
459           then call add_chars_to_buffer (1, n_chars_read);
460 
461           else                                              /* got no data, block */
462                if never_block
463           then return;
464           else do;
465                call block (mask_type);                      /* unmask, block, mask */
466                go to read;
467           end;
468      end read_to_mark;
469 
470 retrieve_mark:
471      procedure;
472 
473 /* When retrieving the mark, we desire block to use special
474    ips masking techniques to avoid async tasks from being run.
475    Since this is not lisp, we cannot lambda-bind some flag,
476    and a controlled variable would be ugly. So we have to
477    pass a parameter down through read_to_mark */
478 
479 
480           do while (^mark_in_buffer (state.current_mark));
481 
482 /* ASSERT that there is a mark outstanding if the current mark
483    is not in the buffer */
484 
485                if ^mark_outstanding ()
486                then call tc_error (video_et_$tc_mark_missing, "");
487 
488 /* This code used to only unmask QUIT, to avoid async happenings
489    while stopped at WriteSyncRead. This is not really useful
490    because the current mark mechanism is not precise enough to be
491    worth this limitation. */
492 
493                call read_to_mark (RESTORE_MASK);
494           end;
495      end retrieve_mark;
496 ^L
497 
498 try_to_satisfy:
499      procedure returns (bit (1) aligned);
500 
501 /* see if we can fill up and finish this input request.
502    starting at buffer_index, we scan characters.
503    we skip "dead" characters, and stop on break, or count.
504    Any marks we find we remove, as there can be extraneous
505    marks if we get to set marks on all output some time. */
506 
507 /* for now we just examine characters in a loop, no fancy
508    searching. We can go for the performance some other day */
509 
510           declare our_x                    fixed bin (21);  /* current index into input_buffer's */
511           declare her_x                    fixed bin (21);  /* current index into user buffer */
512 
513           declare her_buffer               (i_op.cur_buffer_length) character (1) unaligned based (i_op.cur_buffer_ptr);
514                                                             /* use array for char-loop approach */
515           declare only_echoed              bit (1) aligned;
516 
517           only_echoed = "0"b;
518           go to common;
519 
520 try_to_satisfy$$already_echoed_only:
521      entry returns (bit (1) aligned);                       /* RV is a dummy */
522 
523           only_echoed = "1"b;
524 
525 common:
526           call init_echo_buffer;
527           her_x = 1;
528           our_x = i_op.buffer_index;                        /* start after our mark */
529 
530           if input_buffer.n_valid = 0
531           then return ("0"b);                               /* why call them back  from heaven? */
532           do while (our_x <= input_buffer.n_valid);         /* this terminator happens only when we run out of stuff without satisfying */
533 
534                if control_buffer (our_x).mark
535                then control_buffer (our_x).deleted = "1"b;
536 
537                else if ^control_buffer (our_x).deleted
538                then begin;                                  /* consider this character */
539                          declare (break_char, needs_echo) bit (1) aligned;
540                          declare rank_of_char             fixed bin;
541 
542                          rank_of_char = rank (data_buffer (our_x).character);
543                                                             /* All chars > \177 are breaks. */
544                          if rank_of_char > 127
545                          then break_char = "1"b;
546                          else break_char = tc_break_array (rank_of_char);
547 
548                          needs_echo = ^control_buffer (our_x).echoed & i_op.echo;
549 
550 /* Contract is not to return breaks and async_term. There is no good
551    reason for this, but I hesitate to change this without study of
552    window_io_video_. Both would certainly have to be changed. */
553 
554                          if only_echoed & (break_char | needs_echo)
555                          then go to found_unechoed;
556 
557                          her_buffer (her_x) = data_buffer (our_x).character;
558                          her_x = her_x + 1;
559                          control_buffer (our_x).deleted = "1"b;
560 
561                          if break_char
562                          then do;
563                               request_read.returned_break_flag = "1"b;
564                               go to success;                /* try to zonk buffer */
565                          end;
566 
567                          if needs_echo
568                          then call echo_char (data_buffer (our_x).character);
569 
570                          if her_x = hbound (her_buffer, 1) + 1
571                                                             /* DONE */
572                          then do;
573                               request_read.returned_break_flag = "0"b;
574                               go to success;
575                          end;
576                     end;                                    /* if ^deleted */
577                our_x = our_x + 1;
578           end;                                              /* do loop */
579 
580 /* If we got here, we ran out of buffer */
581 
582           request_read.returned_length = request_read.returned_length + (her_x - 1);
583           i_op.cur_buffer_ptr = add_char_offset_ (i_op.cur_buffer_ptr, (her_x - 1));
584           i_op.cur_buffer_length = i_op.cur_buffer_length - (her_x - 1);
585           i_op.buffer_index = our_x;                        /* avoid examining same thing twice */
586           input_buffer.n_chars_valid = input_buffer.n_chars_valid - (her_x - 1);
587           call dump_echo_buffer;
588           return ("0"b);
589 
590 /* we are going to return "1"b */
591 /* Or we hit a character that we cound not returned because */
592 /* it had not been echoed. In both cases our_x is one past the last one */
593 /* that should be returned. */
594 
595 found_unechoed:
596 success:
597           request_read.returned_length = request_read.returned_length + her_x - 1;
598           input_buffer.n_chars_valid = input_buffer.n_chars_valid - (her_x - 1);
599           if ^only_echoed
600           then call dump_echo_buffer;
601           return ("1"b);
602      end try_to_satisfy;
603 ^L
604 
605 read_and_buffer:
606      procedure;
607 
608 /* Caller of tty_read and get_chars_echo_etc. bufferer of read characters. */
609 /* we must manage the echo_negotiation flag. */
610 
611           declare n_chars_read             fixed bin (21);
612 
613 /* We can ignore the mark here on the first read call. There is only one
614    reason the mark could be
615    out. It could be left from some output that no call attempted
616    to sync to. This is not interesting, and is not worth giving up
617    negotiation for. We can claim that it is "in" in case someone tries
618    to sync. The mark could be put out asyncronously, but we will close
619    out negotiation before. */
620 
621           if i_op.echo
622           then do;                                          /* try to negotiate */
623                state.last_mark_back = state.current_mark;   /* fake it */
624 
625 /* ASSERT: negotiation is not in progress. Thus n_chars_echoed must be zero
626    on return. */
627 
628                declare dummy                    fixed bin (21);
629                declare screen_left              fixed bin;
630 
631                screen_left = min ((tc_data.columns - request_read.col + 1), i_op.cur_buffer_length);
632 
633                if tc_data.network_type = DSA_NETWORK_TYPE
634                then                                         /* DSA */
635                     call dsa_tty_$read_echoed (tc_data.tty_handle, addr (tc_data.tty_read_buffer), (0) /* offset */,
636                          length (tc_data.tty_read_buffer), n_chars_read, dummy, screen_left, tty_state, code);
637 
638                else if tc_data.network_type = MOWSE_NETWORK_TYPE
639                then call ws_tty_$read_echoed (tc_data.mowse_terminal_iocb_ptr, addr (tc_data.tty_read_buffer), (0),
640                          length (tc_data.tty_read_buffer), n_chars_read, dummy, screen_left, tty_state, code);
641 
642                else                                         /* MCS */
643                     call hcs_$tty_read_echoed (tc_data.devx, addr (tc_data.tty_read_buffer), (0) /* offset */,
644                          length (tc_data.tty_read_buffer), n_chars_read, dummy, screen_left, tty_state, code);
645 
646                if code ^= 0
647                then call tc_disconnect$check (tc_data_ptr, code);
648                if code ^= 0                                 /* we cannot get awaiting_stop_sync because echoing was OFF */
649                then call tty_read_error (code);
650 
651                if n_chars_read = 0
652                then do;                                     /* we have entered negotiation */
653                     state.echnego_outstanding = "1"b;
654                     call block (RESTORE_MASK);
655 
656 /* now put them in buffer and stop echoing */
657                     call close_out_echnego;
658 
659                     return;
660                end;
661                else do;                                     /* it gave us characters */
662                     call add_chars_to_buffer (1, n_chars_read);
663                     return;
664                end;
665           end;
666           else call read_to_mark (RESTORE_MASK);
667 
668      end read_and_buffer;
669 ^L
670 
671 add_mark_to_buffer:
672      procedure (mark);
673 
674           declare mark                     fixed bin (9) unsigned;
675 
676           call add_1_to_buffer (MARK_CONTROL, byte (mark));
677      end add_mark_to_buffer;
678 
679 /* procedure for adding unechoed characters to the buffer  */
680 add_chars_to_buffer:
681      procedure (start, how_many);
682 
683           declare (start, how_many)        fixed bin (21);
684           declare 1 ce                     unaligned like control_entry;
685 
686           string (ce) = NORMAL_CONTROL;
687           go to chars_common;
688 
689 add_echoed_chars_to_buffer:
690      entry (start, how_many);
691 
692           string (ce) = ECHOED_CONTROL;
693 
694 chars_common:
695           input_buffer.n_chars_valid = input_buffer.n_chars_valid + how_many;
696           go to common;
697 
698 add_1_to_buffer:
699      entry (a_ce, the_char);
700           declare a_ce                     bit (9);
701           declare istart                   fixed bin (21);
702           declare the_char                 character (1) aligned;
703 
704           if input_buffer.n_valid + 1 > input_buffer.buffer_length
705           then input_buffer.n_valid = push_buffer (input_buffer.n_valid);
706 
707           input_buffer.n_valid = input_buffer.n_valid + 1;
708           string (control_buffer (input_buffer.n_valid)) = a_ce;
709           substr (data_buffer_as_chars, input_buffer.n_valid, 1) = the_char;
710           return;
711 
712 common:
713           if input_buffer.n_valid + how_many >= input_buffer.buffer_length
714           then input_buffer.n_valid = push_buffer (input_buffer.n_valid);
715 
716           istart = input_buffer.n_valid + 1;
717 
718           input_buffer.n_valid = input_buffer.n_valid + how_many;
719 
720           begin;
721                declare cx                       fixed bin;
722                do cx = istart to istart + how_many;
723                     control_buffer (cx) = ce;
724                end;
725           end;
726           substr (data_buffer_as_chars, istart, how_many) = substr (tc_data.tty_read_buffer, start, how_many);
727      end add_chars_to_buffer;
728 ^L
729 
730 push_buffer:
731      procedure (nvalid) returns (fixed bin (21));
732           declare nvalid                   fixed bin (21);
733           declare i                        fixed bin (21);
734           declare first_valid_x            fixed bin (21);
735 
736 /* There was a problem with the bounds of the input buffer being        */
737 /* exceeded; to correct this a check has been implemented in            */
738 /* add_1_to_buffer, and common to ensure that the current buffer length */
739 /* plus the characters to be added will not exceed bounds of the        */
740 /* input_buffer. If the check fails this routine is called to push the  */
741 /* buffer down if we can.  If this fails the size of the data_buffer    */
742 /* the control_buffer is increased by calling grow_buffer.              */
743 
744           do first_valid_x = 1 to nvalid while (control_buffer (first_valid_x).deleted);
745           end;                                              /* set i to first nondeleted */
746 
747           if first_valid_x ^> nvalid & first_valid_x > 1
748           then do;
749                do i = first_valid_x to nvalid;
750                     control_buffer (i - first_valid_x + 1) = control_buffer (i);
751                     data_buffer (i - first_valid_x + 1) = data_buffer (i);
752                end;
753                nvalid = nvalid - first_valid_x + 1;
754           end;
755 
756           else if first_valid_x > nvalid
757           then call grow_buffer;
758 
759           return (nvalid);
760 
761      end push_buffer;
762 ^L
763 
764 grow_buffer:
765      procedure;
766 
767           new_buf_size = input_buffer.buffer_length + BUF_LEN;
768           allocate new_control_buf set (new_control_buf_ptr);
769           allocate new_data_buf set (new_data_buf_ptr);
770           unspec (new_control_buf) = ""b;
771           substr (new_control_buf_ptr -> temp_data, 1, input_buffer.buffer_length) =
772                substr (input_buffer.control_ptr -> temp_data, 1, input_buffer.buffer_length);
773           unspec (new_data_buf) = ""b;
774           substr (new_data_buf_ptr -> temp_data, 1, input_buffer.buffer_length) =
775                substr (input_buffer.data_ptr -> temp_data, 1, input_buffer.buffer_length);
776           free control_buffer;
777           free data_buffer;
778           input_buffer.buffer_length = new_buf_size;
779           input_buffer.control_ptr = new_control_buf_ptr;
780           input_buffer.data_ptr = new_data_buf_ptr;
781 
782      end grow_buffer;
783 ^L
784 
785 block:
786      procedure (mask_type);
787           declare mask_type                bit (36) aligned;
788           declare tc_block                 entry (pointer, pointer, bit (36) aligned);
789 
790 
791           if tc_data.network_type ^= MOWSE_NETWORK_TYPE
792           then call tc_block (tc_data_ptr, request_ptr, mask_type);
793 
794           if request_header.async_interruption
795           then do;                                          /* pretend to have the mark, since state is uncertain */
796                call add_mark_to_buffer (state.current_mark);
797                state.last_mark_back = state.current_mark;
798                go to ASYNC_INTERRUPTION;
799           end;
800 
801      end block;
802 
803 close_out_echnego:
804      procedure;
805 
806           declare (n_chars_read, n_chars_echoed)
807                                            fixed bin (21);
808 
809           declare error_table_$echnego_awaiting_stop_sync
810                                            fixed bin (35) external static;
811 
812           declare tc_block                 entry (pointer, pointer, bit (36) aligned);
813 
814 
815 /* ASSERT echo negotiation is already in progress */
816 
817           code = error_table_$echnego_awaiting_stop_sync;
818           do while (code = error_table_$echnego_awaiting_stop_sync);
819 
820 /* ASSERT: a zero col-left argument turns off negotiation according to
821    the echo negotiation protocol */
822 
823                if tc_data.network_type = DSA_NETWORK_TYPE
824                then do;                                     /* DSA */
825                     call dsa_tty_$read_echoed (tc_data.tty_handle, addr (tc_data.tty_read_buffer), (0),
826                          length (tc_data.tty_read_buffer), n_chars_read, n_chars_echoed, (0), tty_state, code);
827                     code = 0;
828                end;
829 
830                else if tc_data.network_type = MOWSE_NETWORK_TYPE
831                then call ws_tty_$read_echoed (tc_data.mowse_terminal_iocb_ptr, addr (tc_data.tty_read_buffer), (0),
832                          length (tc_data.tty_read_buffer), n_chars_read, n_chars_echoed, (0), tty_state, code);
833 
834 
835                else                                         /* MCS */
836                     call hcs_$tty_read_echoed (tc_data.devx, addr (tc_data.tty_read_buffer), (0),
837                          length (tc_data.tty_read_buffer), n_chars_read, n_chars_echoed, (0), tty_state, code);
838 
839 /* if FNP echo negotiation is on, we must wait for the wakeup
840    which signifies the FNP has stopped negotiating.  If we don't
841    block here, we will pick up this wakeup unexpectedly later.
842    After we are through blocking, go back and read again. */
843 
844                if code = error_table_$echnego_awaiting_stop_sync & tc_data.network_type ^= MOWSE_NETWORK_TYPE
845                then call tc_block (tc_data_ptr, request_ptr, UNMASK_NOTHING);
846 
847                if code = 0
848                then do;
849 
850                     if n_chars_echoed > 0
851                     then do;                                /* got stuff back, add it to buffer and update screen image */
852                          call add_echoed_chars_to_buffer (1, n_chars_echoed);
853                          call add_chars_to_buffer (1 + n_chars_echoed, n_chars_read - n_chars_echoed);
854                          begin;
855                               declare echoed                   character (n_chars_echoed)
856                                                                defined (tc_data.tty_read_buffer) position (1);
857                               call tc_screen$text (tc_data.screen_data_ptr, state.row, state.col, "0"b, echoed);
858                          end;
859                          state.col = state.col + n_chars_echoed;
860                     end;
861                     else if n_chars_read > 0
862                     then call add_chars_to_buffer (1, n_chars_read);
863                end;                                         /* if code = 0 */
864           end;                                              /* do loop */
865 
866           state.echnego_outstanding = "0"b;
867           return;
868 
869      end close_out_echnego;
870 
871 
872 echo_char:
873      procedure (char_to_echo);
874 
875           declare char_to_echo             character (1);
876 
877 /* We borrow the tty_read_buffer as an echo buffer. This is because
878    echo characters are only saved for the duration of a call to try_to_satisfy
879 */
880 
881           substr (tc_data.tty_read_buffer, i_op.write_buffer_count, 1) = char_to_echo;
882           i_op.write_buffer_count = i_op.write_buffer_count + 1;
883           return;
884 
885 init_echo_buffer:
886      entry;
887 
888           i_op.write_buffer_count = 1;
889           return;
890 
891 dump_echo_buffer:
892      entry;
893 
894           if i_op.write_buffer_count > 1
895           then begin;
896                     declare to_echo                  character (i_op.write_buffer_count - 1)
897                                                      defined (tc_data.tty_read_buffer) position (1);
898 
899                     call tc_request$write_echo (tc_data_ptr, to_echo);
900                end;
901      end echo_char;
902 
903 tty_read_error:
904      procedure (code);
905           declare code                     fixed bin (35);
906 
907           declare msg                      character (100) aligned;
908           declare convert_status_code_     entry (fixed binary (35), character (8) aligned, character (100) aligned);
909 
910           call convert_status_code_ (code, (8)" ", msg);
911 
912           call tc_error (video_et_$tc_tty_error, rtrim (msg));
913 
914      end tty_read_error;
915 
916 
917 set_break_table:
918      procedure;
919           declare hcs_$tty_order           entry (fixed bin, character (*), pointer, fixed bin, fixed bin (35));
920           declare ws_tty_$order            entry (ptr, char (*), ptr, fixed bin, fixed bin (35));
921           declare dsa_tty_$order           entry (fixed bin (35), character (*), pointer, fixed bin, fixed bin (35));
922 
923           tc_data.breaktest = request_read.breaks;
924 
925 /* This is being commented out until the change for MCR7300 is put in place
926    declare 1 echh                like echo_neg_data;   */
927 
928           declare 1 echh                   like v1_echo_neg_data;
929 
930           unspec (echh) = ""b;
931           echh.version = echo_neg_data_version_1;
932           echh.break = tc_break_array;
933 
934           if tc_data.network_type = DSA_NETWORK_TYPE
935           then                                              /* DSA */
936                call dsa_tty_$order (tc_data.tty_handle, "set_echo_break_table", addr (echh), tty_state, code);
937 
938           else if tc_data.network_type = MOWSE_NETWORK_TYPE
939           then                                              /* MOWSE */
940                call ws_tty_$order (tc_data.mowse_terminal_iocb_ptr, "set_echo_break_table", addr (echh), tty_state, code);
941 
942           else                                              /* MCS */
943                call hcs_$tty_order (tc_data.devx, "set_echo_break_table", addr (echh), tty_state, code);
944 
945           if code ^= 0
946           then call tc_disconnect$check (tc_data_ptr, code);
947           if code ^= 0
948           then call tty_read_error (code);
949 
950      end set_break_table;
951 
952 ASYNC_INTERRUPTION:
953 /****
954       We cannot try to return any extra stuff in the buffer, because the cursor
955       is in the wrong place for echoing. We could call tc_request asyncronously
956       to reposition the cursor, but that would be a bigger pain. */
957           begin;
958                declare dummy                    bit (1) aligned;
959 
960                if i_op.echo
961                then dummy = try_to_satisfy$$already_echoed_only ();
962 
963                request_read.returned_break_flag = "0"b;
964                go to request_satisfied;
965           end ASYNC_INTERRUPTION;
966 
967 read_status:
968      procedure;
969           declare bx                       fixed bin;
970 
971           call read_to_mark_no_block (RESTORE_MASK);
972 
973           request_read_status.returned_length = 0;
974           do bx = 1 to input_buffer.n_valid;
975                if string (control_buffer (bx)) = NORMAL_CONTROL
976                then request_read_status.returned_length = request_read_status.returned_length + 1;
977           end;
978 
979 /* Anybody that blocks on  this ASYNC had damn better send a wakeup */
980 
981           request_read_status.event_channel = tc_data.event;
982           return;
983      end read_status;
984 
985      end tc_input;