?? RIGHT := 110 ??
?? NEWTITLE := 'NFM$RHF_RECEIVE_FILE' ??
MODULE nfm$rhf_receive_file;

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

?? NEWTITLE := 'GLOBAL DECLARATIONS REFERENCED', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$segment_pointer
*copyc fmt$file_label
*copyc fmt$static_label_header
*copyc ife$error_codes
*copyc nae$application_interfaces
*copyc nfd$transfer_declarations
*copyc nfe$batch_transfer_services
*copyc nfe$fts_condition_codes
*copyc nft$network_type
*copyc nft$parameter_00_values
*copyc nft$transfer_declarations
*copyc nft$transfer_modes
*copyc osd$virtual_address
*copyc pft$checksum
*copyc rfe$condition_codes
?? pop ??
*copyc amp$change_file_attributes
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$put_partial
*copyc amp$return
*copyc amp$set_local_name_abnormal
*copyc amp$set_segment_eoi
*copyc amp$write_end_partition
*copyc fsp$close_file
*copyc fsp$copy_file
*copyc fsp$open_and_get_type_of_copy
*copyc fsp$open_file
*copyc mmp$set_access_selections
*copyc nap$await_data_available
*copyc nap$display_message
*copyc nap$se_receive_data
*copyc nap$se_send_data
*copyc nfp$ptf_format_message_to_out
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*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$compute_label_checksum
*copyc srp$store_system_label

*copyc amv$nil_file_identifier
*copyc fsv$copf_input_file_attachment
*copyc fsv$copf_output_file_attachment
?? TITLE := 'GLOBAL DECLARATIONS DECLARED', EJECT ??

  TYPE
    command_buffer_1 = record
      command_id: string (2),
      parameter_count: string (2),
      parameter_id: string (2),
    recend,
    command_buffer_2 = record
      parameter_qualifier: string (1),
      parameter_length: string (3),
      condition_code: string (4),
    recend,
    lcn_command_area = SEQ (REP command_area_length + param_area_length of
          cell),
    level_seven_command = record
      command_area: SEQ (REP command_area_length of cell),
      param_area: SEQ (REP param_area_length of cell),
    recend,
    receiver_input_commands = (ss, ms, es),
    receiver_input_data_area = array [1 .. 2] of ^SEQ ( * ),
    receiver_states = (wait_start, restart_wait, sendr_pend, receive_data,
          end_ok_received, end_err_received, quit_ok_sent, quit_err_sent,
          wait_holdr, resume_pend, exit_receive);

  CONST
    command_area_length = 6,
    param_area_length = 64;

  VAR
    access_method: (nfc$am_nam, nfc$am_rhfam) := nfc$am_nam,
    active_receive_error_code: char,
    command: level_seven_command,
    command_area: SEQ (REP command_area_length of cell),
    copy_required: boolean,
    current_receive_state: receiver_states,
    label_buffer: ^SEQ (REP max_label_size of cell),
    lcn_command: lcn_command_area,
    param_area: SEQ (REP param_area_length of cell),
    processing_error: boolean,
    protocol_trace: boolean,
    queue_file: boolean := FALSE,
    receive_params: transfer_params,
    receive_transfer_progress: transfer_progress,
    receiver_file: amt$local_file_name,
    receiver_file_id: amt$file_identifier,
    receiver_file_open: boolean,
    start_of_rhf_struct_record: boolean,
    transfer_file_size: amt$file_length,
    working_storage: ^SEQ ( * );
?? TITLE := '[XDCL] nfp$receive_file', EJECT ??
*copyc nfh$receive_file

  PROCEDURE [XDCL] nfp$receive_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
      ignore_status: ost$status,
      local_status: ost$status,
      receive_condition_descriptor: ^pmt$established_handler,
      receive_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]],
      rhfam_attributes: ^rft$change_attributes,
      save_rhfam_attrs: ^rft$get_attributes;
?? NEWTITLE := '  receive_condition_handler', EJECT ??

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

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

      VAR
        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_receive_system_error(local_status, processing_error, receive_params, 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_receive_system_error(local_status, processing_error, receive_params, ignore_status);
          RETURN;
        IFEND;
      IFEND;

      IF receiver_file_open THEN
        fsp$close_file (receiver_file_id, ignore_status);
      IFEND;
      IF copy_required THEN
        amp$return (receiver_file, ignore_status);
      IFEND;

      IF condition.selector = pmc$block_exit_processing THEN
        IF (NOT processing_error) AND (current_receive_state <> end_ok_received) AND
              (current_receive_state <> end_err_received) AND (current_receive_state <> quit_ok_sent) AND
              (current_receive_state <> quit_err_sent) AND (current_receive_state <> exit_receive) THEN

{ local_status is used to pass a NORMAL status to PROCESS_RECEIVE_SYSTEM_ERROR

          local_status.normal := TRUE;
          process_receive_system_error (local_status, processing_error, receive_params, ignore_status);
          receive_connection_event (connection_fid, block_size, TRUE, ignore_status);
          pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        IFEND;
      ELSE
        protocol_state_consistent := FALSE;
        pmp$continue_to_cause (pmc$execute_standard_procedure, status);
      IFEND;

    PROCEND receive_condition_handler;
?? OLDTITLE, EJECT ??
{   BEGIN nfp$receive_file

    status.normal := TRUE;
    copy_required := FALSE;
    local_status.normal := TRUE;
    processing_error := FALSE;
    protocol_state_consistent := TRUE;
    receiver_file_open := FALSE;
    start_of_rhf_struct_record := TRUE;
    transfer_file_size := 0;
    #SPOIL (copy_required, receiver_file_open);

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

      CASE transfer_mode OF
      = nfc$ve_to_ve_mode =
        pmp$log ('**** NFM$RHF_RECEIVE_FILE: Transfer mode is VE to VE.', status);
      = nfc$coded_data_mode =
        pmp$log ('**** NFM$RHF_RECEIVE_FILE: Transfer mode is CODED.', status);
      = nfc$transparent_data_mode =
        pmp$log ('**** NFM$RHF_RECEIVE_FILE: Transfer mode is TRANSPARENT.', status);
      = nfc$rhf_structured_mode =
        pmp$log ('**** NFM$RHF_RECEIVE_FILE: Transfer mode is RHF STRUCTURED.', status);
      ELSE
      CASEND;
      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$incoming_record_abn;
        save_rhfam_attrs^ [3].key := rfc$data_transfer_timeout;
        save_rhfam_attrs^ [4].key := rfc$receive_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
          receive_params.block_size := rfc$max_block_size;
        ELSE
          receive_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 := receive_params.block_size;
        rhfam_attributes^ [2].key := rfc$incoming_record_abn;
        rhfam_attributes^ [2].incoming_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;
      receive_params.block_size := block_size;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$bts_internal_error, 'nfp$receive_file network case',
            status);
      RETURN; {----->
    CASEND;

    receive_params.connection_fid := connection_fid;
    receive_params.file_name := file_name;
    receive_params.facilities := facilities;
    receive_params.transfer_mode := transfer_mode;
    receive_params.min_timeout := min_timeout;
    receive_params.validation_ring := validation_ring;
    receive_params.status.normal := TRUE;
    receive_params.transfer_status.normal := TRUE;
    receive_transfer_progress.general_position := not_started;
    current_receive_state := wait_start;
    #SPOIL (current_receive_state);

    ALLOCATE label_buffer;

    PUSH receive_condition_descriptor;
    pmp$establish_condition_handler (receive_conditions,
          ^receive_condition_handler, receive_condition_descriptor, status);
    IF NOT status.normal THEN
      pmp$log ('unable to allocate label buffer', local_status);
      osp$set_status_abnormal ('NF', nfe$receiver_problem_no_retry,
            '', local_status);
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

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

    set_status (receive_params, transfer_status, status);

    file_size := transfer_file_size;

{   Reset LCN particulars.

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

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

?? EJECT ??

  PROCEDURE [XDCL] nfp$receive_queue_file
    (    connection_fid: amt$file_identifier;
         queue_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;
         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
      dummy_pointer: ^cell,
      validation_ring: ost$ring;

    status.normal := TRUE;
    queue_file := TRUE;
    dummy_pointer := ^dummy_pointer;
    validation_ring := #ring(dummy_pointer);

    nfp$receive_file (connection_fid, queue_file_name, facilities,
          transfer_mode, block_size, min_timeout, protocol_version,
          network_type, validation_ring, activate_protocol_trace, file_size,
          protocol_state_consistent, transfer_status, status);

    queue_file := FALSE;

  PROCEND nfp$receive_queue_file;

?? TITLE := 'process_receive_protocol_error', EJECT ??

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

  PROCEDURE process_receive_protocol_error
    (VAR processing_error: boolean;
     VAR receive_params: transfer_params;
     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, '',
          receive_params.status);
    osp$set_status_abnormal ('NF', nfe$protocol_anomaly,
          '', receive_params.transfer_status);

{   Send protocol command QR - quit transfer / error.

    send_qr_err (receive_detected_prot_err, status);

  PROCEND process_receive_protocol_error;
?? TITLE := 'process_receive_system_error', EJECT ??

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

  PROCEDURE process_receive_system_error
    (    local_status: ost$status;
     VAR processing_error: boolean;
     VAR receive_params: transfer_params;
     VAR status: ost$status);

    status.normal := TRUE;
    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
      receive_params.status.normal := TRUE;
    ELSE
      receive_params.status := local_status;
    IFEND;
    osp$set_status_abnormal ('NF', nfe$terminate_transfer_message,
          '', receive_params.transfer_status);

{   Send protocol command QR - quit transfer / error.

    send_qr_err (receive_err_no_retry, status);

  PROCEND process_receive_system_error;
?? TITLE := 'process_receiver_input', EJECT ??

{ PURPOSE:  This procedure processes receiver commands.

  PROCEDURE process_receiver_input
    (    peer_operation: nat$se_peer_operation;
     VAR data_area: receiver_input_data_area;
     VAR status: ost$status);

    CONST
      unique_char = 'A';

    VAR
      attachment_options: ^fst$attachment_options,
      byte_address: amt$file_byte_address,
      command: ^command_buffer_1,
      command_buffer: ^SEQ (REP command_area_length of cell),
      contains_data: boolean,
      control_info: fst$copy_control_information,
      convert_receiver_command: [STATIC, READ] array
            [receiver_input_commands] of string (2) :=
            [ss_command, ms_command, es_command],
      create_file: boolean,
      get_attributes_pointer: ^amt$get_attributes,
      id: receiver_input_commands,
      ignore_status: ost$status,
      input_fid: amt$file_identifier,
      lcn_command_buffer: ^lcn_command_area,
      local_file: boolean,
      local_status: ost$status,
      no_find: boolean,
      old_file: boolean,
      output_fid: amt$file_identifier,
      param: ^command_buffer_2,
      param_buffer: ^SEQ (REP param_area_length of cell),
      rhfam_attributes: ^rft$change_attributes,
      segment_cell: amt$segment_pointer,
      segment_pointer: amt$segment_pointer,
      trace_message: string(256),
      trace_size: integer,
      transfer_file_attributes: ^fst$file_cycle_attributes,
      unique_data: char,
      unique_fid: amt$file_identifier,
      unique_name: ost$name;

    local_status.normal := TRUE;
    status.normal := TRUE;
?? EJECT ??
{   Process data blocks

    IF NOT peer_operation.qualified_data THEN
      IF (current_receive_state = receive_data) OR
         (current_receive_state = wait_holdr) THEN

        IF (receive_transfer_progress.general_position = not_started) AND
           (receive_params.transfer_mode = nfc$ve_to_ve_mode) THEN

{         Process VE label

          IF queue_file THEN
            receive_queue_file_label (peer_operation, data_area, status);
          ELSE
            receive_file_label (peer_operation, data_area, status);
          IFEND;
        ELSEIF receive_transfer_progress.general_position <
              transfer_complete THEN

{         Process all other data blocks

          IF receive_params.transfer_mode <> nfc$rhf_structured_mode THEN
            receive_file_block (peer_operation, data_area, status);
          ELSE
            receive_rhf_file_block (peer_operation, data_area, status);
          IFEND;
        ELSE

 {        Error: Data has been received after the transfer was complete

          process_receive_protocol_error (processing_error, receive_params, status);
        IFEND;

      ELSEIF current_receive_state = quit_err_sent THEN

{          Ignore data received after a QR(err) has been sent

      ELSE

{       Data has been received at an unexpected time

        process_receive_protocol_error (processing_error, receive_params, status);
      IFEND;

      RETURN; {----->

    IFEND;
?? EJECT ??
{   Process command blocks

    IF  access_method = nfc$am_nam  THEN
      command_buffer := data_area [1];
      param_buffer := data_area [2];
      RESET param_buffer;
      NEXT param IN param_buffer;
      RESET command_buffer;
      NEXT command IN command_buffer;
    ELSE
      lcn_command_buffer := data_area [1];
      RESET lcn_command_buffer;
      NEXT command IN lcn_command_buffer;
      NEXT param IN lcn_command_buffer;
    IFEND;
    no_find := TRUE;

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

  /determine_id/
    FOR id := ss TO es DO
      IF command^.command_id = convert_receiver_command [id] THEN
        no_find := FALSE;
        EXIT /determine_id/; {----->
      IFEND;
    FOREND /determine_id/;
    IF no_find THEN
      process_receive_protocol_error (processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    CASE id OF
?? EJECT ??
{   SS command - Start of data

    = ss =
      PUSH get_attributes_pointer: [1 .. 1];
      get_attributes_pointer^ [1].key := amc$ring_attributes;
      amp$get_file_attributes (receive_params.file_name,
            get_attributes_pointer^, local_file, old_file, contains_data,
            local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      IF (local_file OR old_file) THEN
        IF receive_params.validation_ring >
              get_attributes_pointer^ [1].ring_attributes.r1 THEN
          amp$set_local_name_abnormal (receive_params.file_name,
                ame$ring_validation_error, amc$open_req, '', local_status);
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        IFEND;
      IFEND;
      CASE receive_params.transfer_mode OF

      = nfc$ve_to_ve_mode =
        current_receive_state := sendr_pend;
        #SPOIL (current_receive_state);

{       Send protocol command SR - start of data acknowledge.

        send_sr (status);
        IF  access_method = nfc$am_nam  THEN
          data_area [2] := label_buffer;
        ELSE
          data_area [1] := label_buffer;
        IFEND;
        RETURN; {----->

      = nfc$coded_data_mode =
        create_file := TRUE;
        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 :=
              receive_params.validation_ring;
        transfer_file_attributes^ [2].ring_attributes.r2 :=
              receive_params.validation_ring;
        transfer_file_attributes^ [2].ring_attributes.r3 :=
              receive_params.validation_ring;
        transfer_file_attributes^ [3].selector :=
              fsc$record_delimiting_character;
        transfer_file_attributes^ [3].record_delimiting_character :=
              $CHAR (1f(16)); { US character }
        IF local_file OR old_file THEN

          {  This is a kludge, which is required because file management does
          {  not allow inquiries about the t-type record delimiter.

          pmp$get_unique_name (unique_name, local_status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
          fsp$open_file (unique_name, amc$record, NIL,
                transfer_file_attributes, NIL, NIL, NIL, unique_fid,
                local_status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
          unique_data := unique_char;
          amp$put_next (unique_fid, ^unique_data, 1, byte_address,
                local_status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
          fsp$close_file (unique_fid, local_status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
          fsp$open_and_get_type_of_copy (unique_name,
                receive_params.file_name, ^fsv$copf_input_file_attachment, ^fsv$copf_output_file_attachment,
                NIL, NIL, NIL, input_fid, output_fid, control_info, local_status);
          create_file := FALSE;
          IF input_fid <> amv$nil_file_identifier THEN
            fsp$close_file (input_fid, ignore_status);
          IFEND;
          IF output_fid <> amv$nil_file_identifier THEN
            fsp$close_file (output_fid, ignore_status);
          IFEND;
          IF  NOT local_status.normal  THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
          IF  control_info.type_of_copy = fsc$byte_move  THEN
            receiver_file := receive_params.file_name;
            copy_required := FALSE;
          ELSE
            receiver_file := unique_name;
            copy_required := TRUE;
          IFEND;
        ELSE
          receiver_file := receive_params.file_name;
          copy_required := FALSE;
        IFEND;
        #SPOIL (copy_required);

      = nfc$transparent_data_mode =
        create_file := TRUE;
        IF NOT (local_file OR old_file) THEN
          PUSH transfer_file_attributes: [1 .. 2];
          transfer_file_attributes^ [1].selector := fsc$record_type;
          transfer_file_attributes^ [1].record_type := amc$undefined;
          transfer_file_attributes^ [2].selector := fsc$ring_attributes;
          transfer_file_attributes^ [2].ring_attributes.r1 :=
                receive_params.validation_ring;
          transfer_file_attributes^ [2].ring_attributes.r2 :=
                receive_params.validation_ring;
          transfer_file_attributes^ [2].ring_attributes.r3 :=
                receive_params.validation_ring;
        ELSE
          transfer_file_attributes := NIL;
        IFEND;
        receiver_file := receive_params.file_name;
        copy_required := FALSE;
        #SPOIL (copy_required);

      = nfc$rhf_structured_mode =
        PUSH transfer_file_attributes: [1 .. 1];
        transfer_file_attributes^ [1].selector := fsc$record_type;
        transfer_file_attributes^ [1].record_type := amc$variable;
        receiver_file := receive_params.file_name;
        fsp$open_file (receiver_file, amc$record, NIL,
              transfer_file_attributes, NIL, NIL, NIL, receiver_file_id,
              local_status);
        IF NOT local_status.normal THEN
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        IFEND;
        receiver_file_open := TRUE;
        copy_required := FALSE;
        #SPOIL (receiver_file_open, copy_required);
        ALLOCATE working_storage: [[REP receive_params.block_size of cell]];
        IF working_storage = NIL THEN
          osp$set_status_abnormal ('NF', nfe$receiver_problem_no_retry,
                '', local_status);
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        IFEND;
        IF  access_method = nfc$am_nam  THEN
          data_area [2] := working_storage;
        ELSE
          data_area [1] := working_storage;
          PUSH rhfam_attributes: [1 .. 1];
          rhfam_attributes^ [1].key := rfc$receive_record_terminator;
          rhfam_attributes^ [1].receive_record_terminator := rfc$rm_eor;
          rfp$store (receive_params.connection_fid, rhfam_attributes^, status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
        IFEND;
        current_receive_state := sendr_pend;
        #SPOIL (current_receive_state);

{       Send protocol command SR - start of data acknowledge.

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

      ELSE

        pmp$log ('process_receiver_input xfer mode CASE error', local_status);
        osp$set_status_abnormal ('NF', nfe$receiver_problem_no_retry,
              '', local_status);
        process_receive_system_error (local_status, processing_error, receive_params, status);
      CASEND;

      PUSH  attachment_options: [1 .. 2];
      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, fsc$shorten, fsc$append];
      attachment_options^ [1].share_modes.selector := fsc$required_share_modes;
      attachment_options^ [2].selector := fsc$create_file;
      attachment_options^ [2].create_file := create_file;
      fsp$open_file (receiver_file, amc$segment, attachment_options,
            transfer_file_attributes, NIL, NIL, NIL, receiver_file_id,
            local_status);
      IF NOT local_status.normal THEN
        IF local_status.condition = pfe$usage_not_permitted THEN
          attachment_options^ [1].access_modes.value :=
                $fst$file_access_options [fsc$shorten, fsc$append];
          fsp$open_file (receiver_file, amc$segment, attachment_options,
                transfer_file_attributes, NIL, NIL, NIL, receiver_file_id,
                local_status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error, receive_params, status);
            RETURN; {----->
          IFEND;
        ELSE
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        IFEND;
      IFEND;
      receiver_file_open := TRUE;
      #SPOIL (receiver_file_open);
      amp$get_segment_pointer (receiver_file_id, amc$sequence_pointer,
            segment_pointer, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      amp$get_segment_pointer (receiver_file_id, amc$cell_pointer,
            segment_cell, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      mmp$set_access_selections (segment_cell.cell_pointer, mmc$as_sequential,
            local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      receive_transfer_progress.file_byte_address :=
            segment_pointer.sequence_pointer;
      receive_transfer_progress.current_byte_address :=
            segment_pointer.sequence_pointer;
      RESET receive_transfer_progress.current_byte_address;
      IF  access_method = nfc$am_nam  THEN
        data_area [2] := receive_transfer_progress.current_byte_address;
      ELSE
        data_area [1] := receive_transfer_progress.current_byte_address;
      IFEND;
      current_receive_state := sendr_pend;
      #SPOIL (current_receive_state);

{     Send protocol command SR - start of data acknowledge.

      send_sr (status);
?? EJECT ??
{   ES command - End of data

    = es =
      IF param^.condition_code (3, 1) = ok_condition THEN

        IF current_receive_state = receive_data THEN
          current_receive_state := end_ok_received;
          #SPOIL (current_receive_state);

{ Get transfer file size

          PUSH get_attributes_pointer: [1 .. 1];
          get_attributes_pointer^ [1].key := amc$file_length;
          amp$get_file_attributes (receiver_file, get_attributes_pointer^,
                local_file, old_file, contains_data, local_status);
          IF NOT local_status.normal THEN
            process_receive_system_error (local_status, processing_error,
                receive_params, status);
            RETURN; {----->
          IFEND;
          transfer_file_size := get_attributes_pointer^ [1].file_length;

          IF copy_required THEN
            fsp$copy_file (receiver_file, receive_params.file_name, NIL, NIL,
                  NIL, local_status);
            IF NOT local_status.normal THEN
              process_receive_system_error (local_status, processing_error, receive_params, status);
              RETURN; {----->
            IFEND;
          IFEND;
          IF receiver_file_open THEN
            fsp$close_file (receiver_file_id, status);
            IF NOT local_status.normal THEN
              process_receive_system_error (local_status, processing_error, receive_params, status);
              RETURN; {----->
            IFEND;
            receiver_file_open := FALSE;
            #SPOIL (receiver_file_open);
          IFEND;

{         Send protocol command ER - end of data acknowledge / ok.

          send_er_ok (status);
        ELSEIF current_receive_state = quit_ok_sent THEN
          current_receive_state := end_ok_received;
          #SPOIL (current_receive_state);

{         Send protocol command ER - end of data acknowledge / ok.

          send_er_ok (status);
        ELSEIF current_receive_state = wait_start THEN
          process_receive_protocol_error (processing_error, receive_params, status);
        IFEND;

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

        process_receive_protocol_error (processing_error, receive_params, status);

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

        IF current_receive_state = quit_err_sent THEN
          IF active_receive_error_code > param^.condition_code (4) THEN
            RETURN; {----->
          IFEND;
        ELSE
        osp$set_status_abnormal ('NF', nfe$transfer_rejected_message,
              '', receive_params.transfer_status);
        IFEND;
        active_receive_error_code := param^.condition_code (4);
        current_receive_state := end_err_received;
        #SPOIL (current_receive_state);

{       Send protocol command ER - end of data acknowledge / error.

        send_er_err (status);

      ELSE

        process_receive_protocol_error (processing_error, receive_params, status);

      IFEND;

    ELSE

{     Unknown command received

      process_receive_protocol_error (processing_error, receive_params, status);

    CASEND;

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

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

  PROCEDURE receive_connection_event
    (    connection_fid: amt$file_identifier;
         block_size: nft$block_size;
         called_from_condition_handler: boolean;
     VAR status: ost$status);

    TYPE
      abort_buffer_type = record
        command_area: SEQ (REP command_area_length of cell),
        param_area_ptr: ^SEQ (*),
      recend;

    VAR
      abort_buffer: abort_buffer_type,
      abort_buffer_descriptor_nam: array [1 .. 1] of nat$data_fragment,
      activity_status: ost$activity_status,
      buffer_descriptor_nam: array [1 .. 2] of nat$data_fragment,
      buffer_descriptor_rhfam: array [1 .. 1] of rft$data_fragment,
      bytes_transferred: rft$bytes_transferred,
      data_area: receiver_input_data_area,
      ignore_status: ost$status,
      local_status: ost$status,
      peer_operation: nat$se_peer_operation,
      rhfam_xfer_mode: rft$transmission_modes,
      trace_data_block_size: integer,
      trace_message: string(256),
      trace_size: integer;

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

    IF access_method = nfc$am_rhfam THEN
      IF called_from_condition_handler THEN
        PUSH abort_buffer.param_area_ptr : [[REP (block_size * 10) of cell]];
        buffer_descriptor_rhfam [1].address := abort_buffer.param_area_ptr;
        buffer_descriptor_rhfam [1].length := block_size * 10;
        data_area [1] := abort_buffer.param_area_ptr;
      ELSE
        buffer_descriptor_rhfam [1].address := ^lcn_command;
        buffer_descriptor_rhfam [1].length := command_block_size;
        data_area [1] := ^lcn_command;
      IFEND;
    ELSE
      IF called_from_condition_handler THEN
        PUSH abort_buffer.param_area_ptr : [[REP (block_size + data_header_length + 1) of cell]];
        buffer_descriptor_nam [1].address := ^abort_buffer.command_area;
        buffer_descriptor_nam [1].length := command_area_length;
        buffer_descriptor_nam [2].address := abort_buffer.param_area_ptr;
        buffer_descriptor_nam [2].length := block_size + data_header_length + 1;
        data_area [1] := ^abort_buffer.command_area;
        data_area [2] := abort_buffer.param_area_ptr;
      ELSE
        buffer_descriptor_nam [1].address := ^command.command_area;
        buffer_descriptor_nam [1].length := command_area_length;
        buffer_descriptor_nam [2].address := ^command.param_area;
        buffer_descriptor_nam [2].length := param_area_length;
        data_area [1] := ^command.command_area;
        data_area [2] := ^command.param_area;
      IFEND;
    IFEND;

  /receive_event/
    WHILE current_receive_state <> exit_receive DO
      IF  access_method = nfc$am_nam  THEN
        nap$await_data_available (receive_params.connection_fid, initial_wait_time, 0, local_status);
        IF (NOT local_status.normal) AND (local_status.condition =  nae$multiple_waits_attempted) THEN

{ In a previous execution of this procedure, NAP$AWAIT_DATA was called and a condition handler took
{ control to process a condition before NAP$SE_RECEIVE_DATA was called. The condition handler then called
{ this routine and NAP$AWAIT_DATA_AVAILABLE was called again. Mask the abnormal status and continue.

          local_status.normal := called_from_condition_handler;
        IFEND;
        IF (NOT local_status.normal) AND (local_status.condition = nae$no_data_available)  THEN
          nap$await_data_available (receive_params.connection_fid, (receive_params.min_timeout * 1000 -
                 initial_wait_time), 0, local_status);
        IFEND;
      ELSE
        rfp$await_rhfam_event (receive_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 (receive_params.connection_fid, rfc$input_available,
                (receive_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);
          receive_params.status := status;
          RETURN; {----->
        ELSEIF (local_status.condition = nae$no_data_available)  OR
              (local_status.condition = rfe$no_available_event)  THEN
          osp$set_status_abnormal ('NF', nfe$application_timeout, '', status);
          osp$set_status_abnormal ('NF', nfe$application_time_out, '', receive_params.transfer_status);
          receive_params.status := status;
          RETURN; {----->
        ELSE
          process_receive_system_error (local_status, processing_error, receive_params, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          CYCLE /receive_event/; {----->
        IFEND;
      IFEND;

      IF  access_method = nfc$am_nam  THEN
        nap$se_receive_data (connection_fid, buffer_descriptor_nam, osc$wait, peer_operation,
              activity_status, local_status);
      ELSE
        peer_operation.kind := nac$se_send_data;
        IF  (current_receive_state = receive_data) OR (current_receive_state = quit_err_sent) OR
              (current_receive_state = wait_holdr) THEN
          rhfam_xfer_mode := rfc$record_mode;
        ELSE
          rhfam_xfer_mode := rfc$message_mode;
        IFEND;
        peer_operation.qualified_data := rhfam_xfer_mode = rfc$message_mode;
        rfp$receive_data (connection_fid, rhfam_xfer_mode, ^buffer_descriptor_rhfam, osc$wait,
              activity_status, bytes_transferred, peer_operation.end_of_message, local_status);
        IF ((NOT local_status.normal) AND (local_status.condition = rfe$receive_mode_conflict)) OR
              (activity_status.complete AND (NOT activity_status.status.normal) AND
              (activity_status.status.condition = rfe$receive_mode_conflict)) THEN
          IF  (bytes_transferred = 0)  THEN

            {  If the block type does not match try the other mode.

            IF  rhfam_xfer_mode = rfc$message_mode  THEN
              rhfam_xfer_mode := rfc$record_mode;
            ELSE
              rhfam_xfer_mode := rfc$message_mode;
            IFEND;
            peer_operation.qualified_data := rhfam_xfer_mode = rfc$message_mode;
            rfp$receive_data (connection_fid, rhfam_xfer_mode, ^buffer_descriptor_rhfam, osc$wait,
                  activity_status, bytes_transferred, peer_operation.end_of_message, local_status);
            IF ((NOT local_status.normal) AND (local_status.condition = rfe$receive_mode_conflict)) OR
                  (activity_status.complete AND (NOT activity_status.status.normal) AND
                  (activity_status.status.condition = rfe$receive_mode_conflict)) AND
                  (bytes_transferred <> 0) THEN

              {  If data was received before the block change then ignore the error.

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

            {  If data was received before the block change then ignore the error.

            local_status.normal := TRUE;
            activity_status.status.normal := TRUE;
          IFEND;
        IFEND;
        peer_operation.data_length := bytes_transferred;
      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);
          receive_params.status := 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);
          receive_params.status := status;
          RETURN; {----->
        ELSEIF  local_status.condition <> nae$receive_outstanding  THEN
          process_receive_system_error (local_status, processing_error, receive_params, 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);
          receive_params.status := 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);
          receive_params.status := status;
          RETURN; {----->
        ELSEIF  activity_status.status.condition <> nae$receive_outstanding  THEN
          process_receive_system_error (activity_status.status, processing_error, receive_params, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          CYCLE /receive_event/; {----->
        IFEND;
      IFEND;

      IF protocol_trace AND (NOT peer_operation.qualified_data) THEN
        IF access_method = nfc$am_nam THEN
          trace_data_block_size := peer_operation.data_length - data_header_length;
        ELSE
          trace_data_block_size := peer_operation.data_length;
        IFEND;
        STRINGREP (trace_message, trace_size, '**** NFM$RHF_RECEIVE_FILE: RCV Data Block - Size:',
              trace_data_block_size);
        pmp$log (trace_message (1, trace_size), ignore_status);
      IFEND;

      IF peer_operation.kind <> nac$se_send_data THEN
        osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error, '', status);
        receive_params.status := status;
        RETURN; {----->
      IFEND;

      IF (access_method = nfc$am_nam) AND
            (peer_operation.data_length > (block_size + data_header_length)) THEN
        pmp$log ('Peer sent block larger than negotiated.', ignore_status);
        osp$set_status_abnormal (nfc$status_id, nfe$application_protocol_error,
              '', status);
        RETURN; {----->
      IFEND;

      process_receiver_input (peer_operation, data_area, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF NOT called_from_condition_handler THEN
        IF  access_method = nfc$am_nam  THEN
          buffer_descriptor_nam [1].address := data_area [1];
          buffer_descriptor_nam [1].length := #SIZE (data_area [1]^);
          buffer_descriptor_nam [2].address := data_area [2];
          buffer_descriptor_nam [2].length := block_size + data_header_length + 1;
        ELSE
          buffer_descriptor_rhfam [1].address := data_area [1];
          buffer_descriptor_rhfam [1].length := #SIZE (data_area [1]^);
        IFEND;
      IFEND;

    WHILEND /receive_event/;
  PROCEND receive_connection_event;
?? TITLE := 'receive_file_block', EJECT ??

{ PURPOSE:  This procedure receives a file block.

  PROCEDURE receive_file_block
    (    peer_operation: nat$se_peer_operation;
     VAR data_area: receiver_input_data_area;
     VAR status: ost$status);

    VAR
      batch_header: ^batch_data_header,
      buffer_size: integer,
      data_length: integer,
      header_buffer:  ^SEQ ( * ),
      local_status: ost$status,
      segment_pointer: amt$segment_pointer;

    local_status.normal := TRUE;
    status.normal := TRUE;
    receive_transfer_progress.general_position := file_in_progress;
    IF  access_method = nfc$am_nam  THEN
      header_buffer  := data_area [1];
      RESET header_buffer;
      NEXT batch_header IN header_buffer;
      data_length := peer_operation.data_length - data_header_length;
    ELSE
      data_length := peer_operation.data_length;
    IFEND;
    receive_transfer_progress.current_byte_count :=
          receive_transfer_progress.current_byte_count + data_length;
    buffer_size := #SIZE (receive_transfer_progress.file_byte_address^) -
          receive_transfer_progress.current_byte_count;
    IF data_length > 0 THEN
      NEXT receive_transfer_progress.current_byte_address:
            [[REP data_length OF cell]] IN receive_transfer_progress.
            file_byte_address;
      NEXT receive_transfer_progress.current_byte_address:
            [[REP buffer_size OF cell]] IN receive_transfer_progress.
            file_byte_address;
      RESET receive_transfer_progress.file_byte_address TO
            receive_transfer_progress.current_byte_address;
    IFEND;
    IF  ((access_method = nfc$am_nam) AND
          (batch_header^.data_block_clarifier DIV nfc$dbc_eoi_bit MOD 2 = 1))
                OR
          ((access_method = nfc$am_rhfam) AND (peer_operation.end_of_message))
          THEN
      segment_pointer.kind := amc$sequence_pointer;
      segment_pointer.sequence_pointer := receive_transfer_progress.
            file_byte_address;
      amp$set_segment_eoi (receiver_file_id, segment_pointer, status);
      fsp$close_file (receiver_file_id, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      receiver_file_open := FALSE;
      #SPOIL (receiver_file_open);
      receive_transfer_progress.general_position := transfer_complete;
      receive_params.transfer_status.normal := TRUE;
      IF  access_method = nfc$am_nam  THEN
        data_area [2] := ^param_area;
      ELSE
        data_area [1] := ^lcn_command;
      IFEND;
    ELSE
      IF  access_method = nfc$am_nam  THEN
        data_area [2] := receive_transfer_progress.current_byte_address;
      ELSE
        data_area [1] := receive_transfer_progress.current_byte_address;
      IFEND;
    IFEND;
  PROCEND receive_file_block;
?? TITLE := 'receive_file_label', EJECT ??

{ PURPOSE:  This procedure receives the label of a NOS/VE file.
{
{ LOGIC: Create label_file
{        IF write NOT permitted on label_file THEN
{          Increase write bracket (1..Ring_Attribute_1)
{        IFEND
{        Store label in label_file
{        Get file attributes from label file
{
{        IF file_organization = indexed_sequential
{          Create ins_file using label_file attributes
{          Store label in ins_file
{          Delete label_file
{          label_file := ins_file
{        IFEND
{
{        fsp$open_and_get_type_of_copy of label_file
{        IF byte_move
{          receiver_file := receive_params.file_name
{          Delete label_file
{        ELSE
{          receiver_file := label_file
{          copy_required := TRUE
{        IFEND
{
{        Open receiver_file for segment access

  PROCEDURE receive_file_label
    (    peer_operation: nat$se_peer_operation;
     VAR data_area: receiver_input_data_area;
     VAR status: ost$status);

    CONST
      test_char = 'B';

    VAR
      attachment_options: ^fst$attachment_options,
      batch_header: ^batch_data_header,
      byte_address: amt$file_byte_address,
      check_data: char,
      computed_label_checksum: pft$checksum,
      contains_data: boolean,
      control_info: fst$copy_control_information,
      data_buffer: ^SEQ ( * ),
      data_length: integer,
      file_label: ^fmt$file_label,
      file_label_header: ^fmt$static_label_header,
      from_file_attributes: ^fst$file_cycle_attributes,
      get_attributes: ^amt$get_attributes,
      header_buffer: ^SEQ ( * ),
      input_close_status: ost$status,
      input_fid: amt$file_identifier,
      ins_file: amt$local_file_name,
      label_file: amt$local_file_name,
      label_length: 0 .. max_label_size,
      local_file: boolean,
      local_status: ost$status,
      old_file: boolean,
      open_position: ^amt$open_position,
      open_position_length: integer,
      output_attributes: ^fst$file_cycle_attributes,
      output_close_status: ost$status,
      output_fid: amt$file_identifier,
      override_attributes: ^fst$file_cycle_attributes,
      segment_cell: amt$segment_pointer,
      segment_pointer: amt$segment_pointer,
      stored_label_checksum: ^pft$checksum,
      unique_name: ost$name;

    local_status.normal := TRUE;
    status.normal := TRUE;
    receive_transfer_progress.general_position := label_in_progress;

    IF  access_method = nfc$am_nam  THEN
      header_buffer := data_area [1];
      RESET header_buffer;
      NEXT batch_header IN header_buffer;
      IF batch_header^.data_block_clarifier <> nfc$dbc_ve_label THEN
        process_receive_protocol_error (processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      data_buffer := data_area [2];
    ELSE
      data_buffer := data_area [1];
    IFEND;

    RESET data_buffer;
    NEXT open_position IN data_buffer;
    data_length := peer_operation.data_length;
    open_position_length := #SIZE (open_position^);

    IF  access_method = nfc$am_nam  THEN
      label_length := data_length - data_header_length - open_position_length;
    ELSE
      label_length := data_length - open_position_length;
    IFEND;
    NEXT file_label: [[REP label_length OF cell]] IN data_buffer;

    pmp$get_unique_name (unique_name, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    label_file := unique_name;

    check_data := test_char;

{ Create a non-empty temporary file and stuff the received file label into it.
{ The temporary file will have the same file attributes as the original file
{ with the exception of the write bracket, which may be altered to include the
{ execution ring of this task.

    PUSH attachment_options: [1 .. 2];
    attachment_options^ [1].selector := fsc$open_position;
    attachment_options^ [1].open_position := open_position^;
    attachment_options^ [2].selector := fsc$access_and_share_modes;
    attachment_options^ [2].access_modes.selector := fsc$specific_access_modes;
    attachment_options^ [2].access_modes.value :=
          $fst$file_access_options [fsc$read, fsc$shorten, fsc$append];
    attachment_options^ [2].share_modes.selector := fsc$required_share_modes;
    fsp$open_file (label_file, amc$record, attachment_options, NIL, NIL, NIL,
          NIL, input_fid, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    amp$put_next (input_fid, ^check_data, 1, byte_address, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    fsp$close_file (input_fid, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    RESET file_label;
    NEXT stored_label_checksum IN file_label;
    NEXT file_label_header IN file_label;

    IF file_label_header^.ring_attributes.r1 < receive_params.validation_ring THEN

{ Change the write bracket of the file to include the current execution ring of this
{ task. This will allow SRP$STORE_SYSTEM_LABEL to write the label file.

      file_label_header^.ring_attributes.r1 := receive_params.validation_ring;
      srp$compute_label_checksum(file_label_header, #size(file_label^) - #size(stored_label_checksum^),
         computed_label_checksum);
      stored_label_checksum^ := computed_label_checksum;
    IFEND;
    srp$store_system_label (label_file, file_label^, local_status);
    IF NOT local_status.normal THEN
      pmp$log('abnormal status from attempt to store the file label', status);
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    PUSH get_attributes: [1 .. 11];
    get_attributes^ [1].key := amc$ring_attributes;
    get_attributes^ [2].key := amc$file_organization;
    get_attributes^ [3].key := amc$data_padding;
    get_attributes^ [4].key := amc$embedded_key;
    get_attributes^ [5].key := amc$index_levels;
    get_attributes^ [6].key := amc$index_padding;
    get_attributes^ [7].key := amc$key_length;
    get_attributes^ [8].key := amc$key_position;
    get_attributes^ [9].key := amc$key_type;
    get_attributes^ [10].key := amc$max_record_length;
    get_attributes^ [11].key := amc$record_type;
    amp$get_file_attributes (label_file, get_attributes^, local_file, old_file,
          contains_data, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

{  Special processing for Indexed Sequential files.

    IF get_attributes^ [2].file_organization = amc$indexed_sequential THEN
      PUSH from_file_attributes: [1 .. 10];
      from_file_attributes^ [1].selector := fsc$file_organization;
      from_file_attributes^ [1].file_organization := amc$indexed_sequential;
      from_file_attributes^ [2].selector := fsc$data_padding;
      from_file_attributes^ [2].data_padding :=
            get_attributes^ [3].data_padding;
      from_file_attributes^ [3].selector := fsc$embedded_key;
      from_file_attributes^ [3].embedded_key :=
            get_attributes^ [4].embedded_key;
      from_file_attributes^ [4].selector := fsc$index_levels;
      from_file_attributes^ [4].index_levels :=
            get_attributes^ [5].index_levels;
      from_file_attributes^ [5].selector := fsc$index_padding;
      from_file_attributes^ [5].index_padding :=
            get_attributes^ [6].index_padding;
      from_file_attributes^ [6].selector := fsc$key_length;
      from_file_attributes^ [6].key_length := get_attributes^ [7].key_length;
      from_file_attributes^ [7].selector := fsc$key_position;
      from_file_attributes^ [7].key_position :=
            get_attributes^ [8].key_position;
      from_file_attributes^ [8].selector := fsc$key_type;
      from_file_attributes^ [8].key_type := get_attributes^ [9].key_type;
      from_file_attributes^ [9].selector := fsc$max_record_length;
      from_file_attributes^ [9].max_record_length :=
            get_attributes^ [10].max_record_length;
      from_file_attributes^ [10].selector := fsc$record_type;
      from_file_attributes^ [10].record_type :=
            get_attributes^ [11].record_type;

      pmp$get_unique_name (unique_name, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      ins_file := unique_name;

      fsp$open_file (ins_file, amc$record, attachment_options, NIL,
            from_file_attributes, NIL, NIL, input_fid, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;

      fsp$close_file (input_fid, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;

      srp$store_system_label (ins_file, file_label^, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;

      amp$return (label_file, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      label_file := ins_file;
    IFEND;  { ** End special processing for Indexed Sequential files.

    PUSH output_attributes: [1 .. 1];
    output_attributes^ [1].selector := fsc$ring_attributes;
    output_attributes^ [1].ring_attributes.r1 :=
          receive_params.validation_ring;
    output_attributes^ [1].ring_attributes.r2 :=
          receive_params.validation_ring;
    output_attributes^ [1].ring_attributes.r3 :=
          receive_params.validation_ring;

    fsp$open_and_get_type_of_copy (label_file, receive_params.file_name, ^fsv$copf_input_file_attachment,
          ^fsv$copf_output_file_attachment, NIL, NIL, output_attributes, input_fid, output_fid, control_info,
          local_status);
    IF input_fid <> amv$nil_file_identifier THEN
      fsp$close_file (input_fid, input_close_status);
    IFEND;
    IF output_fid <> amv$nil_file_identifier THEN
      fsp$close_file (output_fid, output_close_status);
    IFEND;
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    IF NOT input_close_status.normal THEN
      process_receive_system_error (input_close_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    IF NOT output_close_status.normal THEN
      process_receive_system_error (output_close_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    IF control_info.type_of_copy = fsc$byte_move THEN
      receiver_file := receive_params.file_name;
      copy_required := FALSE;
      #SPOIL (copy_required);
      amp$return (label_file, local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
    ELSE
      receiver_file := label_file;
      copy_required := TRUE;
      #SPOIL (copy_required);
    IFEND;

    attachment_options^ [1].selector := fsc$create_file;
    attachment_options^ [1].create_file := FALSE;
    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;

    fsp$open_file (receiver_file, amc$segment, attachment_options, NIL, NIL,
          NIL, override_attributes, receiver_file_id, local_status);
    IF NOT local_status.normal THEN
      IF local_status.condition = pfe$usage_not_permitted THEN
        attachment_options^ [2].access_modes.value :=
              $fst$file_access_options [fsc$shorten, fsc$append];
        fsp$open_file (receiver_file, amc$segment, attachment_options, NIL,
              NIL, NIL, override_attributes, receiver_file_id, local_status);
        IF NOT local_status.normal THEN
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        IFEND;
      ELSE
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
    IFEND;
    receiver_file_open := TRUE;
    #SPOIL (receiver_file_open);

    amp$get_segment_pointer (receiver_file_id, amc$sequence_pointer,
          segment_pointer, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    amp$get_segment_pointer (receiver_file_id, amc$cell_pointer, segment_cell,
          local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    mmp$set_access_selections (segment_cell.cell_pointer, mmc$as_sequential,
          local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    receive_transfer_progress.general_position := label_complete;
    receive_transfer_progress.file_byte_address :=
          segment_pointer.sequence_pointer;

    IF  access_method = nfc$am_nam  THEN
      data_area [2] := receive_transfer_progress.file_byte_address;
    ELSE
      data_area [1] := receive_transfer_progress.file_byte_address;
    IFEND;

    receive_transfer_progress.current_byte_count := 0;
    RESET receive_transfer_progress.file_byte_address;

  PROCEND  receive_file_label;
?? TITLE := 'receive_queue_file_label', EJECT ??

{ PURPOSE:  This procedure receives the label of a NOS/VE queue file.

  PROCEDURE receive_queue_file_label
    (    peer_operation: nat$se_peer_operation;
     VAR data_area: receiver_input_data_area;
     VAR status: ost$status);

    VAR
      attachment_options: ^fst$attachment_options,
      byte_address: amt$file_byte_address,
      change_ring_attributes: ^amt$file_attributes,
      data_buffer: ^SEQ ( * ),
      data_length: integer,
      file_label: ^SEQ ( * ),
      input_fid: amt$file_identifier,
      label_length: 0 .. max_label_size,
      local_status: ost$status,
      open_position: ^amt$open_position,
      open_position_length: integer,
      override_attributes: ^fst$file_cycle_attributes,
      segment_cell: amt$segment_pointer,
      segment_pointer: amt$segment_pointer;

    local_status.normal := TRUE;
    status.normal := TRUE;
    copy_required := FALSE;
    #SPOIL (copy_required);
    receiver_file := receive_params.file_name;
    receive_transfer_progress.general_position := label_in_progress;

    IF  access_method = nfc$am_nam  THEN
      data_buffer := data_area [2];
    ELSE
      data_buffer := data_area [1];
    IFEND;
    RESET data_buffer;
    NEXT open_position IN data_buffer;
    data_length := peer_operation.data_length;
    open_position_length := #SIZE (open_position^);
    IF  access_method = nfc$am_nam  THEN
      label_length := data_length - data_header_length - open_position_length;
    ELSE
      label_length := data_length - open_position_length;
    IFEND;
    NEXT file_label: [[REP label_length OF cell]] IN data_buffer;

    fsp$open_file (receiver_file, amc$record, NIL, NIL, NIL, NIL, NIL,
           input_fid, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    fsp$close_file (input_fid, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    srp$store_system_label (receiver_file, file_label^, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    PUSH change_ring_attributes: [1 .. 1];
    change_ring_attributes^ [1].key := amc$ring_attributes;
    change_ring_attributes^ [1].ring_attributes.r1 :=
          receive_params.validation_ring;
    change_ring_attributes^ [1].ring_attributes.r2 :=
          receive_params.validation_ring;
    change_ring_attributes^ [1].ring_attributes.r3 :=
          receive_params.validation_ring;
    amp$change_file_attributes (receiver_file, change_ring_attributes,
          local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

    PUSH attachment_options: [1 .. 1];
    attachment_options^ [1].selector := fsc$create_file;
    attachment_options^ [1].create_file := FALSE;
    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;
    fsp$open_file (receiver_file, amc$segment, attachment_options, NIL, NIL,
          NIL, override_attributes, receiver_file_id, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    receiver_file_open := TRUE;
    #SPOIL (receiver_file_open);

    amp$get_segment_pointer (receiver_file_id, amc$sequence_pointer,
          segment_pointer, local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    amp$get_segment_pointer (receiver_file_id, amc$cell_pointer, segment_cell,
          local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    mmp$set_access_selections (segment_cell.cell_pointer, mmc$as_sequential,
          local_status);
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
    receive_transfer_progress.general_position := label_complete;
    receive_transfer_progress.file_byte_address :=
          segment_pointer.sequence_pointer;
    IF  access_method = nfc$am_nam  THEN
      data_area [2] := receive_transfer_progress.file_byte_address;
    ELSE
      data_area [1] := receive_transfer_progress.file_byte_address;
    IFEND;
    receive_transfer_progress.current_byte_count := 0;
    RESET receive_transfer_progress.file_byte_address;

  PROCEND  receive_queue_file_label;
?? TITLE := 'receive_rhf_file_block', EJECT ??

{ PURPOSE:  This procedure receives a file block to an RHF-structured file.
{
{ DESIGN:  Each file block received contains a header containing a data
{          block clarifier.  On NAM transfers this is part of the data,
{          on LCN transfers it is a connection file attribute.  This data
{          block clarifier contains bits indicating a NOS-type EOR (mapped
{          to a "V" record, NOS-type EOF (mapped to a partition mark), EOI
{          or no mark (meaning mid-EOR).

  PROCEDURE receive_rhf_file_block
    (    peer_operation: nat$se_peer_operation;
     VAR data_area: receiver_input_data_area;
     VAR status: ost$status);

   CONST
     dbc_pru_bit = 128,
     dbc_unused_bit = 16;

    VAR
      block_header: ^batch_data_header,
      buffer_size: integer,
      byte_address: amt$file_byte_address,
      data_length: integer,
      fetch_attributes: ^rft$get_attributes,
      header_buffer:  ^SEQ ( * ),
      local_status: ost$status,
      record_mark: (no_mark, eor_mark, eof_mark, eoi_mark),
      segment_pointer: amt$segment_pointer,
      terminate_option: amt$term_option;

    local_status.normal := TRUE;
    status.normal := TRUE;
    IF receive_transfer_progress.general_position <> file_in_progress THEN
      receive_transfer_progress.general_position := file_in_progress;
    IFEND;

    IF  access_method = nfc$am_nam  THEN
      header_buffer  := data_area [1];
      RESET header_buffer;
      NEXT block_header IN header_buffer;
      IF (block_header^.data_block_clarifier DIV nfc$dbc_eoi_bit MOD 2) = 1 THEN
        record_mark := eoi_mark;
      ELSE
        IF (block_header^.data_block_clarifier DIV dbc_pru_bit MOD 2) = 1 THEN
          block_header^.data_block_clarifier := block_header^.data_block_clarifier - dbc_pru_bit;
        IFEND;
        IF (block_header^.data_block_clarifier DIV dbc_unused_bit MOD 2) = 1 THEN
          block_header^.data_block_clarifier := block_header^.data_block_clarifier - dbc_unused_bit;
        IFEND;
        CASE block_header^.data_block_clarifier  OF
        = nfc$dbc_no_mark =
          record_mark := no_mark;
        = nfc$dbc_eor =
          record_mark := eor_mark;
        = nfc$dbc_eof =
          record_mark := eof_mark;
        ELSE
          pmp$log ('receive_rhf_file_block CASE error', local_status);
          osp$set_status_abnormal (nfc$status_id,
                nfe$receiver_problem_no_retry, '', local_status);
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        CASEND;
      IFEND;
      data_length := peer_operation.data_length - data_header_length;
    ELSE
      PUSH fetch_attributes: [1 .. 1];
      fetch_attributes^ [1].key := rfc$file_mark_received;
      rfp$fetch (receive_params.connection_fid, fetch_attributes^,
            local_status);
      IF NOT local_status.normal THEN
        process_receive_system_error (local_status, processing_error, receive_params, status);
        RETURN; {----->
      IFEND;
      IF peer_operation.end_of_message THEN
        CASE fetch_attributes^ [1].file_mark_received OF
        = rfc$rm_eor =
          record_mark := eor_mark;
        = rfc$rm_eof =
          record_mark := eof_mark;
        = rfc$rm_eoi =
          record_mark := eoi_mark;
        ELSE
          pmp$log ('receive_rhf_file_block mark 1 CASE error', local_status);
          osp$set_status_abnormal (nfc$status_id,
                nfe$receiver_problem_no_retry, '', local_status);
          process_receive_system_error (local_status, processing_error, receive_params, status);
          RETURN; {----->
        CASEND;
      ELSE
        record_mark := no_mark;
      IFEND;
      data_length := peer_operation.data_length;
    IFEND;

    local_status.normal := TRUE;
    CASE record_mark OF
    = no_mark =
      IF start_of_rhf_struct_record THEN
        terminate_option := amc$start;
      ELSE
        terminate_option := amc$continue;
      IFEND;
      amp$put_partial (receiver_file_id, working_storage, data_length,
            byte_address, terminate_option, local_status);
      start_of_rhf_struct_record := FALSE;
    = eor_mark =
      amp$put_partial (receiver_file_id, working_storage, data_length,
            byte_address, amc$terminate, local_status);
      start_of_rhf_struct_record := TRUE;
    = eof_mark =
      IF data_length > 0 THEN
        amp$put_partial (receiver_file_id, working_storage, data_length,
              byte_address, amc$terminate, local_status);
      IFEND;
      IF local_status.normal THEN
        amp$write_end_partition (receiver_file_id, local_status);
        start_of_rhf_struct_record := TRUE;
      IFEND;
    = eoi_mark =
      IF data_length > 0 THEN
        amp$put_partial (receiver_file_id, working_storage, data_length,
              byte_address, amc$terminate, local_status);
      IFEND;
      IF local_status.normal THEN
        fsp$close_file (receiver_file_id, local_status);
        IF local_status.normal THEN
          receiver_file_open := FALSE;
          #SPOIL (receiver_file_open);

          IF  access_method = nfc$am_nam  THEN
            data_area [2] := ^param_area;
          ELSE
            data_area [1] := ^lcn_command;
          IFEND;

          receive_transfer_progress.general_position := transfer_complete;
          receive_params.transfer_status.normal := TRUE;
        IFEND;
      IFEND;
    ELSE
      pmp$log ('receive_rhf_file_block mark 2 CASE error', local_status);
      osp$set_status_abnormal ('NF', nfe$receiver_problem_no_retry,
            '', local_status);
    CASEND;

    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;

  PROCEND receive_rhf_file_block;
?? TITLE := 'send_er_err', EJECT ??

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

  PROCEDURE send_er_err
    (VAR status: ost$status);

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

    status.normal := TRUE;
    command_id := er_command;
    condition_code := receive_err_retry;
    condition_code (4, 1) := active_receive_error_code;
    send_receiver_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    current_receive_state := exit_receive;
    #SPOIL (current_receive_state);
  PROCEND send_er_err;
?? TITLE := 'send_er_ok', EJECT ??

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

  PROCEDURE send_er_ok
    (VAR status: ost$status);

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

    status.normal := TRUE;
    command_id := er_command;
    condition_code := ok;
    send_receiver_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    current_receive_state := exit_receive;
    #SPOIL (current_receive_state);
  PROCEND send_er_ok;
?? TITLE := 'send_qr_err', EJECT ??

{ PURPOSE:  This procedure sends a QR command with error.

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

    VAR
      command_id: string (2);

    status.normal := TRUE;
    command_id := qr_command;
    send_receiver_command (command_id, condition_code, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    active_receive_error_code := condition_code (4);
    current_receive_state := quit_err_sent;
    #SPOIL (current_receive_state);
  PROCEND send_qr_err;
?? TITLE := 'send_receiver_command', EJECT ??

{ PURPOSE:  This procedure sends a command.

  PROCEDURE send_receiver_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,
      bytes_transferred: rft$bytes_transferred,
      command_block: data_phase_command,
      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;

    status.normal := TRUE;
    IF protocol_trace THEN
      STRINGREP (trace_message, trace_size, '**** NFM$RHF_RECEIVE_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;

    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 (receive_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 (receive_params.connection_fid, rfc$message_mode, ^message_content_rhfam, end_of_message,
            osc$wait, activity_status, bytes_transferred, local_status);
    IFEND;
    IF NOT local_status.normal THEN
      process_receive_system_error (local_status, processing_error, receive_params, status);
      RETURN; {----->
    ELSEIF activity_status.complete AND (NOT activity_status.status.normal) THEN
      process_receive_system_error (activity_status.status, processing_error, receive_params, status);
      RETURN; {----->
    IFEND;
  PROCEND send_receiver_command;
?? TITLE := 'send_sr', EJECT ??

{ PURPOSE:  This procedure sends an SR command.

  PROCEDURE send_sr
    (VAR status: ost$status);

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

    status.normal := TRUE;
    IF  nfc$ss_ack_required IN receive_params.facilities  THEN
      command_id := sr_command;
      condition_code := ok;
      send_receiver_command (command_id, condition_code, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;
    current_receive_state := receive_data;
    #SPOIL (current_receive_state);
  PROCEND send_sr;
?? TITLE := '  set_status', EJECT ??

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

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

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

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

  PROCEND set_status;
?? OLDTITLE ??
MODEND nfm$rhf_receive_file;
