1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 tty_read:
25 proc (twx, a_readp, a_offset, a_nelem, a_nelemt, state, ercode);
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49 dcl twx fixed bin;
50 dcl a_readp ptr;
51 dcl a_offset fixed bin (24);
52 dcl a_buffer char (*);
53 dcl a_nelem fixed bin (24);
54 dcl a_nelemt fixed bin (24);
55
56 dcl a_screen_left fixed bin;
57 dcl a_echoed fixed bin (24);
58
59 dcl nl_found bit (1);
60 dcl a_mark_index fixed bin (21);
61 dcl state fixed bin;
62 dcl ercode fixed bin (35);
63
64
65
66
67 dcl devx fixed bin;
68 dcl output_ptr ptr;
69 dcl offset fixed bin (24);
70 dcl nelem fixed bin (24);
71 dcl nelemt fixed bin (24);
72 dcl echoed fixed bin (24);
73 dcl screen_left fixed bin;
74
75 dcl ttytp ptr;
76 dcl special_ptr ptr;
77 dcl mvtp ptr;
78 dcl tctp ptr;
79 dcl get_line_entry bit (1);
80 dcl negotiate_entry bit (1);
81 dcl obsolete_negotiate_entry bit (1);
82 dcl mark_entry bit (1);
83 dcl break_found bit (1);
84 dcl convert bit (1);
85 dcl throw_away bit (1);
86 dcl have_more_data bit (1) aligned;
87 dcl unconverted_break bit (1);
88 dcl no_break_anywhere bit (1);
89 dcl orig_output_ptr ptr;
90 dcl source_ptr ptr;
91 dcl target_ptr ptr;
92 dcl old_sourcep ptr;
93 dcl old_targetp ptr;
94 dcl source_len fixed bin;
95 dcl target_len fixed bin;
96
97 dcl new_blockp ptr;
98 dcl data_ptr ptr;
99 dcl new_block fixed bin (18);
100 dcl room_left fixed bin;
101 dcl first_char fixed bin;
102 dcl old_fblock fixed bin (18);
103 dcl last_block fixed bin (18);
104 dcl new_tally fixed bin;
105 dcl temp_buf char (60) aligned;
106 dcl orig_fchar fixed bin;
107 dcl mark_index fixed bin;
108 dcl pmark_index fixed bin;
109
110 dcl time_spent fixed bin (71);
111 dcl start_time fixed bin (71);
112 dcl max_len fixed bin;
113 dcl break char (1);
114 dcl chars_in_buf fixed bin;
115 dcl next_break fixed bin;
116
117 dcl xr fixed bin;
118 dcl can_called bit (1);
119 dcl canon_procedure variable
120 entry (pointer, fixed binary, fixed binary, character (1) aligned, character (1) aligned, fixed binary (35));
121 dcl code fixed bin (35);
122
123 dcl tempp ptr;
124
125 dcl kill_char char (1) aligned;
126 dcl erase_char char (1) aligned;
127 dcl bx fixed bin;
128 dcl i fixed bin;
129 dcl next_char char (1) aligned;
130 dcl uncp_flag bit (1);
131
132 dcl 1 octal aligned,
133 2 pad bit (27) unal,
134 2 result fixed bin (8) unal;
135
136 dcl 1 echo_start_data aligned,
137 2 ctr fixed bin (35),
138 2 screenleft fixed bin (35);
139
140 dcl digit fixed bin;
141 dcl rawcnt fixed bin;
142 dcl old_rawcnt fixed bin;
143 dcl raw_mode bit (1);
144
145 dcl 1 util aligned,
146
147
148 2 stringp ptr,
149 2 stringl fixed bin,
150 2 ctally fixed bin,
151 2 tablep ptr,
152 2 indicator fixed bin,
153 2 pad (3) fixed bin;
154
155 dcl buffer_1 char (720) aligned;
156 dcl buffer_2 char (720) aligned;
157 ^K
158
159
160 dcl crash fixed bin int static options (constant) init (1);
161 dcl BSIZE fixed bin int static options (constant) init (16);
162
163 dcl BREAK_CHAR fixed bin int static options (constant) init (1);
164 dcl ESCAPE_CHAR fixed bin int static options (constant) init (2);
165 dcl THROW_AWAY fixed bin int static options (constant) init (3);
166 dcl FORM_FEED fixed bin int static options (constant) init (4);
167 dcl HARDWARE_CONTROL fixed bin int static options (constant) init (5);
168 dcl DIALED_UP fixed bin int static options (constant) init (5);
169
170
171
172 dcl left_motion char (2) aligned int static options (constant) init ("^H^M");
173
174
175 dcl right_motion char (2) aligned int static options (constant) init (" ");
176
177
178 dcl vertical_motion char (2) aligned int static options (constant) init
179
180 ("^L^K");
181
182 dcl all_white char (6) aligned int static options (constant) init
183
184 ("^@^H
185 ^M ");
186
187 dcl nl char (1) aligned int static options (constant) init ("
188 ");
189
190 dcl bs char (1) aligned int static options (constant) init ("^H");
191
192
193 dcl nul_char char (1) aligned int static options (constant) init ("^@");
194
195
196 dcl no_control_input (16) bit (1) int static options (constant) init ("0"b, (2) (1)"1"b, (13) (1)"0"b);
197
198 dcl nocontrol (128) bit (9) int static options (constant)
199 init ("000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "010"b3, "011"b3, "012"b3,
200 "013"b3, "014"b3, "015"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3,
201 "000"b3, "000"b3, "000"b3, "000"b3, "033"b3, "000"b3, "000"b3, "000"b3, "000"b3, "040"b3, "041"b3, "042"b3,
202 "043"b3, "044"b3, "045"b3, "046"b3, "047"b3, "050"b3, "051"b3, "052"b3, "053"b3, "054"b3, "055"b3, "056"b3,
203 "057"b3, "060"b3, "061"b3, "062"b3, "063"b3, "064"b3, "065"b3, "066"b3, "067"b3, "070"b3, "071"b3, "072"b3,
204 "073"b3, "074"b3, "075"b3, "076"b3, "077"b3, "100"b3, "101"b3, "102"b3, "103"b3, "104"b3, "105"b3, "106"b3,
205 "107"b3, "110"b3, "111"b3, "112"b3, "113"b3, "114"b3, "115"b3, "116"b3, "117"b3, "120"b3, "121"b3, "122"b3,
206 "123"b3, "124"b3, "125"b3, "126"b3, "127"b3, "130"b3, "131"b3, "132"b3, "133"b3, "134"b3, "135"b3, "136"b3,
207 "137"b3, "140"b3, "141"b3, "142"b3, "143"b3, "144"b3, "145"b3, "146"b3, "147"b3, "150"b3, "151"b3, "152"b3,
208 "153"b3, "154"b3, "155"b3, "156"b3, "157"b3, "160"b3, "161"b3, "162"b3, "163"b3, "164"b3, "165"b3, "166"b3,
209 "167"b3, "170"b3, "171"b3, "172"b3, "173"b3, "174"b3, "175"b3, "176"b3, "000"b3);
210
211
212
213
214 dcl meter_response_time entry (bit (36) aligned, fixed bin),
215 syserr ext entry options (variable),
216 tty_lock$lock_channel entry (fixed bin, fixed bin (35)),
217 tty_lock$unlock_channel entry (fixed bin);
218
219 dcl tty_index$initialize_tcb entry (ptr, ptr);
220 dcl tty_util_$mvt entry (ptr);
221 dcl tty_util_$tct entry (ptr);
222 dcl tty_overstrike_canon
223 entry (pointer, fixed binary, fixed binary, character (1) aligned, character (1) aligned, fixed binary (35));
224 dcl tty_replace_canon
225 entry (pointer, fixed binary, fixed binary, character (1) aligned, character (1) aligned, fixed binary (35));
226 dcl tty_write$locked entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35));
227
228
229
230
231 dcl tty_tables$ ext static;
232 dcl error_table_$invalid_write ext static fixed bin (35);
233 dcl error_table_$badcall ext static fixed bin (35);
234 dcl error_table_$improper_data_format ext static fixed bin (35);
235 dcl error_table_$io_no_permission ext static fixed bin (35);
236 dcl error_table_$invalid_device ext static fixed bin (35);
237 dcl error_table_$line_status_pending ext static fixed bin (35);
238 dcl error_table_$echnego_awaiting_stop_sync ext static fixed bin (35);
239 dcl error_table_$no_table ext static fixed bin (35);
240 dcl pds$processid ext static bit (36) aligned;
241
242
243
244
245 dcl based_buf char (60) based;
246 dcl based_chars (0:10) char (1) unal based;
247 dcl based_one_char char (1) unal based;
248 dcl based_string char (stringl) based (stringp);
249 dcl based_source char (source_len) based (old_sourcep);
250 dcl based_target char (target_len) based (old_targetp);
251 dcl table (0:127) fixed bin (8) unaligned based;
252
253
254 dcl 1 mvt_args aligned based (addr (util)),
255 2 stringptr ptr,
256 2 stringlen fixed bin,
257 2 pad fixed bin,
258 2 tablep ptr,
259 2 targetp ptr;
260
261
262
263 dcl (addr, bin, clock, divide, fixed, index, length, min, null, ptr, rank, rel, reverse, search, substr, verify) builtin;
264
265 dcl cleanup condition;
266 %include tty_convert;
267
268 %include tty_buf;
269 ^L
270 %include tty_buffer_block;
271 ^L
272 %include wtcb;
273 ^L
274 %include tcb;
275
276 %include tty_can_types;
277 ^L
278 %include lct;
279 ^L
280 %include tty_space_man_dcls;
281 ^L
282 %include channel_manager_dcls;
283 ^L
284 %include mcs_echo_neg_sys;
285 ^L
286 %include response_transitions;
287 ^L
288 %include multiplexer_types;
289
290 get_line_entry = "0"b;
291 negotiate_entry = "0"b;
292 go to join;
293
294
295 tty_get_line:
296 entry (twx, a_readp, a_offset, a_nelem, a_nelemt, nl_found, state, ercode);
297
298 get_line_entry = "1"b;
299 negotiate_entry = "0"b;
300 go to join;
301
302 tty_read_with_mark:
303 entry (twx, a_buffer, a_nelemt, a_mark_index, state, ercode);
304
305 negotiate_entry, get_line_entry = "0"b;
306 output_ptr = addr (a_buffer);
307 nelem = length (a_buffer);
308 mark_entry = "1"b;
309 mark_index = 0;
310 go to mark_join;
311
312
313
314 tty_read_echoed:
315 entry (twx, a_readp, a_offset, a_nelem, a_nelemt, a_echoed, a_screen_left, state, ercode);
316
317 get_line_entry = "0"b;
318 negotiate_entry = "1"b;
319 obsolete_negotiate_entry = "0"b;
320 screen_left = a_screen_left;
321 echoed = 0;
322 goto join;
323
324
325 echo_negotiate_get_chars:
326 entry (twx, a_readp, a_offset, a_nelem, a_nelemt, a_echoed, a_screen_left, state, ercode);
327
328 get_line_entry = "0"b;
329 negotiate_entry = "1"b;
330 obsolete_negotiate_entry = "1"b;
331 screen_left = a_screen_left;
332 echoed = 0;
333 goto join;
334
335 join:
336 mark_entry = "0"b;
337 output_ptr = a_readp;
338 nelem = a_nelem;
339 mark_join:
340 start_time = clock ();
341 ttybp = addr (tty_buf$);
342 call meter_response_time (pds$processid, CALL_RING_0_TTY);
343
344 devx = twx;
345 lctp = tty_buf.lct_ptr;
346 if devx < 1 | devx > lct.max_no_lctes
347 then do;
348 ercode = error_table_$invalid_device;
349 call clean_up;
350 return;
351 end;
352
353 uncp_flag = is_parent_mpx (UNCP_MPX);
354
355 call tty_lock$lock_channel (devx, ercode);
356 if ercode ^= 0
357 then do;
358 call clean_up;
359 return;
360 end;
361
362 on cleanup call tty_lock$unlock_channel (devx);
363 lctep = addr (lct.lcte_array (devx));
364 if lcte.channel_type ^= 0
365 then go to no_permission;
366 wtcbp = lcte.data_base_ptr;
367 if ^wtcb.flags.dialed
368 then do;
369 no_permission:
370 call tty_lock$unlock_channel (devx);
371 ercode = error_table_$io_no_permission;
372 call clean_up;
373 return;
374 end;
375 state = DIALED_UP;
376
377 tcbp = wtcb.tcb_ptr;
378 if ^wtcb.tcb_initialized
379 then call tty_index$initialize_tcb (wtcbp, tcbp);
380
381 if wtcb.hproc ^= pds$processid
382 then if (wtcb.uproc ^= pds$processid) | ^tcb.uproc_attached
383
384 then do;
385 call tty_lock$unlock_channel (devx);
386 call clean_up;
387 ercode = error_table_$io_no_permission;
388 return;
389 end;
390
391 if wtcb.flags.line_status_present
392 then do;
393 call clean_up;
394 ercode = error_table_$line_status_pending;
395 call tty_lock$unlock_channel (devx);
396 return;
397 end;
398
399 if wtcb.error_code ^= 0
400 then do;
401 ercode = wtcb.error_code;
402 wtcb.error_code = 0;
403 call tty_lock$unlock_channel (devx);
404 return;
405 end;
406
407
408
409 tcb.cumulative_meters.read_calls = tcb.cumulative_meters.read_calls + 1;
410 tty_buf.read_calls = tty_buf.read_calls + 1;
411 nelemt = 0;
412 if negotiate_entry
413 then do;
414 if wtcb.echdp = "000000"b3
415 then do;
416 ercode = error_table_$no_table;
417 go to all_done;
418 end;
419 echo_datap = ptr (ttybp, wtcb.echdp);
420 if screen_left = 0
421 & (wtcb.negotiating_echo | echo_data.awaiting_start_sync)
422 then do;
423
424 echo_data.echo_start_pending_sndopt = "0"b;
425 if ^echo_data.awaiting_stop_sync
426 then do;
427 call channel_manager$control (devx, "stop_negotiated_echo", null (), code);
428 if code = 0
429 then echo_data.awaiting_stop_sync = "1"b;
430 else wtcb.negotiating_echo = "0"b;
431 end;
432 if echo_data.awaiting_stop_sync
433 then do;
434 call tty_lock$unlock_channel (devx);
435 call clean_up;
436 a_echoed = 0;
437 ercode = error_table_$echnego_awaiting_stop_sync;
438
439
440
441
442
443 if obsolete_negotiate_entry
444 then ercode = error_table_$line_status_pending;
445
446 return;
447 end;
448 end;
449 end;
450 if nelem = 0
451 then do;
452 if ^negotiate_entry
453 then wtcb.negotiating_echo = "0"b;
454
455
456
457
458 ercode = 0;
459 go to all_done;
460 end;
461
462 if ^mark_entry
463 then offset = a_offset;
464 else offset = 0;
465 target_len = 0;
466 rawcnt = 0;
467 have_more_data = "0"b;
468 if offset ^= 0
469 then output_ptr = addr (output_ptr -> based_chars (offset));
470 orig_output_ptr = output_ptr;
471
472 if ^tcb.rawim
473 then do;
474 if mark_entry
475 then do;
476 ercode = error_table_$badcall;
477 go to all_done;
478 end;
479
480 ttytp = addr (tty_tables$);
481 if tcb.input_mvtrp = ""b
482 then mvtp = null;
483 else mvtp = ptr (ttytp, tcb.input_mvtrp);
484 if tcb.input_tctrp = ""b
485 then tctp = null;
486 else tctp = ptr (ttytp, tcb.input_tctrp);
487 if tcb.specialrp = ""b
488 then special_ptr = null;
489 else special_ptr = ptr (ttytp, tcb.specialrp);
490 end;
491
492 if wtcb.fblock = 0
493 then do;
494 call get_more_data (blockp);
495 if ercode ^= 0
496 then go to all_done;
497 end;
498 else blockp = ptr (ttybp, wtcb.fblock);
499
500 if wtcb.fblock ^= 0
501 then do;
502 target_ptr = output_ptr;
503
504 if tcb.rawim
505 then do;
506 break_found = "0"b;
507 do while (wtcb.fblock ^= 0 & nelemt < nelem & ^break_found);
508
509 source_ptr = addr (buffer.chars (wtcb.fchar));
510 ctally = min (buffer.tally - wtcb.fchar, nelem - nelemt);
511 if get_line_entry
512 then do;
513 next_break = index (substr (source_ptr -> based_buf, 1, ctally), wtcb.line_delimiter);
514 if next_break ^= 0
515 then do;
516 ctally = next_break;
517 break_found = "1"b;
518 end;
519 end;
520
521 if mark_entry
522 then if buffer.mark
523 then mark_index = target_len + 1;
524
525 call copy_chars;
526
527 nelemt = target_len;
528
529 if ctally < buffer.tally - wtcb.fchar
530
531 then do;
532 wtcb.fchar = wtcb.fchar + ctally;
533 buffer.mark = "0"b;
534 end;
535
536 else do;
537 wtcb.fchar = 0;
538 new_block = buffer.next;
539
540 call tty_space_man$free_buffer (devx, INPUT, blockp);
541
542
543 wtcb.fblock = new_block;
544 blockp = ptr (ttybp, new_block);
545 if (new_block = 0 & wtcb.input_available)
546 then do;
547 call get_more_data (blockp);
548
549 if ercode ^= 0
550 then go to all_done;
551 end;
552 end;
553 end;
554
555 rawcnt = nelemt;
556 end;
557 else do;
558 if tcb.erklm
559 then do;
560 erase_char = tcb.erase;
561 kill_char = tcb.kill;
562 end;
563 else erase_char, kill_char = " ";
564
565 if (tcb.can_type = CAN_TYPE_OVERSTRIKE)
566 then canon_procedure = tty_overstrike_canon;
567 else if (tcb.can_type = CAN_TYPE_REPLACE)
568 then canon_procedure = tty_replace_canon;
569 else canon_procedure = tty_overstrike_canon;
570
571
572 call pickup_preconverted;
573
574 nelemt = target_len;
575 throw_away = "0"b;
576
577
578
579
580 if wtcb.fblock = 0
581 then do;
582 call get_more_data (blockp);
583 if ercode ^= 0
584 then go to all_done;
585 end;
586 max_len = 1;
587 do while ((^break_found | ^get_line_entry) & nelemt < nelem & wtcb.fblock ^= 0 & max_len > 0);
588 old_rawcnt = rawcnt;
589 break = wtcb.line_delimiter;
590 output_ptr = target_ptr;
591 max_len = length (buffer_1);
592 orig_fchar = wtcb.fchar;
593
594
595 retry:
596 if max_len > 0
597 then do;
598 target_ptr = addr (buffer_1);
599 room_left = max_len;
600 target_len = 0;
601 last_block = 0;
602 wtcb.fchar = orig_fchar;
603 call copy_loop;
604 if ^break_found & get_line_entry & room_left > 0
605 then do;
606 no_break_anywhere = "1"b;
607 wtcb.fchar = orig_fchar;
608 go to no_line;
609 end;
610
611 no_break_anywhere = "0"b;
612 call translation;
613
614
615
616 can_called = "0"b;
617 if tcb.canm
618 then do;
619 call canonicalization;
620 if code ^= 0
621 then do;
622 max_len = divide (2 * max_len, 3, 17, 0);
623 if max_len > 0
624 then do;
625 blockp = ptr (ttybp, wtcb.fblock);
626 rawcnt = old_rawcnt;
627 break_found = "0"b;
628
629 tty_buf.input_restart = tty_buf.input_restart + 1;
630 go to retry;
631 end;
632 end;
633 end;
634 end;
635
636
637
638 if last_block ^= 0
639 then do;
640 tempp = ptr (ttybp, last_block);
641
642 tempp -> buffer.next = 0;
643 call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock));
644 wtcb.fblock = fixed (rel (blockp), 17);
645 end;
646
647 if (wtcb.fblock = 0 & wtcb.input_available)
648 then do;
649 call get_more_data (blockp);
650 if ercode ^= 0
651 then go to all_done;
652 wtcb.fchar = 0;
653 end;
654
655
656
657 source_len = stringl;
658 stringp = source_ptr;
659 target_len = 0;
660
661
662
663 if ^can_called & (^tcb.control | no_control_input (wtcb.line_type))
664 then call strip_nulls;
665
666
667
668 if tcb.erklm
669 then call process_erase_kill;
670
671
672
673 if tctp ^= null
674 then call process_escape_break;
675
676 if target_len ^= 0
677 then do;
678 source_ptr = old_targetp;
679 source_len = target_len;
680 end;
681
682 target_len = nelemt;
683 target_ptr = output_ptr;
684 ctally = min (nelem - nelemt, source_len);
685
686 if ctally > 0
687 then call copy_chars;
688
689 nelemt = nelemt + source_len;
690
691
692
693 end;
694 ^L
695
696
697
698 if nelemt > nelem
699 then do;
700
701 source_len = nelemt - nelem;
702 if mark_entry
703 then if mark_index > nelem
704 then pmark_index = mark_index - nelem;
705 else pmark_index = 0;
706 call copy_to_preconverted;
707 end;
708
709 else if (get_line_entry & ^break_found)
710 then do;
711 no_line:
712 if target_len > 0
713 then do;
714 if wtcb.fblock = 0 | no_break_anywhere
715 then unconverted_break = "0"b;
716 else if tcb.break_char_pending
717 then unconverted_break = "1"b;
718
719 else do;
720 blockp = ptr (ttybp, wtcb.fblock);
721 next_break = 0;
722
723 break = wtcb.line_delimiter;
724
725 do while (next_break = 0);
726 source_ptr = addr (buffer.chars (wtcb.fchar));
727 next_break =
728 index (substr (source_ptr -> based_buf, 1, buffer.tally - wtcb.fchar), break)
729 ;
730 if next_break ^= 0
731 then unconverted_break = "1"b;
732
733 else if buffer.next = 0
734 then do;
735 unconverted_break = "0"b;
736 next_break = 1;
737 end;
738
739 else blockp = ptr (ttybp, buffer.next);
740 end;
741 end;
742
743 if unconverted_break
744 then tcb.break_char_pending = "1"b;
745
746 else if ^no_break_anywhere
747 then do;
748 source_ptr = orig_output_ptr;
749
750 source_len = target_len;
751
752 call copy_to_preconverted;
753 nelemt = 0;
754 end;
755 end;
756 end;
757 end;
758 end;
759 ^L
760
761
762
763
764 nelemt = min (nelemt, nelem);
765 if nelemt = 0
766 then do;
767 if negotiate_entry
768 then do;
769 echo_data.horiz_room_left = screen_left;
770 echo_data.chars_echoed = 0;
771 if screen_left = 0
772 then wtcb.negotiating_echo = "0"b;
773 else if tty_buf.echo_neg_mux_inhibit
774 then wtcb.negotiating_echo = "1"b;
775 else if wtcb.write_first ^= 0
776 then do;
777 wtcb.negotiating_echo = "1"b;
778 if echo_data.synchronized
779 then echo_data.echo_start_pending_sndopt = "1"b;
780 end;
781 else if echo_data.synchronized
782 then do;
783 wtcb.negotiating_echo = "1"b;
784 echo_start_data.ctr = echo_data.sync_ctr;
785
786
787 echo_start_data.screenleft = echo_data.horiz_room_left;
788 call channel_manager$control (devx, "start_negotiated_echo", addr (echo_start_data), code);
789 if code = 0
790 then ;
791 else if code = error_table_$invalid_write
792 then echo_data.echo_start_pending_sndopt = "1"b;
793
794
795
796
797 end;
798 else do;
799 call channel_manager$control (devx, "init_echo_negotiation", null (), code);
800 if code = 0
801 then do;
802 echo_data.awaiting_start_sync = "1"b;
803 echo_data.mux_will_echnego = "1"b;
804 end;
805 else wtcb.negotiating_echo = "1"b;
806 end;
807 if wtcb.negotiating_echo
808 then tty_buf.echo_neg_entries = tty_buf.echo_neg_entries + 1;
809 end;
810 else do;
811 if wtcb.negotiating_echo
812 then do;
813 wtcb.negotiating_echo = "0"b;
814 end;
815 end;
816
817 if (uncp_flag & ^wtcb.flags.rflag) |
818 (^uncp_flag & ^wtcb.flags.rflag & wtcb.prompt_len > 0)
819
820 then do;
821 raw_mode = tcb.rawom;
822 tcb.rawom = "1"b;
823 call tty_write$locked (devx, addr (wtcb.prompt), 0, (wtcb.prompt_len), 0, 0, code);
824 tcb.rawom = raw_mode;
825 end;
826
827 wtcb.flags.rflag = "1"b;
828 tty_buf.readblocked = tty_buf.readblocked + 1;
829
830 if ^uncp_flag then do;
831 if ^wtcb.flags.wru
832 then if wtcb.receive_mode_device
833 then call channel_manager$control (devx, "enter_receive", null, ercode);
834
835 else ;
836
837 else wtcb.flags.wru = "0"b;
838 end;
839 end;
840
841 else do;
842 wtcb.flags.rflag, wtcb.flags.wru = "0"b;
843 wtcb.negotiating_echo = "0"b;
844 if negotiate_entry
845 then do;
846 echoed = min (nelem, echo_data.chars_echoed);
847 echo_data.chars_echoed = echo_data.chars_echoed - echoed;
848 end;
849 tcb.cumulative_meters.read_chars = tcb.cumulative_meters.read_chars + nelemt;
850 tty_buf.ninchars = tty_buf.ninchars + nelemt;
851 tty_buf.nrawread = tty_buf.nrawread + rawcnt;
852
853 if (tcb.modes.scroll & (tcb.linemax > 0))
854 then wtcb.actline = 0;
855
856
857 end;
858
859 ercode = 0;
860 if get_line_entry
861 then nl_found = break_found;
862 all_done:
863 if wtcb.fblock = 0
864 then do;
865 wtcb.lblock = 0;
866 wtcb.flags.allow_wakeup = "0"b;
867 end;
868
869 if ercode ^= 0
870 then do;
871 call clean_up;
872 wtcb.negotiating_echo = "0"b;
873 end;
874 time_spent = clock () - start_time;
875 tcb.cumulative_meters.read_time = tcb.cumulative_meters.read_time + time_spent;
876 tty_buf.read_time = tty_buf.read_time + time_spent;
877 call tty_lock$unlock_channel (devx);
878 a_nelemt = nelemt;
879 if nelemt > 0
880 then call meter_response_time (pds$processid, RETURN_RING_0_TTY);
881 if negotiate_entry
882 then a_echoed = echoed;
883 if mark_entry
884 then if mark_index <= nelemt
885 then a_mark_index = mark_index;
886 else a_mark_index = 0;
887 return;
888
889
890
891 copy_chars:
892 proc;
893
894
895
896
897 dcl tally_chars char (ctally) based;
898
899 target_ptr -> tally_chars = source_ptr -> tally_chars;
900
901 source_ptr = addr (source_ptr -> based_chars (ctally));
902 target_ptr = addr (target_ptr -> based_chars (ctally));
903 target_len = target_len + ctally;
904
905 return;
906
907 end ;
908 ^L
909 clean_up:
910 proc;
911
912
913
914
915
916
917 nelemt, a_nelemt = 0;
918 nl_found = "0"b;
919 state = 0;
920 return;
921
922 end clean_up;
923 ^L
924
925 get_more_data:
926 proc (new_blockp);
927
928
929
930
931 dcl new_blockp ptr;
932 dcl prev_blockp ptr;
933 dcl orig_blockp ptr;
934
935 if wtcb.input_available
936 then do;
937 call channel_manager$read (devx, blockp, have_more_data, ercode);
938
939 if ercode ^= 0
940 then nelemt = 0;
941 wtcb.input_available = have_more_data;
942 end;
943 else blockp = null;
944
945 if blockp ^= null
946 then do;
947 if wtcb.fblock = 0
948 then wtcb.fblock = fixed (rel (blockp), 17, 0);
949
950 else do;
951 prev_blockp = ptr (ttybp, wtcb.lblock);
952 prev_blockp -> buffer.next = fixed (rel (blockp), 17, 0);
953 end;
954
955 orig_blockp = blockp;
956
957 do while (buffer.next ^= 0);
958 blockp = ptr (blockp, buffer.next);
959 end;
960
961 wtcb.lblock = bin (rel (blockp), 17);
962 blockp = orig_blockp;
963
964 if wtcb.mark_set
965 then do;
966 buffer.mark = "1"b;
967 wtcb.mark_set = "0"b;
968 end;
969 end;
970 new_blockp = blockp;
971 return;
972 end;
973
974
975 insert_char:
976 proc (i_char);
977
978
979
980 dcl i_char char (1) aligned;
981
982 target_ptr -> based_one_char = i_char;
983 target_ptr = addr (target_ptr -> based_chars (1));
984 target_len = target_len + 1;
985 return;
986
987 end ;
988 skip:
989 proc (to_skip);
990
991
992
993 dcl to_skip fixed bin;
994
995 stringp = addr (stringp -> based_chars (to_skip));
996 if source_len = stringl
997 then source_len = source_len - to_skip;
998 stringl = stringl - to_skip;
999
1000 return;
1001
1002 end ;
1003 ^L
1004 escaped:
1005 proc returns (bit (1) aligned);
1006
1007
1008
1009
1010 if ^tcb.escm
1011 then return ("0"b);
1012
1013 if xr <= 1
1014 then return ("0"b);
1015
1016 if tctp = null
1017 then return ("0"b);
1018
1019 if tctp -> table (rank (substr (based_string, xr - 1, 1))) ^= 2
1020
1021 then return ("0"b);
1022
1023 if xr = 2
1024 then return ("1"b);
1025
1026 if substr (based_string, xr - 2, 1) = bs
1027 then return ("0"b);
1028
1029 else return ("1"b);
1030
1031 end ;
1032 char_value:
1033 proc (a_char) returns (fixed bin);
1034
1035
1036
1037
1038 dcl a_char char (1) aligned;
1039 dcl numeric fixed bin;
1040
1041 numeric = rank (a_char);
1042 if numeric >= 48
1043 & numeric <= 55
1044 then return (numeric - 48);
1045
1046 else return (-1);
1047
1048 end ;
1049 ^L
1050 copy_to_preconverted:
1051 proc;
1052
1053
1054
1055 dcl mark_next_buffer bit (1);
1056
1057 tty_buf.preconverted = tty_buf.preconverted + source_len;
1058
1059 old_fblock = wtcb.fblock;
1060
1061
1062
1063 call tty_space_man$get_buffer (devx, BSIZE, INPUT, new_blockp);
1064 if new_blockp = null
1065 then go to no_space;
1066
1067 wtcb.fblock = bin (bin (rel (new_blockp), 18), 17);
1068
1069 target_len = 0;
1070 mark_next_buffer = "0"b;
1071
1072 do while (source_len > 0);
1073 blockp = new_blockp;
1074 buffer.converted = "1"b;
1075
1076 ctally = min (source_len, bsizec);
1077 if mark_entry
1078 then do;
1079 if mark_next_buffer
1080 then do;
1081 buffer.mark = "1"b;
1082 mark_next_buffer = "0"b;
1083 end;
1084
1085 else if pmark_index > 0
1086 then if pmark_index = target_len + 1
1087
1088 then do;
1089 buffer.mark = "1"b;
1090 pmark_index = 0;
1091 end;
1092 else if pmark_index <= target_len + ctally
1093
1094 then do;
1095 ctally = pmark_index - target_len - 1;
1096
1097 mark_next_buffer = "1"b;
1098
1099 pmark_index = 0;
1100 end;
1101 end;
1102
1103 buffer.tally = ctally;
1104 target_ptr = addr (buffer.chars (0));
1105 call copy_chars;
1106
1107 source_len = source_len - ctally;
1108 if source_len > 0
1109 then do;
1110
1111
1112
1113 call tty_space_man$get_buffer (devx, BSIZE, INPUT, new_blockp);
1114 if new_blockp = null
1115 then do;
1116 no_space:
1117 call syserr (crash, "tty_read: No buffers available for preconverted input.");
1118 return;
1119 end;
1120
1121 buffer.next = bin (bin (rel (new_blockp), 18), 17);
1122
1123 end;
1124 end;
1125
1126
1127
1128 buffer.next = old_fblock;
1129 if break_found
1130 then buffer.break, tcb.flags.break_char_pending = "1"b;
1131
1132 break_found = "0"b;
1133
1134 if old_fblock = 0
1135 then wtcb.lblock = fixed (rel (blockp), 17);
1136
1137 return;
1138
1139 end ;
1140 ^L
1141 pickup_preconverted:
1142 proc;
1143
1144
1145
1146 break_found = "0"b;
1147 convert = buffer.converted;
1148
1149 do while (wtcb.fblock ^= 0 & convert);
1150 data_ptr, source_ptr = addr (buffer.chars (0));
1151 ctally = min (buffer.tally, nelem - target_len);
1152 call copy_chars;
1153
1154 if ctally < buffer.tally
1155 then do;
1156 new_tally = buffer.tally - ctally;
1157 buffer.tally = new_tally;
1158
1159
1160
1161 substr (temp_buf, 1, new_tally) = substr (data_ptr -> based_buf, ctally + 1, new_tally);
1162 substr (data_ptr -> based_buf, 1, new_tally) = substr (temp_buf, 1, new_tally);
1163
1164 convert = "0"b;
1165 tcb.flags.break_char_pending = "0"b;
1166 end;
1167
1168 else do;
1169 break_found = buffer.break;
1170 new_block = buffer.next;
1171
1172 call tty_space_man$free_buffer (devx, INPUT, blockp);
1173
1174 wtcb.fblock = new_block;
1175
1176 if wtcb.fblock ^= 0
1177 then do;
1178 blockp = ptr (ttybp, wtcb.fblock);
1179 if break_found | target_len >= nelem
1180
1181 then convert = "0"b;
1182 else convert = buffer.converted;
1183 end;
1184 else wtcb.lblock = 0;
1185
1186 if break_found
1187 then tcb.flags.break_char_pending = "0"b;
1188
1189 end;
1190 end;
1191
1192 return;
1193
1194 end pickup_preconverted;
1195 ^L
1196 copy_loop:
1197 proc;
1198
1199
1200
1201
1202
1203
1204 dcl new_blockp ptr;
1205 dcl orig_blockp ptr;
1206
1207 first_char = wtcb.fchar;
1208 if ^get_line_entry
1209 then break_found = "0"b;
1210 do while (^break_found & rel (blockp) ^= "0"b & room_left > 0);
1211 chars_in_buf = buffer.tally - first_char;
1212 source_ptr = addr (buffer.chars (first_char));
1213
1214 ctally = index (substr (source_ptr -> based_buf, 1, chars_in_buf), break);
1215 if ctally = 0
1216 then ctally = chars_in_buf;
1217 else break_found = "1"b;
1218
1219 if ctally > room_left
1220 then ctally = room_left;
1221
1222 call copy_chars;
1223
1224 room_left = room_left - ctally;
1225 rawcnt = rawcnt + ctally;
1226
1227 if ctally < chars_in_buf
1228 then first_char = first_char + ctally;
1229 else do;
1230 last_block = fixed (rel (blockp), 17);
1231 first_char = 0;
1232 blockp = ptr (ttybp, buffer.next);
1233 end;
1234
1235 if rel (blockp) = "0"b
1236 then if ^break_found
1237 then if wtcb.input_available
1238 then do;
1239 orig_blockp = blockp;
1240 call get_more_data (new_blockp);
1241 if ercode ^= 0
1242 then go to all_done;
1243 if new_blockp ^= null
1244 then blockp = new_blockp;
1245 else blockp = orig_blockp;
1246 end;
1247 end;
1248
1249 wtcb.fchar = first_char;
1250
1251 return;
1252
1253 end copy_loop;
1254 translation:
1255 proc;
1256
1257
1258
1259
1260
1261
1262 source_ptr = addr (buffer_1);
1263 target_ptr = addr (buffer_2);
1264
1265 if throw_away
1266 then do;
1267 source_ptr = addr (source_ptr -> based_chars (1));
1268 target_len = target_len - 1;
1269 throw_away = "0"b;
1270 end;
1271
1272 stringl = target_len;
1273 stringp = source_ptr;
1274
1275 if mvtp ^= null
1276 then do;
1277 mvt_args.tablep = mvtp;
1278 mvt_args.targetp = target_ptr;
1279
1280 call tty_util_$mvt (addr (util));
1281
1282 source_ptr = addr (buffer_2);
1283 target_ptr = addr (buffer_1);
1284 stringp = source_ptr;
1285 end;
1286
1287 if ^tcb.control
1288 then if ^no_control_input (wtcb.line_type)
1289 then do;
1290 mvt_args.tablep = addr (nocontrol);
1291 mvt_args.targetp = target_ptr;
1292
1293 call tty_util_$mvt (addr (util));
1294
1295 stringp = target_ptr;
1296 target_ptr = source_ptr;
1297 source_ptr = stringp;
1298 end;
1299
1300 return;
1301
1302 end translation;
1303 ^L
1304 canonicalization:
1305 proc;
1306
1307
1308
1309
1310
1311
1312 code = 0;
1313 xr = 1;
1314 do while (xr = 1);
1315
1316 xr = search (based_string, left_motion);
1317
1318 if xr = 1
1319 then do;
1320 stringp = addr (stringp -> based_chars (1));
1321 stringl = stringl - 1;
1322 end;
1323
1324 else if search (based_string, vertical_motion) ^= 0
1325 then go to MUST_CALL_CANONICALIZE;
1326
1327
1328 else if xr ^= 0
1329 then do;
1330
1331 if (tcb.can_type ^= CAN_TYPE_REPLACE) & (verify (substr (based_string, xr), all_white) = 0)
1332
1333
1334
1335 then do;
1336 if substr (based_string, stringl, 1) = nl
1337 then do;
1338 substr (based_string, xr, 1) = nl;
1339 stringl = xr;
1340 end;
1341
1342 else stringl = xr - 1;
1343
1344 source_ptr = stringp;
1345 end;
1346
1347 else do;
1348 MUST_CALL_CANONICALIZE:
1349 if stringp ^= source_ptr
1350 then do;
1351 target_ptr -> based_string = stringp -> based_string;
1352 data_ptr = target_ptr;
1353 target_ptr = source_ptr;
1354 source_ptr = data_ptr;
1355 end;
1356
1357 can_called = "1"b;
1358 call canon_procedure (source_ptr, stringl, length (buffer_1), erase_char, kill_char, code);
1359 end;
1360 end;
1361
1362 else source_ptr = stringp;
1363 end;
1364
1365 return;
1366
1367 end canonicalization;
1368 ^L
1369 strip_nulls:
1370 proc;
1371
1372
1373
1374
1375
1376 old_sourcep = source_ptr;
1377 old_targetp = target_ptr;
1378
1379 xr = index (based_string, nul_char);
1380
1381 do while (xr ^= 0 & stringl > 0);
1382 if xr = 1
1383 then do;
1384 stringl = stringl - 1;
1385 source_len = source_len - 1;
1386 end;
1387
1388 else do;
1389 ctally = xr - 1;
1390 call copy_chars;
1391 stringl = stringl - xr;
1392 end;
1393
1394 if stringl > 0
1395 then do;
1396 source_ptr, stringp = addr (stringp -> based_chars (xr));
1397 xr = index (based_string, nul_char);
1398 end;
1399
1400 end;
1401
1402 if target_len > 0
1403 then do;
1404 if stringl > 0
1405 then do;
1406 ctally = stringl;
1407 call copy_chars;
1408 end;
1409 source_len = target_len;
1410 source_ptr = old_targetp;
1411 target_ptr = old_sourcep;
1412 end;
1413
1414 stringp = source_ptr;
1415
1416 return;
1417
1418 end strip_nulls;
1419 ^L
1420 process_erase_kill:
1421 proc;
1422
1423
1424
1425
1426
1427
1428 old_sourcep = source_ptr;
1429 old_targetp = target_ptr;
1430 stringl = source_len;
1431
1432
1433
1434 xr = 0;
1435
1436 do while (xr < stringl);
1437
1438
1439
1440 xr = stringl - index (reverse (based_string), kill_char);
1441
1442 if xr < stringl
1443 then do;
1444 xr = xr + 1;
1445
1446 if ^escaped ()
1447 then do;
1448 source_ptr, stringp = addr (stringp -> based_chars (xr));
1449
1450 source_len = source_len - xr;
1451 xr = stringl;
1452 end;
1453
1454 else do;
1455 stringl = xr - 2;
1456 xr = 0;
1457 end;
1458 end;
1459 end;
1460
1461
1462
1463
1464
1465 stringl = source_len;
1466 target_len = 0;
1467 xr = 1;
1468
1469 do while (xr ^= 0 & stringl > 0);
1470 xr = index (based_string, erase_char);
1471
1472 if xr = 1
1473 then do;
1474 if target_len ^= 0
1475 then do;
1476 bx = verify (reverse (based_target), right_motion);
1477
1478 if bx = 0
1479 then do;
1480 target_ptr = old_targetp;
1481 target_len = 0;
1482 end;
1483
1484 else do;
1485 if bx ^= 1
1486 then ctally = bx - 1;
1487
1488 else do ctally = 1 to target_len - 2 by 2
1489 while (substr (based_target, target_len - ctally, 1) = bs);
1490 end;
1491
1492 target_len = target_len - ctally;
1493 target_ptr = addr (old_targetp -> based_chars (target_len));
1494 end;
1495 end;
1496
1497 if target_len <= 0
1498 then source_len = stringl - 1;
1499 end;
1500
1501
1502
1503 else if xr ^= 0
1504 then do;
1505 if escaped ()
1506 then ctally = xr;
1507
1508 else do;
1509 bx = verify (reverse (substr (based_string, 1, xr - 1)), right_motion);
1510
1511 if bx = 0
1512 then ctally = 0;
1513
1514 else if bx ^= 1
1515 then ctally = xr - bx;
1516 else do ctally = xr - 2 to 2 by -2 while (substr (based_string, ctally, 1) = bs);
1517 end;
1518
1519 end;
1520 if ctally > 0
1521 then call copy_chars;
1522 else source_len = source_len - xr;
1523 end;
1524
1525 if xr > 0
1526 then do;
1527 source_ptr, stringp = addr (stringp -> based_chars (xr));
1528
1529 stringl = stringl - xr;
1530 end;
1531 end;
1532
1533 if target_len > 0
1534 then do;
1535 if stringl > 0
1536 then do;
1537 ctally = stringl;
1538 call copy_chars;
1539 end;
1540
1541 source_len = target_len;
1542 source_ptr = old_targetp;
1543 target_ptr = old_sourcep;
1544 end;
1545
1546 return;
1547
1548 end process_erase_kill;
1549 ^L
1550 process_escape_break:
1551 proc;
1552
1553
1554
1555
1556
1557 old_targetp = target_ptr;
1558 target_len = 0;
1559 break_found = "0"b;
1560 stringp = source_ptr;
1561 stringl = source_len;
1562 util.tablep = tctp;
1563
1564 do while (stringl > 0);
1565
1566
1567
1568 call tty_util_$tct (addr (util));
1569
1570 if util.indicator = 0 & stringl = 0 & target_len = 0
1571
1572 then ;
1573
1574 else do;
1575 if ctally > 0
1576 then do;
1577 old_sourcep = source_ptr;
1578 call copy_chars;
1579 end;
1580
1581 if indicator = BREAK_CHAR
1582 then call process_break_char;
1583
1584 else if indicator = ESCAPE_CHAR
1585 then do;
1586 if ^tcb.escm
1587 | stringl <= 1
1588 then call insert_and_update;
1589 else call process_escape_char;
1590 end;
1591
1592
1593 else if indicator = THROW_AWAY
1594 then call skip (1);
1595
1596 else if indicator = FORM_FEED
1597 then do;
1598 if tcb.linemax > 0
1599 then call skip (1);
1600
1601 else call insert_and_update;
1602 end;
1603
1604 else if indicator = HARDWARE_CONTROL
1605 then if ^tcb.modes.control
1606 then do;
1607 call skip (2);
1608 if stringl < 0
1609 then throw_away = "1"b;
1610 end;
1611 else call insert_and_update;
1612
1613 else if indicator ^= 0
1614 then do;
1615 nelemt = 0;
1616 ercode = error_table_$improper_data_format;
1617 go to all_done;
1618 end;
1619
1620 source_ptr = stringp;
1621 end;
1622 end;
1623
1624 return;
1625
1626 end process_escape_break;
1627 ^L
1628 process_break_char:
1629 proc;
1630
1631
1632
1633
1634 break_found = "1"b;
1635
1636 if tcb.canm
1637 then if ctally > 0
1638 then do;
1639 bx = verify (reverse (substr (based_source, 1, ctally)), right_motion) - 1;
1640
1641 if bx < 0
1642 then bx = ctally;
1643
1644 if bx > 0
1645 then do;
1646 target_len = target_len - bx;
1647 target_ptr = addr (old_targetp -> based_chars (target_len));
1648 end;
1649 end;
1650
1651
1652
1653 call insert_and_update;
1654
1655 return;
1656
1657 end process_break_char;
1658 ^L
1659 process_escape_char:
1660 proc;
1661
1662
1663
1664
1665 if ctally > 0
1666 then do;
1667 i = -1;
1668 if stringp -> based_chars (i) = bs
1669 then do;
1670 call insert_and_update;
1671 return;
1672 end;
1673 end;
1674
1675 next_char = stringp -> based_chars (1);
1676 if next_char = bs
1677 then do;
1678 call insert_and_update;
1679 return;
1680 end;
1681
1682 if stringl > 2
1683 then if stringp -> based_chars (2) = bs
1684 then do;
1685 call insert_and_update;
1686 return;
1687 end;
1688
1689 if tctp -> table (rank (next_char)) = 2 |
1690 next_char = tcb.erase | next_char = tcb.kill
1691 then do;
1692
1693 stringp = addr (stringp -> based_chars (1));
1694 stringl = stringl - 1;
1695 call insert_and_update;
1696 return;
1697 end;
1698
1699
1700
1701
1702 digit = char_value (next_char);
1703 if digit >= 0
1704 then do;
1705
1706 octal.result = 0;
1707 stringp = addr (stringp -> based_chars (1));
1708
1709 do i = 1 to 3 while (digit >= 0);
1710 octal.result = 8 * octal.result + digit;
1711
1712 if stringl > i & i < 3
1713 then do;
1714 digit = char_value ((stringp -> based_chars (i)));
1715 if digit >= 0
1716 then if stringl > i + 1
1717 then if stringp -> based_chars (i + 1) = bs
1718 then digit = -1;
1719 end;
1720
1721 else digit = -1;
1722 end;
1723
1724 call insert_char ((addr (octal.result) -> based_one_char));
1725 stringp = addr (stringp -> based_chars (i - 1));
1726
1727 stringl = stringl - i;
1728 end;
1729
1730
1731
1732
1733 else if verify (substr (based_string, 2, stringl - 2), right_motion) = 0
1734 & substr (based_string, stringl, 1) = nl
1735 then do;
1736 if stringl = source_len
1737 then source_len = 0;
1738 stringl = 0;
1739 end;
1740
1741 else do;
1742 if special_ptr = null
1743 then call insert_and_update;
1744 else if special_ptr -> special_chars.input_escapes.len = 0
1745 then call insert_and_update;
1746
1747 else do;
1748 xr = index (special_ptr -> special_chars.input_escapes.str, next_char);
1749 if xr ^= 0
1750 then do;
1751 call insert_char ((substr (special_ptr -> special_chars.input_results.str, xr, 1)));
1752 stringp = addr (stringp -> based_chars (2));
1753
1754 stringl = stringl - 2;
1755 end;
1756
1757 else call insert_and_update;
1758 end;
1759 end;
1760
1761 return;
1762
1763 end process_escape_char;
1764 ^L
1765 insert_and_update:
1766 proc;
1767
1768
1769
1770
1771
1772
1773
1774 call insert_char ((stringp -> based_one_char));
1775 stringp = addr (stringp -> based_chars (1));
1776 stringl = stringl - 1;
1777
1778 return;
1779
1780 end insert_and_update;
1781
1782 ^L
1783 is_parent_mpx:
1784 proc (parent_mpx_type) returns (bit (1));
1785
1786 dcl parent_mpx_type fixed bin;
1787 dcl temp_lctep ptr;
1788
1789 lctep = addr (lct.lcte_array (devx));
1790 if lcte.major_channel_devx ^= 0 then do;
1791 temp_lctep = addr (lct.lcte_array (lcte.major_channel_devx));
1792 if temp_lctep->lcte.channel_type = parent_mpx_type then return ("1"b);
1793 end;
1794 else if lcte.channel_type = parent_mpx_type then return ("1"b);
1795 return ("0"b);
1796 end is_parent_mpx;
1797
1798 end ;