1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
   6         *                                                         *
   7         *********************************************************** */
   8 
   9 /****^  HISTORY COMMENTS:
  10   1) change(86-05-30,LJAdams), approve(86-11-11,MCR7485),
  11      audit(86-12-19,Margolin), install(87-01-06,MR12.0-1255):
  12      Modified to support MOWSE.
  13   2) change(86-11-26,LJAdams), approve(86-11-26,MCR7584),
  14      audit(86-12-19,Margolin), install(87-01-06,MR12.0-1255):
  15      Initial DSA coding has been maintained in an non-executable form.
  16   3) change(87-01-16,LJAdams), approve(87-01-16,PBF7485),
  17      audit(87-01-16,Gilcrease), install(87-01-19,MR12.0-1287):
  18      Do not perform cleanup_init for control order initialize_mowse_terminal.
  19      This will be handled when error code is fed back to video_utils_.
  20   4) change(87-02-03,LJAdams), approve(87-02-03,MCR7642),
  21      audit(87-05-05,Gilcrease), install(87-05-14,MR12.1-1030):
  22      The initial terminal modes were not being properly propagated.
  23   5) change(87-02-13,LJAdams), approve(87-02-13,MCR7642),
  24      audit(87-05-05,Gilcrease), install(87-05-14,MR12.1-1030):
  25      Do not support a MOWSE terminal type unless the line type is MOWSE.
  26   6) change(87-03-11,LJAdams), approve(87-03-11,MCR7646),
  27      audit(87-05-05,Gilcrease), install(87-05-14,MR12.1-1030):
  28      Use terminal_type_data to get the information for the existance of a
  29      protocol (dependency).  Changed ttd_version to ttd_version_3.
  30   7) change(87-05-20,LJAdams), approve(87-05-20,MCR7699),
  31      audit(87-06-30,RBarstad), install(87-08-04,MR12.1-1055):
  32      Provided support for MOWSE_FANSI protocol.
  33      Changed name of include file terminal_type_protocols.incl.pl1 which
  34      was to long to term_type_protocols.incl.pl1.
  35   8) change(87-06-03,LJAdams), approve(87-06-03,MCR7584),
  36      audit(87-06-30,RBarstad), install(87-08-04,MR12.1-1055):
  37      Added initial break table for DSA.
  38   9) change(87-09-04,LJAdams), approve(87-09-04,PBF7485),
  39      audit(87-09-04,RBarstad), install(87-09-09,MR12.1-1102):
  40      Moved placement of call to ws_tty_$abort to avoid data transmission
  41      before ws_tty_ was ready to receive data.
  42                                                    END HISTORY COMMENTS */
  43 
  44 
  45 /* tc_.pl1 Terminal Control utilities --
  46    init, shutdown, reconnect/reinit, primitive desk management.
  47 
  48    This program is called from the I/O Module interface */
  49 
  50 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */
  51 
  52 /* */
  53 /* Written by Benson Margulies, sometime in 1981 */
  54 /* Modified 21 January 1982 by Chris Jones to add ^tabecho to initial modes */
  55 /* Modified 11 April 1982 by Richard Lamson to add get_foreign_terminal_data
  56    order call for user SUPDUP support. */
  57 /* Modified 14 July 1982 to fix bug in above change in which important tc_data
  58    values were not initialized for non-SUPDUP users of STYs. */
  59 /* Modified 10 September 1982 by William M. York to add the
  60    send_buffered_output control order. */
  61 /* Modified 20 September 1982 by WMY to remove the send_buffered_output
  62    control order, since window_$sync is a better mechanism. */
  63 /* Modified January 1983 by WMY to stop validating the cursor position for
  64    calls that don't modify the screen (e.g. unechoed input). */
  65 /* Modified 1 August 1983 by Jon A. Rochlis to remove special casing
  66    the terminal_info control order, since ring0 appears to handle it
  67    correctly and we don't (i.e. answerback). */
  68 /* Modified 9 September 1983 by JR to map error_table_$no_table into the new
  69    error_table_$unsupported terminal.  It must be an error_table_ code as
  70    opposed a video_et_ code because it will be used at reconnection time. */
  71 /* Modified 1 October 1983 by JR to add support for partial screen width
  72    windows and to really delete the terminal_info code. */
  73 /* Modified 6 January 1983 by JR to add the randomize_redisplay control order
  74    to make Barmar happy. */
  75 /* Modified 18 March 1984 by JR to add support for the set_term_type
  76    order. Init and shut have been modified (mostly init). They have been
  77    split into two parts, the terminal type dependent part (video info, etc.)
  78    and the general tc_data part. */
  79 /* Modified 7 September 1984 by C. Marker to add set_line_speed order. */
  80 /* Modified 31 October 1984 by BIM for fix to uninitialized variable.  */
  81 /* Modified 7 February 1985 by JR to make get_capabilities fill in the
  82    overprint flag. */
  83 /* Modified June 1985 by Roger Negaret to support DSA networks. */
  84 
  85 tc_:
  86      procedure;
  87           return;
  88 
  89 declare  tc_disconnect$check    entry (pointer, fixed binary (35));
  90 declare  tc_request$init        entry (pointer);
  91 declare  tc_request$shut        entry (pointer, fixed bin (35));
  92 
  93 declare  tc_screen$init         entry (pointer, fixed binary, fixed binary);
  94 declare  tc_screen$shut         entry (pointer);
  95 declare  tc_input$init          entry (pointer);
  96 declare  tc_input$shut          entry (pointer);
  97 declare  tc_request             entry (pointer, pointer, fixed bin, fixed binary (35));
  98 
  99 declare  tc_$init_ttp_info      entry (ptr, char (*), fixed bin (35));
 100 declare  tc_$shut_ttp_info      entry (ptr);
 101 
 102 declare  ttt_info_$initial_string
 103                                 entry (character (*), character (*) var, fixed binary (35));
 104 declare  ttt_info_$video_info   entry (character (*), fixed binary, pointer, pointer, fixed binary (35));
 105 declare  ttt_info_$terminal_data
 106                                 entry (character (*), fixed binary, fixed binary, pointer, fixed binary (35));
 107 
 108 declare  hcs_$tty_attach        entry (character (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35));
 109 declare  hcs_$tty_detach        entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
 110 declare  hcs_$tty_abort         entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
 111 declare  hcs_$tty_order         entry (fixed bin, character (*), pointer, fixed bin, fixed bin (35));
 112 declare  dsa_tty_$attach        entry (character (*), fixed bin (71), fixed bin (35), fixed bin, fixed bin (35));
 113 declare  dsa_tty_$detach        entry (fixed bin (35), fixed bin, fixed bin, fixed bin (35));
 114 declare  dsa_tty_$abort         entry (fixed bin (35), fixed bin, fixed bin, fixed bin (35));
 115 declare  dsa_tty_$order         entry (fixed bin (35), character (*), pointer, fixed bin, fixed bin (35));
 116 declare  ws_tty_$attach         entry (ptr, char (*), fixed bin (71), fixed bin, fixed bin (35));
 117 declare  ws_tty_$detach         entry (ptr, fixed bin, fixed bin, fixed bin (35));
 118 declare  ws_tty_$abort          entry (ptr, fixed bin, fixed bin, fixed bin (35));
 119 declare  ws_tty_$order          entry (ptr, char (*), ptr, fixed bin, fixed bin (35));
 120 declare  continue_to_signal_    entry (fixed binary (35));
 121 
 122 
 123 declare  (
 124          hcs_$set_ips_mask,
 125          hcs_$reset_ips_mask
 126          )                      entry (bit (36) aligned, bit (36) aligned);
 127 declare  (
 128          ipc_$mask_ev_calls,
 129          ipc_$unmask_ev_calls
 130          )                      entry (fixed bin (35));
 131 
 132 declare  get_system_free_area_  entry () returns (ptr);
 133 
 134 declare  dsa_error_table_$try_again
 135                                 external static fixed bin (35);
 136 
 137 declare  (
 138          error_table_$unimplemented_version,
 139          error_table_$smallarg,
 140          error_table_$no_table,
 141          error_table_$null_info_ptr,
 142          error_table_$unsupported_terminal,
 143          error_table_$incompatible_term_type,
 144          video_et_$window_too_big,
 145          video_et_$bad_window_id,
 146          video_et_$capability_lacking,
 147          video_et_$no_video_info,
 148          video_et_$terminal_cannot_position,
 149          video_et_$out_of_window_bounds
 150          )                      external static fixed bin (35);
 151 
 152 declare  tty_state              fixed bin;
 153 declare  X_code                 fixed bin (35);
 154 
 155 declare  iox_$control           entry (ptr, char (*), ptr, fixed bin (35));
 156 
 157 declare  (
 158          TC_data_ptr            pointer,
 159          Code                   fixed bin (35),
 160          Request_ptr            pointer,
 161          Terminal_type          character (*),
 162          Channel                character (*),
 163          Event                  fixed bin (71),
 164          Window_id              bit (36) aligned,
 165          Reconnection_flag      bit (1),
 166          MOWSE_ptr              ptr
 167          )                      parameter;
 168 
 169 declare  1 windows              (100) based (tc_data.desk_ptr),
 170            2 flags              aligned,
 171              3 in_use           bit (1) unaligned,
 172              3 status_pending   bit (1) unaligned,
 173              3 pad              bit (34) unaligned,
 174            2 location           aligned,
 175              3 top_row          fixed bin,
 176              3 n_rows           fixed bin,
 177              3 first_column     fixed bin,
 178              3 n_columns        fixed bin,
 179            2 window_id          bit (36) aligned,           /* for now, bit (index in this table) */
 180            2 window_iocb_ptr    ptr,                        /* so we can do set_window_status orders */
 181            2 pending_status     bit (36) aligned;           /* may be longer someday */
 182 
 183 /* first bit is PIATTY (ITS hangup signal) */
 184 
 185 declare  1 ttd                  aligned like terminal_type_data automatic;
 186 
 187 declare  1 mowse_info           static,
 188            2 tc_data_ptr        ptr,
 189            2 ttd                aligned like terminal_type_data;
 190 
 191 declare  wx                     fixed bin;
 192 declare  ips_mask               bit (36) aligned;
 193 
 194 declare  cleanup                condition;
 195 declare  terminal_control_disconnection_
 196                                 condition;
 197 
 198 declare  (addr, after, bin, bit, clock, hbound, index, lbound, length, max, null, reverse, rtrim, substr, unspec)
 199                                 builtin;
 200 
 201 /* CONSTANTS */
 202 
 203 declare  UNMASK_ALL             bit (36) aligned initial (""b) internal static options (constant);
 204 dcl      INITIAL_BREAKTEST      bit (128) unaligned internal static options (constant) init (""b);
 205                                                             /* noone in their right mind would use that for a breaktable, so it will compare unequal, and get set in hardcore */
 206 
 207 dcl      INITIAL_MODES          char (128) internal static options (constant)
 208                                 init (
 209                                 "force,rawo,rawi,fulldpx,^echoplex,^prefixnl,breakall,^hndlquit,^crecho,^lfecho,^replay,^polite,^tabecho"
 210                                 );
 211 dcl      MOWSE_DEVICE           char (9) internal static options (constant) init ("mowse_i/o");
 212 
 213 dcl      MOWSE_INITIAL_MODES    char (128) internal static options (constant) init ("force,ll79,pl23");
 214 
 215 dcl      iox_$modes             entry (ptr, char (*), char (*), fixed bin (35));
 216 ^L
 217 init:
 218      entry (TC_data_ptr, Channel, Event, Terminal_type, Reconnection_flag, MOWSE_ptr, Code);
 219 
 220           if ^Reconnection_flag then do;
 221                allocate tc_data set (tc_data_ptr);
 222                tc_data.screen_data_ptr = null ();           /* for cleanup handler */
 223                tc_data.input_buffer_ptr = null ();
 224                tc_data.desk_ptr = null ();
 225           end;
 226           else tc_data_ptr = TC_data_ptr;
 227 
 228           if substr (Channel, 1, 4) = "dsa." then do;       /* DSA */
 229                tc_data.network_type = DSA_NETWORK_TYPE;
 230                call dsa_tty_$attach (Channel, Event, tc_data.tty_handle, tty_state, Code);
 231           end;
 232           else if index (Channel, MOWSE_DEVICE) = 1 then do;/* MOWSE */
 233                tc_data.network_type = MOWSE_NETWORK_TYPE;
 234                tc_data.mowse_terminal_iocb_ptr = MOWSE_ptr;
 235           end;
 236           else do;                                          /* MCS */
 237                tc_data.network_type = MCS_NETWORK_TYPE;
 238                call hcs_$tty_attach (Channel, Event, tc_data.devx, tty_state, Code);
 239           end;
 240 
 241           if Code ^= 0 then do;
 242                free tc_data;
 243                return;
 244           end;
 245 
 246           on cleanup call cleanup_init;
 247 
 248           tc_data.event = Event;
 249 
 250           tc_data.state.pending.have_sent_protocol = ""b;
 251           tc_data.state.pending.async_same_window = ""b;
 252           tc_data.state.pending.protocol_evs (*) = 0;
 253           tc_data.state.pending.blocked_windows (*) = ""b;
 254 
 255           call init_ttp_info_1 (Code);
 256           if Code ^= 0 then do;
 257                free tc_data;
 258                return;
 259           end;
 260 
 261           tc_data.breaktest = INITIAL_BREAKTEST;
 262 
 263           call init_ttp_info_2 (Code);
 264           if Code ^= 0 then do;
 265                call cleanup_init;
 266                return;
 267           end;
 268 
 269           if tc_data.network_type ^= MOWSE_NETWORK_TYPE then do;
 270                call init_ttp_info_3 (Code);
 271                if Code ^= 0 then do;
 272                     call cleanup_init;
 273                     return;
 274                end;
 275           end;
 276           else do;                                          /* mowse terminal type data is set after video    */
 277                                                             /* has been attached                              */
 278                mowse_info.ttd = ttd;
 279                mowse_info.tc_data_ptr = tc_data_ptr;
 280           end;
 281 
 282 
 283           if ^Reconnection_flag then do;
 284                allocate windows;                            /* set the desk ptr */
 285                unspec (windows) = ""b;
 286                windows (*).in_use = "0"b;
 287           end;
 288 
 289           if Code ^= 0 then
 290                return;
 291 
 292           TC_data_ptr = tc_data_ptr;
 293 
 294           return;
 295 
 296 /* Initialize only the terminal dependant info in tc_data */
 297 
 298 init_ttp_info:
 299      entry (TC_data_ptr, Terminal_type, Code);
 300 
 301           call init_ttp_info_1 (Code);
 302           if Code ^= 0 then
 303                return;
 304           call init_ttp_info_2 (Code);
 305           if tc_data.network_type ^= MOWSE_NETWORK_TYPE then
 306                call init_ttp_info_3 (Code);                 /* we should not get here if were MOWSE           */
 307           return;
 308 
 309 /* Split into two operations, so init can tell the difference, if we fail. */
 310 
 311 init_ttp_info_1:
 312      proc (Code);
 313 
 314 dcl      Code                   fixed bin (35);
 315 
 316           call get_video_data (Code);
 317           if Code ^= 0 then
 318                return;
 319 
 320           call verify_capabilities (tc_data.ttt_video_ptr, Code);
 321           if Code ^= 0 then
 322                return;
 323 
 324           return;
 325 
 326      end init_ttp_info_1;
 327 
 328 init_ttp_info_2:
 329      proc (Code);
 330 
 331 dcl      Code                   fixed bin (35);
 332 
 333 /* Now initialize the folks down below. If that all works,
 334    which it can only not by signalling, then we massage the
 335    terminal */
 336 
 337           call tc_request$init (tc_data_ptr);
 338           call tc_input$init (tc_data_ptr);
 339           call tc_screen$init (tc_data.screen_data_ptr, tc_data.rows, tc_data.columns);
 340           return;
 341 
 342      end init_ttp_info_2;
 343 
 344 init_ttp_info_3:
 345      proc (Code);
 346 
 347 dcl      Code                   fixed bin (35);
 348 
 349           call setup_terminal (Code);
 350 
 351 /* Now place terminal in known state */
 352 
 353           call clear_screen_proc;
 354           return;
 355 
 356      end init_ttp_info_3;
 357 ^L
 358 request:
 359      entry (TC_data_ptr, Request_ptr, Code);
 360 
 361           tc_data_ptr = TC_data_ptr;
 362           Code = 0;
 363           call request_proc (Request_ptr, Code);
 364           return;
 365 
 366 request_proc:
 367      procedure (R_ptr, Code);
 368 declare  R_ptr                  pointer;
 369 declare  Code                   fixed bin (35);
 370           request_ptr = R_ptr;
 371 
 372           if request_header.window_id ^= (36)"1"b then do;
 373                wx = find_window (request_header.window_id, Code);
 374                                                             /* it best be there */
 375                if Code ^= 0 then
 376                     return;
 377 
 378                call check_bounds (Code);
 379                if Code ^= 0 then
 380                     return;
 381 
 382                call tc_request (tc_data_ptr, request_ptr,
 383                     windows (wx).first_column + windows (wx).n_columns - 1 /* last column in the window */, Code);
 384           end;
 385 
 386           else call tc_request (tc_data_ptr, request_ptr, tc_data.columns, Code);
 387                                                             /* better not be I/D chars */
 388 
 389      end request_proc;
 390 ^L
 391 
 392 check_in_window:
 393      entry (TC_data_ptr, Row, N_rows, Col, N_cols, Window_id, Window_iocb_ptr, Code);
 394 declare  (Row, N_rows)          fixed bin;
 395 declare  (Col, N_cols)          fixed bin;
 396 declare  Window_iocb_ptr        ptr;
 397 
 398           tc_data_ptr = TC_data_ptr;
 399           Code = 0;
 400 
 401           call check_in_window_proc (Row, N_rows, Col, N_cols, Window_id, Window_iocb_ptr);
 402           return;
 403 
 404 check_in_window_proc:
 405      procedure (Row, N_rows, Col, N_cols, Window_id, Window_iocb_ptr);
 406 
 407 declare  (Row, N_rows)          fixed bin;
 408 declare  (Col, N_cols)          fixed bin;
 409 declare  Window_id              bit (36) aligned;
 410 declare  Window_iocb_ptr        ptr;
 411 
 412           if Row < 1                                        /* no hyperspace */
 413                | N_rows < 1                                 /* or degenerates */
 414                | Row + N_rows - 1 > tc_data.rows            /* too big */
 415                | Col < 1                                    /* check the other dimension also */
 416                | N_cols < 1 | Col + N_cols - 1 > tc_data.columns then do;
 417                Code = video_et_$window_too_big;
 418                return;
 419           end;
 420 
 421           wx = find_free_slot ();                           /* uninterruptable, no windows (uggh) */
 422           Window_id = windows (wx).window_id;
 423           windows (wx).top_row = Row;
 424           windows (wx).n_rows = N_rows;
 425           windows (wx).first_column = Col;
 426           windows (wx).n_columns = N_cols;
 427           windows (wx).window_iocb_ptr = Window_iocb_ptr;
 428           return;
 429      end check_in_window_proc;
 430 
 431 check_out_window:
 432      entry (TC_data_ptr, Window_id, Code);
 433           Code = 0;
 434 
 435           tc_data_ptr = TC_data_ptr;
 436           call check_out_window_proc (Window_id);
 437           return;
 438 
 439 check_out_window_proc:
 440      procedure (Window_id);
 441 declare  Window_id              bit (36) aligned;
 442 
 443           wx = find_window (Window_id, Code);
 444           if Code ^= 0 then
 445                return;
 446           windows (wx).in_use = "0"b;
 447           return;
 448      end check_out_window_proc;
 449 
 450 resize_window:
 451      entry (TC_data_ptr, Window_id, Row, N_rows, Col, N_cols, Code);
 452 
 453           tc_data_ptr = TC_data_ptr;
 454           Code = 0;
 455 
 456           call resize_window_proc (Window_id, Row, N_rows, Col, N_cols);
 457           return;
 458 
 459 resize_window_proc:
 460      procedure (Window_id, Row, N_rows, Col, N_cols);
 461 declare  Window_id              bit (36) aligned;
 462 declare  Row                    fixed bin;
 463 declare  N_rows                 fixed bin;
 464 declare  Col                    fixed bin;
 465 declare  N_cols                 fixed bin;
 466 
 467           if Row < 1                                        /* no hyperspace */
 468                | N_rows < 1                                 /* or degenerates */
 469                | Row + N_rows - 1 > tc_data.rows            /* too big */
 470                | Col < 1                                    /* check the other dimension also */
 471                | N_cols < 1 | Col + N_cols - 1 > tc_data.columns then do;
 472                Code = video_et_$window_too_big;
 473                return;
 474           end;
 475 
 476           wx = find_window (Window_id, Code);
 477           if Code ^= 0 then
 478                return;
 479 
 480           windows (wx).top_row = Row;
 481           windows (wx).n_rows = N_rows;
 482           windows (wx).first_column = Col;
 483           windows (wx).n_columns = N_cols;
 484 
 485           return;
 486      end resize_window_proc;
 487 
 488 get_capabilities:
 489      entry (TC_data_ptr, C_ptr, Code);
 490 declare  C_ptr                  pointer;
 491 
 492           tc_data_ptr = TC_data_ptr;
 493           Code = 0;
 494           call get_capabilities_proc (C_ptr);
 495           return;
 496 
 497 get_capabilities_proc:
 498      procedure (C_ptr);
 499 declare  C_ptr                  pointer;
 500 
 501           capabilities_info_ptr = C_ptr;
 502           if capabilities_info.version ^= capabilities_info_version then do;
 503                Code = error_table_$unimplemented_version;
 504                return;
 505           end;
 506 
 507 /* These are physical capabilities -- window_io_ is expected
 508    to know which we will simulate. */
 509 
 510           capabilities_info.screensize.columns = tc_data.terminal.columns;
 511           capabilities_info.screensize.rows = tc_data.terminal.rows;
 512           ttyvtblp = tc_data.ttt_video_ptr;
 513 
 514           capabilities_info.scroll_region =
 515                tty_video_table.sequences (INSERT_LINES).present & tty_video_table.sequences (DELETE_LINES).present;
 516           capabilities_info.insert_chars = tty_video_table.sequences (INSERT_CHARS).present;
 517           capabilities_info.insert_mode = tty_video_table.sequences (END_INSERT_CHARS).present;
 518           capabilities_info.delete_chars = tty_video_table.sequences (DELETE_CHARS).present;
 519           capabilities_info.overprint = tty_video_table.overstrike_available;
 520           capabilities_info.line_speed = tc_data.terminal.line_speed;
 521           return;
 522      end get_capabilities_proc;
 523 ^L
 524 /* Caller of this better be damned sure order is innocuous */
 525 
 526 random_order:
 527      entry (TC_data_ptr, Order, Info_ptr, Code);
 528 declare  Order                  character (*);
 529 declare  Info_ptr               pointer;
 530 
 531           tc_data_ptr = TC_data_ptr;
 532           call call_order (Order, Info_ptr, Code);
 533           return;
 534 ^L
 535 
 536 get_terminal_info:
 537      procedure (ttp, baud_rate, code);
 538 
 539 declare  ttp                   char (*);       /* in  */
 540 declare  baud_rate             fixed bin;       /* out */
 541 declare  code                  fixed bin (35);  /* out */
 542 
 543 declare  1 ti                  aligned like terminal_info automatic;
 544 
 545           baud_rate = 0;
 546           code = 0;
 547 
 548 /* First, pick up the terminal type from ring 0, if our caller
 549    did not give us one */
 550 
 551           ti.version = 1;
 552           call call_order ("terminal_info", addr (ti), (0));
 553 
 554           if ttp ^= "" then
 555              ti.term_type = ttp;
 556           tc_data.ttp = ti.term_type;
 557           ttd.version = ttd_version_3;
 558           call ttt_info_$terminal_data (ti.term_type, (0), ti.baud_rate, addr (ttd), code);
 559           if code ^= 0 then
 560              return;
 561 
 562           baud_rate = ti.baud_rate;
 563 
 564 end get_terminal_info;
 565 
 566 ^L
 567 
 568 get_video_data:
 569      procedure (code);
 570 
 571 /* This should not do anything to the terminal */
 572 
 573 declare  baud_rate              fixed bin;                 /* in */
 574 declare  code                   fixed bin (35);            /* in */
 575 
 576           if Terminal_type ^= "" then                       /* use caller supplied type */
 577              call get_terminal_info (Terminal_type, baud_rate, code);
 578           else call get_terminal_info ("", baud_rate, code);
 579           if code ^= 0 then
 580              return;
 581 
 582           call check_protocol (ttd.protocol, code);
 583           if code ^= 0 then do;
 584              call cleanup_init;
 585              return;
 586              end;
 587 
 588           call get_video_info_ptr (ttp, baud_rate, tc_data.ttt_video_ptr, code);
 589           if code ^= 0 then
 590                return;
 591 
 592           if tc_data.ttt_video_ptr = null () then
 593                code = video_et_$no_video_info;
 594           ttyvtblp = tc_data.ttt_video_ptr;
 595 
 596 /* fill in important values in tc_data */
 597           tc_data.rows = tty_video_table.screen_height;
 598           tc_data.columns = tty_video_table.screen_line_length;
 599           tc_data.line_speed = baud_rate;
 600 
 601 /* user may be coming in via SUPDUP, so issue a
 602    get_foreign_terminal_data order to get screen dimensions, etc.
 603    This order call will also succeed on STY connections, but
 604    the modes returned will not be what the following code looks for,
 605    so no tc_data values will get changed. */
 606 
 607           my_ftd.version = FOREIGN_TERMINAL_DATA_VERSION_1;
 608           my_ftd.area_ptr = get_system_free_area_ ();
 609           call call_order ("get_foreign_terminal_data", addr (my_ftd), X_code);
 610           if X_code = 0 then do;
 611                mode_string_info_ptr = my_ftd.mode_string_info_ptr;
 612                do i = 1 to mode_string_info.number;
 613                     mode_value_ptr = addr (mode_string_info.modes (i));
 614                     if /* case */ mode_value.mode_name = "line_length" then
 615                          tc_data.columns = mode_value.numeric_value;
 616                     else if mode_value.mode_name = "page_length" then
 617                          tc_data.rows = mode_value.numeric_value;
 618                     else if mode_value.mode_name = "ospeed" then
 619                          tc_data.line_speed = mode_value.numeric_value;
 620                     else if mode_value.mode_name = "insert_delete_lines" | mode_value.mode_name = "idel_lines" then
 621                          if ^mode_value.boolean_value then do;
 622                               call delete_sequence (INSERT_LINES);
 623                               call delete_sequence (DELETE_LINES);
 624                          end;
 625                          else ;
 626                     else if mode_value.mode_name = "insert_delete_chars" | mode_value.mode_name = "idel_chars" then
 627                          if ^mode_value.boolean_value then do;
 628                               call delete_sequence (INSERT_CHARS);
 629                               call delete_sequence (DELETE_CHARS);
 630                          end;
 631                          else ;
 632                end;
 633           end;
 634 
 635           return;
 636 
 637 delete_sequence:
 638           procedure (sequence_number);
 639 
 640                if sequence_number <= tty_video_table.nseq then
 641                     tty_video_table.sequences (sequence_number).present = "0"b;
 642                return;
 643 
 644 declare  sequence_number        fixed binary;
 645 
 646           end delete_sequence;
 647 
 648 %include foreign_terminal_data;
 649 %include mode_string_info;
 650 declare  1 my_ftd               auto like foreign_terminal_data;
 651 declare  i                      fixed binary;
 652 
 653      end get_video_data;
 654 
 655 get_video_info_ptr:
 656      procedure (ttp, baud_rate, video_info_ptr, code);
 657 
 658 dcl      ttp                    char (*);
 659 dcl      baud_rate              fixed bin;
 660 dcl      video_info_ptr         ptr;
 661 dcl      code                   fixed bin (35);
 662 
 663           call ttt_info_$video_info (ttp, baud_rate, null (), video_info_ptr, code);
 664 
 665           if code = error_table_$no_table then
 666                code = error_table_$unsupported_terminal;
 667 
 668           return;
 669 
 670      end get_video_info_ptr;
 671 
 672 verify_capabilities:
 673      procedure (video_table_ptr, code);
 674 
 675 dcl      video_table_ptr        ptr;
 676 
 677 /* Make sure she flies */
 678 /* Must have one of abs poistioning, up/down/right/left, or home/right/down */
 679 
 680 declare  code                   fixed bin (35);
 681 
 682           code = 0;
 683 
 684           ttyvtblp = video_table_ptr;
 685           if ^((tty_video_table.sequences (ABS_POS).present
 686                | (tty_video_table.sequences (CURSOR_UP).present & tty_video_table.sequences (CURSOR_DOWN).present
 687                & tty_video_table.sequences (CURSOR_RIGHT).present & tty_video_table.sequences (CURSOR_LEFT).present)
 688                | (tty_video_table.sequences (HOME).present & tty_video_table.sequences (CURSOR_DOWN).present
 689                & tty_video_table.sequences (CURSOR_RIGHT).present))) then
 690                code = video_et_$terminal_cannot_position;
 691 
 692      end verify_capabilities;
 693 
 694 setup_terminal:
 695      procedure (code);
 696 declare  code                   fixed bin (35);
 697 
 698 /* Type */
 699           if tc_data.network_type = DSA_NETWORK_TYPE then do;
 700 
 701                                                             /* For DSA, we always initialize a break table */
 702 dcl  1 dsa_break_table like echo_neg_data aligned;          /* Here, because used only once */
 703 
 704                dsa_break_table.version = echo_neg_data_version_2;
 705                dsa_break_table.break(*) = "1"b;             /* All chars sets. Why not */
 706                                                             /* The remainder is ignored by dsa_tty_index_ */
 707 
 708                call call_order ("set_echo_break_table", addr (dsa_break_table), code);
 709                if code ^= 0 then
 710                     return;
 711                end;
 712 
 713           if tc_data.network_type = MOWSE_NETWORK_TYPE then do;
 714                call ws_tty_$abort (tc_data.mowse_terminal_iocb_ptr, (1) /* resetread */, tty_state, (0));
 715                call call_order ("set_terminal_data", addr (mowse_info.ttd), code);
 716                end;
 717           else call call_order ("set_terminal_data", addr (ttd), code);
 718           if code ^= 0 then
 719                return;
 720 
 721 /* Modes */
 722 
 723           if tc_data.network_type = MOWSE_NETWORK_TYPE then
 724                call iox_$modes (tc_data.mowse_terminal_iocb_ptr, MOWSE_INITIAL_MODES, tc_data.old_mode_string, code);
 725           else call set_modes (INITIAL_MODES, tc_data.old_mode_string, code);
 726           if code = error_table_$smallarg then
 727                code = 0;
 728           if code ^= 0 then
 729                return;
 730 
 731           call send_initial_string (code);                  /* depends on our presence in rawo */
 732           if code ^= 0 then
 733                return;
 734 
 735           if tc_data.network_type = DSA_NETWORK_TYPE then   /* DSA */
 736                call dsa_tty_$abort (tc_data.tty_handle, (1) /* resetread */, tty_state, (0));
 737           else                                              /* MCS */
 738                call hcs_$tty_abort (tc_data.devx, (1) /* resetread */, tty_state, (0));
 739 
 740           call call_order ("printer_off", null (), (0));
 741      end setup_terminal;
 742 ^L
 743 
 744 send_initial_string:
 745      procedure (code);
 746 declare  code                   fixed bin (35);
 747 declare  initial_string         character (512) varying;
 748 declare  1 tct                  aligned like request_text;
 749 
 750           code = 0;
 751           call ttt_info_$initial_string (tc_data.ttp, initial_string, code);
 752           if code ^= 0 then
 753                return;
 754 
 755           if length (initial_string) = 0 then
 756                return;
 757 
 758           tct.operation = OP_WRITE_RAW;
 759           tct.row = 1;
 760           tct.col = 1;
 761 
 762           begin;
 763 declare  i_s_non_varying        char (length (initial_string));
 764                i_s_non_varying = initial_string;
 765                tct.text_ptr = addr (i_s_non_varying);
 766                tct.text_length = length (initial_string);
 767                call tc_request (tc_data_ptr, addr (tct), tc_data.columns /* why not? */, (0));
 768           end;
 769 
 770      end send_initial_string;
 771 ^L
 772 
 773 
 774 call_order:
 775      procedure (order, info, code);
 776 
 777 declare  order                  character (*);
 778 declare  info                   pointer;
 779 declare  code                   fixed bin (35);
 780 declare  tty_state              fixed bin;
 781 declare  tc_block               entry (pointer, pointer, bit (36) aligned);
 782 
 783           code = 0;
 784 
 785           if tc_data.network_type = DSA_NETWORK_TYPE then do;
 786                                                             /* DSA */
 787 try_again:
 788                call dsa_tty_$order (tc_data.tty_handle, order, info, tty_state, code);
 789                if code = dsa_error_table_$try_again then do;
 790                     call tc_block (tc_data_ptr, request_ptr, UNMASK_ALL);
 791                     code = 0;
 792                     goto try_again;
 793                end;
 794           end;
 795           else if tc_data.network_type = MOWSE_NETWORK_TYPE then
 796                                                             /* MOWSE */
 797                call ws_tty_$order (tc_data.mowse_terminal_iocb_ptr, order, info, tty_state, code);
 798           else                                              /* MCS */
 799                call hcs_$tty_order (tc_data.devx, order, info, tty_state, code);
 800 
 801           call tc_disconnect$check (tc_data_ptr, code);
 802      end call_order;
 803 
 804 
 805 check_protocol:
 806       procedure (op, code);
 807 
 808 dcl       op             fixed bin;
 809 dcl       code           fixed bin(35);
 810 
 811       if (op > hbound(protocol_names,1)) | (op < lbound(protocol_names,1)) then
 812          op = -1;
 813       goto PROTOCOL (op);
 814 
 815 PROTOCOL (-1):                                              /* ERROR */
 816       code = error_table_$incompatible_term_type;
 817       return;
 818 
 819 PROTOCOL (0):                                               /* NO_PROTOCOL */
 820       if tc_data.network_type = MOWSE_NETWORK_TYPE then
 821          goto PROTOCOL (-1);
 822       return;
 823 
 824 PROTOCOL (1):                                               /* MOWSE */
 825       if tc_data.network_type ^= MOWSE_NETWORK_TYPE then
 826          goto PROTOCOL (-1);
 827       return;
 828 
 829 PROTOCOL (2):                                              /* MOWSE_FANSI */
 830        return;                                             /* valid with all network types */
 831 
 832 end check_protocol;
 833 
 834 set_modes:
 835      procedure (new_modes, old_modes, code);
 836 
 837 dcl      (new_modes, old_modes) char (*);
 838 dcl      code                   fixed bin (35);
 839 
 840 mode_block:
 841           begin;                                            /* size is unknown till here */
 842 
 843 declare  modes_ptr              pointer;
 844 declare  1 t_modes_info         aligned,
 845            2 mode_length        fixed bin (21),
 846            2 modes              char (max (length (new_modes), length (old_modes)));
 847 
 848                modes_ptr = addr (t_modes_info);
 849                t_modes_info.mode_length = length (t_modes_info.modes);
 850                t_modes_info.modes = new_modes;
 851 
 852                call call_order ("modes", modes_ptr, code);
 853 
 854                if code ^= 0 & code ^= error_table_$smallarg then do;
 855                     old_modes = t_modes_info.modes;         /* the mode(s) in error are in here */
 856                     return;
 857                end;
 858 
 859                if length (old_modes) = 0 then
 860                     return;
 861 
 862                if t_modes_info.mode_length = 0 then do;
 863                     old_modes = "";
 864                     return;
 865                end;
 866                if code = 0 then do;
 867                     old_modes = t_modes_info.modes;
 868                     return;
 869                end;
 870 
 871 /* from this point on we have a smallarg */
 872 
 873                code = 0;                                    /* but we do not admit it. */
 874                if substr (reverse (rtrim (old_modes)), 1, 1) = "."
 875                                                             /* the hardcore returned an even mode, which it should */
 876                     then
 877                     return;
 878 
 879 /* from this point the hardcore returned a fragment of a mode */
 880 
 881                old_modes = reverse (after (reverse (t_modes_info.modes), ","));
 882                if length (rtrim (old_modes)) = length (old_modes) then
 883                     old_modes = reverse (after (reverse (old_modes), ","));
 884                                                             /* leave room for a "." */
 885                substr (old_modes, length (rtrim (old_modes)) + 1, 1) = ".";
 886 
 887           end mode_block;
 888      end set_modes;
 889 
 890 shut:
 891      entry (TC_data_ptr);
 892 
 893           tc_data_ptr = TC_data_ptr;
 894           if tc_data_ptr = null () then
 895                return;
 896 
 897 /* turn off hairy features that we do not want to go off */
 898 
 899           ips_mask = ""b;
 900           on cleanup
 901                begin;
 902                if ips_mask ^= ""b then do;
 903                     call hcs_$reset_ips_mask (ips_mask, ""b);
 904                     call ipc_$unmask_ev_calls (0);
 905                end;
 906           end;
 907 
 908           call hcs_$set_ips_mask (""b, ips_mask);
 909           call ipc_$mask_ev_calls (0);
 910           tc_data.state.pending.count = 0;
 911 
 912           on terminal_control_disconnection_ go to give_up_shut;
 913           call clear_screen_proc;
 914           call send_initial_string (0);
 915           call set_modes (tc_data.old_mode_string, "", (0));
 916 
 917 give_up_shut:
 918           call cleanup_init;
 919           if tc_data.ttt_video_ptr ^= null then
 920                free tc_data.ttt_video_ptr -> tty_video_table;
 921 
 922           free tc_data;
 923           TC_data_ptr = null ();
 924           call ipc_$unmask_ev_calls (0);
 925           call hcs_$reset_ips_mask (ips_mask, ""b);
 926 
 927           return;
 928 
 929 /* This entry is called when changing the terminal type.  It cleans up
 930    terminal type dependent info from tc_data but leaves all else alone. */
 931 
 932 shut_ttp_info:
 933      entry (TC_data_ptr);
 934 
 935           tc_data_ptr = TC_data_ptr;
 936           if tc_data.ttt_video_ptr ^= null () then
 937                free tc_data.ttt_video_ptr -> tty_video_table;
 938 
 939           if tc_data.screen_data_ptr ^= null () then
 940                call tc_screen$shut (tc_data.screen_data_ptr);
 941 
 942           call tc_request$shut (tc_data_ptr, (0));
 943 
 944           return;
 945 
 946 cleanup_init:
 947      procedure;
 948 
 949           if tc_data.screen_data_ptr ^= null () then
 950                call tc_screen$shut (tc_data.screen_data_ptr);
 951 
 952           if tc_data.input_buffer_ptr ^= null () then
 953                call tc_input$shut (tc_data_ptr);
 954 
 955           if tc_data.desk_ptr ^= null () then
 956                free windows;
 957 
 958           call tc_request$shut (tc_data_ptr, (0));
 959 
 960           if tc_data.network_type = DSA_NETWORK_TYPE then   /* DSA */
 961                call dsa_tty_$detach (tc_data.tty_handle, (0), (0), (0));
 962           else if tc_data.network_type = MOWSE_NETWORK_TYPE then
 963                                                             /* MOWSE */
 964                call ws_tty_$detach (tc_data.mowse_terminal_iocb_ptr, (0), (0), (0));
 965           else                                              /* MCS */
 966                call hcs_$tty_detach (tc_data.devx, (0), (0), (0));
 967 
 968      end cleanup_init;
 969 ^L
 970 
 971 
 972 find_free_slot:
 973      procedure returns (fixed bin);
 974 declare  w                      fixed bin;
 975 
 976           do w = 1 to hbound (windows, 1);
 977                if ^windows (w).in_use then do;              /* this should mask, or stacq, or something */
 978                     windows (w).in_use = "1"b;
 979                     windows (w).status_pending = "0"b;
 980                     windows (w).pad = ""b;
 981                     windows (w).window_id = substr (reverse (bit (clock (), 72)), 1, 19) || bit (w, 17);
 982                     return (w);
 983                end;
 984           end;
 985           signal tc_too_many_windows_;
 986 declare  tc_too_many_windows_   condition;
 987      end find_free_slot;
 988 
 989 find_window:
 990      procedure (window_id, code) returns (fixed bin);
 991 
 992 declare  window_id              bit (36) aligned;
 993 declare  code                   fixed bin (35);
 994 declare  wx                     fixed bin;
 995 
 996           wx = bin (substr (window_id, 20), 17);
 997 
 998           if windows (wx).window_id ^= window_id then do;
 999                code = video_et_$bad_window_id;
1000                return (0);
1001           end;
1002           return (wx);
1003      end find_window;
1004 
1005 check_bounds:
1006      procedure (code);
1007 declare  code                   fixed bin (35);
1008 
1009 /* The screen is assumed to have one "phantom" position beyond its
1010    specified width, where the cursor may be positioned, but text may
1011    (possible) not be displayed. The cursor may be positioned anyplace
1012    including the phantom column, but text may not be placed there, for
1013    after putting out the text the cursor would have noplace to go.
1014    This may be nondelux, but it works. Also, characters may not be solicted
1015    from that column, for we could not echo. */
1016 
1017           if request_header.row < 1                         /* not in the sky */
1018                | request_header.col < 1                     /* or in china */
1019                | request_header.row < windows (wx).top_row  /* or not in */
1020                | request_header.row > windows (wx).top_row + windows (wx).n_rows - 1
1021                | request_header.col < windows (wx).first_column
1022                | request_header.col > windows (wx).first_column + windows (wx).n_columns then
1023                go to OUT_OF_BOUNDS;
1024 
1025           go to OP (request_header.operation);
1026 
1027 OP (0):                                                     /* OP_ERROR */
1028           return;
1029 
1030 OP (1):                                                     /* OP_POSITION_CURSOR */
1031           call check_bounds_within_phantom;
1032           return;
1033 
1034 
1035 OP (2):                                                     /* OP_CLEAR_REGION */
1036           call check_bounds_within_phantom;
1037 
1038           if request_clear_region.rows >                    /* extent requested */
1039                (windows (wx).n_rows - (request_header.row - windows (wx).top_row)) then
1040                go to OUT_OF_BOUNDS;
1041 
1042           if (request_clear_region.columns - request_header.col - 1) > windows (wx).n_columns then
1043                go to OUT_OF_BOUNDS;                         /* this will permit zero width regions in phantom col */
1044 
1045           return;
1046 
1047 OP (14):                                                    /* OP_OVERWRITE_TEXT */
1048 OP (3):                                                     /* OP_INSERT_TEXT */
1049           call check_bounds_within_phantom;                 /* allow starting in phantom col */
1050                                                             /* make sure final column isn't beyond phantom col */
1051           if (request_header.col + request_text.text_length) > windows (wx).first_column + windows (wx).n_columns + 1 then
1052                go to OUT_OF_BOUNDS;
1053           return;
1054 
1055 OP (6):                                                     /* OP_DELETE_CHARS */
1056           call check_bounds_within_window;
1057           if (request_header.col + request_delete_chars.count) > windows (wx).first_column + windows (wx).n_columns + 1
1058                then
1059                go to OUT_OF_BOUNDS;
1060 
1061           return;
1062 
1063 OP (7):                                                     /* OP_SCROLL_REGION */
1064                                                             /* coords are not payed attention to */
1065           if windows (wx).n_columns ^= tc_data.columns then /* naughty, naughty, a partial width window! */
1066                do;                                          /* no i-del lines for these windows. tc_request should do this check, but it doesn't know about windows ... sigh */
1067                Code = video_et_$capability_lacking;
1068                return;
1069           end;
1070 
1071           if request_scroll_region.start_line < windows (wx).top_row
1072                                                             /* */
1073                | request_scroll_region.start_line > windows (wx).top_row + windows (wx).n_rows - 1
1074                                                             /* */
1075                | request_scroll_region.n_lines < 1
1076                | request_scroll_region.start_line + request_scroll_region.n_lines
1077                > windows (wx).top_row + windows (wx).n_rows then
1078                go to OUT_OF_BOUNDS;
1079 
1080           return;
1081 
1082 OP (9):                                                     /* OP_GET_CHARS_ECHO */
1083           call check_bounds_within_window;
1084           if request_read.buffer_length + request_read.col > windows (wx).first_column + windows (wx).n_columns + 1 then
1085                go to OUT_OF_BOUNDS;
1086           return;
1087 
1088 OP (11):                                                    /* OP_WRITE_SYNC_GET_CHARS_NO_ECHO */
1089           call check_bounds_within_window;
1090           if request_read.prompt_length + request_read.col > windows (wx).first_column + windows (wx).n_columns + 1 then
1091                go to OUT_OF_BOUNDS;
1092 
1093           return;
1094 
1095 /* we don't check bounds for unechoed input, raw output and things
1096    that don't change the screen. */
1097 
1098 OP (10):                                                    /* OP_GET_CHARS_NO_ECHO */
1099 OP (16):                                                    /* OP_READ_ONE */
1100 OP (13):                                                    /* OP_READ_STATUS */
1101 OP (12):                                                    /* OP_GET_CURSOR_POSITION */
1102 OP (15):                                                    /* OP_WRITE_RAW */
1103 OP (8):                                                     /* OP_BELL */
1104           return;
1105 
1106 OUT_OF_BOUNDS:
1107           Code = video_et_$out_of_window_bounds;
1108           return;
1109 
1110 check_bounds_within_phantom:
1111           procedure;
1112 
1113                if request_header.col < windows (wx).first_column
1114                                                             /* left */
1115                     | request_header.col > windows (wx).first_column + windows (wx).n_columns + 1
1116                                                             /* right */
1117                     then
1118                     go to OUT_OF_BOUNDS;
1119 
1120                return;
1121 
1122 check_bounds_within_window:
1123           entry;
1124 
1125                if request_header.col < windows (wx).first_column
1126                     | request_header.col > windows (wx).first_column + windows (wx).n_columns - 1 then
1127                     go to OUT_OF_BOUNDS;
1128 
1129           end check_bounds_within_phantom;
1130      end check_bounds;
1131 ^L
1132 
1133 /**** The code that follows logically belongs in tc_io_. It has been
1134       transplanted here to avoid having the tc_io_ stack frame pushed
1135       for every video operation. ****/
1136 
1137 set_up:
1138      procedure;
1139 
1140           Code = 0;
1141           actual_iocbp = Iocbp -> iocb.actual_iocb_ptr;
1142           attach_data_ptr = actual_iocbp -> iocb.attach_data_ptr;
1143           mask = ""b;
1144           return;
1145 
1146      end set_up;
1147 
1148 declare  Iocbp                  pointer;
1149 declare  actual_iocbp           pointer;
1150 declare  mask                   bit (36) aligned;
1151 
1152 %page;
1153 %include tc_io_attach_data_;
1154 %include tc_desk_info_;
1155 %include iocb;
1156 %page;
1157 
1158 tc_io_control:
1159      entry (Iocbp, Order, Info_ptr, Code);
1160           call set_up;
1161           tc_data_ptr = attach_data.tc_info_ptr;
1162 
1163 declare  line_speed_ptr         pointer;
1164 declare  line_speed             fixed bin based (line_speed_ptr);
1165 
1166 declare  sub_error_             condition;
1167 
1168 dcl      1 fsc_info             like mowse_io_flush_subchannel_info;
1169 
1170           attach_data.operation_hlock = attach_data.operation_hlock + 1;
1171           on terminal_control_disconnection_ call disconnect_handler;
1172           on cleanup attach_data.operation_hlock = attach_data.operation_hlock - 1;
1173 
1174           on sub_error_ call perhaps_internal_error;
1175 
1176           if /* case */ Order = "window_operation" then
1177                call request_proc (Info_ptr, Code);
1178 
1179           else if Order = "clear_screen" then
1180                call clear_screen_proc;
1181 
1182           else if Order = "get_screen_image_ptr" then
1183                call get_screen_image_proc (Info_ptr);       /* POINTER IS OUTPUT ! */
1184 
1185           else if Order = "get_capabilities" then
1186                call get_capabilities_proc (Info_ptr);
1187 
1188           else if Order = "check_in_window" then do;
1189                tc_desk_info_ptr = Info_ptr;
1190                call check_in_window_proc (tc_desk_window_info.first_row, tc_desk_window_info.n_rows,
1191                     tc_desk_window_info.first_column, tc_desk_window_info.n_columns, tc_desk_window_info.window_id,
1192                     tc_desk_window_info.window_iocb_ptr);
1193           end;
1194           else if Order = "check_out_window" then do;
1195                tc_desk_info_ptr = Info_ptr;
1196                call check_out_window_proc (tc_desk_window_info.window_id);
1197           end;
1198           else if Order = "resize_window" then do;
1199 
1200                tc_desk_info_ptr = Info_ptr;
1201                call resize_window_proc (tc_desk_window_info.window_id, tc_desk_window_info.first_row,
1202                     tc_desk_window_info.n_rows, tc_desk_window_info.first_column, tc_desk_window_info.n_columns);
1203           end;
1204           else if Order = "set_line_speed" then do;
1205                line_speed_ptr = Info_ptr;
1206                tc_data.line_speed = line_speed;
1207           end;
1208           else if Order = "debug_on" then
1209                attach_data.debug = "1"b;
1210           else if Order = "debug_off" then
1211                attach_data.debug = "0"b;
1212 
1213           else if Order = "set_term_type" then do;
1214                begin;
1215                     sttip = Info_ptr;
1216                     if sttip = null () then do;
1217                          Code = error_table_$null_info_ptr;
1218                          return;
1219                     end;
1220                     if set_term_type_info.version ^= stti_version_1 then do;
1221                          Code = error_table_$unimplemented_version;
1222                          return;
1223                     end;
1224                     call set_term_type_proc (set_term_type_info.name, Code);
1225                     return;
1226                end;                                         /* begin */
1227           end;                                              /* case do */
1228 
1229           else if Order = "reconnection" then
1230                call reconnection_proc (Code);
1231 
1232           else if Order = "randomize_redisplay" then        /* to prevent position_cursor from optimizing */
1233                tc_data.state.cursor_valid = "0"b;
1234           else if Order = "initialize_mowse_terminal" then do;
1235                fsc_info.subchannel = FG;
1236                fsc_info.version = mowse_io_info_version_1;
1237                call iox_$control (tc_data.mowse_terminal_iocb_ptr, "flush_subchannel", addr (fsc_info), Code);
1238                call init_ttp_info_3 (Code);
1239                if Code ^= 0 then
1240                     return;
1241                call ws_tty_$attach (tc_data.mowse_terminal_iocb_ptr, Channel, Event, tty_state, Code);
1242           end;
1243           else call call_order (Order, Info_ptr, Code);     /* Trust our caller */
1244 ^L
1245 reconnection_proc:
1246      proc (Code);
1247 
1248 dcl      new_ttp                char (32);
1249 dcl      video_info_ptr         ptr;
1250 dcl      Code                   fixed bin (35);
1251 
1252 dcl      user_info_$terminal_data
1253                                 entry (char (*), char (*), char (*), fixed bin, char (*));
1254 dcl      tc_io_$reconnection    entry (ptr, fixed bin (35));
1255 dcl      video_utils_$turn_off_login_channel
1256                                 entry (fixed bin (35));
1257 
1258           call user_info_$terminal_data ("", new_ttp, "", (0), "");
1259                                                             /* get new terminal type */
1260 
1261 /* see if the new terminal will fly before trying to tweak tc_io_ */
1262 
1263           call get_video_info_ptr (new_ttp, 0, video_info_ptr, Code);
1264           if Code ^= 0 then do;
1265 REVOKE_VIDEO:
1266                call video_utils_$turn_off_login_channel (Code);
1267                return;
1268           end;
1269 
1270           call verify_capabilities (video_info_ptr, Code);
1271           if video_info_ptr ^= null ()                      /* let's play it safe */
1272                then
1273                free video_info_ptr -> tty_video_table;
1274           if Code ^= 0 then
1275                goto REVOKE_VIDEO;
1276 
1277 /* looks good ... let's tell tc_ */
1278 
1279           call tc_io_$reconnection (attach_data_ptr, Code);
1280           if Code ^= 0 then
1281                goto REVOKE_VIDEO;
1282 
1283 /* Now inform window (and therefore applications) of the change */
1284 
1285 dcl      1 WSI                  aligned like window_status_info;
1286 dcl      iox_$control           entry (ptr, char (*), ptr, fixed bin (35));
1287 
1288           WSI.version = window_status_version_1;
1289           WSI.status_string = W_STATUS_TTP_CHANGE | W_STATUS_SCREEN_INVALID | W_STATUS_RECONNECTION;
1290 
1291           do wx = 1 to hbound (windows, 1);
1292                if windows (wx).in_use then
1293                     call iox_$control (windows (wx).window_iocb_ptr, "set_window_status", addr (WSI), (0));
1294           end;                                              /* do */
1295 
1296           return;
1297 
1298      end reconnection_proc;
1299 ^L
1300 set_term_type_proc:
1301      proc (new_ttp, Code);
1302 
1303 dcl      new_ttp                char (*);
1304 dcl      Code                   fixed bin (35);
1305 dcl      video_info_ptr         ptr;
1306 
1307 /* First a dry run to make sure the new ttp will fly */
1308 
1309           call get_terminal_info(new_ttp, (0), Code);
1310           if Code ^= 0 then
1311                return;
1312 
1313           call check_protocol (ttd.protocol, Code);
1314           if Code ^= 0 then
1315               return;
1316 
1317           call get_video_info_ptr (new_ttp, 0, video_info_ptr, Code);
1318           if Code ^= 0 then
1319                return;
1320 
1321           call verify_capabilities (video_info_ptr, Code);
1322           if video_info_ptr ^= null ()                      /* play it safe */
1323                then
1324                free video_info_ptr -> tty_video_table;
1325           if Code ^= 0 then
1326                return;
1327 
1328 /* Update tc_'s idea of the terminal type */
1329 
1330           call tc_$shut_ttp_info (tc_data_ptr);
1331           call tc_$init_ttp_info (tc_data_ptr, set_term_type_info.name, Code);
1332           if Code ^= 0 then
1333                return;                                      /* Boy are we in trouble if this doesn't work */
1334 
1335 /* Now inform window (and therefore applications) of the change */
1336 
1337 dcl      1 WSI                  aligned like window_status_info;
1338 dcl      iox_$control           entry (ptr, char (*), ptr, fixed bin (35));
1339           WSI.version = window_status_version_1;
1340           WSI.status_string = W_STATUS_TTP_CHANGE | W_STATUS_SCREEN_INVALID;
1341 
1342           do wx = 1 to hbound (windows, 1);
1343                if windows (wx).in_use then
1344                     call iox_$control (windows (wx).window_iocb_ptr, "set_window_status", addr (WSI), (0));
1345           end;                                              /* do */
1346 
1347           return;
1348 
1349      end set_term_type_proc;
1350 ^L
1351 
1352 
1353 clear_screen_proc:
1354      procedure;
1355 
1356 declare  1 rcr                  aligned like request_clear_region;
1357 
1358           rcr.sentinel = REQUEST_SENTINEL;
1359           rcr.request_id = clock ();
1360           rcr.window_id = (36)"1"b;                         /* Special internal op */
1361           rcr.coords = 1;                                   /* will set both values */
1362           rcr.operation = OP_CLEAR_SCREEN_NO_OPT;
1363 
1364           rcr.extent.rows = tc_data.terminal.rows;
1365           rcr.extent.columns = tc_data.terminal.columns;
1366 
1367           call request_proc (addr (rcr), (0));
1368           return;
1369      end clear_screen_proc;
1370 
1371 
1372 get_screen_image_proc:
1373      procedure (si_ptr);
1374 declare  si_ptr                 pointer;
1375           si_ptr = tc_data.screen_data_ptr;                 /* violate modularization, but its cheaper */
1376           return;
1377      end get_screen_image_proc;
1378 
1379 reinit_return:
1380           if tc_data.state.pending.count < 0 then
1381                tc_data.state.pending.count = 0;
1382           if attach_data.operation_hlock ^= 0 then
1383                attach_data.operation_hlock = attach_data.operation_hlock - 1;
1384           return;
1385 
1386 hangup_return:
1387           attach_data.operation_hlock = attach_data.operation_hlock - 1;
1388 
1389           return;
1390 
1391 disconnect_handler:
1392      procedure;
1393 
1394 /* The disconnection strategy is different from that of tty_ */
1395 /* If we are a login_channel, and a disconnection occurs, we
1396    wait for the reconnection, but we want applications to know
1397    that something is wrong. also, none of the checked-in windows
1398    will be valid after a detach/reattach.
1399    So when window_io_ gets an invalid-window-id fom us/tc_,
1400    it must attempt to re-check-in, and consider that evidence that
1401    it can trust no screen state. Thus "completing the operation"
1402    on disconnections is not neccessary ... we wait for the reconnection,
1403    and then return invalid_window_id. We cannot return a more mnemotic
1404    code because the disconnect, detach, attach could have happened
1405    while we were not even on the stack to notice.
1406 
1407    If we are not a login channel, then the disconnection is just
1408    a hungup channel, which we translate back into io_no_permission
1409    and return it to the caller.
1410 */
1411 
1412 declare  video_et_$bad_window_id
1413                                 fixed bin (35) ext static;
1414 declare  find_condition_info_   entry (pointer, pointer, fixed binary (35));
1415 declare  video_utils_$turn_off_for_debug
1416                                 entry;
1417 declare  timer_manager_$sleep   entry (fixed binary (71), bit (2));
1418 declare  video_data_$error_name external static character (32);
1419 %include condition_info;
1420 %include condition_info_header;
1421 %include tc_disconnect_info;
1422 %include sub_error_info;
1423 declare  1 ci                   aligned like condition_info;
1424 declare  error_table_$io_no_permission
1425                                 external static fixed bin (35);
1426 
1427 
1428           ci.version = condition_info_version_1;
1429           call find_condition_info_ (null (), addr (ci), (0));
1430           tcdi_ptr = ci.info_ptr;
1431           if tc_data.network_type = DSA_NETWORK_TYPE then do;
1432                if tc_disconnect_info.tty_handle ^= attach_data.tty_handle then do;
1433                     call continue_to_signal_ (0);
1434                     return;
1435                end;
1436           end;
1437           else if tc_data.network_type = MOWSE_NETWORK_TYPE then do;
1438                if tc_disconnect_info.mowse_terminal_iocb_ptr ^= attach_data.mowse_terminal_iocb_ptr then do;
1439                     call continue_to_signal_ (0);
1440                     return;
1441                end;
1442           end;
1443           else if tc_disconnect_info.devx ^= attach_data.tty_index then do;
1444                call continue_to_signal_ (0);
1445                return;
1446           end;
1447 
1448           if ^attach_data.login_channel then do;
1449                Code = error_table_$io_no_permission;
1450                call force_unmask;
1451                go to hangup_return;
1452           end;
1453 
1454 /* We are a login channel */
1455 
1456           call force_unmask;
1457 
1458           do while ("1"b);                                  /* wait one minute for AS to take care of us */
1459                if attach_data.async_detach then
1460                     goto reconnected;
1461                call timer_manager_$sleep (2, "11"b /* rel secs */);
1462           end;
1463 
1464 reconnected:
1465           Code = video_et_$bad_window_id;
1466           go to hangup_return;
1467 ^L
1468 perhaps_internal_error:
1469      entry;
1470 
1471           ci.version = 1;
1472           call find_condition_info_ (null (), addr (ci), (0));
1473           sub_error_info_ptr = ci.info_ptr;
1474           if sub_error_info.name ^= video_data_$error_name then do;
1475                call continue_to_signal_ (0);
1476                return;
1477           end;                                              /* Its ours, and noone elses */
1478 
1479           if attach_data.login_channel then do;
1480                if attach_data.debug then do;
1481                     call video_utils_$turn_off_for_debug;
1482                     call continue_to_signal_ (0);
1483                     ci.info_ptr -> condition_info_header.cant_restart = "1"b;
1484                     return;
1485                end;
1486                call shut (attach_data.tc_info_ptr);
1487                call init (attach_data.tc_info_ptr, attach_data.device_used, attach_data.event_wait.channel_id (1), "",
1488                     "0"b /* not reconnection */, attach_data.mowse_terminal_iocb_ptr, Code);
1489                if Code = 0 then
1490                     Code = video_et_$bad_window_id;
1491                go to reinit_return;
1492           end;                                              /* login channel case */
1493           call continue_to_signal_ (0);                     /* emit the error msg */
1494           return;
1495      end disconnect_handler;
1496 
1497 
1498 
1499 force_unmask:
1500      procedure;
1501 declare  hcs_$reset_ips_mask    entry (bit (36) aligned, bit (36) aligned);
1502 
1503           call hcs_$reset_ips_mask ((36)"1"b, ""b);
1504 
1505      end force_unmask;
1506 %page;
1507 %include net_event_message;
1508 %include tty_video_tables;
1509 %page;
1510 %include tc_data_;
1511 %page;
1512 %include tc_operations_;
1513 %page;
1514 %include terminal_type_data;
1515 %include term_type_protocols;
1516 %include terminal_info;
1517 %page;
1518 %include set_term_type_info;
1519 %page;
1520 /* So we can do a set_window_status at reconnection and ttp change time */
1521 %include window_control_info;
1522 %page;
1523 %include window_status;
1524 %page;
1525 %include sub_err_flags;
1526 %page;
1527 %include terminal_capabilities;
1528 %page;
1529 %include mowse_messages;
1530 %page;
1531 %include mowse_io_control_info;
1532 %page;
1533 %include mowse;
1534 %include mcs_echo_neg;
1535      end tc_;