1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   6         *                                                         *
   7         * Copyright (c) 1972 by Massachusetts Institute of        *
   8         * Technology and Honeywell Information Systems, Inc.      *
   9         *                                                         *
  10         *********************************************************** */
  11 
  12 /****^  HISTORY COMMENTS:
  13   1) change(85-02-01,RCoren), approve(), audit(), install():
  14      Modified to initialize the tty_access_class structure at the tty_attach
  15         entry.
  16      Modified December 1984 by Robert Coren to implement
  17         "(set get)_line_status_enabled" orders.
  18      Modified 84-12-04 by EJ Sharpe to remove protection_audit_ calls
  19      Modified November 1984 by Robert Coren to use tty_area_manager entries
  20         for allocating and freeing TCBs.
  21      Modified September 1984 by Robert Coren to turn off wtcb.dialing if
  22         dialout fails, and to zero pad fields in output_flow_control_info
  23         structure for set_terminal_data order.
  24      Modified February 1984 by Robert Coren to correct bug in access_class
  25         checking.
  26      Modified May 1983 by Robert Coren and E. N. Kittlitz for
  27         required_access_class.
  28      Modified November 1982 by Robert Coren to report wtcb.error_code.
  29      Modified November 1982 by Robert Coren to reset masked bit on "unmask"
  30         order.
  31      Modified June 1982 by Robert Coren to report MASKED state and to reset
  32         it on listen order.
  33      Modified June 1981 by Benson I. Margulies for error on duplicate
  34         attachments.
  35      Modified April 1981 by Robert Coren to handle dialup time
  36      Modified 81 January by Art Beattie to pass along 32 character phone
  37         numbers.
  38      Modified 4 December 1980 by Robert Coren to add copy_meters order
  39      Modified 3/6/80 by C. Hornig to pass 9-bit phone numbers
  40      Modified 4/10/79 by J. Stern to remove modes handling
  41      Modified 3/1/79 by J. Stern to add set_wakeup_table order
  42      Modified 10/11/78 by J. Stern for multiplexing changes
  43      Modified Aug 78 by J. Nicholls to implement ring 0 demuxing, some major
  44         changes involved
  45      Modified 5/17/78 by J. Stern to implement breakall mode
  46      Modified 4/18/78 by Robert Coren to implement blk_xfer mode and
  47         (set get)_framing chars orders and to fix bug that always rned off
  48         fulldpx with echoplex despite explicit user request
  49      Modified 2/6/78 by Robert Core
  50   2) change(86-04-23,Coren), approve(86-04-23,MCR7300),
  51      audit(86-05-19,Beattie), install(86-07-08,MR12.0-1089):
  52      To use version 2 mcs_echo_neg structure.
  53   3) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-08-04,Coren),
  54      install(86-10-09,MR12.0-1181):
  55      Changed to support the new tty event message format declared in
  56      net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1.
  57   4) change(86-09-26,Beattie), approve(86-09-22,MCR7542),
  58      audit(86-10-20,Brunelle), install(86-10-21,MR12.0-1190):
  59      Remove references to the 963 and 029 preaccess commands and remove support
  60      for ARDS, 202_ETX, 2741 and 1050 in system interfaces.
  61   5) change(87-03-10,LJAdams), approve(87-04-03,MCR7646),
  62      audit(87-05-06,Gilcrease), install(87-05-14,MR12.1-1029):
  63      Added support for ttd_version_3 which includes the protocol field.
  64   6) change(87-06-17,LJAdams), approve(87-06-17,MCR7584),
  65      audit(87-08-06,Gilcrease), install(87-08-06,MR12.1-1063):
  66      Changed editing_chars_version_2 to editing_chars_version_3.
  67   7) change(88-08-15,Parisek), approve(88-08-15,PBF7928),
  68      audit(88-08-15,Farley), install(88-08-16,MR12.2-1086):
  69      Make call to tty_write$locked for the "read_status" control order if tty
  70      is attached through the DSA UNCP multiplexer.  This will subsequently set
  71      the wtcb.turn flag ON so the tty will not remain in a blocked for output
  72      state.
  73   8) change(88-08-19,Parisek), approve(88-08-19,PBF7928),
  74      audit(88-08-19,Farley), install(88-08-22,MR12.2-1087):
  75      Correct bug in the is_parent_mpx procedure to return "0"b if parent
  76      multiplexer type does not match multiplexer type being checked.
  77   9) change(88-09-21,Brunelle), approve(88-09-21,MCR7813),
  78      audit(88-10-12,Blair), install(88-10-17,MR12.2-1171):
  79      Add code to support SPECIAL_VERSION_2 special tables in addition to
  80      SPECIAL_VERSION.  These are 15 & 3 char tables respectively.  Change
  81      set/get_special control orders to handle the old and new lengths properly.
  82  10) change(88-10-20,Brunelle), approve(88-10-20,PBF7813),
  83      audit(88-10-21,Farley), install(88-10-22,MR12.2-1181):
  84      Correct problem of returning invalid ptr to  structure (it was already
  85      freed).  Also improve copying of old/new versions of special chars tables.
  86                                                    END HISTORY COMMENTS */
  87 
  88 %page;
  89 /* format: style4,delnl,insnl,^ifthendo */
  90 tty_index:
  91      proc (a_name, twx, state, ercode);                     /* go get index from name, and sign onto tty */
  92 
  93 
  94 dcl  a_name char (*);                                       /* tty name such as a.h102 */
  95 dcl  a_wtcbp ptr;
  96 dcl  a_tcbp ptr;
  97 dcl  a_sw bit (1);
  98 dcl  a_order char (*);                                      /* order name */
  99 dcl  a_argptr ptr;                                          /* pointer to order data */
 100 dcl  a_data_base_ptr ptr;                                   /* pointer returned of establishing wtcb */
 101 dcl  a_event fixed bin (71);                                /* event channel name */
 102 
 103 dcl  twx fixed bin;                                         /* tty index (actually also device index ) */
 104 dcl  state fixed bin;                                       /* tty state, 1 ignored, 2 listening, 5 dialed */
 105 dcl  ercode fixed bin (35);                                 /* error code */
 106 dcl  dflag fixed bin;                                       /* disposition flag */
 107 dcl  nproc bit (36);                                        /* new proc process */
 108 dcl  resetsw fixed;                                         /* abort code, 1 reset read, 2 reset write, 3 reset both */
 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;                             /* bit-string version of reset_read/write switch */
 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;                                   /* automatic copy of output_suspend count */
 125 dcl  res_count fixed bin;                                   /* likewise for resume */
 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           /*** REMOVE when Emacs, video and mowse are using version 2. ***/
 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);       /* indicates whether init_channel ever called before */
 147 
 148 dcl  (
 149      input_tr_type init (1),                                /* input translation table type */
 150      output_tr_type init (2),                               /* output translation table type */
 151      input_cv_type init (3),                                /* input conversion table type */
 152      output_cv_type init (4),                               /* output conversion table type */
 153      special_type init (5),                                 /* special chars table type */
 154      delay_type init (6)
 155      ) fixed bin int static options (constant);             /* delay table type */
 156 
 157 dcl  max_special_size fixed bin int static options (constant) init (600);
 158                                                             /* max special words table size in words */
 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 ("^@"); /* NUL character (\000) */
 166 
 167 dcl  white_space char (6) int static options (constant) initial
 168                                                             /* BS, CR, NL, HT, VT, FF */
 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);                       /* for line length order */
 222 
 223 dcl  new_line_type fixed bin based (argptr);                /* for set_line_type order */
 224 
 225 dcl  1 info based (argptr) aligned,                         /* tty information structure */
 226        2 id char (4) unaligned,                             /* id of tty */
 227        2 baud_rate fixed bin (17) unal,                     /* baud rate */
 228        2 line_type fixed bin (17) unal,                     /* line type for line control */
 229        2 pad bit (36) unal,                                 /* fill */
 230        2 tw_type fixed;                                     /* type of tty (t300) */
 231 
 232 dcl  arg_varying_char32 varying char (32) based (argptr);
 233 
 234 dcl  1 rd_stat aligned based (argptr),                      /* structure fo read_status call */
 235        2 ev_chan fixed bin (71),
 236        2 input_available bit (1);
 237 
 238 dcl  1 wr_stat aligned based (argptr),                      /* structure for write_status call */
 239        2 ev_chan fixed bin (71),
 240        2 output_pending bit (1);
 241 
 242 dcl  bit72 bit (72) based;                                  /* for command data */
 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);                /* overlay for tcb.tables */
 269 dcl  df_tablerp (6) bit (18) unal based (dftrpp);           /* overlay for tcb.default_tables */
 270 dcl  new_tablerp (6) bit (18) unal;
 271 dcl  new_tablep (6) ptr based (ntpp);                       /* overlay for terminal_type_data.tables */
 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 /* special chars structures to support old/new versions */
 281 dcl  special_chars_old_ptr ptr;
 282 dcl  1 special_chars_old aligned based (special_chars_old_ptr),
 283                                                             /* table of special character sequences */
 284        2 nl_seq aligned like c_chars_old,                   /* new-line sequence */
 285        2 cr_seq aligned like c_chars_old,                   /* carriage-return sequence */
 286        2 bs_seq aligned like c_chars_old,                   /* backspace sequence */
 287        2 tab_seq aligned like c_chars_old,                  /* horizontal tab sequence */
 288        2 vt_seq aligned like c_chars_old,                   /* vertical tab sequence */
 289        2 ff_seq aligned like c_chars_old,                   /* form-feed sequence */
 290        2 printer_on aligned like c_chars_old,               /* printer-on sequence */
 291        2 printer_off aligned like c_chars_old,              /* printer_off sequence */
 292        2 red_ribbon_shift aligned like c_chars_old,         /* red ribbon shift sequence */
 293        2 black_ribbon_shift aligned like c_chars_old,       /* black ribbon shift sequence */
 294        2 end_of_page aligned like c_chars_old,              /* end-of-page warning sequence */
 295        2 escape_length fixed bin,                           /* number of escape sequences */
 296        2 not_edited_escapes (sc_escape_len refer (special_chars_old.escape_length)) like c_chars_old,
 297                                                             /* use in ^edited mode */
 298        2 edited_escapes (sc_escape_len refer (special_chars_old.escape_length)) like c_chars_old,
 299                                                             /* use in edited mode */
 300        2 input_escapes aligned,
 301          3 len fixed bin (8) unaligned,                     /* length of string */
 302          3 str char (sc_input_escape_len refer (special_chars_old.input_escapes.len)) unaligned,
 303                                                             /* escape sequence characters */
 304        2 input_results aligned,
 305          3 pad bit (9) unaligned,                           /* so that strings will look the same */
 306          3 str char (sc_input_escape_len refer (special_chars_old.input_escapes.len)) unaligned;
 307                                                             /* results of escape sequences */
 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,                                 /* non-zero indicates use default */
 315        2 special_chars,                                     /* same as level-1 above */
 316                                                             /* has to be spelled out instead of using like */
 317                                                             /* because of refer options */
 318          3 nl_seq aligned like c_chars_old,                 /* new-line sequence */
 319          3 cr_seq aligned like c_chars_old,                 /* carriage-return sequence */
 320          3 bs_seq aligned like c_chars_old,                 /* backspace sequence */
 321          3 tab_seq aligned like c_chars_old,                /* horizontal tab sequence */
 322          3 vt_seq aligned like c_chars_old,                 /* vertical tab sequence */
 323          3 ff_seq aligned like c_chars_old,                 /* form-feed sequence */
 324          3 printer_on aligned like c_chars_old,             /* printer-on sequence */
 325          3 printer_off aligned like c_chars_old,            /* printer_off sequence */
 326          3 red_ribbon_shift aligned like c_chars_old,       /* red ribbon shift sequence */
 327          3 black_ribbon_shift aligned like c_chars_old,     /* black ribbon shift sequence */
 328          3 end_of_page aligned like c_chars_old,            /* end-of-page warning sequence */
 329          3 escape_length fixed bin,                         /* number of escape sequences */
 330          3 not_edited_escapes (sc_escape_len refer (special_chars_struc_old.escape_length)) like c_chars_old,
 331                                                             /* use in ^edited mode */
 332          3 edited_escapes (sc_escape_len refer (special_chars_struc_old.escape_length)) like c_chars_old,
 333                                                             /* use in edited mode */
 334          3 input_escapes aligned,
 335            4 len fixed bin (8) unaligned,                   /* length of string */
 336            4 str char (sc_input_escape_len refer (special_chars_struc_old.input_escapes.len)) unaligned,
 337                                                             /* escape sequence characters */
 338          3 input_results aligned,
 339            4 pad bit (9) unaligned,                         /* so that strings will look the same */
 340            4 str char (sc_input_escape_len refer (special_chars_struc_old.input_escapes.len)) unaligned;
 341                                                             /* results of escape sequences */
 342 %page;
 343 
 344           esw = 0;                                          /* this is index entry */
 345           ttybp = addr (tty_buf$);                          /* get ptrs to tty_buf, tty_data */
 346           lctp = tty_buf.lct_ptr;                           /* get system pointer to lct */
 347           name = a_name;
 348           twx, state = 0;                                   /* init to no information passing state */
 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);           /* index + event */
 358           event = a_event;
 359           esw = 1;                                          /* attach entry */
 360           ttybp = addr (tty_buf$);                          /* get ptrs to tty_buf, tty_data */
 361           lctp = tty_buf.lct_ptr;                           /* get system pointer to lct */
 362           name = a_name;
 363           twx, state = 0;                                   /* init to no information passing state */
 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;                  /* in case the order doesn't do anything */
 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);        /* lock the channel */
 376           if ercode ^= 0
 377           then return;
 378           locked = "1"b;
 379 
 380           lctep = addr (lct.lcte_array (devx));             /* get entry of interest */
 381           if lcte.channel_type ^= 0                         /* has to be tty channel */
 382           then go to index_invalid;
 383 
 384           wtcbp = lcte.data_base_ptr;                       /* pointer to perm per channel data */
 385           tcbp = wtcb.tcb_ptr;                              /* get tcb pointer */
 386           if ^wtcb.tcb_initialized
 387           then call init_tcb;
 388 
 389           if wtcb.hproc = "0"b
 390           then do;                                          /* if up for grabs, let him have it */
 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                /* if he is already boss */
 396           then ;                                            /* then he is ok */
 397           else if wtcb.flags.dialed                         /* else if channel is dialed (has user) */
 398           then if wtcb.uproc = pds$processid                /* and this guy is the user */
 399                then if (esw = 1) & tcb.uproc_attached       /* ATTACH & already called ATTACH */
 400                                                             /* only allow one call to tty_attach */
 401                     then do;
 402                          ercode = error_table_$resource_attached;
 403                          call tty_lock$unlock_channel (devx);
 404                          return;
 405                     end;
 406                     else do;                                /* tty_index can be called as many times on a channel name as desired */
 407                          if ^tcb.uproc_attached
 408                          then do;                           /* this is first attach */
 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;            /* this shouldn't happen unless the process responsible
 414                                                                for channel assignments has failed or the user
 415                                                                process has reset comm privilege since the assignment */
 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;                /* no AIM privilege */
 425                                    end;                     /* channel auth differs from process auth */
 426                          end;                               /* first attach */
 427                     end;                                    /* tty_index or first attach */
 428                else go to index_invalid;                    /* else he is not user, and cant do anything */
 429           else do;                                          /* else channel not dialed up, and not boss */
 430 index_invalid:
 431                ercode = error_table_$io_no_permission;      /* give him error code */
 432                call tty_lock$unlock_channel (devx);         /* unlock channel now */
 433                return;                                      /* thats all we let him do */
 434           end;
 435           if wtcb.flags.dialed                              /* compute state */
 436           then state = DIALED_UP;                           /* dialed up */
 437           else if wtcb.flags.masked                         /* masked by FNP */
 438           then state = MASKED_STATE;
 439           else if wtcb.flags.listen
 440           then state = LISTENING;                           /* listening for ring */
 441           else state = IGNORE;                              /* ignoreing */
 442 
 443           ercode = 0;
 444           twx = devx;                                       /* return tty index */
 445 
 446           if wtcb.flags.dialed
 447           then do;                                          /* if dialed */
 448                wtcb.uproc = pds$processid;                  /* he is using process */
 449                tcb.uproc_attached = "1"b;
 450           end;
 451 
 452           wtcb.qflag, wtcb.qenable = "0"b;                  /* but he may not expect quits */
 453           wtcb.dialing, wtcb.dial_status_valid = ""b;       /* not dialing, no dial status */
 454           wtcb.dial_status_code = 0;
 455           if esw = 1
 456           then go to eret;                                  /* must also record event */
 457           call tty_lock$unlock_channel (devx);              /* unlock the channel */
 458 
 459           return;
 460 %page;
 461 tty_event:
 462      entry (twx, a_event, state, ercode);                   /* to change tty events signaled */
 463 
 464           event = a_event;
 465           state = 0;
 466 
 467           on cleanup call cleaner;
 468           call setup (state);                               /* set up normal variables and check access */
 469           if ercode ^= 0
 470           then return;
 471 
 472           if wtcb.flags.dialed
 473           then wtcb.uproc = pds$processid;                  /* this guy gets to use it */
 474 
 475 eret:
 476           wtcb.event = event;                               /* copy as user event channel */
 477           if wtcb.hproc = pds$processid
 478           then                                              /* and if this guy is the boss */
 479                wtcb.hevent = event;                         /* copy as boss event too */
 480 
 481           call tty_lock$unlock_channel (devx);              /* unlock the channel */
 482 
 483           return;
 484 %page;
 485 tty_get_name:
 486      entry (twx, a_name, state, ercode);                    /* to return channel name given devx */
 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;                                       /* move to internal */
 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;               /* to copy error codes into wired internal static */
 510                ever_initialized = "1"b;                     /* so we don't do this again */
 511           end;
 512 
 513           call tty_space_man$get_space (size (wtcb), wtcbp);
 514 
 515           if wtcbp = null
 516           then do;                                          /* no room for it? */
 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;                             /* start in known state */
 528           wtcb.tcb_ptr = tcbp;                              /* set the data base correctly */
 529           wtcb.devx = devx;
 530           unspec (tcb) = "0"b;                              /* start this in known state also */
 531           call init_tcb;                                    /* start filling in the variables */
 532           a_data_base_ptr = wtcbp;                          /* and the output arg */
 533           return;
 534 
 535 tcb_not_done:
 536           ercode = error_table_$notalloc;                   /* we had a problem */
 537           return;
 538 %page;
 539 terminate_channel:
 540      entry (a_data_base_ptr, ercode);
 541 
 542           ercode = 0;
 543           wtcbp = a_data_base_ptr;                          /* get to internal */
 544           tcbp = wtcb.tcb_ptr;
 545 
 546           call init_tcb_tables;
 547           call tty_area_manager$free (size (tcb), tcbp);    /* clean out the tcb */
 548 
 549           call tty_space_man$free_space (size (wtcb), wtcbp);
 550                                                             /* and get rid of wtcb */
 551           if wtcbp ^= null
 552           then do;                                          /* wtcb still around for some reason? */
 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);                   /* to reset read or write buffers */
 561 
 562           state = 0;
 563 
 564           on cleanup call cleaner;
 565           call setup (state);                               /* do setup */
 566           if ercode ^= 0
 567           then return;
 568           if wtcb.flags.dialed                              /* if any buffers to reset */
 569           then do;
 570                rw_switch = bit (fixed (resetsw, 2));        /* first bit is resetwrite, 2nd is -read */
 571                if substr (rw_switch, 1, 1)                  /* asking for resetwrite */
 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                       /* if at end of page, reset */
 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)                  /* if read buffer to be reset */
 586                then do;
 587                     if wtcb.fblock ^= 0                     /* if a chain there */
 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;      /* no more input chain */
 592                     end;                                    /* tell the 355 not to send current input */
 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;                               /* and stop any current writes */
 601           end;
 602 
 603           call tty_lock$unlock_channel (devx);              /* unlock the channel */
 604 
 605           return;
 606 %page;
 607 tty_state:
 608      entry (twx, state, ercode);                            /* go get state of tty */
 609 
 610           state = 0;
 611 
 612           on cleanup call cleaner;
 613           call setup (state);                               /* get normal variables */
 614           call tty_lock$unlock_channel (devx);              /* unlock the channel */
 615 
 616           return;
 617 %page;
 618 tty_detach:
 619      entry (twx, dflag, state, ercode);                     /* to detach tty */
 620 
 621 dcl  pflag bit (1);                                         /* which entry switch */
 622 
 623           pflag = "0"b;                                     /* not new proc call */
 624           go to detcom;
 625 
 626 new_proc:
 627      entry (twx, nproc, state, ercode);                     /* to switch tty to new process */
 628 
 629           pflag = "1"b;
 630 
 631 detcom:
 632           state = 0;
 633           on cleanup call cleaner;
 634           call setup (state);                               /* set up */
 635           if ercode ^= 0
 636           then return;
 637 
 638           if pflag                                          /* if new process call */
 639           then do;
 640                if wtcb.hproc = pds$processid                /* if initializer wants */
 641                then do;
 642                     wtcb.event = 0;                         /* so as not to send wakeup on bogus event channel */
 643                     wtcb.uproc = nproc;
 644                     tcb.uproc_attached = "0"b;
 645                end;
 646                else go to illdet;                           /* everybody to stay in assigned seat */
 647           end;
 648           else if dflag = 0                                 /* check disposition */
 649           then do;
 650                if wtcb.flags.dialed                         /* if a control block */
 651                then do;
 652                     if wtcb.hproc = pds$processid           /* .. and if this is the boss */
 653                     then wtcb.uproc = "0"b;                 /* place tty up for grabs */
 654                     tcb.uproc_attached = "0"b;              /* always mark as detached */
 655                end;
 656           end;
 657           else if wtcb.hproc = pds$processid                /* if boss process */
 658           then do;
 659                wtcb.flags.listen = "0"b;                    /* shut off channel */
 660                call channel_manager$control (devx, "hangup", null, ercode);
 661                wtcb.hproc = "0"b;                           /* advertise tty looking for new boss */
 662                state = IGNORE;
 663           end;
 664           else go to illdet;                                /* some evil disposition and not boss */
 665 
 666           if wtcb.flags.dialed
 667           then wtcb.flags.wflag, wtcb.flags.rflag = "0"b;   /* force wakeups */
 668 
 669           call tty_lock$unlock_channel (devx);              /* unlock the channel */
 670 
 671           return;
 672 %page;
 673 
 674 tty_order:
 675      entry (twx, a_order, a_argptr, state, ercode);         /* to give tty orders */
 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"                           /* let anyone do this */
 685           then uproc_required_for_setup = "0"b;             /* it's initialized to "1"b */
 686           else if order = "get_required_access_class"
 687           then                                              /* let user do this before attach */
 688                uproc_attach_required_for_setup = "0"b;
 689 
 690           call setup (state);                               /* set up */
 691           if ercode ^= 0
 692           then return;
 693 
 694           if wtcb.masked                                    /* can't do most things to a masked channel */
 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"                          /* listen for dialup */
 705           then do;
 706                call forward_order ();
 707                wtcb.flags.listen = "1"b;
 708                if wtcb.flags.dialed                         /* get state */
 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;                                     /* only owner can do this */
 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"                     /* set line length */
 727           then do;
 728                if ^wtcb.flags.dialed                        /* if data base exists */
 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"                            /* get baud rate, id and type */
 747           then do;
 748                argptr -> info.baud_rate = wtcb.baud_rate;   /* fill in baud rate */
 749                argptr -> info.line_type = wtcb.line_type;
 750                if ^wtcb.flags.dialed                        /* if data not there */
 751                then do;
 752                     argptr -> info.id = " ";                /* fake it */
 753                     argptr -> info.tw_type = 0;
 754                end;
 755                else do;
 756                     argptr -> info.id = tcb.id;             /* pull info from data base */
 757                     argptr -> info.tw_type = tcb.old_type;
 758                end;
 759           end;
 760 
 761           else if order = "quit_enable"                     /* turn on quits? */
 762           then wtcb.qenable = "1"b;
 763 
 764           else if order = "quit_disable"                    /* turn off quits? */
 765           then wtcb.qenable = "0"b;
 766 
 767           else if order = "start"                           /* kick user? */
 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                                                             /* wakeup the user */
 778           end;
 779 %page;
 780           else if order = "read_status"
 781           then do;                                          /* look to see if we have any */
 782                if ^wtcb.flags.dialed
 783                then go to error;
 784 
 785                if wtcb.flags.line_status_present
 786                then do;                                     /* must complain about unprocessed status */
 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;                                /* UNCP needs this to turn line around */
 804                          rawom = tcb.rawom;
 805                          tcb.rawom = "1"b;                  /* write prompt in rawo mode */
 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;                                          /* check for pending output */
 815                if ^wtcb.flags.dialed
 816                then go to error;
 817                if wtcb.flags.line_status_present
 818                then do;                                     /* must complain about unprocessed status */
 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                                                             /* multiplexer is ignorant of this */
 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;           /* get wakeup when it is gone */
 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"                     /* turn 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);     /* stop echoing to stop printing */
 864                else call turn_printer_off (ercode);
 865 
 866                if ercode = 0
 867                then if tcb.modes.replay                     /* don't want any replay while printing disabled */
 868                     then call alter_mode ("replay", "0"b);
 869           end;
 870 
 871           else if order = "printer_on"                      /* turn 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                           /* must reactivate this mode */
 882                     then call alter_mode ("replay", "1"b);
 883           end;
 884 
 885           else if order = "set_terminal_data"
 886           then do;
 887                ttdp = argptr;                               /* set ptr to terminal_type_data info structure */
 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;                  /* init new table rel ptrs */
 892                ntpp = addr (terminal_type_data.tables);     /* set ptr to new_tablep array */
 893                code = 0;
 894                do table_type = 1 to 6 while (code = 0);     /* add the new tables */
 895                     call add_table (table_type, new_tablep (table_type), new_tablerp (table_type), code);
 896                end;
 897 
 898                if code ^= 0                                 /* could not add all the new tables */
 899                then do;                                     /* must delete any we did add */
 900                     do table_type = 1 to 6 while (new_tablerp (table_type) ^= (18)"1"b);
 901                          if new_tablerp (table_type) ^= ""b /* a real table was added */
 902                          then call tty_tables_mgr$delete (new_tablerp (table_type), 0);
 903                     end;
 904                     ercode = code;                          /* give user the bad news */
 905                     go to unlock;
 906                end;
 907 
 908                trpp = addr (tcb.tables);                    /* set ptr to tablerp array */
 909                dftrpp = addr (tcb.default_tables);          /* set ptr to df_tablerp array */
 910                do table_type = 1 to 6;                      /* now assign the new tables in the tcb */
 911                     if tablerp (table_type) ^= ""b          /* dispose of any previous tables */
 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                                                             /* set the current table */
 917                     df_tablerp (table_type) = (18)"1"b;     /* default table is same as current table */
 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;                                     /* ship framing chars to FNP */
 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                /* change to keyboard locking */
 941                then if sw & wtcb.line_type ^= LINE_ASCII
 942                     then ;                                  /* invalid change, ignore it */
 943                     else do;                                /* make the change */
 944                          tcb.keyboard_locking = sw;
 945                          if ^(tcb.modes.full_duplex | tcb.modes.echoplex)
 946                                                             /* keyboard locking possible */
 947                          then call channel_manager$control (devx, "lock", addr (sw), ercode);
 948                                                             /* pass it on down */
 949                     end;
 950 
 951                if terminal_type_data.version >= ttd_version_2
 952                                                             /* version 2 includes flow control */
 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 /* used to have one */
 972                     then do;                                /* must turn it off now */
 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;                                /* something to turn off */
 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                       /* force it off */
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"                        /* store answerback id for later use */
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;                                /* must complain about unprocessed status */
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;                                /* must complain about unprocessed status */
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;                                     /* can't set message size > exhaust limit */
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;                            /* you have tell us what */
1119                if wtcb.flags.listen
1120                then go to error;                            /* it's too late to change line types */
1121                if new_line_type <= 0 | new_line_type > max_line_type
1122                                                             /* invalid line_type */
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              /* The 1050, 2741, ETX and ARDS line types are no longer valid. */
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;                           /* wtcb must be owned by caller */
1139                if argptr = null ()
1140                then go to error;                            /* you have to give me a phone number */
1141                if wtcb.flags.dialed
1142                then go to error;                            /* can't dial out, line is already being used */
1143                if wtcb.dialing
1144                then go to error;                            /* can't dial while dialing */
1145 
1146                if wtcb.flags.line_status_present
1147                then do;                                     /* must complain about unprocessed status */
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 /* phone number looks ok */
1162                wtcb.dialing = "1"b;                         /* remember what we are doing */
1163                wtcb.dial_status_valid = ""b;                /* no status yet */
1164                wtcb.dial_status_code = 0;                   /* zero code */
1165                call channel_manager$control (devx, order, addr (phone_data), ercode);
1166                if ercode ^= 0
1167                then wtcb.dialing = "0"b;                    /* multiplexer rejected it, so we're not really dialing */
1168                                                             /* otherwise, status will be returned via interrupt when the dial_out completes */
1169                                                             /* so we're all done */
1170           end;
1171 
1172           else if order = "dial_out_status"
1173           then do;                                          /* caller wants result of dial */
1174                if ^wtcb.dialing
1175                then goto error;                             /* not dialing */
1176                if wtcb.dial_status_valid
1177                then do;                                     /* is there status yet? */
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;           /* can only get status once */
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;                                     /* good call */
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;   /* bad call */
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;                                     /* must complain about unprocessed status */
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"         /* control whether to report line_status */
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;                                     /* if disabling it */
1242                     wtcb.line_status_present = "0"b;        /* if there was one already, discard it */
1243                     wtcb.line_status = ""b;
1244                end;
1245           end;
1246 
1247           else if order = "get_line_status_enabled"         /* user wants to see if line_status is 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;                         /* now it's just hung up */
1269                end;
1270                else ;                                       /* a nop if channel wasn't masked */
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                                                             /* can't have begin without end */
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;                          /* must be one or the other */
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                                                             /* not already set */
1350                               | (res_count = 0 & sus_count ^= 0) | (sus_count = 0 & res_count ^= 0)
1351                                                             /* or not setting chars */
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                                                             /* set block size to half of buffer size */
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                                                             /* suspend_resume, must specify chars, and they must be different */
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                                                             /* setting some sequence or turning it all off */
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                /*** Code to accept version 1 structure for compatibility ***/
1430                /*** To be REMOVED when Emacs, video and mowse are using  ***/
1431                /*** version 2.                                           ***/
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 /**** end compatibility code ****/
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;               /* For good luck */
1452 
1453                     /*** Version 1 structure ***/
1454                     /*** REMOVE when Emacs, video and mowse are using version 2. ***/
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                          /*** END COMPATIBILITY CODE ****/
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;                                    /* of else clause for version 1 */
1478                     /*** REMOVE when Emacs, video and mowse are using version 2. ***/
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;                            /* obviously can't get it */
1488                if argptr -> delay_struc.version ^= DELAY_VERSION
1489                then go to wrong_version;
1490 
1491                if tcb.delayrp = ""b                         /* no delays */
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                       /* no special chars table */
1502                then do;
1503                     ercode = error_table_$no_table;
1504                     go to unlock;
1505                end;
1506 
1507                special_ptr = ptr (ttytp, tcb.specialrp);    /* prepare to allocate and copy table */
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 /* call internal subroutine to transfer new table into old table.  If any of
1531    the sequences are too long, it will return non-zero error code */
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;                /* User's stuff */
1566 
1567                     /*** Accept version 1 structure for compatibility ***/
1568                     /*** REMOVE when Emacs, video and mowse are using version 2. ***/
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                                                             /* Copy the bits */
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                          /*** END OF COMPATIBILITY CODE ***/
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                                                             /* Copy the bits */
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;                                    /* of else clause based on version */
1593                     /*** REMOVE when Emacs, video and mowse are using version 2. ***/
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                         /* no current wakeup table */
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                /* new table is empty */
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;                                     /* new table is not empty */
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;                                     /* only owner can do this */
1681                     ercode = error_table_$io_no_permission;
1682                     go to unlock;
1683                end;
1684                else call forward_order ();                  /* we don't handle this, but multiplexer might */
1685           end;
1686 
1687           else do;                                          /* we didn't understand the order */
1688                call channel_manager$control (devx, order, a_argptr, ercode);
1689                                                             /* see if any muxes understand */
1690                go to unlock;                                /* if not ercode will be returned */
1691           end;
1692 
1693 unlock:
1694           if ercode = error_table_$io_no_permission
1695           then state = 0;                                   /* keep user in the dark */
1696           call tty_lock$unlock_channel (devx);              /* unlock the channel */
1697           return;
1698 
1699 error:
1700           ercode = error_table_$undefined_order_request;    /* order not understood */
1701           go to unlock;
1702 
1703 cant_do:
1704           ercode = error_table_$action_not_performed;       /* here if order couldn't be carried out */
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 /* external entry to initialize a tcb */
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 /* internal procedure to initialize a tcb */
1730 
1731 init_tcb:
1732      proc;
1733 
1734 dcl  save_breakall_enabled bit (1);                         /* used so this switch doesnt change */
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;     /* dont let this be changed */
1744           string (tcb.flags) = ""b;
1745           tcb.breakall_enabled = save_breakall_enabled;     /* restore old value */
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);                         /* set ptr to tablerp array */
1767           dftrpp = addr (tcb.default_tables);               /* set ptr to  df_tablerp array */
1768           do table_type = 1 to 6;                           /* dispose of tables from previous user */
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 /* internal procedure to add and replace tables */
1781 /* replace_table entry is used by the table setting orders */
1782 /* add_table entry is used by the set_terminal_data order */
1783 
1784 replace_table:
1785      proc (table_type, code);
1786 
1787 dcl  table_type fixed bin;                                  /* table type number (Input) */
1788 dcl  code fixed bin (35);                                   /* status code (Output) */
1789 dcl  infop ptr;                                             /* ptr to info structure containing table (Input) */
1790 dcl  add_tablerp bit (18);                                  /* offset of added table */
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);                         /* set ptr to tablerp array */
1802           dftrpp = addr (tcb.default_tables);               /* set ptr to df_tablerp array */
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                                  /* no info structure supplied */
1814           then tablep = null;                               /* assume null table */
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;                                     /* must set current table to default table */
1832                     if df_tablerp (table_type) = (18)"1"b   /* current table is already same as default */
1833                     then ;                                  /* nothing to do */
1834                     else do;
1835                          if tablerp (table_type) ^= ""b     /* current table is allocated */
1836                          then call tty_tables_mgr$delete (tablerp (table_type), 0);
1837                                                             /* delete it */
1838                          tablerp (table_type) = df_tablerp (table_type);
1839                                                             /* change the current table */
1840                          df_tablerp (table_type) = (18)"1"b;/* indicate that default table is the same */
1841                     end;
1842                     return;
1843                end;
1844 
1845                tablep = addr (argptr -> delay_struc.delay); /* get ptr to new table */
1846           end;
1847 
1848           if tablep = null
1849           then new_tablerp = ""b;                           /* new table is null */
1850           else do;                                          /* allocate the new table */
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 /* copy of special_chars structure.  put here so begin block can allocate an
1875    area large enough to hold the new version ofthe data */
1876 dcl  1 scs aligned,
1877        2 nl_seq aligned like c_chars,                       /* new-line sequence */
1878        2 cr_seq aligned like c_chars,                       /* carriage-return sequence */
1879        2 bs_seq aligned like c_chars,                       /* backspace sequence */
1880        2 tab_seq aligned like c_chars,                      /* horizontal tab sequence */
1881        2 vt_seq aligned like c_chars,                       /* vertical tab sequence */
1882        2 ff_seq aligned like c_chars,                       /* form-feed sequence */
1883        2 printer_on aligned like c_chars,                   /* printer-on sequence */
1884        2 printer_off aligned like c_chars,                  /* printer_off sequence */
1885        2 red_ribbon_shift aligned like c_chars,             /* red ribbon shift sequence */
1886        2 black_ribbon_shift aligned like c_chars,           /* black ribbon shift sequence */
1887        2 end_of_page aligned like c_chars,                  /* end-of-page warning sequence */
1888        2 escape_length fixed bin,                           /* number of escape sequences */
1889        2 not_edited_escapes (sc_escape_len) like c_chars,   /* use in ^edited mode */
1890        2 edited_escapes (sc_escape_len) like c_chars,       /* use in edited mode */
1891        2 input_escapes aligned,
1892          3 len fixed bin (8) unaligned,                     /* length of string */
1893          3 str char (sc_input_escape_len) unaligned,        /* escape sequence characters */
1894        2 input_results aligned,
1895          3 pad bit (9) unaligned,                           /* so that strings will look the same */
1896          3 str char (sc_input_escape_len) unaligned;        /* results of escape sequences */
1897 
1898                          table_size = size (scs);
1899                          if table_size > max_special_size   /* watch out for gluttons */
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;                                     /* don't trust user, restore saved refer values */
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;                                          /* change the tcb table offsets */
1941                if df_tablerp (table_type) = (18)"1"b        /* default table is same as current */
1942                then df_tablerp (table_type) = tablerp (table_type);
1943                                                             /* set default table before changing current table */
1944                else if tablerp (table_type) ^= ""b          /* the current table is allocated */
1945                then call tty_tables_mgr$delete (tablerp (table_type), 0);
1946                                                             /* delete it */
1947                tablerp (table_type) = new_tablerp;          /* set the new current table */
1948           end;
1949           return;
1950 
1951 
1952      end replace_table;
1953 %page;
1954 get_table:
1955      proc (tablerp);
1956 
1957 /* internal procedure to copy contents of table currently in use for "get_" orders */
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                                  /* we'll have to tell him about this */
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 /* get_table */;
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;                                                  /* forwards a control order to the multiplexer */
2013 
2014           call channel_manager$control (devx, order, argptr, ercode);
2015           if ercode ^= 0                                    /* give up */
2016           then go to unlock;
2017 
2018      end;
2019 %page;
2020 /* internal proc to validate a delay table */
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 /* entry to send delay table (called by tty_modes) */
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 /* internal proc to send delay tables for the channel to the fnp */
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                              /* no delay table for this channel */
2069           then fnp_delays (*) = 0;                          /* use default delays, i.e., all zero */
2070           else do;                                          /* fill in fnp delays from current delay table */
2071                dp = ptr (ttytp, tcb.delayrp);               /* get ptr to delay table */
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 /* entry to turn printer on or off (called by tty_modes) */
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 /* internal proc to write printer_off sequence to terminal */
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);         /* get pointer to special chars table */
2123           if special_ptr -> special_chars.printer_off.count = 0
2124           then go to no_print_off;                          /* none, complain */
2125           rawom = tcb.modes.rawom;                          /* save setting of rawom */
2126           tcb.modes.rawom = "1"b;                           /* we shd be in rawo to do this */
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;                          /* restore rawom setting */
2131 
2132           return;
2133 
2134      end turn_printer_off;
2135 
2136 
2137 
2138 
2139 /* internal proc to write printer_on sequence to terminal */
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);         /* get pointer to special chars table */
2164           if special_ptr -> special_chars.printer_on.count = 0
2165           then go to no_print_on;                           /* none, complain */
2166           rawom = tcb.modes.rawom;                          /* save setting of rawom */
2167           tcb.modes.rawom = "1"b;                           /* we shd be in rawo to do this */
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;                          /* reset 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;                                       /* pull devx from user */
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;                                   /* return error */
2188           end;
2189 
2190           call tty_lock$lock_channel (devx, ercode);        /* lock the channel */
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                         /* not our cup of tea */
2197           then go to illdet;
2198 
2199           wtcbp = lcte.data_base_ptr;                       /* pointer to perm info */
2200           tcbp = wtcb.tcb_ptr;                              /* pickup pointer to tib */
2201           if ^wtcb.tcb_initialized
2202           then call init_tcb;
2203 
2204           if wtcb.dialed                                    /* compute state */
2205           then state = DIALED_UP;                           /* dialed up */
2206           else if wtcb.masked                               /* masked by FNP */
2207           then state = MASKED_STATE;
2208           else if wtcb.listen
2209           then state = LISTENING;                           /* hungup but listening */
2210           else state = IGNORE;                              /* made busy */
2211 
2212           ercode = 0;                                       /* clear error code */
2213 
2214           if wtcb.hproc = pds$processid                     /* check access */
2215           then return;                                      /* hproc is always welcome */
2216 
2217           if wtcb.hproc = "0"b                              /* if no one */
2218           then return;                                      /* then ok */
2219 
2220 
2221           if (wtcb.uproc = pds$processid & (tcb.uproc_attached | ^uproc_attach_required_for_setup))
2222                | ^uproc_required_for_setup                  /* if using process */
2223           then return;
2224 
2225           go to illdet;                                     /* return to main line at error point */
2226      end;
2227 
2228 illdet:                                                     /* illegal messing with channel */
2229           ercode = error_table_$io_no_permission;           /* else return error */
2230           call tty_lock$unlock_channel (devx);              /* unlock the channel */
2231 
2232 ret:
2233           if ercode ^= 0
2234           then state = 0;                                   /* keep clean */
2235           return;
2236 %page;
2237 get_devx:
2238      proc (chan_name);
2239 
2240 dcl  chan_name char (*);
2241 
2242           lcntp = lct.lcnt_ptr;                             /* get pointer to the name table */
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                                              /* not in name table, maybe it's old name? */
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                        /* wasn't in that form either */
2251           then ercode = error_table_$invalid_device;        /* leave error code */
2252           else ercode = 0;
2253           return;                                           /* return to caller */
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 /* Subroutine to translate wakeup table from ASCII to terminal code */
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);                 /* get ptr to input translation table */
2279           do i = 0 to 127;
2280                if new_waketab.wake_map (i)                  /* this is a wakeup char */
2281                then do j = 0 to 127;                        /* find all terminal codes that translate into it */
2282                     if p -> cv_trans.value (j) = i          /* found one */
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 /* Subroutine to translate wakeup table from terminal code to ASCII */
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)                  /* this is a wakeup char */
2307                then do;
2308                     j = p -> cv_trans.value (i);            /* get ASCII value */
2309                     if j <= 127                             /* don't trust table */
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:                                              /* Check match of channel's parent mpx type against input mpx type */
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 /* Special procedure to copy a Version 2 special chars table (15 char
2339    sequences) to a Version 1 special chars table (3 char sequences).  It is
2340    broken out as a subroutine just to avoid cluttering up where it is called. */
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 /* Special procedure to copy a Version 1 special chars table (3 char sequences
2422    into a Version 2 special chars table (15 char sequences).  It is put here
2423    just to keep from cluttering up where it is called. */
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 /* format: off */
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 /* format: on */
2502 %page;
2503 /* BEGIN MESSAGE DOCUMENTATION
2504 
2505    Message:
2506    tty_index: USER (ACCESS_CLASS) attempted invalid attachment of CHANNEL (ACCESS_CLASS)
2507 
2508    S:     $info
2509 
2510    T:     $run
2511 
2512    M:     A process of USER (with authorization ACCESS_CLASS) attempted to use
2513    a communications channel which does not correspond to the user's
2514    authorization and the user does not have the communications privilege
2515    enabled. The request was refused.  This may indicate a system error.
2516 
2517    A:     $inform_ssa
2518 
2519    END MESSAGE DOCUMENTATION */
2520 
2521 
2522      end;