1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88 %page;
89
90 tty_index:
91 proc (a_name, twx, state, ercode);
92
93
94 dcl a_name char (*);
95 dcl a_wtcbp ptr;
96 dcl a_tcbp ptr;
97 dcl a_sw bit (1);
98 dcl a_order char (*);
99 dcl a_argptr ptr;
100 dcl a_data_base_ptr ptr;
101 dcl a_event fixed bin (71);
102
103 dcl twx fixed bin;
104 dcl state fixed bin;
105 dcl ercode fixed bin (35);
106 dcl dflag fixed bin;
107 dcl nproc bit (36);
108 dcl resetsw fixed;
109 dcl name char (32);
110 dcl event fixed bin (71);
111 dcl order char (32);
112 dcl argptr ptr;
113 dcl special_ptr ptr;
114 dcl esw fixed bin;
115 dcl cleanup condition;
116 dcl (i, j) fixed bin;
117 dcl devx fixed bin (17);
118 dcl (sw, rawom) bit (1) aligned;
119 dcl rw_switch bit (2) aligned;
120 dcl code fixed bin (35);
121 dcl temp_ptr ptr;
122 dcl table_type fixed bin;
123 dcl locked bit (1) init ("0"b);
124 dcl sus_count fixed bin;
125 dcl res_count fixed bin;
126 dcl uproc_attach_required_for_setup bit (1) init ("1"b);
127 dcl uproc_required_for_setup bit (1) init ("1"b);
128 dcl phone_data varying char (32);
129 dcl aim_attributes_string char (32);
130 dcl user_auth_string char (32);
131 dcl echo_version_1 bit (1);
132 dcl old_special_table_version bit (1);
133
134
135
136 dcl 1 new_waketab aligned like wakeup_table;
137 dcl 1 old_waketab aligned like wakeup_table;
138 dcl 1 sfc aligned like framing_chars;
139 dcl 1 auto_ifc aligned like input_flow_control_info;
140 dcl 1 auto_ofc aligned like output_flow_control_info;
141 dcl 1 l_tty_access_class aligned like tty_access_class;
142 dcl 1 auto_mode aligned,
143 2 len fixed bin,
144 2 str char (8);
145
146 dcl ever_initialized bit (1) int static init ("0"b);
147
148 dcl (
149 input_tr_type init (1),
150 output_tr_type init (2),
151 input_cv_type init (3),
152 output_cv_type init (4),
153 special_type init (5),
154 delay_type init (6)
155 ) fixed bin int static options (constant);
156
157 dcl max_special_size fixed bin int static options (constant) init (600);
158
159
160
161 dcl IGNORE fixed bin int static options (constant) init (1);
162 dcl LISTENING fixed bin int static options (constant) init (2);
163 dcl DIALED_UP fixed bin int static options (constant) init (5);
164 dcl MASKED_STATE fixed bin int static options (constant) init (-1);
165 dcl NUL char (1) int static options (constant) init ("^@");
166
167 dcl white_space char (6) int static options (constant) initial
168
169 ("^H^M
170 ^K^L");
171
172 dcl (
173 error_table_$resource_attached,
174 error_table_$io_no_permission,
175 error_table_$unimplemented_version,
176 error_table_$device_not_usable,
177 error_table_$no_connection,
178 error_table_$no_operation,
179 error_table_$null_info_ptr,
180 error_table_$invalid_state,
181 error_table_$invalid_device,
182 error_table_$smallarg,
183 error_table_$action_not_performed,
184 error_table_$buffer_big,
185 error_table_$bigarg,
186 error_table_$request_pending,
187 error_table_$no_wired_structure,
188 error_table_$inconsistent,
189 error_table_$no_table,
190 error_table_$notalloc,
191 error_table_$no_line_status,
192 error_table_$improper_data_format,
193 error_table_$line_status_pending,
194 error_table_$masked_channel,
195 error_table_$invalid_delay_value,
196 error_table_$undefined_order_request,
197 error_table_$invalid_array_size
198 ) ext fixed bin (35);
199 dcl pds$processid ext static bit (36);
200 dcl pds$process_group_id ext static char (32) aligned;
201 dcl tc_data$initializer_id ext bit (36) aligned;
202
203 dcl 1 pds$access_authorization aligned like aim_template ext static;
204
205 dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
206 dcl compare_tty_name_ entry (char (*), char (*)) returns (bit (1));
207 dcl display_access_class_ entry (bit (72) aligned, char (32));
208 dcl pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin);
209 dcl syserr entry options (variable);
210 dcl tty_area_manager$allocate entry (fixed bin, ptr);
211 dcl tty_area_manager$free entry (fixed bin, ptr);
212 dcl tty_interrupt$set_static entry;
213 dcl tty_lock$lock_channel entry (fixed bin, fixed bin (35));
214 dcl tty_lock$unlock_channel entry (fixed bin);
215 dcl tty_tables_mgr$add entry (ptr, fixed bin, fixed bin, bit (18), fixed bin (35));
216 dcl tty_tables_mgr$delete entry (bit (18), fixed bin (35));
217 dcl tty_modes entry (ptr, ptr, fixed bin (35));
218 dcl tty_modes$mpx_only entry (ptr, ptr, fixed bin (35));
219 dcl tty_write$locked entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35));
220
221 dcl ll fixed bin (9) based (argptr);
222
223 dcl new_line_type fixed bin based (argptr);
224
225 dcl 1 info based (argptr) aligned,
226 2 id char (4) unaligned,
227 2 baud_rate fixed bin (17) unal,
228 2 line_type fixed bin (17) unal,
229 2 pad bit (36) unal,
230 2 tw_type fixed;
231
232 dcl arg_varying_char32 varying char (32) based (argptr);
233
234 dcl 1 rd_stat aligned based (argptr),
235 2 ev_chan fixed bin (71),
236 2 input_available bit (1);
237
238 dcl 1 wr_stat aligned based (argptr),
239 2 ev_chan fixed bin (71),
240 2 output_pending bit (1);
241
242 dcl bit72 bit (72) based;
243 dcl bit1 bit (1) based;
244
245 dcl inid char (4) based;
246 dcl based_arg fixed bin based;
247
248 dcl 1 editing_chars aligned based (argptr),
249 2 version fixed bin,
250 2 chars char (2) unaligned;
251
252 dcl 1 framing_chars aligned based (argptr),
253 2 frame_begin char (1) unal,
254 2 frame_end char (1) unal;
255
256 dcl 1 get_special_info aligned based (argptr),
257 2 version char (8),
258 2 area_ptr ptr,
259 2 table_ptr ptr;
260
261 dcl 1 get_special_info_old aligned based (argptr),
262 2 area_ptr ptr,
263 2 table_ptr ptr;
264
265 dcl two_chars char (2) based;
266 dcl special_area area based;
267
268 dcl tablerp (6) bit (18) unal based (trpp);
269 dcl df_tablerp (6) bit (18) unal based (dftrpp);
270 dcl new_tablerp (6) bit (18) unal;
271 dcl new_tablep (6) ptr based (ntpp);
272 dcl (trpp, dftrpp, ntpp) ptr;
273
274 dcl (area, storage) condition;
275
276 dcl (addr, abs, bit, clock, divide, fixed, length, low, max, min, null, ptr, rel, search, size, string, substr, unspec)
277 builtin;
278 %page;
279
280
281 dcl special_chars_old_ptr ptr;
282 dcl 1 special_chars_old aligned based (special_chars_old_ptr),
283
284 2 nl_seq aligned like c_chars_old,
285 2 cr_seq aligned like c_chars_old,
286 2 bs_seq aligned like c_chars_old,
287 2 tab_seq aligned like c_chars_old,
288 2 vt_seq aligned like c_chars_old,
289 2 ff_seq aligned like c_chars_old,
290 2 printer_on aligned like c_chars_old,
291 2 printer_off aligned like c_chars_old,
292 2 red_ribbon_shift aligned like c_chars_old,
293 2 black_ribbon_shift aligned like c_chars_old,
294 2 end_of_page aligned like c_chars_old,
295 2 escape_length fixed bin,
296 2 not_edited_escapes (sc_escape_len refer (special_chars_old.escape_length)) like c_chars_old,
297
298 2 edited_escapes (sc_escape_len refer (special_chars_old.escape_length)) like c_chars_old,
299
300 2 input_escapes aligned,
301 3 len fixed bin (8) unaligned,
302 3 str char (sc_input_escape_len refer (special_chars_old.input_escapes.len)) unaligned,
303
304 2 input_results aligned,
305 3 pad bit (9) unaligned,
306 3 str char (sc_input_escape_len refer (special_chars_old.input_escapes.len)) unaligned;
307
308 dcl 1 c_chars_old based (c_chars_ptr) aligned,
309 2 count fixed bin (8) unaligned,
310 2 chars (3) char (1) unaligned;
311
312 dcl 1 special_chars_struc_old aligned based,
313 2 version fixed bin,
314 2 default fixed bin,
315 2 special_chars,
316
317
318 3 nl_seq aligned like c_chars_old,
319 3 cr_seq aligned like c_chars_old,
320 3 bs_seq aligned like c_chars_old,
321 3 tab_seq aligned like c_chars_old,
322 3 vt_seq aligned like c_chars_old,
323 3 ff_seq aligned like c_chars_old,
324 3 printer_on aligned like c_chars_old,
325 3 printer_off aligned like c_chars_old,
326 3 red_ribbon_shift aligned like c_chars_old,
327 3 black_ribbon_shift aligned like c_chars_old,
328 3 end_of_page aligned like c_chars_old,
329 3 escape_length fixed bin,
330 3 not_edited_escapes (sc_escape_len refer (special_chars_struc_old.escape_length)) like c_chars_old,
331
332 3 edited_escapes (sc_escape_len refer (special_chars_struc_old.escape_length)) like c_chars_old,
333
334 3 input_escapes aligned,
335 4 len fixed bin (8) unaligned,
336 4 str char (sc_input_escape_len refer (special_chars_struc_old.input_escapes.len)) unaligned,
337
338 3 input_results aligned,
339 4 pad bit (9) unaligned,
340 4 str char (sc_input_escape_len refer (special_chars_struc_old.input_escapes.len)) unaligned;
341
342 %page;
343
344 esw = 0;
345 ttybp = addr (tty_buf$);
346 lctp = tty_buf.lct_ptr;
347 name = a_name;
348 twx, state = 0;
349 call get_devx (name);
350 if ercode ^= 0
351 then return;
352 tty_access_class_ptr = addr (l_tty_access_class);
353 unspec (tty_access_class) = ""b;
354 go to attach;
355
356 tty_attach:
357 entry (a_name, a_event, twx, state, ercode);
358 event = a_event;
359 esw = 1;
360 ttybp = addr (tty_buf$);
361 lctp = tty_buf.lct_ptr;
362 name = a_name;
363 twx, state = 0;
364 call get_devx (name);
365 if ercode ^= 0
366 then return;
367 tty_access_class_ptr = addr (l_tty_access_class);
368 unspec (tty_access_class) = ""b;
369 call tty_order (devx, "get_required_access_class", tty_access_class_ptr, (0), ercode);
370 if ercode ^= 0 & ercode ^= error_table_$undefined_order_request
371 then return;
372
373 attach:
374 on cleanup call cleaner;
375 call tty_lock$lock_channel (devx, ercode);
376 if ercode ^= 0
377 then return;
378 locked = "1"b;
379
380 lctep = addr (lct.lcte_array (devx));
381 if lcte.channel_type ^= 0
382 then go to index_invalid;
383
384 wtcbp = lcte.data_base_ptr;
385 tcbp = wtcb.tcb_ptr;
386 if ^wtcb.tcb_initialized
387 then call init_tcb;
388
389 if wtcb.hproc = "0"b
390 then do;
391 if pds$processid ^= tc_data$initializer_id
392 then go to index_invalid;
393 wtcb.hproc = pds$processid;
394 end;
395 else if wtcb.hproc = pds$processid
396 then ;
397 else if wtcb.flags.dialed
398 then if wtcb.uproc = pds$processid
399 then if (esw = 1) & tcb.uproc_attached
400
401 then do;
402 ercode = error_table_$resource_attached;
403 call tty_lock$unlock_channel (devx);
404 return;
405 end;
406 else do;
407 if ^tcb.uproc_attached
408 then do;
409 if tty_access_class.access_class_set
410 then if ^aim_check_$equal (unspec (pds$access_authorization), tty_access_class.access_class)
411 then do;
412 if ^pds$access_authorization.privileges.comm
413 then do;
414
415
416 call display_access_class_ (unspec (pds$access_authorization),
417 user_auth_string);
418 call display_access_class_ (tty_access_class.access_class,
419 aim_attributes_string);
420 call syserr (ANNOUNCE,
421 "tty_attach: ^a (^a) attempted invalid attachment of ^a (^a)",
422 pds$process_group_id, user_auth_string, name, aim_attributes_string);
423 go to index_invalid;
424 end;
425 end;
426 end;
427 end;
428 else go to index_invalid;
429 else do;
430 index_invalid:
431 ercode = error_table_$io_no_permission;
432 call tty_lock$unlock_channel (devx);
433 return;
434 end;
435 if wtcb.flags.dialed
436 then state = DIALED_UP;
437 else if wtcb.flags.masked
438 then state = MASKED_STATE;
439 else if wtcb.flags.listen
440 then state = LISTENING;
441 else state = IGNORE;
442
443 ercode = 0;
444 twx = devx;
445
446 if wtcb.flags.dialed
447 then do;
448 wtcb.uproc = pds$processid;
449 tcb.uproc_attached = "1"b;
450 end;
451
452 wtcb.qflag, wtcb.qenable = "0"b;
453 wtcb.dialing, wtcb.dial_status_valid = ""b;
454 wtcb.dial_status_code = 0;
455 if esw = 1
456 then go to eret;
457 call tty_lock$unlock_channel (devx);
458
459 return;
460 %page;
461 tty_event:
462 entry (twx, a_event, state, ercode);
463
464 event = a_event;
465 state = 0;
466
467 on cleanup call cleaner;
468 call setup (state);
469 if ercode ^= 0
470 then return;
471
472 if wtcb.flags.dialed
473 then wtcb.uproc = pds$processid;
474
475 eret:
476 wtcb.event = event;
477 if wtcb.hproc = pds$processid
478 then
479 wtcb.hevent = event;
480
481 call tty_lock$unlock_channel (devx);
482
483 return;
484 %page;
485 tty_get_name:
486 entry (twx, a_name, state, ercode);
487
488 devx = twx;
489 uproc_required_for_setup = "0"b;
490 call setup (state);
491 if ercode ^= 0
492 then return;
493
494 lcntp = lct.lcnt_ptr;
495 a_name = lcnt.names (devx);
496 call tty_lock$unlock_channel (devx);
497 return;
498 %page;
499 init_channel:
500 entry (twx, a_argptr, a_data_base_ptr, ercode);
501
502 devx = twx;
503 argptr = a_argptr;
504 a_data_base_ptr = null;
505 ercode = 0;
506
507 if ^ever_initialized
508 then do;
509 call tty_interrupt$set_static;
510 ever_initialized = "1"b;
511 end;
512
513 call tty_space_man$get_space (size (wtcb), wtcbp);
514
515 if wtcbp = null
516 then do;
517 ercode = error_table_$notalloc;
518 return;
519 end;
520
521 on area go to tcb_not_done;
522 on storage go to tcb_not_done;
523 call tty_area_manager$allocate (size (tcb), tcbp);
524 revert area;
525 revert storage;
526
527 unspec (wtcb) = "0"b;
528 wtcb.tcb_ptr = tcbp;
529 wtcb.devx = devx;
530 unspec (tcb) = "0"b;
531 call init_tcb;
532 a_data_base_ptr = wtcbp;
533 return;
534
535 tcb_not_done:
536 ercode = error_table_$notalloc;
537 return;
538 %page;
539 terminate_channel:
540 entry (a_data_base_ptr, ercode);
541
542 ercode = 0;
543 wtcbp = a_data_base_ptr;
544 tcbp = wtcb.tcb_ptr;
545
546 call init_tcb_tables;
547 call tty_area_manager$free (size (tcb), tcbp);
548
549 call tty_space_man$free_space (size (wtcb), wtcbp);
550
551 if wtcbp ^= null
552 then do;
553 ercode = error_table_$action_not_performed;
554 return;
555 end;
556
557 return;
558 %page;
559 tty_abort:
560 entry (twx, resetsw, state, ercode);
561
562 state = 0;
563
564 on cleanup call cleaner;
565 call setup (state);
566 if ercode ^= 0
567 then return;
568 if wtcb.flags.dialed
569 then do;
570 rw_switch = bit (fixed (resetsw, 2));
571 if substr (rw_switch, 1, 1)
572 then do;
573 if wtcb.write_first ^= 0
574 then do;
575 call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first));
576 wtcb.write_first, wtcb.write_last = 0;
577 end;
578 if wtcb.end_frame
579 then do;
580 wtcb.actline = 0;
581 wtcb.end_frame = "0"b;
582 end;
583
584 end;
585 if substr (rw_switch, 2, 1)
586 then do;
587 if wtcb.fblock ^= 0
588 then do;
589 call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock));
590 wtcb.nramsgs = 0;
591 wtcb.fblock, wtcb.lblock = 0;
592 end;
593 wtcb.fchar = 0;
594 end;
595
596 call channel_manager$control (devx, "abort", addr (rw_switch), code);
597 if code ^= 0
598 then if code = error_table_$undefined_order_request
599 then code = 0;
600 ercode = code;
601 end;
602
603 call tty_lock$unlock_channel (devx);
604
605 return;
606 %page;
607 tty_state:
608 entry (twx, state, ercode);
609
610 state = 0;
611
612 on cleanup call cleaner;
613 call setup (state);
614 call tty_lock$unlock_channel (devx);
615
616 return;
617 %page;
618 tty_detach:
619 entry (twx, dflag, state, ercode);
620
621 dcl pflag bit (1);
622
623 pflag = "0"b;
624 go to detcom;
625
626 new_proc:
627 entry (twx, nproc, state, ercode);
628
629 pflag = "1"b;
630
631 detcom:
632 state = 0;
633 on cleanup call cleaner;
634 call setup (state);
635 if ercode ^= 0
636 then return;
637
638 if pflag
639 then do;
640 if wtcb.hproc = pds$processid
641 then do;
642 wtcb.event = 0;
643 wtcb.uproc = nproc;
644 tcb.uproc_attached = "0"b;
645 end;
646 else go to illdet;
647 end;
648 else if dflag = 0
649 then do;
650 if wtcb.flags.dialed
651 then do;
652 if wtcb.hproc = pds$processid
653 then wtcb.uproc = "0"b;
654 tcb.uproc_attached = "0"b;
655 end;
656 end;
657 else if wtcb.hproc = pds$processid
658 then do;
659 wtcb.flags.listen = "0"b;
660 call channel_manager$control (devx, "hangup", null, ercode);
661 wtcb.hproc = "0"b;
662 state = IGNORE;
663 end;
664 else go to illdet;
665
666 if wtcb.flags.dialed
667 then wtcb.flags.wflag, wtcb.flags.rflag = "0"b;
668
669 call tty_lock$unlock_channel (devx);
670
671 return;
672 %page;
673
674 tty_order:
675 entry (twx, a_order, a_argptr, state, ercode);
676
677
678 order = a_order;
679 argptr = a_argptr;
680
681 ttytp = addr (tty_tables$);
682
683 on cleanup call cleaner;
684 if order = "get_meters"
685 then uproc_required_for_setup = "0"b;
686 else if order = "get_required_access_class"
687 then
688 uproc_attach_required_for_setup = "0"b;
689
690 call setup (state);
691 if ercode ^= 0
692 then return;
693
694 if wtcb.masked
695 then if order ^= "unmask" & order ^= "get_meters" & order ^= "copy_meters"
696 then do;
697 ercode = error_table_$masked_channel;
698 go to unlock;
699 end;
700
701 if order = "modes"
702 then call tty_modes (wtcbp, argptr, ercode);
703
704 else if order = "listen"
705 then do;
706 call forward_order ();
707 wtcb.flags.listen = "1"b;
708 if wtcb.flags.dialed
709 then state = DIALED_UP;
710 else state = LISTENING;
711 end;
712
713 else if order = "copy_meters"
714 then do;
715 if wtcb.hproc ^= pds$processid
716 then do;
717 ercode = error_table_$io_no_permission;
718 go to unlock;
719 end;
720
721 tcb.saved_meters = tcb.cumulative_meters;
722 tcb.time_dialed = clock ();
723 call forward_order ();
724 end;
725
726 else if order = "line_length"
727 then do;
728 if ^wtcb.flags.dialed
729 then go to error;
730 tcb.colmax = ll;
731 end;
732
733 else if order = "terminal_info"
734 then do;
735 terminal_info_ptr = argptr;
736 if terminal_info.version ^= terminal_info_version
737 then go to wrong_version;
738 if ^wtcb.flags.dialed
739 then terminal_info.id = "";
740 else terminal_info.id = tcb.id;
741 terminal_info.term_type = tcb.terminal_type;
742 terminal_info.line_type = wtcb.line_type;
743 terminal_info.baud_rate = wtcb.baud_rate;
744 end;
745
746 else if order = "info"
747 then do;
748 argptr -> info.baud_rate = wtcb.baud_rate;
749 argptr -> info.line_type = wtcb.line_type;
750 if ^wtcb.flags.dialed
751 then do;
752 argptr -> info.id = " ";
753 argptr -> info.tw_type = 0;
754 end;
755 else do;
756 argptr -> info.id = tcb.id;
757 argptr -> info.tw_type = tcb.old_type;
758 end;
759 end;
760
761 else if order = "quit_enable"
762 then wtcb.qenable = "1"b;
763
764 else if order = "quit_disable"
765 then wtcb.qenable = "0"b;
766
767 else if order = "start"
768 then do;
769 if ^wtcb.flags.dialed
770 then go to error;
771 unspec (net_event_message) = "0"b;
772 net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
773 net_event_message.network_type = MCS_NETWORK_TYPE;
774 net_event_message.handle = devx;
775 net_event_message.type = MCS_UNSPECIFIED_MSG;
776 call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0);
777
778 end;
779 %page;
780 else if order = "read_status"
781 then do;
782 if ^wtcb.flags.dialed
783 then go to error;
784
785 if wtcb.flags.line_status_present
786 then do;
787 ercode = error_table_$line_status_pending;
788 go to unlock;
789 end;
790
791 if wtcb.error_code ^= 0
792 then do;
793 ercode = wtcb.error_code;
794 wtcb.error_code = 0;
795 go to unlock;
796 end;
797
798 if wtcb.input_available | wtcb.fblock ^= 0
799 then rd_stat.input_available = "1"b;
800 else do;
801 rd_stat.input_available = "0"b;
802 if ^wtcb.flags.rflag & (wtcb.prompt_len > 0 | is_parent_mpx (UNCP_MPX))
803 then do;
804 rawom = tcb.rawom;
805 tcb.rawom = "1"b;
806 call tty_write$locked (devx, addr (wtcb.prompt), 0, (wtcb.prompt_len), 0, 0, code);
807 tcb.rawom = rawom;
808 end;
809 wtcb.flags.rflag = "1"b;
810 end;
811 end;
812
813 else if order = "write_status"
814 then do;
815 if ^wtcb.flags.dialed
816 then go to error;
817 if wtcb.flags.line_status_present
818 then do;
819 ercode = error_table_$line_status_pending;
820 go to unlock;
821 end;
822
823 if wtcb.error_code ^= 0
824 then do;
825 ercode = wtcb.error_code;
826 wtcb.error_code = 0;
827 go to unlock;
828 end;
829
830 code = 0;
831 if wtcb.write_first ^= 0
832 then wr_stat.output_pending = "1"b;
833 else do;
834 call channel_manager$control (devx, "write_status", argptr, code);
835 if code ^= 0
836 then if code = error_table_$undefined_order_request
837
838 then do;
839 code = 0;
840 wr_stat.output_pending = "0"b;
841 end;
842 ercode = code;
843 end;
844
845 if code = 0
846 then if wr_stat.output_pending
847 then wtcb.flags.wflag = "1"b;
848 end;
849
850
851 else if order = "refuse_printer_off"
852 then tcb.no_printer_off = "1"b;
853
854 else if order = "accept_printer_off"
855 then tcb.no_printer_off = "0"b;
856
857 else if order = "printer_off"
858 then do;
859 if ^wtcb.flags.dialed
860 then go to error;
861
862 if tcb.modes.echoplex
863 then call alter_mode ("echoplex", "0"b);
864 else call turn_printer_off (ercode);
865
866 if ercode = 0
867 then if tcb.modes.replay
868 then call alter_mode ("replay", "0"b);
869 end;
870
871 else if order = "printer_on"
872 then do;
873 if ^wtcb.flags.dialed
874 then go to error;
875
876 if tcb.modes.echoplex
877 then call alter_mode ("echoplex", "1"b);
878 else call turn_printer_on (ercode);
879
880 if ercode = 0
881 then if tcb.replay
882 then call alter_mode ("replay", "1"b);
883 end;
884
885 else if order = "set_terminal_data"
886 then do;
887 ttdp = argptr;
888 if terminal_type_data.version > ttd_version_3 | terminal_type_data.version <= 0
889 then go to wrong_version;
890
891 new_tablerp (*) = (18)"1"b;
892 ntpp = addr (terminal_type_data.tables);
893 code = 0;
894 do table_type = 1 to 6 while (code = 0);
895 call add_table (table_type, new_tablep (table_type), new_tablerp (table_type), code);
896 end;
897
898 if code ^= 0
899 then do;
900 do table_type = 1 to 6 while (new_tablerp (table_type) ^= (18)"1"b);
901 if new_tablerp (table_type) ^= ""b
902 then call tty_tables_mgr$delete (new_tablerp (table_type), 0);
903 end;
904 ercode = code;
905 go to unlock;
906 end;
907
908 trpp = addr (tcb.tables);
909 dftrpp = addr (tcb.default_tables);
910 do table_type = 1 to 6;
911 if tablerp (table_type) ^= ""b
912 then call tty_tables_mgr$delete (tablerp (table_type), 0);
913 if df_tablerp (table_type) ^= (18)"1"b & df_tablerp (table_type) ^= ""b
914 then call tty_tables_mgr$delete (df_tablerp (table_type), 0);
915 tablerp (table_type) = new_tablerp (table_type);
916
917 df_tablerp (table_type) = (18)"1"b;
918 end;
919
920 if tcb.modes.echoplex | tcb.modes.echo_cr | tcb.modes.echo_lf
921 then call send_delay_table;
922
923 tcb.old_type = terminal_type_data.old_type;
924 tcb.terminal_type = terminal_type_data.name;
925 tcb.erase = terminal_type_data.erase;
926 tcb.kill = terminal_type_data.kill;
927
928 tcb.frame_begin = terminal_type_data.frame_begin;
929 tcb.frame_end = terminal_type_data.frame_end;
930 if tcb.frame_end ^= NUL
931 then do;
932 sfc.frame_begin = tcb.frame_begin;
933 sfc.frame_end = tcb.frame_end;
934 call channel_manager$control (devx, "set_framing_chars", addr (sfc), ercode);
935 end;
936
937 if terminal_type_data.line_delimiter ^= low (1)
938 then wtcb.line_delimiter = terminal_type_data.line_delimiter;
939 sw = terminal_type_data.keyboard_locking;
940 if sw ^= tcb.keyboard_locking
941 then if sw & wtcb.line_type ^= LINE_ASCII
942 then ;
943 else do;
944 tcb.keyboard_locking = sw;
945 if ^(tcb.modes.full_duplex | tcb.modes.echoplex)
946
947 then call channel_manager$control (devx, "lock", addr (sw), ercode);
948
949 end;
950
951 if terminal_type_data.version >= ttd_version_2
952
953 then do;
954 if terminal_type_data.input_resume ^= NUL
955 then do;
956 tcb.input_resume_seq.count = 1;
957 substr (tcb.input_resume_seq.chars, 1, 1) = terminal_type_data.input_resume;
958 if terminal_type_data.input_suspend = NUL
959 then tcb.input_suspend_seq.count = 0;
960 else do;
961 tcb.input_suspend_seq.count = 1;
962 substr (tcb.input_suspend_seq.chars, 1, 1) = terminal_type_data.input_suspend;
963 end;
964
965 unspec (auto_ifc.suspend_seq) = unspec (tcb.input_suspend_seq);
966 unspec (auto_ifc.resume_seq) = unspec (tcb.input_resume_seq);
967 auto_ifc.timeout = terminal_type_data.input_timeout;
968 call channel_manager$control (devx, "input_flow_control_chars", addr (auto_ifc), ercode);
969 end;
970
971 else if tcb.input_resume_seq.count ^= 0
972 then do;
973 tcb.input_suspend_seq.count = 0;
974 tcb.input_resume_seq.count = 0;
975 auto_ifc.suspend_seq.count = 0;
976 auto_ifc.resume_seq.count = 0;
977 call channel_manager$control (devx, "input_flow_control_chars", addr (auto_ifc), ercode);
978 end;
979
980 if terminal_type_data.output_resume_ack ^= NUL
981 then do;
982 tcb.output_suspend_etb_seq.count = 1;
983 tcb.output_resume_ack_seq.count = 1;
984 substr (tcb.output_suspend_etb_seq.chars, 1, 1) = terminal_type_data.output_suspend_etb;
985 substr (tcb.output_resume_ack_seq.chars, 1, 1) = terminal_type_data.output_resume_ack;
986
987 unspec (auto_ofc.suspend_or_etb_seq) = unspec (tcb.output_suspend_etb_seq);
988 unspec (auto_ofc.resume_or_ack_seq) = unspec (tcb.output_resume_ack_seq);
989 tcb.block_acknowledge, auto_ofc.block_acknowledge = terminal_type_data.output_block_acknowledge;
990 auto_ofc.suspend_resume = ^terminal_type_data.output_block_acknowledge;
991 auto_ofc.mbz = ""b;
992 auto_ofc.buffer_size = terminal_type_data.output_buffer_size;
993 tcb.max_output_block = divide (terminal_type_data.output_buffer_size, 2, 18, 0);
994 call channel_manager$control (devx, "output_flow_control_chars", addr (auto_ofc), ercode);
995 end;
996
997 else if tcb.output_resume_ack_seq.count ^= 0 | tcb.max_output_block ^= 0
998 then do;
999 tcb.output_suspend_etb_seq.count = 0;
1000 tcb.output_resume_ack_seq.count = 0;
1001 tcb.max_output_block = 0;
1002 tcb.block_acknowledge = "0"b;
1003
1004 if tcb.oflow
1005 then do;
1006 auto_mode.len = 6;
1007 auto_mode.str = "^oflow";
1008 call tty_modes (wtcbp, addr (auto_mode), (0));
1009 end;
1010
1011 auto_ofc.block_acknowledge = "0"b;
1012 auto_ofc.suspend_resume = "0"b;
1013 auto_ofc.mbz = ""b;
1014 auto_ofc.buffer_size = 0;
1015 auto_ofc.suspend_or_etb_seq.count = 0;
1016 auto_ofc.resume_or_ack_seq.count = 0;
1017 call channel_manager$control (devx, "output_flow_control_chars", addr (auto_ofc), ercode);
1018 end;
1019 end;
1020 end;
1021
1022 else if order = "store_id"
1023 then do;
1024 if ^wtcb.flags.dialed
1025 then go to error;
1026 tcb.id = argptr -> inid;
1027 end;
1028
1029 else if order = "wru"
1030 then if pds$processid = wtcb.hproc
1031 then do;
1032 if ^wtcb.flags.dialed
1033 then go to error;
1034
1035 if wtcb.flags.line_status_present
1036 then do;
1037 ercode = error_table_$line_status_pending;
1038 go to unlock;
1039 end;
1040
1041 if wtcb.error_code ^= 0
1042 then do;
1043 ercode = wtcb.error_code;
1044 wtcb.error_code = 0;
1045 go to unlock;
1046 end;
1047
1048 call forward_order ();
1049 wtcb.flags.wru, wtcb.flags.rflag = "1"b;
1050 end;
1051 else go to error;
1052
1053 else if order = "interrupt"
1054 then if wtcb.line_type = LINE_ASCII
1055 then do;
1056 if ^wtcb.flags.dialed
1057 then go to error;
1058
1059 if wtcb.flags.line_status_present
1060 then do;
1061 ercode = error_table_$line_status_pending;
1062 go to unlock;
1063 end;
1064
1065 if wtcb.error_code ^= 0
1066 then do;
1067 ercode = wtcb.error_code;
1068 wtcb.error_code = 0;
1069 go to unlock;
1070 end;
1071
1072 call forward_order ();
1073 end;
1074 else go to error;
1075
1076 else if order = "set_input_message_size"
1077 then do;
1078 if ^wtcb.sync_line
1079 then go to error;
1080
1081 if argptr -> based_arg > 2048
1082 then do;
1083 ercode = error_table_$buffer_big;
1084 go to unlock;
1085 end;
1086
1087 call forward_order ();
1088 tcb.input_msg_size = argptr -> based_arg;
1089 end;
1090
1091 else if order = "get_input_message_size"
1092 then do;
1093 if ^wtcb.sync_line
1094 then go to error;
1095 argptr -> based_arg = tcb.input_msg_size;
1096
1097 end;
1098
1099 else if order = "start_xmit_hd"
1100 then do;
1101 if wtcb.line_type ^= LINE_ARDS
1102 then go to error;
1103
1104 call forward_order ();
1105 end;
1106
1107 else if order = "stop_xmit_hd"
1108 then do;
1109 if wtcb.line_type ^= LINE_ARDS
1110 then go to error;
1111
1112 call forward_order ();
1113 end;
1114
1115 else if order = "set_line_type"
1116 then do;
1117 if argptr = null
1118 then go to error;
1119 if wtcb.flags.listen
1120 then go to error;
1121 if new_line_type <= 0 | new_line_type > max_line_type
1122
1123 then go to error;
1124 if new_line_type = LINE_1050 | new_line_type = LINE_2741 | new_line_type = LINE_ARDS
1125 | new_line_type = LINE_ETX
1126 then go to error;
1127
1128 call forward_order ();
1129 wtcb.line_type = new_line_type;
1130 do i = 1 to n_sync_line_types while (new_line_type ^= sync_line_type (i));
1131 end;
1132 wtcb.sync_line = (i <= n_sync_line_types);
1133 end;
1134
1135 else if order = "dial_out"
1136 then do;
1137 if pds$processid ^= wtcb.hproc
1138 then go to illdet;
1139 if argptr = null ()
1140 then go to error;
1141 if wtcb.flags.dialed
1142 then go to error;
1143 if wtcb.dialing
1144 then go to error;
1145
1146 if wtcb.flags.line_status_present
1147 then do;
1148 ercode = error_table_$line_status_pending;
1149 go to unlock;
1150 end;
1151
1152 if wtcb.error_code ^= 0
1153 then do;
1154 ercode = wtcb.error_code;
1155 wtcb.error_code = 0;
1156 go to unlock;
1157 end;
1158
1159 phone_data = arg_varying_char32;
1160
1161
1162 wtcb.dialing = "1"b;
1163 wtcb.dial_status_valid = ""b;
1164 wtcb.dial_status_code = 0;
1165 call channel_manager$control (devx, order, addr (phone_data), ercode);
1166 if ercode ^= 0
1167 then wtcb.dialing = "0"b;
1168
1169
1170 end;
1171
1172 else if order = "dial_out_status"
1173 then do;
1174 if ^wtcb.dialing
1175 then goto error;
1176 if wtcb.dial_status_valid
1177 then do;
1178 if wtcb.dial_status_code = 0
1179 then ercode = 0;
1180 else if wtcb.dial_status_code = acu_no_power
1181 then ercode = error_table_$device_not_usable;
1182 else if wtcb.dial_status_code = acu_line_occupied
1183 then ercode = error_table_$invalid_state;
1184 else if wtcb.dial_status_code = acu_dial_failure
1185 then ercode = error_table_$no_connection;
1186 else if wtcb.dial_status_code = acu_no_good
1187 then ercode = error_table_$no_operation;
1188 else if wtcb.dial_status_code = terminal_rejected
1189 then ercode = error_table_$no_wired_structure;
1190 else ercode = wtcb.dial_status_code;
1191 wtcb.dial_status_valid = ""b;
1192 wtcb.dialing = ""b;
1193 wtcb.dial_status_code = 0;
1194 end;
1195 else ercode = error_table_$request_pending;
1196 end;
1197
1198 else if order = "line_status"
1199 then do;
1200 if ^wtcb.flags.dialed
1201 then go to error;
1202 if wtcb.flags.line_status_present
1203 then do;
1204 argptr -> bit72 = wtcb.line_status;
1205 wtcb.line_status = "0"b;
1206 wtcb.flags.line_status_present = "0"b;
1207 end;
1208 else ercode = error_table_$no_line_status;
1209 end;
1210
1211 else if order = "line_control"
1212 then do;
1213 if ^wtcb.flags.dialed
1214 then go to error;
1215 if wtcb.flags.line_status_present
1216 then do;
1217 ercode = error_table_$line_status_pending;
1218 go to unlock;
1219 end;
1220
1221 if wtcb.error_code ^= 0
1222 then do;
1223 ercode = wtcb.error_code;
1224 wtcb.error_code = 0;
1225 go to unlock;
1226 end;
1227
1228 call forward_order ();
1229 end;
1230
1231 else if order = "set_line_status_enabled"
1232 then do;
1233 if argptr = null ()
1234 then do;
1235 ercode = error_table_$null_info_ptr;
1236 go to unlock;
1237 end;
1238
1239 wtcb.line_status_disabled = ^(argptr -> bit1);
1240 if wtcb.line_status_disabled
1241 then do;
1242 wtcb.line_status_present = "0"b;
1243 wtcb.line_status = ""b;
1244 end;
1245 end;
1246
1247 else if order = "get_line_status_enabled"
1248 then do;
1249 if argptr = null ()
1250 then do;
1251 ercode = error_table_$null_info_ptr;
1252 go to unlock;
1253 end;
1254
1255 argptr -> bit1 = ^wtcb.line_status_disabled;
1256 end;
1257
1258 else if order = "unmask"
1259 then if pds$processid ^= wtcb.hproc
1260 then do;
1261 code = error_table_$io_no_permission;
1262 go to unlock;
1263 end;
1264
1265 else if wtcb.masked
1266 then do;
1267 wtcb.masked = "0"b;
1268 state = IGNORE;
1269 end;
1270 else ;
1271
1272 else if order = "set_editing_chars"
1273 then do;
1274 if ^wtcb.flags.dialed
1275 then go to error;
1276 if editing_chars.version < 2 | editing_chars.version > 3
1277 then go to wrong_version;
1278
1279 if search (editing_chars.chars, white_space) ^= 0
1280 | substr (editing_chars.chars, 1, 1) = substr (editing_chars.chars, 2, 1)
1281 then ercode = error_table_$inconsistent;
1282
1283 else do;
1284 if substr (editing_chars.chars, 1, 1) ^= " "
1285 then tcb.erase = substr (editing_chars.chars, 1, 1);
1286
1287 if substr (editing_chars.chars, 2, 1) ^= " "
1288 then tcb.kill = substr (editing_chars.chars, 2, 1);
1289
1290 end;
1291 end;
1292
1293 else if order = "get_editing_chars"
1294 then if ^wtcb.flags.dialed
1295 then go to error;
1296 else do;
1297 if editing_chars.version < 2 | editing_chars.version > 3
1298 then go to wrong_version;
1299 editing_chars.chars = addr (tcb.special_input_chars) -> two_chars;
1300 end;
1301
1302 else if order = "set_framing_chars"
1303 then do;
1304 if wtcb.sync_line
1305 then go to error;
1306
1307 if (framing_chars.frame_end = NUL & framing_chars.frame_begin ^= NUL)
1308
1309 then ercode = error_table_$inconsistent;
1310
1311 else do;
1312 call forward_order ();
1313 tcb.frame_begin = framing_chars.frame_begin;
1314 tcb.frame_end = framing_chars.frame_end;
1315
1316 end;
1317 end;
1318
1319 else if order = "input_flow_control_chars"
1320 then do;
1321 if ^wtcb.flags.dialed
1322 then go to error;
1323 if (argptr -> input_flow_control_info.resume_seq.count = 0
1324 & argptr -> input_flow_control_info.suspend_seq.count ^= 0)
1325 | (argptr -> input_flow_control_info.suspend_seq.count = 0
1326 & argptr -> input_flow_control_info.resume_seq.count ^= 0
1327 & ^argptr -> input_flow_control_info.timeout)
1328 then ercode = error_table_$improper_data_format;
1329 else do;
1330 tcb.input_suspend_seq = argptr -> input_flow_control_info.suspend_seq;
1331 tcb.input_resume_seq = argptr -> input_flow_control_info.resume_seq;
1332 call forward_order ();
1333 end;
1334 end;
1335
1336 else if order = "output_flow_control_chars"
1337 then do;
1338 if ^wtcb.flags.dialed
1339 then go to error;
1340 if argptr -> output_flow_control_info.suspend_resume & argptr -> output_flow_control_info.block_acknowledge
1341 then go to bad_ofc;
1342
1343 sus_count = argptr -> output_flow_control_info.suspend_or_etb_seq.count;
1344 res_count = argptr -> output_flow_control_info.resume_or_ack_seq.count;
1345
1346 if argptr -> output_flow_control_info.block_acknowledge
1347 then if argptr -> output_flow_control_info.buffer_size = 0
1348 then if (tcb.max_output_block = 0 & (res_count + sus_count ^= 0))
1349
1350 | (res_count = 0 & sus_count ^= 0) | (sus_count = 0 & res_count ^= 0)
1351
1352 then go to bad_ofc;
1353 else ;
1354
1355 else tcb.max_output_block = divide (argptr -> output_flow_control_info.buffer_size, 2, 18, 0);
1356
1357
1358 else if (sus_count = 0 & res_count ^= 0) | (res_count = 0 & sus_count ^= 0)
1359 | (sus_count ^= 0 & sus_count = res_count
1360 & substr (argptr -> output_flow_control_info.suspend_or_etb_seq.chars, 1, sus_count)
1361 = substr (argptr -> output_flow_control_info.resume_or_ack_seq.chars, 1, res_count))
1362
1363 then do;
1364 bad_ofc:
1365 ercode = error_table_$improper_data_format;
1366 go to unlock;
1367 end;
1368 else tcb.max_output_block = 0;
1369
1370 if sus_count ^= 0 | (sus_count = 0 & res_count = 0 & argptr -> output_flow_control_info.buffer_size = 0)
1371
1372 then do;
1373 tcb.output_suspend_etb_seq = argptr -> output_flow_control_info.suspend_or_etb_seq;
1374 tcb.output_resume_ack_seq = argptr -> output_flow_control_info.resume_or_ack_seq;
1375 end;
1376 tcb.block_acknowledge = argptr -> output_flow_control_info.block_acknowledge;
1377
1378 call forward_order ();
1379 end;
1380
1381 else if order = "get_framing_chars"
1382 then do;
1383 framing_chars.frame_begin = tcb.frame_begin;
1384 framing_chars.frame_end = tcb.frame_end;
1385 end;
1386
1387 else if order = "get_ifc_info"
1388 then do;
1389 argptr -> input_flow_control_info.suspend_seq = tcb.input_suspend_seq;
1390 argptr -> input_flow_control_info.resume_seq = tcb.input_resume_seq;
1391 end;
1392
1393 else if order = "get_ofc_info"
1394 then do;
1395 argptr -> output_flow_control_info.block_acknowledge = tcb.block_acknowledge;
1396 argptr -> output_flow_control_info.suspend_resume =
1397 (^tcb.block_acknowledge) & (tcb.output_suspend_etb_seq.count ^= 0);
1398 argptr -> output_flow_control_info.buffer_size = 2 * tcb.max_output_block;
1399 argptr -> output_flow_control_info.suspend_or_etb_seq = tcb.output_suspend_etb_seq;
1400 argptr -> output_flow_control_info.resume_or_ack_seq = tcb.output_resume_ack_seq;
1401 end;
1402
1403 else if order = "set_delay"
1404 then do;
1405 call replace_table (delay_type, ercode);
1406 if ercode = 0 & (tcb.modes.echoplex | tcb.modes.echo_cr | tcb.modes.echo_lf)
1407 then call send_delay_table;
1408 end;
1409
1410 else if order = "set_input_conversion"
1411 then call replace_table (input_cv_type, ercode);
1412
1413 else if order = "set_input_translation"
1414 then call replace_table (input_tr_type, ercode);
1415
1416 else if order = "set_output_conversion"
1417 then call replace_table (output_cv_type, ercode);
1418
1419 else if order = "set_output_translation"
1420 then call replace_table (output_tr_type, ercode);
1421
1422 else if order = "set_special"
1423 then call replace_table (special_type, ercode);
1424
1425 else if order = "set_echo_break_table"
1426 then do;
1427 echo_neg_datap = argptr;
1428
1429
1430
1431
1432
1433 echo_version_1 = "0"b;
1434 if echo_neg_data.version = echo_neg_data_version_1
1435 then echo_version_1 = "1"b;
1436 else
1437
1438 if echo_neg_data.version ^= echo_neg_data_version_2
1439 then go to wrong_version;
1440
1441 if wtcb.echdp = "000000"b3
1442 then do;
1443 call tty_space_man$get_space (size (echo_data), echo_datap);
1444 if echo_datap ^= null ()
1445 then wtcb.echdp = rel (echo_datap);
1446 end;
1447 else echo_datap = ptr (ttybp, wtcb.echdp);
1448 if echo_datap = null
1449 then ercode = error_table_$notalloc;
1450 else do;
1451 unspec (echo_data) = ""b;
1452
1453
1454
1455
1456 if echo_version_1
1457 then do;
1458 string (echo_data.break) = string (v1_echo_neg_data.break);
1459 substr (string (echo_data.break), 129, 128) = (128)"1"b;
1460 echo_data.rubout_trigger_chars = v1_echo_neg_data.rubout_trigger_chars;
1461 echo_data.rubout_sequence_length = v1_echo_neg_data.rubout_sequence_length;
1462 echo_data.rubout_sequence = v1_echo_neg_data.rubout_sequence;
1463 echo_data.rubout_pad_count = v1_echo_neg_data.rubout_pad_count;
1464 echo_data.buffer_rubouts = v1_echo_neg_data.buffer_rubouts;
1465 end;
1466
1467 else do;
1468
1469
1470
1471 string (echo_data.break) = string (echo_neg_data.break);
1472 echo_data.rubout_trigger_chars = echo_neg_data.rubout_trigger_chars;
1473 echo_data.rubout_sequence_length = echo_neg_data.rubout_sequence_length;
1474 echo_data.rubout_sequence = echo_neg_data.rubout_sequence;
1475 echo_data.rubout_pad_count = echo_neg_data.rubout_pad_count;
1476 echo_data.buffer_rubouts = echo_neg_data.buffer_rubouts;
1477 end;
1478
1479
1480 call channel_manager$control (devx, "set_echnego_break_table", addr (echo_data.break), (0));
1481 end;
1482 end;
1483
1484 else if order = "get_delay"
1485 then do;
1486 if ^wtcb.flags.dialed
1487 then go to error;
1488 if argptr -> delay_struc.version ^= DELAY_VERSION
1489 then go to wrong_version;
1490
1491 if tcb.delayrp = ""b
1492 then unspec (argptr -> delay_struc.delay) = ""b;
1493
1494 else argptr -> delay_struc.delay = ptr (ttytp, tcb.delayrp) -> delay;
1495 end;
1496
1497 else if order = "get_special"
1498 then do;
1499 if ^wtcb.flags.dialed
1500 then go to error;
1501 if tcb.specialrp = ""b
1502 then do;
1503 ercode = error_table_$no_table;
1504 go to unlock;
1505 end;
1506
1507 special_ptr = ptr (ttytp, tcb.specialrp);
1508 sc_escape_len = special_ptr -> special_chars.escape_length;
1509 sc_input_escape_len = special_ptr -> special_chars.input_escapes.len;
1510
1511 if get_special_info.version = SPECIAL_INFO_STRUCT_VERSION_1
1512 then old_special_table_version = "0"b;
1513 else old_special_table_version = "1"b;
1514
1515 on area go to no_allocate;
1516 on storage go to no_allocate;
1517
1518 if old_special_table_version
1519 then allocate special_chars_struc_old in (get_special_info_old.area_ptr -> special_area) set (temp_ptr);
1520 else allocate special_chars_struc in (get_special_info.area_ptr -> special_area) set (temp_ptr);
1521
1522 revert area;
1523 revert storage;
1524
1525 if old_special_table_version
1526 then do;
1527 get_special_info_old.table_ptr = temp_ptr;
1528 temp_ptr -> special_chars_struc_old.version = SPECIAL_VERSION;
1529
1530
1531
1532 call copy_to_old_special_table;
1533 if ercode ^= 0
1534 then do;
1535 free temp_ptr -> special_chars_struc_old in (get_special_info_old.area_ptr -> special_area);
1536 get_special_info_old.table_ptr = null;
1537 go to unlock;
1538 end;
1539 end;
1540 else do;
1541 get_special_info.table_ptr = temp_ptr;
1542 temp_ptr -> special_chars_struc.version = SPECIAL_VERSION_2;
1543 addr (temp_ptr -> special_chars_struc.special_chars) -> special_chars = special_ptr -> special_chars;
1544 end;
1545 end;
1546
1547 else if order = "get_input_conversion"
1548 then call get_table (tcb.input_tctrp);
1549
1550 else if order = "get_input_translation"
1551 then call get_table (tcb.input_mvtrp);
1552
1553 else if order = "get_output_conversion"
1554 then call get_table (tcb.output_tctrp);
1555
1556 else if order = "get_output_translation"
1557 then call get_table (tcb.output_mvtrp);
1558
1559 else if order = "get_echo_break_table"
1560 then do;
1561 if wtcb.echdp = "000000"b3
1562 then ercode = error_table_$no_table;
1563 else do;
1564 echo_datap = ptr (ttybp, wtcb.echdp);
1565 echo_neg_datap = argptr;
1566
1567
1568
1569
1570 if echo_neg_data.version = echo_neg_data_version_1
1571 then do;
1572 string (v1_echo_neg_data.break) = substr (string (echo_data.break), 1, 128);
1573
1574 v1_echo_neg_data.rubout_sequence = echo_data.rubout_sequence;
1575 v1_echo_neg_data.rubout_sequence_length = echo_data.rubout_sequence_length;
1576 v1_echo_neg_data.rubout_pad_count = echo_data.rubout_pad_count;
1577 v1_echo_neg_data.buffer_rubouts = echo_data.buffer_rubouts;
1578 v1_echo_neg_data.rubout_trigger_chars = echo_data.rubout_trigger_chars;
1579 end;
1580
1581 else do;
1582
1583 if echo_neg_data.version ^= echo_neg_data_version_2
1584 then go to wrong_version;
1585 string (echo_neg_data.break) = string (echo_data.break);
1586
1587 echo_neg_data.rubout_sequence = echo_data.rubout_sequence;
1588 echo_neg_data.rubout_sequence_length = echo_data.rubout_sequence_length;
1589 echo_neg_data.rubout_pad_count = echo_data.rubout_pad_count;
1590 echo_neg_data.buffer_rubouts = echo_data.buffer_rubouts;
1591 echo_neg_data.rubout_trigger_chars = echo_data.rubout_trigger_chars;
1592 end;
1593
1594 end;
1595 end;
1596
1597 else if order = "get_meters"
1598 then do;
1599 tty_meterp = argptr -> get_comm_meters_info.subchan_ptr;
1600 if tty_meterp ^= null ()
1601 then do;
1602 if tty_channel_meters.version ^= TTY_CHANNEL_METERS_VERSION_1
1603 then go to wrong_version;
1604 tty_channel_meters.last_dialed_time = tcb.time_dialed;
1605 tty_channel_meters.baud_rate = wtcb.baud_rate;
1606 tty_channel_meters.user_process = wtcb.uproc;
1607 tty_channel_meters.breakall = tcb.modes.breakall;
1608 tty_channel_meters.echoplex = tcb.modes.echoplex;
1609 tty_channel_meters.current_meters = tcb.cumulative_meters;
1610 tty_channel_meters.saved_meters = tcb.saved_meters;
1611 end;
1612 call forward_order ();
1613 end;
1614
1615 else if order = "set_wakeup_table"
1616 then do;
1617 swt_infop = argptr;
1618 if swt_info.version ^= swt_info_version_1
1619 then go to wrong_version;
1620 if tcb.modes.wake_tbl
1621 then go to cant_do;
1622
1623 if wtcb.waketp = ""b
1624 then string (swt_info.old_table) = ""b;
1625 else do;
1626 wakeup_tablep = ptr (ttybp, wtcb.waketp);
1627 old_waketab = wakeup_table;
1628 call untranslate_wakeup_table;
1629 swt_info.old_table = old_waketab;
1630 end;
1631
1632 new_waketab = swt_info.new_table;
1633 if string (new_waketab) = ""b
1634 then do;
1635 if wtcb.waketp ^= ""b
1636 then do;
1637 call tty_space_man$free_space (size (new_waketab), ptr (ttybp, wtcb.waketp));
1638 wtcb.waketp = ""b;
1639 end;
1640 end;
1641 else do;
1642 if wtcb.waketp = ""b
1643 then do;
1644 call tty_space_man$get_space (size (new_waketab), wakeup_tablep);
1645 if wakeup_tablep = null
1646 then go to no_allocate;
1647 wtcb.waketp = rel (wakeup_tablep);
1648 end;
1649 call translate_wakeup_table;
1650 wakeup_table = new_waketab;
1651 end;
1652 end;
1653
1654 else if order = "set_prompt"
1655 then do;
1656 sp_infop = argptr;
1657 if sp_info.version ^= sp_info_version_1
1658 then go to wrong_version;
1659
1660 i = length (sp_info.message);
1661 if i < 0
1662 then do;
1663 ercode = error_table_$smallarg;
1664 go to unlock;
1665 end;
1666 if i > 3
1667 then do;
1668 ercode = error_table_$bigarg;
1669 go to unlock;
1670 end;
1671
1672 wtcb.prompt_len = i;
1673 if i > 0
1674 then substr (wtcb.prompt, 1, i) = substr (sp_info.message, 1, i);
1675 end;
1676
1677 else if order = "set_required_access_class"
1678 then do;
1679 if wtcb.hproc ^= pds$processid
1680 then do;
1681 ercode = error_table_$io_no_permission;
1682 go to unlock;
1683 end;
1684 else call forward_order ();
1685 end;
1686
1687 else do;
1688 call channel_manager$control (devx, order, a_argptr, ercode);
1689
1690 go to unlock;
1691 end;
1692
1693 unlock:
1694 if ercode = error_table_$io_no_permission
1695 then state = 0;
1696 call tty_lock$unlock_channel (devx);
1697 return;
1698
1699 error:
1700 ercode = error_table_$undefined_order_request;
1701 go to unlock;
1702
1703 cant_do:
1704 ercode = error_table_$action_not_performed;
1705 go to unlock;
1706
1707
1708 no_allocate:
1709 ercode = error_table_$notalloc;
1710 go to unlock;
1711
1712 wrong_version:
1713 ercode = error_table_$unimplemented_version;
1714 go to unlock;
1715 %page;
1716
1717
1718 initialize_tcb:
1719 entry (a_wtcbp, a_tcbp);
1720
1721
1722 wtcbp = a_wtcbp;
1723 tcbp = a_tcbp;
1724 call init_tcb;
1725 return;
1726
1727
1728
1729
1730
1731 init_tcb:
1732 proc;
1733
1734 dcl save_breakall_enabled bit (1);
1735
1736 call init_tcb_tables;
1737
1738 tcb.terminal_type = "";
1739 tcb.special_input_chars.erase = "#";
1740 tcb.special_input_chars.kill = "@";
1741 tcb.old_type = 0;
1742 string (tcb.modes) = ""b;
1743 save_breakall_enabled = tcb.breakall_enabled;
1744 string (tcb.flags) = ""b;
1745 tcb.breakall_enabled = save_breakall_enabled;
1746 tcb.frame_begin, tcb.frame_end = NUL;
1747 tcb.actshift = "00"b;
1748 tcb.id = "none";
1749 tcb.colmax = 50;
1750 tcb.linemax = 0;
1751 tcb.wrt_lchar = 0;
1752 tcb.max_output_block = 0;
1753 tcb.input_suspend_seq.count = 0;
1754 tcb.input_resume_seq.count = 0;
1755 tcb.output_suspend_etb_seq.count = 0;
1756 tcb.output_resume_ack_seq.count = 0;
1757 wtcb.tcb_initialized = "1"b;
1758
1759 return;
1760
1761 end init_tcb;
1762
1763 init_tcb_tables:
1764 proc;
1765
1766 trpp = addr (tcb.tables);
1767 dftrpp = addr (tcb.default_tables);
1768 do table_type = 1 to 6;
1769 if tablerp (table_type) ^= ""b
1770 then call tty_tables_mgr$delete (tablerp (table_type), 0);
1771 tablerp (table_type) = ""b;
1772 if df_tablerp (table_type) ^= (18)"1"b & df_tablerp (table_type) ^= ""b
1773 then call tty_tables_mgr$delete (df_tablerp (table_type), 0);
1774 df_tablerp (table_type) = (18)"1"b;
1775 end;
1776 return;
1777
1778 end init_tcb_tables;
1779 %page;
1780
1781
1782
1783
1784 replace_table:
1785 proc (table_type, code);
1786
1787 dcl table_type fixed bin;
1788 dcl code fixed bin (35);
1789 dcl infop ptr;
1790 dcl add_tablerp bit (18);
1791
1792 dcl new_tablerp bit (18);
1793 dcl tablep ptr;
1794 dcl table_size fixed bin;
1795 dcl replace_sw bit (1) aligned;
1796
1797
1798 replace_sw = "1"b;
1799 if ^wtcb.flags.dialed
1800 then go to error;
1801 trpp = addr (tcb.tables);
1802 dftrpp = addr (tcb.default_tables);
1803 go to join;
1804
1805
1806 add_table:
1807 entry (table_type, infop, add_tablerp, code);
1808
1809 replace_sw = "0"b;
1810 argptr = infop;
1811
1812 join:
1813 if argptr = null
1814 then tablep = null;
1815 else do;
1816 if table_type = delay_type & argptr -> delay_struc.version ^= DELAY_VERSION
1817 then do;
1818 wrong_version:
1819 code = error_table_$unimplemented_version;
1820 return;
1821 end;
1822 else if table_type = special_type
1823 &
1824 ^(argptr -> special_chars_struc.version = SPECIAL_VERSION
1825 | argptr -> special_chars_struc.version = SPECIAL_VERSION_2)
1826 then go to wrong_version;
1827 else if argptr -> cv_trans_struc.version > CV_TRANS_VERSION
1828 then go to wrong_version;
1829
1830 if replace_sw & argptr -> delay_struc.default ^= 0
1831 then do;
1832 if df_tablerp (table_type) = (18)"1"b
1833 then ;
1834 else do;
1835 if tablerp (table_type) ^= ""b
1836 then call tty_tables_mgr$delete (tablerp (table_type), 0);
1837
1838 tablerp (table_type) = df_tablerp (table_type);
1839
1840 df_tablerp (table_type) = (18)"1"b;
1841 end;
1842 return;
1843 end;
1844
1845 tablep = addr (argptr -> delay_struc.delay);
1846 end;
1847
1848 if tablep = null
1849 then new_tablerp = ""b;
1850 else do;
1851 if table_type = special_type
1852 then do;
1853 if argptr -> special_chars_struc.version = SPECIAL_VERSION_2
1854 then do;
1855 old_special_table_version = "0"b;
1856 sc_escape_len = tablep -> special_chars.escape_length;
1857 sc_input_escape_len = tablep -> special_chars.input_escapes.len;
1858 end;
1859 else do;
1860 old_special_table_version = "1"b;
1861 sc_escape_len = tablep -> special_chars_old.escape_length;
1862 sc_input_escape_len = tablep -> special_chars_old.input_escapes.len;
1863 end;
1864
1865 if sc_escape_len < 0 | sc_input_escape_len < 0
1866 then do;
1867 bad_data:
1868 code = error_table_$improper_data_format;
1869 return;
1870 end;
1871
1872 begin;
1873
1874
1875
1876 dcl 1 scs aligned,
1877 2 nl_seq aligned like c_chars,
1878 2 cr_seq aligned like c_chars,
1879 2 bs_seq aligned like c_chars,
1880 2 tab_seq aligned like c_chars,
1881 2 vt_seq aligned like c_chars,
1882 2 ff_seq aligned like c_chars,
1883 2 printer_on aligned like c_chars,
1884 2 printer_off aligned like c_chars,
1885 2 red_ribbon_shift aligned like c_chars,
1886 2 black_ribbon_shift aligned like c_chars,
1887 2 end_of_page aligned like c_chars,
1888 2 escape_length fixed bin,
1889 2 not_edited_escapes (sc_escape_len) like c_chars,
1890 2 edited_escapes (sc_escape_len) like c_chars,
1891 2 input_escapes aligned,
1892 3 len fixed bin (8) unaligned,
1893 3 str char (sc_input_escape_len) unaligned,
1894 2 input_results aligned,
1895 3 pad bit (9) unaligned,
1896 3 str char (sc_input_escape_len) unaligned;
1897
1898 table_size = size (scs);
1899 if table_size > max_special_size
1900 then do;
1901 code = error_table_$bigarg;
1902 return;
1903 end;
1904 if ^old_special_table_version
1905 then addr (scs) -> special_chars = tablep -> special_chars;
1906 else call copy_from_old_special_table (tablep, addr (scs));
1907 tablep = addr (scs);
1908 call tty_tables_mgr$add (tablep, table_size, table_type, new_tablerp, code);
1909 end;
1910 end;
1911 else do;
1912 if table_type = delay_type
1913 then table_size = size (tablep -> delay);
1914 else table_size = divide (CV_TRANS_SIZE (argptr -> cv_trans_struc.version) + 1, 4, 17, 0);
1915
1916 call tty_tables_mgr$add (tablep, table_size, table_type, new_tablerp, code);
1917 end;
1918 if code ^= 0
1919 then return;
1920
1921 if table_type = special_type
1922 then do;
1923 tablep = ptr (ttytp, new_tablerp);
1924 tablep -> special_chars.escape_length = sc_escape_len;
1925 tablep -> special_chars.input_escapes.len = sc_input_escape_len;
1926 end;
1927 else if table_type = delay_type
1928 then do;
1929 call validate_delay_table (ptr (ttytp, new_tablerp), code);
1930 if code ^= 0
1931 then do;
1932 call tty_tables_mgr$delete (new_tablerp, 0);
1933 return;
1934 end;
1935 end;
1936 end;
1937
1938 if ^replace_sw
1939 then add_tablerp = new_tablerp;
1940 else do;
1941 if df_tablerp (table_type) = (18)"1"b
1942 then df_tablerp (table_type) = tablerp (table_type);
1943
1944 else if tablerp (table_type) ^= ""b
1945 then call tty_tables_mgr$delete (tablerp (table_type), 0);
1946
1947 tablerp (table_type) = new_tablerp;
1948 end;
1949 return;
1950
1951
1952 end replace_table;
1953 %page;
1954 get_table:
1955 proc (tablerp);
1956
1957
1958
1959 dcl tablerp bit (18);
1960 dcl tablep ptr;
1961
1962 if ^wtcb.flags.dialed
1963 then go to error;
1964
1965 if tablerp = ""b
1966 then ercode = error_table_$no_table;
1967
1968 else do;
1969 tablep = ptr (ttytp, tablerp);
1970 if argptr -> cv_trans_struc.version > CV_TRANS_VERSION
1971 then ercode = error_table_$unimplemented_version;
1972 else if argptr -> cv_trans_struc.version = CV_TRANS_VERSION
1973 then argptr -> cv_trans_struc.cv_trans = tablep -> cv_trans;
1974 else do i = 0 to CV_TRANS_SIZE (argptr -> cv_trans_struc.version);
1975 argptr -> cv_trans_struc.cv_trans.value (i) = tablep -> cv_trans.value (i);
1976 end;
1977 end;
1978 return;
1979
1980 end ;
1981 %page;
1982 alter_mode:
1983 proc (mode_name, alter_sw);
1984
1985 dcl mode_name char (*);
1986 dcl alter_sw bit (1);
1987
1988 dcl 1 modes_info aligned,
1989 2 len fixed bin,
1990 2 str char (20);
1991
1992
1993 if alter_sw
1994 then do;
1995 modes_info.str = mode_name;
1996 modes_info.len = length (mode_name);
1997 end;
1998 else do;
1999 modes_info.str = "^" || mode_name;
2000 modes_info.len = length (mode_name) + 1;
2001 end;
2002
2003 call tty_modes$mpx_only (wtcbp, addr (modes_info), ercode);
2004
2005 return;
2006
2007 end;
2008
2009
2010
2011 forward_order:
2012 proc;
2013
2014 call channel_manager$control (devx, order, argptr, ercode);
2015 if ercode ^= 0
2016 then go to unlock;
2017
2018 end;
2019 %page;
2020
2021
2022 validate_delay_table:
2023 proc (dp, code);
2024
2025 dcl dp ptr;
2026 dcl code fixed bin (35);
2027
2028 if max (abs (dp -> delay.vert_nl), dp -> delay.const_tab, abs (dp -> delay.backspace)) <= 127
2029 then if dp -> delay.vt_ff <= 511
2030 then if min (dp -> delay.const_tab, dp -> delay.vt_ff) >= 0
2031 then if max (dp -> delay.horz_nl, dp -> delay.var_tab) <= 1
2032 then if min (dp -> delay.horz_nl, dp -> delay.var_tab) >= 0
2033 then do;
2034 code = 0;
2035 return;
2036 end;
2037 code = error_table_$invalid_delay_value;
2038
2039 return;
2040
2041 end validate_delay_table;
2042
2043
2044
2045
2046 send_delays:
2047 entry (a_wtcbp);
2048
2049 wtcbp = a_wtcbp;
2050 tcbp = wtcb.tcb_ptr;
2051 devx = wtcb.devx;
2052 ttytp = addr (tty_tables$);
2053 call send_delay_table;
2054 return;
2055
2056
2057
2058
2059 send_delay_table:
2060 proc;
2061
2062 dcl code fixed bin (35);
2063
2064
2065 dcl fnp_delays (6) fixed bin (17) unal;
2066 dcl dp ptr;
2067
2068 if tcb.delayrp = ""b
2069 then fnp_delays (*) = 0;
2070 else do;
2071 dp = ptr (ttytp, tcb.delayrp);
2072 fnp_delays (1) = abs (dp -> delay.vert_nl);
2073 fnp_delays (2) = fixed (dp -> delay.horz_nl * 512, 17);
2074 fnp_delays (3) = dp -> delay.const_tab;
2075 fnp_delays (4) = fixed (dp -> delay.var_tab * 512, 17);
2076 fnp_delays (5) = abs (dp -> delay.backspace);
2077 fnp_delays (6) = min (dp -> delay.vt_ff, 127);
2078 end;
2079
2080 call channel_manager$control (devx, "set_delay", addr (fnp_delays), code);
2081
2082 end send_delay_table;
2083 %page;
2084
2085
2086 printer_on_off:
2087 entry (a_wtcbp, a_sw);
2088
2089 wtcbp = a_wtcbp;
2090 tcbp = wtcb.tcb_ptr;
2091 devx = wtcb.devx;
2092 ttytp = addr (tty_tables$);
2093 if a_sw
2094 then call turn_printer_on (0);
2095 else call turn_printer_off (0);
2096 return;
2097
2098
2099
2100
2101 turn_printer_off:
2102 proc (code);
2103
2104 dcl code fixed bin (35);
2105
2106 if tcb.no_printer_off
2107 then do;
2108 no_print_off:
2109 code = error_table_$action_not_performed;
2110 return;
2111 end;
2112
2113 call channel_manager$control (devx, "printer_off", null, code);
2114 if code = 0
2115 then return;
2116 if code ^= error_table_$undefined_order_request
2117 then return;
2118 code = 0;
2119
2120 if tcb.specialrp = ""b
2121 then go to no_print_off;
2122 special_ptr = ptr (ttytp, tcb.specialrp);
2123 if special_ptr -> special_chars.printer_off.count = 0
2124 then go to no_print_off;
2125 rawom = tcb.modes.rawom;
2126 tcb.modes.rawom = "1"b;
2127
2128 call tty_write$locked (devx, addr (special_ptr -> special_chars.printer_off.chars), 0,
2129 (special_ptr -> special_chars.printer_off.count), i, (0), code);
2130 tcb.modes.rawom = rawom;
2131
2132 return;
2133
2134 end turn_printer_off;
2135
2136
2137
2138
2139
2140
2141 turn_printer_on:
2142 proc (code);
2143
2144 dcl code fixed bin (35);
2145
2146 if tcb.no_printer_off
2147 then do;
2148 no_print_on:
2149 code = error_table_$action_not_performed;
2150 return;
2151 end;
2152
2153 call channel_manager$control (devx, "printer_on", null, code);
2154 if code = 0
2155 then return;
2156 if code ^= error_table_$undefined_order_request
2157 then return;
2158 code = 0;
2159
2160 if tcb.specialrp = ""b
2161 then go to no_print_on;
2162
2163 special_ptr = ptr (ttytp, tcb.specialrp);
2164 if special_ptr -> special_chars.printer_on.count = 0
2165 then go to no_print_on;
2166 rawom = tcb.modes.rawom;
2167 tcb.modes.rawom = "1"b;
2168
2169 call tty_write$locked (devx, addr (special_ptr -> special_chars.printer_on.chars), 0,
2170 (special_ptr -> special_chars.printer_on.count), i, (0), code);
2171 tcb.modes.rawom = rawom;
2172
2173 return;
2174
2175 end turn_printer_on;
2176 %page;
2177 setup:
2178 proc (state);
2179
2180 dcl state fixed bin;
2181 devx = twx;
2182 ttybp = addr (tty_buf$);
2183 lctp = tty_buf.lct_ptr;
2184 if devx < 1 | devx > lct.max_no_lctes
2185 then do;
2186 ercode = error_table_$invalid_device;
2187 go to ret;
2188 end;
2189
2190 call tty_lock$lock_channel (devx, ercode);
2191 if ercode ^= 0
2192 then go to ret;
2193 locked = "1"b;
2194
2195 lctep = addr (lct.lcte_array (devx));
2196 if lcte.channel_type ^= 0
2197 then go to illdet;
2198
2199 wtcbp = lcte.data_base_ptr;
2200 tcbp = wtcb.tcb_ptr;
2201 if ^wtcb.tcb_initialized
2202 then call init_tcb;
2203
2204 if wtcb.dialed
2205 then state = DIALED_UP;
2206 else if wtcb.masked
2207 then state = MASKED_STATE;
2208 else if wtcb.listen
2209 then state = LISTENING;
2210 else state = IGNORE;
2211
2212 ercode = 0;
2213
2214 if wtcb.hproc = pds$processid
2215 then return;
2216
2217 if wtcb.hproc = "0"b
2218 then return;
2219
2220
2221 if (wtcb.uproc = pds$processid & (tcb.uproc_attached | ^uproc_attach_required_for_setup))
2222 | ^uproc_required_for_setup
2223 then return;
2224
2225 go to illdet;
2226 end;
2227
2228 illdet:
2229 ercode = error_table_$io_no_permission;
2230 call tty_lock$unlock_channel (devx);
2231
2232 ret:
2233 if ercode ^= 0
2234 then state = 0;
2235 return;
2236 %page;
2237 get_devx:
2238 proc (chan_name);
2239
2240 dcl chan_name char (*);
2241
2242 lcntp = lct.lcnt_ptr;
2243 do devx = 1 to lct.max_no_lctes while (lcnt.names (devx) ^= chan_name);
2244 end;
2245 if devx > lct.max_no_lctes
2246 then
2247 do devx = 1 to lct.max_no_lctes while (^compare_tty_name_ (chan_name, lcnt.names (devx)));
2248 end;
2249
2250 if devx > lct.max_no_lctes
2251 then ercode = error_table_$invalid_device;
2252 else ercode = 0;
2253 return;
2254
2255 end;
2256
2257
2258 cleaner:
2259 proc;
2260
2261 if locked
2262 then call tty_lock$unlock_channel (devx);
2263
2264 end cleaner;
2265 %page;
2266
2267
2268 translate_wakeup_table:
2269 proc;
2270
2271 dcl 1 temp_table aligned like wakeup_table;
2272 dcl (i, j) fixed bin;
2273 dcl p ptr;
2274
2275 if tcb.input_mvtrp = ""b
2276 then return;
2277 string (temp_table) = ""b;
2278 p = ptr (ttytp, tcb.input_mvtrp);
2279 do i = 0 to 127;
2280 if new_waketab.wake_map (i)
2281 then do j = 0 to 127;
2282 if p -> cv_trans.value (j) = i
2283 then temp_table.wake_map (j) = "1"b;
2284 end;
2285 end;
2286
2287 new_waketab = temp_table;
2288 end;
2289
2290
2291
2292
2293
2294 untranslate_wakeup_table:
2295 proc;
2296
2297 dcl 1 temp_table aligned like wakeup_table;
2298 dcl i fixed bin;
2299 dcl p ptr;
2300
2301 if tcb.input_mvtrp = ""b
2302 then return;
2303 string (temp_table) = ""b;
2304 p = ptr (ttytp, tcb.input_mvtrp);
2305 do i = 0 to 127;
2306 if old_waketab.wake_map (i)
2307 then do;
2308 j = p -> cv_trans.value (i);
2309 if j <= 127
2310 then temp_table.wake_map (j) = "1"b;
2311 end;
2312 end;
2313
2314 old_waketab = temp_table;
2315 end;
2316
2317 %page;
2318 is_parent_mpx:
2319 proc (parent_mpx_type) returns (bit (1));
2320
2321 dcl parent_mpx_type fixed bin;
2322 dcl temp_lctep ptr;
2323
2324 if lcte.major_channel_devx ^= 0
2325 then do;
2326 temp_lctep = addr (lct.lcte_array (lcte.major_channel_devx));
2327 if temp_lctep -> lcte.channel_type = parent_mpx_type
2328 then return ("1"b);
2329 end;
2330 else if lcte.channel_type = parent_mpx_type
2331 then return ("1"b);
2332 return ("0"b);
2333 end is_parent_mpx;
2334 %page;
2335 copy_to_old_special_table:
2336 proc;
2337
2338
2339
2340
2341
2342 special_chars_old_ptr = addr (temp_ptr -> special_chars_struc_old.special_chars);
2343
2344 if special_ptr -> special_chars.nl_seq.count > 3
2345 then do;
2346 bad_special_size:
2347 ercode = error_table_$invalid_array_size;
2348 return;
2349 end;
2350 addr (special_chars_old.nl_seq) -> c_chars_old = addr (special_ptr -> special_chars.nl_seq) -> c_chars_old;
2351
2352 if special_ptr -> special_chars.cr_seq.count > 3
2353 then go to bad_special_size;
2354 addr (special_chars_old.cr_seq) -> c_chars_old = addr (special_ptr -> special_chars.cr_seq) -> c_chars_old;
2355
2356 if special_ptr -> special_chars.bs_seq.count > 3
2357 then go to bad_special_size;
2358 addr (special_chars_old.bs_seq) -> c_chars_old = addr (special_ptr -> special_chars.bs_seq) -> c_chars_old;
2359
2360 if special_ptr -> special_chars.tab_seq.count > 3
2361 then go to bad_special_size;
2362 addr (special_chars_old.tab_seq) -> c_chars_old = addr (special_ptr -> special_chars.tab_seq) -> c_chars_old;
2363
2364 if special_ptr -> special_chars.vt_seq.count > 3
2365 then go to bad_special_size;
2366 addr (special_chars_old.vt_seq) -> c_chars_old = addr (special_ptr -> special_chars.vt_seq) -> c_chars_old;
2367
2368 if special_ptr -> special_chars.ff_seq.count > 3
2369 then go to bad_special_size;
2370 addr (special_chars_old.ff_seq) -> c_chars_old = addr (special_ptr -> special_chars.ff_seq) -> c_chars_old;
2371
2372 if special_ptr -> special_chars.printer_on.count > 3
2373 then go to bad_special_size;
2374 addr (special_chars_old.printer_on) -> c_chars_old =
2375 addr (special_ptr -> special_chars.printer_on) -> c_chars_old;
2376
2377 if special_ptr -> special_chars.printer_off.count > 3
2378 then go to bad_special_size;
2379 addr (special_chars_old.printer_off) -> c_chars_old =
2380 addr (special_ptr -> special_chars.printer_off) -> c_chars_old;
2381
2382 if special_ptr -> special_chars.red_ribbon_shift.count > 3
2383 then go to bad_special_size;
2384 addr (special_chars_old.red_ribbon_shift) -> c_chars_old =
2385 addr (special_ptr -> special_chars.red_ribbon_shift) -> c_chars_old;
2386
2387 if special_ptr -> special_chars.black_ribbon_shift.count > 3
2388 then go to bad_special_size;
2389 addr (special_chars_old.black_ribbon_shift) -> c_chars_old =
2390 addr (special_ptr -> special_chars.black_ribbon_shift) -> c_chars_old;
2391
2392 if special_ptr -> special_chars.end_of_page.count > 3
2393 then go to bad_special_size;
2394 addr (special_chars_old.end_of_page) -> c_chars_old =
2395 addr (special_ptr -> special_chars.end_of_page) -> c_chars_old;
2396
2397 special_chars_old.escape_length = special_ptr -> special_chars.escape_length;
2398
2399 do i = 1 to special_ptr -> special_chars.escape_length;
2400 if special_ptr -> special_chars.not_edited_escapes (i).count > 3
2401 | special_ptr -> special_chars.edited_escapes (i).count > 3
2402 then go to bad_special_size;
2403 addr (special_chars_old.not_edited_escapes (i)) -> c_chars_old =
2404 addr (special_ptr -> special_chars.not_edited_escapes (i)) -> c_chars_old;
2405
2406 addr (special_chars_old.edited_escapes (i)) -> c_chars_old =
2407 addr (special_ptr -> special_chars.edited_escapes (i)) -> c_chars_old;
2408 end;
2409
2410 special_chars_old.input_escapes.len = special_ptr -> special_chars.input_escapes.len;
2411 special_chars_old.input_escapes.str = special_ptr -> special_chars.input_escapes.str;
2412
2413 special_chars_old.input_results.pad = special_ptr -> special_chars.input_results.pad;
2414 special_chars_old.input_results.str = special_ptr -> special_chars.input_results.str;
2415
2416 end copy_to_old_special_table;
2417 %page;
2418 copy_from_old_special_table:
2419 proc (source_ptr, target_ptr);
2420
2421
2422
2423
2424
2425 dcl target_ptr ptr;
2426 dcl source_ptr ptr;
2427
2428 special_chars_old_ptr = source_ptr;
2429 addr (target_ptr -> special_chars.nl_seq) -> c_chars_old = addr (special_chars_old.nl_seq) -> c_chars_old;
2430
2431 addr (target_ptr -> special_chars.cr_seq) -> c_chars_old = addr (special_chars_old.cr_seq) -> c_chars_old;
2432
2433 addr (target_ptr -> special_chars.bs_seq) -> c_chars_old = addr (special_chars_old.bs_seq) -> c_chars_old;
2434
2435 addr (target_ptr -> special_chars.tab_seq) -> c_chars_old = addr (special_chars_old.tab_seq) -> c_chars_old;
2436
2437 addr (target_ptr -> special_chars.vt_seq) -> c_chars_old = addr (special_chars_old.vt_seq) -> c_chars_old;
2438
2439 addr (target_ptr -> special_chars.ff_seq) -> c_chars_old = addr (special_chars_old.ff_seq) -> c_chars_old;
2440
2441 addr (target_ptr -> special_chars.printer_on) -> c_chars_old =
2442 addr (special_chars_old.printer_on) -> c_chars_old;
2443
2444 addr (target_ptr -> special_chars.printer_off) -> c_chars_old =
2445 addr (special_chars_old.printer_off) -> c_chars_old;
2446
2447 addr (target_ptr -> special_chars.red_ribbon_shift) -> c_chars_old =
2448 addr (special_chars_old.red_ribbon_shift) -> c_chars_old;
2449
2450 addr (target_ptr -> special_chars.black_ribbon_shift) -> c_chars_old =
2451 addr (special_chars_old.black_ribbon_shift) -> c_chars_old;
2452
2453 addr (target_ptr -> special_chars.end_of_page) -> c_chars_old =
2454 addr (special_chars_old.end_of_page) -> c_chars_old;
2455
2456 target_ptr -> special_chars.escape_length = special_chars_old.escape_length;
2457
2458 do i = 1 to special_chars_old.escape_length;
2459 addr (target_ptr -> special_chars.not_edited_escapes (i)) -> c_chars_old =
2460 addr (special_chars_old.not_edited_escapes (i)) -> c_chars_old;
2461 addr (target_ptr -> special_chars.edited_escapes (i)) -> c_chars_old =
2462 addr (special_chars_old.edited_escapes (i)) -> c_chars_old;
2463 end;
2464
2465 target_ptr -> special_chars.input_escapes.len = special_chars_old.input_escapes.len;
2466 target_ptr -> special_chars.input_escapes.str = special_chars_old.input_escapes.str;
2467
2468 target_ptr -> special_chars.input_results.pad = special_chars_old.input_results.pad;
2469 target_ptr -> special_chars.input_results.str = special_chars_old.input_results.str;
2470
2471 end copy_from_old_special_table;
2472
2473
2474 %page; %include aim_template;
2475 %page; %include tty_convert;
2476 %page; %include tty_buf;
2477 %page; %include wtcb;
2478 %page; %include tcb;
2479 %page; %include tty_buffer_block;
2480 %page; %include lct;
2481 %page; %include tty_tables;
2482 %page; %include mailbox_ops;
2483 %page; %include net_event_message;
2484 %page; %include terminal_type_data;
2485 dcl ttd_version_2 fixed bin int static options (constant) init (2);
2486 %page; %include terminal_info;
2487 %page; %include tty_space_man_dcls;
2488 %page; %include channel_manager_dcls;
2489 %page; %include line_types;
2490 %page; %include mcs_echo_neg;
2491 %page; %include mcs_echo_neg_sys;
2492 %page; %include set_wakeup_table_info;
2493 %page; %include set_prompt_info;
2494 %page; %include flow_control_info;
2495 %page; %include get_comm_meters_info;
2496 %page; %include tty_channel_meters;
2497 %page; %include tty_access_class;
2498 %page; %include syserr_constants;
2499 %page; %include multiplexer_types;
2500
2501
2502 %page;
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522 end;