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 /* HASP multiplexer:  This multiplexer processes most of the HASP RJE protocol in either host or workstation mode.
  14    This multiplexer expects data from the user ring to be already compressed and converted to EBCDIC.
  15    This procedure implements the non-privileged entries of the multiplexer; it may be invoked at interrupt time
  16    and must be wired.
  17    */
  18 
  19 /* Created:  October 1979 by G. Palter */
  20 /* Modified: 15 October 1980 by G. Palter to correct bug which can cause null pointer reference at interrupt time, to
  21                 always accept input for configured devices, and to re-enable tracing code */
  22 /* Modified: 25 November 1980 by G. Palter to use channel_manager$interrupt_later */
  23 /* Modified: December 1980 by G. Palter to fix the "loopback bug" */
  24 /* Modified: 9 January 1981 by G. Palter to correct bug which causes a system crash when a block received out of sequence
  25                is to be ignored */
  26 /* Modified: 11 January 1981 by G. Palter to correct bug where detecting a partial output record would take precedence
  27                 over detecting an output record which exceeds the maximum block size for the multiplexer */
  28 /* Modified: 30 March 1981 by G. Palter to trap duplicate loopback blocks (possibly permanently) */
  29 /* Modified: 2 April 1981 by G. Palter to properly handle space restrictions during input and loopback processing, to
  30                 transmit a status block if necessary after a resetread, and to correct problems with the interface to
  31                 tty_space_man$needs_space */
  32 /* Modified: 16 April 1981 by G. Palter to support rts_mode, to not set off the beeper when calling syserr, and to add
  33                   message documentation */
  34 /* Modified: July 1981 by G. Palter to complete SIGNON record processing and implement multiplexer metering */
  35 /* Modified: 25 August 1981 by G. Palter to correct bugs in wraparound processing (formerlly called loopback) */
  36 /* Modified: 5 February 1982 by G. Palter to always acknowledge requests to send input to a configured device */
  37 /* Modified: 11 August 1982 by G. Palter to correct the bug in classify_record that would cause it to reference beyond the
  38                 end of a buffer when called from move_record_to_output_block to classify the record just added when the
  39                 previous record in the block completely filled a buffer */
  40 /* Modified: August 1982 by Robert Coren to handle "MASKED" interrupt */
  41 /* Modified: February 1984 by G. Palter as part of the correct implementation of the system wait-a-bit */
  42 /* Modified: August 1984 by G. Palter to fix HASP error #0013 -- hasp_mpx frees the individual buffers of a record when
  43       the buffer's data is copied into the output block under construction.  If there isn't sufficient space in tty_buf to
  44       grow the output block, hasp_mpx will abort writing the record and return to its caller (channel_manager$write) while
  45       indicating that the record in question has not yet been written.  However, some of the buffers which comprised the
  46       record may have been freed.  As a result, when space in tty_buf is available and the write operation is retried,
  47       hasp_mpx will be asked to process the original buffers of the record which are now either on the free chain or in
  48       use by another channel.  In either case, the system will eventually crash with the message
  49            tty_space_man:  Attempt to free space already freed */
  50 /* Modified: December 1984 by G. Palter to fix HASP error #0015 -- If the first buffer of an input block from the FNP
  51       contains only a single character, hasp_mpx will either take a fault while on the PRDS or move 262143 characters of
  52       tty_buf one halfword to the "left".  In either case, the system will crash */
  53 
  54 
  55 /* Missing features and further design issues to be resolved:
  56 
  57    o Change input block processing to allow (1) blocks to be split across ACCEPT INPUT interrupts or calls to
  58      channel_manager$read, and (2) multiple blocks to be returned by a single interrupt or read call.
  59 
  60    o Timeout mechanism to wait for acknowldegement of RTS records?
  61    */
  62 
  63 
  64 hasp_mpx:
  65      procedure ();
  66 
  67           return;                                           /* not an entrypoint */
  68 
  69 
  70 /* Parameters */
  71 
  72 dcl  P_hmd_ptr pointer parameter;                           /* -> multiplexer data for this channel */
  73 dcl  P_subchannel_idx fixed binary parameter;               /* index of specific sub-channel referenced by this call */
  74 dcl  P_code fixed binary (35) parameter;                    /* status code */
  75 
  76 dcl  P_chain_ptr pointer parameter;                         /* read, write:  chain of buffers */
  77 
  78 dcl  P_more_input bit (1) aligned parameter;                /* read:  set ON => more input for sub-channel is available */
  79 
  80 dcl  P_interrupt_type fixed binary parameter;               /* interrupt:  type of interrupt encountered */
  81 dcl  P_interrupt_data bit (72) aligned parameter;           /* interrupt:  data associated with this interrupt (if any) */
  82 
  83 dcl  P_order character (*) parameter;                       /* control:  order to be executed */
  84 dcl  P_info_ptr pointer parameter;                          /* control:  -> additional data for this control order */
  85 
  86 dcl  P_mclp pointer parameter;                              /* check_modes, set_modes:  -> modes to check/set */
  87 
  88 dcl  P_modes character (*) parameter;                       /* get_modes:  set to modes in effect for sub-channel */
  89 
  90 
  91 /* Local copies of parameters (not in include files) */
  92 
  93 dcl  subchannel_idx fixed binary;
  94 dcl  code fixed binary (35);
  95 
  96 dcl  chain_ptr pointer;
  97 
  98 dcl  interrupt_type fixed binary;
  99 dcl  interrupt_data bit (72) aligned;
 100 
 101 dcl  order character (32);
 102 dcl  info_ptr pointer;
 103 
 104 
 105 /* Remaining declarations */
 106 
 107 dcl  ttybp pointer;                                         /* -> tty_buf$ */
 108 
 109 dcl 1 based_block_header unaligned based like TEMPLATE_HASP_BLOCK_HEADER;
 110 dcl 1 based_block_trailer unaligned based like TEMPLATE_HASP_BLOCK_TRAILER;
 111 
 112 dcl 1 based_signon_block unaligned based like TEMPLATE_HASP_SIGNON_BLOCK;
 113 
 114 dcl 1 based_bad_bcb_block unaligned based like TEMPLATE_HASP_BAD_BCB_BLOCK;
 115 dcl 1 based_bad_bcb_record unaligned based like TEMPLATE_HASP_BAD_BCB_RECORD;
 116 
 117 dcl 1 based_sync_block unaligned based like TEMPLATE_HASP_SYNC_BLOCK;
 118 
 119 dcl 1 based_rts_record unaligned based like TEMPLATE_HASP_RTS_RECORD;
 120 dcl 1 based_rts_ack_record unaligned based like TEMPLATE_HASP_RTS_ACK_RECORD;
 121 
 122 dcl  needs_space bit (1) aligned;                           /* ON => some processing required more space than available */
 123 
 124 dcl  partial_record bit (1) aligned;                        /* ON => output processing terminated when an incomplete
 125                                                                record was found in output chain; wakeup must be sent
 126                                                                to user ring */
 127 
 128 dcl  long_record bit (1) aligned;                           /* ON => output processing terminated when a record was found
 129                                                                which is simply too large to ever fit into output block */
 130 
 131 dcl  previously_scanned_bufferp pointer;                    /* used by scan_input_records:  -> buffer before last buffer
 132                                                                of a record */
 133 dcl  last_bufferp pointer;
 134 
 135 dcl 1 abort_info aligned based (info_ptr),                  /* data structure for "abort" control order */
 136     2 resetwrite bit (1) unaligned,
 137     2 resetread bit (1) unaligned;
 138 
 139 dcl 1 write_status_info aligned based (info_ptr),           /* data structure for "write_status" control order */
 140     2 event_channel fixed binary (71),
 141     2 output_pending bit (1);
 142 
 143 dcl  get_device_type_info fixed binary based (info_ptr);    /* device type returned by "get_device_type" control order */
 144 
 145 dcl 1 sri aligned based (info_ptr) like signon_record_info; /* data structure for "signon_record" order */
 146 
 147 dcl  idx fixed binary;
 148 
 149 dcl  NUL character (1) static options (constant) initial ("^@");   /* EBCDIC NUL character ("000"b3) */
 150 dcl  DLE character (1) static options (constant) initial ("^P");   /* EBCDIC DLE character ("020"b3) */
 151 
 152 dcl (LOG_AND_PRINT  initial (0),                            /* log message and print it on console */
 153      LOG_ONLY       initial (5))                            /* log message or throw it away */
 154           fixed binary static options (constant);
 155 
 156 dcl (et_action_not_performed, et_bad_mode, et_incorrect_device_type, et_invalid_read, et_invalid_state, et_invalid_write,
 157      et_long_record, et_noalloc, et_null_info_ptr, et_out_of_sequence, et_undefined_order_request,
 158      et_unimplemented_version)
 159           fixed binary (35) static;                         /* local copies so no page faults during interrupts, etc. */
 160 
 161 dcl  pds$process_id bit (36) aligned external;
 162 
 163 dcl  tty_buf$ bit (36) aligned external;                    /* MCS data buffer segment */
 164 
 165 dcl (error_table_$action_not_performed, error_table_$bad_mode, error_table_$incorrect_device_type,
 166      error_table_$invalid_read, error_table_$invalid_state, error_table_$invalid_write, error_table_$long_record,
 167      error_table_$noalloc, error_table_$null_info_ptr, error_table_$out_of_sequence, error_table_$undefined_order_request,
 168      error_table_$unimplemented_version)
 169           fixed binary (35) external;
 170 
 171 dcl  mcs_trace entry () options (variable);
 172 dcl  mcs_trace$buffer_chain entry (fixed binary, pointer);
 173 dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed binary (71), fixed binary (71), fixed binary (35));
 174 dcl  syserr entry () options (variable);
 175 dcl  wire_proc$wire_me entry ();
 176 
 177 dcl (addr, binary, clock, copy, currentsize, divide, hbound, index, lbound, length, min, mod, null, pointer, rel, size,
 178      string, substr, unspec)
 179           builtin;
 180 %page;
 181 /* Once per bootload initialization:  called from priv_hasp_mpx */
 182 
 183 system_initialize:
 184      entry ();
 185 
 186           et_action_not_performed = error_table_$action_not_performed;
 187           et_bad_mode = error_table_$bad_mode;
 188           et_incorrect_device_type = error_table_$incorrect_device_type;
 189           et_invalid_read = error_table_$invalid_read;
 190           et_invalid_state = error_table_$invalid_state;
 191           et_invalid_write = error_table_$invalid_write;
 192           et_long_record = error_table_$long_record;
 193           et_noalloc = error_table_$noalloc;
 194           et_null_info_ptr = error_table_$null_info_ptr;
 195           et_out_of_sequence = error_table_$out_of_sequence;
 196           et_undefined_order_request = error_table_$undefined_order_request;
 197           et_unimplemented_version = error_table_$unimplemented_version;
 198 
 199           call wire_proc$wire_me ();                        /* Doctor Memory */
 200 
 201           return;
 202 
 203 
 204 
 205 /* Dialup a sub-channel:  called from priv_hasp_mpx */
 206 
 207 dialup:
 208      entry (P_hmd_ptr, P_subchannel_idx);
 209 
 210           hmd_ptr = P_hmd_ptr;
 211           subchannel_idx = P_subchannel_idx;
 212           hste_ptr = addr (hmd.subchannels (subchannel_idx));
 213 
 214           call signal_dialup ();
 215 
 216           return;
 217 
 218 
 219 
 220 /* Crash the multiplexer:  called from priv_hasp_mpx */
 221 
 222 crash:
 223      entry (P_hmd_ptr);
 224 
 225           ttybp = addr (tty_buf$);
 226           hmd_ptr = P_hmd_ptr;
 227 
 228           call crash_mpx ();
 229 
 230           return;
 231 
 232 
 233 ERROR_RETURN:
 234           P_code = code;
 235           return;
 236 %page;
 237 /* Read input from a specified sub-channel:  return one complete HASP record if available */
 238 
 239 read:
 240      entry (P_hmd_ptr, P_subchannel_idx, P_chain_ptr, P_more_input, P_code);
 241 
 242           ttybp = addr (tty_buf$);
 243           call setup_subchannel ();
 244           P_chain_ptr = null ();                            /* setup for error returns */
 245           P_more_input = "0"b;
 246           P_code = 0;                                       /* assume success */
 247 
 248           if hste.state ^= HSTE_DIALED then                 /* not if channel isn't dialed up */
 249                return;
 250 
 251           if hste.direction = HSTE_OUTPUT_ONLY then do;     /* can't read from this device */
 252                P_code = et_invalid_read;
 253                return;
 254           end;
 255 
 256 
 257 /* Check for available input */
 258 
 259           if hmd.flags.input_available then                 /* something is waiting for us */
 260                call process_available_input_blocks ();
 261 
 262           if (hmd.input.first_bufferp ^= null ()) then      /* some records are waiting to be processed */
 263                call process_input_records ();
 264 
 265           if hste.input.first_bufferp = null () then do;    /* still no input for this sub-channel */
 266                hste.requested_input = "1"b;                 /* request an interrupt when something is available */
 267                go to RETURN_FROM_READ_CALL;
 268           end;
 269 
 270 
 271 /* Input exits:  return the first record and permit more input if the number of records being held is small enough */
 272 
 273           P_chain_ptr = hste.input.first_bufferp;
 274 
 275           last_bufferp = null ();                           /* until the last buffer of the record is found */
 276           do blockp = hste.input.first_bufferp repeat (pointer (ttybp, buffer.next)) while (last_bufferp = null ());
 277                if (buffer.next = 0) | buffer.break then     /* last buffer or end-of-record */
 278                     last_bufferp = blockp;
 279           end;
 280 
 281           if (last_bufferp -> buffer.next = 0) then         /* no more input records after this one */
 282                hste.input.first_bufferp, hste.input.last_bufferp = null ();
 283           else do;
 284                hste.input.first_bufferp = pointer (ttybp, last_bufferp -> buffer.next);
 285                last_bufferp -> buffer.next = 0;             /* break the chain */
 286           end;
 287 
 288           hste.input.n_records = hste.input.n_records - 1;
 289 
 290           if hste.input.n_records < hmd.max_device_input_records then
 291                hmd.input_wabs (hste.device_wab_idx) = "1"b; /* OK to send more from foreign side now */
 292 
 293 
 294 /* Post-processing:  interrupt other channels waiting for input and also (if possible) send an output block if any local
 295    state changes have occured */
 296 
 297 RETURN_FROM_READ_CALL:
 298           call interrupt_subchannels_with_input ();
 299 
 300           if (hmd.minor_state = HMD_REPROCESS) then
 301                call process_loopback_records ();            /* still have some untouched loopbacked records */
 302           else call process_output_block ();
 303 
 304           return;
 305 %page;
 306 /* Write output to the specified sub-channel:  accept only completed HASP records */
 307 
 308 write:
 309      entry (P_hmd_ptr, P_subchannel_idx, P_chain_ptr, P_code);
 310 
 311           ttybp = addr (tty_buf$);                          /* for addressing buffers */
 312           call setup_subchannel ();
 313           chain_ptr = P_chain_ptr;
 314 
 315           if hste.state ^= HSTE_DIALED then do;             /* this line not in use */
 316                call tty_space_man$free_chain (hste.devx, OUTPUT, chain_ptr);
 317                P_chain_ptr = null ();
 318                P_code = 0;
 319                return;
 320           end;
 321 
 322           if hste.direction = HSTE_INPUT_ONLY then do;      /* can't write to this subchannel */
 323                call tty_space_man$free_chain (hste.devx, OUTPUT, chain_ptr);
 324                P_chain_ptr = null ();                       /* we threw the output away already */
 325                P_code = et_invalid_write;
 326                return;
 327           end;
 328 
 329           P_code = 0;                                       /* if this far, the call is guarenteed to "work" */
 330 
 331 
 332 /* Add this sub-channel to the output queue for a later SEND OUTPUT; it may be removed later */
 333 
 334           call enqueue_subchannel_for_output ();
 335 
 336 
 337 /* Determine if output is acceptable at this time from this sub-channel */
 338 
 339           if (hmd.minor_state ^= HMD_NORMAL) |              /* multiplexer isn't accepting output at the moment */
 340              hmd.suspend_all_output |                       /* foreign side has requested to stop all output */
 341              ^hmd.output_wabs (hste.device_wab_idx) |       /* this device temporarily shut down */
 342              (hste.loopback.first_bufferp ^= null ()) then  /* some loopbacked output is waiting to be sent */
 343                go to RETURN_FROM_WRITE_CALL;                /* see if there's anything to send anyway and then return */
 344 
 345 
 346 /* Splice any previously saved output to the beginning of this chain */
 347 
 348           if hste.output.first_bufferp ^= null () then do;
 349                hste.output.last_bufferp -> buffer.next = binary (rel (chain_ptr), 18, 0);
 350                P_chain_ptr,
 351                     chain_ptr = hste.output.first_bufferp;
 352                hste.output.first_bufferp, hste.output.last_bufferp = null ();
 353           end;
 354 
 355 
 356 /* Process the actual output */
 357 
 358           partial_record = "0"b;                            /* set by process_output_records if incomplete record found */
 359           long_record = "0"b;                               /* set by process_output_records if record is found which can
 360                                                                never be placed into an output block */
 361 
 362           if (hste.minor_state = HSTE_NORMAL) |
 363              (hste.device_type = HASP_CONSOLE) |
 364              ^hmd.rts_mode
 365           then do;
 366 
 367 /* Transfer records:  if the multiplexer is so configured, it never requests permission to transmit a file; if the
 368    sub-channel is the console, it never requests permission regardless of the setting of rts_mode; if the sub-channel
 369    has already been given permission to transmit the file, continue transmission until an end-of-file record is
 370    encountered */
 371 
 372                call process_output_records ();
 373                if needs_space then go to CANT_FINISH_WRITE_CALL;
 374           end;
 375 
 376 
 377           else if (hste.minor_state = HSTE_SEND_RTS) then
 378 
 379 /* Request permission:  the sub-channel has never transmitted any data or has previously transmitted an end-of-file
 380    record, ask the foreign side for permission to transfer the next file */
 381 
 382                hmd.send_rts (hste.device_wab_idx) = "1"b;   /* when there's a free output block */
 383 
 384 
 385           else if (hste.minor_state = HSTE_WAIT_RTS_ACK) then
 386                if hmd.input.first_bufferp ^= null ()
 387                then do;
 388 
 389 /* Sub-channel is waiting for permission:  if some input records are available, process them in order to check for a
 390    possible acknowledgement record; if an acknowledgement is present, begin transmitting data */
 391 
 392                     call process_input_records ();          /* process as many input records as possible */
 393                     call interrupt_subchannels_with_input ();    /* inform any waiting sub-channels while we're at it */
 394 
 395                     if hste.minor_state = HSTE_NORMAL
 396                     then do;                                /* processing the input records found the ACK record */
 397                          call process_output_records ();
 398                          if needs_space then go to CANT_FINISH_WRITE_CALL;
 399                     end;
 400                end;
 401 
 402 
 403 /* Post-processing:  if processing of output records terminated because a record was found which is too large to fit into
 404    a block, return an error indication to tty_write.  Otherwise, if an incomplete record was found in the output chain, a
 405    wakeup must be sent to the user ring to request more output; to do this, the multiplexer must hold the partial record
 406    to prevent tty_write from deciding to not send the wakeup.  For the partial record case or if the entire output chain
 407    is processed, a SEND OUTPUT interrupt will be sent; otherwise, the SEND OUTPUT interrupt will be queued to be sent at a
 408    later time */
 409 
 410           if long_record then                               /* supplied record will not fit into a block */
 411                P_code = et_long_record;
 412 
 413           else if partial_record & (chain_ptr ^= null ())
 414           then do;                                          /* partial record terminated processing */
 415 
 416                hste.output.first_bufferp = chain_ptr;
 417 
 418                do last_bufferp = hste.output.first_bufferp repeat (pointer (ttybp, last_bufferp -> buffer.next))
 419                          while (rel (last_bufferp) ^= ""b);
 420                     if (last_bufferp -> buffer.next) = 0 then hste.output.last_bufferp = last_bufferp;
 421                end;
 422 
 423                chain_ptr = null ();                         /* have now taken entire output chain */
 424           end;
 425 
 426           P_chain_ptr = chain_ptr;                          /* reflect what was processed to the caller */
 427 
 428           if chain_ptr = null () then do;                   /* took all output one way or another:  ask for more now */
 429                call dequeue_subchannel_for_output ();
 430                call channel_manager$interrupt (hste.devx, SEND_OUTPUT, ""b);
 431           end;
 432 
 433 
 434 RETURN_FROM_WRITE_CALL:
 435           if (hmd.minor_state = HMD_REPROCESS) then
 436                call process_loopback_records ();            /* still have untouched loopback records */
 437           else call process_output_block ();                          /* complete and send the block if OK */
 438 
 439           return;
 440 
 441 
 442 /* When not enough space is available to process the entire output chain, control is transfered here */
 443 
 444 CANT_FINISH_WRITE_CALL:
 445           P_chain_ptr = chain_ptr;                          /* only return still unprocessed output */
 446 
 447           call tty_space_man$needs_space (hmd.devx);
 448 
 449           return;
 450 %page;
 451 /* Process an interrupt */
 452 
 453 interrupt:
 454      entry (P_hmd_ptr, P_interrupt_type, P_interrupt_data);
 455 
 456           ttybp = addr (tty_buf$);
 457           hmd_ptr = P_hmd_ptr;
 458           hste_ptr = null ();                               /* avoid referencing unitialized values */
 459           interrupt_type = P_interrupt_type;
 460           interrupt_data = P_interrupt_data;
 461 
 462           if (interrupt_type < lbound (INTERRUPT, 1)) | (interrupt_type > hbound (INTERRUPT, 1)) then
 463                return;                                      /* don't handle this kind */
 464 
 465           go to INTERRUPT (interrupt_type);                 /* process it */
 466 
 467 
 468 INTERRUPT (1):                                              /* DIALUP -- major channel has dialed up */
 469           if hmd.state ^= HMD_LOADING then return;
 470           unspec (hmd.dialup_info) = interrupt_data;        /* will need to dialup individual channels */
 471           call do_line_control (SET_HASP_MODE, 0, 0, 0);    /* switch line to HASP mode */
 472           call do_line_control (CONFIGURE, 3, 0, 0);        /* transparent EBCDIC */
 473           call do_line_control (SET_MASTER_SLAVE_MODE,      /* indicate if workstation or host */
 474                                 binary ((hmd.type = HASP_WORKSTATION), 17, 0), 0, 0);
 475           call do_line_control (SET_HASP_TIMERS, hmd.ic_timeout, hmd.receive_timeout, hmd.transmit_timeout);
 476           call do_line_control (SET_NAK_LIMIT, hmd.max_naks, 0, 0);   /* maximum # of continous NAKs before line dies */
 477           call do_line_control (ACCEPT_BID, 0, 0, 0);       /* start waiting for connection */
 478           call channel_manager$control (hmd.devx, "set_input_message_size", addr (hmd.max_block_size), code);
 479                                                             /* set maximum block size allowed on input */
 480           return;                                           /* still loading */
 481 
 482 LOADING_FAILS:                                              /* line control fails--crash or hangup to follow */
 483           return;
 484 
 485 
 486 INTERRUPT (2):                                              /* HANGUP -- major channel has hungup */
 487           call crash_mpx ();                                /* death and destruction reigns */
 488           call pxss$ring_0_wakeup (hmd.loader_process_id, hmd.loader_event_channel, HASP_MPX_DOWN, code);
 489           return;
 490 
 491 
 492 INTERRUPT (3):                                              /* CRASH -- parent multiplexer has crashed */
 493           call crash_mpx ();
 494           return;
 495 
 496 
 497 INTERRUPT (4):                                              /* SEND OUTPUT -- parent wants output */
 498           hmd.send_output = "1"b;                           /* have permission to send some output */
 499           if (hmd.state < HMD_LOADED)
 500                then;                                        /* nothing to send yet */
 501           else if (hmd.minor_state = HMD_REPROCESS) then
 502                call process_loopback_records ();            /* try to retransmit loopback'ed records if possible */
 503           else call process_output_block ();                /* either finish last block or start transmitting a new one */
 504           return;
 505 
 506 
 507 INTERRUPT (5):                                              /* INPUT AVAILABLE -- parent has input */
 508           hmd.flags.input_available = "1"b;                 /* remember that input is waiting */
 509           if (hmd.state < HMD_LOADED)
 510                then;                                        /* no sub-channels are up yet */
 511           else call interrupt_subchannels_requesting_input ();
 512           return;                                           /* inform all sub-channels which have already
 513                                                                requested input */
 514 
 515 
 516 INTERRUPT (6):                                              /* ACCEPT INPUT -- parent has input */
 517           hmd.flags.input_available = "0"b;                 /* just to be safe -- parent shouldn't use both mechanisms */
 518           if (hmd.state < HMD_LOADED)
 519                then;                                        /* can't take the input yet */
 520           else do;
 521                unspec (rtx_info) = interrupt_data;
 522                chain_ptr = pointer (ttybp, rtx_info.chain_head);
 523                if hmd.trace_mode then             /* requested trace of all I/O with the FNP */
 524                     call trace_block (chain_ptr, INPUT);
 525                call process_input_block (chain_ptr);        /* interpret the BCB and FCS */
 526                if (hmd.input.first_bufferp ^= null ()) & ^hmd.retry_process_input then
 527                     call process_input_records ();          /* have something to process and space OK */
 528                call interrupt_subchannels_with_input ();    /* inform the sub-channels that now have input */
 529                if (hmd.minor_state = HMD_REPROCESS) then
 530                     call process_loopback_records ();
 531                else call process_output_block ();           /* an output block might have to be sent because of above
 532                                                                processing */
 533           end;
 534           return;
 535 
 536 
 537 INTERRUPT (7):                                              /* INPUT REJECTED -- some input rejected by FNP; ignore */
 538           return;
 539 
 540 
 541 INTERRUPT (8):                                              /* QUIT -- break signal; ignore */
 542           return;
 543 
 544 
 545 INTERRUPT (9):                                              /* LINE STATUS -- line status from FNP; process */
 546           unspec (line_stat) = interrupt_data;
 547           call process_line_status ();
 548           return;
 549 
 550 
 551 INTERRUPT (10):                                             /* DIAL STATUS -- autocall status; ignore */
 552           return;
 553 
 554 
 555 INTERRUPT (11):                                             /* WRU TIMEOUT -- timeout waiting for answerback; ignore */
 556           return;
 557 
 558 
 559 INTERRUPT (12):                                             /* SPACE AVAILABLE  -- some buffer space freed; try again */
 560           if hmd.state < HMD_LOADED then return;
 561           call process_space_available ();
 562           return;
 563 
 564 INTERRUPT (13):                                             /* various, not used by this multiplexer */
 565 INTERRUPT (14):
 566 INTERRUPT (15):
 567 INTERRUPT (16):
 568           return;
 569 
 570 INTERRUPT (17):                                             /* MASKED -- treat like HANGUP but use different wakeup message */
 571           call crash_mpx ();                                /* death and destruction reigns */
 572           call pxss$ring_0_wakeup (hmd.loader_process_id, hmd.loader_event_channel, HASP_MPX_MASKED, code);
 573           return;
 574 
 575 %page;
 576 /* Process control orders */
 577 
 578 control:
 579      entry (P_hmd_ptr, P_subchannel_idx, P_order, P_info_ptr, P_code);
 580 
 581           ttybp = addr (tty_buf$);
 582           call setup_subchannel ();
 583           order = P_order;
 584           info_ptr = P_info_ptr;
 585           code = 0;                                         /* assume success */
 586 
 587           if (order = "listen") then                        /* listen to this sub-channel */
 588                if (hmd.state < HMD_LOADED) then             /* multiplexer must be loaded for this to work */
 589                     code = et_invalid_state;
 590                else do;
 591                     if (hste.state < HSTE_LISTENING) then   /* this sub-channel wasn't already listening */
 592                          hste.state = HSTE_LISTENING;
 593                     if (hmd.minor_state < HMD_NORMAL) then  /* can only dialup the console until SIGNON is sent */
 594                          if (hste.device_type = HASP_CONSOLE) & (hmd.state = HMD_STARTED) &
 595                             (hste.state = HSTE_LISTENING) then
 596                               call signal_dialup ();
 597                          else;
 598                     else                                    /* any channel can dialup now */
 599                     if (hmd.state = HMD_STARTED) & (hste.state = HSTE_LISTENING) then
 600                          call signal_dialup ();
 601                end;
 602 
 603           else if (order = "hangup") then                   /* hangup this sub-channel */
 604                call signal_hangup (HANGUP);
 605 
 606           else if (order = "wru") then                      /* read answerback: none available */
 607                call channel_manager$interrupt (hste.devx, WRU_TIMEOUT, ""b);
 608 
 609           else if (order = "abort") then                    /* resetwrite and/or resetread */
 610                if (info_ptr = null ()) then                 /* info structure required */
 611                     code = et_null_info_ptr;
 612                else do;
 613                     if abort_info.resetwrite & (hste.direction ^= HSTE_INPUT_ONLY)
 614                     then do;                                /* resetwrite only if it could do output in the first place */
 615                          if (hste.output.first_bufferp ^= null ()) then do;
 616                               call tty_space_man$free_chain (hste.devx, OUTPUT, hste.output.first_bufferp);
 617                               hste.output.first_bufferp, hste.output.last_bufferp = null ();
 618                          end;
 619                          call channel_manager$interrupt (hste.devx, SEND_OUTPUT, ""b);
 620                     end;
 621                     if abort_info.resetread & (hste.input.first_bufferp ^= null ())
 622                     then do;                                /* resetread only if it has some input already */
 623                          call tty_space_man$free_chain (hste.devx, INPUT, hste.input.first_bufferp);
 624                          hste.input.n_records = 0;
 625                          hste.input.first_bufferp, hste.input.last_bufferp = null ();
 626                          if ^hmd.input_wabs (hste.device_wab_idx)
 627                          then do;                           /* device was not-ready: it's now ready again */
 628                               hmd.input_wabs (hste.device_wab_idx) = "1"b;
 629                               if (hmd.minor_state = HMD_REPROCESS) then
 630                                    call process_loopback_records ();
 631                               else call process_output_block ();
 632                          end;                               /* may want to send a status block now */
 633                     end;
 634                end;
 635 
 636           else if (order = "write_status") then             /* check if output still pending */
 637                if (info_ptr = null ()) then                 /* info structure is required */
 638                     code = et_null_info_ptr;
 639                else if (hste.output.first_bufferp ^= null ()) then
 640                     write_status_info.output_pending = "1"b;
 641                else write_status_info.output_pending = "0"b;
 642 
 643           else if (order = "get_device_type") then          /* return type of device attached to this sub-channel */
 644                if (info_ptr = null ()) then                 /* info structure is required */
 645                     code = et_null_info_ptr;
 646                else get_device_type_info = hste.device_type;
 647 
 648           else if (order = "signon_record") then            /* send SIGNON record for multiplexer */
 649                if (info_ptr = null ()) then                 /* info structure is required */
 650                     code = et_null_info_ptr;
 651                else if (hmd.type = HASP_WORKSTATION) then   /* workstations only */
 652                     if (hste.device_type ^= HASP_CONSOLE) then
 653                          code = et_incorrect_device_type;   /* only from the console please */
 654                     else if ^hmd.signon_mode then           /* remote isn't expecting one */
 655                          code = et_invalid_state;
 656                     else if (hmd.signon_data_ptr = null ()) &    /* if waiting for a SIGNON... */
 657                             (hmd.minor_state = HMD_SEND_SIGNON) then
 658                          if (sri.version ^= SIGNON_RECORD_INFO_VERSION_1) then
 659                               code = et_unimplemented_version;
 660                          else do;
 661                               call tty_space_man$get_space (size (hmd_signon_data), hsd_ptr);
 662                               if hsd_ptr ^= null ()
 663                               then do;                      /* got the needed room */
 664                                    hmd.signon_data_ptr = hsd_ptr;
 665                                    hmd_signon_data.processid = pds$process_id;
 666                                    hmd_signon_data.event_channel = sri.event_channel;
 667                                    hmd_signon_data.record = sri.record;
 668                                    call process_output_block (); /* try to send it */
 669                               end;
 670                               else code = et_noalloc;       /* no room: let caller retry */
 671                          end;
 672                     else code = et_out_of_sequence;         /* already sent one */
 673                else code = et_undefined_order_request;      /* not valid for a host */
 674 
 675           else if (order = "no_signon_record") then         /* caller wants to verify no SIGNON record is needed */
 676                if (hmd.type = HASP_WORKSTATION) then        /* workstations only */
 677                     if hmd.signon_mode then
 678                          code = et_invalid_state;           /* workstation requires a signon record */
 679                     else;                                   /* workstation does not need to send a SIGNON */
 680                else code = et_undefined_order_request;      /* not valid for a host */
 681 
 682           else if (order = "copy_meters") then              /* save current meters for use with -since_dialup */
 683                hste.saved_meters_ptr -> hasp_subchannel_meters = hste.meters;
 684 
 685           else if (order = "get_meters") then               /* return subchannel metering data */
 686                if (info_ptr = null ()) then                 /* must have a place to put results */
 687                     code = et_null_info_ptr;
 688                else if (info_ptr -> get_comm_meters_info.version ^= GET_COMM_METERS_INFO_VERSION_1) then
 689                     code = et_unimplemented_version;        /* wrong structure or version of structure */
 690                else do;                                     /* OK so far ... */
 691                     hsmd_ptr = info_ptr -> get_comm_meters_info.parent_ptr;
 692                     if hsmd_ptr ^= null () then
 693                          if (hasp_subchannel_meters_data.version ^= HASP_SUBCHANNEL_METERS_DATA_VERSION_1) then
 694                               code = et_unimplemented_version;
 695                          else do;
 696                               string (hasp_subchannel_meters_data.flags) = ""b;
 697                               hasp_subchannel_meters_data.report_input_meters = (hste.direction ^= HSTE_OUTPUT_ONLY);
 698                               hasp_subchannel_meters_data.report_output_meters = (hste.direction ^= HSTE_INPUT_ONLY);
 699                               hasp_subchannel_meters_data.current_meters = hste.meters;
 700                               hasp_subchannel_meters_data.saved_meters = hste.saved_meters_ptr -> hasp_subchannel_meters;
 701                          end;
 702                end;
 703 
 704           else code = et_undefined_order_request;
 705 
 706           P_code = code;
 707           return;
 708 %page;
 709 /* Validate a proposed mode setting */
 710 
 711 check_modes:
 712      entry (P_hmd_ptr, P_subchannel_idx, P_mclp, P_code);
 713 
 714 
 715 /* Set modes ON or OFF */
 716 
 717 set_modes:
 718      entry (P_hmd_ptr, P_subchannel_idx, P_mclp, P_code);
 719 
 720           call setup_subchannel ();
 721           mclp = P_mclp;
 722           P_code = 0;
 723 
 724           do idx = 1 to mcl.n_entries;
 725 
 726                mclep = addr (mcl.entries (idx));
 727 
 728                mcle.mpx_mode = (mcle.mode_name = "rawi") |  /* rawi, rawo, and echoplex only are checked */
 729                                (mcle.mode_name = "rawo") | (mcle.mode_name = "echoplex");
 730 
 731                if mcle.mpx_mode then                        /* process this mode */
 732 
 733                     if ((mcle.mode_name ^= "rawi") & (mcle.mode_name ^= "rawo") & (mcle.mode_name ^= "echoplex")) |
 734                        ((mcle.mode_name = "rawi") & ^mcle.mode_switch) |
 735                        ((mcle.mode_name = "rawo") & ^mcle.mode_switch) |
 736                        ((mcle.mode_name = "echoplex") & mcle.mode_switch)
 737                     then do;                                /* only accept:  rawo,rawi,^echoplex */
 738                          mcle.error = "1"b;
 739                          P_code = et_bad_mode;
 740                     end;
 741           end;
 742 
 743           return;
 744 
 745 
 746 
 747 /* Return multiplexer specific modes */
 748 
 749 get_modes:
 750      entry (P_hmd_ptr, P_subchannel_idx, P_modes, P_code);
 751 
 752           P_modes = "";                                     /* no special modes defined */
 753           P_code = 0;
 754 
 755           return;
 756 %page;
 757 /* Initialize sub-channel data pointer from parameters */
 758 
 759 setup_subchannel:
 760           procedure ();
 761 
 762                hmd_ptr = P_hmd_ptr;
 763 
 764                if hmd.state < HMD_LOADED then do;           /* can't hack subchannels if not loaded */
 765                     code = et_action_not_performed;
 766                     go to ERROR_RETURN;
 767                end;
 768 
 769                subchannel_idx = P_subchannel_idx;
 770                hste_ptr = addr (hmd.subchannels (subchannel_idx));
 771 
 772                return;
 773 
 774           end setup_subchannel;
 775 %page;
 776 /* Signal dialup on the given subchannel:  A subchannel may be dialed-up and hungup several times during the life of a
 777    multiplexer loading.  Therefore, any loopbacked records for the subchannel must be preserved across hangups/dial-ups of
 778    the subchannel as those records were sucessfully transmitted as far as the user ring is concerned.  Additionally, input
 779    is accepted for devices before they dialup to avoid loss of data in the original blocks which are received before the
 780    Initializer can listen to all the subchannels */
 781 
 782 signal_dialup:
 783           procedure ();
 784 
 785 dcl  saved_input_available bit (1) aligned;
 786 
 787                if (hmd.minor_state_stack = null ()) & (hste.loopback.first_bufferp = null ()) then
 788                                                             /* no loopbacked records available: this subchannel can't be
 789                                                                retransmitting any records so it's minor state should be
 790                                                                reset.  If it were retransmitting, that process controls
 791                                                                the minor state */
 792                     if hmd.rts_mode & (hste.device_type ^= HASP_CONSOLE) & (hste.direction ^= HSTE_INPUT_ONLY) then
 793                          hste.minor_state = HSTE_SEND_RTS;  /* must request permission before first output */
 794                     else hste.minor_state = HSTE_NORMAL;    /* console or multiplexer not configured to ask: OK to send */
 795 
 796                hste.next_subchannel_for_output = 0;         /* not in the queues yet */
 797 
 798                hste.output.first_bufferp, hste.output.last_bufferp = null ();   /* can't have output outstanding */
 799 
 800                saved_input_available = hste.flags.input_available;
 801                string (hste.flags) = ""b;                   /* can't have done a read/write call yet */
 802                hste.flags.input_available = saved_input_available;
 803 
 804                if (hste.direction = HSTE_INPUT_ONLY) | (hste.direction = HSTE_INPUT_OUTPUT)
 805                then do;                                     /* input device:  OK to receive input ... */
 806                     hmd.input_wabs (hste.device_wab_idx) = "1"b;
 807                     hmd.send_rts_ack (hste.device_wab_idx) = "0"b;    /* ... but don't send ACKs yet */
 808 
 809                end;
 810                else hmd.send_rts (hste.device_wab_idx) = "0"b;
 811 
 812                hste.dialup_info = hmd.dialup_info;
 813 
 814                hste.state = HSTE_DIALED;                    /* now have everything to qualify as dialed */
 815 
 816                call channel_manager$interrupt (hste.devx, DIALUP, unspec (hste.dialup_info));
 817 
 818                if (hste.direction ^= HSTE_INPUT_ONLY) then  /* authorize first output */
 819                     call channel_manager$interrupt (hste.devx, SEND_OUTPUT, ""b);
 820 
 821                if (hste.direction ^= HSTE_OUTPUT_ONLY) then
 822                     if hste.flags.input_available then do;  /* inform the channel something's already present */
 823                          call channel_manager$interrupt (hste.devx, INPUT_AVAILABLE, ""b);
 824                          hste.flags.input_available = "0"b;
 825                     end;
 826 
 827                return;
 828 
 829           end signal_dialup;
 830 %page;
 831 /* Signal hangup on the specified sub-channel */
 832 
 833 signal_hangup:
 834           procedure (P_interrupt_type);
 835 
 836 dcl  P_interrupt_type fixed binary;                         /* type of interrupt to give to sub-channel -- hangup/crash */
 837 
 838                hste.state = HSTE_HUNGUP;
 839 
 840                if hste.input.first_bufferp ^= null () then  /* throw away any held input */
 841                     call tty_space_man$free_chain (hste.devx, INPUT, hste.input.first_bufferp);
 842 
 843                if hste.output.first_bufferp ^= null () then
 844                     call tty_space_man$free_chain (hste.devx, OUTPUT, hste.output.first_bufferp);
 845 
 846                call dequeue_subchannel_for_output ();
 847 
 848                hste.input.n_records = 0;
 849 
 850                hste.input.first_bufferp, hste.input.last_bufferp,
 851                     hste.output.first_bufferp, hste.output.last_bufferp = null ();
 852 
 853                string (hste.flags) = ""b;
 854 
 855                if (hste.direction = HSTE_INPUT_ONLY) | (hste.direction = HSTE_INPUT_OUTPUT)
 856                then do;                                     /* input device:  shut it down and don't send RTS ack */
 857                     hmd.input_wabs (hste.device_wab_idx) = "0"b;
 858                     hmd.send_rts_ack (hste.device_wab_idx) = "0"b;
 859                end;
 860                else hmd.send_rts (hste.device_wab_idx) = "0"b;
 861 
 862                call channel_manager$interrupt (hste.devx, P_interrupt_type, ""b);
 863 
 864                return;
 865 
 866           end signal_hangup;
 867 %page;
 868 /* Indicate that the multiplexer is loaded: initialize the multiplexer database to the point where input will be buffered
 869    and the initial SEND OUTPUT interrupt can be handled */
 870 
 871 load_mpx: procedure ();
 872 
 873 dcl (saved_send_output, saved_input_available) bit (1) aligned;
 874 dcl  idx fixed binary;
 875 
 876                hmd.state = HMD_LOADED;                      /* we are not loaded, but no dialups on sub-channels */
 877 
 878                hmd.time_mpx_booted = clock ();              /* it's there now */
 879 
 880                if (hmd.type = HASP_WORKSTATION) & hmd.signon_mode then
 881                     hmd.minor_state = HMD_SEND_SIGNON;      /* must wait for console to send SIGNON record */
 882                else hmd.minor_state = HMD_NORMAL;           /* normal data transfer may begin */
 883 
 884                saved_send_output = hmd.send_output;         /* these flags are valid from time boot is started */
 885                saved_input_available = hmd.flags.input_available;
 886 
 887                string (hmd.flags) = ""b;
 888 
 889                hmd.send_output = saved_send_output;
 890                hmd.flags.input_available = saved_input_available;
 891 
 892                hmd.suspend_all_output = "1"b;               /* do not allow any output */
 893                hmd.first_foreign_block = "1"b;              /* haven't seen the first block yet */
 894                unspec (hmd.foreign_fcs_bytes) = "700600"b3; /* FCS that can't come from foreign side */
 895 
 896                hmd.suspend_all_input = "1"b;                /* do not accept any input */
 897                hmd.reset_local_block_count = "1"b;          /* force BCB reset to be sent */
 898                unspec (hmd.local_fcs_bytes) = "700600"b3;   /* force FCS to be computed */
 899 
 900                string (hmd.input_wabs) = ""b;               /* turn off all wait-a-bits to prevent data transfer */
 901                string (hmd.output_wabs) = ""b;
 902                string (hmd.send_rts) = ""b;                 /* prevent accidental shipments of RTS or RTS-ack records */
 903                string (hmd.send_rts_ack) = ""b;
 904 
 905                hmd.minor_state_stack,                       /* these stacks are empty as loopback is not preserved ... */
 906                     hmd.loopback_block_chain_stack = null ();    /* ... across multiplexer load/crash sequences */
 907 
 908                hmd.output_chain_ptr, hmd.signon_data_ptr,
 909                     hmd.input.first_bufferp, hmd.input.last_bufferp,
 910                     hmd.loopback.first_bufferp, hmd.loopback.last_bufferp,
 911                     hmd.output_block.first_bufferp, hmd.output_block.last_bufferp = null ();
 912 
 913                hmd.output_block.subchannel_idx, hmd.output_block.tally = 0;
 914 
 915                do idx = 1 to hmd.n_subchannels;             /* indicate all sub-channels are still hungup */
 916                     hmd.subchannels(idx).state = HSTE_HUNGUP;
 917                     hmd.subchannels(idx).input.n_records = 0;    /* no input has arrived yet: some may arrive ... */
 918                     hmd.subchannels(idx).input.first_bufferp,    /* ... before dialup however */
 919                          hmd.subchannels(idx).input.last_bufferp = null ();
 920                     hmd.subchannels(idx).loopback.n_records = 0; /* can't have any loopbacked records yet */
 921                     hmd.subchannels(idx).loopback.first_bufferp, hmd.subchannels(idx).loopback.last_bufferp = null ();
 922                end;
 923 
 924                call pxss$ring_0_wakeup (hmd.loader_process_id, hmd.loader_event_channel, HASP_MPX_UP, code);
 925 
 926                return;
 927 
 928           end load_mpx;
 929 %page;
 930 /* Shutdown the multiplexer by "hanging up" all the sub-channels */
 931 
 932 crash_mpx:
 933           procedure ();
 934 
 935 dcl (old_state, idx) fixed binary;
 936 
 937 
 938                old_state = hmd.state;
 939 
 940                hmd.state = HMD_DOWN;                        /* multiplexer is now dead */
 941 
 942                if old_state < HMD_LOADED then               /* wasn't loaded:  couldn't be doing anything */
 943                     return;
 944 
 945                if (hmd.minor_state = HMD_SEND_SIGNON) | (hmd.minor_state = HMD_WAIT_SIGNON_RESPONSE)
 946                then do;                                     /* inform console's owner that the SIGNON record failed */
 947                     hsd_ptr = hmd.signon_data_ptr;
 948                     if hsd_ptr ^= null () then              /* ... insure there's someone listening */
 949                          call pxss$ring_0_wakeup (hmd_signon_data.processid, hmd_signon_data.event_channel,
 950                                                   HASP_SIGNON_HANGUP, code);
 951                end;
 952 
 953                if hmd.output_chain_ptr ^= null () then      /* free up all unused data */
 954                     call tty_space_man$free_chain (hmd.devx, OUTPUT, hmd.output_chain_ptr);
 955 
 956                if hmd.input.first_bufferp ^= null () then
 957                     call tty_space_man$free_chain (hmd.devx, INPUT, hmd.input.first_bufferp);
 958 
 959                if hmd.loopback.first_bufferp ^= null () then
 960                     call tty_space_man$free_chain (hmd.devx, INPUT, hmd.loopback.first_bufferp);
 961 
 962                if hmd.output_block.first_bufferp ^= null () then
 963                     call tty_space_man$free_chain (hmd.devx, OUTPUT, hmd.output_block.first_bufferp);
 964 
 965                if hmd.signon_data_ptr ^= null () then
 966                     call tty_space_man$free_space (currentsize (hmd.signon_data_ptr -> hmd_signon_data),
 967                                                    hmd.signon_data_ptr);
 968 
 969                call empty_minor_state_stack ();
 970                call empty_loopback_block_chain_stack ();
 971 
 972                hmd.output_chain_ptr, hmd.signon_data_ptr,
 973                     hmd.input.first_bufferp, hmd.input.last_bufferp,
 974                     hmd.loopback.first_bufferp, hmd.loopback.last_bufferp,
 975                     hmd.output_block.first_bufferp, hmd.output_block.last_bufferp = null ();
 976 
 977                hmd.output_block.subchannel_idx, hmd.output_block.tally = 0;
 978 
 979                hmd.subchannels_for_output = 0;              /* empty the queue */
 980 
 981                string (hmd.flags) = ""b;
 982 
 983                do idx = 1 to hmd.n_subchannels;
 984                     hste_ptr = addr (hmd.subchannels (idx));
 985                     call signal_hangup (CRASH);
 986                end;
 987 
 988                return;
 989 
 990           end crash_mpx;
 991 %page;
 992 /* Minor state stack manager:  The minor state stack is used to preserve the multiplexer state during the processing of
 993    output blocks returned by the FNP.  This stack includes the previous minor state of the multiplexer and the individual
 994    loopback chains of each subchannel.  These chains are saved to insure that, when a loopback occurs while retransmitting
 995    previous output, the order of records for each subchannel will be preserved properly */
 996 
 997 minor_state_stack_manager:
 998           procedure ();
 999 
1000                return;                                      /* not an entry */
1001 
1002 
1003 dcl  P_new_minor_state fixed binary parameter;              /* push_minor_state: new minor state for multiplexer */
1004 
1005 dcl  previous_msse_ptr pointer;
1006 
1007 dcl  idx fixed binary;
1008 
1009 
1010 
1011 /* Push the current minor state onto the stack */
1012 
1013 push_minor_state:
1014           entry (P_new_minor_state);
1015 
1016                call tty_space_man$get_space (size (msse), msse_ptr);
1017                     if msse_ptr = null () then do;          /* punt ... */
1018                          call syserr (LOG_AND_PRINT,
1019                                       "hasp_mpx (line ^a): No space available to preserve minor state; line will be hungup.",
1020                                       hmd.name);
1021                          call channel_manager$control (hmd.devx, "hangup", null (), code);
1022                          return;
1023                     end;
1024 
1025                do idx = 1 to hmd.n_subchannels;             /* save loopback chains */
1026                     msse.subchannels(idx).loopback = hmd.subchannels(idx).loopback;
1027                     hmd.subchannels(idx).loopback.n_records = 0;
1028                     hmd.subchannels(idx).loopback.first_bufferp, hmd.subchannels(idx).loopback.last_bufferp = null ();
1029                end;                                         /* empty chains so new records go at front */
1030 
1031                msse.minor_state = hmd.minor_state;          /* push state */
1032                hmd.minor_state = P_new_minor_state;
1033 
1034                msse.previous = hmd.minor_state_stack;       /* push */
1035                hmd.minor_state_stack = msse_ptr;
1036 
1037                return;
1038 
1039 
1040 /* Pop the minor state stack: splice any newly created loopback chains onto the front of the old chains (if any) */
1041 
1042 pop_minor_state:
1043           entry ();
1044 
1045                if hmd.minor_state_stack = null () then      /* shouldn't happen */
1046                     return;
1047 
1048                msse_ptr = hmd.minor_state_stack;
1049 
1050                do idx = 1 to hmd.n_subchannels;             /* splice chains */
1051                     if msse.subchannels(idx).loopback.first_bufferp ^= null () then do;
1052                          hmd.subchannels(idx).loopback.n_records =
1053                               hmd.subchannels(idx).loopback.n_records + msse.subchannels(idx).loopback.n_records;
1054                          if hmd.subchannels(idx).loopback.last_bufferp = null () then     /* didn't get any this time */
1055                               hmd.subchannels(idx).loopback.first_bufferp = msse.subchannels(idx).loopback.first_bufferp;
1056                          else hmd.subchannels(idx).loopback.last_bufferp -> buffer.next =
1057                                    binary (rel (msse.subchannels(idx).loopback.first_bufferp), 18, 0);
1058                          hmd.subchannels(idx).loopback.last_bufferp = msse.subchannels(idx).loopback.last_bufferp;
1059                     end;
1060                end;
1061 
1062                hmd.minor_state = msse.minor_state;          /* pop */
1063                hmd.minor_state_stack = msse.previous;
1064 
1065                call tty_space_man$free_space (currentsize (msse), msse_ptr);
1066 
1067                return;
1068 
1069 
1070 
1071 /* Empty the stack: called at multiplexer crashes to flush all space used by the minor state stack */
1072 
1073 empty_minor_state_stack:
1074           entry ();
1075 
1076                do msse_ptr = hmd.minor_state_stack
1077                              repeat (previous_msse_ptr) while (msse_ptr ^= null ());
1078 
1079                     do idx = 1 to hmd.n_subchannels;
1080                          if msse.subchannels(idx).loopback.first_bufferp ^= null () then
1081                               call tty_space_man$free_chain (hmd.subchannels(idx).devx, OUTPUT,
1082                                                              msse.subchannels(idx).loopback.first_bufferp);
1083                     end;
1084 
1085                     previous_msse_ptr = msse.previous;
1086 
1087                     call tty_space_man$free_space (currentsize (msse), msse_ptr);
1088                end;
1089 
1090                hmd.minor_state_stack = null ();
1091 
1092                return;
1093 
1094           end minor_state_stack_manager;
1095 %page;
1096 /* Loopback block chain stack manager:  The loopback block chain stack is when the FNP is returning output blocks to
1097    prevent retransmitted data from being processed out of order */
1098 
1099 loopback_block_chain_stack_manager:
1100           procedure ();
1101 
1102                return;                                      /* not an entry */
1103 
1104 dcl  previous_lbcse_ptr pointer;
1105 
1106 
1107 /* Push the current loopback block chain onto the top of the stack */
1108 
1109 push_loopback_block_chain:
1110           entry ();
1111 
1112                call tty_space_man$get_space (size (lbcse), lbcse_ptr);
1113                     if lbcse_ptr = null () then do;
1114                          call syserr (LOG_AND_PRINT,
1115                                       "hasp_mpx (line ^a): No space available to save loopback chain; line will be hungup.",
1116                                       hmd.name);
1117                          call channel_manager$control (hmd.devx, "hangup", null (), code);
1118                          return;
1119                     end;
1120 
1121                lbcse.loopback = hmd.loopback;
1122                hmd.loopback = null ();                      /* start loopback chain afresh */
1123 
1124                lbcse.previous = hmd.loopback_block_chain_stack;  /* push */
1125                hmd.loopback_block_chain_stack = lbcse_ptr;
1126 
1127                return;
1128 
1129 
1130 
1131 /* Pop the top entry from the stack: splice the current loopback block chain onto the front of the chain from the stack */
1132 
1133 pop_loopback_block_chain:
1134           entry ();
1135 
1136                if hmd.loopback_block_chain_stack = null () then
1137                     return;                                 /* nothing there */
1138 
1139                lbcse_ptr = hmd.loopback_block_chain_stack;
1140 
1141                if lbcse.loopback.first_bufferp ^= null () then do;
1142                     if hmd.loopback.last_bufferp = null () then  /* didn't pickup any data this time */
1143                          hmd.loopback.first_bufferp = lbcse.loopback.first_bufferp;
1144                     else hmd.loopback.last_bufferp -> buffer.next = binary (rel (lbcse.loopback.first_bufferp), 18, 0);
1145                     hmd.loopback.last_bufferp = lbcse.loopback.last_bufferp;
1146                end;
1147 
1148                hmd.loopback_block_chain_stack = lbcse.previous;  /* pop */
1149 
1150                call tty_space_man$free_space (currentsize (lbcse), lbcse_ptr);
1151 
1152                return;
1153 
1154 
1155 
1156 /* Empty the stack: called at multiplexer crashes to flush all space used by the loopback block chain stack */
1157 
1158 empty_loopback_block_chain_stack:
1159           entry ();
1160 
1161                do lbcse_ptr = hmd.loopback_block_chain_stack
1162                               repeat (previous_lbcse_ptr) while (lbcse_ptr ^= null ());
1163 
1164                     previous_lbcse_ptr = lbcse.previous;
1165 
1166                     if lbcse.loopback.first_bufferp ^= null () then
1167                          call tty_space_man$free_chain (hmd.devx, INPUT, lbcse.loopback.first_bufferp);
1168 
1169                     call tty_space_man$free_space (currentsize (lbcse), lbcse_ptr);
1170                end;
1171 
1172                hmd.loopback_block_chain_stack = null ();    /* now empty */
1173 
1174                return;
1175 
1176           end loopback_block_chain_stack_manager;
1177 %page;
1178 /* Add the sub-channel to the end of the pending output queue */
1179 
1180 enqueue_subchannel_for_output:
1181           procedure ();
1182 
1183 dcl  idx fixed binary;
1184 
1185                do idx = hmd.subchannels_for_output.first
1186                         repeat (hmd.subchannels(idx).next_subchannel_for_output)
1187                          while (idx ^= 0);                  /* see if it is already in the queue */
1188                     if (idx = hste.subchannel_idx) then return;
1189                end;
1190 
1191                hste.holding_output = "1"b;                  /* now on the queue */
1192 
1193                if (hmd.subchannels_for_output.first = 0) then    /* queue empty:  this will be first element in queue */
1194                     hmd.subchannels_for_output.first = hste.subchannel_idx;
1195 
1196                else hmd.subchannels(hmd.subchannels_for_output.last).next_subchannel_for_output = hste.subchannel_idx;
1197                                                             /* chain to end of queue */
1198 
1199                hmd.subchannels_for_output.last = hste.subchannel_idx; /* last element on the queue */
1200                hste.next_subchannel_for_output = 0;
1201 
1202                return;
1203 
1204           end enqueue_subchannel_for_output;
1205 %page;
1206 /* Remove the sub-channel from the output queue */
1207 
1208 dequeue_subchannel_for_output:
1209           procedure ();
1210 
1211 dcl  previous_subchannel_idx fixed binary;
1212 
1213                if hste.holding_output then do;              /* it is on the queue */
1214 
1215                     previous_subchannel_idx = 0;            /* in case it is first (and last) in the queue */
1216 
1217                     if (hmd.subchannels_for_output.first = hste.subchannel_idx) then
1218                          hmd.subchannels_for_output.first = hste.next_subchannel_for_output;
1219 
1220                     else                                    /* not first in queue:  find predecessor */
1221                     do previous_subchannel_idx = hmd.subchannels_for_output.first
1222                                               repeat (hmd.subchannels(previous_subchannel_idx).next_subchannel_for_output)
1223                               while (previous_subchannel_idx ^= 0);
1224                          if (hmd.subchannels(previous_subchannel_idx).next_subchannel_for_output = hste.subchannel_idx)
1225                          then do;
1226                               hmd.subchannels(previous_subchannel_idx).next_subchannel_for_output =
1227                                         hste.next_subchannel_for_output;
1228                               go to EXIT_SEARCH_FOR_PREVIOUS_LOOP;
1229                          end;
1230                     end;
1231 
1232 EXIT_SEARCH_FOR_PREVIOUS_LOOP:
1233                     if (hmd.subchannels_for_output.last = hste.subchannel_idx) then
1234                          hmd.subchannels_for_output.last = previous_subchannel_idx;
1235                end;
1236 
1237                hste.next_subchannel_for_output = 0;
1238 
1239                hste.holding_output = "0"b;                  /* no longer on the queue */
1240 
1241                return;
1242 
1243           end dequeue_subchannel_for_output;
1244 %page;
1245 /* Give a SEND OUTPUT interrupt to each sub-channel that is holding output */
1246 
1247 interrupt_subchannels_with_output:
1248           procedure ();
1249 
1250 dcl  saved_hste_ptr pointer;
1251 dcl  queue (17) fixed binary;                               /* local copy of output queue to avoid looping */
1252 dcl (n_entries, idx) fixed binary;
1253 
1254                saved_hste_ptr = hste_ptr;                   /* need to use this value */
1255 
1256                n_entries = 0;                               /* make a copy of the current queue */
1257                do idx = hmd.subchannels_for_output.first
1258                         repeat (hmd.subchannels(idx).next_subchannel_for_output) while (idx ^= 0);
1259                     n_entries = n_entries + 1;
1260                     queue (n_entries) = hmd.subchannels(idx).subchannel_idx;
1261                end;
1262 
1263                if (n_entries = 0) then return;              /* no interrupts need be sent now */
1264 
1265                do idx = 1 to n_entries;
1266                     hste_ptr = addr (hmd.subchannels (queue (idx)));
1267                     call dequeue_subchannel_for_output ();  /* remove from front of queue */
1268                     call channel_manager$interrupt_later (hste.devx, SEND_OUTPUT, ""b);
1269                end;
1270 
1271                hste_ptr = saved_hste_ptr;
1272 
1273                return;
1274 
1275           end interrupt_subchannels_with_output;
1276 
1277 
1278 
1279 /* Give an INPUT AVAILABLE interrupt to each sub-channel that actually has input waiting */
1280 
1281 interrupt_subchannels_with_input:
1282           procedure ();
1283 
1284 dcl  idx fixed binary;
1285 
1286                do idx = 1 to hmd.n_subchannels;
1287                     if hmd.subchannels(idx).input_available | (hmd.subchannels(idx).input.first_bufferp ^= null ())
1288                     then do;
1289                          hmd.subchannels(idx).requested_input, hmd.subchannels(idx).input_available = "0"b;
1290                          call channel_manager$interrupt (hmd.subchannels(idx).devx, INPUT_AVAILABLE, ""b);
1291                     end;
1292                end;
1293 
1294                return;
1295 
1296           end interrupt_subchannels_with_input;
1297 %page;
1298 /* Give an INPUT AVAILABLE interrupt to each sub-channel which has already requested input.  If no such sub-channels
1299    exist, interrupt the operator's console */
1300 
1301 interrupt_subchannels_requesting_input:
1302           procedure ();
1303 
1304 dcl  sent_interrupt bit (1) aligned;
1305 dcl  idx fixed binary;
1306 
1307                sent_interrupt = "0"b;
1308 
1309                do idx = 1 to hmd.n_subchannels;
1310                     if hmd.subchannels(idx).requested_input then do;
1311                          hmd.subchannels(idx).requested_input, hmd.subchannels(idx).input_available = "0"b;
1312                          call channel_manager$interrupt (hmd.subchannels(idx).devx, INPUT_AVAILABLE, ""b);
1313                          sent_interrupt = "1"b;
1314                     end;
1315                end;
1316 
1317                if ^sent_interrupt then                      /* insure that someone is interrupted */
1318                     call channel_manager$interrupt (hmd.subchannels(hmd.console_hste_idx).devx, INPUT_AVAILABLE, ""b);
1319 
1320                return;
1321 
1322           end interrupt_subchannels_requesting_input;
1323 
1324 
1325 
1326 /* Process available input blocks:  retrieve any input blocks from the parent multiplexer and perform preliminary
1327    processing on them */
1328 
1329 process_available_input_blocks:
1330           procedure ();
1331 
1332 dcl  first_bufferp pointer;
1333 dcl  more_input bit (1) aligned;                            /* ON => parent is holding another block */
1334 
1335 
1336                more_input = hmd.flags.input_available;
1337 
1338                do while (more_input);                       /* while the parent has some input */
1339                     call channel_manager$read (hmd.devx, first_bufferp, more_input, code);
1340                          if code ^= 0 then go to ERROR_RETURN;
1341                     if hmd.trace_mode then                  /* requested trace of all I/O with the FNP */
1342                          call trace_block (first_bufferp, INPUT);
1343                     if first_bufferp ^= null () then        /* got a block */
1344                          call process_input_block (first_bufferp);
1345                end;
1346 
1347                hmd.flags.input_available = "0"b;            /* when here all input blocks have been processed */
1348 
1349                return;
1350 
1351           end process_available_input_blocks;
1352 %page;
1353 /* Process an input block:  check if the block is real input or returned output.  For real input, process the BCB and FCS;
1354    save the input for later processing; and notify the sub-channels that input has arrived.  For returned output, save the
1355    returned output for later processing; and, when all the output has been returned, permit the sub-channels to send
1356    output again */
1357 
1358 process_input_block:
1359           procedure (P_first_bufferp);
1360 
1361 dcl  P_first_bufferp pointer parameter;                     /* -> first block of data in the block */
1362 
1363 dcl  foreign_bcb_char character (1) unaligned;              /* the BCB ... */
1364 dcl  foreign_fcs_chars character (2) unaligned;             /* ... and the FCS for this input block */
1365 
1366 dcl 1 foreign_bcb unaligned based (addr (foreign_bcb_char)) like hasp_bcb_byte;
1367 dcl 1 foreign_fcs unaligned based (addr (foreign_fcs_chars)) like hasp_fcs_bytes;
1368 
1369 dcl (first_bufferp, last_bufferp, next_to_last_bufferp) pointer;
1370 
1371 dcl  first_char character (1) aligned;
1372 
1373 
1374                first_bufferp = P_first_bufferp;             /* start of input message */
1375 
1376                next_to_last_bufferp = null ();
1377                do blockp = first_bufferp repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b);
1378                     if buffer.next = 0 then                 /* find the last buffer in the chain ... */
1379                          last_bufferp = blockp;
1380                     else next_to_last_bufferp = blockp;     /* ... and the buffer just before it */
1381                end;
1382 
1383                if last_bufferp -> buffer.tally > 2 then     /* strip DLE/SYN ETB from end */
1384                     last_bufferp -> buffer.tally = last_bufferp -> buffer.tally - 2;
1385                else do;                                     /* last buffer has part (or all) of trailer, free it */
1386                     if next_to_last_bufferp = null () then go to BAD_INPUT_BLOCK;
1387                     next_to_last_bufferp -> buffer.tally =  /* adjust to flush DLE/SYN ETB sequence */
1388                          next_to_last_bufferp -> buffer.tally - 2 + last_bufferp -> buffer.tally;
1389                     call tty_space_man$free_buffer (hmd.devx, INPUT, last_bufferp);
1390                     next_to_last_bufferp -> buffer.next = 0;/* this is now end of chain */
1391                     last_bufferp = next_to_last_bufferp;
1392                end;
1393 
1394                first_char = substr_of_chain (1, 1);         /* save the DLE or SOH */
1395                call delete_leading_text (2);                /* remove DLE/SOH STX */
1396 
1397                if first_char = DLE then                     /* transparent block, remove transparency codes */
1398                     call strip_dles ();
1399 
1400                foreign_bcb_char = substr_of_chain (1, 1);   /* get the BCB and FCS from the buffer */
1401                foreign_fcs_chars = substr_of_chain (2, 2);
1402 
1403                call delete_leading_text (3);                /* remove the BCB and FCS, leaving just records */
1404 
1405 
1406                if ^foreign_fcs.returned_data then
1407 
1408                     call process_real_input_block ();       /* real input:  see below */
1409 
1410 
1411                else do;
1412 
1413 /* Returned output:  This is an output block returned by the FNP because a foreign output device went not-ready.  If this
1414    is not a sync-block, place it onto the loopback chain for subsequent processing.  If it is a sync-block, enter
1415    a special state where the loopbacked records are processed until the loopback chain is exhausted.  (See
1416    process_loopback_records for more detail) */
1417 
1418                     if (foreign_fcs.block_type = HASP_FCS_SYNC_BLOCK) then
1419                          call process_sync_block ();        /* this code has gotten gravid */
1420 
1421                     else if (foreign_bcb_char = hmd.last_loopback_bcb)
1422                     then do;                                /* FNP returned the same block twice! */
1423                          call syserr (LOG_AND_PRINT,
1424                                       "hasp_mpx (line ^a): Duplicate loopback block received: BCB = ^3.3b",
1425                                       hmd.name, unspec (hmd.last_loopback_bcb));
1426                          call tty_space_man$free_chain (hmd.devx, INPUT, first_bufferp);
1427                     end;
1428 
1429                     else do;                                /* real loopback */
1430                          hmd.meters.n_wraparound_blocks = hmd.meters.n_wraparound_blocks + 1;
1431                          if hmd.loopback.first_bufferp = null () then
1432                               hmd.loopback.first_bufferp = first_bufferp;
1433                          else hmd.loopback.last_bufferp -> buffer.next = binary (rel (first_bufferp), 18, 0);
1434                          hmd.loopback.last_bufferp = last_bufferp;
1435                          hmd.last_loopback_bcb = foreign_bcb_char;
1436                     end;
1437                end;
1438 
1439                return;
1440 
1441 
1442 /* Control arrives here iff the input block's header/trailer was incomplete:  As the foreign system/workstation believed
1443    this block was OK and we could not interpret its content, we must drop the line */
1444 
1445 BAD_INPUT_BLOCK:
1446                call tty_space_man$free_chain (hmd.devx, INPUT, first_bufferp);
1447 
1448                call syserr (LOG_AND_PRINT, "hasp_mpx (line ^a): Invalid input block header/trailer; line will be hungup.", hmd.name);
1449                call channel_manager$control (hmd.devx, "hangup", null (), code);
1450 
1451                return;
1452 %page;
1453 /* Internal to process_input_block:  Returns the specified number of characters (up to four) from the input block */
1454 
1455 substr_of_chain:
1456                procedure (p_start_idx, p_length) returns (character (4) varying);
1457 
1458 dcl  (p_start_idx, p_length) fixed binary parameter;
1459 dcl  the_text character (4) varying;
1460 dcl  (characters_to_skip, characters_to_pickup, characters_in_buffer, start) fixed binary;
1461 
1462                     blockp = first_bufferp;
1463                     the_text = "";                          /* nothing yet */
1464 
1465                     /*** Skip past those leading buffers which do not contain any of the desired substring */
1466                     characters_to_skip = p_start_idx - 1;
1467                     do while (buffer.tally <= characters_to_skip);
1468                          if buffer.next = 0 then go to BAD_INPUT_BLOCK;
1469                          characters_to_skip = characters_to_skip - buffer.tally;
1470                          blockp = pointer (ttybp, buffer.next);
1471                     end;
1472 
1473                     /*** Collect the characters of the substring */
1474                     start = characters_to_skip;             /* this buffer may contain some uninteresting data */
1475                     characters_to_pickup = p_length;        /* caller will never ask for more than 4 characters */
1476                     do while (characters_to_pickup > 0);
1477                          characters_in_buffer = min (characters_to_pickup, (buffer.tally - start));
1478                          begin;
1479 dcl  text_in_buffer character (characters_in_buffer) unaligned defined (buffer.chars (start));
1480                               the_text = the_text || text_in_buffer;
1481                          end;
1482                          characters_to_pickup = characters_to_pickup - characters_in_buffer;
1483                          if characters_to_pickup > 0 then do;
1484                               if buffer.next = 0 then go to BAD_INPUT_BLOCK;
1485                               blockp = pointer (ttybp, buffer.next);
1486                               start = 0;                    /* ... always from the beginning of subsequent buffers */
1487                          end;
1488                     end;
1489 
1490                     return (the_text);
1491 
1492                end substr_of_chain;
1493 %page;
1494 /* Internal to process_input_block:  Deletes the specified number of characters from the beginning of the input block */
1495 
1496 delete_leading_text:
1497                procedure (p_n_characters);
1498 
1499 dcl  p_n_characters fixed binary parameter;
1500 dcl  characters_left_to_delete fixed binary;
1501 
1502                     blockp = first_bufferp;
1503                     characters_left_to_delete = p_n_characters;
1504 
1505                     /*** Delete any leading buffers completely emptied by this delete operation */
1506                     do while (buffer.tally <= characters_left_to_delete);
1507                          if buffer.next ^= 0 then           /* ... there are more buffers */
1508                               first_bufferp = pointer (ttybp, buffer.next);
1509                          else go to BAD_INPUT_BLOCK;        /* ... should have been at least n_characters in the block */
1510                          characters_left_to_delete = characters_left_to_delete - buffer.tally;
1511                          call tty_space_man$free_buffer (hmd.devx, INPUT, blockp);
1512                          blockp = first_bufferp;
1513                     end;
1514 
1515                     /*** Delete the rest from this buffer as it has more than enough in it */
1516                     if characters_left_to_delete > 0 then call delete_text (blockp, 0, characters_left_to_delete);
1517 
1518                     return;
1519 
1520                end delete_leading_text;
1521 %page;
1522 /* Internal to process_input_block:  Remove the DLEs added to the chain for transparency's sake */
1523 
1524 strip_dles:    procedure ();
1525 
1526 dcl  buffer_text character (bufferp -> buffer.tally) unaligned based (addr (bufferp -> buffer.chars (0)));
1527 dcl  bufferp pointer;
1528 
1529 dcl (start, dle_idx) fixed binary;
1530 dcl  last_was_dle bit (1) aligned;
1531 
1532 
1533                     last_was_dle = "0"b;                    /* no previous buffer to end in DLE */
1534 
1535                     do bufferp = first_bufferp repeat (pointer (ttybp, bufferp -> buffer.next))
1536                               while (rel (bufferp) ^= ""b);
1537 
1538                          if last_was_dle then
1539                               start = 2;                    /* last in previous buffer a DLE: first here is escaped */
1540                          else start = 1;                    /* previous buffer ended normally */
1541 
1542                          last_was_dle = "0"b;
1543 
1544                          dle_idx = index (substr (buffer_text, start), DLE);
1545 
1546                          do while (dle_idx ^= 0);           /* scan buffer until no DLEs are found */
1547 
1548                               dle_idx = dle_idx + start - 1;     /* actual 1-based index in buffer */
1549 
1550                               if dle_idx < (bufferp -> buffer.tally) then
1551                                    call delete_text (bufferp, (dle_idx - 1), 1);     /* DLE in middle: delete it */
1552                               else do;                      /* DLE last in buffer: escaped character in next buffer */
1553                                    bufferp -> buffer.tally = (bufferp -> buffer.tally) - 1;
1554                                    last_was_dle = "1"b;
1555                               end;
1556 
1557                               start = dle_idx + 1;          /* "escaped" character now at dle_idx: start with next one */
1558 
1559                               if start > (bufferp -> buffer.tally) then
1560                                    dle_idx = 0;             /* have reached the end of this buffer */
1561                               else dle_idx = index (substr (buffer_text, start), DLE);
1562                          end;
1563                     end;
1564 
1565                     return;
1566 
1567                end strip_dles;
1568 %page;
1569 /* Process a real input block (not output returned by the FNP):  check for a foreign device going not-ready; validate the
1570    BCB; process the foreign FCS; process a bad BCB record; place input records onto the multiplexer's chain for later
1571    processing; notify waiting sub-channels that input has arrived */
1572 
1573 process_real_input_block:
1574                procedure ();
1575 
1576 dcl  chain_to_release_ptr pointer;
1577 dcl (expected_count, received_count, record_type, idx) fixed binary;
1578 dcl  new_wab_bit bit (1) aligned;
1579 
1580 
1581 /* FNP has detected a foreign device going not ready: save the current processing state and send a sync-block as soon as
1582    possible to tell the FNP that we have seen the state change and the FNP can send output to the remote system again */
1583 
1584                     if foreign_fcs.device_not_ready then do;
1585                          hmd.meters.n_wraparounds = hmd.meters.n_wraparounds + 1;
1586                          unspec (hmd.last_loopback_bcb) = "777"b3;
1587                          if hmd.minor_state = HMD_REPROCESS then /* in middle of reprocessing loopback: FNP is ... */
1588                               call push_loopback_block_chain (); /* ... returning said reprocessed data; it goes first */
1589                          call push_minor_state (HMD_SEND_SYNC_BLOCK);
1590                     end;
1591 
1592 
1593 /* BCB processing:  check that the received block count in the BCB is the expected value or that the BCB specifies that
1594    the block count is to be ignored or reset.  If the received block count is wrong, log a message and either drop the
1595    line or ignore the input block depending on the size and direction of the discrepency in the count */
1596 
1597                     expected_count = mod (hmd.foreign_block_count + 1, 16);
1598                     received_count = foreign_bcb.count;
1599 
1600                     if foreign_bcb.type = HASP_BCB_NORMAL then
1601                          if hmd.first_foreign_block
1602                          then do;                           /* first foreign block:  trust the count therein */
1603                               hmd.first_foreign_block = "0"b;
1604                               hmd.foreign_block_count = received_count;
1605                          end;
1606                          else if received_count = expected_count then /* correct value:  remember it */
1607                               hmd.foreign_block_count = received_count;
1608                          else                               /* bad block count -- determine appropriate action */
1609                          if ((received_count < expected_count) & ((expected_count - received_count) <= 3)) |
1610                             ((received_count > expected_count) & ((expected_count - received_count + 16) <= 3))
1611                          then do;                           /* duplicate block:  log, ignore data, process FCS */
1612                               hmd.meters.n_duplicate_input_blocks = hmd.meters.n_duplicate_input_blocks + 1;
1613                               call syserr (LOG_ONLY,
1614                                            "hasp_mpx (line ^a): Block received out of sequence: expected = ^d, received = ^d; block ignored.",
1615                                            hmd.name, expected_count, received_count);
1616                               first_bufferp -> buffer.tally = 1;  /* flush all but an RCB for end-of-block */
1617                               first_bufferp -> buffer.chars (0) = HASP_EOB_RCB;
1618                               last_bufferp = first_bufferp; /* this is now the only buffer in the block */
1619                               chain_to_release_ptr = pointer (ttybp, first_bufferp -> buffer.next);
1620                               first_bufferp -> buffer.next = 0;  /* break the chain now */
1621                               if rel (chain_to_release_ptr) ^= ""b then    /* some data to be discarded */
1622                                    call tty_space_man$free_chain (hmd.devx, INPUT, chain_to_release_ptr);
1623                          end;
1624                          else do;                           /* out of sync:  log, queue bad BCB record and hangup */
1625                               call syserr (LOG_AND_PRINT,
1626                                            "hasp_mpx (line ^a): Block received out of sequence: expected = ^d, received = ^d; line will be hungup.",
1627                                            hmd.name, expected_count, received_count);
1628                               call tty_space_man$free_chain (hmd.devx, INPUT, first_bufferp);
1629                               hmd.minor_state = HMD_SEND_BAD_BCB_BLOCK;
1630                               hmd.foreign_block_count = received_count;    /* set state and save info for the block */
1631                               hmd.local_block_count = expected_count;
1632                               return;
1633                          end;
1634 
1635                     else if foreign_bcb.type = HASP_BCB_IGNORE
1636                          then;                              /* ignore this block's counter */
1637 
1638                     else if foreign_bcb.type = HASP_BCB_RESET then
1639                          hmd.foreign_block_count = received_count - 1;     /* this is to be count of next block */
1640 
1641 
1642 /* FCS processing:  if the foreign FCS has changed from the last input record, reflect these changes in the multiplexer's
1643    local state.  The FCS bits control whether output may be sent to the individual devices at the foreign site */
1644 
1645                     hmd.meters.n_input_blocks = hmd.meters.n_input_blocks + 1;
1646 
1647                     string (foreign_fcs.mcs1) = ""b;        /* remove bits possibly added by FNP */
1648                     foreign_fcs.block_type = HASP_FCS_NORMAL_BLOCK;
1649 
1650                     if hmd.foreign_fcs_bytes ^= foreign_fcs_chars then do;
1651                                                             /* only if the foreign FCS has been changed */
1652                          hmd.foreign_fcs_bytes = foreign_fcs_chars;   /* for the next time around */
1653 
1654                          if foreign_fcs.system_wab & ^hmd.suspend_all_output then
1655                               hmd.meters.n_foreign_wab_set = hmd.meters.n_foreign_wab_set + 1;
1656                                                             /* foreign system just stopped taking output */
1657 
1658                          hmd.suspend_all_output = foreign_fcs.system_wab;
1659 
1660                          do idx = 1 to hmd.n_subchannels;
1661 
1662                               if hmd.subchannels(idx).direction = HSTE_INPUT_ONLY
1663                                    then;                    /* input only: never throttled by the foreign side */
1664 
1665                               else do;                      /* output device or console */
1666                                    if (hmd.subchannels(idx).device_wab_idx = 0) then
1667                                         new_wab_bit = foreign_fcs.console_wab;
1668                                    else if (hmd.subchannels(idx).device_wab_idx <= 4) then
1669                                         new_wab_bit = foreign_fcs.wab_bits1 (hmd.subchannels(idx).device_wab_idx);
1670                                    else new_wab_bit = foreign_fcs.wab_bits2 (hmd.subchannels(idx).device_wab_idx - 4);
1671                                    if ^new_wab_bit & hmd.output_wabs (hmd.subchannels(idx).device_wab_idx) then
1672                                         hmd.subchannels(idx).meters.device_n_foreign_wab_set =
1673                                              hmd.subchannels(idx).meters.device_n_foreign_wab_set + 1;
1674                                    hmd.output_wabs (hmd.subchannels(idx).device_wab_idx) = new_wab_bit;
1675                               end;
1676                          end;
1677                     end;
1678 
1679 
1680 /* Data processing:  classify the first record of the data.  Check for a bad BCB record (which is a separate block) and,
1681    if found, log the error and hangup the line (crashing the multiplexer).  Otherwise, if data is present in the block,
1682    save it for subsequent processing */
1683 
1684                     record_type = classify_record (first_bufferp, 0); /* it starts at the first character in buffer */
1685 
1686                     if record_type = HASP_EOB_RECORD
1687                     then do;                                /* no data records:  status block, some devices might be able
1688                                                                to send output now, so ask everyone who's waiting */
1689                          call tty_space_man$free_chain (hmd.devx, INPUT, first_bufferp);
1690                          call interrupt_subchannels_with_output ();
1691                     end;
1692 
1693                     else if record_type = HASP_BAD_BCB_RECORD
1694                     then do;                                /* foreign side detected out of sequence block: punt */
1695                          received_count = foreign_bcb.count;     /* extract the usefull information */
1696                          expected_count = addr (addr (first_bufferp -> buffer.chars (0)) -> based_bad_bcb_record.srcb) -> hasp_bcb_byte.count;
1697                          call syserr (LOG_AND_PRINT,
1698                                       "hasp_mpx (line ^a): Block transmitted out of sequence: expected = ^d, received = ^d; line will be hungup.",
1699                                       hmd.name, expected_count, received_count);
1700                          call channel_manager$control (hmd.devx, "hangup", null (), code);
1701                          call tty_space_man$free_chain (hmd.devx, INPUT, first_bufferp);
1702                     end;
1703 
1704                     else do;                                /* the block contains actual data:  save it for call time */
1705                          if hmd.input.first_bufferp = null () then
1706                               hmd.input.first_bufferp = first_bufferp;     /* first block of unprocessed input */
1707                          else hmd.input.last_bufferp -> buffer.next = binary (rel (first_bufferp), 18, 0);
1708                          hmd.input.last_bufferp = last_bufferp;  /* this is now last buffer */
1709                          call interrupt_subchannels_with_output ();
1710                     end;
1711 
1712                     return;
1713 
1714                end process_real_input_block;
1715 %page;
1716 /* Process a sync-block (internal to process_input_block): pop the minor state if the preiovus minor state was either
1717    send-sync or loopback as the multiplexer was in the process of receiving returned data from the FNP when another
1718    foreign device went not ready; otherwise, enter the reprocess minor state to retransmit the data returned by the FNP.
1719    If the multiplexer was reprocessing data when this wraparound occured, splice the just returned output in front of the
1720    output that was being reprocessed originally as the newly returned data must be part of the older returned data */
1721 
1722 process_sync_block:
1723                procedure ();
1724 
1725 dcl  previous_minor_state fixed binary;
1726 
1727                     call tty_space_man$free_chain (hmd.devx, INPUT, first_bufferp);
1728                                                             /* all done with this block */
1729 
1730                     if hmd.minor_state > HMD_REPROCESS then
1731                          return;                            /* multiplexer is preparing to shutdown */
1732 
1733                     if hmd.minor_state_stack = null () then
1734                          previous_minor_state = HMD_NORMAL; /* no saved minor state? */
1735                     else previous_minor_state = hmd.minor_state_stack -> msse.minor_state;
1736 
1737                     if (previous_minor_state = HMD_SEND_SYNC_BLOCK) | (previous_minor_state = HMD_LOOPBACK) then
1738                          call pop_minor_state ();           /* see above */
1739 
1740                     else do;
1741                          if previous_minor_state = HMD_REPROCESS then
1742                               call pop_loopback_block_chain ();  /* merge chains */
1743                          hmd.reset_local_block_count = "1"b;/* force a reset BCB to be sent */
1744                          hmd.minor_state = HMD_REPROCESS;
1745                     end;
1746 
1747                     return;
1748 
1749                end process_sync_block;
1750 
1751           end process_input_block;
1752 %page;
1753 /* Input records processing and loopbacked records processing */
1754 
1755 input_loopback_records_processor:
1756           procedure ();
1757 
1758                return;                                      /* not an entry */
1759 
1760 
1761 dcl  input_entry bit (1) aligned;                           /* ON => process_input_records vs. process_loopback_records */
1762 
1763 dcl  saved_hste_ptr pointer;                                /* -> sub-channel data of interest to caller: hste_ptr used
1764                                                                locally and must be preserved */
1765 
1766 dcl (start_bufferp, end_bufferp) pointer;                   /* -> buffer containing start/end of the current record */
1767 dcl (start_record_idx, end_record_idx) fixed binary;        /* index (0-based) in buffer of the current record's first and
1768                                                                last characters */
1769 
1770 dcl  rcb_char character (1) unaligned;                      /* RCB of the current record */
1771 dcl  srcb_char character (1) unaligned;                     /* SRCB of the current record */
1772 
1773 dcl 1 rcb unaligned based (addr (rcb_char)) like hasp_rcb_byte;
1774 
1775 dcl (continue_scan, record_was_taken) bit (1) aligned;
1776 
1777 dcl  bufferp pointer;
1778 dcl (record_type, record_tally, dle_count) fixed binary;
1779 %page;
1780 /* Process input records:  a read call has been issued by a sub-channel and there is input data whic needs to be split
1781    into individual records and assigned to their appropriate sub-channels.  Also, process any RTS or RTS acknowledgement
1782    records amongst the records */
1783 
1784 process_input_records:
1785           entry ();
1786 
1787                input_entry = "1"b;                          /* this is to process input records, not loopback records */
1788                needs_space = "0"b;
1789 
1790                saved_hste_ptr = hste_ptr;                   /* invoked at call time:  must not lose correct value */
1791 
1792                start_bufferp = hmd.input.first_bufferp;     /* start with the first piece of input */
1793                start_record_idx = 0;
1794 
1795                continue_scan = "1"b;                        /* will continue until we run out of space or input data */
1796 
1797                do while (continue_scan);
1798 
1799                     call find_next_record (start_bufferp, start_record_idx, "1"b, "0"b,
1800                                            end_bufferp, end_record_idx, record_tally, (0));
1801 
1802                     if end_bufferp ^= null ()
1803                     then do;
1804 
1805                          record_type = classify_record (start_bufferp, start_record_idx);
1806 
1807 
1808 /* Pick up the RCB and SRCB */
1809 
1810                          record_tally = record_tally - 1;   /* don't count the RCB as it's not passed to user ring */
1811 
1812                          rcb_char = start_bufferp -> buffer.chars (start_record_idx);
1813 
1814                          if (start_record_idx < (start_bufferp -> buffer.tally - 1))
1815                          then                               /* RCB is in middle of buffer */
1816                               srcb_char = start_bufferp -> buffer.chars (start_record_idx + 1);
1817 
1818                          else                               /* RCB is last character in this buffer ... */
1819                          if ((start_bufferp -> buffer.next) ^= 0) & (record_tally ^= 0)
1820                          then do;                           /* ... and more data exists in the record */
1821                               bufferp = pointer (ttybp, start_bufferp -> buffer.next);
1822                               srcb_char = bufferp -> buffer.chars (0);
1823                          end;
1824 
1825                          else do;                           /* ... and no more data exists in the record */
1826                               record_type = HASP_EOB_RECORD;
1827                               srcb_char = NUL;
1828                          end;
1829 
1830 
1831 /* Process the record according to its type */
1832 
1833                          if (record_type = HASP_DATA_RECORD) | (record_type = HASP_EOF_RECORD)
1834                          then do;
1835 
1836 /* Data records:  add the record to the input chain for the appropriate sub-channel if it can accept input.  If the device
1837    isn't the console and too many input records are present, request the foreign side to suspend further input */
1838 
1839                               hste_ptr = find_subchannel (rcb_char);  /* get the sub-channel for this record */
1840 
1841                               if hste_ptr ^= null () then
1842 
1843                                    if (hste.direction = HSTE_OUTPUT_ONLY) then
1844                                                             /* output only:  flush the record */
1845                                         call flush_record_buffers ();
1846 
1847                                    else do;                 /* input device: take the record */
1848                                         call move_record_to_device ();
1849                                         hste.meters.device_n_input_records = hste.meters.device_n_input_records + 1;
1850                                         if (record_type = HASP_EOF_RECORD) then
1851                                              hste.meters.device_n_input_eof_records = hste.meters.device_n_input_eof_records + 1;
1852                                         if hste.input.n_records >= hmd.max_device_input_records then
1853                                              if hste.device_type ^= HASP_CONSOLE
1854                                              then do;
1855                                                   if hmd.input_wabs (hste.device_wab_idx) then
1856                                                        hste.meters.device_n_local_wab_set = hste.meters.device_n_local_wab_set + 1;
1857                                                   hmd.input_wabs (hste.device_wab_idx) = "0"b;
1858                                              end;
1859                                    end;
1860 
1861                               else do;                      /* not configured:  flush record and disallow input... */
1862                                    call flush_record_buffers ();      /* ... OK to set the bit: system WAB will not be set */
1863                                    if (rcb.type = HASP_RCB_TYPE_READER_INPUT) | (rcb.type = HASP_RCB_TYPE_PRINT_OUTPUT) then
1864                                         hmd.input_wabs (rcb.stream) = "0"b;
1865                                    else if (rcb.type = HASP_RCB_TYPE_PUNCH_OUTPUT) then
1866                                         hmd.input_wabs (9 - rcb.stream) = "0"b;
1867                               end;
1868                          end;
1869 
1870 
1871                          else if (record_type = HASP_RTS_RECORD)
1872                          then do;
1873 
1874 /* Request-to-send record:  if the specified device is configured, queue an RTS acknowledgement record -- the
1875    acknowledgement is sent even though the device is not dialed up as some systems will send an RTS record, time out, and
1876    give up on the subchannel faster than Multics can load the multiplexer and dial-up all the subchannels */
1877 
1878                               hste_ptr = find_subchannel (srcb_char); /* this specified the device */
1879 
1880                               if hste_ptr ^= null () then
1881                                    if (hste.direction ^= HSTE_OUTPUT_ONLY) & (hste.device_type ^= HASP_CONSOLE) then
1882                                         hmd.send_rts_ack (hste.device_wab_idx) = "1"b;
1883 
1884                               call flush_record_buffers ();
1885                          end;
1886 
1887 
1888                          else if (record_type = HASP_RTS_ACK_RECORD)
1889                          then do;
1890 
1891 /* RTS acknowledgement record:  indicate that the specific sub-channel may now send output.  If the device is waiting to
1892    send output, give it a SEND OUTPUT interrupt */
1893 
1894                               hste_ptr = find_subchannel (srcb_char);
1895 
1896                               if hste_ptr ^= null () then do;
1897                                    hste.minor_state = HSTE_NORMAL;
1898                                    if hste.holding_output then do;
1899                                         call dequeue_subchannel_for_output ();
1900                                         call channel_manager$interrupt (hste.devx, SEND_OUTPUT, ""b);
1901                                    end;
1902                               end;
1903 
1904                               call flush_record_buffers ();
1905                          end;
1906 
1907                          else call flush_record_buffers (); /* end-of-block, SIGNON, others:  just flush it */
1908 
1909 
1910 /* Update pointers to the next record in the block (if any) */
1911 
1912                          if end_bufferp = null () then
1913                               start_bufferp = null ();      /* record was last in chain:  don't look for next one */
1914 
1915                          else if (end_record_idx + 1) = (end_bufferp -> buffer.tally)
1916                          then do;                           /* record ends at end of buffer:  go to next one */
1917                               if end_bufferp -> buffer.next = 0 then
1918                                    start_bufferp = null ();
1919                               else start_bufferp = pointer (ttybp, end_bufferp -> buffer.next);
1920                               start_record_idx = 0;
1921                               call tty_space_man$free_buffer (hmd.devx, INPUT, end_bufferp);
1922                          end;
1923 
1924                          else do;                           /* more data in this buffer */
1925                               start_bufferp = end_bufferp;
1926                               start_record_idx = end_record_idx + 1;
1927                          end;
1928 
1929                          hmd.meters.n_input_records = hmd.meters.n_input_records + 1;
1930 
1931                          continue_scan = (start_bufferp ^= null ());
1932                     end;
1933 
1934                     else continue_scan = "0"b;              /* no more complete records in the chain */
1935                end;
1936 
1937 
1938 RETURN_FROM_PROCESS_INPUT_RECORDS:
1939                if start_bufferp ^= null () then             /* didn't process the entire chain:  return the rest */
1940                     if start_record_idx ^= 0 then           /* some processed stuff in this buffer should be flushed */
1941                          call delete_text (start_bufferp, 0, start_record_idx);
1942 
1943                hmd.input.first_bufferp = start_bufferp;
1944 
1945                if start_bufferp = null () then              /* got all of it */
1946                     hmd.input.last_bufferp = null ();
1947 
1948                hmd.retry_process_input = needs_space;
1949                if needs_space then                          /* couldn't process it all right now */
1950                     call tty_space_man$needs_space (hmd.devx);
1951 
1952                hste_ptr = saved_hste_ptr;                   /* so caller will be happy */
1953 
1954                return;
1955 %page;
1956 /* Process loopback records: called after all loopbacked output blocks have been returned by the FNP and the FNP has
1957    requested more output.  Process each record in the chain of loopbacked blocks by either (1) placing the record into a
1958    new output block if the device is not suspended or (2) placing the record onto the individual loopback chain of the
1959    device.  Stop processing when either (1) the new output block is full (can't include a zero length record) or (2) the
1960    chain of loopbacked blocks is exhausted.  Finally, transmit the newly created output block (if any) */
1961 
1962 process_loopback_records:
1963           entry ();
1964 
1965                input_entry = "0"b;                          /* this is to process loopback records, not input records */
1966                needs_space = "0"b;
1967 
1968                saved_hste_ptr = hste_ptr;                   /* invoked at call time:  must not lose correct value */
1969 
1970                start_bufferp = hmd.loopback.first_bufferp;  /* start with the first piece of loopback */
1971                start_record_idx = 0;
1972 
1973                continue_scan = ^full_output_blockp () &     /* while there's some room in the output block ... */
1974                                (hmd.loopback.first_bufferp ^= null ());    /* ... and something to work on */
1975 
1976                do while (continue_scan);
1977 
1978                     call find_next_record (start_bufferp, start_record_idx, "1"b, "1"b,
1979                                            end_bufferp, end_record_idx, record_tally, dle_count);
1980 
1981                     if end_bufferp ^= null ()
1982                     then do;
1983 
1984                          record_type = classify_record (start_bufferp, start_record_idx);
1985 
1986 
1987 /* Pick up the RCB and SRCB */
1988 
1989                          record_tally = record_tally - 1;   /* don't count the RCB as it's not passed to user ring */
1990 
1991                          rcb_char = start_bufferp -> buffer.chars (start_record_idx);
1992 
1993                          if (start_record_idx < (start_bufferp -> buffer.tally - 1))
1994                          then                               /* RCB is in middle of buffer */
1995                               srcb_char = start_bufferp -> buffer.chars (start_record_idx + 1);
1996 
1997                          else                               /* RCB is last character in this buffer ... */
1998                          if ((start_bufferp -> buffer.next) ^= 0) & (record_tally ^= 0)
1999                          then do;                           /* ... and more data exists in the record */
2000                               bufferp = pointer (ttybp, start_bufferp -> buffer.next);
2001                               srcb_char = bufferp -> buffer.chars (0);
2002                          end;
2003 
2004                          else do;                           /* ... and no more data exists in the record */
2005                               record_type = HASP_EOB_RECORD;
2006                               srcb_char = NUL;
2007                          end;
2008 
2009 
2010 /* Process the record according to its type */
2011 
2012                          if (record_type = HASP_DATA_RECORD) | (record_type = HASP_EOF_RECORD)
2013                          then do;
2014 
2015 /* Data records:  try to put the record in the output block being built; otherwise, hand the record back to the device for
2016    later processing */
2017 
2018                               hste_ptr = find_subchannel (rcb_char);  /* get the sub-channel for this record */
2019 
2020                               if hste_ptr ^= null () then
2021 
2022                                    if hste.direction = HSTE_INPUT_ONLY then
2023                                         call flush_record_buffers (); /* input only: couldn't have sent the record */
2024 
2025                                    else if hmd.output_wabs (hste.device_wab_idx) &
2026                                            (hste.loopback.first_bufferp = null ())
2027                                    then do;                 /* device is ready and not already holding records */
2028                                         call process_single_loopback_record (start_bufferp, (start_record_idx + 1),
2029                                                                              end_bufferp, end_record_idx, record_tally,
2030                                                                              dle_count, record_was_taken);
2031                                              if needs_space then /* can't do it now */
2032                                                   go to RETURN_FROM_PROCESS_LOOPBACK_RECORDS;
2033                                         if record_was_taken then /* in output block now */
2034                                              call flush_record_buffers ();
2035                                         else call move_record_to_device ();     /* try later */
2036                                    end;
2037 
2038                                    else call move_record_to_device ();     /* device is suspended */
2039 
2040                               else call flush_record_buffers (); /* not configured: couldn't have sent it */
2041                          end;
2042 
2043 
2044                          else if (record_type = HASP_RTS_RECORD)
2045                          then do;
2046 
2047 /* Request-to-send record: this output sub-channel requested permission to send a file.  The actual RTS record is thrown
2048    away as it will be recreated; if, however, this is the first record of loopbacked output, then the sub-channel was
2049    previously not transmitting a file, and its state should be changed to force generation of an RTS record */
2050 
2051                               hste_ptr = find_subchannel (srcb_char); /* this specified the device */
2052 
2053                               if hste_ptr ^= null () then
2054                                    if hste.loopback.first_bufferp = null () then
2055                                         hste.minor_state = HSTE_SEND_RTS;
2056 
2057                               call flush_record_buffers ();
2058                          end;
2059 
2060 
2061                          else if (record_type = HASP_RTS_ACK_RECORD)
2062                          then do;
2063 
2064 /* RTS acknowledgement record: this record was being sent in response to an RTS record for one of our devices.  Turn the
2065    appropriate bit back on so that the record will be sent again */
2066 
2067                               hste_ptr = find_subchannel (srcb_char);
2068 
2069                               if hste_ptr ^= null () then
2070                                    hmd.send_rts_ack (hste.device_wab_idx) = "1"b;
2071 
2072                               call flush_record_buffers ();
2073                          end;
2074 
2075 
2076                          else call flush_record_buffers (); /* anything else can be ignored */
2077                                                             /* SIGNON records are ignored as process_output_block will
2078                                                                rebuild them automatically */
2079 
2080 
2081 /* Update pointers to the next record in the block (if any) */
2082 
2083                          if end_bufferp = null () then
2084                               start_bufferp = null ();      /* record was last in chain:  don't look for next one */
2085 
2086                          else if (end_record_idx + 1) = (end_bufferp -> buffer.tally)
2087                          then do;                           /* record ends at end of buffer:  go to next one */
2088                               if end_bufferp -> buffer.next = 0 then
2089                                    start_bufferp = null ();
2090                               else start_bufferp = pointer (ttybp, end_bufferp -> buffer.next);
2091                               start_record_idx = 0;
2092                               call tty_space_man$free_buffer (hmd.devx, INPUT, end_bufferp);
2093                          end;
2094 
2095                          else do;                           /* more data in this buffer */
2096                               start_bufferp = end_bufferp;
2097                               start_record_idx = end_record_idx + 1;
2098                          end;
2099 
2100                          continue_scan = (start_bufferp ^= null ()) & /* something left in loopback chain ... */
2101                                          ^full_output_blockp ();      /* ... and still room in the output block */
2102                     end;
2103 
2104                     else continue_scan = "0"b;              /* no more complete records in the chain (shouldn't happen) */
2105                end;
2106 
2107 
2108 /* Post processing: transmit the output block if necessary and, if all loopbacked records have been processed, exit
2109    HMD_REPROCESS state and return to the previous state */
2110 
2111 RETURN_FROM_PROCESS_LOOPBACK_RECORDS:
2112                if start_bufferp ^= null () then             /* didn't process the entire chain:  return the rest */
2113                     if start_record_idx ^= 0 then           /* some processed stuff in this buffer should be flushed */
2114                          call delete_text (start_bufferp, 0, start_record_idx);
2115 
2116                hmd.loopback.first_bufferp = start_bufferp;
2117 
2118                if start_bufferp = null () then              /* got all of it */
2119                     hmd.loopback.last_bufferp = null ();
2120 
2121                hmd.retry_process_loopback_records = needs_space;
2122                if needs_space then                          /* couldn't reprocess it all now */
2123                     call tty_space_man$needs_space (hmd.devx);
2124                else call process_output_block ();           /* enough room: ship what we just built */
2125 
2126                if hmd.loopback.first_bufferp = null () then do;
2127                     call pop_minor_state ();                /* involves much work */
2128                     if (hmd.minor_state = HMD_NORMAL) then  /* OK for subchannels to send output again */
2129                          call interrupt_subchannels_with_output ();
2130                end;
2131 
2132                hste_ptr = saved_hste_ptr;                   /* so caller will be happy */
2133 
2134                return;
2135 %page;
2136 /* Internal to input_loopback_records_processor:  find the sub-channel corresponding to the given RCB */
2137 
2138 find_subchannel: procedure (P_rcb_char) returns (pointer);
2139 
2140 dcl  P_rcb_char character (1) unaligned parameter;
2141 
2142 dcl  idx fixed binary;
2143 
2144 
2145                     do idx = 1 to hmd.n_subchannels;
2146 
2147                          if (hmd.subchannels(idx).device_type = HASP_CONSOLE) then   /* console is special case */
2148                               if (P_rcb_char = HASP_CONSOLE_INPUT_RCB) | (P_rcb_char = HASP_CONSOLE_OUTPUT_RCB) then
2149                                    return (addr (hmd.subchannels (idx)));
2150                               else;                         /* not the console */
2151 
2152                          else if (hmd.subchannels(idx).rcb = P_rcb_char) then
2153                               return (addr (hmd.subchannels (idx)));
2154                     end;
2155 
2156                     return (null ());                       /* no such sub-channel is configured */
2157 
2158                end find_subchannel;
2159 %page;
2160 /* Internal to input_loopback_records_processor:  free all the buffers containing this record except for the last buffer
2161    as it also contains the next record */
2162 
2163 flush_record_buffers:
2164                procedure ();
2165 
2166 dcl (bufferp, p) pointer;
2167 
2168                     bufferp = start_bufferp;
2169 
2170                     do while (bufferp ^= null ());
2171 
2172                          if bufferp = end_bufferp then      /* never free the last buffer of the record:  caller will */
2173                               bufferp = null ();
2174 
2175                          else do;                           /* some buffer in the middle of the record */
2176                               if (bufferp -> buffer.next) = 0 then
2177                                    p = null ();             /* last buffer:  this shouldn't occur, but ... */
2178                               else p = pointer (ttybp, bufferp -> buffer.next);
2179                               call tty_space_man$free_buffer (hmd.devx, INPUT, bufferp);
2180                               bufferp = p;
2181                          end;
2182                     end;
2183 
2184                     return;
2185 
2186                end flush_record_buffers;
2187 %page;
2188 /* Internal to input_loopback_records_processor:  move the current record to the input/loopback chain of the selected
2189    sub-channel.  The record is, in the process, copied into new buffers of the size requested for the sub-channel */
2190 
2191 move_record_to_device:
2192                procedure ();
2193 
2194 dcl 1 record_data aligned based (record_data_ptr) like hste.input;
2195 dcl  record_data_ptr pointer;
2196 
2197 dcl  substring character (substr_lth) unaligned based;
2198 dcl  substr_lth fixed binary;
2199 
2200 dcl (first_output_bufferp, last_output_bufferp, current_output_bufferp, current_input_bufferp, p) pointer;
2201 dcl (buffer_size_code, n_buffers, n_words_in_last_buffer, idx, amount_to_copy, current_input_idx,
2202      space_needed, space_left) fixed binary;
2203 dcl  direction bit (1);
2204 
2205 
2206                     if input_entry then
2207                          direction = INPUT;
2208                     else direction = OUTPUT;                /* loopback records:  will be freed as output records */
2209 
2210                     buffer_size_code = divide (hste.dialup_info.max_buf_size, 16, 17, 0) - 1;
2211 
2212                     n_buffers = divide ((record_tally + max_buffer_tally (buffer_size_code) - 1),
2213                                         max_buffer_tally (buffer_size_code), 17, 0);
2214 
2215                     if n_buffers = 1 then
2216                          first_output_bufferp = null ();    /* only one buffer:  created below */
2217 
2218                     else do;                                /* more than 1 buffer:  all but last one are maximum size */
2219                          call tty_space_man$get_chain (hste.devx, (hste.dialup_info.max_buf_size), (n_buffers - 1),
2220                                                        direction, first_output_bufferp);
2221                               if first_output_bufferp = null () then go to CANT_MOVE_RECORD_TO_DEVICE;
2222                          last_output_bufferp = first_output_bufferp;
2223                          do idx = 1 to (n_buffers - 2);     /* find the last buffer:  chase the chain to its end */
2224                               last_output_bufferp = pointer (ttybp, last_output_bufferp -> buffer.next);
2225                          end;
2226                     end;
2227 
2228                     n_words_in_last_buffer =                /* need a buffer big enough for remainder of record */
2229                          16 * divide ((record_tally - (n_buffers - 1) * max_buffer_tally (buffer_size_code)) + 67, 64, 17, 0);
2230 
2231                     call tty_space_man$get_buffer (hste.devx, n_words_in_last_buffer, direction, current_output_bufferp);
2232                          if current_output_bufferp = null () then do;
2233                               if first_output_bufferp ^= null () then
2234                                    call tty_space_man$free_chain (hste.devx, direction, first_output_bufferp);
2235                               go to CANT_MOVE_RECORD_TO_DEVICE;
2236                          end;
2237 
2238                     if first_output_bufferp = null () then  /* only buffer needed */
2239                          first_output_bufferp = current_output_bufferp;
2240                     else last_output_bufferp -> buffer.next = binary (rel (current_output_bufferp), 18, 0);
2241 
2242                     last_output_bufferp = current_output_bufferp;     /* remember both ends of the chain */
2243 
2244                     amount_to_copy = record_tally;          /* copy the entire record */
2245 
2246                     current_input_bufferp = start_bufferp;
2247                     current_input_idx = start_record_idx + 1;    /* skip the RCB */
2248 
2249                     current_output_bufferp = first_output_bufferp;
2250 
2251                     do while (amount_to_copy > 0);
2252 
2253                          space_left = max_buffer_tally (current_output_bufferp -> buffer.size_code) -
2254                                          (current_output_bufferp -> buffer.tally);
2255                          space_needed = min ((current_input_bufferp -> buffer.tally - current_input_idx), amount_to_copy);
2256 
2257                          if space_left >= space_needed then
2258                               substr_lth = space_needed;    /* enough room for this piece of the buffer */
2259                          else substr_lth = space_left;      /* only copy a small piece */
2260 
2261                          addr (current_output_bufferp -> buffer.chars (current_output_bufferp -> buffer.tally)) -> substring
2262                               = addr (current_input_bufferp -> buffer.chars (current_input_idx)) -> substring;
2263 
2264                          current_output_bufferp -> buffer.tally = (current_output_bufferp -> buffer.tally) + substr_lth;
2265                          current_input_idx = current_input_idx + substr_lth;
2266                          amount_to_copy = amount_to_copy - substr_lth;
2267 
2268                          if (amount_to_copy > 0) & (current_input_idx = (current_input_bufferp -> buffer.tally))
2269                          then do;                           /* used up this input buffer:  free it (if OK) and go on */
2270                               if (current_input_bufferp -> buffer.next) = 0
2271                               then do;                      /* no more input????? */
2272                                    p = null ();
2273                                    amount_to_copy = 0;      /* avoid null pointer faults (sigh) */
2274                               end;
2275                               else p = pointer (ttybp, current_input_bufferp -> buffer.next);
2276                               if current_input_bufferp ^= end_bufferp then
2277                                    call tty_space_man$free_buffer (hmd.devx, INPUT, current_input_bufferp);
2278                                                             /* never free the last buffer of a record */
2279                               current_input_bufferp = p;
2280                               current_input_idx = 0;
2281                          end;
2282 
2283                          if (amount_to_copy > 0) &          /* if there is stuff left to copy ... */
2284                             ((current_output_bufferp -> buffer.tally) =
2285                              max_buffer_tally (current_output_bufferp -> buffer.size_code))
2286                          then                               /* ... and used up this output buffer:  grab next one */
2287                          if (current_output_bufferp -> buffer.next) = 0 then
2288                                    amount_to_copy = 0;      /* ran out of buffer space????? */
2289                               else current_output_bufferp = pointer (ttybp, current_output_bufferp -> buffer.next);
2290                     end;
2291 
2292                     if current_output_bufferp ^= last_output_bufferp then do;
2293                                                             /* didn't use the entire chain allocated */
2294                          p = pointer (ttybp, current_output_bufferp -> buffer.next);
2295                          call tty_space_man$free_chain (hste.devx, direction, p);
2296                          current_output_bufferp -> buffer.next = 0;
2297                          last_output_bufferp = current_output_bufferp;     /* new end of the chain (sigh) */
2298                     end;
2299 
2300                     if input_entry then
2301                          record_data_ptr = addr (hste.input);    /* processing input records */
2302                     else record_data_ptr = addr (hste.loopback);
2303 
2304                     last_output_bufferp -> buffer.break = "1"b;  /* end of a record */
2305 
2306                     if record_data.first_bufferp = null () then
2307                          record_data.first_bufferp = first_output_bufferp;
2308                     else record_data.last_bufferp -> buffer.next = binary (rel (first_output_bufferp), 18, 0);
2309 
2310                     record_data.last_bufferp = last_output_bufferp;
2311 
2312                     record_data.n_records = record_data.n_records + 1;
2313 
2314                     return;
2315 
2316 
2317 
2318 /* Not being able to allocate buffers for the input record transfers here */
2319 
2320 CANT_MOVE_RECORD_TO_DEVICE:
2321                     needs_space = "1"b;
2322                     if input_entry then
2323                          go to RETURN_FROM_PROCESS_INPUT_RECORDS;
2324                     else go to RETURN_FROM_PROCESS_LOOPBACK_RECORDS;
2325 
2326                end move_record_to_device;
2327 
2328           end input_loopback_records_processor;
2329 %page;
2330 /* Process an output block:  if output is not suspended, compute the new local BCB and FCS, complete the current output
2331    block by adding the block trailer, and start transmission of the block to the FNP.  If there is no partial block
2332    waiting to be sent, send a status block or a block with an RTS record or RTS acknowledgment record when necessary */
2333 
2334 process_output_block:
2335           procedure ();
2336 
2337 dcl  local_bcb_char character (1) unaligned;                /* the BCB ... */
2338 dcl  local_fcs_chars character (2) unaligned;               /* ... and the FCS for this output block */
2339 
2340 dcl 1 local_bcb unaligned based (addr (local_bcb_char)) like hasp_bcb_byte;
2341 dcl 1 local_fcs unaligned based (addr (local_fcs_chars)) like hasp_fcs_bytes;
2342 
2343 dcl  saved_hste_ptr pointer;
2344 dcl  idx fixed binary;
2345 
2346 
2347 /* Check for permission to send a block to the FNP */
2348 
2349                if hmd.output_in_progress then               /* finish what was already started */
2350                     call transmit_output_block ();
2351 
2352                if ^hmd.send_output then return;             /* no permission: don't bother to finish building the block */
2353 
2354                if hmd.suspend_all_output &                  /* remote wants us not to send anything */
2355                   (hmd.minor_state ^= HMD_SEND_SYNC_BLOCK) &     /* and needn't send special sync-block for FNP */
2356                   (hmd.minor_state ^= HMD_SEND_BAD_BCB_BLOCK) &  /* and needn't send a bad BCB error block */
2357                   (hmd.minor_state ^= HMD_HANGUP_LINE)      /* and needn't hangup the line to punt after fatal error */
2358                then
2359                     return;
2360 
2361 
2362                if (hmd.minor_state = HMD_HANGUP_LINE) then
2363 
2364 /* Fatal error:  An error fatal to the operation of the multiplexer (eg: out of sequence input blocks) has occurred which
2365    needed to be acknowledged by a message from the multiplexer.  That message has been sent out to the FNP and the line
2366    should now be hungup which will crash the multiplexer */
2367 
2368                     call channel_manager$control (hmd.devx, "hangup", null (), code);
2369 
2370 
2371                else if (hmd.minor_state = HMD_SEND_BAD_BCB_BLOCK)
2372                then do;
2373 
2374 /* Out of sequence input block:  An input block was received which was out of sequence.  The multiplexer must now format
2375    and transmit a bad BCB error block to the foreign side before breaking the connection */
2376 
2377                     if hmd.output_block.first_bufferp ^= null ()
2378                     then do;                                /* throw out partial output block:  no need for it */
2379                          call tty_space_man$free_chain (hmd.devx, OUTPUT, hmd.output_block.first_bufferp);
2380                          hmd.output_block.first_bufferp = null ();
2381                     end;
2382 
2383                     call tty_space_man$get_buffer (hmd.devx, 16, OUTPUT, blockp);
2384                          if blockp = null () then go to CANT_FINISH_PROCESS_OUTPUT_BLOCK;
2385 
2386                     addr (buffer.chars (0)) -> based_bad_bcb_block = TEMPLATE_HASP_BAD_BCB_BLOCK;
2387                     buffer.tally = length (string (TEMPLATE_HASP_BAD_BCB_BLOCK));
2388 
2389                     addr (addr (buffer.chars (0)) -> based_bad_bcb_block.bcb) -> hasp_bcb_byte.count =
2390                          hmd.foreign_block_count;           /* this is what was received */
2391 
2392                     addr (addr (buffer.chars (0)) -> based_bad_bcb_block.srcb) -> hasp_bcb_byte.count =
2393                          hmd.local_block_count;             /* this is what was expected */
2394 
2395                     hmd.output_block.tally = buffer.tally;  /* fill in information about the block */
2396                     hmd.output_block.first_bufferp, hmd.output_block.last_bufferp = blockp;
2397 
2398                     hmd.minor_state = HMD_HANGUP_LINE;      /* hangup the connection after the block is transmitted */
2399                end;
2400 
2401 
2402                else if ^empty_output_blockp ()
2403                then do;
2404 
2405 /* Have partial output block:  compute local BCB and FCS, add the block trailer, and ship the block */
2406 
2407                     call compute_local_bcb_and_fcs ();
2408                     call finish_output_block ();
2409                end;
2410 
2411 
2412                else if ((hmd.minor_state = HMD_SEND_SIGNON) | (hmd.minor_state = HMD_REPROCESS)) &
2413                        (hmd.signon_data_ptr ^= null ())
2414                then do;
2415 
2416 /* No partial block and a SIGNON record needs to be transmitted: create the SIGNON record block and mark it as requiring
2417    an acknowledgement from the FNP; the acknowledgement from the FNP is used as the signal that the other sub-channels of
2418    the multiplexer may be dialed-up and normal data transfer may commence.  Checking hmd.signon_data_ptr and the minor
2419    state is sufficient as the minor state is changed upon transmission and the data block is not freed until the FNP
2420    acknowledges the message */
2421 
2422                     call compute_local_bcb_and_fcs ();
2423 
2424                     if hmd.output_block.first_bufferp ^= null () then /* we'll create our own buffers shortly */
2425                          call tty_space_man$free_chain (hmd.devx, OUTPUT, hmd.output_block.first_bufferp);
2426 
2427                     call tty_space_man$get_buffer (hmd.devx, 32, OUTPUT, blockp);
2428                          if blockp = null () then go to CANT_FINISH_PROCESS_OUTPUT_BLOCK;
2429 
2430                     hmd.output_block.first_bufferp,         /* the only buffer in the block */
2431                          hmd.output_block.last_bufferp = blockp;
2432 
2433                     addr (buffer.chars (0)) -> based_signon_block.header = TEMPLATE_HASP_SIGNON_BLOCK.header;
2434                     addr (buffer.chars (0)) -> based_signon_block.record = hmd.signon_data_ptr -> hmd_signon_data.record;
2435                     hmd.output_block.tally,                 /* how much just used */
2436                          buffer.tally = length (string (TEMPLATE_HASP_SIGNON_BLOCK.non_trailer));
2437                     hmd.meters.n_output_records = hmd.meters.n_output_records + 1;
2438 
2439                     call finish_output_block ();            /* shouldn't grab another buffer... */
2440                     addr (addr (buffer.chars (0)) -> based_block_header.fcs) -> hasp_fcs_bytes.block_type =
2441                          HASP_FCS_ACKNOWLEDGE_BLOCK;        /* tell us when it gets sent */
2442 
2443                     if hmd.minor_state = HMD_SEND_SIGNON then    /* not in loopback processing */
2444                          hmd.minor_state = HMD_WAIT_SIGNON_RESPONSE;  /* ... wait for the reply */
2445                end;
2446 
2447 
2448                else if (hmd.minor_state = HMD_NORMAL)
2449                then do;
2450 
2451 /* No partial block and multiplexer running normally: scan for any loopbacked records which couldn't be transmitted
2452    before (the remote device wasn't ready) but can be sent now */
2453 
2454                     saved_hste_ptr = hste_ptr;              /* need to use this value */
2455 
2456                     do idx = 1 to hmd.n_subchannels         /* check them all ... */
2457                               while (^full_output_blockp ());    /* ... while there's still room */
2458                          hste_ptr = addr (hmd.subchannels (idx));
2459 
2460                          if (hste.direction ^= HSTE_INPUT_ONLY) & hmd.output_wabs (hste.device_wab_idx) then
2461                                                             /* it's a ready output device ... */
2462                               if (hste.loopback.first_bufferp ^= null ())
2463                               then do;                      /* ... and it has some loopbacked data */
2464                                    call process_subchannel_loopback_records ();
2465                                         if needs_space then /* couldn't finish */
2466                                              go to CANT_FINISH_PROCESS_OUTPUT_BLOCK;
2467                                    if (hste.loopback.first_bufferp = null ()) then do;
2468                                                             /* took all of it: subchannel can send output again */
2469                                         call dequeue_subchannel_for_output ();
2470                                         call channel_manager$interrupt_later (hste.devx, SEND_OUTPUT, ""b);
2471                                    end;
2472                               end;
2473                     end;
2474 
2475                     hste_ptr = saved_hste_ptr;              /* done with it so restore it */
2476 
2477                     if empty_output_blockp () then
2478                          go to TRY_STATUS_OR_RTS_BLOCK;     /* nothing found: try to make status, RTS, or RTS ack block */
2479                     else do;                                /* got something: done with this output block */
2480                          call compute_local_bcb_and_fcs ();
2481                          call finish_output_block ();
2482                     end;
2483                end;
2484 
2485 
2486                else if ((hmd.minor_state = HMD_NORMAL) | (hmd.minor_state = HMD_REPROCESS)) & empty_output_blockp ()
2487                then do;
2488 
2489 /* No partial block: create and transmit a block iff the local FCS has changed or an RTS record or an RTS acknowledgement
2490    record needs to be sent */
2491 
2492 TRY_STATUS_OR_RTS_BLOCK:
2493                     call compute_local_bcb_and_fcs ();
2494 
2495                     if (hmd.local_fcs_bytes ^= local_fcs_chars) |
2496                        (string (hmd.send_rts) ^= ""b) | (string (hmd.send_rts_ack) ^= ""b)
2497                     then do;
2498 
2499                          if (hmd.output_block.first_bufferp = null ())
2500                          then do;                           /* no empty block already started */
2501 
2502                               call tty_space_man$get_buffer (hmd.devx, 16, OUTPUT, blockp);
2503                                    if blockp = null () then go to CANT_FINISH_PROCESS_OUTPUT_BLOCK;
2504 
2505                               hmd.output_block.first_bufferp,         /* the only buffer in the block */
2506                                    hmd.output_block.last_bufferp = blockp;
2507 
2508                               addr (buffer.chars (0)) -> based_block_header = TEMPLATE_HASP_BLOCK_HEADER;
2509                               hmd.output_block.tally,
2510                                    buffer.tally = length (string (TEMPLATE_HASP_BLOCK_HEADER));
2511                          end;
2512 
2513                          call add_rts_or_rts_ack_record ();
2514                          call finish_output_block ();
2515                     end;
2516                end;
2517 
2518 
2519                else if (hmd.minor_state = HMD_SEND_SYNC_BLOCK)
2520                then do;
2521 
2522 /* Starting a loopback:  the FNP detected (from the FCS received in an input block) that one of the foreign devices just
2523    went not-ready.  It is possible that the FNP has (or is receiving) one or more output blocks containing records for
2524    that device.  Thus, the FNP has entered "loopback" state wherein it will return all output blocks it has or we send it
2525    until it returns the specially formatted block known as a sync-block */
2526 
2527                     call tty_space_man$get_buffer (hmd.devx, 16, OUTPUT, blockp);
2528                          if blockp = null () then go to CANT_FINISH_PROCESS_OUTPUT_BLOCK;
2529 
2530                     addr (buffer.chars (0)) -> based_sync_block = TEMPLATE_HASP_SYNC_BLOCK;
2531                     buffer.tally = length (string (TEMPLATE_HASP_SYNC_BLOCK));
2532 
2533                     hmd.output_block.tally = buffer.tally;  /* fill in information about the block */
2534                     hmd.output_block.first_bufferp, hmd.output_block.last_bufferp = blockp;
2535 
2536                     hmd.minor_state = HMD_LOOPBACK;         /* multiplexer now expects output blocks to be returned */
2537                end;
2538 
2539 
2540                else if (hmd.minor_state = HMD_LOOPBACK) then
2541                     return;                                 /* already in loopback (see above):  send no output */
2542 
2543                else if (hmd.minor_state = HMD_WAIT_SIGNON_RESPONSE) then
2544                     return;                                 /* waiting for response from foreign system to SIGNON */
2545 
2546 
2547 /* Begin transmission of the output block to the FNP and, if the multiplexer is not in an exceptional state, request all
2548    waiting sub-channels to send more output */
2549 
2550                if ^empty_output_blockp () then do;          /* tests at entry guarentee that no output is in progress */
2551                     hmd.meters.n_output_blocks = hmd.meters.n_output_blocks + 1;
2552                     hmd.output_chain_ptr = hmd.output_block.first_bufferp;
2553 
2554                     hmd.output_block.tally = 0;             /* "empty" the output block for next time around */
2555                     hmd.output_block.first_bufferp, hmd.output_block.last_bufferp = null ();
2556 
2557                     if hmd.trace_mode then                  /* requested trace of all I/O with the FNP */
2558                          call trace_block (hmd.output_chain_ptr, OUTPUT);
2559 
2560                     call transmit_output_block ();          /* send it */
2561 
2562                     if hmd.minor_state = HMD_NORMAL then    /* all is well:  can accept more output */
2563                          call interrupt_subchannels_with_output ();
2564                end;
2565 
2566                hmd.retry_process_output = "0"b;             /* didn't run out of tty_buf space */
2567 
2568                return;
2569 
2570 
2571 /* Not being able to allocate a buffer transfers here:  queue a request to be informed when space is available */
2572 
2573 CANT_FINISH_PROCESS_OUTPUT_BLOCK:
2574                hmd.retry_process_output = "1"b;
2575                call tty_space_man$needs_space (hmd.devx);
2576                return;
2577 %page;
2578 /* Internal to process_output_block:  compute the local BCB and FCS for the next block to be transmitted */
2579 
2580 compute_local_bcb_and_fcs:
2581                procedure ();
2582 
2583 dcl  idx fixed binary;
2584 
2585 /* Construct the BCB:  get the next block number (modulo 16) from the previous block count unless requested to reset
2586    the counter; when resetting, the counter is always set to zero */
2587 
2588                     local_bcb_char = NUL;
2589                     local_bcb.mbo1 = "1"b;                  /* make it not be an EBCDIC control character */
2590 
2591                     if hmd.reset_local_block_count then     /* reset count to zero: local_bcb.count is already zero */
2592                          local_bcb.type = HASP_BCB_RESET;
2593                     else do;
2594                          local_bcb.type = HASP_BCB_NORMAL;
2595                          local_bcb.count = mod (hmd.local_block_count + 1, 16);
2596                     end;
2597 
2598 
2599 /* Construct the FCS:  examine all the input wait-a-bits.  If the wait-a-bit for any individual device is off (not-ready),
2600    and the configuration data of the multiplexer specifies suspend_all_mode, turn the system wait-a-bit on also as foreign
2601    side does not interpret the individual device wait-a-bits */
2602 
2603                     local_fcs_chars = copy (NUL, 2);
2604                     local_fcs.mbo1,
2605                          local_fcs.mbo2 = "1"b;
2606 
2607                     if hmd.suspend_all_input then           /* if the multiplexer isn't ready yet:  indicate no input */
2608                          local_fcs.system_wab = "1"b;
2609 
2610                     string (local_fcs.wab_bits1),           /* all devices not ready: insures that wait-a-bits for ... */
2611                          string (local_fcs.wab_bits2) = ""b;     /* ... devices that aren't used or dialed-up are OFF */
2612                     local_fcs.console_wab = "0"b;
2613 
2614                     do idx = 1 to hmd.n_subchannels;
2615 
2616                          if (hmd.subchannels(idx).direction = HSTE_OUTPUT_ONLY)
2617                               then;                         /* this device can't accept any input at all */
2618 
2619                          else if (hmd.subchannels(idx).state = HSTE_DIALED) then
2620                                                             /* this device is dialed up:  set wait-a-bit as desired */
2621                               if hmd.input_wabs (hmd.subchannels(idx).device_wab_idx) then
2622                                                             /* device is ready:  set appropriate bit */
2623                                    if (hmd.subchannels(idx).device_wab_idx = 0) then
2624                                         local_fcs.console_wab = "1"b;
2625                                    else if (hmd.subchannels(idx).device_wab_idx <= 4) then
2626                                         local_fcs.wab_bits1 (hmd.subchannels(idx).device_wab_idx) = "1"b;
2627                                    else local_fcs.wab_bits2 (hmd.subchannels(idx).device_wab_idx-4) = "1"b;
2628 
2629                               else                          /* device is not ready:  appropriate bit is already off ... */
2630                               if hmd.suspend_all_mode then  /* ... but foreign side only interprets system wait-a-bit */
2631                                    local_fcs.system_wab = "1"b;
2632                     end;
2633 
2634                     return;
2635 
2636                end compute_local_bcb_and_fcs;
2637 %page;
2638 /* Internal to process_output_block:  complete the current output block by adding the block trailer, entering the already
2639    computed BCB and FCS into the block, and updating the local state of the multiplexer to reflect shipment of this block
2640    */
2641 
2642 finish_output_block:
2643                procedure ();
2644 
2645 dcl 1 hmd_local_fcs unaligned based (addr (hmd.local_fcs_bytes)) like hasp_fcs_bytes;
2646 
2647 dcl 1 based_split_block_trailer aligned based,
2648     2 part1 character (space_left_in_buffer) unaligned,
2649     2 part2 character (amount_needed - space_left_in_buffer) unaligned;
2650 
2651 dcl  based_part1 character (space_left_in_buffer) unaligned based;
2652 dcl  based_part2 character (amount_needed - space_left_in_buffer) unaligned based;
2653 
2654 dcl (bufferp, new_bufferp) pointer;
2655 dcl (space_left_in_buffer, amount_needed, saved_tally) fixed binary;
2656 
2657 
2658                     bufferp = hmd.output_block.last_bufferp;
2659 
2660                     space_left_in_buffer = max_buffer_tally (bufferp -> buffer.size_code) - (bufferp -> buffer.tally);
2661                     amount_needed = length (string (TEMPLATE_HASP_BLOCK_TRAILER.non_crc));
2662 
2663                     if space_left_in_buffer >= amount_needed
2664                     then do;                                /* trailer fits neatly into this block */
2665                          addr (bufferp -> buffer.chars (bufferp -> buffer.tally)) -> based_block_trailer.non_crc =
2666                                    TEMPLATE_HASP_BLOCK_TRAILER.non_crc;
2667                          bufferp -> buffer.tally = (bufferp -> buffer.tally) +
2668                                                     length (string (TEMPLATE_HASP_BLOCK_TRAILER.non_crc));
2669                     end;
2670 
2671                     else do;                                /* must be split into two parts */
2672                          saved_tally = bufferp -> buffer.tally;       /* in case tsm$get_buffer fails ... */
2673                          if space_left_in_buffer > 0 then do;
2674                               addr (bufferp -> buffer.chars (bufferp -> buffer.tally)) -> based_part1 =
2675                                         addr (TEMPLATE_HASP_BLOCK_TRAILER.non_crc) -> based_split_block_trailer.part1;
2676                               bufferp -> buffer.tally = max_buffer_tally (bufferp -> buffer.size_code);
2677                          end;
2678                          call tty_space_man$get_buffer (hmd.devx, 16, OUTPUT, new_bufferp);
2679                               if new_bufferp = null () then do;
2680                                    bufferp -> buffer.tally = saved_tally;
2681                                    go to CANT_FINISH_PROCESS_OUTPUT_BLOCK;
2682                               end;
2683                          addr (new_bufferp -> buffer.chars (0)) -> based_part2 =
2684                                    addr (TEMPLATE_HASP_BLOCK_TRAILER.non_crc) -> based_split_block_trailer.part2;
2685                          new_bufferp -> buffer.tally = amount_needed - space_left_in_buffer;
2686                          bufferp -> buffer.next = binary (rel (new_bufferp), 18, 0);
2687                          hmd.output_block.last_bufferp = new_bufferp;
2688                     end;
2689 
2690                     hmd.output_block.tally = hmd.output_block.tally +
2691                                               length (string (TEMPLATE_HASP_BLOCK_TRAILER.non_crc));
2692 
2693                     addr (hmd.output_block.first_bufferp -> buffer.chars (0)) -> based_block_header.bcb = local_bcb_char;
2694                     addr (hmd.output_block.first_bufferp -> buffer.chars (0)) -> based_block_header.fcs = local_fcs_chars;
2695 
2696                     if hmd.reset_local_block_count
2697                     then do;                                /* this block indicates next block will be #0 */
2698                          hmd.reset_local_block_count = "0"b;
2699                          hmd.local_block_count = -1;
2700                     end;
2701                     else hmd.local_block_count = local_bcb.count;
2702 
2703                     if local_fcs.system_wab & ^hmd_local_fcs.system_wab then    /* stopped taking input */
2704                          hmd.meters.n_local_wab_set = hmd.meters.n_local_wab_set + 1;
2705 
2706                     hmd.local_fcs_bytes = local_fcs_chars;  /* save BCB and FCS for next time around */
2707 
2708                     return;
2709 
2710                end finish_output_block;
2711 %page;
2712 /* Internal to process_output_block:  add an RTS or RTS acknowledgement record to the output block.  This procedure is
2713    never called unless the current output block would be empty; only one record is added */
2714 
2715 add_rts_or_rts_ack_record:
2716                procedure ();
2717 
2718 dcl  p pointer;
2719 dcl  idx fixed binary;
2720 
2721 
2722                     do idx = 1 to hmd.n_subchannels;        /* go by subchannel in order to have the RCB */
2723 
2724                           if (hmd.subchannels(idx).direction ^= HSTE_INPUT_ONLY) & (idx ^= hmd.console_hste_idx)
2725                               then if hmd.send_rts (hmd.subchannels(idx).device_wab_idx)
2726                                    then do;
2727 
2728 /* An output device needs to request permission to send a file:  add an RTS record (guarenteed to be room) */
2729 
2730                                         hmd.meters.n_output_records = hmd.meters.n_output_records + 1;
2731 
2732                                         p = hmd.output_block.last_bufferp;
2733 
2734                                         addr (p -> buffer.chars (p -> buffer.tally)) -> based_rts_record =
2735                                                   TEMPLATE_HASP_RTS_RECORD;
2736 
2737                                         addr (p -> buffer.chars (p -> buffer.tally)) -> based_rts_record.srcb =
2738                                                   hmd.subchannels(idx).rcb;
2739 
2740                                         p -> buffer.tally = (p -> buffer.tally) +
2741                                                              length (string (TEMPLATE_HASP_RTS_RECORD));
2742                                         hmd.output_block.tally = hmd.output_block.tally +
2743                                                                   length (string (TEMPLATE_HASP_RTS_RECORD));
2744 
2745                                         hmd.send_rts (hmd.subchannels(idx).device_wab_idx) = "0"b;
2746                                         hmd.subchannels(idx).minor_state = HSTE_WAIT_RTS_ACK;
2747                                         go to NO_MORE_RECORDS;   /* only one records goes in this block */
2748                                    end;
2749 
2750                                    else;                    /* sub-channel doesn't need an RTS record */
2751 
2752 
2753                          else if (hmd.subchannels(idx).direction ^= HSTE_OUTPUT_ONLY)
2754                               then if hmd.send_rts_ack (hmd.subchannels(idx).device_wab_idx)
2755                                    then do;
2756 
2757 /* Foreign side has requested permission to send a file for a given device:  add an RTS acknowledgement record */
2758 
2759                                         hmd.meters.n_output_records = hmd.meters.n_output_records + 1;
2760 
2761                                         p = hmd.output_block.last_bufferp;
2762 
2763                                         addr (p -> buffer.chars (p -> buffer.tally)) -> based_rts_ack_record =
2764                                                   TEMPLATE_HASP_RTS_ACK_RECORD;
2765 
2766                                         addr (p -> buffer.chars (p -> buffer.tally)) -> based_rts_ack_record.srcb =
2767                                                   hmd.subchannels(idx).rcb;
2768 
2769                                         p -> buffer.tally = (p -> buffer.tally) +
2770                                                              length (string (TEMPLATE_HASP_RTS_ACK_RECORD));
2771                                         hmd.output_block.tally = hmd.output_block.tally +
2772                                                                   length (string (TEMPLATE_HASP_RTS_ACK_RECORD));
2773 
2774                                         hmd.send_rts_ack (hmd.subchannels(idx).device_wab_idx) = "0"b;
2775                                         go to NO_MORE_RECORDS;   /* only one record goes in this block */
2776                                    end;
2777 
2778                                    else;                    /* sub-channel doesn't want an RTS acknowledgement record */
2779                     end;
2780 
2781 NO_MORE_RECORDS:    return;
2782 
2783                end add_rts_or_rts_ack_record;
2784 
2785           end process_output_block;
2786 %page;
2787 /* Output records processing */
2788 
2789 output_records_processor:
2790           procedure ();
2791 
2792 RETURN_FROM_CALLER:                                         /* not an entry */
2793                return;
2794 
2795 
2796 /* Parameters */
2797 
2798 dcl (P_start_bufferp, P_end_bufferp) pointer parameter;     /* process_single_loopback_record: -> the record */
2799 dcl ( P_start_record_idx, P_end_record_idx) fixed binary parameter;   /* ... */
2800 dcl  P_record_tally fixed binary parameter;                 /* process_single_loopback_record: length of the record */
2801 dcl  P_dle_count fixed binary parameter;                    /* process_single_loopback_record: # of DLEs in record */
2802 dcl  P_record_was_taken bit (1) aligned parameter;          /* process_single_loopback_record: set ON => record was put
2803                                                                                                into the output block */
2804 
2805 
2806 /* Remaining declarations */
2807 
2808 dcl  loopback_entry bit (1) aligned;                        /* ON => process_single_loopback_record;
2809                                                                OFF => process_output_records */
2810 
2811 dcl 1 saved_output_block aligned like hmd.output_block;     /* for recovery from running out of space */
2812 dcl  saved_last_tally fixed binary;
2813 
2814 dcl (start_bufferp, end_bufferp) pointer;                   /* -> buffer containing start and end of a record */
2815 dcl (start_record_idx, end_record_idx) fixed binary;        /* index (0-based) in those buffers of first and last chars */
2816 
2817 dcl  continue_scan bit (1) aligned;                         /* ON => continue scanning output records */
2818 
2819 dcl (bufferp, p) pointer;
2820 
2821 dcl (record_type, record_tally, dle_count, first_idx, last_idx) fixed binary;
2822 %page;
2823 /* Process output records:  scan the supplied chain for complete records and add them to the output block presently being
2824    built until (1) there are no more complete records in the chain, (2) there is no room in the output block to add the
2825    record, (3) an end-of-file record is placed into the block and this device must request permission to send the next
2826    file, or (4) a record is found which is simply too large to place into an output block */
2827 
2828 process_output_records:
2829           entry ();
2830 
2831                loopback_entry = "0"b;
2832                needs_space = "0"b;
2833 
2834                if cant_accept_records_from_this_device () then
2835                     return;                                 /* records from this device can't be put into current block */
2836 
2837 
2838 /* Records may be placed into this output block:  put as many completed records as will fit into the block */
2839 
2840                start_bufferp = chain_ptr;                   /* start with first character in the chain */
2841                start_record_idx = 0;
2842 
2843                continue_scan = "1"b;                        /* until there is a reason to stop */
2844 
2845                do while (continue_scan);
2846 
2847                     call find_next_record (start_bufferp, start_record_idx, "0"b, "1"b,
2848                                            end_bufferp, end_record_idx, record_tally, dle_count);
2849 
2850                     if end_bufferp ^= null ()
2851                     then do;                                /* found a record:  process it */
2852 
2853                          record_tally = record_tally + dle_count + 1; /* the RCB and transparency */
2854 
2855                          if ^space_in_empty_output_block_for_recordp (record_tally)
2856                          then do;                           /* record is too long to fit into a buffer ... */
2857                               continue_scan = "0"b;         /* ... stop processing now ... */
2858                               long_record = "1"b;           /* ... and return error code to user ring */
2859                          end;
2860 
2861                          else if space_in_output_block_for_recordp (record_tally)
2862                          then do;                           /* the record will fit into this block */
2863                               call move_record_to_output_block ("1"b);
2864                               hmd.meters.n_output_records = hmd.meters.n_output_records + 1;
2865                               hste.meters.device_n_output_records = hste.meters.device_n_output_records + 1;
2866                               if record_type = HASP_EOF_RECORD then   /* set by move_record_to_output_block ... */
2867                                    hste.meters.device_n_output_eof_records = hste.meters.device_n_output_eof_records + 1;
2868 
2869                               if (end_record_idx + 1) = (end_bufferp -> buffer.tally)
2870                               then do;                      /* record ends at end of buffer, go to next one */
2871                                    if end_bufferp -> buffer.next = 0 then
2872                                         start_bufferp = null ();
2873                                    else start_bufferp = pointer (ttybp, end_bufferp -> buffer.next);
2874                                    start_record_idx = 0;
2875                                    call tty_space_man$free_buffer (hste.devx, OUTPUT, end_bufferp);
2876                               end;
2877                               else do;                      /* more data in this buffer, examine it */
2878                                    start_bufferp = end_bufferp;
2879                                    start_record_idx = end_record_idx + 1;
2880                               end;
2881 
2882                               continue_scan = (start_bufferp ^= null ()) &      /* must be more data ... */
2883                                               (hste.minor_state = HSTE_NORMAL); /* ... and must be OK to send more */
2884                          end;
2885 
2886                          else continue_scan = "0"b;         /* no room in output block for this record */
2887                     end;
2888 
2889                     else do;                                /* no more complete records ... */
2890                          continue_scan = "0"b;              /* ... stop processing now ... */
2891                          if ^space_in_empty_output_block_for_recordp ((record_tally + dle_count + 1)) then
2892                               long_record = "1"b;           /* ... but it will never fit even when complete */
2893                          else partial_record = "1"b;        /* ... and ask user ring for more */
2894                     end;
2895                end;
2896 
2897 
2898 RETURN_FROM_PROCESS_OUTPUT_RECORDS:
2899                if start_bufferp ^= null () then             /* didn't process entire chain:  return the rest */
2900                     if start_record_idx ^= 0 then           /* some processed stuff in this buffer should be flushed */
2901                          call delete_text (start_bufferp, 0, start_record_idx);
2902 
2903                chain_ptr = start_bufferp;                   /* this is untouched data */
2904 
2905                return;
2906 %page;
2907 /* Process a single loopbacked data/EOF record: place the record into the current output block if there is room and the
2908    record would normally be permitted in this block */
2909 
2910 process_single_loopback_record:
2911           entry (P_start_bufferp, P_start_record_idx, P_end_bufferp, P_end_record_idx, P_record_tally, P_dle_count,
2912                  P_record_was_taken);
2913 
2914                start_bufferp = P_start_bufferp;             /* copy parameters */
2915                start_record_idx = P_start_record_idx;
2916                end_bufferp = P_end_bufferp;
2917                end_record_idx = P_end_record_idx;
2918                record_tally = P_record_tally + P_dle_count + 1;  /* include the RCB */
2919 
2920                P_record_was_taken = "0"b;                   /* assume failure */
2921 
2922                loopback_entry = "1"b;
2923                needs_space = "0"b;
2924 
2925                if cant_accept_records_from_this_device () then
2926                     return;                                 /* can't be put into this buffer */
2927 
2928                if (hste.minor_state ^= HSTE_NORMAL) then do;    /* can't send records quite yet */
2929                     if (hste.minor_state = HSTE_SEND_RTS) then
2930                          hmd.send_rts (hste.device_wab_idx) = "1"b;
2931                     return;
2932                end;
2933 
2934                if ^space_in_output_block_for_recordp (record_tally) then
2935                     return;                                 /* won't fit into this block */
2936 
2937                call move_record_to_output_block ("0"b);     /* don't free the record here */
2938                P_record_was_taken = "1"b;                   /* got it */
2939 
2940                return;
2941 %page;
2942 /* Process records loopbacked to a subchannel: these records are present when either (1) the device for this subchannel
2943    was not ready when reprocessing occured or (2) it wasn't possible to retransmit all the records of this subchannel at
2944    reprocessing time.  Retransmit as many now as possible */
2945 
2946 process_subchannel_loopback_records:
2947           entry ();
2948 
2949                loopback_entry = "1"b;
2950                needs_space = "0"b;
2951 
2952                if cant_accept_records_from_this_device () then
2953                     return;                                 /* can't put them into output now */
2954 
2955                if (hste.minor_state ^= HSTE_NORMAL) then do;     /* can't send records quite yet */
2956                     if (hste.minor_state = HSTE_SEND_RTS) then
2957                          hmd.send_rts (hste.device_wab_idx) = "1"b;
2958                     return;
2959                end;
2960 
2961 
2962 /* Process records: records are separated by the buffer.break flag and no buffer contains data from multiple records
2963    (enforced by process_loopback_records) */
2964 
2965                start_bufferp = hste.loopback.first_bufferp;
2966 
2967                continue_scan = (start_bufferp ^= null ());
2968 
2969                do while (continue_scan);
2970 
2971                     record_tally, dle_count = 0;
2972                     do bufferp = start_bufferp
2973                                  repeat (bufferp) while (bufferp ^= null ());
2974                          record_tally = record_tally + (bufferp -> buffer.tally) + count_dles (bufferp);
2975                          if (bufferp -> buffer.next = 0) | (bufferp -> buffer.break)
2976                          then do;                           /* found end of the record */
2977                               end_bufferp = bufferp;
2978                               bufferp = null ();
2979                          end;
2980                          else bufferp = pointer (ttybp, bufferp -> buffer.next);
2981                     end;
2982 
2983                     start_record_idx = 0;                   /* uses all of each buffer */
2984                     end_record_idx = (end_bufferp -> buffer.tally) - 1;
2985 
2986                     if space_in_output_block_for_recordp (record_tally)
2987                     then do;                                /* room for this record: put it in */
2988                          call move_record_to_output_block ("1"b);
2989                          hste.loopback.n_records = hste.loopback.n_records - 1;
2990                          if (end_bufferp -> buffer.next = 0) then
2991                               start_bufferp = null ();      /* last loopback record */
2992                          else start_bufferp = pointer (ttybp, end_bufferp -> buffer.next);
2993                          call tty_space_man$free_buffer (hste.devx, OUTPUT, end_bufferp);
2994                          continue_scan = ((start_bufferp ^= null ()) &     /* still something there ... */
2995                                          (hste.minor_state = HSTE_NORMAL));     /* ... and still OK to send records */
2996                     end;
2997 
2998                     else continue_scan = "0"b;              /* no room anymore */
2999                end;
3000 
3001 
3002 /* Post processing: update hste.loopback */
3003 
3004                hste.loopback.first_bufferp = start_bufferp;
3005 
3006                if (start_bufferp = null ()) then            /* none left */
3007                     hste.loopback.last_bufferp = null ();
3008 
3009                return;
3010 %page;
3011 /* Internal to output_records_processor: determines if records from the current device can be placed into the output block
3012    being constructed; if an output block isn't underway, a fresh one is started.  Records for the operator's console can
3013    only be placed in a block that contains other console records; in multileave mode, any device (other than the console)
3014    can share a block with any other device (other than the console); in non-multileave mode, no device can share a block
3015    with other devices */
3016 
3017 cant_accept_records_from_this_device:
3018                procedure () returns (bit (1) aligned);
3019 
3020 dcl accept_records bit (1) aligned;
3021 
3022                     accept_records = "1"b;                  /* assume you can accept 'till proven otherwise */
3023 
3024                     if empty_output_blockp ()
3025                     then do;                                /* no output block:  clearly can add records */
3026                          if hmd.output_block.first_bufferp = null () then
3027                               call start_new_output_block ();
3028                          if hmd.multileave_mode & (hste.device_type ^= HASP_CONSOLE) then
3029                               hmd.output_block.subchannel_idx = -1;   /* not console and multileaving:  shared block */
3030                          else hmd.output_block.subchannel_idx = hste.subchannel_idx;
3031                     end;
3032 
3033                     else if hmd.multileave_mode & (hste.device_type ^= HASP_CONSOLE)
3034                          then if (hmd.output_block.subchannel_idx = -1)
3035                               then;                         /* multileaving and not console:  only if a shared block */
3036                          else accept_records = "0"b;
3037 
3038                     else if (hmd.output_block.subchannel_idx = hste.subchannel_idx)
3039                          then;                              /* console or not multileaving:  no shared blocks */
3040                     else accept_records = "0"b;
3041 
3042                     return (^accept_records);
3043 
3044 
3045 
3046 /* Internal to cant_accept_records_from_this_device: start a new output block */
3047 
3048 start_new_output_block:
3049                     procedure ();
3050 
3051 dcl  bufferp pointer;
3052 
3053                          call tty_space_man$get_buffer (hmd.devx, (hmd.dialup_info.max_buf_size), OUTPUT, bufferp);
3054                               if bufferp = null () then do;
3055                                    needs_space = "1"b;      /* ran out of room */
3056                                    go to RETURN_FROM_CALLER;
3057                               end;
3058 
3059                          addr (bufferp -> buffer.chars (0)) -> based_block_header = TEMPLATE_HASP_BLOCK_HEADER;
3060 
3061                          hmd.output_block.tally,
3062                               bufferp -> buffer.tally = length (string (TEMPLATE_HASP_BLOCK_HEADER));
3063                          hmd.output_block.first_bufferp, hmd.output_block.last_bufferp = bufferp;
3064 
3065                          return;
3066 
3067                     end start_new_output_block;
3068 
3069                end cant_accept_records_from_this_device;
3070 %page;
3071 /* Internal to output_records_processor:  Move the current record into the output block */
3072 
3073 move_record_to_output_block:
3074                procedure (P_free_buffers);
3075 
3076 dcl  P_free_buffers bit (1) aligned parameter;              /* ON => free buffers as data is moved */
3077 
3078                     saved_output_block = hmd.output_block;  /* in case we run out of room */
3079                     saved_last_tally = hmd.output_block.last_bufferp -> buffer.tally;
3080 
3081                     if (hste.device_type = HASP_CONSOLE) then    /* console:  RCB is special cased */
3082                          if (hmd.type = HASP_HOST) then
3083                               call add_to_output_block (addr (HASP_CONSOLE_OUTPUT_RCB), 1);
3084                          else call add_to_output_block (addr (HASP_CONSOLE_INPUT_RCB), 1);
3085                     else call add_to_output_block (addr (hste.rcb), 1);    /* normal device */
3086 
3087                     bufferp = start_bufferp;
3088 
3089                     do while (bufferp ^= null ());
3090 
3091                          if bufferp = start_bufferp then
3092                               first_idx = start_record_idx;
3093                          else first_idx = 0;                /* take from beginning of the buffer */
3094                          if bufferp = end_bufferp then
3095                               last_idx = end_record_idx;
3096                          else last_idx = bufferp -> buffer.tally - 1; /* last character in buffer */
3097 
3098                          call add_to_output_block (addr (bufferp -> buffer.chars (first_idx)),
3099                                                    (last_idx - first_idx + 1));
3100 
3101                          if (bufferp = end_bufferp) then
3102                               bufferp = null ();            /* got the whole record now */
3103                          else bufferp = pointer (ttybp, bufferp -> buffer.next);
3104                     end;                                    /* go to next buffer */
3105 
3106                     record_type = classify_record (saved_output_block.last_bufferp, saved_last_tally);
3107 
3108                     if (record_type = HASP_EOF_RECORD) &
3109                        (hste.device_type ^= HASP_CONSOLE) & hmd.rts_mode then
3110                          hste.minor_state = HSTE_SEND_RTS;  /* reached EOF on device that must ask to send */
3111 
3112                     if P_free_buffers then                  /* caller asked us to free the record's buffers ... */
3113                          do bufferp = start_bufferp         /* ... but not the last buffer which the caller will handle */
3114                                       repeat (p) while (bufferp ^= end_bufferp);
3115                               p = pointer (ttybp, bufferp -> buffer.next);
3116                               call tty_space_man$free_buffer (hste.devx, OUTPUT, bufferp);
3117                          end;
3118 
3119                     return;
3120 %page;
3121 /* Internal to move_record_to_output_block:  Add a string to the current output block, doubling any DLEs present in
3122    the string */
3123 
3124 add_to_output_block:
3125                     procedure (P_text_ptr, P_text_lth);
3126 
3127 dcl  P_text_ptr pointer parameter;
3128 dcl  P_text_lth fixed binary parameter;
3129 
3130 dcl  text character (text_lth) unaligned based (text_ptr);
3131 dcl  text_ptr pointer;
3132 dcl  text_lth fixed binary;
3133 
3134 dcl  based_substring character (substr_lth) unaligned based;
3135 dcl  based_buffer_remainder character (space_left_in_buffer) unaligned based;
3136 dcl  based_character character (1) unaligned based;
3137 
3138 dcl (bufferp, new_bufferp) pointer;
3139 dcl (start, substr_lth, space_left_in_buffer) fixed binary;
3140 dcl  add_dle bit (1) aligned;
3141 
3142 
3143                          text_ptr = P_text_ptr;
3144                          text_lth = P_text_lth;
3145 
3146                          bufferp = hmd.output_block.last_bufferp;
3147 
3148                          start = 1;                         /* start from beginning of the text (obviously) */
3149 
3150                          do while (start <= text_lth);
3151 
3152                               space_left_in_buffer = max_buffer_tally (bufferp -> buffer.size_code)
3153                                                                         - (bufferp -> buffer.tally);
3154 
3155                               substr_lth = index (substr (text, start), DLE);
3156                                                             /* find next character requiring transparency */
3157                               if substr_lth ^= 0 then
3158                                    add_dle = "1"b;
3159                               else do;                      /* no special characters left:  take the rest */
3160                                    substr_lth = text_lth - start + 1;
3161                                    add_dle = "0"b;
3162                               end;
3163 
3164                               do while (space_left_in_buffer < substr_lth);
3165                                    if space_left_in_buffer > 0 then do;
3166                                         addr (bufferp -> buffer.chars (bufferp -> buffer.tally)) -> based_buffer_remainder
3167                                              = substr (text, start, space_left_in_buffer);
3168                                         bufferp -> buffer.tally = max_buffer_tally (bufferp -> buffer.size_code);
3169                                         start = start + space_left_in_buffer;
3170                                         substr_lth = substr_lth - space_left_in_buffer;
3171                                    end;
3172                                    call tty_space_man$get_buffer (hmd.devx, (hmd.dialup_info.max_buf_size), OUTPUT,
3173                                                                   new_bufferp);
3174                                         if new_bufferp = null () then go to NO_MORE_ROOM;
3175                                    bufferp -> buffer.next = binary (rel (new_bufferp), 18, 0);
3176                                    hmd.output_block.last_bufferp, bufferp = new_bufferp;
3177                                    space_left_in_buffer = max_buffer_tally (bufferp -> buffer.size_code);
3178                               end;
3179 
3180                               if substr_lth ^= 0 then do;   /* something left over from above loop */
3181                                    addr (bufferp -> buffer.chars (bufferp -> buffer.tally)) -> based_substring =
3182                                              substr (text, start, substr_lth);
3183                                    bufferp -> buffer.tally = (bufferp -> buffer.tally) + substr_lth;
3184                                    start = start + substr_lth;
3185                               end;
3186 
3187                               if add_dle then do;           /* need to insert a DLE */
3188                                    if (bufferp -> buffer.tally) = max_buffer_tally (bufferp -> buffer.size_code)
3189                                    then do;                 /* no room for it in this buffer, get another */
3190                                         call tty_space_man$get_buffer (hmd.devx, (hmd.dialup_info.max_buf_size), OUTPUT,
3191                                                                        new_bufferp);
3192                                              if new_bufferp = null () then go to NO_MORE_ROOM;
3193                                         bufferp -> buffer.next = binary (rel (new_bufferp), 18, 0);
3194                                         hmd.output_block.last_bufferp, bufferp = new_bufferp;
3195                                    end;
3196                                    addr (bufferp -> buffer.chars (bufferp -> buffer.tally)) -> based_character = DLE;
3197                                    bufferp -> buffer.tally = (bufferp -> buffer.tally) + 1;
3198                                    hmd.output_block.tally = hmd.output_block.tally + 1;
3199                               end;
3200                          end;
3201 
3202                          hmd.output_block.tally = hmd.output_block.tally + text_lth;
3203                                                             /* the string has been added: DLEs added were counted above */
3204 
3205                          return;
3206 
3207 
3208 /* Not being able to allocate a buffer transfers here:  revert the output block to the state it was in before starting to
3209    add this record and abort the call to process_output_records */
3210 
3211 NO_MORE_ROOM:            hmd.output_block = saved_output_block;
3212                          hmd.output_block.last_bufferp -> buffer.tally = saved_last_tally;
3213 
3214                          if (hmd.output_block.last_bufferp -> buffer.next) ^= 0
3215                          then do;                           /* free part of chain added by this aborted call */
3216                               bufferp = pointer (ttybp, hmd.output_block.last_bufferp -> buffer.next);
3217                               call tty_space_man$free_chain (hmd.devx, OUTPUT, bufferp);
3218                               hmd.output_block.last_bufferp -> buffer.next = 0;
3219                          end;
3220 
3221                          needs_space = "1"b;                /* tell the caller about it */
3222 
3223                          if loopback_entry then
3224                               go to RETURN_FROM_CALLER;     /* nothing else to do */
3225                          else go to RETURN_FROM_PROCESS_OUTPUT_RECORDS;
3226 
3227                     end add_to_output_block;
3228 
3229                end move_record_to_output_block;
3230 %page;
3231 /* Internal to output_records_processor: count DLEs in a buffer for computing # of characters added to a record by
3232    transparency */
3233 
3234 count_dles:    procedure (P_bufferp) returns (fixed binary);
3235 
3236 dcl P_bufferp pointer parameter;
3237 
3238 dcl  buffer_text character (bufferp -> buffer.tally) based (addr (bufferp -> buffer.chars (0)));
3239 
3240 dcl  bufferp pointer;
3241 dcl (start, idx, dle_count) fixed binary;
3242 
3243 
3244                     bufferp = P_bufferp;
3245 
3246                     start = 1;
3247                     idx = index (buffer_text, DLE);
3248 
3249                     dle_count = 0;
3250 
3251                     do while (idx ^= 0);
3252                          dle_count = dle_count + 1;
3253                          start = start + idx;
3254                          if start > (bufferp -> buffer.tally) then
3255                               idx = 0;
3256                          else idx = index (substr (buffer_text, start), DLE);
3257                     end;
3258 
3259                     return (dle_count);
3260 
3261                end count_dles;
3262 
3263           end output_records_processor;
3264 %page;
3265 /* Transmit an output block:  send output to the FNP.  If it accepts the entire block, permit another block to be
3266    transmitted; otherwise, wait for the next SEND OUTPUT interrupt to try to complete transmission */
3267 
3268 transmit_output_block:
3269           procedure ();
3270 
3271 dcl  p pointer;
3272 
3273 
3274                if ^hmd.send_output then return;             /* no permission to send anything */
3275 
3276                if hmd.output_chain_ptr ^= null () then do;  /* something to write */
3277                     p = hmd.output_chain_ptr;
3278 
3279                     call channel_manager$write (hmd.devx, p, code);
3280                     if code = 0 then
3281                          hmd.retry_transmit_output = "0"b;  /* this write request won */
3282                     else if code = et_noalloc
3283                          then do;                           /* not enough room, try later */
3284                               hmd.retry_transmit_output = "1"b;
3285                               call tty_space_man$needs_space (hmd.devx);
3286                          end;
3287                          else return;                       /* write failed--crash to follow? */
3288 
3289                     hmd.output_chain_ptr = p;               /* remember what's left */
3290                     hmd.send_output = "0"b;                 /* no longer have permission */
3291                end;
3292 
3293                if hmd.output_chain_ptr = null () then
3294                     hmd.output_in_progress = "0"b;          /* it finished--OK to send the next block */
3295                else hmd.output_in_progress = "1"b;
3296 
3297                return;
3298 
3299           end transmit_output_block;
3300 %page;
3301 /* Perform a line-control operation and abort loading the multiplexer if it fails */
3302 
3303 do_line_control:
3304           procedure (P_line_ctl_opcode, P_line_ctl_val1, P_line_ctl_val2, P_line_ctl_val3);
3305 
3306 dcl (P_line_ctl_opcode, P_line_ctl_val1, P_line_ctl_val2, P_line_ctl_val3) fixed binary parameter;
3307 
3308                line_ctl.op = P_line_ctl_opcode;
3309 
3310                line_ctl.val (1) = P_line_ctl_val1;
3311                line_ctl.val (2) = P_line_ctl_val2;
3312                line_ctl.val (3) = P_line_ctl_val3;
3313 
3314                call channel_manager$control (hmd.devx, "line_control", addr (line_ctl), code);
3315 
3316                if code = 0 then
3317                     return;                                 /* all's well that ends well */
3318                else go to LOADING_FAILS;
3319 
3320           end do_line_control;
3321 %page;
3322 /* Interpret line status from the FNP:  A check must be made for line status interrupts generated by the multiplexer in
3323    order to delay some type of processing from call time to interrupt time */
3324 
3325 process_line_status:
3326           procedure ();
3327 
3328                if (line_stat.op < lbound (LINE_STATUS, 1)) | (line_stat.op > hbound (LINE_STATUS, 1)) then
3329                     return;                                 /* unrecognized line status */
3330 
3331                else go to LINE_STATUS (line_stat.op);
3332 
3333 
3334 LINE_STATUS (1):                                            /* BID FAILED -- could not complete HASP initialization */
3335                if hmd.state = HMD_LOADING then do;          /* What if the multiplexer isn't loading? */
3336                     call crash_mpx ();
3337                     call pxss$ring_0_wakeup (hmd.loader_process_id, hmd.loader_event_channel, HASP_MPX_DOWN, code);
3338                end;
3339                return;
3340 
3341 
3342 LINE_STATUS (2):                                            /* BAD BLOCK -- we sent badly formatted block */
3343                call syserr (LOG_AND_PRINT,
3344                             "hasp_mpx (line ^a): Bad block line status from FNP; line will be hungup.", hmd.name);
3345                call channel_manager$control (hmd.devx, "hangup", null (), code);
3346                return;
3347 
3348 
3349 LINE_STATUS (4):                                            /* TOO MANY NAKS -- line has gone bad */
3350                call syserr (LOG_AND_PRINT, "hasp_mpx (line ^a): Too many NAKS; line will be hungup.", hmd.name);
3351                call channel_manager$control (hmd.devx, "hangup", null (), code);
3352                return;
3353 
3354 
3355 LINE_STATUS (6):                                            /* WRITE COMPLETE -- indicates a SIGNON record was sent OK */
3356                if hmd.minor_state ^= HMD_WAIT_SIGNON_RESPONSE then
3357                     return;                                 /* ignore spurious line statuses */
3358                if hmd.signon_data_ptr ^= null () then do;   /* inform owner of the console */
3359                     hsd_ptr = hmd.signon_data_ptr;
3360                     call pxss$ring_0_wakeup (hmd_signon_data.processid, hmd_signon_data.event_channel, HASP_SIGNON_OK,
3361                                              code);
3362                     call tty_space_man$free_space (currentsize (hmd_signon_data), hsd_ptr);
3363                     hmd.signon_data_ptr = null ();
3364                end;
3365                hmd.minor_state = HMD_NORMAL;                /* allow normal data transmission */
3366                if (hmd.state = HMD_STARTED) then
3367                     do idx = 1 to hmd.n_subchannels;        /* dailup any listening subchannels */
3368                          hste_ptr = addr (hmd.subchannels (idx));
3369                          if hste.state = HSTE_LISTENING then
3370                               call signal_dialup ();
3371                     end;
3372                call interrupt_subchannels_with_output ();   /* in case console has data waiting to ship */
3373                return;
3374 
3375 
3376 LINE_STATUS (13):                                           /* HASP INIT COMPLETE -- HASP handshake done; line is up */
3377                if hmd.state = HMD_LOADING then
3378                     call load_mpx ();                       /* perform necessary initialization and notify Initializer */
3379                return;
3380 
3381 
3382 LINE_STATUS (14):                                           /* HASP FOREIGN READY -- other side reset its wait-a-bit */
3383                hmd.suspend_all_output = "0"b;
3384                if hmd.state >= HMD_LOADED then              /* it's OK to send output blocks ... */
3385                     if hmd.minor_state = HMD_REPROCESS then
3386                          call process_loopback_records ();
3387                     else call process_output_block ();      /* ... so start sending output again */
3388                return;
3389 
3390 LINE_STATUS (3):                                            /* REVERSE INTERRUPT -- ignored */
3391 LINE_STATUS (5):                                            /* FNP WRITE STATUS -- ignored */
3392 LINE_STATUS (7):  LINE_STATUS (8):  LINE_STATUS (9):        /* IBM 3270 line status codes -- ignored */
3393 LINE_STATUS (10):  LINE_STATUS (11): LINE_STATUS (12):
3394                return;
3395 
3396           end process_line_status;
3397 %page;
3398 /* Process a SPACE AVAILABLE interrupt:  Check each of the conditions that could have caused a wait for the interrupt
3399    and process them appropriately */
3400 
3401 process_space_available:
3402           procedure ();
3403 
3404                if hmd.retry_transmit_output then do;        /* parent rejected our write request, so retry it */
3405                     call transmit_output_block ();
3406                     if hmd.retry_transmit_output then return;    /* still rejecting ... */
3407                end;
3408 
3409                if hmd.retry_process_loopback_records then   /* wasn't enough room to process loopbacked data */
3410                     call process_loopback_records ();       /* calls process_output_block if all OK */
3411 
3412                else if hmd.retry_process_output then        /* wasn't enough room to finish an output block */
3413                     call process_output_block ();
3414 
3415                if hmd.retry_process_input then              /* couldn't split up input block(s) */
3416                     call process_input_records ();
3417 
3418                call interrupt_subchannels_with_output ();
3419 
3420                return;
3421 
3422           end process_space_available;
3423 %page;
3424 /* Scan a chain of buffers to find the next complete HASP record */
3425 
3426 find_next_record:
3427           procedure (P_start_bufferp, P_start_record_idx, P_rcb_included, P_count_dles,
3428                      P_end_bufferp, P_end_record_idx, P_record_tally, P_dle_count);
3429 
3430 dcl  P_start_bufferp pointer parameter;                     /* -> buffer where search should begin */
3431 dcl  P_start_record_idx fixed binary parameter;             /* index (0-based) in buffer of first character to check */
3432 dcl  P_rcb_included bit (1) aligned parameter;              /* ON => buffer already contains the record's RCB */
3433 dcl  P_count_dles bit (1) aligned parameter;                /* ON => caller wants a count of DLEs in the record */
3434 
3435 dcl  P_end_bufferp pointer parameter;                       /* set -> buffer containing end of record/null if none */
3436 dcl  P_end_record_idx fixed binary parameter;               /* set to index (0-based) in buffer of last character
3437                                                                of record found (if any) */
3438 dcl  P_record_tally fixed binary parameter;                 /* set to # of characters in the record */
3439 dcl  P_dle_count fixed binary parameter;                    /* set to # of characters in record requiring transparency */
3440 
3441 dcl (bufferp, previous_bufferp) pointer;
3442 dcl (record_idx, previous_record_idx, record_tally, dle_count) fixed binary;
3443 dcl (count_dles_sw, end_of_data_is_special) bit (1) aligned;
3444 
3445 dcl  scb_char character (1) unaligned;
3446 
3447 dcl 1 scb unaligned based (addr (scb_char)) like hasp_scb_byte;
3448 dcl 1 compressed_scb unaligned based (addr (scb_char)) like hasp_compressed_scb_byte;
3449 dcl 1 not_compressed_scb unaligned based (addr (scb_char)) like hasp_not_compressed_scb_byte;
3450 
3451 
3452                P_end_bufferp = null ();                     /* set output for failure */
3453                P_end_record_idx, P_record_tally, P_dle_count = 0;
3454 
3455                bufferp = P_start_bufferp;
3456                record_idx = P_start_record_idx;
3457                count_dles_sw = P_count_dles;
3458 
3459                record_tally, dle_count = 0;
3460 
3461                end_of_data_is_special = "0"b;               /* used to stop advance_pointer from failing */
3462 
3463 
3464 /* If an RCB is included, check for special records:  the special records currently are the end-of-block and general
3465    control records (SIGNON, for example) */
3466 
3467                if P_rcb_included then
3468 
3469                     if (bufferp -> buffer.chars (record_idx) = HASP_EOB_RCB) then
3470                          go to SUCCESSFUL_RETURN_FROM_FIND_NEXT_RECORD;    /* end-of-block: just the RCB, counted below */
3471 
3472                     else if (bufferp -> buffer.chars (record_idx) = HASP_GENERAL_CONTROL_RCB)
3473                     then do;                                /* general control record:  terminated by a NUL, which is not
3474                                                                part of the record, but is the next RCB */
3475                          call advance_pointer (1);          /* skip the RCB */
3476                          end_of_data_is_special = "1"b;
3477                          do while ("1"b);                   /* until we win or run off the end */
3478                               previous_bufferp = bufferp;   /* will try to find the NUL, but want previous character */
3479                               previous_record_idx = record_idx;
3480                               call advance_pointer (1);
3481                               if (bufferp -> buffer.chars (record_idx) = NUL) then do;
3482 END_OF_GENERAL_CONTROL_RECORD_SCAN: bufferp = previous_bufferp;
3483                                    record_idx = previous_record_idx;
3484                                    record_tally = record_tally - 1;
3485                                    go to SUCCESSFUL_RETURN_FROM_FIND_NEXT_RECORD;
3486                               end;
3487                          end;
3488                     end;
3489 
3490                     else call advance_pointer (2);          /* normal record:  pass over RCB and SRCB */
3491 
3492                else call advance_pointer (1);               /* skip past just an SRCB */
3493 
3494 
3495 /* Scan the actual record to find the end-of-record SCB */
3496 
3497                do while ("1"b);
3498 
3499                     scb_char = bufferp -> buffer.chars (record_idx);
3500 
3501                     if scb_char = HASP_EOR_SCB then         /* have reached the end-of-record */
3502                          go to SUCCESSFUL_RETURN_FROM_FIND_NEXT_RECORD;
3503 
3504                     else                                    /* an ordinary SCB */
3505                     if scb.not_compressed then
3506                          call advance_pointer (not_compressed_scb.count + 1);
3507 
3508                     else if compressed_scb.not_blank then
3509                          call advance_pointer (2);          /* skip the SCB and the character */
3510                     else call advance_pointer (1);          /* skip just the SCB */
3511                end;
3512 
3513 
3514 /* Return:  the above loop will have set bufferp, record_idx, and dle_count correctly; however, record_tally will not have
3515    counted the last character of the record; do that here */
3516 
3517 SUCCESSFUL_RETURN_FROM_FIND_NEXT_RECORD:
3518                P_end_bufferp = bufferp;
3519                P_end_record_idx = record_idx;
3520                P_record_tally = record_tally + 1;           /* count the last character of the record */
3521                P_dle_count = dle_count;
3522 
3523 RETURN_FROM_FIND_NEXT_RECORD:
3524                return;
3525 %page;
3526 /* Internal to find_next_record:  skip over the specified number of characters, counting DLEs */
3527 
3528 advance_pointer:
3529                procedure (P_n_characters);
3530 
3531 dcl  P_n_characters fixed binary parameter;
3532 
3533 dcl (amount_left, amount_in_buffer) fixed binary;
3534 
3535 
3536                     record_tally = record_tally + P_n_characters;
3537                                                             /* count the characters into the record */
3538 
3539                     amount_left = P_n_characters;
3540 
3541                     do while (amount_left > 0);
3542 
3543                          amount_in_buffer = (bufferp -> buffer.tally) - record_idx;
3544 
3545                          if amount_in_buffer > amount_left
3546                          then do;                           /* first character after text is in this buffer */
3547                               dle_count = dle_count + count_dles (amount_left);
3548                               record_idx = record_idx + amount_left;
3549                               amount_left = 0;
3550                          end;
3551 
3552                          else do;                           /* in next buffer (maybe): count DLEs and go to next buffer */
3553                               previously_scanned_bufferp = bufferp;
3554                               dle_count = dle_count + count_dles (amount_in_buffer);
3555                               amount_left = amount_left - amount_in_buffer;
3556                               if (bufferp -> buffer.next) = 0 then    /* no next buffer:  no complete record */
3557                                    if end_of_data_is_special then
3558                                         go to END_OF_GENERAL_CONTROL_RECORD_SCAN;
3559                                    else do;                 /* need record_tally/dle_count to check for overly long ... */
3560                                         P_record_tally = record_tally - amount_left;
3561                                         P_dle_count = dle_count; /* ... records before partial records */
3562                                         go to RETURN_FROM_FIND_NEXT_RECORD;
3563                                    end;
3564                               bufferp = pointer (ttybp, bufferp -> buffer.next);
3565                               record_idx = 0;
3566                          end;
3567                     end;
3568 
3569                     return;
3570 
3571 
3572 
3573 /* Internal to advance_pointer:  count the number of DLEs in the given piece of text */
3574 
3575 count_dles:         procedure (P_n_characters) returns (fixed binary);
3576 
3577 dcl  P_n_characters fixed binary parameter;
3578 
3579 dcl  text character (n_characters) unaligned based (addr (bufferp -> buffer.chars (record_idx)));
3580 dcl (n_characters, count, start, idx) fixed binary;
3581 
3582 
3583                          if ^count_dles_sw then             /* caller doesn't need a count */
3584                               return (0);
3585 
3586                          n_characters = P_n_characters;
3587 
3588                          count = 0;
3589 
3590                          start = 1;
3591                          idx = index (text, DLE);
3592 
3593                          do while (idx ^= 0);               /* while there are DLEs in the text */
3594                               count = count + 1;
3595                               start = start + idx;          /* skip past that DLE */
3596                               if start > n_characters then
3597                                    idx = 0;
3598                               else idx = index (substr (text, start), DLE);
3599                          end;
3600 
3601                          return (count);
3602 
3603                     end count_dles;
3604 
3605                end advance_pointer;
3606 
3607           end find_next_record;
3608 %page;
3609 /* Classify a HASP record according to its functionality */
3610 
3611 classify_record:
3612           procedure (P_bufferp, P_rcb_idx) returns (fixed binary);
3613 
3614 dcl  P_bufferp pointer parameter;                           /* -> tty buffer containing the record */
3615 dcl  P_rcb_idx fixed binary parameter;                      /* index of RCB in the buffer (0-based) */
3616 
3617 dcl  bufferp pointer;
3618 dcl  rcb_idx fixed binary;
3619 
3620 dcl  rcb_char character (1) unaligned;
3621 dcl  srcb_char character (1) unaligned;
3622 dcl  first_scb_char character (1) unaligned;
3623 
3624 dcl 1 rcb unaligned based (addr (rcb_char)) like hasp_rcb_byte;
3625 
3626 
3627 /* Pick up the record's RCB, SRCB, and first SCB */
3628 
3629                bufferp = P_bufferp;
3630                rcb_idx = P_rcb_idx;
3631 
3632                if rcb_idx < bufferp -> buffer.tally then
3633                     rcb_char = bufferp -> buffer.chars (rcb_idx);
3634                else                                         /* RCB is in next block (blame move_record_to_output_block) */
3635                if bufferp -> buffer.next = 0 then
3636                     return (0);                             /* ... but there is no next block (?) */
3637                else do;
3638                     bufferp = pointer (ttybp, bufferp -> buffer.next);
3639                     rcb_idx = 0;                            /* ... it's the first character in this buffer */
3640                     rcb_char = bufferp -> buffer.chars (0);
3641                end;
3642 
3643                if rcb_idx < (bufferp -> buffer.tally - 1) then
3644                     srcb_char = bufferp -> buffer.chars (rcb_idx+1);
3645                else                                         /* SRCB not in this block, check the next one */
3646                if bufferp -> buffer.next = 0 then
3647                     srcb_char = NUL;
3648                else do;
3649                     bufferp = pointer (ttybp, bufferp -> buffer.next);
3650                     rcb_idx = -1;                           /* not in this buffer */
3651                     srcb_char = bufferp -> buffer.chars (0);
3652                end;
3653 
3654                if rcb_idx < (bufferp -> buffer.tally - 2) then
3655                     first_scb_char = bufferp -> buffer.chars (rcb_idx+2);
3656                else                                         /* first SCB not in this block, check the next one */
3657                if bufferp -> buffer.next = 0 then
3658                     first_scb_char = NUL;
3659                else first_scb_char = pointer (ttybp, bufferp -> buffer.next) -> buffer.chars (0);
3660 
3661 
3662 /* Now classify the record */
3663 
3664                if rcb.not_eob then                          /* not an end-of-block */
3665 
3666                     if rcb.type = HASP_RCB_TYPE_CONTROL then     /* some form of control record */
3667 
3668                          if rcb.stream = HASP_RCB_STREAM_RTS then
3669                               return (HASP_RTS_RECORD);
3670 
3671                          else if rcb.stream = HASP_RCB_STREAM_RTS_ACK then
3672                               return (HASP_RTS_ACK_RECORD);
3673 
3674                          else if rcb.stream = HASP_RCB_STREAM_BAD_BCB then
3675                               return (HASP_BAD_BCB_RECORD);
3676 
3677                          else if rcb.stream = HASP_RCB_STREAM_CONTROL then
3678                               if srcb_char = HASP_SIGNON_SRCB then
3679                                    return (HASP_SIGNON_RECORD);
3680                               else return (0);              /* unknown type */
3681                          else return (0);
3682 
3683                     else if (srcb_char = HASP_EOF_SRCB) & (first_scb_char = HASP_EOF_FIRST_SCB) then
3684                               return (HASP_EOF_RECORD);
3685 
3686                     else return (HASP_DATA_RECORD);         /* simple data record */
3687 
3688                else return (HASP_EOB_RECORD);               /* first bit off -- end of block */
3689 
3690           end classify_record;
3691 %page;
3692 /* Return "1"b if the current output block is empty */
3693 
3694 empty_output_blockp:
3695           procedure () returns (bit (1) aligned);
3696 
3697                if hmd.output_block.first_bufferp = null () then
3698                     return ("1"b);                          /* there is no block right now */
3699 
3700                else return (hmd.output_block.tally <= length (string (TEMPLATE_HASP_BLOCK_HEADER)));
3701 
3702           end empty_output_blockp;
3703 
3704 
3705 
3706 /* Return "1"b if there is room in the current output block for a record of the given length and the block trailer */
3707 
3708 space_in_output_block_for_recordp:
3709           procedure (P_record_lth) returns (bit (1) aligned);
3710 
3711 dcl  P_record_lth fixed binary parameter;
3712 
3713                return                                       /* check that record and trailer won't overflow the block */
3714                  (hmd.max_block_size >=
3715                   (hmd.output_block.tally + P_record_lth + length (string (TEMPLATE_HASP_BLOCK_TRAILER))));
3716 
3717           end space_in_output_block_for_recordp;
3718 
3719 
3720 
3721 /* Return "1"b if there is no more room left in the current output block */
3722 
3723 full_output_blockp:
3724           procedure () returns (bit (1) aligned);
3725 
3726                if empty_output_blockp () then
3727                     return ("0"b);                          /* always room in an empty block */
3728                else return (^space_in_output_block_for_recordp (length (string (TEMPLATE_HASP_RTS_RECORD))));
3729                                                             /* block full if smallest record possible won't fit */
3730 
3731           end full_output_blockp;
3732 
3733 
3734 
3735 /* Return "1"b if there is room in an empty output block for a record of the given length */
3736 
3737 space_in_empty_output_block_for_recordp:
3738           procedure (P_record_lth) returns (bit (1) aligned);
3739 
3740 dcl  P_record_lth fixed binary parameter;
3741 
3742                return                                       /* check that header, record, and trailer fit into block */
3743                  (hmd.max_block_size >=
3744                   (P_record_lth + length (string (TEMPLATE_HASP_BLOCK_HEADER)) +
3745                                   length (string (TEMPLATE_HASP_BLOCK_TRAILER))));
3746 
3747           end space_in_empty_output_block_for_recordp;
3748 %page;
3749 /* Delete characters from a buffer */
3750 
3751 delete_text:
3752           procedure (P_bufferp, P_position, P_text_lth);
3753 
3754 dcl  P_bufferp pointer parameter;
3755 dcl  P_position fixed binary parameter;                     /* delete characters starting with this one (0-based) */
3756 dcl  P_text_lth fixed binary parameter;                     /* # of character to delete */
3757 
3758 dcl  based_remainder character (remainder_lth) unaligned based;
3759 dcl  remainder_lth fixed binary;
3760 
3761 
3762                remainder_lth = (P_bufferp -> buffer.tally) - P_text_lth - P_position;
3763 
3764                addr (P_bufferp -> buffer.chars (P_position)) -> based_remainder =
3765                     addr (P_bufferp -> buffer.chars (P_position+P_text_lth)) -> based_remainder;
3766 
3767                P_bufferp -> buffer.tally = (P_bufferp -> buffer.tally) - P_text_lth;
3768 
3769                return;
3770 
3771           end delete_text;
3772 
3773 
3774 
3775 /* Trace an input/output block:  simply dump each buffer of the block using the MCS tracing facility */
3776 
3777 trace_block:
3778           procedure (P_first_bufferp, P_direction);
3779 
3780 dcl  P_first_bufferp pointer parameter;                     /* -> first buffer of block to be traced */
3781 dcl  P_direction bit (1) parameter;                         /* type of block:  ON => output; OFF => input */
3782 
3783                call mcs_trace (hmd.devx, "^[Output^;Input^] chain starting at ^p:", P_direction, P_first_bufferp);
3784 
3785                call mcs_trace$buffer_chain (hmd.devx, P_first_bufferp);
3786 
3787                return;
3788 
3789           end trace_block;
3790 %page;
3791 %include hasp_mpx_data;
3792 %page;
3793 %include hasp_load_data;
3794 %page;
3795 %include hasp_mpx_meters;
3796 %page;
3797 %include hasp_subchannel_meters;
3798 %page;
3799 %include hasp_block_record_data;
3800 
3801 %include hasp_rcb_byte;
3802 
3803 %include hasp_srcb_scb_bytes;
3804 %page;
3805 %include hasp_signon_record_info;
3806 %page;
3807 %include bisync_line_data;
3808 %page;
3809 %include mcs_interrupt_info;
3810 %page;
3811 %include tty_buffer_block;
3812 %page;
3813 %include mcs_modes_change_list;
3814 %page;
3815 %include channel_manager_dcls;
3816 
3817 %include tty_space_man_dcls;
3818 %page;
3819 %include lct;
3820 %page;
3821 %include get_comm_meters_info;
3822 %page;
3823 /* BEGIN MESSAGE DOCUMENTATION
3824 
3825    Message:
3826    hasp_mpx (line TTY): No space available to preserve minor state; line will be hungup.
3827 
3828    S:  $info
3829 
3830    M:  Insufficient space was available in tty_buf to perform part of the critical input processing of the HASP
3831    multiplexer on channel TTY.  The connection to the remote host/workstation is broken as communications cannot continue
3832    under these conditions.
3833 
3834    A:  $inform
3835    It may be necessary to increase the size of tty_buf as specified on the PARM config card before using this multiplexer
3836    again.
3837 
3838 
3839    Message:
3840    hasp_mpx (line TTY): No space available to save loopback chain; line will be hungup.
3841 
3842    S:  $info
3843 
3844    M:  Insufficient space was available in tty_buf to perform part of the critical input processing of the HASP
3845    multiplexer on channel TTY.  The connection to the remote host/workstation is broken as communications cannot continue
3846    under these conditions.
3847 
3848    A:  $inform
3849    It may be necessary to increase the size of tty_buf as specified on the PARM config card before using this multiplexer
3850    again.
3851 
3852 
3853    Message:
3854    hasp_mpx (line TTY): Duplicate loopback block received: BCB = NNN
3855 
3856    S:  $note
3857 
3858    T:  $run
3859 
3860    M:  The output block identified by the 3-digit octal sequence NNN was returned to Multics twice by the FNP for
3861    reprocessing.
3862 
3863    A:  $inform
3864 
3865 
3866    Message:
3867    hasp_mpx (line TTY): Invalid input block header/trailer; line will be hungup.
3868 
3869    S:  $note
3870 
3871    T:  $run
3872 
3873    M:  A data block whose format does not conform to the HASP protocol was received from the remote host/workstation by
3874    the HASP multiplexer on channel TTY.  The connection to the remote host/workstation is broken as communications cannot
3875    continue under these conditions.
3876 
3877    A:  Frequent occurences of this message indicate that hardware or software problems may exist in the remote
3878    host/workstation.  The operator should contact the appropriate personnel before reusing the multiplexer.
3879 
3880 
3881    Message:
3882    hasp_mpx (line TTY): Block recevied out of sequence: expected = N, received = M; block ignored.
3883 
3884    S:  $log
3885 
3886    T:  $run
3887 
3888    M:  A duplicate data block was received by the HASP multiplexer on channel TTY from the foreign host/workstation.
3889 
3890    A:  The operator should ignore this message unless it occurs quite frequently.  Frequent occurences of this message
3891    indicate possible problems in the communications equipment which should be investigated by the appropriate personnel.
3892 
3893 
3894    Message:
3895    hasp_mpx (line TTY): Block received out of sequence: expected = N, recevied = M; line will be hungup.
3896 
3897    S:  $note
3898 
3899    T:  $run
3900 
3901    M:  One or more data blocks from the remote host/workstation for the HASP multiplexer on channel TTY were lost.  The
3902    connection to the remote host/workstation is broken as communications cannot continue under these conditions.
3903 
3904    A:  There are two possible causes for this message: communications equipment failures or problems in the remote
3905    host/workstation itself.  The operator should contact the appropriate personnel before reusing the multiplexer.
3906 
3907 
3908    Message:
3909    hasp_mpx (line TTY): Block transmitted out of sequence: expected = N, received = M; line will be hungup.
3910 
3911    S:  $note
3912 
3913    T:  $run
3914 
3915    M:  One or more data blocks transmitted by the HASP multiplexer on channel TTY were not received by the remote
3916    host/workstation.  The connection to the remote host/workstation is broken as communications cannot continue
3917    under these conditions.
3918 
3919    A:  $inform
3920    The HASP software is designed to prevent this situation even if the communications equipment is not functioning
3921    properly.
3922 
3923 
3924    Message:
3925    hasp_mpx (line TTY): Bad block line status from FNP; line will be hungup.
3926 
3927    S:  $note
3928 
3929    T:  $run
3930 
3931    M:  A block generated by the HASP multiplexer on channel TTY for transmission was malformed.  The connection to the
3932    remote host/workstation is broken as communications cannot continue under these conditions.
3933 
3934    A:  $inform
3935 
3936 
3937    Message:
3938    hasp_mpx (line TTY): Too many NAKs; line will be hungup.
3939 
3940    S:  $note
3941 
3942    T:  $run
3943 
3944    M:  A block could not be transmitted or received by the HASP multiplexer on channel TTY because of excessive line
3945    noise.  The connection to the remote host/workstation is broken as communications cannot continue
3946    under these conditions.
3947 
3948    A:  The operator should contact the appropriate personnel to check the communications equipment used by the line before
3949    attempting to reuse this multiplexer.
3950 
3951    END MESSAGE DOCUMENTATION */
3952 
3953      end hasp_mpx;