*copyc osd$default_pragmats
MODULE iim$st_send_output_message;

?? PUSH (LISTEXT := ON) ??
*copyc amt$local_file_name
*copyc bat$task_file_table
*copyc clc$standard_file_names
*copyc ifc$interrupt_timesharing_io
*copyc ife$error_codes
*copyc iik$keypoints
*copyc iit$connection_description
*copyc oss$job_paged_literal
*copyc oss$task_shared
*copyc tmc$wait_times
?? POP ??
*copyc amp$flush
*copyc clp$get_system_file_id
*copyc clp$get_time_string
*copyc iip$st_put
*copyc iip$clear_job_locks
*copyc iip$st_send_attributes_change
*copyc iip$vt_output
*copyc nap$await_data_available
*copyc nap$se_clear_request
*copyc nap$se_receive_data
*copyc nap$se_synchronize
*copyc osp$clear_job_signature_lock
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$set_status_from_condition
*copyc osp$test_sig_lock
*copyc pmp$continue_to_cause
*copyc pmp$get_job_names
*copyc pmp$log
*copyc bav$last_tft_entry
*copyc bav$task_file_table
*copyc iiv$interactive_terminated
*copyc iiv$output
*copyc jmv$terminal_io_disabled

  PROCEDURE [XDCL] iip$st_send_output_message (connection_desc_ptr:
        ^iit$connection_description;
        vtp_file_id: amt$file_identifier;
    VAR status: ost$status);

    VAR
      activity_status: [STATIC, oss$task_shared {namve workaround }] ost$activity_status,
      data: [STATIC] array [1 .. 1] of nat$data_fragment,
      data1: SEQ (REP iic$vt_header_length_input of cell),
      difference_count: integer,
      dqe: ^iit$st_downline_queue_entry,
      file_identifier: amt$file_identifier,
      file_id_is_valid: boolean,
      file_instance: ^bat$task_file_entry,
      fm: 0 .. 0ff(16),
      i: integer,
      ignore_status: ost$status,
      index: integer,
      job_is_disconnected: boolean,
      len: integer,
      local_status: ost$status,
      ls: ost$signature_lock_status,
      output_array: ^nat$data_fragments,
      output_info: iit$vt_output_information,
      p_length: ^integer,
      peer_operation: [STATIC, oss$task_shared {NAMVE workaround} ] nat$se_peer_operation,
      po: ^iit$st_output,
      put_byte_address: amt$file_byte_address,
      st_open_file_dsc_pointer: ^iit$st_open_file_description,
      str: ost$string,
      system_supplied_name: jmt$system_supplied_name,
      tcn: boolean,
      tcs: boolean,
      temp_output_array: array [1 .. nac$max_data_fragment_count] OF nat$data_fragment,
      text: [STATIC, READ, oss$job_paged_literal] string(35) :=
            ' TERMINAL TIMEOUT IN 30 SECONDS.' CAT $CHAR(7) CAT
            $CHAR(13) CAT $CHAR(10),
      timeout_data: SEQ (REP 1 of cell),
      timeout_message: string (80),
      tlength: integer,
      user_supplied_name: jmt$user_supplied_name,
      warning_displayed: boolean,
      xpt_type: ift$transparent_types;

?? NEWTITLE := 'PROCEDURE handle_break', EJECT ??

    PROCEDURE handle_break (cond: pmt$condition;
          cd: ^pmt$condition_information;
          sa: ^ost$stack_frame_save_area;
      VAR ch_status: ost$status);

      VAR
        iiv$condition_handler_trace: [XREF]  boolean,
        ignore_status: ost$status;

      IF (cond.selector = ifc$interactive_condition) OR (cond.selector = pmc$block_exit_processing) THEN
        osp$test_sig_lock (iiv$downline_queue_lock, ls);
        IF ls = osc$sls_locked_by_current_task THEN

          IF iiv$condition_handler_trace THEN
            pmp$log ('ST_SOM locked by current task',local_status);
          IFEND;
          IF cond.selector = ifc$interactive_condition THEN
            pmp$log ('ST - SOM - Had to clear the lock for interactive condition.', ignore_status);
          ELSE
            pmp$log ('ST - SOM - Had to clear the lock for block exit condition.', ignore_status);
          IFEND;

          RESET connection_desc_ptr^.output_buffer_entry_loc;
          RESET connection_desc_ptr^.output_buffer_exit_loc;
          connection_desc_ptr^.downline_queue_count := 0;
          osp$clear_job_signature_lock (iiv$downline_queue_lock);
        IFEND;

        IF cond.selector = ifc$interactive_condition THEN
          IF iiv$condition_handler_trace THEN
            pmp$log ('ST_SOM interactive condition',local_status);
          IFEND;
          pmp$continue_to_cause (pmc$execute_standard_procedure, ch_status);
          osp$set_status_from_condition (ifc$interactive_facility_id, cond, sa, status, ignore_status);
          EXIT iip$st_send_output_message;

        ELSE { cond.selector = pmc$block_exit_processing }

          IF (pmc$program_termination IN cond.reason) OR (pmc$program_abort IN cond.reason) THEN
            iip$clear_job_locks (ignore_status)
          IFEND;
          RETURN;
          IF iiv$condition_handler_trace THEN
            pmp$log ('ST_SOM block exit condition',local_status);
          IFEND;
        IFEND;

      ELSE
          IF iiv$condition_handler_trace THEN
            pmp$log ('ST_SOM neither interactive nor block exit',local_status);
          IFEND;
        pmp$continue_to_cause (pmc$execute_standard_procedure, ch_status);
      IFEND;
    PROCEND handle_break;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE compare_attributes', EJECT ??

    PROCEDURE compare_attributes (array1: ^iit$connection_attributes;
          array2: ^iit$connection_attributes;
      VAR difference_count: integer);

    { Compare the values of the connection attributes of array1 with those of
    { array2.  Return the number of discrepancies.

      difference_count := 0;
      IF dqe^.term_char_null THEN
        IF array1^.input_editing_mode.value <> array2^.input_editing_mode.value THEN
          difference_count := difference_count + 1;
        IFEND;

        IF array1^.trans_character_mode.value <> array2^.trans_character_mode.value THEN
          difference_count := difference_count + 1;
        IFEND;

        IF (array1^.trans_forward_character.value.size <> array2^.trans_forward_character.value.size) OR
              (array1^.trans_forward_character.value.value (1, array1^.trans_forward_character.value.size)
              <> array2^.trans_forward_character.value.value (1, array2^.trans_forward_character.value.
              size)) THEN
          difference_count := difference_count + 1;
        IFEND;

        IF array1^.trans_length_mode.value <> array2^.trans_length_mode.value THEN
          difference_count := difference_count + 1;
        IFEND;

        IF array1^.trans_message_length.value <> array2^.trans_message_length.value THEN
          difference_count := difference_count + 1;
        IFEND;

        IF (array1^.trans_terminate_character.value.size <> array2^.trans_terminate_character.value.size) OR
              (array1^.trans_terminate_character.value.value (1, array1^.trans_terminate_character.value.
              size) <> array2^.trans_terminate_character.value.value (1, array2^.trans_terminate_character.
              value.size)) THEN
          difference_count := difference_count + 1;
        IFEND;

        IF array1^.trans_timeout_mode.value <> array2^.trans_timeout_mode.value THEN
          difference_count := difference_count + 1;
        IFEND;
      IFEND;

      IF array1^.attention_character_action.value <> array2^.attention_character_action.value THEN
        difference_count := difference_count + 1;
      IFEND;

      IF array1^.break_key_action.value <> array2^.break_key_action.value THEN
        difference_count := difference_count + 1;
      IFEND;

      IF array1^.input_block_size.value <> array2^.input_block_size.value THEN
        difference_count := difference_count + 1;
      IFEND;

      IF array1^.input_output_mode.value <> array2^.input_output_mode.value THEN
        difference_count := difference_count + 1;
      IFEND;

      IF array1^.partial_char_forwarding.value <> array2^.partial_char_forwarding.value THEN
        difference_count := difference_count + 1;
      IFEND;

      IF array1^.store_backspace_character.value <> array2^.store_backspace_character.value THEN
        difference_count := difference_count + 1;
      IFEND;

      IF array1^.store_nuls_dels.value <> array2^.store_nuls_dels.value THEN
        difference_count := difference_count + 1;
      IFEND;


    PROCEND compare_attributes;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE timeout_job', EJECT ??

    PROCEDURE timeout_job;

{ Synchronize the connection in both directions. Then input on the connection to
{ clear the synchronize_confirm response.
{
      job_is_disconnected := FALSE;
      nap$se_synchronize (vtp_file_id, nac$se_synchronize_all_data, timeout_data,
              ignore_status);
      data [1].address := ^data1;
      data [1].length := iic$vt_header_length_input;
      nap$se_receive_data (vtp_file_id,
              data, osc$wait, peer_operation, activity_status,
              ignore_status);
{
{ Discard all data in the output buffer and clear the downline queue count.
{ We clear the downline queue lock so that we can call iip$st_put to output
{ the timeout messages.
{
      RESET connection_desc_ptr^.output_buffer_entry_loc;
      RESET connection_desc_ptr^.output_buffer_exit_loc;
      connection_desc_ptr^.downline_queue_count := 0;
      osp$clear_job_signature_lock (iiv$downline_queue_lock);
      IF NOT warning_displayed THEN
        clp$get_system_file_id (clc$job_output, file_identifier, ignore_status);
*copy bai$validate_file_identifier
*copy iii$fetch_st_open_file_desc_ptr
{
{ Output a character to reset the output side of the network.
{
        iip$st_put (file_identifier, st_open_file_dsc_pointer,
                amc$put_next_req, ^text, 1, ^put_byte_address,
                amc$terminate, ignore_status);
{
{ Output the timeout warning message.
{
        iip$st_put (file_identifier, st_open_file_dsc_pointer,
                amc$put_next_req, ^text, STRLENGTH (text), ^put_byte_address,
              amc$terminate, ignore_status);
        warning_displayed := TRUE;
        amp$flush (file_identifier, osc$wait, ignore_status);
{
{ Wait 30 seconds for a response to the warning message.
{
        nap$await_data_available (vtp_file_id, 30000, 30000, status);
        IF status.normal THEN
          osp$set_job_signature_lock (iiv$downline_queue_lock);
          RETURN;
        IFEND;
      IFEND;

{ Display the time and job name in the terminal timeout message.

      clp$get_time_string (str, ignore_status);
      timeout_message (1, 1) := ' ';
      timeout_message (2, str.size) := str.value (1, str.size);
      timeout_message (str.size + 2, 24) := ' TERMINAL TIMEOUT.  JOB ';
      pmp$get_job_names (user_supplied_name, system_supplied_name, ignore_status);
      timeout_message (str.size + 26, 19) := system_supplied_name;
      timeout_message (str.size + 45, 13) := ' DETACHED.' CAT $CHAR (7) CAT
            $CHAR (13) CAT $CHAR (10);
      clp$get_system_file_id (clc$job_output, file_identifier, ignore_status);
*copy bai$validate_file_identifier
*copy iii$fetch_st_open_file_desc_ptr
{
{ Output the terminal timeout message to the terminal.
{
      iip$st_put (file_identifier, st_open_file_dsc_pointer, amc$put_next_req,
             #LOC (timeout_message), str.size + 57, ^put_byte_address,
             amc$terminate, ignore_status);
      amp$flush (file_identifier, osc$wait, ignore_status);
      file_identifier := vtp_file_id;
*copy bai$validate_file_identifier
      nap$se_clear_request(file_instance^.local_file_name, status);
      IF NOT status.normal THEN
        osp$set_job_signature_lock (iiv$downline_queue_lock);
        RETURN;
      IFEND;

      job_is_disconnected := TRUE;
      RETURN;

    PROCEND timeout_job;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    #KEYPOINT (osk$entry, 0, iik$st_send_output_message);

{   interlock the send output message operation (1 per job)

    osp$test_sig_lock (iiv$downline_queue_lock, ls);
    IF ls = osc$sls_locked_by_current_task THEN
      RETURN;
    IFEND;

    osp$establish_condition_handler (^handle_break, TRUE);
    osp$set_job_signature_lock (iiv$downline_queue_lock);
  /begin_end/
    BEGIN
      IF connection_desc_ptr^.downline_queue_count <> 0 THEN

      /send_output_message/
        REPEAT
          index := 0;

        { repeatedly send downline queue entries, via iip$vt_output, to the network
        { until the downline queue count is 0.

    {     Build address-length pairs for as many like queue
    {     entries as possible.  The following conditions terminate the building of pairs:
    {     - downline queue empty
    {     - temp_output_array contains nac$max_data_fragments_count entries
    {     - change in block modes (transparent, format effectors)
    {     - terminal attributes change

          tlength := 0;
          NEXT p_length IN connection_desc_ptr^.output_buffer_exit_loc;
          IF p_length = NIL THEN
            osp$system_error ('ST_SOM CONFUSION #1 ', NIL);
          IFEND;
          RESET connection_desc_ptr^.output_buffer_exit_loc TO p_length;
          NEXT po: [1 .. p_length^] IN connection_desc_ptr^.output_buffer_exit_loc;
          IF po = NIL THEN
            osp$system_error ('ST_SOM CONFUSION #2 ', NIL);
          IFEND;
          dqe := ^po^.block;
          fm := dqe^.output_info.formatting_mode;
          output_info := dqe^.output_info;
          tcs := dqe^.term_char_sent;
          tcn := dqe^.term_char_null;
          xpt_type := dqe^.transparent_type;

          IF (output_info.secured.suppress_echoplexing) OR
                (output_info.secured.suppress_end_line_positioning) THEN

          { When echoplexing and/or cursor_positioning are to be suppressed for the first queue
          { entry in the output buffer, flush the queue entry alone and cycle /send_output_message/.

            temp_output_array [1].address := #LOC (dqe^.data [1]);
            temp_output_array [1].length := p_length^;

            PUSH output_array: [1 .. 1];
            output_array^ [1] := temp_output_array [1];

          { Update the downline_queue_count, but check for zero since condition handler may have zeroed.

            IF connection_desc_ptr^.downline_queue_count <> 0 THEN
              connection_desc_ptr^.downline_queue_count := connection_desc_ptr^.
                    downline_queue_count - p_length^;
            IFEND;

            IF iiv$terminal_timeout_limit <> tmc$infinite_wait THEN
              iip$vt_output (dqe^.vtp_connection_id, vtp_file_id, output_array^,
                    output_info, osc$nowait, activity_status, status);
              warning_displayed := FALSE;
              IF jmv$terminal_io_disabled THEN
                RESET connection_desc_ptr^.output_buffer_entry_loc;
                RESET connection_desc_ptr^.output_buffer_exit_loc;
                connection_desc_ptr^.downline_queue_count := 0;
                EXIT /begin_end/;
              IFEND;

              IF NOT activity_status.complete THEN { it's time to disconnect.
                activity_status.complete := TRUE;
                timeout_job;
                IF job_is_disconnected THEN
                  osp$disestablish_cond_handler;
                  RETURN;
                IFEND;
              IFEND;

            ELSE
              iip$vt_output (dqe^.vtp_connection_id, vtp_file_id, output_array^,
                    output_info, osc$wait, activity_status, status);
              IF jmv$terminal_io_disabled THEN
                RESET connection_desc_ptr^.output_buffer_entry_loc;
                RESET connection_desc_ptr^.output_buffer_exit_loc;
                connection_desc_ptr^.downline_queue_count := 0;
                EXIT /begin_end/;
              IFEND;
            IFEND;

            IF NOT status.normal THEN
              status.normal := TRUE;
              EXIT /begin_end/;  { do not enable until debugging is done }
            IFEND;

            connection_desc_ptr^.job_output_count :=
              connection_desc_ptr^.job_output_count + p_length^;
            CYCLE /send_output_message/;
          IFEND;

        { Compare the downline queue entry's attributes with those in the
        { terminal connection table.  If different then send an attributes
        { change message to the network.

          IF NOT tcs THEN
            IF dqe^.output_info.formatting_mode = 0 THEN
              IF dqe^.transparent_type =ifc$single_message THEN
                dqe^.connection_ptr^.actual_connection_attributes.input_editing_mode.value := ifc$normal_edit;
              IFEND;
            IFEND;
            compare_attributes (^dqe^.attributes, ^dqe^.connection_ptr^.actual_connection_attributes,
                  difference_count);
            IF difference_count <> 0 THEN
              { send attribute downline, immediately update data structure before considering status }
              iip$st_send_attributes_change (dqe, difference_count, status);
              dqe^.term_char_sent := TRUE;
              IF jmv$terminal_io_disabled THEN
                RESET connection_desc_ptr^.output_buffer_entry_loc;
                RESET connection_desc_ptr^.output_buffer_exit_loc;
                connection_desc_ptr^.downline_queue_count := 0;
                EXIT /begin_end/;
              ELSE
                RESET connection_desc_ptr^.output_buffer_exit_loc TO po;
              IFEND;
              IF NOT status.normal THEN
    {!!!}       EXIT /begin_end/;    { do not enable this until debugging done }
              IFEND;
              CYCLE /send_output_message/;
            IFEND;
          IFEND;

        /build_output_message/
          WHILE TRUE DO
            len := p_length^;
            tcn := dqe^.term_char_null;
            tcs := dqe^.term_char_sent;

          { check if to terminate building the current message

            IF NOT tcs THEN
              compare_attributes (^dqe^.attributes, ^dqe^.connection_ptr^.actual_connection_attributes,
                    difference_count);
            IFEND;
            IF (fm <> dqe^.output_info.formatting_mode)
                  OR (index >= nac$max_data_fragment_count)
                  OR (output_info.partial <> dqe^.output_info.partial)
                  OR (dqe^.output_info.secured.suppress_end_line_positioning)
                  OR (dqe^.output_info.secured.suppress_echoplexing)
                  OR (tlength > iic$max_block_size)
                  OR ((NOT tcs) AND (difference_count <> 0)) THEN
              RESET connection_desc_ptr^.output_buffer_exit_loc TO po;
              EXIT /build_output_message/;
            IFEND;

    {       add an address-length pair to the temp_output_array for this queue entry

            IF (NOT tcn) { OR (len > 0) } THEN      { OR section removed by gkc }
              index := index + 1;
              temp_output_array [index].address := #LOC (dqe^.data [1]);
              temp_output_array [index].length := len;
            IFEND;
            tlength := tlength + p_length^;

    {       attempt to continue if there are any more queue entries left
    {       set dqe to point to the next entry to add to the message

            IF tlength < connection_desc_ptr^.downline_queue_count THEN
              NEXT p_length IN connection_desc_ptr^.output_buffer_exit_loc;
              IF p_length = NIL THEN
                osp$system_error ('ST_SOM CONFUSION #3 ', NIL);
              IFEND;
              RESET connection_desc_ptr^.output_buffer_exit_loc TO p_length;
              NEXT po: [1 .. p_length^] IN connection_desc_ptr^.output_buffer_exit_loc;
              IF po = NIL THEN
                osp$system_error ('ST_SOM CONFUSION #4 ', NIL);
              IFEND;
              dqe := ^po^.block;
            ELSE
              EXIT /build_output_message/;
            IFEND;
          WHILEND /build_output_message/;
        { Re-evaluate downline_queue_count since cond handler may have zeroed.
          IF connection_desc_ptr^.downline_queue_count <> 0 THEN
            connection_desc_ptr^.downline_queue_count := connection_desc_ptr^.downline_queue_count - tlength;
          IFEND;

        { Send a downline block if there are any data fragments in the output array }

          IF (index > 0) THEN
            PUSH output_array: [1 .. index];
            FOR i := 1 TO index DO
              output_array^ [i] := temp_output_array [i];
            FOREND;
          ELSE
            PUSH output_array: [1 .. 1];
            output_array^ [1].address := NIL;
            output_array^ [1].length := 0;
            output_info.formatting_mode := iiv$last_formatting_mode;
          IFEND;

          { Call vtp to output the contents of output_buffer.

          IF (index > 0) OR (NOT output_info.partial) THEN
            iiv$last_formatting_mode := output_info.formatting_mode;
            IF iiv$terminal_timeout_limit <> tmc$infinite_wait THEN
              iip$vt_output (dqe^.vtp_connection_id, vtp_file_id, output_array^,
                    output_info, osc$nowait, activity_status, status);
              warning_displayed := FALSE;
              IF jmv$terminal_io_disabled THEN
                RESET connection_desc_ptr^.output_buffer_entry_loc;
                RESET connection_desc_ptr^.output_buffer_exit_loc;
                connection_desc_ptr^.downline_queue_count := 0;
                EXIT /begin_end/;
              IFEND;

              IF NOT activity_status.complete THEN { it's time to disconnect.
                activity_status.complete := TRUE;
                timeout_job;
                IF job_is_disconnected THEN
                  osp$disestablish_cond_handler;
                  RETURN;
                IFEND;
              IFEND;

            ELSE
              iip$vt_output (dqe^.vtp_connection_id, vtp_file_id, output_array^,
                    output_info, osc$wait, activity_status, status);
              IF jmv$terminal_io_disabled THEN
                RESET connection_desc_ptr^.output_buffer_entry_loc;
                RESET connection_desc_ptr^.output_buffer_exit_loc;
                connection_desc_ptr^.downline_queue_count := 0;
                EXIT /begin_end/;
              IFEND;
            IFEND;

            IF NOT status.normal THEN
{!!!}         status.normal := TRUE;
{!!!          EXIT /begin_end/;  { do not enable until debugging is done }
            IFEND;

            connection_desc_ptr^.job_output_count :=
              connection_desc_ptr^.job_output_count + tlength;
          IFEND;

          index := 0;
          IF connection_desc_ptr^.downline_queue_count <= 0 THEN
            IF (connection_desc_ptr^.downline_queue_count < 0) THEN
              osp$system_error ('ST_SOM CONFUSED #5 ', NIL);
            IFEND;
            RESET connection_desc_ptr^.output_buffer_entry_loc;
            RESET connection_desc_ptr^.output_buffer_exit_loc;
          IFEND;

        UNTIL connection_desc_ptr^.downline_queue_count <= 0;
      IFEND;

    END /begin_end/;
    osp$clear_job_signature_lock (iiv$downline_queue_lock);
    osp$disestablish_cond_handler;

    #KEYPOINT (osk$exit, 0, iik$st_send_output_message);

  PROCEND iip$st_send_output_message;
MODEND iim$st_send_output_message

