1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style4,delnl,insnl,^ifthendo */
 14 
 15 tty_modes:
 16      proc (pm_wtcbp, pm_modes_infop, pm_code);
 17 
 18 /* A procedure to handle modes changing and related trivia. */
 19 
 20 /* Coded 4/9/79 by J. Stern */
 21 /* Modified: 11 November 1980 by G. Palter to handle can_type and implement MCS suggestions #64 and #65 */
 22 /* Modified: 16 November 1981 by G. Palter to fix bug in interaction of init and can_type modes */
 23 /* Modified: 9/14/84 by John Mills to fix bug in enteraction of can_type and can modes */
 24 /* Modified: 9/25/84 by Robert Coren to enforce the requirement that flow control
 25    characters must be set before the modes can be turned on, and to remove prefixnl from the list
 26    of modes turned on by "default" mode */
 27 
 28 
 29 /****^  HISTORY COMMENTS:
 30   1) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-08-04,Coren),
 31      install(86-10-09,MR12.0-1181):
 32      Changed to support the new tty event message format declared in
 33      net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1.
 34                                                    END HISTORY COMMENTS */
 35 
 36 
 37 /* Parameters */
 38 
 39 dcl  pm_code fixed bin (35);                                /* error code */
 40 dcl  pm_modes_infop ptr;                                    /* ptr to modes_info structure */
 41 dcl  pm_wtcbp ptr;                                          /* ptr to wtcb of channel to which modes change applies */
 42 
 43 
 44 /* Automatic */
 45 
 46 dcl  code fixed bin (35);
 47 dcl  force_sw bit (1);
 48 dcl  i fixed bin;
 49 dcl  j fixed bin;
 50 dcl  idx fixed bin;
 51 dcl  lock_keyboard bit (1) aligned;
 52 dcl  mclx fixed bin;
 53 dcl  mode_name char (32) varying;
 54 dcl  1 modes_change_list aligned like mcl;
 55 dcl  modes_infop ptr;
 56 dcl  modes_len fixed bin;
 57 dcl  mpx_only_sw bit (1);
 58 dcl  off_modes (36) bit (1);
 59 dcl  on_modes (36) bit (1);
 60 dcl  saved_force_sw bit (1);
 61 dcl  saved_ll fixed bin;
 62 dcl  saved_modes bit (36);
 63 dcl  saved_mpx_modes char (192);
 64 dcl  saved_pl fixed bin;
 65 dcl  saved_can_type fixed bin;
 66 dcl  send_delay_table_sw bit (1);
 67 dcl  sw bit (1);
 68 dcl  temp_modes char (576) varying;
 69 
 70 
 71 /* Based */
 72 
 73 dcl  1 modes_info aligned based (modes_infop),
 74        2 len fixed bin,
 75        2 str char (0 refer (modes_info.len));
 76 
 77 
 78 /* Constants */
 79 
 80 dcl  NUL char (1) int static options (constant) init ("^@");
 81 
 82 
 83 /* External static */
 84 
 85 dcl  error_table_$bad_mode fixed bin (35) ext;
 86 dcl  error_table_$bigarg fixed bin (35) ext;
 87 dcl  error_table_$improper_data_format fixed bin (35) ext;
 88 dcl  error_table_$smallarg fixed bin (35) ext;
 89 
 90 
 91 /* Builtins */
 92 
 93 dcl  (addr, after, bin, hbound, index, lbound, length, ltrim, reverse, rtrim, string, substr, verify) builtin;
 94 
 95 
 96 /* Entries */
 97 
 98 dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
 99 dcl  tty_index$printer_on_off entry (ptr, bit (1));
100 dcl  tty_index$send_delays entry (ptr);
101 ^L
102 %include mcs_modes_change_list;
103 ^L
104 %include tty_mode_names;
105 
106 %include tty_can_types;
107 ^L
108 %include wtcb;
109 ^L
110 %include tcb;
111 ^L
112 %include net_event_message;
113 ^L
114 %include channel_manager_dcls;
115 ^L
116 %include mcs_echo_neg_sys;
117 ^L
118           mpx_only_sw = "0"b;
119           go to join;
120 
121 
122 /* for this entry, modes are merely forwarded to the multiplexer
123    no local action is taken and no old modes are returned
124 */
125 
126 mpx_only:
127      entry (pm_wtcbp, pm_modes_infop, pm_code);
128 
129           mpx_only_sw = "1"b;
130 
131 join:
132           pm_code = 0;
133           wtcbp = pm_wtcbp;
134           tcbp = wtcb.tcb_ptr;
135           modes_infop = pm_modes_infop;
136 
137           saved_modes = string (tcb.modes);                 /* save current modes */
138           saved_ll = tcb.colmax;
139           saved_pl = tcb.linemax;
140           saved_can_type = tcb.can_type;
141 
142 /* initialize modes change list */
143 
144           mclp = addr (modes_change_list);
145           mcl.version = mcl_version_2;
146           mcl.n_entries = 0;
147           mcl.line_len = -1;
148           mcl.page_len = -1;
149           mcl.can_type = -1;
150           string (mcl.flags) = ""b;
151 
152 /* parse the modes string */
153 
154           modes_len = length (rtrim (modes_info.str));
155           if modes_len > 0
156           then if substr (modes_info.str, modes_len, 1) = "."
157                then modes_len = modes_len - 1;
158 
159           if modes_len <= 0
160           then do;
161                if mpx_only_sw
162                then return;
163                call get_mpx_modes;
164                go to build_old_modes;
165           end;
166 
167           if index (substr (modes_info.str, 1, modes_len), ".") ^= 0
168                                                             /* imbedded period */
169                | index (substr (modes_info.str, 1, modes_len), " ") ^= 0
170                                                             /* imbedded space */
171           then go to bad_format;
172 
173           force_sw = "0"b;
174           mclx = 0;
175           i = 1;
176           do while (i <= modes_len);                        /* scan modes string until reaching the end */
177                j = index (substr (modes_info.str, i), ",") - 1;
178                                                             /* find next mode boundary */
179                if j = -1                                    /* end of string */
180                then j = modes_len - (i - 1);
181                if j <= 0                                    /* skinny mode */
182                then go to bad_format;
183 
184                if substr (modes_info.str, i, 1) = "^"       /* OFF indicator */
185                then do;
186                     i = i + 1;
187                     j = j - 1;
188                     if j <= 0
189                     then go to bad_format;
190                     sw = "0"b;
191                end;
192                else sw = "1"b;                              /* if not OFF, then ON */
193 
194                mode_name = substr (modes_info.str, i, j);
195                if j > length (mode_name)
196                then go to bad_mode;
197                if mode_name = "init"
198                then do;
199                     if ^sw
200                     then go to bad_mode;
201                     mcl.init = "1"b;
202                     mcl.line_len = 50;
203                     mcl.page_len = 0;
204                     mcl.can_type = CAN_TYPE_OVERSTRIKE;
205                end;
206                else if mode_name = "force"
207                then force_sw = sw;
208                else if mode_name = "default"
209                then do;
210                     if ^sw
211                     then go to bad_mode;
212                     saved_force_sw = force_sw;
213                     force_sw = "1"b;                        /* force all default modes */
214                     do mode_name = "esc", "can", "erkl";    /* add default ON modes */
215                          call add_mode_change;
216                     end;
217                     sw = "0"b;
218                     do mode_name = "rawi", "rawo", "breakall", "wake_tbl";
219                                                             /* add default OFF modes */
220                          call add_mode_change;
221                     end;
222                     force_sw = saved_force_sw;
223                end;
224                else if substr (mode_name, 1, 2) = "ll"
225                then mcl.line_len = convert_len ();
226                else if substr (mode_name, 1, 2) = "pl"
227                then mcl.page_len = convert_len ();
228                else if length (mode_name) > 9               /* to ensure validity of substr */
229                     & (substr (mode_name, 1, 9) = "can_type=")
230                then do;
231                     if ^sw
232                     then go to bad_mode;
233                     mcl.can_type = -1;                      /* about to get a new value */
234                     do idx = lbound (CAN_TYPE_NAMES, 1) to hbound (CAN_TYPE_NAMES, 1) while (mcl.can_type = -1);
235                          if (mode_name = CAN_TYPE_NAMES (idx))
236                          then mcl.can_type = idx;           /* found it */
237                     end;
238                     if (mcl.can_type = -1)
239                     then                                    /* don't recognize the user's canonicalization type */
240                          go to bad_mode;
241                end;
242                else call add_mode_change;
243 
244                i = i + j + 1;                               /* skip to next mode */
245           end;
246           mcl.n_entries = mclx;                             /* fill in mode change count */
247 
248 /* let multiplexer check mode changes */
249 
250           call channel_manager$check_modes ((wtcb.devx), mclp, code);
251           if code ^= 0
252           then if code ^= error_table_$bad_mode             /* if bad_mode, look for more errors before returning */
253                then do;
254                     pm_code = code;
255                     return;
256                end;
257 
258 /* find modes that we must change rather than multiplexer */
259 
260           send_delay_table_sw = "0"b;
261           on_modes (*) = "0"b;
262           off_modes (*) = "0"b;
263           if mcl.init
264           then off_modes (*) = "1"b;
265 
266           do mclx = 1 to mcl.n_entries;
267                mclep = addr (mcl.entries (mclx));
268                do i = 1 to n_modes while (modestr (i) ^= mcle.mode_name);
269                end;
270                if i <= n_modes                              /* this is a standard mode */
271                then do;
272                     if MPX_MODES (i) & ^mcle.mpx_mode       /* need multiplexer help for this mode */
273                     then do;
274                          if mcle.mode_switch ^= substr (saved_modes, i, 1)
275                                                             /* this is a real change */
276                          then if ^mcle.force
277                               then go to mode_error;
278                     end;
279                     else do;
280 
281                          if substr (saved_modes, i, 1) = mcle.mode_switch & ^mpx_only_sw & ^mcl.init
282                                                             /* this is not a change */
283                          then mcle.mpx_mode = "0"b;         /* so make sure multiplexer doesn't try to do it */
284 
285                          else if mcle.mode_switch
286                          then do;                           /* be careful when turning on certain modes */
287                               if mcle.mode_name = "echoplex" | mcle.mode_name = "crecho" | mcle.mode_name = "lfecho"
288                               then send_delay_table_sw = "1"b;
289                               else if mcle.mode_name = "blk_xfer"
290                               then do;
291                                    if tcb.frame_end = NUL
292                                    then go to mode_error;
293                               end;
294 
295                               else if mcle.mode_name = "oflow"
296                               then do;                      /* make sure characters have been set */
297                                    if tcb.output_suspend_etb_seq.count = 0 | tcb.output_resume_ack_seq.count = 0
298                                    then go to mode_error;
299                               end;
300 
301                               else if mcle.mode_name = "iflow"
302                               then do;                      /* as above */
303                                    if tcb.input_suspend_seq.count = 0 | tcb.input_resume_seq.count = 0
304                                    then go to mode_error;
305                               end;
306 
307                               else if mcle.mode_name = "wake_tbl"
308                               then do;
309                                    if wtcb.waketp = ""b
310                                    then go to mode_error;
311                               end;
312                          end;
313 
314                          on_modes (i) = mcle.mode_switch;
315                          off_modes (i) = ^mcle.mode_switch;
316                     end;
317                end;
318                else if ^mcle.mpx_mode                       /* nobody knows this mode */
319                then do;
320                     if ^mcle.force
321                     then do;
322 mode_error:
323                          mcle.error = "1"b;
324                          code = error_table_$bad_mode;
325                     end;
326                end;
327           end;
328           if code ^= 0
329           then go to mcl_error;                             /* take care of all accumulated mode errors */
330 
331 /* now go change the modes */
332 
333           if ^mpx_only_sw
334           then call get_mpx_modes;
335 
336           call channel_manager$set_modes ((wtcb.devx), mclp, code);
337           if code ^= 0
338           then do;
339                if code = error_table_$bad_mode
340                then go to mcl_error;
341                pm_code = code;
342                return;
343           end;
344           if mpx_only_sw
345           then return;
346 
347           if send_delay_table_sw
348           then call tty_index$send_delays (wtcbp);
349 
350           do j = 1 to n_modes;                              /* we've checked the mode string, now implement it */
351                if on_modes (j)
352                then sw = "1"b;
353                else if off_modes (j)
354                then sw = "0"b;
355                else go to end_of_mode;
356                if substr (saved_modes, j, 1) = sw           /* no change to this mode */
357                then go to end_of_mode;
358 
359                substr (string (tcb.modes), j, 1) = sw;
360                go to set_modes (j);
361 
362 set_modes (13):                                             /* hndlquit */
363                wtcb.flags.hndlquit = sw;
364 
365 set_modes (14):                                             /* full_duplex */
366                if tcb.keyboard_locking
367                then do;                                     /* turn keyboard locking on/off if appropriate */
368                     lock_keyboard = ^sw;                    /* fulldpx ON => unlock keyboard and vice versa */
369                     call channel_manager$control ((wtcb.devx), "lock", addr (lock_keyboard), code);
370                end;
371                go to end_of_mode;
372 
373 set_modes (15):                                             /* echoplex */
374                call tty_index$printer_on_off (wtcbp, ^sw);
375                go to end_of_mode;
376 
377 set_modes (21):                                             /* breakall */
378                wtcb.flags.breakall = sw;
379                if sw = "0"b
380                then do;                                     /* Turn off echnego */
381                     wtcb.negotiating_echo = "0"b;
382                     if wtcb.echdp ^= "000000"b3
383                     then do;
384                          echo_datap = ptr (wtcbp, wtcb.echdp);
385                          echo_data.synchronized = "0"b;
386                     end;
387                end;
388                go to end_of_mode;
389 
390 set_modes (22):                                             /* scroll */
391                wtcb.flags.scroll = sw;
392                go to end_of_mode;
393 
394 set_modes (24):                                             /* wake_tbl */
395                wtcb.flags.wake_tbl = sw;
396                wtcb.allow_wakeup = "0"b;
397                if wtcb.rflag & (wtcb.fblock ^= 0)           /* waiting for wakeup and has input */
398                then do;                                     /* play it safe, send wakeup now */
399                     unspec (net_event_message) = "0"b;
400                     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
401                     net_event_message.network_type = MCS_NETWORK_TYPE;
402                     net_event_message.handle = wtcb.devx;
403                     net_event_message.type = MCS_READ_MSG;
404                     call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, code);
405                end;
406                go to end_of_mode;
407 
408 set_modes (1):
409 set_modes (2):
410 set_modes (3):
411 set_modes (4):
412 set_modes (5):
413 set_modes (6):
414 set_modes (7):
415 set_modes (8):
416 set_modes (9):
417 set_modes (10):
418 set_modes (11):
419 set_modes (12):
420 set_modes (16):
421 set_modes (17):
422 set_modes (18):
423 set_modes (19):
424 set_modes (20):
425 set_modes (23):
426 set_modes (25):
427 set_modes (26):
428 set_modes (27):
429 set_modes (28):
430 set_modes (29):
431 end_of_mode:
432           end;
433 
434           if mcl.line_len ^= -1
435           then tcb.colmax = mcl.line_len;
436           if mcl.page_len ^= -1
437           then do;
438                tcb.linemax = mcl.page_len;
439                wtcb.count_lines = (mcl.page_len ^= 0);
440           end;
441           if mcl.can_type ^= -1
442           then tcb.can_type = mcl.can_type;
443 
444 
445 /* build string of old modes to return */
446 
447 build_old_modes:
448           temp_modes = "";
449           call append_ll (saved_ll);
450           call append_pl (saved_pl);
451           call append_can_type (saved_can_type);
452 
453           do i = 1 to n_modes;
454                call append_mode ((modestr (i)), substr (saved_modes, i, 1));
455           end;
456 
457           if saved_mpx_modes ^= ""
458           then temp_modes = temp_modes || "," || rtrim (saved_mpx_modes);
459           temp_modes = temp_modes || ".";
460 
461           modes_info.str = temp_modes;
462           if length (temp_modes) > modes_info.len
463           then do;                                          /* doesn't fit: truncate to last complete mode */
464                idx = modes_info.len - index (reverse (modes_info.str), ",") + 1;
465                if (idx = modes_info.len + 1)
466                then modes_info.str = "";                    /* not even the first mode fits */
467                else substr (modes_info.str, idx) = ".";     /* truncate mode string at last comma */
468                pm_code = error_table_$smallarg;
469           end;
470 
471           return;
472 
473 
474 
475 bad_format:
476           pm_code = error_table_$improper_data_format;
477           return;
478 
479 bad_mode:
480           pm_code = error_table_$bad_mode;
481           if sw
482           then modes_info.str = mode_name;
483           else modes_info.str = "^" || mode_name;
484           return;
485 
486 mcl_error:
487           pm_code = error_table_$bad_mode;
488           temp_modes = "";
489           if mcl.flags.ll_error
490           then call append_ll (mcl.line_len);
491           if mcl.flags.pl_error
492           then call append_pl (mcl.page_len);
493           if mcl.flags.can_type_error
494           then call append_can_type (mcl.can_type);
495           do i = 1 to mcl.n_entries;
496                mclep = addr (mcl.entries (i));
497                if mcle.error
498                then call append_mode (mcle.mode_name, mcle.mode_switch);
499           end;
500           modes_info.str = temp_modes;
501           return;
502 
503 error_exit:
504           return;
505 ^L
506 /* subroutine to add an entry to the mode change list */
507 
508 add_mode_change:
509      proc;
510 
511 dcl  i fixed bin;
512 
513 /* avoid duplicate entries for the same mode */
514 
515           do i = 1 to mclx while (mcl.entries (i).mode_name ^= mode_name);
516           end;
517           if i > mclx                                       /* not a repeat */
518           then do;
519                mclx = i;
520                if mclx > hbound (modes_change_list.entries, 1)
521                then do;
522                     pm_code = error_table_$bigarg;
523                     go to error_exit;
524                end;
525           end;
526 
527           mclep = addr (mcl.entries (i));
528           if mclx = i                                       /* first time for this mode */
529           then do;
530                mcle.mode_name = mode_name;
531                string (mcle.flags) = ""b;
532           end;
533           mcle.mode_switch = sw;
534           mcle.force = force_sw;
535 
536      end;
537 
538 
539 
540 /* subroutine to get multiplexer modes */
541 
542 get_mpx_modes:
543      proc;
544 
545           call channel_manager$get_modes ((wtcb.devx), saved_mpx_modes, code);
546           if code ^= 0
547           then do;
548                pm_code = code;
549                go to error_exit;
550           end;
551 
552      end;
553 ^L
554 /* subroutine to convert from chars to fixed bin */
555 
556 convert_len:
557      proc returns (fixed bin);
558 
559 dcl  len fixed bin;
560 dcl  size condition;
561 
562           if ^sw
563           then do;
564                if length (mode_name) > 2
565                then go to bad_mode;
566                return (0);
567           end;
568 
569           if length (mode_name) < 3
570           then go to bad_mode;
571           if verify (substr (mode_name, 3), "0123456789") ^= 0
572           then go to bad_mode;
573 
574           on size go to bad_mode;
575           len = bin (substr (mode_name, 3), 17);
576           revert size;
577           if len ^= 0
578           then if len < 5 | len > 255
579                then go to bad_mode;
580 
581           return (len);
582      end;
583 
584 
585 
586 /* subroutine to append mode to mode string */
587 
588 append_mode:
589      proc (name, switch);
590 
591 dcl  name char (*);
592 dcl  switch bit (1);
593 
594           if length (temp_modes) > 0
595           then temp_modes = temp_modes || ",";
596           if ^switch
597           then temp_modes = temp_modes || "^";
598           temp_modes = temp_modes || rtrim (name);
599 
600           return;
601      end;
602 
603 
604 
605 /* subroutine to append can_type mode to mode string */
606 
607 append_can_type:
608      procedure (P_can_type);
609 
610 dcl  P_can_type fixed binary parameter;
611 
612           if length (temp_modes) > 0
613           then temp_modes = temp_modes || ",";
614 
615           if (P_can_type < lbound (CAN_TYPE_NAMES, 1)) | (P_can_type > hbound (CAN_TYPE_NAMES, 1))
616           then temp_modes = temp_modes || rtrim (CAN_TYPE_NAMES (lbound (CAN_TYPE_NAMES, 1)));
617           else temp_modes = temp_modes || rtrim (CAN_TYPE_NAMES (P_can_type));
618 
619           return;
620 
621      end append_can_type;
622 ^L
623 /* subroutine to append line length to mode string */
624 
625 append_ll:
626      proc (ll);
627 
628 dcl  ll fixed bin;
629 dcl  pic999 picture "999";
630 
631           if length (temp_modes) > 0
632           then temp_modes = temp_modes || ",";
633           if ll = 0
634           then temp_modes = temp_modes || "^ll";
635           else do;
636                pic999 = ll;
637                temp_modes = temp_modes || "ll" || ltrim (pic999, "0");
638           end;
639 
640      end;
641 
642 
643 
644 /* subroutine to append page length to mode string */
645 
646 append_pl:
647      proc (pl);
648 
649 dcl  pl fixed bin;
650 dcl  pic999 picture "999";
651 
652           if length (temp_modes) > 0
653           then temp_modes = temp_modes || ",";
654           if pl = 0
655           then temp_modes = temp_modes || "^pl";
656           else do;
657                pic999 = pl;
658                temp_modes = temp_modes || "pl" || ltrim (pic999, "0");
659           end;
660      end;
661 
662 
663      end;