1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   6         *                                                         *
   7         * Copyright (c) 1972 by Massachusetts Institute of        *
   8         * Technology and Honeywell Information Systems, Inc.      *
   9         *                                                         *
  10         *********************************************************** */
  11 
  12 
  13 
  14 /****^  HISTORY COMMENTS:
  15   1) change(86-09-01,Beattie), approve(86-09-01,MCR7528),
  16      audit(86-09-11,Brunelle), install(86-09-16,MR12.0-1159):
  17      Change name of the "raw3270" mode to "raw3270io".
  18                                                    END HISTORY COMMENTS */
  19 
  20 
  21 /* format: style4 */
  22 
  23 /* IBM3270_MPX - The active portion of the ibm3270 multiplexer */
  24 
  25 /* Written May 1979 by Larry Johnson */
  26 /* Modified August 1982 by Robert Coren to handle "MASKED" interrupt */
  27 /* Bug fixes from Ford adopted by Robert Coren, October 1983 */
  28 /* Modified 1985-02-21, EJ Sharpe: use syserr_binary_def.incl.pl1, add format */
  29 
  30 ibm3270_mpx: proc;
  31 
  32 /* Parameters */
  33 
  34 dcl  arg_mdp ptr;
  35 dcl  arg_int_type fixed bin;
  36 dcl  arg_int_data bit (72) aligned;
  37 dcl  arg_subchan fixed bin;
  38 dcl  arg_order char (*);
  39 dcl  arg_infop ptr;
  40 dcl  arg_code fixed bin (35);
  41 dcl  arg_chain_ptr ptr;
  42 dcl  arg_mclp ptr;
  43 dcl  arg_modes char (*);
  44 dcl  arg_more_input bit (1) aligned;
  45 
  46 /* Automatic */
  47 
  48 dcl  int_type fixed bin;
  49 dcl  code fixed bin (35);
  50 dcl  order char (32);
  51 dcl  infop ptr;
  52 dcl  chain_ptr ptr;
  53 dcl  textp ptr;
  54 dcl  textl fixed bin;
  55 dcl  i fixed bin;
  56 dcl  position fixed bin;
  57 dcl  (pos_char1, pos_char2) char (1);
  58 dcl  dev_addr fixed bin;
  59 dcl  status bit (12);
  60 dcl  subchan fixed bin;
  61 dcl  header_blockp ptr;
  62 dcl  chain_len fixed bin;
  63 dcl  rest_chain_ptr ptr;
  64 dcl  end_chain_ptr ptr;
  65 dcl  column fixed bin;
  66 dcl  c char (1);
  67 dcl  save_raw_in_effect bit (1);
  68 dcl  targetp ptr;
  69 dcl  targetl fixed bin;
  70 
  71 dcl  1 wcc unal,                                            /* Write control code in output messages */
  72        2 printer_format bit (2),
  73        2 start_printer bit (1),
  74        2 sound_alarm bit (1),
  75        2 keyboard_restore bit (1),
  76        2 reset_modify bit (1);
  77 
  78 /* Based */
  79 
  80 dcl  target char (targetl) based (targetp);
  81 dcl  text char (textl) based (textp);
  82 dcl  text_array (textl) char (1) unal based (textp);
  83 dcl  bit_text_array (textl) bit (9) unal based (textp);
  84 
  85 dcl  1 status_msg unal based (textp),                       /* Format of status and test_req */
  86        2 soh char (1),
  87        2 percent char (1),                                  /* Should be "%", untranlated */
  88        2 type char (1),                                     /* "/" for test_req, "R" for status */
  89        2 stx char (1),
  90        2 controller_address char (1),
  91        2 device_address char (1),
  92        2 status1 char (1),
  93        2 status2 char (1),
  94        2 etx char (1);
  95 
  96 dcl  1 text_msg unal based (textp),                         /* Format of normal text start */
  97        2 stx char (1),
  98        2 controller_address char (1),
  99        2 device_address char (1),
 100        2 aid char (1),                                      /* Reason for input (which key) */
 101        2 cursor1 char (1),
 102        2 cursor2 char (1);
 103 
 104 dcl  1 abort_info aligned based (infop),                    /* Data for abort order */
 105        2 resetwrite bit (1) unal,
 106        2 resetread bit (1) unal,
 107        2 pad bit (34) unal;
 108 
 109 /* Constants */
 110 
 111 dcl  name char (11) int static options (constant) init ("ibm3270_mpx");
 112 dcl  max_chain_len fixed bin int static options (constant) init (1950);
 113 dcl  max_raw_chain_len fixed bin int static options (constant) init (4000);
 114 
 115 dcl  ascii_address_table (0:63) bit (9) unal int static options (constant) init (
 116           "040"b3, "101"b3, "102"b3, "103"b3, "104"b3, "105"b3, "106"b3, "107"b3,
 117           "110"b3, "111"b3, "133"b3, "056"b3, "074"b3, "050"b3, "053"b3, "041"b3,
 118           "046"b3, "112"b3, "113"b3, "114"b3, "115"b3, "116"b3, "117"b3, "120"b3,
 119           "121"b3, "122"b3, "135"b3, "044"b3, "052"b3, "051"b3, "073"b3, "136"b3,
 120           "055"b3, "057"b3, "123"b3, "124"b3, "125"b3, "126"b3, "127"b3, "130"b3,
 121           "131"b3, "132"b3, "174"b3, "054"b3, "045"b3, "137"b3, "076"b3, "077"b3,
 122           "060"b3, "061"b3, "062"b3, "063"b3, "064"b3, "065"b3, "066"b3, "067"b3,
 123           "070"b3, "071"b3, "072"b3, "043"b3, "100"b3, "047"b3, "075"b3, "042"b3);
 124 
 125 dcl  ebcdic_address_table (0:63) bit (9) unal int static options (constant) init (
 126           "100"b3, "301"b3, "302"b3, "303"b3, "304"b3, "305"b3, "306"b3, "307"b3,
 127           "310"b3, "311"b3, "112"b3, "113"b3, "114"b3, "115"b3, "116"b3, "117"b3,
 128           "120"b3, "321"b3, "322"b3, "323"b3, "324"b3, "325"b3, "326"b3, "327"b3,
 129           "330"b3, "331"b3, "132"b3, "133"b3, "134"b3, "135"b3, "136"b3, "137"b3,
 130           "140"b3, "141"b3, "342"b3, "343"b3, "344"b3, "345"b3, "346"b3, "347"b3,
 131           "350"b3, "351"b3, "152"b3, "153"b3, "154"b3, "155"b3, "156"b3, "157"b3,
 132           "360"b3, "361"b3, "362"b3, "363"b3, "364"b3, "365"b3, "366"b3, "367"b3,
 133           "370"b3, "371"b3, "172"b3, "173"b3, "174"b3, "175"b3, "176"b3, "177"b3);
 134 
 135 dcl  (
 136      SYSERR_CRASH_SYSTEM init (1),                          /* Crash the system, and bleat plaintively. */
 137      BEEP init (3),                                         /* Beep and print the message on the console. */
 138      ANNOUNCE init (0),                                     /* Just print the message on the console. */
 139      JUST_LOG init (5)                                      /* Just try to log the message, and discard it if it can't be */
 140      ) fixed bin internal static options (constant);
 141 
 142 /* Interal static */
 143 
 144 dcl  et_undefined_order_request fixed bin (35) int static;
 145 dcl  et_improper_data_format fixed bin (35) int static;
 146 dcl  et_noalloc fixed bin (35) int static;
 147 dcl  et_bad_mode fixed bin (35) int static;
 148 
 149 /* External */
 150 
 151 dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
 152 dcl  syserr entry options (variable);
 153 dcl  syserr$binary entry options (variable);
 154 dcl  wire_proc$wire_me entry;
 155 
 156 dcl  error_table_$undefined_order_request ext fixed bin (35);
 157 dcl  error_table_$noalloc ext fixed bin (35);
 158 dcl  error_table_$improper_data_format ext fixed bin (35);
 159 dcl  error_table_$bad_mode ext fixed bin (35);
 160 
 161 dcl  (addr, bin, bit, hbound, index, lbound, low, min, max, mod, null, ptr, rel,
 162      string, substr, unspec, size) builtin;
 163 
 164 dcl  cleanup condition;
 165 %page;
 166 /* Control entry point */
 167 
 168 control: entry (arg_mdp, arg_subchan, arg_order, arg_infop, arg_code);
 169 
 170           mdp = arg_mdp;
 171           subchan = arg_subchan;
 172           mdep = addr (md.mde_entry (subchan));
 173           order = arg_order;
 174           infop = arg_infop;
 175           ttybp = addr (tty_buf$);
 176 
 177           if order = "enter_receive" then do;
 178                if ^mde.raw3270_in_effect then do;
 179                     mde.keyboard_restore = "1"b;
 180                     call queue_control;                     /* Schedule the unlocking */
 181                     call process_write;                     /* In case it can be done now */
 182                end;
 183                code = 0;
 184           end;
 185           else if order = "abort" then do;
 186                if abort_info.resetwrite then call reset_channel;
 187                code = 0;
 188           end;
 189           else if order = "listen" then do;
 190                mde.listen = "1"b;
 191                if mde.printer & ^mde.dialed & md.started then
 192                     call dialup_channel;
 193                code = 0;
 194           end;
 195           else if order = "hangup" then do;
 196                mde.listen, mde.dialed = "0"b;
 197                call reset_channel;
 198                mde.keyboard_restore = "1"b;
 199                call channel_manager$interrupt (mde.devx, HANGUP, "0"b);
 200                call queue_control;
 201                call process_write;
 202                code = 0;
 203           end;
 204           else if order = "wru" then do;
 205                call channel_manager$interrupt (mde.devx, WRU_TIMEOUT, "0"b);
 206                code = 0;
 207           end;
 208           else if order = "printer_off" then code = 0;
 209           else if order = "printer_on" then code = 0;
 210           else code = et_undefined_order_request;
 211 
 212           arg_code = code;
 213           return;
 214 
 215 /* Read entry. We have no data. */
 216 
 217 read: entry (arg_mdp, arg_subchan, arg_chain_ptr, arg_more_input, arg_code);
 218 
 219           arg_chain_ptr = null ();
 220           arg_more_input = "0"b;
 221           arg_code = 0;
 222 
 223           return;
 224 %page;
 225 /* Entries that dial with modes. We only watch the setting of hndlquit */
 226 
 227 check_modes: entry (arg_mdp, arg_subchan, arg_mclp, arg_code);
 228 
 229           mdp = arg_mdp;
 230           subchan = arg_subchan;
 231           mdep = addr (md.mde_entry (subchan));
 232           mclp = arg_mclp;
 233           ttybp = addr (tty_buf$);
 234 
 235           do i = 1 to mcl.n_entries;
 236                mclep = addr (mcl.entries (i));
 237                mcle.mpx_mode = "0"b;
 238                if mcle.mode_name = "hndlquit" | mcle.mode_name = "rawi" | mcle.mode_name = "rawo" then
 239                     mcle.mpx_mode = "1"b;                   /* Monitor changes to these modes */
 240                else if mcle.mode_name = "raw3270io" then
 241                     if (^md.allow_raw3270 & mcle.mode_switch) then mcle.error = "1"b;
 242                     else mcle.mpx_mode = "1"b;
 243           end;
 244 
 245           arg_code = 0;
 246           return;
 247 
 248 set_modes: entry (arg_mdp, arg_subchan, arg_mclp, arg_code);
 249 
 250           mdp = arg_mdp;
 251           subchan = arg_subchan;
 252           mdep = addr (md.mde_entry (subchan));
 253           mclp = arg_mclp;
 254           arg_code = 0;
 255           ttybp = addr (tty_buf$);
 256 
 257           save_raw_in_effect = mde.raw3270_in_effect;
 258           if mcl.init then mde.hndlquit, mde.rawi, mde.rawo, mde.raw3270 = "0"b;
 259 
 260           do i = 1 to mcl.n_entries;
 261                mclep = addr (mcl.entries (i));
 262                if mcle.mpx_mode then do;
 263                     if mcle.mode_name = "hndlquit" then mde.hndlquit = mcle.mode_switch;
 264                     else if mcle.mode_name = "rawi" then mde.rawi = mcle.mode_switch;
 265                     else if mcle.mode_name = "rawo" then mde.rawo = mcle.mode_switch;
 266                     else if mcle.mode_name = "raw3270io" then mde.raw3270 = mcle.mode_switch;
 267                     else do;
 268                          mcle.error = "1"b;
 269                          arg_code = et_bad_mode;
 270                     end;
 271                end;
 272           end;
 273 
 274           mde.raw3270_in_effect = mde.rawi & mde.rawo & mde.raw3270;
 275           if save_raw_in_effect & ^mde.raw3270_in_effect & ^mde.write_queued & mde.write_chain_ptr ^= null () then
 276                call reset_channel;
 277 
 278           return;
 279 
 280 get_modes: entry (arg_mdp, arg_subchan, arg_modes, arg_code);
 281 
 282           mdp = arg_mdp;
 283           subchan = arg_subchan;
 284           mdep = addr (md.mde_entry (subchan));
 285           ttybp = addr (tty_buf$);
 286 
 287           if mde.raw3270 then arg_modes = "raw3270io";
 288           else arg_modes = "^raw3270io";
 289           arg_code = 0;
 290           return;
 291 %page;
 292 /* Write entry point */
 293 
 294 write: entry (arg_mdp, arg_subchan, arg_chain_ptr, arg_code);
 295 
 296           mdp = arg_mdp;
 297           subchan = arg_subchan;
 298           mdep = addr (md.mde_entry (subchan));
 299           chain_ptr = arg_chain_ptr;
 300           end_chain_ptr, rest_chain_ptr, header_blockp = null ();
 301           arg_code = 0;
 302           ttybp = addr (tty_buf$);
 303 
 304 /* The following section handles writing in raw3270 mode */
 305 
 306           if mde.raw3270_in_effect then do;
 307                if mde.write_chain_ptr ^= null () then do;   /* Must merge */
 308                     do blockp = mde.write_chain_ptr repeat (ptr (ttybp, buffer.next)) while (buffer.next ^= 0);
 309                     end;                                    /* Find end */
 310                     buffer.next = bin (rel (chain_ptr));
 311                     chain_ptr = mde.write_chain_ptr;
 312                     mde.write_chain_ptr = null ();
 313                end;
 314 
 315 /* Look for end of first command as signalled by ETX. */
 316 
 317                position = 0;
 318                blockp = chain_ptr;
 319                do while (position = 0 & (rel (blockp) ^= "0"b));
 320                     textp = addr (buffer.chars);
 321                     textl = buffer.tally;
 322                     position = index (text, md.etx);
 323                     end_chain_ptr = blockp;
 324                     if position = 0
 325                     then do;
 326                          blockp = ptr (ttybp, buffer.next);
 327                     end;
 328                end;
 329 
 330                if position = -1                             /* No ETX in message anywhere. */
 331                then do;
 332                     if ^end_chain_ptr -> buffer.break then do; /* Don't have complete message yet. */
 333                          mde.write_chain_ptr = chain_ptr;
 334                          arg_chain_ptr = null ();
 335                          arg_code = 0;
 336                          call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
 337                          return;
 338                     end;
 339                     else do;
 340                          goto write_format_error;
 341                     end;
 342                end;
 343 
 344 /* ETX is somewhere in message. */
 345 
 346                if position = buffer.tally                   /* ETX is at end of buffer.  Don't need to split buffer. */
 347                then do;
 348                     if buffer.next = 0 then ;               /* ETX is at end of chain.  Don't need to split chain. */
 349                     else do;                                /* Need to split chain, but not buffer. */
 350                          rest_chain_ptr = ptr (ttybp, buffer.next);
 351                          buffer.next = 0;
 352                     end;
 353                end;
 354                else do;                                     /* Need to split buffer and split chain. */
 355                     call tty_space_man$get_buffer (mde.devx,
 356                          16 * (buffer.size_code + 1),
 357                          OUTPUT,
 358                          rest_chain_ptr);
 359                     if rest_chain_ptr = null ()
 360                     then do;
 361                          arg_code = et_noalloc;
 362                          return;
 363                     end;
 364                     rest_chain_ptr -> buffer.next = buffer.next;
 365                     rest_chain_ptr -> buffer.flags = buffer.flags;
 366                     rest_chain_ptr -> buffer.size_code = buffer.size_code;
 367                     rest_chain_ptr -> buffer.tally = (buffer.tally - position);
 368                     buffer.tally = position;
 369                     buffer.next = 0;
 370                     buffer.break = "1"b;
 371                     textp = addr (buffer.chars (position));
 372                     textl = rest_chain_ptr -> buffer.tally;
 373                     targetp = addr (rest_chain_ptr -> buffer.chars);
 374                     targetl = textl;
 375                     target = text;
 376                end;
 377 
 378 /* Check max chain length. */
 379 
 380                chain_len = 0;
 381                do blockp = chain_ptr repeat (ptr (ttybp, buffer.next)) while (rel (blockp) ^= "0"b);
 382                     chain_len = chain_len + buffer.tally;
 383                     end_chain_ptr = blockp;
 384                end;
 385                if chain_len > max_raw_chain_len
 386                then do;
 387                     go to write_format_error;
 388                end;
 389 
 390 /* Check for proper message header. */
 391 
 392                blockp = chain_ptr;
 393                if buffer.chars (0) ^= md.stx
 394                then do;
 395                     go to write_format_error;
 396                end;
 397                if buffer.chars (1) ^= md.esc
 398                then do;
 399                     go to write_format_error;
 400                end;
 401                if (buffer.chars (2) = md.write)
 402                     | (buffer.chars (2) = md.erase_write) then ; /* Ok */
 403                else do;
 404                     if buffer.chars (2) = md.copy
 405                     then do;
 406                          if md.allow_copy then ;            /* Ok */
 407                          else do;
 408                               go to write_format_error;
 409                          end;
 410                     end;
 411                     else do;
 412                          goto write_format_error;
 413                     end;
 414                end;
 415 
 416 /* Check for trailing ETX. */
 417 
 418                blockp = end_chain_ptr;
 419                if buffer.chars (buffer.tally - 1) ^= md.etx then go to write_format_error;
 420 
 421 /* Seem to have a good message; queue it up. */
 422 
 423                header_blockp = chain_ptr;
 424                go to queue_write_data;
 425 
 426           end;
 427 
 428 /* Rest of code is for case of ^raw3270 mode */
 429 /* First, be sure a buffer is available for the header */
 430 
 431           call tty_space_man$get_buffer (mde.devx, 16, OUTPUT, header_blockp);
 432           if header_blockp = null () then do;
 433                arg_code = et_noalloc;                       /* Give up if no space */
 434                return;
 435           end;
 436 
 437 /* Take as much of the chain as can fit in a single bisync message.  We must
 438    be careful not to split a NL-NUL-NUL sequence. */
 439 
 440           chain_len = 0;
 441           do blockp = chain_ptr repeat (ptr (ttybp, buffer.next)) while (rel (blockp) ^= "0"b);
 442                chain_len = chain_len + buffer.tally;
 443                if chain_len > max_chain_len then do;
 444                     rest_chain_ptr = blockp;                /* First buffer of rest of chain */
 445                     blockp = end_chain_ptr;
 446                     buffer.next = 0;                        /* Break chain */
 447                     if mde.printer then go to chain_split;
 448                     textp = addr (buffer.chars);
 449                     textl = buffer.tally;
 450                     do i = 2 to 1 by -1 while (textl > (2 - i)); /* Check last 2 characters */
 451                          c = substr (text, textl - 2 + i, 1);
 452                          if c = md.nl | c = md.cr | c = md.bs then do;
 453                               call check_buffer_tally (i);  /* This buffer must have room */
 454                               buffer.tally = buffer.tally + i;
 455                               textl = textl + i;
 456                               substr (text, textl - i + 1, i) = low (i);
 457                               blockp = rest_chain_ptr;
 458                               if buffer.tally > i then do;  /* Trim stuff from front */
 459                                    textp = addr (buffer.chars);
 460                                    textl = buffer.tally;
 461                                    text = substr (text, i + 1);
 462                                    buffer.tally = buffer.tally - i;
 463                               end;
 464                               go to chain_split;
 465                          end;
 466                     end;
 467                     go to chain_split;
 468                end;
 469                end_chain_ptr = blockp;
 470           end;
 471 chain_split:
 472           if end_chain_ptr = null () then end_chain_ptr = chain_ptr;
 473 
 474 /* The output chain should have been formatted by tty_write so that each new_line is followed by two nulls.
 475    Loop thru the chain replacing each such sequence by a cursor addressing sequence */
 476 
 477           blockp = chain_ptr;
 478           textp = addr (buffer.chars);
 479           textl = buffer.tally;
 480           if mde.printer then mde.erase_req = "1"b;
 481           if mde.erase_req then mde.position = 0;
 482           position = mde.position;
 483 
 484           if ^mde.printer then do while (textp ^= null ()); /* Loop over entire message */
 485                i = 0;                                       /* Index to next interesting char */
 486                call find_next (i, md.nl);
 487                call find_next (i, md.cr);
 488                call find_next (i, md.bs);
 489                if i = 0 then do;
 490                     position = mod (position + textl, mde.screen_size);
 491                     call adv_text (textl);
 492                end;
 493                else do;
 494                     column = mod (position, mde.line_size);
 495                     position = position - column;
 496                     if i > 1 then do;                       /* Data before new line */
 497                          column = column + i - 1;
 498                          call adv_text (i - 1);
 499                     end;
 500                     c = substr (text, 1, 1);
 501                     substr (text, 1, 1) = md.sba;           /* Replace nl by set-buffer-address */
 502                     call adv_text (1);
 503                     if textp = null () then go to write_format_error; /* Should be followed by 2 nulls */
 504                     if substr (text, 1, 1) ^= low (1) then go to write_format_error;
 505                     if c = md.nl then do;
 506                          if (column = 0) | (mod (column, mde.line_size) ^= 0) then
 507                               column = column - mod (column, mde.line_size) + mde.line_size;
 508                     end;
 509                     else if c = md.cr then column = 0;
 510                     else if c = md.bs then column = max (column - 1, 0);
 511                     position = mod (position + column, mde.screen_size);
 512                     call get_position_chars (position);
 513                     substr (text, 1, 1) = pos_char1;        /* Replace first null () */
 514                     call adv_text (1);                      /* To second null */
 515                     if textp = null then go to write_format_error;
 516                     if substr (text, 1, 1) ^= low (1) then go to write_format_error;
 517                     substr (text, 1, 1) = pos_char2;
 518                     call adv_text (1);
 519                end;
 520           end;
 521 
 522 /* Format the header block with STX-ESC-WRITE-WCC-SBA-POS-POS */
 523 
 524           blockp = header_blockp;
 525           if ^mde.printer then mde.end_of_page = end_chain_ptr -> buffer.end_of_page;
 526           end_chain_ptr -> buffer.end_of_page = "0"b;
 527           if mde.end_of_page then mde.keyboard_restore = "1"b;
 528           call build_header;
 529           buffer.next = bin (rel (chain_ptr));              /* Thread to head of chain */
 530 
 531 /* Two characters must be added to end of last buffer, IC (insert cursor) and ETX */
 532 
 533           blockp = end_chain_ptr;
 534           call check_buffer_tally (2);                      /* Need space for 2 chars */
 535 
 536           textp = addr (buffer.chars);                      /* Add necessary stuff to end of last buffer */
 537           textl = buffer.tally;
 538           textl = textl + 2;
 539           if mde.printer then substr (text, textl - 1, 1) = md.em;
 540           else substr (text, textl - 1, 1) = md.ic;         /* Insert cursor */
 541           substr (text, textl, 1) = md.etx;
 542           buffer.tally = textl;
 543 
 544 /* Data is now completely formated and ready to transmit */
 545 
 546           mde.position = position;                          /* Where we left the cursor */
 547 
 548 queue_write_data:
 549           call queue_write;
 550 
 551           call process_write;                               /* Start this write if possible */
 552 
 553           arg_chain_ptr = rest_chain_ptr;
 554           return;
 555 
 556 write_format_error:
 557           if header_blockp ^= null () then
 558                call tty_space_man$free_buffer (mde.devx, OUTPUT, header_blockp);
 559           call tty_space_man$free_chain (mde.devx, OUTPUT, chain_ptr);
 560           if rest_chain_ptr ^= null () then
 561                call tty_space_man$free_chain (mde.devx, OUTPUT, rest_chain_ptr);
 562           md.write_format_error = md.write_format_error + 1;
 563           arg_code = 0;                                     /* A code would be better, but users cant handle it */
 564           arg_chain_ptr = null ();
 565           return;
 566 %page;
 567 /* Interrupt entry point */
 568 
 569 interrupt: entry (arg_mdp, arg_int_type, arg_int_data);
 570 
 571           mdp = arg_mdp;
 572           int_type = arg_int_type;
 573           interrupt_info = arg_int_data;
 574           ttybp = addr (tty_buf$);
 575 
 576           if int_type < lbound (INTERRUPT, 1) | int_type > hbound (INTERRUPT, 1) then do;
 577                call syserr (ANNOUNCE, "^a: Unrecognized interrupt for ^a. ^d ^.3b",
 578                     name, md.name, int_type, interrupt_info);
 579                return;
 580           end;
 581 
 582           go to INTERRUPT (int_type);
 583 
 584 /* DIALUP interrupt - This means that the major channel has dialed up and the multiplexer is now loaded */
 585 
 586 INTERRUPT (1):
 587           if ^md.loading then return;
 588           md.loading = "0"b;
 589           md.loaded = "1"b;
 590           unspec (dialup_info) = interrupt_info;
 591           md.line_type = dialup_info.line_type;
 592           md.baud_rate = dialup_info.baud_rate;
 593           md.max_buf_size = dialup_info.max_buf_size;
 594           md.buffer_pad = dialup_info.buffer_pad;
 595           call pxss$ring_0_wakeup (md.processid, md.event_channel, IBM3270_MPX_UP, code);
 596           return;
 597 
 598 /* HANGUP interrupt - This means that we have lost the phone and the multiplexer is considered crashed */
 599 
 600 INTERRUPT (2):
 601           if ^md.loaded then return;
 602           call crash_mpx;
 603           call pxss$ring_0_wakeup (md.processid, md.event_channel, IBM3270_MPX_DOWN, code);
 604           return;
 605 
 606 /* CRASH interrupt - Parent multiplexer has crashed. We must propagate the information */
 607 
 608 INTERRUPT (3):
 609           if ^md.loaded then return;
 610           call crash_mpx;
 611           return;
 612 
 613 /* SEND_OUTPUT interrupt - We are allowed to send more output */
 614 
 615 INTERRUPT (4):
 616           if ^md.loaded then return;
 617           md.send_output = "1"b;                            /* Will save for later */
 618           if md.message_in_progress then do;                /* Complete partially written msg */
 619                call send_more_message;
 620                return;
 621           end;
 622           if ^md.output_in_progress then call process_write;/* Just in case */
 623           return;
 624 %page;
 625 /* INPUT_AVAILABLE Interrupt - Not used */
 626 
 627 INTERRUPT (5):
 628           return;
 629 
 630 /* ACCEPT_INPUT - Real data to processes */
 631 
 632 INTERRUPT (6):
 633           if ^md.loaded then return;
 634           md.poll_in_progress = "0"b;                       /* Any input suspends polling */
 635           unspec (rtx_info) = interrupt_info;
 636           chain_ptr = ptr (ttybp, rtx_info.chain_head);     /* Start of input chain */
 637           if ^md.loaded then go to discard_input;
 638 
 639           blockp = chain_ptr;
 640           textp = addr (buffer.chars);
 641           textl = buffer.tally;                             /* Set up to look at start */
 642 
 643           if substr (text, 1, 1) = md.eot then do;          /* EOT means end of current poll operation */
 644                md.poll_in_progress = "0"b;
 645                call tty_space_man$free_chain (md.devx, INPUT, chain_ptr);
 646                call process_input;
 647                call process_polls;
 648                call process_write;
 649                return;
 650           end;
 651 
 652           if substr (text, 1, 1) = md.soh then do;          /* Status or test_req */
 653                if textl < 5 then go to bad_input;
 654                if status_msg.percent ^= md.percent then     /* Should start % */
 655                     go to bad_input;
 656                if status_msg.type = slash then go to discard_input; /* Ignore test_reqq */
 657                if status_msg.type ^= md.letter_R then       /* R means status */
 658                     go to bad_input;
 659                if textl < 9 then go to bad_input;
 660                if status_msg.stx ^= md.stx then go to bad_input;
 661                dev_addr = getbin (status_msg.device_address);
 662                if dev_addr < lbound (md.chan_map, 1) | dev_addr > hbound (md.chan_map, 1) then go to bad_dev_addr;
 663                subchan = md.chan_map (dev_addr);
 664                if subchan <= 0 then go to bad_device;
 665                mdep = addr (md.mde_entry (subchan));
 666                if ^mde.dialed then go to discard_input;     /* Dont care if hungup */
 667                if ^mde.printer then go to discard_input;    /* Dont care except for printers */
 668                if mde.waiting_for_ready then do;            /* Looking for printer to go ready */
 669                     substr (status, 1, 6) = getbit (status_msg.status1);
 670                     substr (status, 7, 6) = getbit (status_msg.status2);
 671                     if status = "0200"b3 then do;           /* Really ready status */
 672                          mde.waiting_for_ready = "0"b;
 673                          call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
 674                     end;
 675                end;
 676                go to discard_input;                         /* Throw away status */
 677           end;
 678 
 679 
 680 /* Accumulate this block onto the current input chain */
 681 
 682           if text_msg.stx ^= md.stx then go to bad_input;
 683           if textl < 2 then go to bad_input;
 684           if md.input_chain_ptr ^= null () then do;         /* Trim etb off previous block */
 685                call trim_chain_end (md.input_chain_ptr, 1);
 686                md.input_count = md.input_count - 1;
 687           end;
 688           if md.input_chain_ptr ^= null () then do;         /* Thread blocks */
 689                call trim_chain_start (chain_ptr, 1);        /* Throw away new stx */
 690                do blockp = md.input_chain_ptr repeat (ptr (ttybp, buffer.next)) while (buffer.next ^= 0);
 691                end;
 692                buffer.next = bin (rel (chain_ptr));
 693                md.input_count = md.input_count + rtx_info.input_count - 1;
 694           end;
 695           else do;                                          /* First block */
 696                md.input_chain_ptr = chain_ptr;
 697                md.input_count = rtx_info.input_count;
 698           end;
 699           do blockp = chain_ptr repeat (ptr (ttybp, buffer.next)) while (buffer.next ^= 0);
 700           end;                                              /* Find last block */
 701           if buffer.chars (buffer.tally - 1) = md.etx then call process_input;
 702           return;
 703 
 704 bad_input:
 705           textl = min (textl, 8);
 706           if md.debug then
 707                call syserr (ANNOUNCE, "^a: Unrecognized input for ^a:^( ^.3b^)", name, md.name, bit_text_array);
 708           md.bad_input = md.bad_input + 1;
 709           go to discard_input;
 710 
 711 bad_dev_addr:
 712                                                             /* This is so bad we cannot even mask it off, because its not in the table */
 713           call syserr (ANNOUNCE, "^a: Input for illegal device address ^d on ^a", name, dev_addr, md.name);
 714           md.bad_device = md.bad_device + 1;
 715           go to discard_input;
 716 
 717 bad_device:
 718           if subchan < 0 then go to discard_input;          /* Once per bootload */
 719           call syserr (ANNOUNCE, "^a: Input for unconfigured device ^d on ^a", name, dev_addr, md.name);
 720           md.bad_device = md.bad_device + 1;
 721           md.chan_map (dev_addr) = -1;                      /* So wont get printed again */
 722 
 723 discard_input:
 724           call tty_space_man$free_chain (md.devx, INPUT, chain_ptr);
 725           return;
 726 
 727 /* INPUT REJECTED interrupt - Ignore */
 728 
 729 INTERRUPT (7):
 730           if ^md.loaded then return;
 731           md.input_reject = md.input_reject + 1;
 732           return;
 733 
 734 /* QUIT interrupt - Ignore */
 735 
 736 INTERRUPT (8):
 737           return;
 738 
 739 /* DIAL STATUS interrupt - Ignore */
 740 
 741 INTERRUPT (10):
 742           return;
 743 
 744 /* WRU TIMEOUT interrupt - Ignore */
 745 
 746 INTERRUPT (11):
 747           return;
 748 
 749 /* SPACE AVAILABLE interrupt - Retry suspended write operation. */
 750 
 751 INTERRUPT (12):
 752           if ^md.loaded then return;
 753           md.space_available = md.space_available + 1;
 754           if md.message_in_progress then call send_more_message;
 755           else call process_write;
 756           return;
 757                                                             /* various others - ignore */
 758 
 759 INTERRUPT (13):
 760 INTERRUPT (14):
 761 INTERRUPT (15):
 762 INTERRUPT (16):
 763           return;
 764 
 765 /* MASKED interrupt - Treat like hangup but use different wakeup message */
 766 
 767 INTERRUPT (17):
 768           if ^md.loaded then return;
 769           call crash_mpx;
 770           call pxss$ring_0_wakeup (md.processid, md.event_channel, IBM3270_MPX_MASKED, code);
 771           return;
 772 
 773 %page;
 774 /* LINE STATUS interrupt - Decode and act upon in */
 775 
 776 INTERRUPT (9):
 777           if ^md.loaded then return;
 778           unspec (line_stat) = interrupt_info;
 779           if line_stat.op < lbound (LINE_STAT, 1) | line_stat.op > hbound (LINE_STAT, 1) then return;
 780           go to LINE_STAT (line_stat.op);
 781 
 782 LINE_STAT (1):                                              /* No response to poll */
 783           md.poll_failed = md.poll_failed + 1;
 784           md.poll_in_progress = "0"b;
 785           call process_polls;
 786           call process_write;
 787           return;
 788 
 789 LINE_STAT (2):                                              /* Badly formated output block */
 790           md.bad_output = md.bad_output + 1;
 791           go to line_stat_output_complete;
 792 
 793 LINE_STAT (3):                                              /* Rvi - device has status */
 794           if md.output_in_progress then do;
 795                subchan = md.cur_write_chan;
 796                mdep = addr (md.mde_entry (subchan));
 797                call queue_poll;
 798           end;
 799           go to line_stat_output_complete;
 800 
 801 LINE_STAT (4):                                              /* Too many naks */
 802           return;
 803 
 804 LINE_STAT (5):                                              /* Write status - can't happen */
 805           return;
 806 
 807 LINE_STAT (6):                                              /* 3270 write complete */
 808 line_stat_output_complete:
 809           if md.output_in_progress then do;
 810                md.output_in_progress, md.message_in_progress = "0"b;
 811                mdep = addr (md.mde_entry (md.cur_write_chan));
 812                if ^mde.end_of_page then
 813                     call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
 814           end;
 815 line_stat_continue:
 816           call process_polls;
 817           call process_write;
 818           return;
 819 
 820 LINE_STAT (7):                                              /* 3270 wack msg - printer going busy */
 821           if ^md.output_in_progress then go to line_stat_continue;
 822           md.output_in_progress, md.message_in_progress = "0"b;
 823           mdep = addr (md.mde_entry (md.cur_write_chan));
 824           if mde.printer then mde.waiting_for_ready = "1"b;
 825           else call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
 826           go to line_stat_continue;
 827 
 828 LINE_STAT (8):                                              /* Ibm3270 write eot */
 829           md.write_eot = md.write_eot + 1;
 830           go to line_stat_output_complete;
 831 
 832 LINE_STAT (9):
 833           md.write_abort = md.write_abort + 1;
 834           go to line_stat_output_complete;
 835 
 836 LINE_STAT (10):
 837           md.select_failed = md.select_failed + 1;
 838           go to line_stat_output_complete;
 839 
 840 LINE_STAT (11):
 841           md.wack_select = md.wack_select + 1;
 842           go to line_stat_output_complete;
 843 
 844 LINE_STAT (12):
 845           md.nak_output = md.nak_output + 1;
 846           go to line_stat_output_complete;
 847 %page;
 848 /* Internal procedure to adv pointer down a buffer chain. If the current buffer is exhausted, step to next */
 849 
 850 adv_text: proc (n);
 851 
 852 dcl  n fixed bin;
 853 
 854           textp = addr (text_array (n + 1));                /* Bump pointer */
 855           textl = textl - n;                                /* Reduce tally */
 856           if textl > 0 then return;                         /* More in buffer */
 857           if buffer.next = 0 then do;                       /* End of chain */
 858                textp = null ();
 859                return;
 860           end;
 861           blockp = ptr (ttybp, buffer.next);                /* Next in chain */
 862           textp = addr (buffer.chars);
 863           textl = buffer.tally;
 864           return;
 865 
 866      end adv_text;
 867 
 868 /* Procedure for finding next occurance of specified character */
 869 
 870 find_next: proc (ix, c);
 871 
 872 dcl  ix fixed bin;
 873 dcl  c char (1) unal;
 874 
 875 dcl  i fixed bin;
 876 
 877           if ix = 0 then ix = index (text, c);              /* No interesting chars yet */
 878           else if ix = 1 then ;                             /* Nothing if another interesting char first */
 879           else do;
 880                i = index (substr (text, 1, ix - 1), c);
 881                if i ^= 0 then ix = i;
 882           end;
 883 
 884           return;
 885 
 886      end find_next;
 887 
 888 /* This procedure computes a two character addressing sequence, given a position */
 889 
 890 get_position_chars: proc (pos);
 891 
 892 dcl  pos fixed bin;
 893 dcl  posbit bit (12);
 894 
 895           posbit = bit (bin (pos, 12), 12);                 /* Need two 6-but pieces */
 896           pos_char1 = address_table (bin (substr (posbit, 1, 6)));
 897           pos_char2 = address_table (bin (substr (posbit, 7, 6)));
 898           return;
 899 
 900      end get_position_chars;
 901 
 902 /* Decode screen position from characters */
 903 
 904 get_position: proc (c1, c2) returns (fixed bin);
 905 
 906 dcl  (c1, c2) char (1);
 907 
 908           return (bin (getbit (c1) || getbit (c2)));
 909 
 910      end get_position;
 911 
 912 /* Functions that map status chars back into usefull stuff */
 913 
 914 getbin: proc (c) returns (fixed bin (6));
 915 
 916 dcl  c char (1);
 917 
 918           return (bin (substr (unspec (c), 4, 6), 6));
 919 
 920      end getbin;
 921 
 922 getbit: proc (c) returns (bit (6));
 923 
 924 dcl  c char (1);
 925 
 926           return (substr (unspec (c), 4, 6));
 927 
 928      end getbit;
 929 %page;
 930 /* Internal procedure to queue a channel with data to write on the mpx write queue */
 931 
 932 queue_write: proc;
 933 
 934 dcl  p ptr;
 935 
 936           if mde.write_queued then do;
 937                call syserr$binary (
 938                     JUST_LOG,                               /* Log, discard if not possible         */
 939                     mdep,
 940                     SB_ibm3270_mde,
 941                     size (mde),                             /* Size of an MDE                       */
 942                     "^a: Attempt to queue write while write queued ^a.^a",
 943                     name,
 944                     md.name,
 945                     mde.name
 946                     );
 947 
 948                mde.write_chain_ptr = header_blockp;
 949                return;
 950           end;
 951 
 952           if md.first_write_chan = 0 then do;
 953                md.first_write_chan = subchan;
 954                md.last_write_chan = subchan;
 955           end;
 956           else do;
 957                p = addr (md.mde_entry (md.last_write_chan));
 958                p -> mde.next_write_chan = subchan;
 959                md.last_write_chan = subchan;
 960           end;
 961           mde.next_write_chan = 0;
 962           mde.write_chain_ptr = header_blockp;
 963           mde.write_queued = "1"b;
 964           return;
 965 
 966      end queue_write;
 967 
 968 /* Procedure to process the next piece of output */
 969 
 970 process_write: proc;
 971 
 972           mdep = null ();
 973           if md.output_in_progress then return;             /* Doing someone else */
 974           if md.poll_in_progress then return;
 975           if md.first_poll_chan ^= 0 then return;           /* Polling has priority */
 976           if md.first_control_chan ^= 0 then do;
 977                call setup_control_chan;
 978                if mdep ^= null () then go to write_join;    /* Found one */
 979           end;
 980           if md.first_write_chan = 0 then return;           /* Nothing to do anyway */
 981 
 982           subchan = md.first_write_chan;
 983           mdep = addr (md.mde_entry (subchan));
 984           md.first_write_chan = mde.next_write_chan;        /* Dequeue */
 985           if md.first_write_chan = 0 then md.last_write_chan = 0;
 986           mde.next_write_chan = 0;
 987           mde.write_queued = "0"b;
 988 
 989 write_join: md.write_chain_ptr = mde.write_chain_ptr;       /* Pick up data from channel */
 990           mde.write_chain_ptr = null ();
 991           md.cur_write_chan = subchan;
 992           md.eot_sent = "0"b;
 993           md.output_in_progress = "1"b;
 994           md.message_in_progress = "1"b;
 995 
 996           call select;
 997           call send_more_message;
 998 
 999           mdep = null ();
1000           return;
1001 
1002      end process_write;
1003 %page;
1004 /* Procedure to send the next piece of the current output chain down the pike */
1005 
1006 send_more_message: proc;
1007 
1008 dcl  p ptr;
1009 
1010           if ^md.send_output then return;                   /* Dont have permission */
1011           if md.write_chain_ptr ^= null () then do;         /* Have a chain */
1012                p = md.write_chain_ptr;
1013 send_chain:    call channel_manager$write (md.devx, p, code);
1014                if code ^= 0 then do;
1015                     if code ^= et_noalloc then go to write_fails;
1016                     md.needs_space = md.needs_space + 1;
1017                     call tty_space_man$needs_space (md.devx);
1018                     return;
1019                end;
1020                md.send_output = "0"b;
1021                md.write_chain_ptr = p;                      /* Remember whats left */
1022                return;
1023           end;
1024 
1025           if ^md.eot_sent then do;                          /* Still must send an eot */
1026                call tty_space_man$get_buffer (md.devx, 16, OUTPUT, blockp);
1027                if blockp = null () then do;
1028                     md.needs_space = md.needs_space + 1;
1029                     call tty_space_man$needs_space (md.devx);
1030                     return;
1031                end;
1032                buffer.tally = 1;
1033                buffer.chars (0) = md.eot;
1034                p = blockp;
1035                md.eot_sent = "1"b;
1036                go to send_chain;
1037           end;
1038 
1039           md.message_in_progress = "0"b;
1040           return;
1041 
1042 write_fails: return;                                        /* Probably a crash coming soon */
1043 
1044      end send_more_message;
1045 %page;
1046 /* Build write header in current buffer */
1047 
1048 build_header: proc;
1049 
1050           buffer.chars (0) = md.stx;
1051           buffer.chars (1) = md.esc;
1052           if mde.erase_req then buffer.chars (2) = md.erase_write;
1053           else buffer.chars (2) = md.write;                 /* Write function */
1054           mde.erase_req = "0"b;
1055           string (wcc) = "0"b;                              /* No special functions */
1056           wcc.keyboard_restore = mde.keyboard_restore;
1057           mde.keyboard_restore = "0"b;
1058           wcc.sound_alarm = mde.sound_alarm;
1059           mde.sound_alarm = "0"b;
1060           wcc.start_printer = mde.printer;
1061           buffer.chars (3) = address_table (bin (string (wcc)));
1062           buffer.chars (4) = md.sba;                        /* Position cursor where I think i should be */
1063           call get_position_chars (mde.position);
1064           buffer.chars (5) = pos_char1;
1065           buffer.chars (6) = pos_char2;
1066           buffer.tally = 7;
1067 
1068           return;
1069 
1070      end build_header;
1071 %page;
1072 /* Procedure to process input once it has arrived in its entirity */
1073 
1074 process_input: proc;
1075 
1076 dcl  delta_position fixed bin;
1077 dcl  save_bit bit (1);
1078 
1079           if md.input_chain_ptr = null () then return;
1080           chain_ptr = md.input_chain_ptr;
1081           md.input_chain_ptr = null ();
1082           blockp = chain_ptr;
1083           textp = addr (buffer.chars);
1084           textl = buffer.tally;
1085 
1086           dev_addr = getbin (text_msg.device_address);
1087           if dev_addr < lbound (md.chan_map, 1) | dev_addr > hbound (md.chan_map, 1) then go to bad_dev_addr;
1088           subchan = md.chan_map (dev_addr);
1089           if subchan <= 0 then go to bad_device;            /* Address wasn't configured */
1090           mdep = addr (md.mde_entry (subchan));
1091 
1092           if ^mde.dialed then do;                           /* Iirst input */
1093                if mde.listen & md.started then do;          /* And we are accepting dials */
1094                     mde.erase_req = "1"b;
1095                     call dialup_channel;
1096                end;
1097                go to discard_input;
1098           end;
1099 
1100           if textl < 5 then go to bad_input;
1101 
1102           if text_msg.aid = md.quit_key then do;            /* Function code for quit */
1103                if mde.raw3270_in_effect & ^mde.hndlquit then go to send_raw_input;
1104                save_bit = mde.end_of_page;
1105                mde.end_of_page = "0"b;
1106                if save_bit then do;
1107                     mde.position = 0;
1108                     mde.erase_req = "1"b;
1109                end;
1110                call channel_manager$interrupt (mde.devx, QUIT, "0"b);
1111                if mde.hndlquit then if mde.write_chain_ptr ^= null () then do;
1112                          call reset_channel;
1113                          save_bit = "0"b;
1114                     end;
1115                if save_bit then call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
1116                go to discard_input;
1117           end;
1118 
1119           if mde.raw3270_in_effect then go to send_raw_input;
1120           if text_msg.aid = md.formfeed_key then do;        /* Function for ff for new page */
1121                mde.erase_req, mde.keyboard_restore = "1"b;
1122                mde.position = 0;
1123                call queue_control;
1124                if mde.end_of_page then do;
1125                     mde.end_of_page = "0"b;
1126                     call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
1127                end;
1128                else do;
1129                     unspec (rtx_info) = "0"b;
1130                     rtx_info.formfeed_present = "1"b;
1131                     call channel_manager$interrupt (mde.devx, ACCEPT_INPUT, unspec (rtx_info));
1132                end;
1133                go to discard_input;
1134           end;
1135 
1136           if text_msg.aid ^= md.enter then go to discard_input;
1137           if textl < 7 then go to bad_input;
1138           position = get_position (text_msg.cursor1, text_msg.cursor2);
1139 
1140           delta_position = position - mde.position;         /* Amount cursor moved */
1141           if (delta_position > (md.input_count - 7)) | (delta_position < 0) then do; /* Cant parse it */
1142                mde.position = position;
1143                mde.sound_alarm = "1"b;
1144                mde.keyboard_restore = "1"b;
1145                call queue_control;
1146                go to discard_input;
1147           end;
1148 
1149           call trim_chain_start (chain_ptr, md.input_count - (delta_position + 1)); /* Throw away leading junk */
1150           do blockp = chain_ptr repeat (ptr (ttybp, buffer.next)) while (buffer.next ^= 0);
1151           end;                                              /* Find end */
1152           buffer.chars (buffer.tally - 1) = md.nl;          /* Put new-line at end */
1153 
1154           unspec (rtx_info) = "0"b;
1155           rtx_info.chain_head = rel (chain_ptr);
1156           rtx_info.chain_tail = rel (blockp);
1157           rtx_info.input_count = delta_position + 1;
1158           rtx_info.break_char = "1"b;
1159           mde.position = mod (position - mod (position, mde.line_size) + mde.line_size, mde.screen_size);
1160           call channel_manager$interrupt (mde.devx, ACCEPT_INPUT, unspec (rtx_info));
1161           return;
1162 
1163 /* Here in raw mode to foward stuff */
1164 
1165 send_raw_input:
1166           do blockp = chain_ptr repeat (ptr (ttybp, buffer.next)) while (buffer.next ^= 0);
1167           end;                                              /* Find end of chain */
1168           unspec (rtx_info) = "0"b;
1169           rtx_info.chain_head = rel (chain_ptr);
1170           rtx_info.chain_tail = rel (blockp);
1171           rtx_info.input_count = md.input_count;
1172           rtx_info.break_char = "1"b;
1173           call channel_manager$interrupt (mde.devx, ACCEPT_INPUT, unspec (rtx_info));
1174           return;
1175 
1176      end process_input;
1177 %page;
1178 /* Procedure to trim a specified number of characters off start of chain */
1179 
1180 trim_chain_start: proc (p, arg_n);
1181 
1182 dcl  p ptr;
1183 dcl  arg_n fixed bin;
1184 
1185 dcl  q ptr;
1186 dcl  n fixed bin;
1187 dcl  textp ptr;
1188 dcl  textl fixed bin;
1189 dcl  text char (textl) based (textp);
1190 
1191           n = arg_n;
1192           do while (n > 0);
1193                if p -> buffer.tally <= n then do;
1194                     q = p;
1195                     n = n - p -> buffer.tally;
1196                     if p -> buffer.next = 0 then if n > 0 then
1197                               go to trim_failure;           /* More than in chain */
1198                          else p = null ();                  /* Exactly size of chain */
1199                     else p = ptr (ttybp, p -> buffer.next);
1200                     call tty_space_man$free_buffer (md.devx, INPUT, q);
1201                end;
1202                else do;
1203                     textp = addr (p -> buffer.chars);
1204                     textl = p -> buffer.tally;
1205                     text = substr (text, n + 1);
1206                     p -> buffer.tally = p -> buffer.tally - n;
1207                     n = 0;
1208                end;
1209           end;
1210 
1211           return;
1212 
1213      end trim_chain_start;
1214 %page;
1215 /* Trim characters from end of buffer chain */
1216 
1217 trim_chain_end: proc (arg_p, arg_n);
1218 
1219 dcl  arg_p ptr;
1220 dcl  arg_n fixed bin;
1221 
1222 dcl  p ptr;
1223 dcl  n fixed bin;
1224 dcl  q ptr;
1225 
1226           n = arg_n;
1227           do while (n > 0);
1228                q = null ();
1229                p = arg_p;
1230                do while (p -> buffer.next ^= 0);
1231                     q = p;
1232                     p = ptr (ttybp, p -> buffer.next);
1233                end;
1234                if n < p -> buffer.tally then do;
1235                     p -> buffer.tally = p -> buffer.tally - n;
1236                     n = 0;
1237                end;
1238                else do;
1239                     n = n - p -> buffer.tally;
1240                     if q ^= null () then q -> buffer.next = 0;
1241                     else if n > 0 then go to trim_failure;
1242                     else arg_p = null ();
1243                     call tty_space_man$free_buffer (md.devx, INPUT, p);
1244                end;
1245           end;
1246           return;
1247 
1248      end trim_chain_end;
1249 
1250 trim_failure:
1251           call syserr (SYSERR_CRASH_SYSTEM, "^a: Error trimming buffer chain for ^a", name, md.name);
1252           go to trim_failure;
1253 %page;
1254 /* Queue a poll request */
1255 
1256 queue_poll: proc;
1257 
1258 dcl  p ptr;
1259 
1260           if md.first_poll_chan = 0 then do;
1261                md.first_poll_chan = subchan;
1262                md.last_poll_chan = subchan;
1263           end;
1264           else do;
1265                p = addr (md.mde_entry (md.last_poll_chan));
1266                p -> mde.next_poll_chan = subchan;
1267                md.last_poll_chan = subchan;
1268           end;
1269           mde.next_poll_chan = 0;
1270           return;
1271 
1272      end queue_poll;
1273 
1274 process_polls: proc;
1275 
1276           if md.output_in_progress then return;
1277           if md.poll_in_progress then return;
1278           if md.first_poll_chan ^= 0 then do;
1279                subchan = md.first_poll_chan;
1280                mdep = addr (md.mde_entry (subchan));
1281                md.first_poll_chan = mde.next_poll_chan;
1282                if md.first_poll_chan = 0 then md.last_poll_chan = 0;
1283                md.poll_in_progress = "1"b;
1284                call poll;
1285                return;
1286           end;
1287 
1288           if md.first_write_chan = 0 then call general_poll;
1289           return;
1290 
1291      end process_polls;
1292 %page;
1293 /* Internal procedure to handle poll/select addressing and initiation */
1294 
1295 poll: proc;
1296 
1297 dcl  auto_poll fixed bin init (0);
1298 dcl  cont char (1);                                         /* Controller */
1299 dcl  dev char (1);                                          /* The device */
1300 
1301           dev = mde.device_address;
1302 poll_join:
1303           line_ctl.op = SET_POLLING_ADDR;
1304           cont = md.controller_poll_address;
1305 
1306           if dev ^= md.last_poll_address then do;
1307                md.last_poll_address = dev;
1308 select_join:   line_ctl.val = 0;
1309                valchar.data_len = 4;
1310                substr (valchar.data, 1, 1) = cont;
1311                substr (valchar.data, 2, 1) = cont;
1312                substr (valchar.data, 3, 1) = dev;
1313                substr (valchar.data, 4, 1) = dev;
1314                call channel_manager$control (md.devx, "line_control", addr (line_ctl), code);
1315           end;
1316 
1317           if line_ctl.op = SET_POLLING_ADDR then do;
1318                line_ctl.op = START_POLL;
1319                line_ctl.val = 0;
1320                line_ctl.val (1) = auto_poll;
1321                call channel_manager$control (md.devx, "line_control", addr (line_ctl), code);
1322           end;
1323           return;
1324 
1325 general_poll: entry;
1326 
1327           dev = md.general_poll_address;
1328           auto_poll = 1;
1329           go to poll_join;
1330 
1331 select: entry;
1332 
1333           dev = mde.device_address;
1334           if dev = md.last_select_address then return;
1335           md.last_select_address = dev;
1336           cont = md.controller_select_address;
1337           line_ctl.op = SET_SELECT_ADDR;
1338           go to select_join;
1339 
1340      end poll;
1341 %page;
1342 /* Handle control function queue */
1343 
1344 queue_control: proc;
1345 
1346 dcl  p ptr;
1347 
1348           if mde.control_queued then return;
1349           if md.first_control_chan = 0 then do;
1350                md.first_control_chan = subchan;
1351                md.last_control_chan = subchan;
1352           end;
1353           else do;
1354                p = addr (md.mde_entry (md.last_control_chan));
1355                p -> mde.next_control_chan = subchan;
1356                md.last_control_chan = subchan;
1357           end;
1358           mde.next_control_chan = 0;
1359           mde.control_queued = "1"b;
1360           return;
1361 
1362      end queue_control;
1363 %page;
1364 /* Setup message to perform control operation on the next channel */
1365 
1366 setup_control_chan: proc;
1367 
1368 dcl  prev_subchan fixed bin;
1369 dcl  p ptr;
1370 
1371           prev_subchan = 0;
1372           subchan = md.first_control_chan;
1373 search_control_queue:
1374           if subchan = 0 then do;
1375                mdep = null ();
1376                return;
1377           end;
1378           mdep = addr (md.mde_entry (subchan));
1379           if mde.write_chain_ptr ^= null () then do;        /* Must finish output first */
1380                prev_subchan = subchan;
1381                subchan = mde.next_control_chan;
1382                go to search_control_queue;
1383           end;
1384 
1385           call tty_space_man$get_buffer (mde.devx, 16, OUTPUT, blockp); /* To build msg */
1386           if blockp = null () then do;
1387                md.needs_space = md.needs_space + 1;
1388                call tty_space_man$needs_space (md.devx);
1389                mdep = null ();
1390                return;
1391           end;
1392 
1393           if prev_subchan = 0 then do;                      /* We were first in queue */
1394                md.first_control_chan = mde.next_control_chan;
1395                if md.first_control_chan = 0 then md.last_control_chan = 0;
1396           end;
1397           else do;
1398                p = addr (md.mde_entry (prev_subchan));
1399                p -> mde.next_control_chan = mde.next_control_chan;
1400                if md.last_control_chan = subchan then md.last_control_chan = prev_subchan;
1401           end;
1402           mde.next_control_chan = 0;
1403           mde.control_queued = "0"b;
1404 
1405           call build_header;                                /* Build header with kybd restore */
1406           call check_buffer_tally (2);
1407           buffer.chars (buffer.tally) = md.ic;              /* Insert cursor */
1408           buffer.chars (buffer.tally + 1) = md.etx;         /* Finish msg */
1409           buffer.tally = buffer.tally + 2;
1410           mde.write_chain_ptr = blockp;                     /* Write this chain */
1411           return;
1412 
1413      end setup_control_chan;
1414 %page;
1415 /* Internal procedure to crash the multiplexer */
1416 
1417 crash_mpx: proc;
1418 
1419 dcl  loaded bit (1);
1420 
1421           loaded = md.loaded;
1422           md.loaded, md.loading = "0"b;
1423 
1424           if loaded then do subchan = 1 to md.nchan;        /* Was loaded at time of crash */
1425                mdep = addr (md.mde_entry (subchan));
1426                mde.listen, mde.dialed = "0"b;
1427                call reset_channel;
1428                call channel_manager$interrupt (mde.devx, CRASH, "0"b);
1429           end;
1430 
1431           return;
1432 
1433      end crash_mpx;
1434 
1435 dialup_channel: proc;
1436 
1437           mde.position = 0;
1438           if ^mde.printer then do;
1439                mde.erase_req = "1"b;
1440                call queue_control;
1441           end;
1442           unspec (dialup_info) = "0"b;
1443           dialup_info.line_type = md.line_type;
1444           dialup_info.baud_rate = md.baud_rate;
1445           dialup_info.max_buf_size = md.max_buf_size;
1446           dialup_info.buffer_pad = md.buffer_pad + 4;
1447           dialup_info.receive_mode_device = ^mde.printer;
1448           call channel_manager$interrupt (mde.devx, DIALUP, unspec (dialup_info));
1449           mde.dialed = "1"b;
1450           call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
1451           return;
1452 
1453      end dialup_channel;
1454 
1455 reset_channel: proc;
1456 
1457 dcl  (p, q) ptr;
1458 dcl  loop_count fixed bin;
1459 dcl  save_subchan fixed bin;
1460 
1461           if mde.write_chain_ptr = null () then return;
1462           p = mde.write_chain_ptr;
1463           mde.write_chain_ptr = null ();
1464           call tty_space_man$free_chain (mde.devx, OUTPUT, p);
1465           if ^mde.write_queued then return;
1466           if md.first_write_chan = 0 then goto reset_channel_failed; /* Wonder where the write went */
1467           if md.first_write_chan = subchan then do;         /* First in chain */
1468                md.first_write_chan = mde.next_write_chan;
1469                if md.first_write_chan = 0 then md.last_write_chan = 0;
1470           end;
1471           else do;
1472                loop_count = 0;
1473                q = addr (md.mde_entry (md.first_write_chan)); /* Find channel before this one */
1474                save_subchan = md.first_write_chan;
1475                do while (q -> mde.next_write_chan ^= subchan);
1476                     save_subchan = q -> mde.next_write_chan;
1477                     q = addr (md.mde_entry (q -> mde.next_write_chan));
1478                                                             /* Make sure we are not looping */
1479                     if loop_count > md.nchan | save_subchan = 0 then goto reset_channel_failed;
1480                     loop_count = loop_count + 1;
1481                end;
1482                q -> mde.next_write_chan = mde.next_write_chan;
1483                if subchan = md.last_write_chan then md.last_write_chan = save_subchan;
1484           end;
1485 reset_channel_restart:
1486           mde.next_write_chan = 0;
1487           mde.write_queued = "0"b;
1488           mde.end_of_page = "0"b;
1489           if ^md.loaded | ^mde.dialed then return;
1490           call channel_manager$interrupt (mde.devx, SEND_OUTPUT, "0"b);
1491           return;
1492 
1493 reset_channel_failed:
1494 
1495           call syserr (BEEP, "^a: Could not find queued write on ^a.", name, md.name);
1496           goto reset_channel_restart;
1497 
1498 
1499      end reset_channel;
1500 
1501 /* Test the current buffer for room for additional characters */
1502 
1503 check_buffer_tally: proc (n);
1504 
1505 dcl  n fixed bin;
1506 
1507           if (buffer.tally + n) > (max_buffer_tally (buffer.size_code) - md.buffer_pad) then
1508                call syserr (SYSERR_CRASH_SYSTEM, "^a: Buffer tally error on ^a.", name, md.name);
1509           else return;
1510 
1511      end check_buffer_tally;
1512 %page;
1513 /* This entry is called when mpx_data is being built to set the address of the translation table */
1514 /* This is necessary because the actual data is in the text of this module, but is used by priv_ibm3270_mpx */
1515 
1516 set_address_table: entry (arg_mdp);
1517 
1518           mdp = arg_mdp;
1519           if md.ascii then md.address_tablep = addr (ascii_address_table);
1520           else md.address_tablep = addr (ebcdic_address_table);
1521           return;
1522 
1523 /* Initialization entry. Called by priv_ibm3270_mpx once per Multics bootload
1524    the first time an ibm3270 multiplexer is initialized. */
1525 
1526 init: entry;
1527 
1528           et_undefined_order_request = error_table_$undefined_order_request;
1529           et_improper_data_format = error_table_$improper_data_format;
1530           et_noalloc = error_table_$noalloc;
1531           et_bad_mode = error_table_$bad_mode;
1532 
1533           call wire_proc$wire_me;
1534           return;
1535 
1536 /* Entry to dialup a subchannel */
1537 
1538 dialup: entry (arg_mdp, arg_subchan);
1539 
1540           mdp = arg_mdp;
1541           subchan = arg_subchan;
1542           mdep = addr (md.mde_entry (subchan));
1543           call dialup_channel;
1544           return;
1545 
1546 /* Entry called at bootload time to kick off general polling */
1547 
1548 start_general_poll: entry (arg_mdp);
1549 
1550           mdp = arg_mdp;
1551           mdep = null ();                                   /* A precaution */
1552           call general_poll;
1553           return;
1554 
1555 /* Entry to crash the multiplexer */
1556 
1557 crash: entry (arg_mdp);
1558 
1559           mdp = arg_mdp;
1560           call crash_mpx;
1561           return;
1562 %page;
1563 /* BEGIN MESSAGE DOCUMENTATION
1564 
1565    Message:
1566    ibm3270_mpx: Unrecognized interrupt for CHANNEL. INT_TYPE INTERRUPT_INFO
1567 
1568    S:     $info
1569 
1570    T:     $run
1571 
1572    M:     An interrupt was received from the FNP which does not have a defined
1573    action.  The type of interrupt received is INT_TYPE and the information
1574    supplied with the interrupt is INTERRUPT_INFO.
1575 
1576    A:     $inform
1577 
1578    Message:
1579    ibm3270_mpx: Unrecognized input for CHANNEL: DATA
1580 
1581    S:     $info
1582 
1583    T:     $run
1584 
1585    M:     DATA received from CHANNEL does not meet certain format requirements.
1586    This message is only displayed if in debug mode.
1587 
1588    A:     $inform
1589 
1590    Message:
1591    ibm3270_mpx: Input for illegal device address DEV_ADDRESS on CHANNEL
1592 
1593    S:     $info
1594 
1595    T:     $run
1596 
1597    M:     Received input for a device whose address (DEV_ADDRESS) is not in the
1598    channel map for CHANNEL.
1599 
1600    A:     $inform
1601 
1602    Message:
1603    ibm3270_mpx: Input for unconfigured device DEV_ADDRESS on CHANNEL
1604 
1605    S:     $info
1606 
1607    T:     $run
1608 
1609    M:     Received input for a device (DEV_ADDRESS) whose subchannel was
1610    <= 0 in the channel map for CHANNEL.
1611 
1612    A:     $inform
1613 
1614    Message:
1615    ibm3270_mpx: Attempt to queue write while write queued CHANNEL.SUBCHANNEL
1616 
1617    S:     $log
1618 
1619    T:     $run
1620 
1621    M:     An attempt was made to queue a write while a previous write was still
1622    queued.  A dump of the subchannel entry as defined by the mde structure in
1623    ibm3270_mpx_data.incl.pl1 is included with this message.
1624 
1625    A:     $ignore
1626 
1627    Message:
1628    ibm3270_mpx: Error trimming buffer chain for CHANNEL
1629 
1630    S:     $crash
1631 
1632    T:     $run
1633 
1634    M:     An inconsistency was found while trimming the buffer chain for
1635    CHANNEL which is stored in tty_buf.
1636 
1637    A:     $inform
1638 
1639    Message:
1640    ibm3270_mpx: Could not find queued write on CHANNEL.
1641 
1642    S:     $beep
1643 
1644    T:     $run
1645 
1646    M:     The reset_channel internal procedure could not find a queued write on
1647    CHANNEL or it detected itself looping in releasing queued writes for
1648    CHANNEL.  Will attempt to continue.
1649 
1650    A:     $inform
1651 
1652    Message:
1653    ibm3270_mpx: Buffer tally error on CHANNEL.
1654 
1655    S:     $crash
1656 
1657    T:     $run
1658 
1659    M:     An attempt was made to add characters to a buffer which should have
1660    fit but couldn't.
1661 
1662    A:     $inform
1663 
1664    END MESSAGE DOCUMENTATION */
1665 
1666 %page;
1667 %include tty_buf;
1668 %page;
1669 %include mcs_interrupt_info;
1670 %page;
1671 %include channel_manager_dcls;
1672 %page;
1673 %include tty_space_man_dcls;
1674 %page;
1675 %include tty_buffer_block;
1676 %page;
1677 %include mcs_modes_change_list;
1678 %page;
1679 %include bisync_line_data;
1680 %page;
1681 %include ibm3270_mpx_load_data;
1682 %page;
1683 %include ibm3270_mpx_data;
1684 %page;
1685 %include ibm3270_meters;
1686 %page;
1687 %include syserr_binary_def;
1688 
1689      end ibm3270_mpx;
1690