?? RIGHT := 110 ??
?? NEWTITLE := 'NFM$RHF_SEND_FILE' ??
MODULE nfm$rhf_send_file;

{ PURPOSE:  This module contains procedures used to perform the data
{           transfer phase for files sent via the RHF A-to-A file
{           transfer protocol.

?? NEWTITLE := 'GLOBAL DECLARATIONS REFERENCED', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc AMV$NIL_FILE_IDENTIFIER
*copyc AMT$SEGMENT_POINTER
*copyc IFE$ERROR_CODES
*copyc JMT$DESTINATION_USAGE
*copyc JMT$OUTPUT_FILE_POSITION
*copyc NAE$APPLICATION_INTERFACES
*copyc NFD$TRANSFER_DECLARATIONS
*copyc NFE$BATCH_TRANSFER_SERVICES
*copyc NFE$FTS_CONDITION_CODES
*copyc NFT$FILE_KIND
*copyc NFT$NETWORK_TYPE
*copyc NFT$PARAMETER_00_VALUES
*copyc NFT$PARAMETER_17_DEFINITION
*copyc NFT$TRANSFER_DECLARATIONS
*copyc NFT$TRANSFER_MODES
*copyc OSD$VIRTUAL_ADDRESS
*copyc RFE$CONDITION_CODES
?? POP ??
*copyc AMP$FILE
*copyc AMP$GET_FILE_ATTRIBUTES
*copyc AMP$GET_PARTIAL
*copyc AMP$GET_SEGMENT_POINTER
*copyc AMP$RETURN
*copyc AMP$SET_LOCAL_NAME_ABNORMAL
*copyc BAP$GET_PHN_VIA_FILE_ID
*copyc CLP$CONVERT_INTEGER_TO_RJSTRING
*copyc CLP$CONVERT_INTEGER_TO_STRING
*copyc CLP$CONVERT_STRING_TO_INTEGER
*copyc CLP$READ_VARIABLE
*copyc FSP$CLOSE_FILE
*copyc FSP$COPY_FILE
*copyc FSP$OPEN_AND_GET_TYPE_OF_COPY
*copyc FSP$OPEN_FILE
*copyc JMP$CLOSE_OUTPUT_FILE
*copyc JMP$OPEN_INPUT_FILE
*copyc JMP$OPEN_OUTPUT_FILE
*copyc MMP$SET_ACCESS_SELECTIONS
*copyc NAP$AWAIT_DATA_AVAILABLE
*copyc NAP$DISPLAY_MESSAGE
*copyc NAP$FETCH_ATTRIBUTES
*copyc NAP$SE_RECEIVE_DATA
*copyc NAP$SE_SEND_DATA
*copyc NAP$STORE_ATTRIBUTES
*copyc NFP$PTF_FORMAT_MESSAGE_TO_OUT
*copyc OSP$ESTABLISH_CONDITION_HANDLER
*copyc OSP$FORMAT_MESSAGE
*copyc OSP$SET_STATUS_ABNORMAL
*copyc OSP$SET_STATUS_CONDITION
*copyc OSP$SYSTEM_ERROR
*copyc PMP$CONTINUE_TO_CAUSE
*copyc PMP$ESTABLISH_CONDITION_HANDLER
*copyc PMP$GET_170_OS_TYPE
*copyc PMP$GET_UNIQUE_NAME
*copyc PMP$LOG
*copyc RFP$AWAIT_RHFAM_EVENT
*copyc RFP$FETCH
*copyc RFP$RECEIVE_DATA
*copyc RFP$SEND_DATA
*copyc RFP$STORE
*copyc SRP$FETCH_SYSTEM_LABEL
*copyc SRP$FETCH_SYSTEM_LABEL_SIZE

*copyc AMV$NIL_FILE_IDENTIFIER
*copyc FSV$COPF_INPUT_FILE_ATTACHMENT
*copyc FSV$COPF_OUTPUT_FILE_ATTACHMENT
?? TITLE := 'GLOBAL DECLARATIONS DECLARED', EJECT ??

  TYPE
    positioning_grid = packed array [1 .. * ] of char,
    reposition_direction = (forward, backward),
    reposition_displacement = 0 .. 65535,
    reposition_preview_lines = 0 .. 10,
    reposition_preview_message = array [1 .. 3] of record
      message: ^string ( * ),
      length: 0 .. 2560,
    recend,
    reposition_start_position = (top, bottom, last_line_printed),
    reposition_string = string ( * <= 256),
    reposition_units = (lines, pages),
    repositioning_type = (no_repositioning, forward_string_search_to_line, forward_string_search_to_page,
          back_string_search_to_line, back_string_search_to_page, forward_ellipsis_search_to_line,
          forward_ellipsis_search_to_page, back_ellipsis_search_to_line, back_ellipsis_search_to_page,
          forward_line_displacement, backward_line_displacement, forward_page_absolute, forward_page_relative,
          backward_page_absolute, backward_page_relative, line_adjustment_forward, page_adjustment_forward,
          line_adjustment_backward, page_adjustment_backward),
    sender_input_commands = (sr, rr, mr, er, qr, pr),
    sender_input_data_area = array [1 .. 1] of ^SEQ ( * ),
    sender_positioning_attributes = (reposition_info, current_position),
    sender_states = (start_pend, restart_pend, wait_sendr, ss_ack_not_required, send_data, end_ok_sent,
          end_err_sent, quit_ok_received, quit_err_received, pos_pend, holdr_pend, wait_resume, exit_send);

  VAR
    access_method: (nfc$am_rhfam, nfc$am_nam) := nfc$am_nam,
    active_send_error_code: char,
    control_info: fst$copy_control_information,
    current_send_state: sender_states,
    header_buffer: batch_data_header,
    position_valid: boolean,
    processing_error: boolean,
    protocol_trace: boolean,
    queue_file: boolean,
    return_file: boolean,
    search_character_designator: [STATIC, READ] array [1 .. 4] of integer := [100000000(16), 0, 0, 0],
    send_params: transfer_params,
    send_transfer_progress: transfer_progress,
    sender_file_id: amt$file_identifier,
    transfer_file: amt$local_file_name,
    transfer_file_size: amt$file_length;

?? TITLE := '[XDCL] nfp$send_batch_file', EJECT ??
*copyc nfh$send_batch_file

  PROCEDURE [XDCL] nfp$send_batch_file
    (    connection_fid: amt$file_identifier;
         connection_file_name: fst$file_reference;
         file_name: jmt$system_supplied_name;
         local_file_name: amt$local_file_name;
         facilities: nft$facility_group;
         transfer_mode: nft$transfer_modes;
         block_size: nft$block_size;
         min_timeout: nft$timeout;
         protocol_version: nft$parameter_00_values;
         destination_usage: jmt$destination_usage;
         queue_file_password: jmt$queue_file_password;
         disposition_code: nft$parameter_17_definition;
         activate_protocol_trace: boolean;
     VAR file_position: jmt$output_file_position;
     VAR protocol_state_consistent: boolean;
     VAR transfer_status: ost$status;
     VAR status: ost$status);


    CONST
      b101_session_timeout = 0ffffffff(16);

    VAR
      attachment_options: ^fst$attachment_options,
      change_attributes: ^nat$change_attributes,
      command_buffer: ^SEQ ( * ),
      data_area: sender_input_data_area,
      get_attributes: ^nat$get_attributes,
      line_number: jmt$output_file_position,
      local_status: ost$status,
      saved_session_timeout: nat$wait_time,
      segment_pointer: amt$segment_pointer,
      send_condition_descriptor: ^pmt$established_handler,
      send_conditions: [STATIC, READ] pmt$condition := [pmc$condition_combination,
            [pmc$system_conditions, pmc$block_exit_processing, jmc$job_resource_condition,
            mmc$segment_access_condition, ifc$interactive_condition]],
      session_timeout_modified: boolean,
      transfer_file_attributes: ^fst$file_cycle_attributes;

?? NEWTITLE := '  process_abnormal_status', EJECT ??

{ PURPOSE:  This procedure handles an abnormal status, attempting to inform
{           the peer application of our troubles before dropping out.

    PROCEDURE process_abnormal_status
      (    bad_status: ost$status);

      VAR
        command_buffer: ^SEQ ( * ),
        data_area: sender_input_data_area,
        local_status: ost$status;

      process_send_system_error (bad_status, status);
      IF NOT status.normal THEN
        set_status (send_params, transfer_status, status);
        protocol_state_consistent := FALSE;
        RETURN; {----->
      IFEND;

      PUSH command_buffer: [[REP command_block_size OF cell]];
      data_area [1] := command_buffer;
      receive_connection_event (data_area, status);
      IF NOT status.normal THEN
        set_status (send_params, transfer_status, status);
        protocol_state_consistent := FALSE;
        RETURN; {----->
      IFEND;

      set_status (send_params, transfer_status, status);

    PROCEND process_abnormal_status;

?? OLDTITLE ??
?? NEWTITLE := '  send_condition_handler', EJECT ??

{ PURPOSE:  This is the condition handler for nfp$send_batch_file.

    PROCEDURE send_condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      VAR
        change_attributes: ^nat$change_attributes,
        ignore_status: ost$status;

      IF (condition.selector = pmc$block_exit_processing) AND ((pmc$program_abort IN condition.reason) OR
            (pmc$program_termination IN condition.reason)) THEN
        IF protocol_trace THEN
          pmp$log('**** NFM$RHF_SEND_FILE: Sender terminating. Closing connection.', ignore_status);
        IFEND;

{ Closing the network connection file before closing the output file will prevent NAM/VE from
{ attempting to send data from the closed output file. NAM/VE would attempt to send the data if
{ NFP$SEND_BATCH_FILE had called NAP$SE_SEND_DATA just prior to the event which caused execution
{ of this condition handler.

        fsp$close_file (send_params.connection_fid, ignore_status);
        amp$return (connection_file_name, ignore_status);
      IFEND;

      IF sender_file_id <> amv$nil_file_identifier THEN
        IF local_file_name = osc$null_name THEN
          jmp$close_output_file (sender_file_id, local_status);
        ELSE
          fsp$close_file (sender_file_id, local_status);
        IFEND;
        sender_file_id := amv$nil_file_identifier;
        #SPOIL (sender_file_id);
      IFEND;
      IF session_timeout_modified AND (condition.selector <> pmc$block_exit_processing) THEN
        PUSH change_attributes: [1 .. 1];
        change_attributes^ [1].kind := nac$data_transfer_timeout;
        change_attributes^ [1].data_transfer_timeout := saved_session_timeout;
        nap$store_attributes (send_params.connection_fid, change_attributes^, status);
        IF NOT local_status.normal THEN
          status := local_status;
        IFEND;
        session_timeout_modified := FALSE;
      IFEND;

      file_position := 0;

      IF condition.selector <> pmc$block_exit_processing THEN
        protocol_state_consistent := FALSE;
        pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        EXIT nfp$send_batch_file; {----->
      IFEND;
    PROCEND send_condition_handler;
?? OLDTITLE, EJECT ??
{   BEGIN nfp$send_batch_file

    status.normal := TRUE;
    local_status.normal := TRUE;
    sender_file_id := amv$nil_file_identifier;
    #SPOIL (sender_file_id);
    processing_error := FALSE;
    session_timeout_modified := FALSE;
    protocol_state_consistent := TRUE;
    position_valid := FALSE;
    queue_file := (local_file_name = osc$null_name);
    send_params.connection_fid := connection_fid;
    IF local_file_name = osc$null_name THEN
      send_params.file_name := file_name;
    ELSE
      send_params.file_name := local_file_name;
    IFEND;
    send_params.facilities := facilities;
    send_params.transfer_mode := transfer_mode;
    send_params.block_size := block_size;
    send_params.min_timeout := min_timeout;
    send_params.validation_ring := osc$sj_ring_3; {RING 6}
    send_params.protocol_version := protocol_version;
    send_params.status.normal := TRUE;
    current_send_state := start_pend;

    protocol_trace := activate_protocol_trace;

    PUSH send_condition_descriptor;
    pmp$establish_condition_handler (send_conditions, ^send_condition_handler, send_condition_descriptor,
          local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    IF local_file_name = osc$null_name THEN
      IF (disposition_code = nfc$p17_input_return) OR
         (disposition_code = nfc$p17_input_no_return) THEN
        jmp$open_input_file (file_name, amc$segment, destination_usage, queue_file_password,
              sender_file_id, local_status);
      ELSE
        jmp$open_output_file (file_name, amc$segment, destination_usage, queue_file_password,
              sender_file_id, local_status);
      IFEND;
    ELSE
      PUSH attachment_options: [1 .. 1];
      attachment_options^ [1].selector := fsc$access_and_share_modes;
      attachment_options^ [1].access_modes.selector := fsc$specific_access_modes;
      attachment_options^ [1].access_modes.value := $fst$file_access_options [fsc$read];
      attachment_options^ [1].share_modes.selector := fsc$determine_from_access_modes;
      fsp$open_file (local_file_name, amc$segment, attachment_options, NIL, NIL, NIL, NIL,
            sender_file_id, local_status);
    IFEND;
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    amp$get_segment_pointer (sender_file_id, amc$sequence_pointer, segment_pointer, local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    transfer_file_size := #SIZE (segment_pointer.sequence_pointer^);
    send_transfer_progress.remaining_data := transfer_file_size;
    send_transfer_progress.general_position := file_in_progress;
    header_buffer.application_block_number := 0;
    send_transfer_progress.file_byte_address := segment_pointer.sequence_pointer;
    RESET send_transfer_progress.file_byte_address;

    line_number := 0;

    PUSH get_attributes: [1 .. 1];
    get_attributes^ [1].kind := nac$data_transfer_timeout;
    nap$fetch_attributes (send_params.connection_fid, get_attributes^, local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;
    saved_session_timeout := get_attributes^ [1].data_transfer_timeout;
    PUSH change_attributes: [1 .. 1];
    change_attributes^ [1].kind := nac$data_transfer_timeout;
    change_attributes^ [1].data_transfer_timeout := b101_session_timeout;
    nap$store_attributes (send_params.connection_fid, change_attributes^, local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;
    session_timeout_modified := TRUE;

    PUSH command_buffer: [[REP batch_command_size OF cell]];
    data_area [1] := command_buffer;

{   Send protocol command SS - start sender data.

    send_batch_ss (file_position, line_number, status);
    IF NOT status.normal THEN
      set_status (send_params, transfer_status, status);
      protocol_state_consistent := FALSE;
      RETURN; {----->
    IFEND;

    receive_connection_event (data_area, status);
    IF NOT status.normal THEN
      set_status (send_params, transfer_status, status);
      protocol_state_consistent := FALSE;
      RETURN; {----->
    IFEND;

    set_status (send_params, transfer_status, status);

  PROCEND nfp$send_batch_file;

?? TITLE := '[XDCL] nfp$send_file', EJECT ??
*copyc nfh$send_file

  PROCEDURE [XDCL] nfp$send_file
    (    connection_fid: amt$file_identifier;
         file_name: amt$local_file_name;
         facilities: nft$facility_group;
         transfer_mode: nft$transfer_modes;
         block_size: nft$block_size;
         min_timeout: nft$timeout;
         protocol_version: nft$parameter_00_values;
         network_type: nft$network_type;
         validation_ring: ost$ring;
         activate_protocol_trace: boolean;
     VAR file_size: amt$file_length;
     VAR protocol_state_consistent: boolean;
     VAR transfer_status: ost$status;
     VAR status: ost$status);

    VAR
      command_buffer: ^SEQ ( * ),
      data_area: sender_input_data_area,
      get_attributes: ^nat$get_attributes,
      ignore_status: ost$status,
      local_status: ost$status,
      output_close_status: ost$status,
      output_fid: amt$file_identifier,
      rhfam_attributes: ^rft$change_attributes,
      save_rhfam_attrs: ^rft$get_attributes,
      send_condition_descriptor: ^pmt$established_handler,
      send_conditions: [STATIC, READ] pmt$condition := [pmc$condition_combination,
            [pmc$system_conditions, pmc$block_exit_processing, jmc$job_resource_condition,
            mmc$segment_access_condition, ifc$interactive_condition]],
      transfer_file_attributes: ^fst$file_cycle_attributes,
      unique_name: ost$name;
?? NEWTITLE := '  process_abnormal_status', EJECT ??

{ PURPOSE:  This procedure handles an abnormal status, attempting to inform
{           the peer application of our troubles before dropping out.

    PROCEDURE process_abnormal_status
      (    bad_status: ost$status);

      VAR
        command_buffer: ^SEQ ( * ),
        data_area: sender_input_data_area,
        local_status: ost$status;

      process_send_system_error (bad_status, status);
      IF NOT status.normal THEN
        set_status (send_params, transfer_status, status);
        protocol_state_consistent := FALSE;
        RETURN; {----->
      IFEND;

      PUSH command_buffer: [[REP command_block_size OF cell]];
      data_area [1] := command_buffer;
      receive_connection_event (data_area, status);
      IF NOT status.normal THEN
        set_status (send_params, transfer_status, status);
        protocol_state_consistent := FALSE;
        RETURN; {----->
      IFEND;

      set_status (send_params, transfer_status, status);

    PROCEND process_abnormal_status;

?? OLDTITLE ??
?? NEWTITLE := '  send_condition_handler', EJECT ??

{ PURPOSE:  This is the condition handler for nfp$send_file.

    PROCEDURE send_condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      VAR
        command_buffer: ^SEQ ( * ),
        data_area: sender_input_data_area,
        ignore_status: ost$status,
        local_status: ost$status,
        os_type: ost$170_os_type;

      IF (condition.selector = ifc$interactive_condition) THEN
        IF ((condition.interactive_condition = ifc$pause_break) OR
              (condition.interactive_condition = ifc$job_reconnect)) THEN

          pmp$get_170_os_type(os_type, local_status);
          IF (NOT local_status.normal) OR (os_type = osc$ot7_dual_state_nos_be) THEN

{ NOS/BE allows only one asynch interrupt which is mapped to a NOS/VE pause break. Respond to the pause
{ break as if it were a terminate break.

            osp$set_status_condition (ife$terminate_break_received, local_status);
            process_send_system_error(local_status, ignore_status);
          ELSE

{ Generate message indicating pause break is ignored.

            osp$set_status_abnormal (nfc$status_id, nfe$user_interrupt_ignored, '', local_status);
            nfp$ptf_format_message_to_out (local_status);
          IFEND;
          RETURN;

        ELSEIF (condition.interactive_condition = ifc$terminate_break) THEN
          osp$set_status_condition (ife$terminate_break_received, local_status);
          process_send_system_error(local_status, ignore_status);
          RETURN;
        IFEND;
      IFEND;

      IF sender_file_id <> amv$nil_file_identifier THEN
        fsp$close_file (sender_file_id, local_status);
      IFEND;
      IF return_file THEN
        amp$return (transfer_file, local_status);
      IFEND;
      IF condition.selector <> pmc$block_exit_processing THEN
        protocol_state_consistent := FALSE;
        pmp$continue_to_cause (pmc$execute_standard_procedure, status);
      ELSE
        IF (NOT processing_error) AND (current_send_state <> end_ok_sent) AND
             (current_send_state <> end_err_sent) AND (current_send_state <> exit_send) THEN
          PUSH command_buffer: [[REP command_block_size OF cell]];
          data_area [1] := command_buffer;
          ignore_status.normal := TRUE;
          process_send_system_error (ignore_status, ignore_status);
          receive_connection_event (data_area, ignore_status);
          pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        IFEND;
      IFEND;
    PROCEND send_condition_handler;
?? OLDTITLE, EJECT ??
{   BEGIN nfp$send_file

    status.normal := TRUE;
    local_status.normal := TRUE;
    output_close_status.normal := TRUE;
    processing_error := FALSE;
    protocol_state_consistent := TRUE;
    queue_file := FALSE;
    sender_file_id := amv$nil_file_identifier;
    #SPOIL (sender_file_id);
    return_file := FALSE;
    transfer_file_size := 0;
    #SPOIL (return_file);

    protocol_trace := activate_protocol_trace;
    IF protocol_trace THEN
      CASE network_type OF
      = nfc$network_lcn =
        pmp$log ('**** NFM$RHF_SEND_FILE: Network type is LCN.', local_status);
      = nfc$network_nam =
        pmp$log ('**** NFM$RHF_SEND_FILE: Network type is NAM.', local_status);
      = nfc$unknown_network =
        pmp$log ('**** NFM$RHF_SEND_FILE: Network type is UNKNOWN.', local_status);
      ELSE
      CASEND;

      CASE transfer_mode OF
      = nfc$ve_to_ve_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is VE to VE.', local_status);
      = nfc$coded_data_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is CODED.', local_status);
      = nfc$transparent_data_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is TRANSPARENT.', local_status);
      = nfc$rhf_structured_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is RHF STRUCTURED.', local_status);
      ELSE
      CASEND;
      local_status.normal := TRUE;
    IFEND;

    CASE network_type OF
    = nfc$network_lcn =
      access_method := nfc$am_rhfam;
      IF  (protocol_version = nfc$p00_a101) OR (protocol_version = nfc$p00_a102)  THEN
        PUSH save_rhfam_attrs: [1 .. 3];
        save_rhfam_attrs^ [1].key := rfc$record_block_size;
        save_rhfam_attrs^ [2].key := rfc$outgoing_record_abn;
        save_rhfam_attrs^ [3].key := rfc$data_transfer_timeout;
        rfp$fetch (connection_fid, save_rhfam_attrs^, status);
        IF  NOT status.normal  THEN
          RETURN; {----->
        IFEND;

        IF  block_size > rfc$max_block_size  THEN
          send_params.block_size := rfc$max_block_size;
        ELSE
          send_params.block_size := block_size;
        IFEND;

        PUSH rhfam_attributes: [1 .. 3];
        rhfam_attributes^ [1].key := rfc$record_block_size;
        rhfam_attributes^ [1].record_block_size := send_params.block_size;
        rhfam_attributes^ [2].key := rfc$outgoing_record_abn;
        rhfam_attributes^ [2].outgoing_record_abn := 0;
        rhfam_attributes^ [3].key := rfc$data_transfer_timeout;
        rhfam_attributes^ [3].data_transfer_timeout := min_timeout * 1000;

        rfp$store (connection_fid, rhfam_attributes^, status);
        IF  NOT status.normal  THEN
          RETURN; {----->
        IFEND;
      ELSE
        osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error, '', status);
        RETURN; {----->
      IFEND;
    = nfc$network_nam =
      access_method := nfc$am_nam;
      send_params.block_size := block_size;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'nfp$send_file network case',
            status);
      RETURN; {----->
    CASEND;

    send_params.connection_fid := connection_fid;
    send_params.file_name := file_name;
    send_params.facilities := facilities;
    send_params.transfer_mode := transfer_mode;
    send_params.min_timeout := min_timeout;
    send_params.validation_ring := validation_ring;
    send_params.protocol_version := protocol_version;
    send_params.status.normal := TRUE;
    send_transfer_progress.general_position := not_started;
    current_send_state := start_pend;

    PUSH send_condition_descriptor;
    pmp$establish_condition_handler (send_conditions, ^send_condition_handler, send_condition_descriptor,
          local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

{   Send protocol command SS - Start sender data.

    send_ss (status);
    IF NOT status.normal THEN
      set_status (send_params, transfer_status, status);
      protocol_state_consistent := FALSE;
      RETURN; {----->
    IFEND;

    PUSH command_buffer: [[REP command_block_size OF cell]];
    data_area [1] := command_buffer;

    pmp$get_unique_name (unique_name, local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    IF send_params.transfer_mode = nfc$coded_data_mode THEN
      PUSH transfer_file_attributes: [1 .. 3];
      transfer_file_attributes^ [1].selector := fsc$record_type;
      transfer_file_attributes^ [1].record_type := amc$trailing_char_delimited;
      transfer_file_attributes^ [2].selector := fsc$ring_attributes;
      transfer_file_attributes^ [2].ring_attributes.r1 := send_params.validation_ring;
      transfer_file_attributes^ [2].ring_attributes.r2 := send_params.validation_ring;
      transfer_file_attributes^ [2].ring_attributes.r3 := send_params.validation_ring;
      transfer_file_attributes^ [3].selector := fsc$record_delimiting_character;
      transfer_file_attributes^ [3].record_delimiting_character := $CHAR (1f(16)); { US character }
    ELSE
      transfer_file_attributes := NIL;
    IFEND;

    fsp$open_and_get_type_of_copy (send_params.file_name, unique_name, ^fsv$copf_input_file_attachment,
          ^fsv$copf_output_file_attachment, NIL, NIL, transfer_file_attributes, sender_file_id, output_fid,
          control_info, local_status);
    IF NOT local_status.normal THEN
      IF output_fid <> amv$nil_file_identifier THEN
        fsp$close_file (output_fid, output_close_status);
      IFEND;
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    IF output_fid <> amv$nil_file_identifier THEN
      fsp$close_file (output_fid, output_close_status);
      IF NOT output_close_status.normal THEN
        process_abnormal_status (output_close_status);
        RETURN; {----->
      IFEND;
    IFEND;

    amp$return (unique_name, local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    receive_connection_event (data_area, status);
    IF NOT status.normal THEN
      set_status (send_params, transfer_status, status);
      protocol_state_consistent := FALSE;
      RETURN; {----->
    IFEND;

    set_status (send_params, transfer_status, status);

    file_size := transfer_file_size;

{   Clean up LCN particulars.

    IF network_type = nfc$network_lcn THEN
      rhfam_attributes^ [1].record_block_size := save_rhfam_attrs^ [1].record_block_size;
      rhfam_attributes^ [2].outgoing_record_abn := save_rhfam_attrs^ [2].outgoing_record_abn;
      rhfam_attributes^ [3].data_transfer_timeout := save_rhfam_attrs^ [3].data_transfer_timeout;
      rfp$store (connection_fid, rhfam_attributes^, ignore_status);
    IFEND;

  PROCEND nfp$send_file;
?? TITLE := '[XDCL] nfp$send_queue_file', EJECT ??
*copyc nfh$send_queue_file

  PROCEDURE [XDCL] nfp$send_queue_file
    (    connection_fid: amt$file_identifier;
         queue_file_fid: amt$file_identifier;
         file_name: jmt$system_supplied_name;
         facilities: nft$facility_group;
         transfer_mode: nft$transfer_modes;
         block_size: nft$block_size;
         min_timeout: nft$timeout;
         protocol_version: nft$parameter_00_values;
         network_type: nft$network_type;
         activate_protocol_trace: boolean;
     VAR protocol_state_consistent: boolean;
     VAR transfer_status: ost$status;
     VAR status: ost$status);

    VAR
      command_buffer: ^SEQ ( * ),
      data_area: sender_input_data_area,
      ignore_status: ost$status,
      local_status: ost$status,
      rhfam_attributes: ^rft$change_attributes,
      save_rhfam_attrs: ^rft$get_attributes,
      send_conditions: [STATIC, READ] pmt$condition := [pmc$condition_combination,
            [pmc$system_conditions, pmc$block_exit_processing, jmc$job_resource_condition,
            mmc$segment_access_condition, ifc$interactive_condition]],
      send_condition_descriptor: ^pmt$established_handler;

?? NEWTITLE := '  process_abnormal_status', EJECT ??

{ PURPOSE:  This procedure handles an abnormal status, attempting to inform
{           the peer application of our troubles before dropping out.

    PROCEDURE process_abnormal_status
      (    bad_status: ost$status);

      VAR
        command_buffer: ^SEQ ( * ),
        data_area: sender_input_data_area,
        local_status: ost$status;

      process_send_system_error (bad_status, status);
      IF NOT status.normal THEN
        set_status (send_params, transfer_status, status);
        protocol_state_consistent := FALSE;
        RETURN; {----->
      IFEND;

      PUSH command_buffer: [[REP command_block_size OF cell]];
      data_area [1] := command_buffer;
      receive_connection_event (data_area, status);
      IF NOT status.normal THEN
        set_status (send_params, transfer_status, status);
        protocol_state_consistent := FALSE;
        RETURN; {----->
      IFEND;

      set_status (send_params, transfer_status, status);

    PROCEND process_abnormal_status;

?? OLDTITLE ??
?? NEWTITLE := '  send_condition_handler', EJECT ??

{ PURPOSE:  This is the condition handler for nfp$send_queue_file.

    PROCEDURE send_condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      IF sender_file_id <> amv$nil_file_identifier THEN
        fsp$close_file (sender_file_id, local_status);
      IFEND;

      IF return_file THEN
        amp$return (transfer_file, local_status);
      IFEND;

      IF condition.selector <> pmc$block_exit_processing THEN
        protocol_state_consistent := FALSE;
        pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        EXIT nfp$send_queue_file; {----->
      IFEND;

    PROCEND send_condition_handler;
?? OLDTITLE, EJECT ??
{   BEGIN nfp$send_queue_file

    status.normal := TRUE;
    local_status.normal := TRUE;

    processing_error := FALSE;
    protocol_state_consistent := TRUE;
    queue_file := TRUE;
    return_file := FALSE;
    #SPOIL (return_file);

{ Initilize variables which are global to this module using the values provided by our caller.

    sender_file_id := queue_file_fid;
    #SPOIL (sender_file_id);
    protocol_trace := activate_protocol_trace;
    IF protocol_trace THEN
      CASE network_type OF
      = nfc$network_lcn =
        pmp$log ('**** NFM$RHF_SEND_FILE: Network type is LCN.', local_status);
      = nfc$network_nam =
        pmp$log ('**** NFM$RHF_SEND_FILE: Network type is NAM.', local_status);
      = nfc$unknown_network =
        pmp$log ('**** NFM$RHF_SEND_FILE: Network type is UNKNOWN.', local_status);
      CASEND;

      CASE transfer_mode OF
      = nfc$ve_to_ve_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is VE to VE.', local_status);
      = nfc$coded_data_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is CODED.', local_status);
      = nfc$transparent_data_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is TRANSPARENT.', local_status);
      = nfc$rhf_structured_mode =
        pmp$log ('**** NFM$RHF_SEND_FILE: Transfer mode is RHF STRUCTURED.', local_status);
      CASEND;
      local_status.normal := TRUE;
    IFEND;

    CASE network_type OF
    = nfc$network_lcn =
      access_method := nfc$am_rhfam;
      IF  (protocol_version = nfc$p00_a101) OR (protocol_version = nfc$p00_a102)  THEN
        PUSH save_rhfam_attrs: [1 .. 4];
        save_rhfam_attrs^ [1].key := rfc$record_block_size;
        save_rhfam_attrs^ [2].key := rfc$outgoing_record_abn;
        save_rhfam_attrs^ [3].key := rfc$data_transfer_timeout;
        save_rhfam_attrs^ [4].key := rfc$send_record_terminator;
        rfp$fetch (connection_fid, save_rhfam_attrs^, status);
        IF  NOT status.normal  THEN
          RETURN; {----->
        IFEND;

        IF  block_size > rfc$max_block_size  THEN
          send_params.block_size := rfc$max_block_size;
        ELSE
          send_params.block_size := block_size;
        IFEND;

        PUSH rhfam_attributes: [1 .. 4];
        rhfam_attributes^ [1].key := rfc$record_block_size;
        rhfam_attributes^ [1].record_block_size := send_params.block_size;
        rhfam_attributes^ [2].key := rfc$outgoing_record_abn;
        rhfam_attributes^ [2].outgoing_record_abn := 0;
        rhfam_attributes^ [3].key := rfc$data_transfer_timeout;
        rhfam_attributes^ [3].data_transfer_timeout := min_timeout * 1000;
        rhfam_attributes^ [4].key := rfc$send_record_terminator;
        rhfam_attributes^ [4].send_record_terminator := rfc$rm_eoi;

        rfp$store (connection_fid, rhfam_attributes^, status);
        IF  NOT status.normal  THEN
          RETURN; {----->
        IFEND;
      ELSE
        osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error, '', status);
        RETURN; {----->
      IFEND;
    = nfc$network_nam =
      access_method := nfc$am_nam;
      send_params.block_size := block_size;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'nfp$send_queue_file network case',
            status);
      RETURN; {----->
    CASEND;

    send_params.connection_fid := connection_fid;
    send_params.file_name := file_name;
    send_params.facilities := facilities;
    send_params.transfer_mode := transfer_mode;
    send_params.min_timeout := min_timeout;
    send_params.validation_ring := osc$tsrv_ring;
    send_params.protocol_version := protocol_version;
    send_params.status.normal := TRUE;

    current_send_state := start_pend;

{   Send protocol command SS - Start sender data.

    send_ss (status);
    IF NOT status.normal THEN
      set_status (send_params, transfer_status, status);
      protocol_state_consistent := FALSE;
      RETURN; {----->
    IFEND;

    PUSH send_condition_descriptor;
    pmp$establish_condition_handler (send_conditions, ^send_condition_handler, send_condition_descriptor,
          local_status);
    IF NOT local_status.normal THEN
      process_abnormal_status (local_status);
      RETURN; {----->
    IFEND;

    PUSH command_buffer: [[REP command_block_size OF cell]];
    data_area [1] := command_buffer;

    receive_connection_event (data_area, status);
    IF NOT status.normal THEN
      set_status (send_params, transfer_status, status);
      protocol_state_consistent := FALSE;
      RETURN; {----->
    IFEND;

{   Clean up LCN particulars.

    IF network_type = nfc$network_lcn THEN
      rhfam_attributes^ [1].record_block_size := save_rhfam_attrs^ [1].record_block_size;
      rhfam_attributes^ [2].outgoing_record_abn := save_rhfam_attrs^ [2].outgoing_record_abn;
      rhfam_attributes^ [3].data_transfer_timeout := save_rhfam_attrs^ [3].data_transfer_timeout;
      rhfam_attributes^ [4].send_record_terminator := save_rhfam_attrs^ [4].send_record_terminator;
      rfp$store (connection_fid, rhfam_attributes^, ignore_status);
    IFEND;

    set_status (send_params, transfer_status, status);

  PROCEND nfp$send_queue_file;
?? TITLE := '[INLINE] advance_one_line', EJECT ??

{ PURPOSE:  This inline procedure advances to the next line in an output file.

  PROCEDURE [INLINE] advance_one_line
    (VAR line_length: jmt$output_file_position;
     VAR end_of_file: boolean;
     VAR status: ost$status);

    VAR
      char_index: jmt$output_file_position,
      found: boolean,
      interim_line_length: jmt$output_file_position,
      line_string: ^string ( * <= 256),
      search_length: 1 .. 256,
      search_string: ^string ( * <= 256);

    status.normal := TRUE;
    found := FALSE;
    line_length := 0;
    end_of_file := FALSE;

  /find_end_of_line/
    WHILE NOT found DO
      IF send_transfer_progress.remaining_data >= 256 THEN
        search_length := 256;
      ELSE
        search_length := send_transfer_progress.remaining_data;
      IFEND;
      NEXT search_string: [search_length] IN send_transfer_progress.file_byte_address;
      #SCAN (search_character_designator, search_string^, char_index, found);
      IF found THEN
        RESET send_transfer_progress.file_byte_address TO search_string;
        NEXT line_string: [char_index] IN send_transfer_progress.file_byte_address;
        interim_line_length := char_index;
      ELSE
        interim_line_length := search_length;
      IFEND;
      line_length := line_length + interim_line_length;
      send_transfer_progress.remaining_data := send_transfer_progress.remaining_data - interim_line_length;
      end_of_file := (send_transfer_progress.remaining_data <= 0);
      IF end_of_file THEN
        EXIT /find_end_of_line/; {----->
      IFEND;
    WHILEND /find_end_of_line/;
  PROCEND advance_one_line;
?? TITLE := '[INLINE] find_last_line', EJECT ??

{ PURPOSE:  This inline procedure finds the previous line in an output file.

  PROCEDURE [INLINE] find_last_line
    (    backward_locator: ^positioning_grid;
     VAR index: jmt$output_file_position;
     VAR byte_count: jmt$output_file_position;
     VAR beginning_of_file: boolean;
     VAR status: ost$status);

    status.normal := TRUE;
    index := index - 1;
    byte_count := byte_count - 1;
    beginning_of_file := byte_count = 0;
    send_transfer_progress.remaining_data := send_transfer_progress.remaining_data + 1;

  /search_for_end_of_line/
    WHILE NOT beginning_of_file DO
      IF backward_locator^ [index] = $CHAR (31) THEN
        EXIT /search_for_end_of_line/; {----->
      IFEND;
      index := index - 1;
      byte_count := byte_count - 1;
      beginning_of_file := byte_count = 0;
      send_transfer_progress.remaining_data := send_transfer_progress.remaining_data + 1;
    WHILEND /search_for_end_of_line/;
  PROCEND find_last_line;
?? TITLE := 'move_back_pages', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards by pages.

  PROCEDURE move_back_pages
    (    page_count: jmt$output_file_position;
     VAR line_number: jmt$output_file_position;
     VAR byte_position: jmt$output_file_position;
     VAR beginning_of_file: boolean;
     VAR status: ost$status);

    VAR
      backward_locator: ^positioning_grid,
      byte_count: jmt$output_file_position,
      i: jmt$output_file_position,
      index: jmt$output_file_position;

    status.normal := TRUE;
    byte_count := byte_position - 1;
    IF byte_count = 0 THEN
      RETURN; {----->
    IFEND;
    RESET send_transfer_progress.file_byte_address;
    NEXT backward_locator: [1 .. byte_count] IN send_transfer_progress.file_byte_address;
    beginning_of_file := FALSE;
    index := byte_count;
    FOR i := 1 TO page_count DO

    /find_page_boundary/
      WHILE NOT beginning_of_file DO
        find_last_line (backward_locator, index, byte_count, beginning_of_file, status);
        line_number := line_number - 1;
        IF backward_locator^ [index + 1] = '1' THEN
          EXIT /find_page_boundary/; {----->
        IFEND;
      WHILEND /find_page_boundary/;
    FOREND;
    RESET send_transfer_progress.file_byte_address;
    IF NOT beginning_of_file THEN
      NEXT backward_locator: [1 .. byte_count] IN send_transfer_progress.file_byte_address;
      send_transfer_progress.remaining_data := transfer_file_size - byte_count;
    IFEND;
    byte_position := byte_count + 1;

  PROCEND move_back_pages;
?? TITLE := 'output_debug_message', EJECT ??

{ PURPOSE:  This procedure displays a debug message in the job log.

  PROCEDURE output_debug_message
    (    message_description: string ( * ),
         stat: ost$status);

    CONST
      line_length = 60;

    VAR
      i: 1 .. osc$max_status_message_lines,
      ignore_status: ost$status,
      message: ost$status_message,
      message_pointer: ^ost$status_message,
      msg_line_count: ^ost$status_message_line_count,
      msg_line_size: ^ost$status_message_line_size,
      msg_line_text: ^string ( * );

    osp$format_message (stat, osc$full_message_level, line_length, message, ignore_status);
    message_pointer := ^message;
    RESET message_pointer;
    NEXT msg_line_count IN message_pointer;
    pmp$log (message_description, ignore_status);
    FOR i := 1 TO msg_line_count^ DO
      NEXT msg_line_size IN message_pointer;
      NEXT msg_line_text: [msg_line_size^] IN message_pointer;
      pmp$log (msg_line_text^, ignore_status);
    FOREND;
  PROCEND output_debug_message;
?? TITLE := 'process_pr_command', EJECT ??

{ PURPOSE:  This procedure processes the PR protocol command.

  PROCEDURE process_pr_command
    (VAR command_buffer: ^SEQ ( * );
     VAR status: ost$status);

    CONST
      boi_message = 'File is positioned at beginning.',
      current_file_position = '57',
      eoi_message = 'File is positioned at end.      ',
      not_found_message = 'String was not found.            ',
      reposition_file_parameters = '56',
      user_message_size = 35;

    VAR
      attribute_id: sender_positioning_attributes,
      attribute_number_string: ^string (2),
      attribute_size: clt$integer,
      attribute_size_string: ^string (3),
      beginning_of_file: boolean,
      command_id_string: ^string (2),
      convert_positioning_param: [STATIC, READ] array [sender_positioning_attributes] of string (2) :=
            [reposition_file_parameters, current_file_position],
      current_di_byte: jmt$output_file_position,
      current_tip_line: jmt$output_file_position,
      direction: reposition_direction,
      displacement: reposition_displacement,
      end_of_file: boolean,
      first_string: ^reposition_string,
      i: 1 .. 3,
      index: 1 .. 2,
      local_status: ost$status,
      new_byte_position: jmt$output_file_position,
      new_line_number: jmt$output_file_position,
      no_find: boolean,
      parameter_count: clt$integer,
      parameter_count_string: ^string (2),
      parameter_string: ^string ( * ),
      preview_bytes: jmt$output_file_position,
      preview_count: integer,
      preview_lines: reposition_preview_lines,
      preview_message: reposition_preview_message,
      qualifier_character: ^char,
      required_attribute_present: boolean,
      second_string: ^reposition_string,
      start_position: reposition_start_position,
      string_found: boolean,
      units: reposition_units,
      user_message: ^string ( * );

?? NEWTITLE := '  position_file', EJECT ??

{ PURPOSE:  This procedure is the main output file positioning routine.

    PROCEDURE position_file
      (    current_line_number: jmt$output_file_position;
           current_byte_count: jmt$output_file_position;
           displacement: reposition_displacement;
           first_string: ^reposition_string;
           second_string: ^reposition_string;
           units: reposition_units;
           direction: reposition_direction;
           start_position: reposition_start_position;
           preview_lines: reposition_preview_lines;
       VAR new_line_number: jmt$output_file_position;
       VAR new_byte_position: jmt$output_file_position;
       VAR preview_bytes: jmt$output_file_position;
       VAR string_found: boolean;
       VAR beginning_of_file: boolean;
       VAR end_of_file: boolean;
       VAR status: ost$status);

      CONST
        new_page_effector = '1';

      VAR
        bytes: jmt$output_file_position,
        current_candidate_string: ^SEQ ( * ),
        current_position: ^cell,
        current_remaining_data: jmt$output_file_position,
        i: 1 .. 10,
        target_line_number: jmt$output_file_position,
        type_of_repositioning: repositioning_type;

?? NEWTITLE := '    initialize_for_scan', EJECT ??

{ PURPOSE:  This procedure sets things up for file positioning.

      PROCEDURE initialize_for_scan
        (    current_line: integer;
             displacement: reposition_displacement;
             first_string: ^reposition_string;
             second_string: ^reposition_string;
             units: reposition_units;
             direction: reposition_direction;
             start_position: reposition_start_position;
         VAR type_of_positioning: repositioning_type;
         VAR target_line_number: jmt$output_file_position;
         VAR beginning_of_file: boolean;
         VAR end_of_file: boolean;
         VAR status: ost$status);

        status.normal := TRUE;
        target_line_number := 0;
        RESET send_transfer_progress.file_byte_address;
        send_transfer_progress.remaining_data := transfer_file_size;
        CASE direction OF
        = forward =
          CASE start_position OF
          = bottom =
            position_to_bottom (target_line_number, status);
            IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
              RETURN; {----->
            IFEND;
            end_of_file := TRUE;
            type_of_positioning := no_repositioning;
          = top =
            IF first_string <> NIL THEN
              target_line_number := 1;
              IF second_string = NIL THEN
                IF units = lines THEN
                  type_of_positioning := forward_string_search_to_line;
                ELSE
                  type_of_positioning := forward_string_search_to_page;
                IFEND;
              ELSE
                IF units = lines THEN
                  type_of_positioning := forward_ellipsis_search_to_line;
                ELSE
                  type_of_positioning := forward_ellipsis_search_to_page;
                IFEND;
              IFEND;
            ELSEIF displacement = 0 THEN
              type_of_positioning := no_repositioning;
              target_line_number := 1;
              beginning_of_file := TRUE;
            ELSEIF units = lines THEN
              type_of_positioning := forward_line_displacement;
              target_line_number := displacement + 1;
            ELSEIF units = pages THEN
              type_of_positioning := forward_page_absolute;
            IFEND;
          = last_line_printed =
            IF first_string <> NIL THEN
              target_line_number := current_line_number;
              IF second_string = NIL THEN
                IF units = lines THEN
                  type_of_positioning := forward_string_search_to_line;
                ELSE
                  type_of_positioning := forward_string_search_to_page;
                IFEND;
              ELSE
                IF units = lines THEN
                  type_of_positioning := forward_ellipsis_search_to_line;
                ELSE
                  type_of_positioning := forward_ellipsis_search_to_page;
                IFEND;
              IFEND;
            ELSEIF units = lines THEN
              IF NOT position_valid THEN
                type_of_positioning := forward_line_displacement;
              ELSE
                type_of_positioning := line_adjustment_forward;
              IFEND;
              target_line_number := current_line_number + displacement;
            ELSE
              IF displacement = 0 THEN
                IF NOT position_valid THEN
                  type_of_positioning := backward_page_relative;
                ELSE
                  type_of_positioning := page_adjustment_backward;
                IFEND;
              ELSE
                IF NOT position_valid THEN
                  type_of_positioning := forward_page_relative;
                ELSE
                  type_of_positioning := page_adjustment_forward;
                IFEND;
              IFEND;
            IFEND;
          CASEND;
        = backward =
          CASE start_position OF
          = top =
            type_of_positioning := no_repositioning;
            target_line_number := 1;
            beginning_of_file := TRUE;
          = bottom =
            IF first_string <> NIL THEN
              target_line_number := 0;
              IF second_string = NIL THEN
                IF units = lines THEN
                  type_of_positioning := back_string_search_to_line;
                ELSE
                  type_of_positioning := back_string_search_to_page;
                IFEND;
              ELSE
                IF units = lines THEN
                  type_of_positioning := back_ellipsis_search_to_line;
                ELSE
                  type_of_positioning := back_ellipsis_search_to_page;
                IFEND;
              IFEND;
            ELSEIF displacement = 0 THEN
              position_to_bottom (target_line_number, status);
              IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
                RETURN; {----->
              IFEND;
              end_of_file := TRUE;
              type_of_positioning := no_repositioning;
            ELSEIF units = lines THEN
              type_of_positioning := backward_line_displacement;
            ELSE
              type_of_positioning := backward_page_absolute;
            IFEND;
          = last_line_printed =
            IF first_string <> NIL THEN
              target_line_number := current_line_number;
              IF second_string = NIL THEN
                IF units = lines THEN
                  type_of_positioning := back_string_search_to_line;
                ELSE
                  type_of_positioning := back_string_search_to_page;
                IFEND;
              ELSE
                IF units = lines THEN
                  type_of_positioning := back_ellipsis_search_to_line;
                ELSE
                  type_of_positioning := back_ellipsis_search_to_page;
                IFEND;
              IFEND;
            ELSEIF units = lines THEN
              IF NOT position_valid THEN
                type_of_positioning := forward_line_displacement;
              ELSE
                type_of_positioning := line_adjustment_backward;
              IFEND;
              IF current_line > displacement THEN
                target_line_number := current_line - displacement;
              ELSE
                type_of_positioning := no_repositioning;
                target_line_number := 1;
                beginning_of_file := TRUE;
              IFEND;
            ELSE
              IF NOT position_valid THEN
                type_of_positioning := backward_page_relative;
              ELSE
                type_of_positioning := page_adjustment_backward;
              IFEND;
            IFEND;
          CASEND;
        CASEND;

      PROCEND initialize_for_scan;
?? OLDTITLE ??
?? NEWTITLE := '    move_back_lines', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards by lines.

      PROCEDURE move_back_lines
        (    displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR beginning_of_file: boolean;
         VAR status: ost$status);

        VAR
          backward_locator: ^positioning_grid,
          byte_count: jmt$output_file_position,
          current_line_index: jmt$output_file_position,
          locator_index: jmt$output_file_position;

        status.normal := TRUE;
        byte_count := new_byte_position - 1;
        IF byte_count = 0 THEN
          RETURN; {----->
        IFEND;
        RESET send_transfer_progress.file_byte_address;
        NEXT backward_locator: [1 .. byte_count] IN send_transfer_progress.file_byte_address;
        locator_index := byte_count;
        FOR current_line_index := 1 TO displacement DO
          find_last_line (backward_locator, locator_index, byte_count, beginning_of_file, status);
          new_line_number := new_line_number - 1;
        FOREND;
        RESET send_transfer_progress.file_byte_address;
        IF NOT beginning_of_file THEN
          NEXT backward_locator: [1 .. byte_count] IN send_transfer_progress.file_byte_address;
          send_transfer_progress.remaining_data := transfer_file_size - byte_count;
        IFEND;
        new_byte_position := byte_count + 1;

      PROCEND move_back_lines;
?? OLDTITLE ??
?? NEWTITLE := '    move_forward_lines', EJECT ??

{ PURPOSE:  This procedure positions an output file forward by lines.

      PROCEDURE move_forward_lines
        (    displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR end_of_file: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          current_line_index: jmt$output_file_position,
          position_marker: ^string ( * );

        status.normal := TRUE;
        IF NOT (new_line_number = 1) THEN
          NEXT position_marker: [new_byte_position - 1] IN send_transfer_progress.file_byte_address;
          send_transfer_progress.remaining_data := send_transfer_progress.remaining_data - new_byte_position -
                1;
        IFEND;
        FOR current_line_index := 1 TO displacement DO
          advance_one_line (byte_count, end_of_file, status);
          new_line_number := new_line_number + 1;
          new_byte_position := new_byte_position + byte_count;
          IF end_of_file THEN
            RETURN; {----->
          IFEND;
        FOREND;
      PROCEND move_forward_lines;
?? OLDTITLE ??
?? NEWTITLE := '    move_forward_pages', EJECT ??

{ PURPOSE:  This procedure positions an output file forward by pages.

      PROCEDURE move_forward_pages
        (    displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR end_of_file: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          current_page_index: jmt$output_file_position,
          first_char: ^char;

        status.normal := TRUE;

        FOR current_page_index := 1 TO displacement DO

        /find_next_page/
          WHILE TRUE DO
            IF end_of_file THEN
              RETURN; {----->
            IFEND;
            advance_one_line (byte_count, end_of_file, status);
            IF end_of_file THEN
              RETURN; {----->
            IFEND;
            new_line_number := new_line_number + 1;
            new_byte_position := new_byte_position + byte_count;
            NEXT first_char IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO first_char;
            IF first_char^ = new_page_effector THEN
              EXIT /find_next_page/; {----->
            IFEND;
          WHILEND /find_next_page/;
        FOREND;
      PROCEND move_forward_pages;
?? OLDTITLE ??
?? NEWTITLE := '    page_backward_from_line', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards a page from the
{           current line.

      PROCEDURE page_backward_from_line
        (    current_line_number: jmt$output_file_position;
             displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR beginning_of_file: boolean;
         VAR status: ost$status);

        TYPE
          page_record = record
            address: ^cell,
            byte_position: jmt$output_file_position,
            line_number: jmt$output_file_position,
          recend;

        VAR
          bytes: jmt$output_file_position,
          current_page_index: 0 .. 65535,
          current_page_record: ^page_record,
          end_of_file: boolean,
          first_char: ^char,
          page_bytes: jmt$output_file_position,
          page_trace: ^array [0 .. * ] of page_record,
          temp_line_number: jmt$output_file_position;

        status.normal := TRUE;
        page_bytes := 0;
        PUSH current_page_record;
        current_page_record^.byte_position := 1;
        PUSH page_trace: [0 .. displacement];
        NEXT page_trace^ [0].address IN send_transfer_progress.file_byte_address;
        RESET send_transfer_progress.file_byte_address TO page_trace^ [0].address;
        FOR current_page_index := 0 TO displacement DO
          page_trace^ [current_page_index].address := NIL;
          page_trace^ [current_page_index].byte_position := 0;
          page_trace^ [current_page_index].line_number := current_page_index;
        FOREND;
        page_trace^ [0].byte_position := 1;
        page_trace^ [0].line_number := 1;
        current_page_index := 0;
        end_of_file := FALSE;
        FOR temp_line_number := 1 TO current_line_number DO
          NEXT first_char IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO first_char;
          IF first_char^ = new_page_effector THEN
            current_page_index := current_page_index + 1;
            IF current_page_index = displacement + 1 THEN
              current_page_index := 0;
            IFEND;
            NEXT current_page_record^.address IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_page_record^.address;
            current_page_record^.byte_position := current_page_record^.byte_position + page_bytes;
            current_page_record^.line_number := temp_line_number;
            page_trace^ [current_page_index] := current_page_record^;
            page_bytes := 0;
          IFEND;
          advance_one_line (bytes, end_of_file, status);
          IF end_of_file THEN
            RETURN; {----->
          IFEND;
          page_bytes := page_bytes + bytes;
        FOREND;
        IF page_trace^ [(current_page_index + 1) MOD (displacement + 1)].address <> NIL THEN
          new_line_number := page_trace^ [(current_page_index + 1) MOD (displacement + 1)].line_number;
          new_byte_position := page_trace^ [(current_page_index + 1) MOD (displacement + 1)].byte_position;
          RESET send_transfer_progress.file_byte_address TO page_trace^
                [(current_page_index + 1) MOD (displacement + 1)].address;
          send_transfer_progress.remaining_data := transfer_file_size - new_byte_position + 1;
        ELSE
          new_line_number := 1;
          new_byte_position := 1;
          RESET send_transfer_progress.file_byte_address;
          send_transfer_progress.remaining_data := transfer_file_size;
          beginning_of_file := TRUE;
        IFEND;
      PROCEND page_backward_from_line;
?? OLDTITLE ??
?? NEWTITLE := '    page_forward_from_line', EJECT ??

{ PURPOSE:  This procedure positions an output file forward a page from the
{           current line.

      PROCEDURE page_forward_from_line
        (    current_line_number: jmt$output_file_position;
             displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR end_of_file: boolean;
         VAR status: ost$status);

        status.normal := TRUE;
        position_forward_to_line (current_line_number, new_line_number, new_byte_position, end_of_file,
              status);
        IF end_of_file THEN
          RETURN; {----->
        IFEND;
        move_forward_pages (displacement, new_line_number, new_byte_position, end_of_file, status);
      PROCEND page_forward_from_line;
?? OLDTITLE ??
?? NEWTITLE := '    page_forward_from_top', EJECT ??

{ PURPOSE:  This procedure positions an output file forward a page from the
{           beginning of the file.

      PROCEDURE page_forward_from_top
        (    displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR end_of_file: boolean;
         VAR status: ost$status);

        VAR
          adjusted_displacement: reposition_displacement,
          current_line_number: jmt$output_file_position,
          first_char: ^char;

        status.normal := TRUE;
        NEXT first_char IN send_transfer_progress.file_byte_address;
        send_transfer_progress.remaining_data := send_transfer_progress.remaining_data - 1;
        adjusted_displacement := displacement;
        end_of_file := FALSE;
        IF first_char^ = new_page_effector THEN
          adjusted_displacement := adjusted_displacement - 1;
          IF adjusted_displacement = 0 THEN
            new_line_number := 1;
            new_byte_position := 2;
            RETURN; {----->
          IFEND;
        IFEND;
        current_line_number := 1;
        page_forward_from_line (current_line_number, adjusted_displacement, new_line_number,
              new_byte_position, end_of_file, status);
      PROCEND page_forward_from_top;
?? OLDTITLE ??
?? NEWTITLE := '    position_backward_to_page', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards to the top
{           of a page.

      PROCEDURE position_backward_to_page
        (    displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR beginning_of_file: boolean;
         VAR status: ost$status);

        TYPE
          page_record = record
            address: ^cell,
            byte_position: jmt$output_file_position,
            line_number: jmt$output_file_position,
          recend;

        VAR
          bytes: jmt$output_file_position,
          current_line_number: jmt$output_file_position,
          current_page_index: 0 .. 65535,
          current_page_record: ^page_record,
          end_of_file: boolean,
          first_char: ^char,
          page_bytes: jmt$output_file_position,
          page_trace: ^array [0 .. * ] of page_record;

        status.normal := TRUE;
        current_line_number := 1;
        page_bytes := 0;
        PUSH current_page_record;
        current_page_record^.byte_position := 1;
        PUSH page_trace: [0 .. (displacement - 1)];
        NEXT page_trace^ [0].address IN send_transfer_progress.file_byte_address;
        RESET send_transfer_progress.file_byte_address TO page_trace^ [0].address;
        FOR current_page_index := 0 TO (displacement - 1) DO
          page_trace^ [current_page_index].address := NIL;
          page_trace^ [current_page_index].byte_position := 0;
          page_trace^ [current_page_index].line_number := current_page_index;
        FOREND;
        page_trace^ [0].byte_position := 1;
        page_trace^ [0].line_number := 1;
        current_page_index := 0;
        end_of_file := FALSE;
        REPEAT
          NEXT first_char IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO first_char;
          IF first_char^ = new_page_effector THEN
            current_page_index := current_page_index + 1;
            IF current_page_index = displacement THEN
              current_page_index := 0;
            IFEND;
            NEXT current_page_record^.address IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_page_record^.address;
            current_page_record^.byte_position := current_page_record^.byte_position + page_bytes;
            current_page_record^.line_number := current_line_number;
            page_trace^ [current_page_index] := current_page_record^;
            page_bytes := 0;
          IFEND;
          advance_one_line (bytes, end_of_file, status);
          current_line_number := current_line_number + 1;
          page_bytes := page_bytes + bytes;
        UNTIL end_of_file;
        IF page_trace^ [(current_page_index + 1) MOD displacement].address <> NIL THEN
          new_line_number := page_trace^ [(current_page_index + 1) MOD displacement].line_number;
          new_byte_position := page_trace^ [(current_page_index + 1) MOD displacement].byte_position;
          RESET send_transfer_progress.file_byte_address TO page_trace^
                [(current_page_index + 1) MOD displacement].address;
          send_transfer_progress.remaining_data := transfer_file_size - new_byte_position + 1;
        ELSE
          new_line_number := 1;
          new_byte_position := 1;
          RESET send_transfer_progress.file_byte_address;
          send_transfer_progress.remaining_data := transfer_file_size;
          beginning_of_file := TRUE;
        IFEND;
      PROCEND position_backward_to_page;
?? OLDTITLE ??
?? NEWTITLE := '    position_forward_to_line', EJECT ??

{ PURPOSE:  This procedure positions an output file forward to a given line.

      PROCEDURE position_forward_to_line
        (    target_line_number: jmt$output_file_position;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR end_of_file: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position;

        status.normal := TRUE;
        new_byte_position := 1;
        IF target_line_number <= 1 THEN
          new_line_number := 1;
          RETURN; {----->
        IFEND;
        FOR new_line_number := 2 TO target_line_number DO
          advance_one_line (byte_count, end_of_file, status);
          new_byte_position := new_byte_position + byte_count;
          IF end_of_file THEN
            RETURN; {----->
          IFEND;

        FOREND;
      PROCEND position_forward_to_line;
?? OLDTITLE ??
?? NEWTITLE := '    position_to_bottom', EJECT ??

{ PURPOSE:  This procedure positions an output file forward to the end of
{           the file

      PROCEDURE position_to_bottom
        (VAR line_number: jmt$output_file_position;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          end_of_file: boolean;

        status.normal := TRUE;
        line_number := 1;
        REPEAT
          advance_one_line (byte_count, end_of_file, status);
          line_number := line_number + 1;
        UNTIL end_of_file;

      PROCEND position_to_bottom;
?? OLDTITLE ??
?? NEWTITLE := '    position_to_line_from_bottom', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards from the end of
{           the file.

      PROCEDURE position_to_line_from_bottom
        (    displacement: reposition_displacement;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR beginning_of_file: boolean;
         VAR status: ost$status);

        TYPE
          line_record = record
            address: ^cell,
            byte_position: jmt$output_file_position,
          recend;

        VAR
          bytes: jmt$output_file_position,
          current_line_index: 0 .. 65535,
          current_line_number: jmt$output_file_position,
          current_line_record: ^line_record,
          end_of_file: boolean,
          line_trace: ^array [0 .. * ] of line_record;

        status.normal := TRUE;
        current_line_number := 0;
        bytes := 0;
        PUSH current_line_record;
        current_line_record^.byte_position := 1;
        PUSH line_trace: [0 .. (displacement - 1)];
        FOR current_line_index := 0 TO (displacement - 1) DO
          line_trace^ [current_line_index].address := NIL;
          line_trace^ [current_line_index].byte_position := 1
        FOREND;

      /record_displacement_data/
        WHILE TRUE DO
          FOR current_line_index := 0 TO (displacement - 1) DO
            NEXT current_line_record^.address IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_line_record^.address;
            current_line_number := current_line_number + 1;
            current_line_record^.byte_position := current_line_record^.byte_position + bytes;
            line_trace^ [current_line_index] := current_line_record^;
            advance_one_line (bytes, end_of_file, status);
            IF end_of_file THEN
              EXIT /record_displacement_data/; {----->
            IFEND;
          FOREND;
        WHILEND /record_displacement_data/;
        IF line_trace^ [(current_line_index + 1) MOD displacement].address <> NIL THEN
          new_line_number := current_line_number - displacement + 1;
          new_byte_position := line_trace^ [(current_line_index + 1) MOD displacement].byte_position;
          RESET send_transfer_progress.file_byte_address TO line_trace^
                [(current_line_index + 1) MOD displacement].address;
          send_transfer_progress.remaining_data := transfer_file_size - new_byte_position + 1;
        ELSE
          new_line_number := 1;
          new_byte_position := 1;
          RESET send_transfer_progress.file_byte_address;
          send_transfer_progress.remaining_data := transfer_file_size;
          beginning_of_file := TRUE;
        IFEND;
      PROCEND position_to_line_from_bottom;
?? OLDTITLE ??
?? NEWTITLE := '    search_backward_for_ellipsis', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards by a range of
{           string.

      PROCEDURE search_backward_for_ellipsis
        (    first_string: ^string ( * );
             second_string: ^string ( * );
             target_line_number: jmt$output_file_position;
             current_line_number: jmt$output_file_position;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR string_found: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          current_line: ^string ( * ),
          end_of_file: boolean,
          found: boolean,
          last_occurance: record
            current_line: ^string ( * ),
            line_number: jmt$output_file_position,
            byte_address: jmt$output_file_position,
            remaining_data: jmt$output_file_position,
          recend,
          last_occurance_set: boolean,
          restore_line_number: jmt$output_file_position;

        status.normal := TRUE;
        string_found := FALSE;
        found := FALSE;
        last_occurance_set := FALSE;
        end_of_file := FALSE;
        new_line_number := 1;
        new_byte_position := 1;
        IF position_valid THEN
          restore_line_number := current_line_number + 1;
        ELSE
          restore_line_number := current_line_number;
        IFEND;

      /search_file/
        WHILE NOT end_of_file DO
          NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO current_line;
          advance_one_line (byte_count, end_of_file, status);
          RESET send_transfer_progress.file_byte_address TO current_line;
          NEXT current_line: [byte_count] IN send_transfer_progress.file_byte_address;
          search_for_string (first_string, second_string, current_line, byte_count, found, status);
          IF found THEN
            string_found := TRUE;
            last_occurance.current_line := current_line;
            last_occurance.line_number := new_line_number;
            last_occurance.byte_address := new_byte_position;
            last_occurance.remaining_data := send_transfer_progress.remaining_data + byte_count;
            last_occurance_set := TRUE;
          IFEND;
          new_byte_position := new_byte_position + byte_count;
          new_line_number := new_line_number + 1;
          IF (new_line_number = restore_line_number) AND (NOT string_found) THEN
            NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_line;
            last_occurance.current_line := current_line;
            last_occurance.line_number := new_line_number;
            last_occurance.byte_address := new_byte_position;
            last_occurance.remaining_data := send_transfer_progress.remaining_data;
            last_occurance_set := TRUE;
          IFEND;
          IF new_line_number = target_line_number THEN
            IF NOT last_occurance_set THEN
              advance_one_line (byte_count, end_of_file, status);
              NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
              RESET send_transfer_progress.file_byte_address TO current_line;
              last_occurance.current_line := current_line;
              last_occurance.line_number := new_line_number + 1;
              last_occurance.byte_address := new_byte_position + byte_count;
              last_occurance.remaining_data := send_transfer_progress.remaining_data;
              last_occurance_set := TRUE;
            IFEND;
            EXIT /search_file/; {----->
          IFEND;
        WHILEND /search_file/;
        RESET send_transfer_progress.file_byte_address TO last_occurance.current_line;
        new_line_number := last_occurance.line_number;
        new_byte_position := last_occurance.byte_address;
        send_transfer_progress.remaining_data := last_occurance.remaining_data;
      PROCEND search_backward_for_ellipsis;
?? OLDTITLE ??
?? NEWTITLE := '    search_backward_for_string', EJECT ??

{ PURPOSE:  This procedure positions an output file backwards by a string.

      PROCEDURE search_backward_for_string
        (    first_string: ^string ( * );
             target_line_number: jmt$output_file_position;
             current_line_number: jmt$output_file_position;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR string_found: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          current_line: ^string ( * ),
          end_of_file: boolean,
          found: boolean,
          last_occurance: record
            current_line: ^string ( * ),
            line_number: jmt$output_file_position,
            byte_address: jmt$output_file_position,
            remaining_data: jmt$output_file_position,
          recend,
          last_occurance_set: boolean,
          restore_line_number: jmt$output_file_position;

        status.normal := TRUE;
        new_line_number := 1;
        new_byte_position := 1;
        string_found := FALSE;
        found := FALSE;
        last_occurance_set := FALSE;
        end_of_file := FALSE;
        IF position_valid THEN
          restore_line_number := current_line_number + 1;
        ELSE
          restore_line_number := current_line_number;
        IFEND;

      /search_file/
        WHILE NOT end_of_file DO
          NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO current_line;
          advance_one_line (byte_count, end_of_file, status);
          RESET send_transfer_progress.file_byte_address TO current_line;
          NEXT current_line: [byte_count] IN send_transfer_progress.file_byte_address;
          search_for_string (first_string, NIL, current_line, byte_count, found, status);
          IF found THEN
            string_found := TRUE;
            last_occurance.current_line := current_line;
            last_occurance.line_number := new_line_number;
            last_occurance.byte_address := new_byte_position;
            last_occurance.remaining_data := send_transfer_progress.remaining_data + byte_count;
            last_occurance_set := TRUE;
          IFEND;
          new_byte_position := new_byte_position + byte_count;
          new_line_number := new_line_number + 1;
          IF (new_line_number = restore_line_number) AND (NOT string_found) THEN
            NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_line;
            last_occurance.current_line := current_line;
            last_occurance.line_number := new_line_number;
            last_occurance.byte_address := new_byte_position;
            last_occurance.remaining_data := send_transfer_progress.remaining_data;
            last_occurance_set := TRUE;
          IFEND;
          IF new_line_number = target_line_number THEN
            IF NOT last_occurance_set THEN
              advance_one_line (byte_count, end_of_file, status);
              NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
              RESET send_transfer_progress.file_byte_address TO current_line;
              last_occurance.current_line := current_line;
              last_occurance.line_number := new_line_number + 1;
              last_occurance.byte_address := new_byte_position + byte_count;
              last_occurance.remaining_data := send_transfer_progress.remaining_data;
              last_occurance_set := TRUE;
            IFEND;
            EXIT /search_file/; {----->
          IFEND;
        WHILEND /search_file/;
        RESET send_transfer_progress.file_byte_address TO last_occurance.current_line;
        new_line_number := last_occurance.line_number;
        new_byte_position := last_occurance.byte_address;
        send_transfer_progress.remaining_data := last_occurance.remaining_data;
      PROCEND search_backward_for_string;
?? OLDTITLE ??
?? NEWTITLE := '    search_for_string', EJECT ??

{ PURPOSE:  This procedure searches for a string in an output file.

      PROCEDURE search_for_string
        (    string1: ^string ( * );
             string2: ^string ( * );
             search_string: ^string ( * );
             search_string_size: 1 .. 256;
         VAR found: boolean;
         VAR status: ost$status);

        VAR
          column: 1 .. 256,
          index: 1 .. 256,
          last_pass: boolean,
          str: ^string ( * );

        status.normal := TRUE;
        str := string1;
        last_pass := string2 = NIL;
        index := 1;
        found := FALSE;

      /search_loop/
        FOR column := 1 TO search_string_size DO
          IF str^ (index) = search_string^ (column) THEN
            index := index + 1;
            found := index > STRLENGTH (str^);
            IF found THEN
              IF last_pass THEN
                RETURN; {----->
              IFEND;
              found := FALSE;
              last_pass := TRUE;
              str := string2;
              index := 1;
            IFEND;
            CYCLE /search_loop/; {----->
          IFEND;
          index := 1;
        FOREND /search_loop/;
      PROCEND search_for_string;
?? OLDTITLE ??
?? NEWTITLE := '    search_forward_for_ellipsis', EJECT ??

{ PURPOSE:  This procedure positions an output file forward by a range of
{           string.

      PROCEDURE search_forward_for_ellipsis
        (    first_string: ^string ( * );
             second_string: ^string ( * );
             current_line_number: jmt$output_file_position;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR string_found: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          current_line: ^string ( * ),
          end_of_file: boolean,
          found: boolean,
          original_position: record
            current_line: ^string ( * ),
            line_number: jmt$output_file_position,
            byte_address: jmt$output_file_position,
            remaining_data: jmt$output_file_position,
          recend,
          restore_line_number: jmt$output_file_position;

        status.normal := TRUE;
        string_found := FALSE;
        found := FALSE;
        end_of_file := FALSE;
        NEXT original_position.current_line: [1] IN send_transfer_progress.file_byte_address;
        RESET send_transfer_progress.file_byte_address TO original_position.current_line;
        original_position.remaining_data := send_transfer_progress.remaining_data;
        original_position.line_number := current_line_number;
        original_position.byte_address := new_byte_position;
        IF position_valid THEN
          restore_line_number := current_line_number + 1;
        ELSE
          restore_line_number := current_line_number;
        IFEND;

      /search_file/
        WHILE NOT end_of_file DO
          NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO current_line;
          advance_one_line (byte_count, end_of_file, status);
          RESET send_transfer_progress.file_byte_address TO current_line;
          NEXT current_line: [byte_count] IN send_transfer_progress.file_byte_address;
          search_for_string (first_string, second_string, current_line, byte_count, found, status);
          IF found THEN
            string_found := TRUE;
            RESET send_transfer_progress.file_byte_address TO current_line;
            end_of_file := FALSE;
            send_transfer_progress.remaining_data := send_transfer_progress.remaining_data + byte_count;
            RETURN; {----->
          IFEND;
          new_line_number := new_line_number + 1;
          new_byte_position := new_byte_position + byte_count;
          IF (new_line_number = restore_line_number) AND (NOT string_found) THEN
            NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_line;
            original_position.current_line := current_line;
            original_position.line_number := new_line_number;
            original_position.byte_address := new_byte_position;
            original_position.remaining_data := send_transfer_progress.remaining_data;
          IFEND;
        WHILEND /search_file/;
        RESET send_transfer_progress.file_byte_address TO original_position.current_line;
        new_line_number := original_position.line_number;
        new_byte_position := original_position.byte_address;
        send_transfer_progress.remaining_data := original_position.remaining_data;

      PROCEND search_forward_for_ellipsis;
?? OLDTITLE ??
?? NEWTITLE := '    search_forward_for_string', EJECT ??

{ PURPOSE:  This procedure positions an output file forward by a string.

      PROCEDURE search_forward_for_string
        (    first_string: ^string ( * );
             current_line_number: jmt$output_file_position;
         VAR new_line_number: jmt$output_file_position;
         VAR new_byte_position: jmt$output_file_position;
         VAR string_found: boolean;
         VAR status: ost$status);

        VAR
          byte_count: jmt$output_file_position,
          current_line: ^string ( * ),
          end_of_file: boolean,
          found: boolean,
          original_position: record
            current_line: ^string ( * ),
            line_number: jmt$output_file_position,
            byte_address: jmt$output_file_position,
            remaining_data: jmt$output_file_position,
          recend,
          restore_line_number: jmt$output_file_position;

        status.normal := TRUE;
        found := FALSE;
        string_found := FALSE;
        end_of_file := FALSE;
        NEXT original_position.current_line: [1] IN send_transfer_progress.file_byte_address;
        RESET send_transfer_progress.file_byte_address TO original_position.current_line;
        original_position.remaining_data := send_transfer_progress.remaining_data;
        original_position.line_number := current_line_number;
        original_position.byte_address := new_byte_position;
        IF position_valid THEN
          restore_line_number := current_line_number + 1;
        ELSE
          restore_line_number := current_line_number;
        IFEND;

      /search_file/
        WHILE NOT end_of_file DO
          NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO current_line;
          advance_one_line (byte_count, end_of_file, status);
          RESET send_transfer_progress.file_byte_address TO current_line;
          NEXT current_line: [byte_count] IN send_transfer_progress.file_byte_address;
          search_for_string (first_string, NIL, current_line, byte_count, found, status);
          IF found THEN
            string_found := TRUE;
            RESET send_transfer_progress.file_byte_address TO current_line;
            end_of_file := FALSE;
            send_transfer_progress.remaining_data := send_transfer_progress.remaining_data + byte_count;
            RETURN; {----->
          IFEND;
          new_line_number := new_line_number + 1;
          new_byte_position := new_byte_position + byte_count;
          IF (new_line_number = restore_line_number) AND (NOT string_found) THEN
            NEXT current_line: [1] IN send_transfer_progress.file_byte_address;
            RESET send_transfer_progress.file_byte_address TO current_line;
            original_position.current_line := current_line;
            original_position.line_number := new_line_number;
            original_position.byte_address := new_byte_position;
            original_position.remaining_data := send_transfer_progress.remaining_data;
          IFEND;
        WHILEND /search_file/;
        RESET send_transfer_progress.file_byte_address TO original_position.current_line;
        new_line_number := original_position.line_number;
        new_byte_position := original_position.byte_address;
        send_transfer_progress.remaining_data := original_position.remaining_data;

      PROCEND search_forward_for_string;
?? OLDTITLE, EJECT ??
      status.normal := TRUE;
      local_status.normal := TRUE;
      string_found := TRUE;
      beginning_of_file := FALSE;
      end_of_file := FALSE;
      initialize_for_scan (current_line_number, displacement, first_string, second_string, units, direction,
            start_position, type_of_repositioning, target_line_number, beginning_of_file, end_of_file,
            status);
      IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
        RETURN; {----->
      IFEND;
      CASE type_of_repositioning OF
      = forward_string_search_to_line =
        position_forward_to_line (target_line_number, new_line_number, new_byte_position, end_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
        IF NOT end_of_file THEN
          search_forward_for_string (first_string, current_line_number, new_line_number, new_byte_position,
                string_found, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
      = forward_string_search_to_page =
        position_forward_to_line (target_line_number, new_line_number, new_byte_position, end_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
        IF NOT end_of_file THEN
          search_forward_for_string (first_string, current_line_number, new_line_number, new_byte_position,
                string_found, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
        IF string_found THEN
          move_back_pages (1, new_line_number, new_byte_position, beginning_of_file, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
      = back_string_search_to_line =
        search_backward_for_string (first_string, target_line_number, current_line_number, new_line_number,
              new_byte_position, string_found, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = back_string_search_to_page =
        search_backward_for_string (first_string, target_line_number, current_line_number, new_line_number,
              new_byte_position, string_found, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
        IF string_found THEN
          move_back_pages (1, new_line_number, new_byte_position, beginning_of_file, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
      = forward_ellipsis_search_to_line =
        position_forward_to_line (target_line_number, new_line_number, new_byte_position, end_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
        IF NOT end_of_file THEN
          search_forward_for_ellipsis (first_string, second_string, current_line_number, new_line_number,
                new_byte_position, string_found, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
      = forward_ellipsis_search_to_page =
        position_forward_to_line (target_line_number, new_line_number, new_byte_position, end_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
        IF NOT end_of_file THEN
          search_forward_for_ellipsis (first_string, second_string, current_line_number, new_line_number,
                new_byte_position, string_found, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
        IF string_found THEN
          move_back_pages (1, new_line_number, new_byte_position, beginning_of_file, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
      = back_ellipsis_search_to_line =
        search_backward_for_ellipsis (first_string, second_string, target_line_number, current_line_number,
              new_line_number, new_byte_position, string_found, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = back_ellipsis_search_to_page =
        search_backward_for_ellipsis (first_string, second_string, target_line_number, current_line_number,
              new_line_number, new_byte_position, string_found, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
        IF string_found THEN
          move_back_pages (1, new_line_number, new_byte_position, beginning_of_file, status);
          IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
            RETURN; {----->
          IFEND;
        IFEND;
      = forward_line_displacement =
        position_forward_to_line (target_line_number, new_line_number, new_byte_position, end_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = backward_line_displacement =
        position_to_line_from_bottom (displacement, new_line_number, new_byte_position, beginning_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = forward_page_absolute =
        page_forward_from_top (displacement, new_line_number, new_byte_position, end_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = forward_page_relative =
        page_forward_from_line (current_line_number, displacement, new_line_number, new_byte_position,
              end_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = backward_page_absolute =
        position_backward_to_page (displacement, new_line_number, new_byte_position, beginning_of_file,
              status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = backward_page_relative =
        page_backward_from_line (current_line_number, displacement, new_line_number, new_byte_position,
              beginning_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = line_adjustment_forward =
        new_line_number := current_line_number + 1;
        new_byte_position := current_byte_count + 1;
        move_forward_lines (displacement, new_line_number, new_byte_position, end_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = line_adjustment_backward =
        new_line_number := current_line_number + 1;
        new_byte_position := current_byte_count + 1;
        move_back_lines (displacement, new_line_number, new_byte_position, beginning_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = page_adjustment_forward =

        move_forward_pages (displacement, new_line_number, new_byte_position, end_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = page_adjustment_backward =
        new_line_number := current_line_number + 1;
        new_byte_position := current_byte_count + 1;
        move_back_pages (displacement, new_line_number, new_byte_position, beginning_of_file, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = no_repositioning =
        new_line_number := target_line_number;
        IF end_of_file THEN
          new_byte_position := transfer_file_size;
        ELSE
          new_byte_position := 1;
        IFEND;
      CASEND;
      preview_bytes := 0;
      IF preview_lines > 0 THEN
        IF NOT beginning_of_file AND NOT end_of_file THEN
          NEXT current_position IN send_transfer_progress.file_byte_address;
          RESET send_transfer_progress.file_byte_address TO current_position;
          current_remaining_data := send_transfer_progress.remaining_data;

        /set_preview_bytes/
          FOR i := 1 TO preview_lines DO
            advance_one_line (bytes, end_of_file, status);
            preview_bytes := preview_bytes + bytes;
            IF end_of_file THEN
              EXIT /set_preview_bytes/; {----->
            IFEND;
          FOREND /set_preview_bytes/;
          RESET send_transfer_progress.file_byte_address TO current_position;
          send_transfer_progress.remaining_data := current_remaining_data;
        IFEND;
      IFEND;
    PROCEND position_file;
?? OLDTITLE ??
?? NEWTITLE := '  set_current_position', EJECT ??

{ PURPOSE:  This procedure establishes the current position of an output file.

    PROCEDURE set_current_position
      (    parameter_string: ^string ( * );
       VAR current_tip_line: jmt$output_file_position;
       VAR current_di_byte: jmt$output_file_position;
       VAR status: ost$status);

      VAR
        byte_number: clt$integer,
        index: 1 .. 999,
        line_number: clt$integer,
        local_status: ost$status,
        parameter_string_length: 0 .. 999,
        separator_not_found: boolean;

      status.normal := TRUE;
      local_status.normal := TRUE;
      parameter_string_length := STRLENGTH (parameter_string^);
      separator_not_found := TRUE;

    /search_for_separator/
      FOR index := 1 TO parameter_string_length DO
        IF parameter_string^ (index, 1) = ',' THEN
          separator_not_found := FALSE;
          EXIT /search_for_separator/; {----->
        IFEND;
      FOREND /search_for_separator/;
      IF separator_not_found THEN
        process_send_protocol_error (status);
        RETURN; {----->
      IFEND;
      clp$convert_string_to_integer (parameter_string^ (1, index - 1), byte_number, local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      IFEND;
      clp$convert_string_to_integer (parameter_string^ (index + 1, parameter_string_length - index),
            line_number, local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      IFEND;
      current_tip_line := line_number.value;
      current_di_byte := byte_number.value;
    PROCEND set_current_position;
?? OLDTITLE ??
?? NEWTITLE := '  set_repositioning_data', EJECT ??

{ PURPOSE:  This procedure sets up the data neede to position an output file.

    PROCEDURE set_repositioning_data
      (    parameter_string: ^string ( * );
       VAR displacement: reposition_displacement;
       VAR first_string: ^reposition_string;
       VAR second_string: ^reposition_string;
       VAR units: reposition_units;
       VAR direction: reposition_direction;
       VAR start_position: reposition_start_position;
       VAR preview_lines: reposition_preview_lines;
       VAR status: ost$status);

      CONST
        backward_direction = 'B',
        direction_id = '05',
        forward_direction = 'F',
        lines_units = 'L',
        location_count_id = '01',
        location_string_1_id = '02',
        location_string_2_id = '03',
        pages_units = 'P',
        preview_id = '07',
        start_at_beginning = 'B',
        start_at_current_line = 'L',
        start_at_end = 'E',
        start_position_id = '06',
        system_level_id = '001',
        units_id = '04';

      VAR
        command_format_id: string (3),
        direction_set: boolean,
        direction_string: char,
        displacement_integer: clt$integer,
        displacement_set: boolean,
        first_string_set: boolean,
        index: integer,
        local_status: ost$status,
        parameter_id: string (2),
        parameter_length: clt$integer,
        preview_lines_integer: clt$integer,
        preview_lines_set: boolean,
        preview_string: char,
        second_string_set: boolean,
        start_position_set: boolean,
        start_position_string: char,
        units_set: boolean,
        units_string: char;

      status.normal := TRUE;
      local_status.normal := TRUE;
      command_format_id := parameter_string^ (1, 3);
      IF command_format_id = system_level_id THEN
        index := 4;
        displacement_set := FALSE;
        first_string_set := FALSE;
        second_string_set := FALSE;
        units_set := FALSE;
        direction_set := FALSE;
        start_position_set := FALSE;
        preview_lines_set := FALSE;

      /process_parameters/
        REPEAT
          parameter_id := parameter_string^ (index, 2);
          index := index + 2;
          IF parameter_id = location_count_id THEN
            IF displacement_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            clp$convert_string_to_integer (parameter_string^ (index, 3), parameter_length, local_status);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
            index := index + 3;
            clp$convert_string_to_integer (parameter_string^ (index, parameter_length.value),
                  displacement_integer, local_status);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
            displacement := displacement_integer.value;
            index := index + parameter_length.value;
            displacement_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSEIF parameter_id = location_string_1_id THEN
            IF first_string_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            clp$convert_string_to_integer (parameter_string^ (index, 3), parameter_length, local_status);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
            index := index + 3;
            first_string := ^parameter_string^ (index, parameter_length.value);
            index := index + parameter_length.value;
            first_string_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSEIF parameter_id = location_string_2_id THEN
            IF second_string_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            clp$convert_string_to_integer (parameter_string^ (index, 3), parameter_length, local_status);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
            index := index + 3;
            second_string := ^parameter_string^ (index, parameter_length.value);
            index := index + parameter_length.value;
            second_string_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSEIF parameter_id = units_id THEN
            IF units_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            IF parameter_string^ (index + 3, 1) = lines_units THEN
              units := lines;
            ELSEIF parameter_string^ (index + 3, 1) = pages_units THEN
              units := pages;
            ELSE
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            index := index + 4;
            units_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSEIF parameter_id = direction_id THEN
            IF direction_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            IF parameter_string^ (index + 3, 1) = forward_direction THEN
              direction := forward;
            ELSEIF parameter_string^ (index + 3, 1) = backward_direction THEN
              direction := backward;
            ELSE
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            index := index + 4;
            direction_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSEIF parameter_id = start_position_id THEN
            IF start_position_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            IF parameter_string^ (index + 3, 1) = start_at_beginning THEN
              start_position := top;
            ELSEIF parameter_string^ (index + 3, 1) = start_at_end THEN
              start_position := bottom;
            ELSEIF parameter_string^ (index + 3, 1) = start_at_current_line THEN
              start_position := last_line_printed;
            ELSE
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            index := index + 4;
            start_position_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSEIF parameter_id = preview_id THEN
            IF preview_lines_set THEN
              process_send_protocol_error (status);
              RETURN; {----->
            IFEND;
            clp$convert_string_to_integer (parameter_string^ (index + 3, 1), preview_lines_integer,
                  local_status);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
            preview_lines := preview_lines_integer.value + 1;
            index := index + 4;
            preview_lines_set := TRUE;
            CYCLE /process_parameters/; {----->
          ELSE
            process_send_protocol_error (status);
            RETURN; {----->
          IFEND;
        UNTIL index > STRLENGTH (parameter_string^);
      ELSE
        process_send_protocol_error (status);
      IFEND;

    PROCEND set_repositioning_data;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    local_status.normal := TRUE;
    required_attribute_present := FALSE;
    RESET command_buffer;
    NEXT command_id_string IN command_buffer;
    NEXT parameter_count_string IN command_buffer;
    clp$convert_string_to_integer (parameter_count_string^, parameter_count, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    displacement := 1;
    first_string := NIL;
    second_string := NIL;
    units := pages;
    direction := backward;
    start_position := last_line_printed;
    preview_lines := 0;

  /process_attributes/
    FOR index := 1 TO parameter_count.value DO
      NEXT attribute_number_string IN command_buffer;
      NEXT qualifier_character IN command_buffer;
      NEXT attribute_size_string IN command_buffer;
      clp$convert_string_to_integer (attribute_size_string^, attribute_size, local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      IFEND;
      NEXT parameter_string: [attribute_size.value] IN command_buffer;
      no_find := TRUE;

    /determine_attribute/
      FOR attribute_id := reposition_info TO current_position DO
        IF attribute_number_string^ = convert_positioning_param [attribute_id] THEN
          no_find := FALSE;
          EXIT /determine_attribute/; {----->
        IFEND;
      FOREND /determine_attribute/;
      IF no_find THEN
        process_send_protocol_error (status);
        RETURN; {----->
      IFEND;
      CASE attribute_id OF
      = reposition_info =
        set_repositioning_data (parameter_string, displacement, first_string, second_string, units, direction,
              start_position, preview_lines, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      = current_position =
        required_attribute_present := TRUE;
        set_current_position (parameter_string, current_tip_line, current_di_byte, status);
        IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
          RETURN; {----->
        IFEND;
      CASEND;
    FOREND /process_attributes/;
    IF NOT required_attribute_present THEN
      process_send_protocol_error (status);
      RETURN; {----->
    IFEND;
    position_file (current_tip_line, current_di_byte, displacement, first_string, second_string, units,
          direction, start_position, preview_lines, new_line_number, new_byte_position, preview_bytes,
          string_found, beginning_of_file, end_of_file, status);
    IF (NOT status.normal) OR (NOT send_params.status.normal) THEN
      RETURN; {----->
    IFEND;
    user_message := NIL;
    preview_message [1].message := NIL;
    preview_message [2].message := NIL;
    preview_message [3].message := NIL;
    IF preview_lines <> 0 THEN
      IF NOT string_found THEN
        PUSH user_message: [user_message_size];
        user_message^ (1, user_message_size - 3) := not_found_message;
        user_message^ (user_message_size - 2, 1) := $CHAR (31);
        user_message^ (user_message_size - 1, 1) := ' ';
        user_message^ (user_message_size, 1) := $CHAR (31);
      IFEND;
      IF preview_bytes <> 0 THEN
        preview_count := preview_bytes;

      /set_preview_message/
        FOR i := 1 TO 3 DO
          preview_message [i].length := preview_count;
          IF preview_message [i].length > 999 THEN
            preview_message [i].length := 999;
            preview_count := preview_count - 999;
            IF preview_count <= 0 THEN
              preview_count := 0;
            IFEND;
          ELSE
            preview_count := 0;
          IFEND;
          IF (preview_message [i].length) <> 0 THEN
            NEXT preview_message [i].message: [preview_message [i].length] IN
                  send_transfer_progress.file_byte_address;
          ELSE
            preview_message [i].message := NIL;
            EXIT /set_preview_message/; {----->
          IFEND;
        FOREND /set_preview_message/;

        RESET send_transfer_progress.file_byte_address TO preview_message [1].message;
      ELSE
        preview_message [1].message := NIL;
        IF beginning_of_file THEN
          RESET send_transfer_progress.file_byte_address;
          send_transfer_progress.remaining_data := transfer_file_size;
          PUSH user_message: [user_message_size];
          user_message^ (1, user_message_size - 3) := boi_message;
          user_message^ (user_message_size - 2, 1) := $CHAR (31);
          user_message^ (user_message_size - 1, 1) := ' ';
          user_message^ (user_message_size, 1) := $CHAR (31);
        ELSEIF end_of_file THEN
          send_transfer_progress.remaining_data := 0;
          PUSH user_message: [user_message_size];
          user_message^ (1, user_message_size - 3) := eoi_message;
          user_message^ (user_message_size - 2, 1) := $CHAR (31);
          user_message^ (user_message_size - 1, 1) := ' ';
          user_message^ (user_message_size, 1) := $CHAR (31);
        IFEND;
      IFEND;
    IFEND;

{   Send protocol command PS - Position request acknowledge.

    send_ps_command (new_line_number, new_byte_position, user_message, preview_message, status);
  PROCEND process_pr_command;
?? TITLE := 'process_send_protocol_error', EJECT ??

{ PURPOSE:  This procedure sets up an error ES command to the peer because of
{           a protocol anomaly.

  PROCEDURE process_send_protocol_error
    (VAR status: ost$status);

    status.normal := TRUE;
    IF processing_error THEN
      osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error, '', status);
      RETURN; {----->
    IFEND;
    processing_error := TRUE;
    osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error, '', send_params.status);
    osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly, '', send_params.transfer_status);

{   Send protocol command ES with error - end sender data.

    send_es_err (send_detected_prot_err, status);
  PROCEND process_send_protocol_error;
?? TITLE := 'process_send_system_error', EJECT ??

{ PURPOSE:  This procedure sets up an error ES command to the peer because of
{           a system error.

  PROCEDURE process_send_system_error
    (    local_status: ost$status;
     VAR status: ost$status);

    VAR
      command_buffer: ^SEQ ( * ),
      data_area: sender_input_data_area;

    IF NOT local_status.normal THEN
      nap$display_message (local_status);
    IFEND;
    IF processing_error THEN
      IF local_status.normal THEN
        status.normal := TRUE;
      ELSE
        status := local_status;
      IFEND;
      RETURN; {----->
    IFEND;
    processing_error := TRUE;
    IF local_status.normal THEN
      send_params.status.normal := TRUE;
    ELSE
      send_params.status := local_status;
    IFEND;
    osp$set_status_abnormal (nfc$status_id, nfe$terminate_transfer_message, '',
          send_params.transfer_status);
    IF current_send_state = wait_sendr THEN
      PUSH command_buffer: [[REP command_block_size OF cell]];
      data_area [1] := command_buffer;
      receive_connection_event (data_area, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

{   Send protocol command ES with error - end sender data.

    send_es_err (send_err_no_retry, status);
  PROCEND process_send_system_error;
?? TITLE := 'process_sender_input', EJECT ??

{ PURPOSE:  This procedure processes sender commands.

  PROCEDURE process_sender_input
    (    peer_operation: nat$se_peer_operation;
     VAR data_area: sender_input_data_area;
     VAR status: ost$status);

    VAR
      command: ^data_phase_command,
      command_buffer: ^SEQ ( * ),
      contains_data: boolean,
      convert_sender_command: [STATIC, READ] array [sender_input_commands] of string (2) :=
            [sr_command, rr_command, mr_command, er_command, qr_command, pr_command],
      get_attributes: ^amt$get_attributes,
      id: sender_input_commands,
      local_file: boolean,
      local_status: ost$status,
      no_find: boolean,
      old_file: boolean,
      trace_message: string(256),
      trace_size: integer,
      transfer_file_attributes: ^fst$file_cycle_attributes,
      unique_name: ost$name;

    status.normal := TRUE;
    local_status.normal := TRUE;
    IF  current_send_state <> ss_ack_not_required  THEN
      command_buffer := data_area [1];
      RESET command_buffer;
      NEXT command IN command_buffer;
      no_find := TRUE;

    IF protocol_trace THEN
      STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE:',
            ' RCV Command: ', command^.command_id, ', ',
            command^.parameter_count, command^.parameter_prefix,
            command^.condition_code);
      pmp$log (trace_message (1,trace_size), local_status);
      local_status.normal := TRUE;
    IFEND;

    /determine_id/
      FOR id := sr TO pr DO
        IF command^.command_id = convert_sender_command [id] THEN
          no_find := FALSE;
          EXIT /determine_id/; {----->
        IFEND;
      FOREND /determine_id/;
      IF no_find THEN
        process_send_protocol_error (status);
        RETURN; {----->
      IFEND;
    ELSE
      id := sr;
    IFEND;
    CASE id OF
?? EJECT ??
{   Process SR command - Start of data acknowledge

    = sr =
      IF processing_error THEN
        current_send_state := exit_send;
        RETURN; {----->
      IFEND;
      IF (current_send_state <> wait_sendr)  AND (current_send_state <> ss_ack_not_required)  THEN
        process_send_protocol_error (status);
        RETURN; {----->
      IFEND;
      current_send_state := send_data;

      CASE send_params.transfer_mode OF

      = nfc$ve_to_ve_mode =
        IF NOT queue_file THEN
          transfer_file := send_params.file_name;
        ELSE
          bap$get_phn_via_file_id (sender_file_id, transfer_file, local_status);
          IF NOT local_status.normal THEN
            process_send_system_error (local_status, status);
            RETURN; {----->
          IFEND;
        IFEND;
        send_file_label (status);
        IF (NOT status.normal)  OR (send_transfer_progress.general_position <> label_complete)  THEN
          RETURN; {----->
        IFEND;

      = nfc$coded_data_mode =
        IF NOT queue_file THEN
          IF  control_info.type_of_copy <> fsc$byte_move  THEN
            pmp$get_unique_name (unique_name, local_status);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
            transfer_file := unique_name;
            PUSH transfer_file_attributes: [1 .. 3];
            transfer_file_attributes^ [1].selector := fsc$record_type;
            transfer_file_attributes^ [1].record_type := amc$trailing_char_delimited;
            transfer_file_attributes^ [2].selector := fsc$ring_attributes;
            transfer_file_attributes^ [2].ring_attributes.r1 := send_params.validation_ring;
            transfer_file_attributes^ [2].ring_attributes.r2 := send_params.validation_ring;
            transfer_file_attributes^ [2].ring_attributes.r3 := send_params.validation_ring;
            transfer_file_attributes^ [3].selector := fsc$record_delimiting_character;
            transfer_file_attributes^ [3].record_delimiting_character := $CHAR (1f(16)); { US character }

            fsp$copy_file (send_params.file_name, transfer_file, NIL, NIL, transfer_file_attributes,
                  local_status);
            return_file := TRUE;
            #SPOIL (return_file);
            IF NOT local_status.normal THEN
              process_send_system_error (local_status, status);
              RETURN; {----->
            IFEND;
          ELSE
            transfer_file := send_params.file_name;
          IFEND;
        ELSE
          bap$get_phn_via_file_id (sender_file_id, transfer_file, local_status);
          IF NOT local_status.normal THEN
            process_send_system_error (local_status, status);
            RETURN; {----->
          IFEND;
        IFEND;

      = nfc$rhf_structured_mode =
        send_rhf_file_blocks (status);
        IF (NOT status.normal)  THEN
          RETURN; {----->
        IFEND;

      = nfc$transparent_data_mode =
        transfer_file := send_params.file_name;

      ELSE

        pmp$log ('process_sender_input sr mode CASE error', local_status);
        osp$set_status_abnormal (nfc$status_id, nfe$sender_problem_no_retry,
            '', local_status);
        process_send_system_error (local_status, status);
        RETURN; {----->

      CASEND;

      start_send_file (status);
      IF  status.normal  THEN
        IF  (current_send_state = send_data)  AND
            (send_transfer_progress.general_position = file_in_progress) THEN
          send_file_blocks (status);
        IFEND;
      IFEND;
?? EJECT ??
{   ER command - End of data acknowledge

    = er =
      IF command^.condition_code = ok THEN

        IF current_send_state <> end_ok_sent THEN
          process_send_protocol_error (status);
          RETURN; {----->
        IFEND;
        current_send_state := exit_send;
        RETURN; {----->

      ELSEIF command^.condition_code (3, 1) = hold_condition THEN

        IF (current_send_state <> wait_resume) AND (current_send_state <> end_err_sent) AND
              (current_send_state <> send_data) THEN
          process_send_protocol_error (status);
          RETURN; {----->
        IFEND;
        position_valid := FALSE;
        IF send_transfer_progress.general_position = not_started THEN
          current_send_state := send_data;
          IF send_params.transfer_mode = nfc$ve_to_ve_mode THEN
            send_file_label (status);
            IF send_transfer_progress.general_position <> label_complete THEN
              RETURN; {----->
            IFEND;
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
          IFEND;
          start_send_file (status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
        IF send_transfer_progress.general_position = file_in_progress THEN
          current_send_state := send_data;
          send_file_blocks (status);
          RETURN; {----->
        IFEND;
        IF send_transfer_progress.general_position = transfer_complete THEN
          current_send_state := end_ok_sent;
          RETURN; {----->
        IFEND;

      ELSEIF command^.condition_code (3, 1) = err_condition THEN

        IF current_send_state <> end_err_sent THEN
          process_send_protocol_error (status);
          RETURN; {----->
        IFEND;
        current_send_state := exit_send;

      ELSE

        process_send_protocol_error (status);
        RETURN; {----->

      IFEND;
?? EJECT ??
{   QR command - Quit transfer

    = qr =
      IF command^.condition_code (3, 1) = ok_condition THEN

        IF current_send_state = send_data THEN
          current_send_state := quit_ok_received;
          send_params.transfer_status.normal := TRUE;

{         Send protocol command ES - end sender data ok.

          send_es_ok (status);
        ELSEIF (current_send_state <> end_ok_sent) AND (current_send_state <> end_err_sent) THEN
          process_send_protocol_error (status);
        IFEND;
        RETURN; {----->

      ELSEIF command^.condition_code (3, 1) = hold_condition THEN

        IF (current_send_state = send_data) THEN
          current_send_state := holdr_pend;

{         Send protocol command ES with hold - end sender data / hold.

          send_es_hold (command^.condition_code, status);
        ELSEIF (current_send_state <> end_err_sent) AND (current_send_state <> end_ok_sent) AND
              (current_send_state <> wait_resume) THEN
          process_send_protocol_error (status);
        IFEND;
        RETURN; {----->

      ELSEIF command^.condition_code (3, 1) = err_condition THEN

        IF current_send_state = end_err_sent THEN
          IF command^.condition_code (4, 1) < active_send_error_code THEN
            RETURN; {----->
          IFEND;
        IFEND;
        processing_error := TRUE;
        osp$set_status_abnormal (nfc$status_id, nfe$receiver_problem_no_retry, '',
              send_params.transfer_status);
        current_send_state := quit_err_received;

{       Send protocol command ES with error - end sender data.

        send_es_err (command^.condition_code, status);

      ELSE

        process_send_protocol_error (status);

      IFEND;
?? EJECT ??
{   PR command - Position file

    = pr =
      IF send_params.protocol_version <> nfc$p00_b101 THEN
        process_send_protocol_error (status);
        RETURN; {----->
      IFEND;
      IF current_send_state =  wait_sendr THEN
        process_send_protocol_error (status);
        RETURN; {----->
      IFEND;
      IF current_send_state = end_err_sent THEN
        RETURN; {----->
      IFEND;
      current_send_state := pos_pend;
      RESET command_buffer;
      process_pr_command (command_buffer, status);

    ELSE
      process_send_protocol_error (status);
    CASEND;

  PROCEND process_sender_input;
?? TITLE := 'receive_connection_event', EJECT ??

{ PURPOSE:  This procedure receives data from the peer application.

  PROCEDURE receive_connection_event
    (VAR data_area: sender_input_data_area;
     VAR status: ost$status);

    VAR
      activity_status: ost$activity_status,
      buffer_descriptor_nam: array [1 .. 1] of nat$data_fragment,
      buffer_descriptor_rhfam: array [1 .. 1] of rft$data_fragment,
      local_status: ost$status,
      peer_operation: nat$se_peer_operation,
      trace_message: string(256),
      trace_size: integer;

    status.normal := TRUE;
    local_status.normal := TRUE;
    activity_status.status.normal := TRUE;

  /receive_event/
    WHILE current_send_state <> exit_send DO
      IF  access_method = nfc$am_nam  THEN
        buffer_descriptor_nam [1].address := data_area [1];
        buffer_descriptor_nam [1].length := #SIZE (data_area [1]^);
      ELSE
        buffer_descriptor_rhfam [1].address := data_area [1];
        buffer_descriptor_rhfam [1].length := #SIZE (data_area [1]^);
      IFEND;
      IF  current_send_state <> ss_ack_not_required  THEN
        IF  access_method = nfc$am_nam  THEN
          nap$await_data_available (send_params.connection_fid, initial_wait_time, 0, local_status);
          IF (NOT local_status.normal) AND (local_status.condition = nae$no_data_available)  THEN
            IF send_params.min_timeout <> nfc$timeout_limit THEN
              nap$await_data_available (send_params.connection_fid,
                    send_params.min_timeout * 1000 - initial_wait_time, 0, local_status);
            ELSE
              nap$await_data_available (send_params.connection_fid, nac$max_wait_time, 0, local_status);
            IFEND;
          IFEND;
        ELSE
          rfp$await_rhfam_event (send_params.connection_fid, rfc$input_available, initial_wait_time,
                local_status);
          IF (NOT local_status.normal)  AND (local_status.condition = rfe$no_available_event)  THEN
            rfp$await_rhfam_event (send_params.connection_fid, rfc$input_available,
                  send_params.min_timeout * 1000 - initial_wait_time, local_status);
          IFEND;
        IFEND;
        IF NOT local_status.normal THEN
          IF (local_status.condition = nae$connection_terminated) OR
                (local_status.condition = rfe$connection_terminated)  THEN
            osp$set_status_abnormal ('NF', nfe$connection_closed_by_peer, '', status);
            send_params.status := status;
            osp$set_status_abnormal (nfc$status_id, nfe$receiver_problem_no_retry, '',
                  send_params.transfer_status);
            RETURN; {----->
          ELSEIF (local_status.condition = nae$no_data_available)  OR
                (local_status.condition = rfe$no_available_event)  THEN
            IF current_send_state = wait_resume THEN
              CYCLE /receive_event/; {----->
            IFEND;
            osp$set_status_abnormal ('NF', nfe$application_timeout, '', status);
            send_params.status := status;
            osp$set_status_abnormal (nfc$status_id, nfe$application_time_out, '',
                  send_params.transfer_status);
            RETURN; {----->
          ELSE
            process_send_system_error (local_status, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            CYCLE /receive_event/; {----->
          IFEND;
        IFEND;
        IF  access_method = nfc$am_nam  THEN
          nap$se_receive_data (send_params.connection_fid, buffer_descriptor_nam, osc$wait, peer_operation,
                activity_status, local_status);
        ELSE
          peer_operation.kind := nac$se_send_data;
          rfp$receive_data (send_params.connection_fid, rfc$message_mode, ^buffer_descriptor_rhfam, osc$wait,
                activity_status, peer_operation.data_length, peer_operation.end_of_message, local_status);
        IFEND;
        IF NOT local_status.normal THEN
          IF (local_status.condition = nae$connection_terminated)  OR
                (local_status.condition = rfe$connection_terminated) THEN
            osp$set_status_abnormal ('NF', nfe$connection_closed_by_peer, '', status);
            send_params.status := status;
            osp$set_status_abnormal (nfc$status_id, nfe$receiver_problem_no_retry, '',
                  send_params.transfer_status);
            RETURN; {----->
          ELSEIF (local_status.condition = nae$data_transfer_timeout) OR
                (local_status.condition = rfe$transfer_timeout) THEN
            osp$set_status_abnormal ('NF', nfe$access_method_timeout, '', status);
            send_params.status := status;
            osp$set_status_abnormal (nfc$status_id, nfe$application_time_out, '',
                  send_params.transfer_status);
            RETURN; {----->
          ELSE
            process_send_system_error (local_status, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            CYCLE /receive_event/; {----->
          IFEND;
        ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
          IF (activity_status.status.condition = nae$connection_terminated)  OR
                (activity_status.status.condition = rfe$connection_terminated) THEN
            osp$set_status_abnormal ('NF', nfe$connection_closed_by_peer, '', status);
            send_params.status := status;
            osp$set_status_abnormal (nfc$status_id, nfe$receiver_problem_no_retry, '',
                  send_params.transfer_status);
            RETURN; {----->
          ELSEIF (activity_status.status.condition = nae$data_transfer_timeout) OR
                (activity_status.status.condition = rfe$transfer_timeout) THEN
            osp$set_status_abnormal ('NF', nfe$access_method_timeout, '', status);
            send_params.status := status;
            osp$set_status_abnormal (nfc$status_id, nfe$application_time_out, '',
                  send_params.transfer_status);
            RETURN; {----->
          ELSE
            process_send_system_error (activity_status.status, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            CYCLE /receive_event/; {----->
          IFEND;
        IFEND;
        IF peer_operation.kind <> nac$se_send_data THEN
          IF peer_operation.kind = nac$se_synchronize THEN
            STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE:',
                  ' RCV Illegal Synchronize Message.');
            pmp$log (trace_message (1,trace_size), local_status);
          ELSEIF peer_operation.kind = nac$se_interrupt THEN
            STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE:',
                ' RCV Illegal Interrupt Message.');
            pmp$log (trace_message (1,trace_size), local_status);
          IFEND;
          osp$set_status_abnormal ('NF', nfe$application_protocol_error, '', status);
          send_params.status := status;
          RETURN; {----->
        IFEND;
      IFEND;
      process_sender_input (peer_operation, data_area, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    WHILEND /receive_event/;
  PROCEND receive_connection_event;
?? TITLE := 'send_batch_ss', EJECT ??

{ PURPOSE:  This procedure sends an SS command for output file transfers.

  PROCEDURE send_batch_ss
    (    byte_position: jmt$output_file_position;
         line_number: jmt$output_file_position;
     VAR status: ost$status);

    CONST
      basic_batch_ss_command = '300223S004000057S',
      basic_batch_ss_command_size = 17,
      comma = ',',
      size_string_size = 3;

    VAR
      activity_status: ost$activity_status,
      basic_command_ptr: ^string (basic_batch_ss_command_size),
      byte_string: ost$string,
      byte_string_ptr: ^string ( * <= 14),
      comma_string_ptr: ^string (1),
      command_string: ^SEQ ( * ),
      command_string_size: 1 .. 49,
      end_of_message: boolean,
      line_string: ost$string,
      line_string_ptr: ^string ( * <= 14),
      local_status: ost$status,
      message_content: array [1 .. 1] of nat$data_fragment,
      parameter_size: 3 .. 29,
      qualified_data: boolean,
      size_string_ptr: ^string (size_string_size),
      trace_message: ^string(256),
      trace_message_ptr: ^string ( * ),
      trace_size: integer;

    status.normal := TRUE;
    local_status.normal := TRUE;
    qualified_data := TRUE;
    end_of_message := TRUE;
    clp$convert_integer_to_string (byte_position, 10, FALSE, byte_string, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    clp$convert_integer_to_string (line_number, 10, FALSE, line_string, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    parameter_size := byte_string.size + line_string.size + 1;
    command_string_size := basic_batch_ss_command_size + size_string_size + parameter_size;
    PUSH command_string: [[REP command_string_size OF cell]];
    RESET command_string;
    NEXT basic_command_ptr IN command_string;
    NEXT size_string_ptr IN command_string;
    NEXT byte_string_ptr: [byte_string.size] IN command_string;
    NEXT comma_string_ptr IN command_string;
    NEXT line_string_ptr: [line_string.size] IN command_string;
    basic_command_ptr^ := basic_batch_ss_command;
    clp$convert_integer_to_rjstring (parameter_size, 10, FALSE, '0', size_string_ptr^, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    byte_string_ptr^ := byte_string.value;
    comma_string_ptr^ := comma;
    line_string_ptr^ := line_string.value;

    IF protocol_trace THEN
      PUSH trace_message;
      RESET command_string;
      NEXT trace_message_ptr: [command_string_size] IN command_string;
      STRINGREP (trace_message^, trace_size, '**** NFM$RHF_SEND_FILE:',
            ' SND Command: 30, ', trace_message_ptr^ (1, command_string_size));
      pmp$log (trace_message^ (1,trace_size), local_status);
    IFEND;

    message_content [1].address := command_string;
    message_content [1].length := command_string_size;
    nap$se_send_data (send_params.connection_fid, message_content, end_of_message, qualified_data, osc$wait,
          activity_status, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
    ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
      process_send_system_error (activity_status.status, status);
    IFEND;
    current_send_state := wait_sendr;
  PROCEND send_batch_ss;
?? TITLE := 'send_es_err', EJECT ??

{ PURPOSE:  This procedure sends an ES command with error.

  PROCEDURE send_es_err
    (    condition_code: string (4);
     VAR status: ost$status);

    VAR
      command_id: string (2);

    status.normal := TRUE;
    command_id := es_command;
    IF condition_code = receive_err_retry THEN
      osp$set_status_abnormal (nfc$status_id, nfe$receiver_problem_retry,
          '', send_params.transfer_status);
    ELSEIF condition_code = receive_err_no_retry THEN
      osp$set_status_abnormal (nfc$status_id, nfe$receiver_problem_no_retry,
          '', send_params.transfer_status);
    ELSEIF condition_code = receive_detected_prot_err THEN
      osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly,
          '', send_params.transfer_status);
    ELSEIF condition_code = receive_nogo THEN
      osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly,
          '', send_params.transfer_status);
    ELSEIF condition_code = send_err_retry THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sender_problem_retry,
          '', send_params.transfer_status);
    ELSEIF condition_code = send_err_no_retry THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sender_problem_no_retry,
          '', send_params.transfer_status);
    ELSEIF condition_code = send_detected_prot_err THEN
      osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly,
          '', send_params.transfer_status);
    ELSEIF condition_code = send_nogo THEN
      osp$set_status_abnormal (nfc$status_id, nfe$protocol_anomaly,
          '', send_params.transfer_status);
    IFEND;
    active_send_error_code := condition_code (4);
    send_sender_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    current_send_state := end_err_sent;
  PROCEND send_es_err;
?? TITLE := 'send_es_hold', EJECT ??

{ PURPOSE:  This procedure sends an ES command with hold.

  PROCEDURE send_es_hold
    (    condition_code: string (4);
     VAR status: ost$status);

    VAR
      command_id: string (2);

    status.normal := TRUE;
    command_id := es_command;
    send_sender_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    current_send_state := wait_resume;
  PROCEND send_es_hold;
?? TITLE := 'send_es_ok', EJECT ??

{ PURPOSE:  This procedure sends an ES command with no error.

  PROCEDURE send_es_ok
    (VAR status: ost$status);

    VAR
      command_id: string (2),
      condition_code: string (4);

    status.normal := TRUE;
    command_id := es_command;
    condition_code := ok;
    send_sender_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    current_send_state := end_ok_sent;
  PROCEND send_es_ok;
?? TITLE := 'send_file_blocks', EJECT ??

{ PURPOSE:  This procedure transfers the file data in blocks.

  PROCEDURE send_file_blocks
    (VAR status: ost$status);

    CONST
      event_check_window = 1;

    VAR
      activity_status: ost$activity_status,
      block_count: integer,
      data_header: ^batch_data_header,
      end_of_message: boolean,
      ignore_status: ost$status,
      local_status: ost$status,
      message_content: array [1 .. 2] of nat$data_fragment,
      qualified_data: boolean,
      trace_message: string(256),
      trace_size: integer;

?? NEWTITLE := '  output_handler', EJECT ??

{ PURPOSE:  This is the condition handler for send_file_blocks.

    PROCEDURE output_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      activity_status.complete := ((condition.selector = pmc$system_conditions) OR
            (condition.selector = jmc$job_resource_condition) OR
            (condition.selector = mmc$segment_access_condition) OR
            (condition.selector = ifc$interactive_condition));
      pmp$continue_to_cause (pmc$execute_standard_procedure, status);

    PROCEND output_handler;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    IF  access_method = nfc$am_rhfam  THEN
      osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error, '', status);
      RETURN; {----->
    IFEND;

    local_status.normal := TRUE;
    data_header := ^header_buffer;
    block_count := 0;
    message_content [1].address := data_header;
    message_content [1].length := data_header_length;
    osp$establish_condition_handler (^output_handler, FALSE);

  /repeat_send/
    WHILE send_transfer_progress.remaining_data > 0 DO
      IF send_params.block_size < send_transfer_progress.remaining_data THEN
        message_content [2].length := send_params.block_size;
        data_header^.data_block_clarifier := nfc$dbc_no_mark;
        data_header^.byte_count := send_params.block_size;
      ELSE
        message_content [2].length := send_transfer_progress.remaining_data;
        data_header^.data_block_clarifier := nfc$dbc_eoi_bit;
        data_header^.byte_count := send_transfer_progress.remaining_data;
      IFEND;
        data_header^.reserved := 0;
        data_header^.unused_bit_count := 0;
      NEXT send_transfer_progress.current_byte_address: [[REP message_content [2].length OF cell]] IN
            send_transfer_progress.file_byte_address;
      message_content [2].address := send_transfer_progress.current_byte_address;
      qualified_data := FALSE;
      end_of_message := TRUE;
      IF protocol_trace THEN
        STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE: SND Data Block - Size:',
              message_content [2].length);
        pmp$log (trace_message (1,trace_size), ignore_status);
      IFEND;
      nap$se_send_data (send_params.connection_fid, message_content, end_of_message, qualified_data, osc$wait,
            activity_status, local_status);
      IF NOT local_status.normal THEN
        IF (send_params.protocol_version = nfc$p00_b101) AND
              (local_status.condition = nae$data_transfer_timeout) THEN
          RETURN; {----->
        IFEND;
        output_debug_message (' ERROR - SE_send_data - status', local_status);
        process_send_system_error (local_status, status);
        RETURN; {----->
      ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
        IF (send_params.protocol_version = nfc$p00_b101) AND
              (activity_status.status.condition = nae$data_transfer_timeout) THEN
          RETURN; {----->
        IFEND;
        output_debug_message (' ERROR - SE_send_data - activity_status', activity_status.status);
        process_send_system_error (activity_status.status, status);
        RETURN; {----->
      IFEND;
      send_transfer_progress.remaining_data := send_transfer_progress.remaining_data -
            message_content [2].length;
      data_header^.application_block_number := data_header^.application_block_number + 1;
      block_count := block_count + 1;
      IF block_count = event_check_window THEN
        block_count := 0;
        IF send_transfer_progress.remaining_data > 0 THEN
          nap$await_data_available (send_params.connection_fid, 0, 0, local_status);
          IF NOT local_status.normal THEN
            IF local_status.condition = nae$no_data_available THEN
              CYCLE /repeat_send/; {----->
            ELSEIF local_status.condition = nae$connection_terminated THEN
              osp$set_status_abnormal (nfc$status_id, nfe$connection_closed_by_peer, '', status);
              send_params.status := status;
              RETURN; {----->
            ELSE
              output_debug_message (' ERROR - Await_data_available ', local_status);
              process_send_system_error (local_status, status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
            IFEND;
          IFEND;
          RETURN; {----->
        IFEND;
      IFEND;
    WHILEND /repeat_send/;
    send_params.transfer_status.normal := TRUE;

{   Send protocol command ES - end sender data ok.

    send_es_ok (status);
    send_transfer_progress.general_position := transfer_complete;
  PROCEND send_file_blocks;
?? TITLE := 'send_file_label', EJECT ??

{ PURPOSE:  This procedure sends the file label.

  PROCEDURE send_file_label
    (VAR status: ost$status);

    VAR
      activity_status: ost$activity_status,
      contains_data: boolean,
      data_block: ^SEQ ( * ),
      data_block_size: 0 .. 8fffffff(16),
      data_header: ^batch_data_header,
      data_sent: rft$bytes_transferred,
      end_of_message: boolean,
      file_attributes: ^amt$get_attributes,
      file_label: ^SEQ ( * ),
      ignore_status: ost$status,
      label_size: 0 .. 7fffffff(16),
      local_file: boolean,
      local_status: ost$status,
      message_content_nam: array [1 .. 2] of nat$data_fragment,
      message_content_rhfam: array [1 .. 1] of rft$data_fragment,
      old_file: boolean,
      open_position: ^amt$open_position,
      qualified_data: boolean,
      trace_message: string(256),
      trace_size: integer;

    status.normal := TRUE;
    local_status.normal := TRUE;
    PUSH file_attributes: [1 .. 2];
    file_attributes^ [1].key := amc$open_position;
    file_attributes^ [2].key := amc$ring_attributes;
    amp$get_file_attributes (transfer_file, file_attributes^, local_file, old_file, contains_data,
          local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    IF send_params.validation_ring > file_attributes^ [2].ring_attributes.r2 THEN
      amp$set_local_name_abnormal (send_params.file_name, ame$ring_validation_error, amc$open_req, '',
            local_status);
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    srp$fetch_system_label_size (transfer_file, label_size, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    open_position := ^file_attributes^ [1].open_position;
    data_block_size := #SIZE (open_position^) + label_size;
    PUSH data_block: [[REP data_block_size OF cell]];
    RESET data_block;
    NEXT open_position IN data_block;
    NEXT file_label: [[REP label_size OF cell]] IN data_block;
    open_position^ := file_attributes^ [1].open_position;
    srp$fetch_system_label (transfer_file, file_label^, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    end_of_message := TRUE;
    IF  access_method = nfc$am_nam  THEN
      data_header := ^header_buffer;
      data_header^.data_block_clarifier := nfc$dbc_ve_label;
      data_header^.byte_count := data_block_size;
      data_header^.application_block_number := 0;
      data_header^.reserved := 0;
      data_header^.unused_bit_count := 0;
      message_content_nam [1].address := data_header;
      message_content_nam [1].length := data_header_length;
      message_content_nam [2].address := data_block;
      message_content_nam [2].length := data_block_size;
      qualified_data := FALSE;
      send_transfer_progress.general_position := label_in_progress;
      nap$se_send_data (send_params.connection_fid, message_content_nam, end_of_message, qualified_data,
            osc$wait, activity_status, local_status);
    ELSE
      message_content_rhfam [1].address := data_block;
      message_content_rhfam [1].length := data_block_size;
      rfp$send_data (send_params.connection_fid, rfc$record_mode, ^message_content_rhfam, end_of_message,
            osc$wait, activity_status, data_sent, local_status);
    IFEND;
    IF protocol_trace THEN
      STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE: SND File Label - Size:',
            data_block_size);
      pmp$log (trace_message (1,trace_size), ignore_status);
    IFEND;
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
      process_send_system_error (activity_status.status, status);
      RETURN; {----->
    IFEND;
    send_transfer_progress.general_position := label_complete;
  PROCEND send_file_label;
?? TITLE := 'send_ps_command', EJECT ??

{ PURPOSE:  This procedure sends a PS command.

  PROCEDURE send_ps_command
    (    new_line_number: jmt$output_file_position;
         new_byte_position: jmt$output_file_position;
         user_message: ^string ( * );
         preview_message: reposition_preview_message;
     VAR status: ost$status);

    CONST
      file_position_parameter_prefix = '57S',
      ps_command_id = '39',
      user_message_parameter_prefix = '08S';

    VAR
      activity_status: ost$activity_status,
      array_index: 1 .. 9,
      basic_ps_command: ^string ( * ),
      byte_string: ost$string,
      end_of_message: boolean,
      file_position_length: 3 .. 29,
      i: 1 .. 3,
      line_string: ost$string,
      local_status: ost$status,
      max_data_array_index: 1 .. 9,
      message_content_pointer: ^array [1 .. * ] of nat$data_fragment,
      message_length_string: string (3),
      parameter_count: 1 .. 5,
      parameter_count_string: string (2),
      position_length_string: string (3),
      preview_header: array [1 .. 3] of string (6),
      preview_length_string: array [1 .. 3] of string (3),
      qualified_data: boolean,
      string_index: 1 .. 1200,
      user_message_header: string (6),
      user_message_length: 0 .. 999;

    status.normal := TRUE;
    local_status.normal := TRUE;
    clp$convert_integer_to_string (new_line_number - 1, 10, FALSE, line_string, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    clp$convert_integer_to_string (new_byte_position - 1, 10, FALSE, byte_string, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    file_position_length := line_string.size + byte_string.size + 1;
    clp$convert_integer_to_rjstring (file_position_length, 10, FALSE, '0', position_length_string,
          local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    parameter_count := 1;
    max_data_array_index := 1;
    IF user_message <> NIL THEN
      parameter_count := parameter_count + 1;
      max_data_array_index := max_data_array_index + 2;
      user_message_length := STRLENGTH (user_message^);
      clp$convert_integer_to_rjstring (user_message_length, 10, FALSE, '0', message_length_string,
            local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      IFEND;
    ELSE
      user_message_length := 0;
    IFEND;

  /set_preview_lengths/
    FOR i := 1 TO 3 DO
      IF preview_message [i].message <> NIL THEN
        parameter_count := parameter_count + 1;
        max_data_array_index := max_data_array_index + 2;
        clp$convert_integer_to_rjstring (preview_message [i].
              length, 10, FALSE, '0', preview_length_string [i], local_status);
        IF NOT local_status.normal THEN
          process_send_system_error (local_status, status);
          RETURN; {----->
        IFEND;
      ELSE
        EXIT /set_preview_lengths/; {----->
      IFEND;
    FOREND /set_preview_lengths/;
    clp$convert_integer_to_rjstring (parameter_count, 10, FALSE, '0', parameter_count_string, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    IFEND;
    PUSH message_content_pointer: [1 .. max_data_array_index];
    PUSH basic_ps_command: [file_position_length + 10];
    basic_ps_command^ (1, 2) := ps_command_id;
    basic_ps_command^ (3, 2) := parameter_count_string;
    basic_ps_command^ (5, 3) := file_position_parameter_prefix;
    basic_ps_command^ (8, 3) := position_length_string;
    basic_ps_command^ (11, byte_string.size) := byte_string.value (1, byte_string.size);
    string_index := 11 + byte_string.size;
    basic_ps_command^ (string_index, 1) := ',';
    string_index := string_index + 1;
    basic_ps_command^ (string_index, line_string.size) := line_string.value (1, line_string.size);
    string_index := string_index + line_string.size;
    message_content_pointer^ [1].address := basic_ps_command;
    message_content_pointer^ [1].length := string_index - 1;
    array_index := 2;
    IF user_message_length > 0 THEN
      user_message_header (1, 3) := user_message_parameter_prefix;
      user_message_header (4, 3) := message_length_string;
      message_content_pointer^ [array_index].address := ^user_message_header;
      message_content_pointer^ [array_index].length := 6;
      array_index := array_index + 1;
      message_content_pointer^ [array_index].address := user_message;
      message_content_pointer^ [array_index].length := user_message_length;
      array_index := array_index + 1;
    IFEND;

  /prepare_preview_message/
    FOR i := 1 TO 3 DO
      IF preview_message [i].message <> NIL THEN
        preview_header [i] (1, 3) := user_message_parameter_prefix;
        preview_header [i] (4, 3) := preview_length_string [i];
        message_content_pointer^ [array_index].address := ^preview_header [i];
        message_content_pointer^ [array_index].length := 6;
        array_index := array_index + 1;
        message_content_pointer^ [array_index].address := preview_message [i].message;
        message_content_pointer^ [array_index].length := preview_message [i].length;
        array_index := array_index + 1;
      ELSE
        EXIT /prepare_preview_message/; {----->
      IFEND;
    FOREND /prepare_preview_message/;
    qualified_data := TRUE;
    end_of_message := TRUE;
    nap$se_send_data (send_params.connection_fid, message_content_pointer^, end_of_message, qualified_data,
          osc$wait, activity_status, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
    ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
      process_send_system_error (activity_status.status, status);
    IFEND;
    send_transfer_progress.general_position := file_in_progress;
    position_valid := TRUE;
    current_send_state := wait_resume;
  PROCEND send_ps_command;
?? TITLE := 'send_rhf_file_blocks', EJECT ??

{ PURPOSE:  This procedure transfers an RHF-structured file on a
{           record-by-record basis.

  PROCEDURE send_rhf_file_blocks
    (VAR status: ost$status);

    VAR
      activity_status: ost$activity_status,
      byte_address: amt$file_byte_address,
      data_header: ^batch_data_header,
      data_sent: rft$bytes_transferred,
      end_of_message: boolean,
      file_position: amt$file_position,
      ignore_status: ost$status,
      local_status: ost$status,
      message_content_nam: array [1 .. 2] of nat$data_fragment,
      message_content_rhfam: array [1 .. 1] of rft$data_fragment,
      record_area: ^SEQ ( * ),
      record_length: amt$max_record_length,
      rhfam_attributes: ^rft$change_attributes,
      trace_message: string(256),
      trace_size: integer,
      transfer_count: amt$transfer_count;

?? NEWTITLE := '  output_handler', EJECT ??

{ PURPOSE:  This is the condition handler for send_rhf_file_blocks.

    PROCEDURE output_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      activity_status.complete := ((condition.selector =
            pmc$system_conditions) OR (condition.selector =
            jmc$job_resource_condition) OR (condition.selector =
            mmc$segment_access_condition) OR (condition.selector =
            ifc$interactive_condition));
      pmp$continue_to_cause (pmc$execute_standard_procedure, status);

    PROCEND output_handler;
?? OLDTITLE, EJECT ??
{   Begin send_rhf_file_blocks

    status.normal := TRUE;
    local_status.normal := TRUE;
    file_position := amc$boi;
    PUSH record_area: [[REP send_params.block_size OF cell]];

    IF  access_method = nfc$am_nam  THEN
      data_header := ^header_buffer;
      message_content_nam [1].address := data_header;
      message_content_nam [1].length := data_header_length;
      message_content_nam [2].address := record_area;
    ELSE
      PUSH rhfam_attributes: [1 .. 1];
      rhfam_attributes^ [1].key := rfc$send_record_terminator;
      message_content_rhfam [1].address := record_area;
    IFEND;

    osp$establish_condition_handler (^output_handler, FALSE);

  /process_record/
    WHILE file_position <> amc$eoi DO

      amp$get_partial (sender_file_id, record_area, send_params.block_size,
            record_length, transfer_count, byte_address, file_position,
            amc$no_skip, local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      IFEND;

      IF  access_method = nfc$am_nam  THEN

        CASE file_position OF
        = amc$mid_record =
          data_header^.data_block_clarifier := nfc$dbc_no_mark;
        = amc$eor =
          data_header^.data_block_clarifier := nfc$dbc_eor;
        = amc$eop =
          data_header^.data_block_clarifier := nfc$dbc_eof;
        = amc$eoi =
          data_header^.data_block_clarifier := nfc$dbc_eoi_bit;
        ELSE
          pmp$log ('send_rhf_file_blocks CASE', local_status);
          osp$set_status_abnormal (nfc$status_id, nfe$sender_problem_no_retry,
              '', local_status);
          process_send_system_error (local_status, status);
          RETURN; {----->
        CASEND;

        data_header^.byte_count := transfer_count;
        data_header^.reserved := 0;
        data_header^.unused_bit_count := 0;
        message_content_nam [2].length := transfer_count;

        IF protocol_trace THEN
          STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE: SND Data Block - Size:',
                transfer_count);
          pmp$log (trace_message (1,trace_size), ignore_status);
        IFEND;
        nap$se_send_data (send_params.connection_fid, message_content_nam, TRUE, FALSE, osc$wait,
              activity_status, local_status);
        IF NOT local_status.normal THEN
          output_debug_message (' ERROR - SE_send_data - status', local_status);
          process_send_system_error (local_status, status);
          RETURN; {----->
        ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
          output_debug_message (' ERROR - SE_send_data - activity_status', activity_status.status);
          process_send_system_error (activity_status.status, status);
          RETURN; {----->
        IFEND;
        data_header^.application_block_number := data_header^.application_block_number + 1;

{       Check for incoming commands.

        IF file_position <> amc$eoi THEN
          nap$await_data_available (send_params.connection_fid, 0, 0,
                local_status);
          IF local_status.normal THEN
            {  Peer application has sent a command - stop everything
            RETURN; {----->
          ELSE
            IF local_status.condition = nae$no_data_available THEN
              CYCLE /process_record/; {----->
            ELSEIF local_status.condition = nae$connection_terminated THEN
              osp$set_status_abnormal (nfc$status_id,
                    nfe$connection_closed_by_peer, '', status);
              send_params.status := status;
              RETURN; {----->
            ELSE
              output_debug_message (' ERROR - Await_data_available ',
                    local_status);
              process_send_system_error (local_status, status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
            IFEND;
          IFEND;
        IFEND;

      ELSE { access_method = nfc$am_rhfam

        CASE file_position OF
        = amc$mid_record =
          end_of_message := FALSE;
        = amc$eor =
          rhfam_attributes^ [1].send_record_terminator := rfc$rm_eor;
          end_of_message := TRUE;
        = amc$eop =
          rhfam_attributes^ [1].send_record_terminator := rfc$rm_eof;
          end_of_message := TRUE;
        = amc$eoi =
          rhfam_attributes^ [1].send_record_terminator := rfc$rm_eoi;
          end_of_message := TRUE;
        ELSE
          pmp$log ('send_rhf_file_blocks CASE', local_status);
          osp$set_status_abnormal (nfc$status_id, nfe$sender_problem_no_retry, '', local_status);
          process_send_system_error (local_status, status);
          RETURN; {----->
        CASEND;

        IF end_of_message THEN
          rfp$store (send_params.connection_fid, rhfam_attributes^, local_status);
          IF NOT local_status.normal THEN
            output_debug_message (' ERROR - rfp$store', local_status);
            process_send_system_error (local_status, status);
            RETURN; {----->
          IFEND;
        IFEND;

        message_content_rhfam [1].length := transfer_count;

        IF protocol_trace THEN
          STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE: SND Data Block - Size:',
                transfer_count);
          pmp$log (trace_message (1,trace_size), ignore_status);
        IFEND;
        rfp$send_data (send_params.connection_fid, rfc$record_mode, ^message_content_rhfam, end_of_message,
              osc$wait, activity_status, data_sent, local_status);
        IF NOT local_status.normal THEN
          output_debug_message (' ERROR - rfp$send_data - status', local_status);
          process_send_system_error (local_status, status);
          RETURN; {----->
        ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
          output_debug_message (' ERROR - rfp$send_data - activity_status', activity_status.status);
          process_send_system_error (activity_status.status, status);
          RETURN; {----->
        IFEND;

      IFEND;

    WHILEND /process_record/;

    send_params.transfer_status.normal := TRUE;
    send_transfer_progress.general_position := transfer_complete;

{   Send protocol command ES - end sender data ok.

    send_es_ok (status);

  PROCEND send_rhf_file_blocks;
?? TITLE := 'send_sender_command', EJECT ??

{ PURPOSE:  This procedure sends data to the peer application.

  PROCEDURE send_sender_command
    (    command_id: string (2);
         condition_code: string (4);
     VAR status: ost$status);

    CONST
      data_phase_parameter_count = '01',
      data_phase_parameter_prefix = '23S004';

    VAR
      activity_status: ost$activity_status,
      command_block: data_phase_command,
      data_sent: rft$bytes_transferred,
      end_of_message: boolean,
      local_status: ost$status,
      message_content_nam: array [1 .. 1] of nat$data_fragment,
      message_content_rhfam: array [1 .. 1] of rft$data_fragment,
      qualified_data: boolean,
      trace_message: string(256),
      trace_size: integer;

    IF protocol_trace THEN
      STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE:',
            ' SND Command: ', command_id, ', ',
            data_phase_parameter_count, data_phase_parameter_prefix,
            condition_code);
      pmp$log (trace_message (1,trace_size), local_status);
    IFEND;

    status.normal := TRUE;
    local_status.normal := TRUE;
    qualified_data := TRUE;
    end_of_message := TRUE;
    command_block.command_id := command_id;
    command_block.parameter_count := data_phase_parameter_count;
    command_block.parameter_prefix := data_phase_parameter_prefix;
    command_block.condition_code := condition_code;
    IF  access_method = nfc$am_nam  THEN
      message_content_nam [1].address := ^command_block;
      message_content_nam [1].length := command_block_size;
      nap$se_send_data (send_params.connection_fid, message_content_nam, end_of_message, qualified_data,
            osc$wait, activity_status, local_status);
    ELSE
      message_content_rhfam [1].address := ^command_block;
      message_content_rhfam [1].length := command_block_size;
      rfp$send_data (send_params.connection_fid, rfc$message_mode, ^message_content_rhfam, end_of_message,
            osc$wait, activity_status, data_sent, local_status);
    IFEND;
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
    ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
      process_send_system_error (activity_status.status, status);
    IFEND;
  PROCEND send_sender_command;
?? TITLE := 'send_ss', EJECT ??

{ PURPOSE:  This procedure sends an SS command.

  PROCEDURE send_ss
    (VAR status: ost$status);

    VAR
      command_id: string (2),
      condition_code: string (4);

    status.normal := TRUE;
    command_id := ss_command;
    condition_code := ok;
    send_sender_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    IF  nfc$ss_ack_required IN send_params.facilities  THEN
      current_send_state := wait_sendr;
    ELSE
      current_send_state := ss_ack_not_required;
    IFEND;
  PROCEND send_ss;
?? TITLE := '  set_status', EJECT ??

{ PURPOSE:  This procedure sets status in the different places the
{           caller expects to see it.

  PROCEDURE set_status
    (VAR send_params: transfer_params;
     VAR transfer_status: ost$status;
     VAR proc_status: ost$status);

    IF send_params.status.normal THEN
      proc_status.normal := TRUE;
    ELSE
      proc_status := send_params.status;
    IFEND;

    IF send_params.transfer_status.normal THEN
      transfer_status.normal := TRUE;
    ELSE
      transfer_status := send_params.transfer_status;
    IFEND;

  PROCEND set_status;
?? TITLE := 'start_send_file', EJECT ??

{ PURPOSE:  This procedure initializes the send_file process.

  PROCEDURE start_send_file
    (VAR status: ost$status);

    VAR
      access_selections_pointer: ^fst$attachment_options,
      activity_status: ost$activity_status,
      contains_data: boolean,
      data_header: ^batch_data_header,
      data_sent: rft$bytes_transferred,
      end_of_message: boolean,
      ignore_status: ost$status,
      local_file: boolean,
      local_status: ost$status,
      message_content_nam: array [1 .. 2] of nat$data_fragment,
      message_content_rhfam: array [1 .. 1] of rft$data_fragment,
      old_file: boolean,
      override_attributes: ^fst$file_cycle_attributes,
      qualified_data: boolean,
      segment_cell: amt$segment_pointer,
      segment_pointer: amt$segment_pointer,
      trace_message: string(256),
      trace_size: integer;

    status.normal := TRUE;
    IF (send_params.protocol_version = nfc$p00_b101) OR
       (send_params.transfer_mode = nfc$rhf_structured_mode) THEN
      RETURN; {----->
    IFEND;

    local_status.normal := TRUE;

    IF NOT queue_file THEN
      IF sender_file_id <> amv$nil_file_identifier THEN
        fsp$close_file (sender_file_id, local_status);
        IF NOT local_status.normal THEN
          process_send_system_error (local_status, status);
          RETURN; {----->
        IFEND;
        sender_file_id := amv$nil_file_identifier;
        #SPOIL (sender_file_id);
      IFEND;
      PUSH override_attributes: [1 .. 3];
      override_attributes^ [1].selector := fsc$record_type;
      override_attributes^ [1].record_type := amc$undefined;
      override_attributes^ [2].selector := fsc$block_type;
      override_attributes^ [2].block_type := amc$system_specified;
      override_attributes^ [3].selector := fsc$file_organization;
      override_attributes^ [3].file_organization := amc$sequential;

      PUSH access_selections_pointer: [1 .. 1];
      access_selections_pointer^ [1].selector := fsc$access_and_share_modes;
      access_selections_pointer^ [1].access_modes.selector := fsc$specific_access_modes;
      access_selections_pointer^ [1].access_modes.value := $fst$file_access_options [fsc$read];
      access_selections_pointer^ [1].share_modes.selector := fsc$determine_from_access_modes;

      fsp$open_file (transfer_file, amc$segment, access_selections_pointer, NIL, NIL, NIL,
            override_attributes, sender_file_id, local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      IFEND;
    IFEND;

    amp$get_segment_pointer (sender_file_id, amc$sequence_pointer, segment_pointer, local_status);
    IF NOT local_status.normal THEN
      process_send_system_error (local_status, status);
      RETURN; {----->
    ELSE
      amp$get_segment_pointer (sender_file_id, amc$cell_pointer, segment_cell, local_status);
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      ELSE
        mmp$set_access_selections (segment_cell.cell_pointer, mmc$as_sequential, local_status);
        IF NOT local_status.normal THEN
          process_send_system_error (local_status, status);
          RETURN; {----->
        IFEND;
      IFEND;
    IFEND;
    transfer_file_size := #SIZE (segment_pointer.sequence_pointer^);
    send_transfer_progress.remaining_data := transfer_file_size;
    send_transfer_progress.general_position := file_in_progress;

    IF  access_method = nfc$am_nam  THEN
      data_header := ^header_buffer;
      IF send_params.block_size = 99999999 THEN
        data_header^.data_block_clarifier := nfc$dbc_eoi_bit;
        data_header^.byte_count := 0;
        data_header^.application_block_number := 0;
        data_header^.reserved := 0;
        data_header^.unused_bit_count := 0;
        message_content_nam [1].address := data_header;
        message_content_nam [1].length := data_header_length;
        message_content_nam [2].address := segment_pointer.sequence_pointer;
        message_content_nam [2].length := send_transfer_progress.remaining_data;
        end_of_message := TRUE;
        qualified_data := FALSE;
        nap$se_send_data (send_params.connection_fid, message_content_nam, end_of_message, qualified_data,
              osc$wait, activity_status, local_status);
      IFEND;
    ELSE
      end_of_message := TRUE;
      message_content_rhfam [1].address := segment_pointer.sequence_pointer;
      message_content_rhfam [1].length := send_transfer_progress.remaining_data;
      rfp$send_data (send_params.connection_fid, rfc$record_mode, ^message_content_rhfam, end_of_message,
            osc$wait, activity_status, data_sent, local_status);
    IFEND;
    IF  (access_method = nfc$am_rhfam)  OR (send_params.block_size = 99999999) THEN
      IF protocol_trace THEN
        STRINGREP (trace_message, trace_size, '**** NFM$RHF_SEND_FILE: SND Data Block - Size:',
              send_transfer_progress.remaining_data);
        pmp$log (trace_message (1,trace_size), ignore_status);
      IFEND;
      IF NOT local_status.normal THEN
        process_send_system_error (local_status, status);
        RETURN; {----->
      ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
        process_send_system_error (activity_status.status, status);
        RETURN; {----->
      IFEND;
      send_transfer_progress.general_position := transfer_complete;
      send_params.transfer_status.normal := TRUE;

{     Send protocol command ES - end sender data ok.

      send_es_ok (status);
    ELSE
      data_header^.application_block_number := 0;
      send_transfer_progress.file_byte_address := segment_pointer.sequence_pointer;
      RESET send_transfer_progress.file_byte_address;
    IFEND;
  PROCEND start_send_file;
?? OLDTITLE ??
MODEND nfm$rhf_send_file;
