*copyc osd$default_pragmats
?? NEWTITLE := 'RHFAM/VE: External Application Interface' ??
?? NEWTITLE := 'Ring Brackets 23D' ??
MODULE rfm$external_interface;
?? NEWTITLE := '  Global Declarations', EJECT ??
?? NEWTITLE := '    Type/Constant Definitions' ??
*copyc rfc$external_interface
*copyc rft$external_interface
*copyc rfe$condition_codes
?? EJECT ??
*copyc rft$rhfam_job_table
?? EJECT ??
*copyc rfk$keypoints
*copyc rft$switched_connection_queue
*copyc rft$file_attributes
*copyc rft$outgoing_control_messages
*copyc rfd$path_status_table
*copyc rft$pp_interface_defs
*copyc rft$rhfam_client_table
*copyc rft$rhfam_event_table
*copyc rft$rhfam_server_table
*copyc rft$r1_interface_defs
?? EJECT ??

?? PUSH (LISTEXT := ON) ??
*copyc ame$improper_file_id
*copyc amt$call_block
*copyc amt$fap_layer_number
*copyc amt$file_identifier
*copyc bat$task_file_table
*copyc cle$ecc_lexical
*copyc i#ptr
*copyc iot$io_function
*copyc osd$integer_limits
*copyc osk$keypoints
*copyc osk$keypoint_class_codes
*copyc oss$task_shared
?? POP ??

?? TITLE := '    External Variables', EJECT ??

*copyc nav$network_paged_heap
*copyc nav$network_wired_heap
*copyc osv$page_size
*copyc rfv$switched_connection_queue
*copyc rfv$rhfam_job_table
*copyc rfv$rhfam_client_table
*copyc rfv$rhfam_event_table
*copyc rfv$rhfam_server_table
*copyc rfv$status_table
*copyc rfv$system_task_id
*copyc rfv$outstanding_requests
*copyc tmv$null_global_task_id
?? TITLE := '    External Procedures' , EJECT ??

*copyc amp$return
*copyc bap$validate_file_identifier
*copyc clp$construct_path_handle_name
*copyc clp$validate_name
*copyc fmp$create_rhfam_file
*copyc fmp$evaluate_path
*copyc i#ptr
*copyc jmp$job_monitor_xcb
*copyc mmp$advise_out_in
*copyc mmp$verify_access
?? NEWTITLE := ' Overwritten by nap$validate_user' ??
*copyc nap$validate_user
?? OLDTITLE ??
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$begin_subsystem_activity
*copyc osp$clear_job_signature_lock
*copyc osp$disestablish_cond_handler
*copyc osp$end_subsystem_activity
*copyc osp$i_await_activity
*copyc osp$establish_condition_handler
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc osp$test_set_job_sig_lock
*copyc pmp$find_executing_task_xcb
*copyc pmp$continue_to_cause
*copyc pmp$get_compact_date_time
*copyc pmp$get_executing_task_gtid
*copyc pmp$get_job_names
*copyc pmp$get_microsecond_clock
*copyc pmp$ready_task
*copyc pmp$wait
*copyc pmp$zero_out_table

*copyc rfp$continue_io_request
*copyc rfp$delink_request
*copyc rfp$find_client_entry
*copyc rfp$move_data_to_wired_buffs
*copyc rfp$move_data_from_wired_buffs
*copyc rfp$post_request
*copyc rfp$process_pp_response_flag
*copyc rfp$queue_request
*copyc rfp$release_wired_buffers
*copyc rfp$reserve_wired_buffers
*copyc rfp$re_issue_request
*copyc syp$cycle
*copyc nlv$bm_large_buffer_size
?? TITLE := '    Internal Global Variables' , EJECT ??

      VAR
        rfv$job_entry_pointer: [XDCL, oss$task_shared] ^rft$rhfam_job_table_entry := NIL;


?? OLDTITLE ??
?? TITLE := 'PROCEDURE get_path_handle_name', EJECT ??
  PROCEDURE get_path_handle_name
    (    file: fst$file_reference;
     VAR path_handle_name: fst$path_handle_name;
     VAR status: ost$status);

    VAR
      evaluated_file_reference: fst$evaluated_file_reference,
      ignore_cycle_description: ^fmt$cycle_description;

    path_handle_name := '';
    fmp$evaluate_path (file, $bat$process_pt_work_list [bac$resolve_path],
          evaluated_file_reference, ignore_cycle_description, status);
    IF evaluated_file_reference.path_handle_info.path_handle_present THEN
      clp$construct_path_handle_name (evaluated_file_reference.path_handle_info.path_handle,
            path_handle_name);
    IFEND;

  PROCEND get_path_handle_name;
?? TITLE := '  Application Interface Requests', EJECT ??
?? NEWTITLE := '    rfp$accept_connect_request', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$accept_connect_request (connection_file:
        fst$file_reference;
    VAR status: ost$status);

*copy rfh$accept_connect_request

?? NEWTITLE := '      terminate_accept_connect - condition handler', EJECT ??
    PROCEDURE terminate_accept_connect (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        block_exit_expected := TRUE;
        EXIT rfp$accept_connect_request;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          current_request := rfv$outstanding_requests;
        /complete_synchronous_request/
          WHILE current_request <> NIL DO
            IF (current_request^.request_id.ring_1_id.address <> NIL) AND
               (NOT current_request^.request_id.ring_1_id.address^.asynchronous_request) THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              REPEAT
                #SPOIL (activity_status^);
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
              UNTIL activity_status^.complete;
              FREE activity_status  IN osv$task_private_heap^;
              current_request := rfv$outstanding_requests;
              EXIT /complete_synchronous_request/;
            IFEND;
            current_request := current_request^.next_entry;
          WHILEND /complete_synchronous_request/;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_accept_connect_request THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          block_exit_expected := TRUE;
          EXIT rfp$accept_connect_request;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_accept_connect;
?? OLDTITLE, EJECT ??

    VAR
      activity_status: ^ost$activity_status,
      block_exit_expected: boolean,
      command_identifier: ^rft$logical_commands,
      connection_entry_p: ^rft$connection_entry,
      nad_index: rft$local_nads,
      request_info: ^SEQ ( * ),
      path_handle_name: fst$path_handle_name,
      path_id: ^rft$path_identifier,
      unit_request_status: ^rft$connection_mgmt_status;

    #keypoint (osk$entry, 0, rfk$accept_connect_request);

    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_accept_connect, TRUE);
    status.normal := TRUE;

  /accept_connect_request/
    BEGIN
      get_path_handle_name (connection_file, path_handle_name, status);
      IF NOT status.normal THEN
        EXIT /accept_connect_request/;
      IFEND;

      get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
      IF NOT status.normal THEN
        EXIT /accept_connect_request/;
      IFEND;
      CASE connection_entry_p^.connection_attributes.connection_status.connection_state OF
      = rfc$incoming_connect_active =
      /queue_accept_request/
        BEGIN
          PUSH request_info: [[rft$logical_commands,rft$path_identifier]];
          RESET request_info;
          NEXT command_identifier  IN  request_info;
          IF  command_identifier = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                  'the request overflowed the request sequence', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$accept_connect_request', status);
            EXIT  /queue_accept_request/;
          IFEND;
          command_identifier^ := rfc$lc_accept_connect_request;
          NEXT  path_id  IN  request_info;
          IF  path_id = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                  'the request overflowed the request sequence', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$accept_connect_request', status);
            EXIT  /queue_accept_request/;
          IFEND;
          path_id^ := connection_entry_p^.connection_descriptor.network_path;
          ALLOCATE unit_request_status IN osv$task_private_heap^;
          IF  unit_request_status = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                  'task private', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$accept_connect_request', status);
            EXIT  /queue_accept_request/;
          IFEND;
          unit_request_status^.internal_use := false;
          unit_request_status^.connection := connection_entry_p;

{     The structure activity status is allocated in task private to insure
{     it is writeable by ring 3 code. Pointers to this variable are stored in
{     a task private segment and thus inherit ring 3 privileges.

          ALLOCATE activity_status IN osv$task_private_heap^;
          IF  activity_status = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                  'task private', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$accept_connect_request', status);
            EXIT  /queue_accept_request/;
          IFEND;
          unit_request_status^.activity_status := activity_status;
          activity_status^.complete := false;
          activity_status^.status.normal := true;
          #SPOIL (activity_status^);
          nad_index := connection_entry_p^.connection_descriptor.nad_index;
          connection_entry_p^.active_pp_requests := connection_entry_p^.active_pp_requests + 1;
          rfp$unlock_table (connection_entry_p^.lock);
          rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_accept_connect_request,
                unit_request_status, request_info, status);
          IF  NOT status.normal  THEN
            rfp$lock_table(connection_entry_p^.lock);
            connection_entry_p^.active_pp_requests := connection_entry_p^.active_pp_requests - 1;
            EXIT  /queue_accept_request/;
          IFEND;
          REPEAT
            #SPOIL (activity_status^);
            pmp$wait (rfc$unit_request_wait_time,rfc$ur_expected_wait);
            rfp$process_pp_response_flag (rfc$pp_response_available);
          UNTIL activity_status^.complete;
          IF NOT activity_status^.status.normal THEN
            status := activity_status^.status;
          IFEND;
          FREE activity_status IN osv$task_private_heap^;
          EXIT /accept_connect_request/;
        END /queue_accept_request/;
        rfp$unlock_table (connection_entry_p^.lock);

      ELSE
        set_connection_status (connection_entry_p, status);
        rfp$unlock_table (connection_entry_p^.lock);
      CASEND;

    END /accept_connect_request/;

    osp$disestablish_cond_handler;
    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$accept_connect_request);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$accept_connect_request);
    IFEND;
  PROCEND rfp$accept_connect_request;
?? TITLE := '    rfp$accept_switch_offer', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$accept_switch_offer (application_name:
        rft$application_name;
        connection_file: fst$file_reference;
        file_attributes: ^rft$change_attributes;
        wait_time: rft$connection_timeout;
    VAR source_job: jmt$system_supplied_name;
    VAR status: ost$status);

*copy rfh$accept_switch_offer

?? NEWTITLE := '      terminate_accept_switch - condition handler', EJECT ??
    PROCEDURE terminate_accept_switch (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$accept_switch_offer;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$accept_switch_offer;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_accept_switch;
?? OLDTITLE, EJECT ??

    VAR
      activity_completed: ost$i_wait_activity,
      application_entry_p: ^rft$application_table_entry,
      application_kind: rft$application_kinds,
      connection_attributes: rft$connection_attributes,
      ignore_status: ost$status,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_file_created: boolean,
      local_source_job: jmt$system_supplied_name,
      local_status: ost$status,
      new_entry: BOOLEAN,
      path_handle_name: fst$path_handle_name,
      ready_index: integer,
      server_entry_p: ^rft$rhfam_server_table_entry,
      switched_connection: ^rft$switched_connection,
      wait_complete: boolean,
      wait_list: ARRAY [ 1.. 2 ] OF ost$i_activity;


    #keypoint (osk$entry, 0, rfk$accept_switch_offer);
    osp$establish_condition_handler (^terminate_accept_switch, FALSE);

    job_table_entry_p := NIL;
    local_file_created := FALSE;
    status.normal := TRUE;

    wait_list [1].activity := rfc$i_await_switch_offer;
    wait_list [1].application_name := application_name;
    wait_list [2].activity := osc$i_await_time;
    wait_list [2].milliseconds := wait_time;
    osp$i_await_activity (wait_list, ready_index, wait_complete, status);

  /accept_switch_offer/
    WHILE status.normal DO
      activity_completed := wait_list [ready_index].activity;
      CASE activity_completed OF
      = rfc$i_await_switch_offer =

{     Verify change_attributes.

        merge_change_attributes (^connection_attributes,
              file_attributes, status);
        IF NOT status.normal THEN
          EXIT /accept_switch_offer/;
        IFEND;

        fmp$create_rhfam_file (connection_file, status);
        IF NOT status.normal THEN
          EXIT /accept_switch_offer/;
        IFEND;
        local_file_created := TRUE;

        get_path_handle_name (connection_file, path_handle_name, status);
        IF NOT status.normal THEN
          EXIT /accept_switch_offer/;
        IFEND;

        rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
        IF  job_table_entry_p = NIL  THEN
          osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
                'Accept switch offer', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, application_name,
                status);
          EXIT /accept_switch_offer/;
        IFEND;

        find_application_entry (application_name, job_table_entry_p, application_entry_p);
        IF application_entry_p = NIL THEN
          osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
                'Accept switch offer', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, application_name,
                status);
          EXIT /accept_switch_offer/;
        IFEND;

        IF (NOT application_entry_p^.system_wide_connection_mgmt) AND
           (application_entry_p^.maximum_allowed_connections <=
                application_entry_p^.number_of_active_connections) THEN
          osp$set_status_abnormal (rfc$product_id, rfe$exceeded_connect_limit,
                'Accept switch offer', status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                application_name, status);
          EXIT /accept_switch_offer/;
        IFEND;

        get_switched_connection (application_name, switched_connection);
        IF switched_connection <> NIL THEN
          rfp$lock_table (switched_connection^.connection_entry_p^.lock);

          switched_connection^.connection_entry_p^.next_entry :=
                application_entry_p^.connection_table;
          application_entry_p^.connection_table := switched_connection^.connection_entry_p;

          merge_change_attributes (^switched_connection^.connection_entry_p^.connection_attributes,
              file_attributes, ignore_status);
          switched_connection^.connection_entry_p^.connection_name := path_handle_name;
          switched_connection^.connection_entry_p^.application_entry_p := application_entry_p;
          application_entry_p^.number_of_active_connections :=
                application_entry_p^.number_of_active_connections + 1;
          rfp$unlock_table (switched_connection^.connection_entry_p^.lock);
          application_kind := application_entry_p^.application_kind;
          job_table_entry_p^.lock := tmv$null_global_task_id;
          job_table_entry_p := NIL;
          local_source_job := switched_connection^.source_job;

          CASE switched_connection^.source_application_kind OF
          = rfc$server =
            IF application_kind = rfc$partner THEN
              rfp$lock_table (rfv$rhfam_server_table.lock);
              find_server_entry (application_name, FALSE, server_entry_p, local_status);
              IF local_status.normal THEN
                server_entry_p^.partner_job_connections := server_entry_p^.partner_job_connections + 1;
              IFEND;
              rfp$unlock_table (rfv$rhfam_server_table.lock);
            IFEND;
          = rfc$partner =
            IF application_kind = rfc$server THEN
              rfp$lock_table (rfv$rhfam_server_table.lock);
              find_server_entry (application_name, FALSE, server_entry_p, local_status);
              IF local_status.normal THEN
                server_entry_p^.partner_job_connections := server_entry_p^.partner_job_connections - 1;
              IFEND;
              rfp$unlock_table (rfv$rhfam_server_table.lock);
            IFEND
          ELSE
            { No action required.
          CASEND;

          FREE switched_connection IN nav$network_paged_heap^;
          wakeup_accept_switch_waits (local_source_job);
          source_job := local_source_job;
          EXIT /accept_switch_offer/;
        ELSE
          osp$set_status_abnormal (rfc$product_id,
                rfe$no_switch_offered, application_name, status);
        IFEND;
      = osc$i_await_time =
        osp$set_status_abnormal (rfc$product_id,
              rfe$no_switch_offered, application_name, status);
      CASEND;
    WHILEND /accept_switch_offer/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$accept_switch_offer);
    ELSE
      IF job_table_entry_p <> NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
      IFEND;
      IF local_file_created THEN
        amp$return (connection_file, ignore_status);
      IFEND;
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$accept_switch_offer);
    IFEND;
  PROCEND rfp$accept_switch_offer;
?? TITLE := '    rfp$acquire_connect_request', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$acquire_connect_request (server_name:
    rft$application_name;
        connection_file: fst$file_reference;
        file_attributes: ^rft$create_attributes;
        wait_time: rft$connection_timeout;
    VAR client_name: rft$application_name;
    VAR source_host_name: rft$host_identifier;
    VAR status: ost$status);

*copy rfh$acquire_connect_request

?? NEWTITLE := '      terminate_acquire_connect - condition handler', EJECT ??
    PROCEDURE terminate_acquire_connect (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$acquire_connect_request;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$acquire_connect_request;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_acquire_connect;
?? OLDTITLE, EJECT ??

    VAR
      access_method_accept: boolean,
      activity_completed: ost$i_wait_activity,
      application_entry_p: ^rft$application_table_entry,
      connection_attributes: rft$connection_attributes,
      connection_entry_p: ^rft$connection_entry,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      file_attribute_p_valid: boolean,
      ignore_status: ost$status,
      incoming_connect: rft$incoming_connect,
      incoming_connect_available: BOOLEAN,
      local_file_created: BOOLEAN,
      new_entry: BOOLEAN,
      path_handle_name: fst$path_handle_name,
      ready_index: integer,
      wait_complete: boolean,
      wait_list: ARRAY [ 1 .. 2 ] OF ost$i_activity;


    #keypoint (osk$entry, 0, rfk$acquire_connect_request);
    osp$establish_condition_handler (^terminate_acquire_connect, FALSE);


    wait_list [1].activity := rfc$i_await_incoming_connect;
    wait_list [1].application_name := server_name;
    wait_list [2].activity := osc$i_await_time;
    wait_list [2].milliseconds := wait_time;

    job_table_entry_p := NIL;
    local_file_created := FALSE;
    status.normal := TRUE;

    osp$i_await_activity (wait_list, ready_index, wait_complete, status);

    /acquire_connection/
      BEGIN
        activity_completed := wait_list [ready_index].activity;
        CASE activity_completed OF
        = rfc$i_await_incoming_connect =

{     Validate creation file attributes.

          merge_creation_attributes (^connection_attributes,
                file_attributes, status);
          IF NOT status.normal THEN
            EXIT /acquire_connection/;
          IFEND;

{     Create the connection file.

          fmp$create_rhfam_file (connection_file, status);
          IF NOT status.normal THEN
            EXIT /acquire_connection/;
          IFEND;
          local_file_created := TRUE;

          get_path_handle_name (connection_file, path_handle_name, status);
          IF NOT status.normal THEN
            EXIT /acquire_connection/;
          IFEND;

          rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
          IF  job_table_entry_p = NIL  THEN
            osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
                  'Acquire connect request', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, server_name,
                  status);
            EXIT /acquire_connection/;
          IFEND;

{     Get pointer to application table entry and check for application kind
{     of server.

          find_application_entry (server_name, job_table_entry_p, application_entry_p);
          IF application_entry_p = NIL THEN
            osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
                  'Acquire connect request', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, server_name,
                  status);
            EXIT /acquire_connection/;
          IFEND;

          IF application_entry_p^.application_kind <> rfc$server THEN
            osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on_as_server,
                  'Acquire connect request', status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  job_table_entry_p^.job_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, server_name,
                  status);
            EXIT /acquire_connection/;
          IFEND;

{         Check for maximum number of connections.

          IF application_entry_p^.maximum_allowed_connections <=
                application_entry_p^.number_of_active_connections THEN
            osp$set_status_abnormal (rfc$product_id, rfe$exceeded_connect_limit,
                   'Acquire connect request', status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  server_name, status);
            EXIT /acquire_connection/;
          IFEND;

{     Get an incoming connect and initialize the connection table.

          get_incoming_connect (server_name, incoming_connect, incoming_connect_available,
                access_method_accept, status);
          IF NOT status.normal THEN
            EXIT /acquire_connection/;
          IFEND;
          IF  incoming_connect_available  THEN
            allocate_connection_entry (application_entry_p, connection_entry_p, status);
            IF NOT status.normal THEN
              EXIT /acquire_connection/;
            IFEND;
            rfp$lock_table (connection_entry_p^.lock);
            job_table_entry_p^.lock := tmv$null_global_task_id;
            job_table_entry_p := NIL;
            IF access_method_accept THEN
              connection_entry_p^.connection_attributes.connection_status.connection_state :=
                  rfc$connected;
              connection_entry_p^.connection_attributes.connection_status.input_available :=
                  FALSE;
              connection_entry_p^.connection_attributes.connection_status.output_below_threshold :=
                  TRUE;
            ELSE
              connection_entry_p^.connection_attributes.connection_status.connection_state :=
                  rfc$incoming_connect_active;
            IFEND;
            connection_entry_p^.connection_name := path_handle_name;
            connection_entry_p^.connection_descriptor := incoming_connect.connection_descriptor;
            pmp$get_microsecond_clock (connection_entry_p^.connection_statistics.connect_time, status);
            connection_entry_p^.connection_statistics.bytes_sent := 0;
            connection_entry_p^.connection_statistics.bytes_received := 0;
            connection_entry_p^.active_pp_requests := 0;
            connection_entry_p^.waiting_tasks := NIL;
            connection_entry_p^.send_request_active := FALSE;
            connection_entry_p^.receive_request_active := FALSE;
            connection_entry_p^.residue_input_data := NIL;
            connection_entry_p^.open_count := 0;

{     Set control message header.

            connection_entry_p^.control_message_header.nad_address :=
                  incoming_connect.connect_message.nad_address;
            connection_entry_p^.control_message_header.local_tcu_enables :=
                  incoming_connect.connect_message.local_tcu_enables;
            connection_entry_p^.control_message_header.destination_device :=
                  incoming_connect.connect_message.destination_device;
            connection_entry_p^.control_message_header.access_code :=
                  incoming_connect.connect_message.access_code;
            connection_entry_p^.control_message_header.name :=
                  incoming_connect.connect_message.name;

{     Set connection attributes.

            connection_entry_p^.connection_attributes.client_name :=
                  incoming_connect.connect_message.requesting_application;
            connection_entry_p^.connection_attributes.server_name := server_name;
            connection_entry_p^.connection_attributes.client_host :=
                  incoming_connect.connect_message.source_physical_id;
            connection_entry_p^.connection_attributes.server_host :=
                  rfv$status_table.local_host^.physical_identifier;
            connection_entry_p^.connection_attributes.connection_timeout :=
                  rfv$status_table.local_host^.connection_timeout * 1000;
            connection_entry_p^.connection_attributes.data_transfer_timeout :=
                  rfv$status_table.local_host^.data_transfer_timeout * 1000;
            connection_entry_p^.connection_attributes.record_block_size :=
                  rfc$default_record_block_size;
            connection_entry_p^.connection_attributes.message_block_size :=
                  rfc$default_message_block_size;
            connection_entry_p^.connection_attributes.incoming_record_abn := 0;
            connection_entry_p^.connection_attributes.outgoing_record_abn := 0;
            connection_entry_p^.connection_attributes.acks_received_count := 0;
            connection_entry_p^.connection_attributes.acks_sent_count := 0;
            connection_entry_p^.connection_attributes.incoming_message_count := 0;
            connection_entry_p^.connection_attributes.outgoing_message_count := 0;
            connection_entry_p^.connection_attributes.receive_record_terminator :=
                  rfc$rm_eoi;
            connection_entry_p^.connection_attributes.file_mark_received :=
                  rfc$rm_null;
            connection_entry_p^.connection_attributes.send_record_terminator :=
                  rfc$rm_eoi;
            connection_entry_p^.connection_attributes.abnormal_termination := FALSE;
            merge_creation_attributes (^connection_entry_p^.connection_attributes,
                  file_attributes, ignore_status);
            rfp$set_connection_entry_p (connection_entry_p, 0, status);
            IF NOT status.normal THEN
              connection_entry_p^.connection_attributes.connection_status.connection_state :=
                    rfc$not_viable;
              rfp$unlock_table (connection_entry_p^.lock);
              EXIT /acquire_connection/;
            IFEND;

{     Set return parameters.

            client_name := connection_entry_p^.connection_attributes.client_name;
            source_host_name.host_identifier_kind := rfc$physical_identifier;
            source_host_name.physical_identifier :=
                  connection_entry_p^.connection_attributes.client_host;
            rfp$unlock_table (connection_entry_p^.lock);
            EXIT /acquire_connection/;
          ELSE
            osp$set_status_abnormal (rfc$product_id,
                  rfe$connection_not_available, server_name, status);
          IFEND;

        = osc$i_await_time =
          osp$set_status_abnormal (rfc$product_id,
                rfe$connection_not_available, server_name, status);
        CASEND;
      END /acquire_connection/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$acquire_connect_request);
    ELSE
      IF job_table_entry_p <> NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
      IFEND;
      IF local_file_created THEN
        amp$return (connection_file, ignore_status);
      IFEND;
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$acquire_connect_request);
    IFEND;
  PROCEND rfp$acquire_connect_request;
?? TITLE := '   rfp$application_sign_off', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$application_sign_off (application_name:
    rft$application_name;
    VAR status: ost$status);

*copy rfh$application_sign_off

?? NEWTITLE := '      terminate_sign_off - condition handler', EJECT ??
    PROCEDURE terminate_sign_off (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$application_sign_off;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$application_sign_off;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_sign_off;
?? OLDTITLE, EJECT ??

    VAR
      application_entry_p: ^rft$application_table_entry,
      client_definition_p: ^rft$rhfam_client_table_entry,
      current_entry_p: ^rft$application_table_entry,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_appl_name: rft$application_name,
      maximum_connections: rft$application_connections,
      new_entry: BOOLEAN,
      previous_entry_p: ^rft$application_table_entry,
      system_supplied_name: jmt$system_supplied_name;


    #keypoint (osk$entry, 0, rfk$application_sign_off);
    osp$establish_condition_handler (^terminate_sign_off, FALSE);
    status.normal := TRUE;
    local_appl_name := application_name;

  /main_section/
    BEGIN
      rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
      IF job_table_entry_p = NIL THEN
        osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
              'Application sign off', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              local_appl_name, status);
        EXIT /main_section/;
      IFEND;
      find_application_entry (local_appl_name, job_table_entry_p,
            application_entry_p);
      IF application_entry_p = NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
              'Application sign off', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              local_appl_name, status);
        EXIT /main_section/;
      IFEND;

{     Check for active connections.

      IF application_entry_p^.number_of_active_connections <> 0 THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id,
              rfe$connections_not_terminated, local_appl_name, status);
        EXIT /main_section/;
      IFEND;

{     Remove application table entry.

      maximum_connections := application_entry_p^.maximum_allowed_connections;
      current_entry_p := job_table_entry_p^.application_entry;
      previous_entry_p := NIL;
      system_supplied_name := job_table_entry_p^.job_name;

    /remove_application_entry/
      WHILE current_entry_p <> NIL DO
        IF current_entry_p^.application_name = local_appl_name THEN
          IF previous_entry_p = NIL THEN
            job_table_entry_p^.application_entry := current_entry_p^.next_entry;
            IF current_entry_p^.next_entry = NIL THEN
              remove_job_table_entry(job_table_entry_p);
            IFEND;
          ELSE
            previous_entry_p^.next_entry := current_entry_p^.next_entry;
          IFEND;
          FREE current_entry_p IN nav$network_paged_heap^;
          EXIT /remove_application_entry/;
        IFEND;
        previous_entry_p := current_entry_p;
        current_entry_p := current_entry_p^.next_entry;
      WHILEND /remove_application_entry/;

      IF job_table_entry_p <> NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
      IFEND;

      CASE application_entry_p^.application_kind OF
      = rfc$client =
        rfp$lock_table (rfv$rhfam_client_table.lock);
        rfp$find_client_entry (local_appl_name, FALSE, client_definition_p, status);
        IF status.normal THEN
          client_definition_p^.connections_reserved := client_definition_p^.
                connections_reserved - maximum_connections;
        IFEND;
        rfp$unlock_table (rfv$rhfam_client_table.lock);
      = rfc$server =
        sign_off_server (local_appl_name, system_supplied_name, maximum_connections,
              status);
      = rfc$partner =
        ;
      CASEND;

    END /main_section/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$application_sign_off);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m, rfk$application_sign_off);
    IFEND;

  PROCEND rfp$application_sign_off;
?? TITLE := '    rfp$application_sign_on', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$application_sign_on (application_name:
    rft$application_name;
        application_kind: rft$application_kinds;
    VAR maximum_connections: rft$application_connections;
    VAR status: ost$status);

*copy rfh$application_sign_on

?? NEWTITLE := '      terminate_sign_on - condition handler', EJECT ??
    PROCEDURE terminate_sign_on (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$application_sign_on;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$application_sign_on;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_sign_on;
?? OLDTITLE, EJECT ??

    VAR
      application_entry_p: ^rft$application_table_entry,
      capability: ost$name,
      client_definition_p: ^rft$rhfam_client_table_entry,
      first_application_sign_on: boolean,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_appl_kind: rft$application_kinds,
      local_appl_name: rft$application_name,
      local_max_connects: rft$application_connections,
      new_application_entry_p: ^rft$application_table_entry,
      remaining_connections: rft$application_connections,
      ring: ost$ring,
      server_definition_p: ^rft$rhfam_server_table_entry,
      system_privilege: boolean;


    #keypoint (osk$entry, 0, rfk$application_sign_on);
    osp$establish_condition_handler (^terminate_sign_on, FALSE);

    status.normal := TRUE;
    local_max_connects := maximum_connections;
    local_appl_kind := application_kind;
    local_appl_name := application_name;

  /main_section/
    BEGIN
      new_application_entry_p := NIL;
      rfp$lock_job_table_entry (TRUE, first_application_sign_on, job_table_entry_p);
      IF job_table_entry_p = NIL THEN
        osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
              'network paged', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'rfp$application_sign_on', status);
        EXIT /main_section/;
      IFEND;

{     Check for active system task.

      IF NOT rfv$status_table.system_task_is_up THEN
        osp$set_status_abnormal (rfc$product_id,
              rfe$system_task_not_active, 'rfp$application_sign_on', status);
        EXIT /main_section/
      IFEND;

      IF NOT first_application_sign_on  THEN

{     Check for duplicate sign on.

        find_application_entry(application_name, job_table_entry_p, application_entry_p);
        IF  application_entry_p <> NIL  THEN
          osp$set_status_abnormal (rfc$product_id, rfe$already_signed_on,
            application_name, status);
          EXIT /main_section/;
        IFEND;
      IFEND;

{     Allocate application table entry and preset.

      ALLOCATE new_application_entry_p IN nav$network_paged_heap^;
      IF new_application_entry_p = NIL THEN
        osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
              'network paged', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'rfp$application_sign_on', status);
        EXIT /main_section/;
      IFEND;


{     Preset new application table entry

      new_application_entry_p^.next_entry := NIL;
      new_application_entry_p^.application_name := local_appl_name;
      new_application_entry_p^.application_kind := local_appl_kind;
      new_application_entry_p^.number_of_active_connections := 0;
      new_application_entry_p^.connection_table := NIL;
      new_application_entry_p^.system_wide_connection_mgmt := FALSE;

      CASE local_appl_kind OF
      = rfc$client =
        rfp$lock_table (rfv$rhfam_client_table.lock);
        rfp$find_client_entry (application_name, TRUE, client_definition_p, status);
        IF status.normal THEN
          nap$validate_user (client_definition_p^.client_capability, client_definition_p^.client_ring,
                client_definition_p^.client_system_privilege, status);
          IF status.normal THEN
            new_application_entry_p^.system_wide_connection_mgmt :=
                             client_definition_p^.system_wide_connection_mgmt;
            remaining_connections := client_definition_p^.maximum_connections -
                  client_definition_p^.connections_reserved;
            IF local_max_connects = 0 THEN
              local_max_connects := remaining_connections;
            ELSE
              IF remaining_connections <  local_max_connects THEN
                osp$set_status_abnormal (rfc$product_id, rfe$defined_connects_exceeded,
                      application_name, status);
                osp$append_status_integer (osc$status_parameter_delimiter, local_max_connects,
                      10, FALSE, status);
              IFEND;
            IFEND;
            IF status.normal THEN
              new_application_entry_p^.maximum_allowed_connections := local_max_connects;
              client_definition_p^.connections_reserved := client_definition_p^.connections_reserved +
                    local_max_connects;
            IFEND;
          IFEND;
        IFEND;
        rfp$unlock_table (rfv$rhfam_client_table.lock);
      = rfc$server =
        rfp$lock_table (rfv$rhfam_server_table.lock);
        find_server_entry (application_name, TRUE, server_definition_p, status);
        IF status.normal THEN
          nap$validate_user (server_definition_p^.server_capability, server_definition_p^.server_ring,
                server_definition_p^.server_system_privilege, status);
          IF status.normal THEN
            sign_on_server (server_definition_p, job_table_entry_p^.job_name, local_max_connects,
                    status);
            new_application_entry_p^.maximum_allowed_connections := local_max_connects;
          IFEND;
        IFEND;
        rfp$unlock_table (rfv$rhfam_server_table.lock);
      =rfc$partner =
        rfp$lock_table (rfv$rhfam_server_table.lock);
        find_server_entry (application_name, TRUE, server_definition_p, status);
        IF status.normal THEN
          capability := server_definition_p^.server_capability;
          ring := server_definition_p^.server_ring;
          system_privilege := server_definition_p^.server_system_privilege;
          local_max_connects := server_definition_p^.maximum_connections;
          rfp$unlock_table (rfv$rhfam_server_table.lock);
        ELSE
          rfp$unlock_table (rfv$rhfam_server_table.lock);
          rfp$lock_table (rfv$rhfam_client_table.lock);
          rfp$find_client_entry (application_name, TRUE, client_definition_p, status);
          IF status.normal THEN
            capability := client_definition_p^.client_capability;
            ring := client_definition_p^.client_ring;
            system_privilege := client_definition_p^.client_system_privilege;
            local_max_connects := client_definition_p^.maximum_connections;
          IFEND;
          rfp$unlock_table (rfv$rhfam_client_table.lock);
        IFEND;
        IF status.normal THEN
          new_application_entry_p^.maximum_allowed_connections := local_max_connects;
          nap$validate_user (capability, ring, system_privilege, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (rfc$product_id, rfe$invalid_application_kind,
              'application sign on', status);
      CASEND;

      IF status.normal THEN

{     Add new application table entry to this jobs application table.

        new_application_entry_p^.next_entry := job_table_entry_p^.application_entry;
        job_table_entry_p^.application_entry := new_application_entry_p;
        job_table_entry_p^.lock := tmv$null_global_task_id;
      IFEND;

    END /main_section/;

    IF status.normal THEN
      maximum_connections := local_max_connects;
      #keypoint (osk$exit, 0, rfk$application_sign_on);
    ELSE
      IF job_table_entry_p <> NIL THEN
        IF first_application_sign_on THEN
          remove_job_table_entry(job_table_entry_p);
        ELSE
          job_table_entry_p^.lock := tmv$null_global_task_id;
        IFEND;
        IF new_application_entry_p <> NIL THEN
          FREE new_application_entry_p IN nav$network_paged_heap^;
        IFEND;
      IFEND;
      #keypoint (osk$exit, status.condition * osk$m, rfk$application_sign_on);
    IFEND;

  PROCEND rfp$application_sign_on;
?? TITLE := '    rfp$await_rhfam_event', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$await_rhfam_event (connection_identifier:
    amt$file_identifier;
        event: rft$connection_events;
        wait_time: rft$connection_timeout;
    VAR status: ost$status);

*copy rfh$await_rhfam_event

?? NEWTITLE := '      terminate_await_event - condition handler', EJECT ??
    PROCEDURE terminate_await_event (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$await_rhfam_event;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$await_rhfam_event;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_await_event;
?? OLDTITLE, EJECT ??

    VAR
      activity_completed: ost$i_wait_activity,
      ready_index: integer,
      wait_complete: boolean,
      wait_list: ARRAY [ 1 .. 2 ] OF ost$i_activity;


    #keypoint (osk$entry, 0, rfk$await_rhfam_event);
    osp$establish_condition_handler (^terminate_await_event, FALSE);

    status.normal := TRUE;
    wait_list [1].activity := rfc$i_await_connection_event;
    wait_list [1].connection_file_identifier := connection_identifier;
    wait_list [1].event_type := event;
    wait_list [2].activity := osc$i_await_time;
    wait_list [2].milliseconds := wait_time;
    osp$i_await_activity (wait_list, ready_index, wait_complete, status);

    IF status.normal THEN
      activity_completed := wait_list [ready_index].activity;
      CASE activity_completed OF
      = rfc$i_await_connection_event =
        ;
      = osc$i_await_time =
          osp$set_status_abnormal (rfc$product_id, rfe$no_available_event,
                '', status);
      CASEND;
    IFEND;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$await_rhfam_event);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m, rfk$await_rhfam_event);
    IFEND;
  PROCEND rfp$await_rhfam_event;
?? TITLE := '    rfp$await_server_response', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$await_server_response (connection_file:
        fst$file_reference;
        wait_time: rft$connection_timeout;
    VAR server_response: rft$server_response;
    VAR status: ost$status);

*copy rfh$await_server_response

?? NEWTITLE := '      terminate_await_server - condition handler', EJECT ??
    PROCEDURE terminate_await_server (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$await_server_response;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$await_server_response;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_await_server;
?? OLDTITLE, EJECT ??

    VAR
      connection_attributes: ^rft$connection_attributes,
      connection_entry_p: ^rft$connection_entry,
      first_wait: boolean,
      path_handle_name: fst$path_handle_name,
      ready_index: integer,
      remote_host: rft$logical_identifier,
      wait_complete: boolean,
      wait_list: ARRAY [ 1 .. 2 ] OF ost$i_activity;


    #keypoint (osk$entry, 0, rfk$await_server_response);
    osp$establish_condition_handler (^terminate_await_server, FALSE);

    status.normal := TRUE;
    first_wait := TRUE;

    get_path_handle_name (connection_file, path_handle_name, status);
    IF NOT status.normal THEN
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$await_server_response);
      EXIT rfp$await_server_response;
    IFEND;

  /await_server_response/
    WHILE status.normal DO
      get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
      IF NOT status.normal THEN
        EXIT /await_server_response/;
      IFEND;
      connection_attributes := ^connection_entry_p^.connection_attributes;
      CASE connection_attributes^.connection_status.connection_state OF
      = rfc$connected =
        rfp$unlock_table (connection_entry_p^.lock);
        status.normal := TRUE;
        server_response.server_response_kind := rfc$accept;
        EXIT /await_server_response/;
      = rfc$outgoing_connect_active =
        IF first_wait THEN
          rfp$unlock_table (connection_entry_p^.lock);
          first_wait := FALSE;
          wait_list [1].activity := rfc$i_await_server_response;
          wait_list [1].file := ^connection_file;
          wait_list [2].activity := osc$i_await_time;
          wait_list [2].milliseconds := wait_time;
          osp$i_await_activity (wait_list, ready_index, wait_complete, status);
          IF status.normal THEN
            CASE wait_list[ready_index].activity OF
            = rfc$i_await_server_response =
              CYCLE /await_server_response/;
            = osc$i_await_time =
              osp$set_status_abnormal (rfc$product_id, rfe$no_server_response,
                    path_handle_name, status);
              EXIT /await_server_response/;
            CASEND;
          ELSE
            status.normal := TRUE;
            CYCLE /await_server_response/;
          IFEND;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$no_server_response,
                path_handle_name, status);
        IFEND;
      = rfc$connect_rejected =
        CASE connection_attributes^.destination_host.host_identifier_kind OF
          = rfc$logical_identifier =
            remote_host := connection_attributes^.destination_host.logical_identifier;
          = rfc$physical_identifier =
            remote_host := connection_attributes^.destination_host.physical_identifier;
        ELSE
          ;     { This should never happen }
        CASEND;
        CASE connection_attributes^.connection_status.server_response OF
        = rfc$nbp_requested_server_busy, rfc$nbp_server_unavailable =
          osp$set_status_abnormal (rfc$product_id, rfe$server_busy,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.server_name, status);
        = rfc$nbp_requested_host_busy =
          osp$set_status_abnormal (rfc$product_id, rfe$remote_host_busy, remote_host,
                status);
        = rfc$nbp_server_disabled =
          osp$set_status_abnormal (rfc$product_id, rfe$server_disabled,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.server_name, status);
        = rfc$nbp_server_lid_disabled, rfc$nbp_pid_lid_not_available =
          osp$set_status_abnormal (rfc$product_id, rfe$server_lid_disabled,
                connection_attributes^.server_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                remote_host, status);
        = rfc$nbp_client_disabled =
          osp$set_status_abnormal (rfc$product_id, rfe$client_disabled,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.client_name, status);
        = rfc$nbp_client_pid_disabled =
          osp$set_status_abnormal (rfc$product_id, rfe$client_pid_disabled,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.client_host, status);
        = rfc$nbp_client_nad_disabled =
          osp$set_status_abnormal (rfc$product_id, rfe$client_nad_disabled,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                rfv$status_table.local_nads^ [connection_entry_p^.connection_descriptor.nad_index]
                .name, status);
        = rfc$nbp_tcu_disabled =
          osp$set_status_abnormal (rfc$product_id, rfe$tcu_disabled,
                remote_host, status);
        = rfc$nbp_rhf_not_active =
          osp$set_status_abnormal (rfc$product_id, rfe$rhf_not_active,
                remote_host, status);
        = rfc$nbp_rhf_shutdown, rfc$nbp_shutdown =
              osp$set_status_abnormal (rfc$product_id, rfe$remote_rhf_shutdown,
                    remote_host, status);
        = rfc$nbp_server_undefined =
          osp$set_status_abnormal (rfc$product_id, rfe$server_undefined,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.server_name, status);
        = rfc$nbp_server_lid_undefined =
          osp$set_status_abnormal (rfc$product_id, rfe$server_lid_undefined,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                remote_host, status);
        = rfc$nbp_client_undefined, rfc$nbp_requesting_appl_unknown =
          osp$set_status_abnormal (rfc$product_id, rfe$client_undefined,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.client_name, status);
        = rfc$nbp_client_pid_undefined =
          osp$set_status_abnormal (rfc$product_id, rfe$client_pid_undefined,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.client_host, status);
        = rfc$nbp_password_undefined, rfc$nbp_invalid_password =
          osp$set_status_abnormal (rfc$product_id, rfe$password_undefined,
                remote_host, status);
        = rfc$nbp_client_nad_undefined =
          osp$set_status_abnormal (rfc$product_id, rfe$client_nad_undefined,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                rfv$status_table.local_nads^ [connection_entry_p^.connection_descriptor.nad_index]
                .name, status);
        = rfc$nbp_access_code_invalid =
          osp$set_status_abnormal (rfc$product_id, rfe$access_code_invalid,
                remote_host, status);
        = rfc$nbp_device_invalid =
          osp$set_status_abnormal (rfc$product_id, rfe$device_invalid,
                remote_host, status);
        = rfc$nbp_tcu_invalid =
          osp$set_status_abnormal (rfc$product_id, rfe$tcu_invalid,
                remote_host, status);

{     Discontinued reject codes.

        = rfc$nbp_path_unavailable =
          osp$set_status_abnormal (rfc$product_id, rfe$client_nad_disabled,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                rfv$status_table.local_nads^ [connection_entry_p^.connection_descriptor.nad_index]
                .name, status);
        = rfc$nbp_resources_not_available =
          osp$set_status_abnormal (rfc$product_id, rfe$server_busy,
                remote_host, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                connection_attributes^.server_name, status);

{     Server reject codes.

        = rfc$min_server_reject_code .. rfc$max_server_reject_code =
          osp$set_status_abnormal (rfc$product_id, rfe$server_reject_response,
                connection_attributes^.server_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                remote_host, status);
          server_response.server_response_kind := rfc$reject;
          server_response.server_reject_code := connection_attributes^.
                connection_status.server_response;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$unknown_reject_code,
                remote_host, status);
          osp$append_status_integer (osc$status_parameter_delimiter, connection_attributes^.
                connection_status.server_response, 10, FALSE, status);
        CASEND;
        osp$append_status_parameter (osc$status_parameter_delimiter,
              connection_entry_p^.connection_name, status);
      ELSE
        set_connection_status (connection_entry_p, status);
      CASEND;
      rfp$unlock_table (connection_entry_p^.lock);

    WHILEND /await_server_response/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$await_server_response);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$await_server_response);
    IFEND;
  PROCEND rfp$await_server_response;
?? TITLE := '    rfp$cancel_switch_offer', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$cancel_switch_offer (connection_file:
        fst$file_reference;
    VAR status: ost$status);

*copy rfh$cancel_switch_offer

?? NEWTITLE := '      terminate_cancel_switch - condition handler', EJECT ??
    PROCEDURE terminate_cancel_switch (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$cancel_switch_offer;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$cancel_switch_offer;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_cancel_switch;
?? OLDTITLE, EJECT ??

    VAR
      connection_entry_p: ^rft$connection_entry,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      path_handle_name: fst$path_handle_name;


    #keypoint (osk$entry, 0, rfk$cancel_switch_offer);
    osp$establish_condition_handler (^terminate_cancel_switch, FALSE);
    status.normal := TRUE;

  /cancel_switch_offer/
    BEGIN
      get_path_handle_name (connection_file, path_handle_name, status);
      IF NOT status.normal THEN
        EXIT /cancel_switch_offer/;
      IFEND;
      get_exclusive_to_job (path_handle_name, job_table_entry_p,
            connection_entry_p, status);
      IF NOT status.normal THEN
        EXIT /cancel_switch_offer/;
      IFEND;

      CASE connection_entry_p^.connection_attributes.connection_status.connection_state OF
      = rfc$switch_offered =
        remove_switch_offer (job_table_entry_p^.job_name, connection_entry_p);
        IF connection_entry_p^.connection_attributes.connection_status.
              connection_state = rfc$switch_accepted THEN
          set_connection_status (connection_entry_p, status);
        IFEND;
      ELSE
        set_connection_status (connection_entry_p, status);
      CASEND;
      rfp$unlock_table (connection_entry_p^.lock);
      job_table_entry_p^.lock := tmv$null_global_task_id;
    END /cancel_switch_offer/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$cancel_switch_offer);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$cancel_switch_offer);
    IFEND;
  PROCEND rfp$cancel_switch_offer;
?? TITLE := '    rfp$find_available_service', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$find_available_service (server_name:
    rft$application_name;
        destination_host: rft$host_identifier;
    VAR host_identifiers: rft$destination_hosts;
    VAR number_of_hosts: rft$number_of_hosts;
    VAR status: ost$status);

*copy rfh$find_available_service

?? NEWTITLE := '      terminate_find_service - condition handler', EJECT ??
    PROCEDURE terminate_find_service (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$find_available_service;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$find_available_service;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_find_service;
?? OLDTITLE, EJECT ??


    VAR
      host_identifier_p: ^rft$destination_hosts,
      map_lid_to_pid: boolean,
      selected_path_p: ^rft$lcn_path_definition,
      selected_pid: rft$physical_identifier,
      server_available_locally: boolean,
      server_entry_p: ^rft$rhfam_server_table_entry;

    #keypoint (osk$entry, 0, rfk$find_available_service);
    osp$establish_condition_handler (^terminate_find_service, FALSE);

    status.normal := TRUE;
    server_available_locally := FALSE;
    rfp$lock_table (rfv$rhfam_server_table.lock);
    find_server_entry (server_name, TRUE, server_entry_p, status);
    IF status.normal THEN
      server_available_locally := TRUE;
    IFEND;
    rfp$unlock_table (rfv$rhfam_server_table.lock);

    rfp$lock_table (rfv$status_table.lock);
    IF rfv$status_table.system_task_is_up THEN
      host_identifier_p := ^host_identifiers;
      search_for_path (server_name, destination_host, server_available_locally,
            selected_path_p, selected_pid, host_identifier_p, number_of_hosts,
            map_lid_to_pid, status);
    ELSE
      osp$set_status_abnormal (rfc$product_id,
            rfe$system_task_not_active, 'rfp$find_available_service', status);
    IFEND;
    rfp$unlock_table (rfv$status_table.lock);

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$find_available_service);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$find_available_service);
    IFEND;
  PROCEND rfp$find_available_service;
?? TITLE := '    rfp$offer_connection_switch', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$offer_connection_switch (connection_file:
        fst$file_reference;
        destination_job: jmt$system_supplied_name;
        wait_time: rft$connection_timeout;
    VAR status: ost$status);

*copy rfh$offer_connection_switch


?? NEWTITLE := '      terminate_offer_connection - condition handler', EJECT ??
    PROCEDURE terminate_offer_connection (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      VAR
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        block_exit_expected := TRUE;
        EXIT rfp$offer_connection_switch;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          current_request := rfv$outstanding_requests;
        /complete_synchronous_request/
          WHILE current_request <> NIL DO
            IF (current_request^.request_id.ring_1_id.address <> NIL) AND
               (NOT current_request^.request_id.ring_1_id.address^.asynchronous_request) THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              REPEAT
                #SPOIL (activity_status^);
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
              UNTIL activity_status^.complete;
              FREE activity_status  IN osv$task_private_heap^;
              current_request := rfv$outstanding_requests;
              EXIT /complete_synchronous_request/;
            IFEND;
            current_request := current_request^.next_entry;
          WHILEND /complete_synchronous_request/;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_path_status THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          block_exit_expected := TRUE;
          EXIT rfp$offer_connection_switch;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_offer_connection;
?? OLDTITLE, EJECT ??


    VAR
      block_exit_expected: boolean,
      connection_entry_p: ^rft$connection_entry,
      connection_unlocked: boolean,
      input_available: boolean,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_destination_job: jmt$system_supplied_name,
      path_handle_name: fst$path_handle_name,
      ready_index: integer,
      wait_complete: boolean,
      wait_list: ARRAY [ 1 .. 2 ] OF ost$i_activity;

    #keypoint (osk$entry, 0, rfk$offer_connection_switch);
    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_offer_connection, TRUE);
    status.normal := TRUE;
    local_destination_job := destination_job;

  /offer_connection_switch/
    BEGIN
    get_path_handle_name (connection_file, path_handle_name, status);
    IF NOT status.normal THEN
      EXIT /offer_connection_switch/;
    IFEND;

    get_exclusive_to_job (path_handle_name, job_table_entry_p,
          connection_entry_p, status);
    IF NOT status.normal THEN
      EXIT /offer_connection_switch/;
    IFEND;

    update_connection_status(connection_entry_p, input_available,
          connection_unlocked, status);

{     During the connection process, an application may be able
{     to get to this code before the system task has time to
{     update the path status table with the correct path state.
{     If this occurs, update_connection_status will unlock the
{     connection and retrieve the path status.  If this case the
{     status returned will be normal but the connection will be
{     unlocked and it is assumed that the connection state in the
{     connection entry is correct.

    IF connection_unlocked THEN
      IF status.normal THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
        get_exclusive_to_job (path_handle_name, job_table_entry_p,
              connection_entry_p, status);
        IF NOT status.normal THEN
          EXIT /offer_connection_switch/;
        IFEND;
      ELSE
        job_table_entry_p^.lock := tmv$null_global_task_id;
        EXIT /offer_connection_switch/;
      IFEND;
    IFEND;

    CASE connection_entry_p^.connection_attributes.
          connection_status.connection_state OF
    = rfc$connected =
      IF connection_entry_p^.open_count <> 0 THEN
        rfp$unlock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id, rfe$file_not_closed,
              path_handle_name, status);
        EXIT /offer_connection_switch/;
      IFEND;
      enter_switched_connect_queue  (local_destination_job, connection_entry_p, status);
      IF NOT status.normal THEN
        rfp$unlock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        EXIT /offer_connection_switch/;
      IFEND;
      wakeup_wait_switch_offers (connection_entry_p^.application_entry_p^.application_name);
      IF wait_time <> 0 THEN
        rfp$unlock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        wait_list[1].activity := rfc$i_await_switch_accept;
        wait_list[1].connection_file := ^connection_file;
        wait_list[2].activity := osc$i_await_time;
        wait_list[2].milliseconds := wait_time;
        osp$i_await_activity (wait_list, ready_index, wait_complete, status);
        IF status.normal THEN
          CASE wait_list[ready_index].activity OF
          = rfc$i_await_switch_accept =
            ;
          = osc$i_await_time =
            osp$set_status_abnormal (rfc$product_id, rfe$switch_offer_not_accepted,
                  path_handle_name, status);
          CASEND;
        IFEND;
      ELSE
        rfp$unlock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id, rfe$switch_offer_not_accepted,
              path_handle_name, status);
      IFEND;
    ELSE
      set_connection_status( connection_entry_p, status);
      rfp$unlock_table (connection_entry_p^.lock);
      job_table_entry_p^.lock := tmv$null_global_task_id;
    CASEND;
    END /offer_connection_switch/;
    osp$disestablish_cond_handler;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$offer_connection_switch);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m, rfk$offer_connection_switch);
    IFEND;
  PROCEND rfp$offer_connection_switch;
?? TITLE := '    rfp$receive_data', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$receive_data (connection_identifier:
    amt$file_identifier;
        transmission_mode: rft$transmission_modes;
        data_buffer: rft$data_buffers;
        wait: ost$wait;
    VAR activity: ost$activity_status;
    VAR data_received: rft$bytes_transferred;
    VAR end_of_message: boolean;
    VAR status: ost$status);

*copy rfh$receive_data


{     NOTE: If this routine is to be called at a ring level below ring3,
{       the VAR parameters must be allocated in a segment that is
{       writable by ring 3 code.  Pointers to this variable are stored in
{       a task private segment and thus inherit ring 3 privileges.


?? NEWTITLE := '      terminate_receive_data - condition handler', EJECT ??
    PROCEDURE terminate_receive_data (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        activities: rft$set_of_async_activities,
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        local_status: ost$status,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests,
        transfer_status: ^rft$data_transfer_status;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        IF wait = osc$wait THEN
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
        ELSE
          osp$set_status_from_condition (rfc$product_id, condition, sfsa,
                activity.status, condition_status);
          activity.complete := TRUE;
        IFEND;
        block_exit_expected := TRUE;
        EXIT rfp$receive_data;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          activities := $rft$set_of_async_activities[rfc$aa_receive_data];
          terminate_async_activity (activities, connection_name);
          current_request := rfv$outstanding_requests;
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_path_status THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              current_request := current_request^.next_entry;
              syp$cycle;
              rfp$process_pp_response_flag (rfc$pp_response_available);
              IF activity_status^.complete THEN
                FREE activity_status  IN osv$task_private_heap^;
              IFEND;
              current_request := rfv$outstanding_requests;
            ELSEIF current_request^.request_kind = rfc$rk_receive_data THEN
              transfer_status := current_request^.request_status;
              activity_status := transfer_status^.activity_status;
              current_request := current_request^.next_entry;
              IF transfer_status^.connection_name = connection_name THEN
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
                current_request := rfv$outstanding_requests;
              IFEND;
            ELSE
              current_request := current_request^.next_entry;
            IFEND;
          WHILEND;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                local_status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_path_status THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            ELSEIF current_request^.request_kind = rfc$rk_receive_data THEN
              transfer_status := current_request^.request_status;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE transfer_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          IF wait = osc$wait THEN
            osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                  condition_status);
          ELSE
            osp$set_status_from_condition (rfc$product_id, condition, sfsa,
                  activity.status, condition_status);
            activity.complete := TRUE;
          IFEND;
          block_exit_expected := TRUE;
          EXIT rfp$receive_data;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_receive_data;
?? OLDTITLE, EJECT ??

    VAR
      activity_completed: ost$i_wait_activity,
      block_exit_expected: boolean,
      cell_to_verify: ^^cell,
      connection_entry_p: ^rft$connection_entry,
      connection_name: fst$path_handle_name,
      connection_status: rft$connection_status,
      connection_unlocked: boolean,
      data_length: rft$data_length,
      data_transfer_status: ^rft$data_transfer_status,
      index: integer,
      input_available: boolean,
      last_data_cell: ^cell,
      local_status: ost$status,
      network_wired_data: boolean,
      number_of_fragments: integer,
      pva_valid: boolean,
      ready_index: integer,
      receive_request_active: boolean,
      residue_input_data: ^rft$residue_data,
      starting_fragment: rft$data_fragment_count,
      wait_complete: boolean,
      wait_list: ARRAY [ 1 .. 2 ] OF ost$i_activity,
      write_only_pva: boolean;


    #keypoint (osk$entry, 0, rfk$receive_data);
    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_receive_data, TRUE);
    status.normal := TRUE;
    activity.complete := FALSE;
    activity.status.normal := TRUE;
    data_received := 0;
    end_of_message := FALSE;

    /main_program/
    BEGIN

{     Validate data fragments.

      data_length := 0;
      number_of_fragments := 0;
      write_only_pva := FALSE;
      starting_fragment := LOWERBOUND(data_buffer^);
      cell_to_verify := ^last_data_cell;
      /validate_data_fragments/
      FOR index := LOWERBOUND(data_buffer^) TO UPPERBOUND(data_buffer^) DO
        IF data_buffer^[index].length > 0 THEN
          last_data_cell := i#ptr(data_buffer^[index].length,
                data_buffer^[index].address);
          pva_valid := mmp$verify_access (cell_to_verify, mmc$va_read_write);
          IF NOT pva_valid THEN
            pva_valid := mmp$verify_access (cell_to_verify, mmc$va_write);
            IF NOT pva_valid THEN
              osp$set_status_abnormal(rfc$product_id, rfe$invalid_data_fragment,
                    'receive data', status);
              EXIT /main_program/;
            IFEND;
            write_only_pva := TRUE;
          IFEND;
          IF number_of_fragments = 0 THEN
            starting_fragment := index;
          IFEND;
          number_of_fragments := number_of_fragments + 1;
          data_length := data_length + data_buffer^[index].length;
        IFEND;
      FOREND /validate_data_fragments/;

      IF number_of_fragments = 0 THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_data_fragment,
              'receive data', status);
        EXIT /main_program/;
      IFEND;

      /wait_for_input_available/
      REPEAT
        /wait_for_active_receive/
        REPEAT
          get_exclusive_to_cid (connection_identifier, connection_entry_p, status);
          IF NOT status.normal THEN
            EXIT /main_program/;
          IFEND;

          receive_request_active := connection_entry_p^.receive_request_active;
          IF receive_request_active THEN
            IF wait = osc$wait THEN
              enter_waiting_task_queue(connection_entry_p, local_status);
              rfp$unlock_table (connection_entry_p^.lock);
              pmp$wait(10000, 10000);
            ELSE
              rfp$unlock_table (connection_entry_p^.lock);
              osp$set_status_abnormal (rfc$product_id, rfe$receive_data_active,
                  connection_entry_p^.connection_name, status);
             EXIT /main_program/;
            IFEND;
          IFEND;

        UNTIL NOT receive_request_active;

        update_connection_status (connection_entry_p, input_available,
              connection_unlocked, status);
        IF connection_unlocked THEN
          EXIT /main_program/;
        IFEND;

        connection_status := connection_entry_p^.connection_attributes.connection_status;
        IF connection_status.connection_state <> rfc$connected THEN
          IF NOT ((connection_status.connection_state = rfc$terminated) AND
                  (connection_status.reason_for_termination = rfc$peer_termination) AND
                  (input_available)) THEN
            set_connection_status (connection_entry_p, status);
            rfp$unlock_table (connection_entry_p^.lock);
            EXIT /main_program/;
          IFEND;
        IFEND;

        IF NOT input_available THEN
          rfp$unlock_table (connection_entry_p^.lock);
          wait_list [1].activity := rfc$i_await_connection_event;
          wait_list [1].connection_file_identifier := connection_identifier;
          wait_list [1].event_type := rfc$input_available;
          wait_list [2].activity := osc$i_await_time;
          wait_list [2].milliseconds := connection_entry_p^.connection_attributes.
                data_transfer_timeout;
          osp$i_await_activity (wait_list, ready_index, wait_complete, status);

          IF status.normal THEN
            activity_completed := wait_list [ready_index].activity;
            CASE activity_completed OF
            = rfc$i_await_connection_event =
              input_available := FALSE;
              CYCLE /wait_for_input_available/;
            = osc$i_await_time =
              osp$set_status_abnormal (rfc$product_id, rfe$transfer_timeout,
                    'Send data', status);
              EXIT /main_program/;
            CASEND;
          ELSE
            EXIT /main_program/;
          IFEND;
        IFEND;
      UNTIL input_available;


      connection_name := connection_entry_p^.connection_name;
      IF (#OFFSET(data_buffer^[starting_fragment].address) MOD 8) <> 0 THEN
        network_wired_data := TRUE;
      ELSEIF (transmission_mode = rfc$message_mode) AND (connection_entry_p^.connection_attributes.
            message_block_size MOD 8 <> 0) THEN
        network_wired_data := TRUE;
      ELSEIF (transmission_mode = rfc$record_mode) AND (connection_entry_p^.connection_attributes.
            record_block_size MOD 8 <> 0) THEN
        network_wired_data := TRUE;
      ELSEIF  data_buffer^[starting_fragment].length < rfc$min_unwired_data_length THEN
        network_wired_data := TRUE;
      ELSEIF write_only_pva THEN
        network_wired_data := TRUE;
      ELSE
        network_wired_data := FALSE;
      IFEND;

      ALLOCATE data_transfer_status IN osv$task_private_heap^;
      IF data_transfer_status = NIL THEN
        rfp$unlock_table (connection_entry_p^.lock);
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
              'task private', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'rfp$receive_data',
              status);
        EXIT /main_program/;
      IFEND;
      data_transfer_status^.connection_name := connection_entry_p^.connection_name;
      data_transfer_status^.connection_entry_p := connection_entry_p;
      data_transfer_status^.transmission_mode := transmission_mode;
      data_transfer_status^.data_area := data_buffer;
      data_transfer_status^.wait := wait;
      data_transfer_status^.activity_status := ^activity;
      data_transfer_status^.data_transferred := ^data_received;
      data_transfer_status^.end_of_message_p := ^end_of_message;
      IF transmission_mode = rfc$message_mode THEN
        data_transfer_status^.block_size := connection_entry_p^.connection_attributes.
              message_block_size;
      ELSE
        data_transfer_status^.block_size := connection_entry_p^.connection_attributes.
              record_block_size;
      IFEND;
      data_transfer_status^.file_mark := connection_entry_p^.connection_attributes.receive_record_terminator;
      data_transfer_status^.connection_descriptor := connection_entry_p^.connection_descriptor;
      data_transfer_status^.network_wired_data := network_wired_data;
      data_transfer_status^.next_to_queue_abn := connection_entry_p^.connection_attributes.
            incoming_record_abn;
      data_transfer_status^.next_to_queue_index := starting_fragment;
      data_transfer_status^.next_to_queue_offset := 0;
      data_transfer_status^.bytes_transferred := 0;
      data_transfer_status^.previous_error.normal := TRUE;
      data_transfer_status^.transfer_kind := rfc$tk_receive_data;
      data_transfer_status^.file_mark_received := rfc$rm_null;
      data_transfer_status^.complete_message_received := FALSE;
      data_transfer_status^.outstanding_control_messages := NIL;
      data_transfer_status^.control_message_header := connection_entry_p^.control_message_header;
      data_transfer_status^.control_message_header.my_path_id :=
            connection_entry_p^.connection_descriptor.network_path;
      data_transfer_status^.control_message_header.connection_number :=
            connection_entry_p^.connection_descriptor.network_path;
      connection_entry_p^.receive_request_active := TRUE;
      residue_input_data := connection_entry_p^.residue_input_data;
      rfp$unlock_table (connection_entry_p^.lock);
      start_receive_data (data_transfer_status, data_length, residue_input_data, status);
      #SPOIL (activity);
      IF (activity.complete) OR
         (NOT status.normal) THEN
        EXIT /main_program/;
      IFEND;

      IF wait = osc$wait THEN
        REPEAT
          #SPOIL (activity);
          pmp$wait (rfc$unit_request_wait_time,rfc$ur_expected_wait);
          rfp$process_pp_response_flag (rfc$pp_response_available);
        UNTIL activity.complete;
      IFEND;

    END /main_program/;

    osp$disestablish_cond_handler;
    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$receive_data);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m, rfk$receive_data);
    IFEND;
  PROCEND rfp$receive_data;
?? TITLE := '    rfp$reject_connect_request', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$reject_connect_request (connection_file:
        fst$file_reference;
        server_response: rft$server_reject_codes;
    VAR status: ost$status);

*copy rfh$reject_connect_request

?? NEWTITLE := '      terminate_reject_connect - condition handler', EJECT ??
    PROCEDURE terminate_reject_connect (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      VAR
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        block_exit_expected := TRUE;
        EXIT rfp$reject_connect_request;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          current_request := rfv$outstanding_requests;
        /complete_synchronous_request/
          WHILE current_request <> NIL DO
            IF (current_request^.request_id.ring_1_id.address <> NIL) AND
               (NOT current_request^.request_id.ring_1_id.address^.asynchronous_request) THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              REPEAT
                #SPOIL (activity_status^);
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
              UNTIL activity_status^.complete;
              FREE activity_status  IN osv$task_private_heap^;
              current_request := rfv$outstanding_requests;
              EXIT /complete_synchronous_request/;
            IFEND;
            current_request := current_request^.next_entry;
          WHILEND /complete_synchronous_request/;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_reject_connect_request THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          block_exit_expected := TRUE;
          EXIT rfp$reject_connect_request;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_reject_connect;
?? OLDTITLE, EJECT ??

    VAR
      activity_status: ^ost$activity_status,
      block_exit_expected: boolean,
      command_identifier: ^rft$logical_commands,
      connection_entry_p: ^rft$connection_entry,
      ignore_status: ost$status,
      nad_index: rft$local_nads,
      path_handle_name: fst$path_handle_name,
      path_id: ^rft$path_identifier,
      reject_code: ^rft$reject_code,
      request_complete: boolean,
      request_info: ^SEQ ( * ),
      unit_request_status: ^rft$connection_mgmt_status;

    #keypoint (osk$entry, 0, rfk$reject_connect_request);
    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_reject_connect, TRUE);
    status.normal := TRUE;

  /reject_connect_request/
    BEGIN
      get_path_handle_name (connection_file, path_handle_name, status);
      IF NOT status.normal THEN
        EXIT /reject_connect_request/;
      IFEND;

      get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
      IF NOT status.normal THEN
        EXIT /reject_connect_request/;
      IFEND;
      CASE connection_entry_p^.connection_attributes.connection_status.connection_state OF
      = rfc$incoming_connect_active =
      /queue_reject_request/
        BEGIN
          PUSH request_info: [[rft$logical_commands, rft$path_identifier,rft$reject_code]];
          RESET request_info;
          NEXT command_identifier  IN  request_info;
          IF  command_identifier = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                  'the request overflowed the request sequence', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$reject_connect_request', status);
            EXIT  /queue_reject_request/;
          IFEND;
          command_identifier^ := rfc$lc_reject_connect_request;
          NEXT  path_id  IN  request_info;
          IF  path_id = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                  'the request overflowed the request sequence', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$reject_connect_request', status);
            EXIT  /queue_reject_request/;
          IFEND;
          path_id^ := connection_entry_p^.connection_descriptor.network_path;
          NEXT  reject_code  IN  request_info;
          IF  reject_code = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                  'the request overflowed the request sequence', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$reject_connect_request', status);
            EXIT  /queue_reject_request/;
          IFEND;
          reject_code^ := server_response;
          ALLOCATE unit_request_status IN osv$task_private_heap^;
          IF  unit_request_status = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                  'task private', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$reject_connect_request', status);
            EXIT /queue_reject_request/;
          IFEND;
          unit_request_status^.internal_use := FALSE;
          unit_request_status^.connection := connection_entry_p;

{     The structure activity status is allocated in task private to insure
{     it is writeable by ring 3 code. Pointers to this variable are stored in
{     a task private segment and thus inherit ring 3 privileges.

          ALLOCATE activity_status IN osv$task_private_heap^;
          IF  activity_status = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                  'task private', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
                  'rfp$reject_connect_request', status);
            EXIT /queue_reject_request/;
          IFEND;
          unit_request_status^.activity_status := activity_status;
          activity_status^.complete := FALSE;
          activity_status^.status.normal := TRUE;
          nad_index := connection_entry_p^.connection_descriptor.nad_index;
          connection_entry_p^.active_pp_requests :=
                connection_entry_p^.active_pp_requests + 1;
          rfp$unlock_table (connection_entry_p^.lock);
          rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_reject_connect_request,
                unit_request_status, request_info, status);
          IF  NOT status.normal  THEN
            rfp$lock_table (connection_entry_p^.lock);
            connection_entry_p^.active_pp_requests :=
                  connection_entry_p^.active_pp_requests - 1;
            rfp$unlock_table (connection_entry_p^.lock);
            amp$return (connection_file, ignore_status);
            EXIT  /reject_connect_request/;
          IFEND;
          REPEAT
            #SPOIL (activity_status^);
            pmp$wait (rfc$unit_request_wait_time,rfc$ur_expected_wait);
            rfp$process_pp_response_flag (rfc$pp_response_available);
          UNTIL activity_status^.complete;
          IF NOT activity_status^.status.normal THEN
            status := activity_status^.status;
          IFEND;
          FREE activity_status IN osv$task_private_heap^;
          amp$return (connection_file, ignore_status);
          EXIT /reject_connect_request/;
        END /queue_reject_request/;
        rfp$unlock_table (connection_entry_p^.lock);
      ELSE
        set_connection_status (connection_entry_p, status);
        rfp$unlock_table (connection_entry_p^.lock);
      CASEND;

    END /reject_connect_request/;

    osp$disestablish_cond_handler;
    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$reject_connect_request);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$reject_connect_request);
    IFEND;
  PROCEND rfp$reject_connect_request;
?? TITLE := '    rfp$request_connection', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$request_connection (client_name:
    rft$application_name;
        server_name: rft$application_name;
        destination_host: rft$host_identifier;
        connection_file: fst$file_reference;
        file_attributes: ^rft$create_attributes;
    VAR status: ost$status);

*copy rfh$request_connection

?? NEWTITLE := '      terminate_request_connection - condition handler', EJECT ??
    PROCEDURE terminate_request_connection (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        block_exit_expected := TRUE;
        amp$return (connection_file, ignore_status);
        EXIT rfp$request_connection;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          current_request := rfv$outstanding_requests;
        /complete_synchronous_request/
          WHILE current_request <> NIL DO
            IF (current_request^.request_id.ring_1_id.address <> NIL) AND
               (NOT current_request^.request_id.ring_1_id.address^.asynchronous_request) THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              REPEAT
                #SPOIL (activity_status^);
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
              UNTIL activity_status^.complete;
              FREE activity_status  IN osv$task_private_heap^;
              current_request := rfv$outstanding_requests;
              EXIT /complete_synchronous_request/;
            IFEND;
            current_request := current_request^.next_entry;
          WHILEND /complete_synchronous_request/;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                status);
          amp$return (connection_file, ignore_status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          amp$return (connection_file, ignore_status);
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_request_connection THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          block_exit_expected := TRUE;
          EXIT rfp$request_connection;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_request_connection;
?? OLDTITLE, EJECT ??

    VAR
      application_entry_p: ^rft$application_table_entry,
      associated_path: ^rft$lcn_path_definition,
      block_exit_expected: boolean,
      client_entry_p: ^rft$rhfam_client_table_entry,
      connection_attributes: rft$connection_attributes,
      connect_request: rft$nbp_outgoing_connect,
      connection_descriptor: rft$connection_descriptor,
      connection_entry_p: ^rft$connection_entry,
      connection_timeout: rft$connection_timeout,
      connections_incremented: boolean,
      data_transfer_timeout: rft$transfer_timeout,
      ignore_status: ost$status,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_file_created: boolean,
      new_entry: BOOLEAN,
      path_handle_name: fst$path_handle_name,
      physical_identifier: rft$physical_identifier,
      server_available_locally: boolean,
      server_entry_p: ^rft$rhfam_server_table_entry,
      server_host_pid: rft$physical_identifier;


    #keypoint (osk$entry, 0, rfk$request_connection);
    local_file_created := FALSE;
    connections_incremented := FALSE;
    job_table_entry_p := NIL;
    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_request_connection, TRUE);
    status.normal := TRUE;

    /request_connection/
      BEGIN

{     Verify creation file attributes.

        merge_creation_attributes (^connection_attributes, file_attributes, status);
        IF NOT status.normal THEN
          EXIT /request_connection/;
        IFEND;

        fmp$create_rhfam_file (connection_file, status);
        IF NOT status.normal THEN
          EXIT /request_connection/;
        IFEND;
        local_file_created := TRUE;
        get_path_handle_name (connection_file, path_handle_name, status);
        IF NOT status.normal THEN
          EXIT /request_connection/;
        IFEND;

{     Lock the job table entry.

        rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
        IF job_table_entry_p = NIL THEN
          osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
                'Request connection', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, client_name,
                status);
          EXIT /request_connection/;
        IFEND;

{     Get pointer to application table entry.

        find_application_entry (client_name, job_table_entry_p, application_entry_p);
        IF application_entry_p = NIL THEN
          osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
                'Request_connection', status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                client_name, status);
          EXIT /request_connection/;
        IFEND;

{     Check for application type client.

        IF application_entry_p^.application_kind <> rfc$client THEN
          osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on_as_client,
                'rfp$request_connection', status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                job_table_entry_p^.job_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, client_name, status);
          EXIT /request_connection/;
        IFEND;

{     Check if maximum connections allowed for this client is exceeded.

        IF (NOT application_entry_p^.system_wide_connection_mgmt) AND
           (application_entry_p^.maximum_allowed_connections <=
                application_entry_p^.number_of_active_connections) THEN
          osp$set_status_abnormal (rfc$product_id, rfe$exceeded_connect_limit,
                'Request connection', status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                client_name, status);
          EXIT /request_connection/;
        IFEND;

{     Check if maximum connections allowed for all clients is exceeded.

        rfp$lock_table (rfv$rhfam_client_table.lock);
        rfp$find_client_entry (client_name, TRUE, client_entry_p, status);
        IF status.normal THEN
          IF client_entry_p^.current_connections < client_entry_p^.maximum_connections THEN
            client_entry_p^.current_connections := client_entry_p^.current_connections + 1;
            connections_incremented := TRUE;
          ELSE
            osp$set_status_abnormal (rfc$product_id, rfe$max_appl_connects_exceeded,
                  client_name, status);
          IFEND;
        IFEND;
        rfp$unlock_table (rfv$rhfam_client_table.lock);
        IF NOT status.normal THEN
          EXIT /request_connection/;
        IFEND;

{     Check if server is available locally.

        rfp$lock_table (rfv$rhfam_server_table.lock);
        find_server_entry (server_name, TRUE, server_entry_p, ignore_status);
        rfp$unlock_table (rfv$rhfam_server_table.lock);
        server_available_locally := ignore_status.normal;

{     Build connect request.

        rfp$lock_table (rfv$status_table.lock);
        IF rfv$status_table.system_task_is_up THEN
          pmp$zero_out_table(^connect_request, #SIZE(connect_request));
          build_connect_request (server_name, client_name, destination_host,
                server_available_locally, ^connect_request, connection_descriptor,
                server_host_pid, associated_path, status);
          physical_identifier := rfv$status_table.local_host^.physical_identifier;
          connection_timeout := rfv$status_table.local_host^.connection_timeout * 1000;
          data_transfer_timeout := rfv$status_table.local_host^.data_transfer_timeout * 1000;
        ELSE
          osp$set_status_abnormal (rfc$product_id,
                rfe$system_task_not_active, 'rfp$request_connection', status);
        IFEND;
        rfp$unlock_table (rfv$status_table.lock);
        IF NOT status.normal THEN
          EXIT /request_connection/;
        IFEND;

{     Create the connection entry and initialize.

        allocate_connection_entry (application_entry_p, connection_entry_p, status);
        IF NOT status.normal THEN
          EXIT /request_connection/;
        IFEND;
        rfp$lock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        job_table_entry_p := NIL;
        connection_entry_p^.connection_name := path_handle_name;
        connection_entry_p^.connection_descriptor := connection_descriptor;
        pmp$get_microsecond_clock (connection_entry_p^.connection_statistics.connect_time,
              ignore_status);
        connection_entry_p^.connection_statistics.bytes_sent := 0;
        connection_entry_p^.connection_statistics.bytes_received := 0;
        connection_entry_p^.active_pp_requests := 0;
        connection_entry_p^.waiting_tasks := NIL;
        connection_entry_p^.send_request_active := FALSE;
        connection_entry_p^.receive_request_active := FALSE;
        connection_entry_p^.residue_input_data := NIL;
        connection_entry_p^.open_count := 0;
        connection_entry_p^.selected_path := associated_path;

{     Set control message header.

        connection_entry_p^.control_message_header.nad_address :=
              connect_request.nad_address;
        connection_entry_p^.control_message_header.local_tcu_enables :=
              connect_request.local_tcu_enables;
        connection_entry_p^.control_message_header.destination_device :=
              connect_request.destination_device;
        connection_entry_p^.control_message_header.access_code :=
              connect_request.access_code;
        connection_entry_p^.control_message_header.name :=
              connect_request.name;

{     Set default connection file attributes.

        connection_entry_p^.connection_attributes.client_name := client_name;
        connection_entry_p^.connection_attributes.server_name := server_name;
        connection_entry_p^.connection_attributes.client_host := physical_identifier;
        connection_entry_p^.connection_attributes.server_host := server_host_pid;
        connection_entry_p^.connection_attributes.destination_host := destination_host;
        connection_entry_p^.connection_attributes.connection_timeout :=
              connection_timeout;
        connection_entry_p^.connection_attributes.data_transfer_timeout :=
              data_transfer_timeout;
        connection_entry_p^.connection_attributes.record_block_size :=
              rfc$default_record_block_size;
        connection_entry_p^.connection_attributes.message_block_size :=
              rfc$default_message_block_size;
        connection_entry_p^.connection_attributes.incoming_record_abn := 0;
        connection_entry_p^.connection_attributes.outgoing_record_abn := 0;
        connection_entry_p^.connection_attributes.acks_received_count := 0;
        connection_entry_p^.connection_attributes.acks_sent_count := 0;
        connection_entry_p^.connection_attributes.incoming_message_count := 0;
        connection_entry_p^.connection_attributes.outgoing_message_count := 0;
        connection_entry_p^.connection_attributes.receive_record_terminator :=
              rfc$rm_eoi;
        connection_entry_p^.connection_attributes.file_mark_received :=
              rfc$rm_null;
        connection_entry_p^.connection_attributes.send_record_terminator :=
              rfc$rm_eoi;
        connection_entry_p^.connection_attributes.abnormal_termination := FALSE;
        merge_creation_attributes (^connection_entry_p^.connection_attributes,
              file_attributes, ignore_status);

        request_lcn_connection (connection_entry_p, ^connect_request, status);

      END /request_connection/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$request_connection);
    ELSE
      IF job_table_entry_p <> NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
      IFEND;
      IF connections_incremented THEN
        rfp$lock_table (rfv$rhfam_client_table.lock);
        rfp$find_client_entry (client_name, FALSE, client_entry_p, ignore_status);
        IF ignore_status.normal THEN
          client_entry_p^.current_connections := client_entry_p^.current_connections - 1;
        IFEND;
        rfp$unlock_table (rfv$rhfam_client_table.lock);
      IFEND;
      IF local_file_created THEN
        amp$return (connection_file, ignore_status);
      IFEND;
      #keypoint (osk$exit, status.condition * osk$m, rfk$request_connection);
    IFEND;
    osp$disestablish_cond_handler;

  PROCEND rfp$request_connection;
?? TITLE := '    rfp$send_data', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$send_data (connection_identifier:
    amt$file_identifier;
        transmission_mode: rft$transmission_modes;
        data_buffer: rft$data_buffers;
        end_of_message: boolean;
        wait: ost$wait;
    VAR activity: ost$activity_status;
    VAR data_sent: rft$bytes_transferred;
    VAR status: ost$status);

*copy rfh$send_data


{     NOTE: If this routine is to be called at a ring level below ring3,
{       the VAR parameters must be allocated in a segment that is
{       writable by ring 3 code.  Pointers to this variable are stored in
{       a task private segment and thus inherit ring 3 privileges.


?? NEWTITLE := '      terminate_send_data - condition handler', EJECT ??
    PROCEDURE terminate_send_data (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        activities: rft$set_of_async_activities,
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        local_status: ost$status,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests,
        transfer_status: ^rft$data_transfer_status;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        IF wait = osc$wait THEN
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
        ELSE
          osp$set_status_from_condition (rfc$product_id, condition, sfsa,
                activity.status, condition_status);
          activity.complete := TRUE;
        IFEND;
        block_exit_expected := TRUE;
        EXIT rfp$send_data;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          activities := $rft$set_of_async_activities[rfc$aa_send_data];
          terminate_async_activity (activities, connection_name);
          current_request := rfv$outstanding_requests;
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_path_status THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              current_request := current_request^.next_entry;
              syp$cycle;
              rfp$process_pp_response_flag (rfc$pp_response_available);
              IF activity_status^.complete THEN
                FREE activity_status  IN osv$task_private_heap^;
              IFEND;
              current_request := rfv$outstanding_requests;
            ELSEIF current_request^.request_kind = rfc$rk_send_data THEN
              transfer_status := current_request^.request_status;
              activity_status := transfer_status^.activity_status;
              current_request := current_request^.next_entry;
              IF transfer_status^.connection_name = connection_name THEN
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
                current_request := rfv$outstanding_requests;
              IFEND;
            ELSE
              current_request := current_request^.next_entry;
            IFEND;
          WHILEND;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                local_status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_path_status THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            ELSEIF current_request^.request_kind = rfc$rk_send_data THEN
              transfer_status := current_request^.request_status;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE transfer_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          IF wait = osc$wait THEN
            osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                  condition_status);
          ELSE
            osp$set_status_from_condition (rfc$product_id, condition, sfsa,
                  activity.status, condition_status);
            activity.complete := TRUE;
          IFEND;
          block_exit_expected := TRUE;
          EXIT rfp$send_data;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_send_data;
?? OLDTITLE, EJECT ??

    VAR
      block_exit_expected: boolean,
      cell_to_verify: ^^cell,
      connection_entry_p: ^rft$connection_entry,
      connection_name: fst$path_handle_name,
      connection_unlocked: boolean,
      data_length: rft$data_length,
      data_transfer_status: ^rft$data_transfer_status,
      index: integer,
      input_available: boolean,
      last_data_cell: ^cell,
      local_status: ost$status,
      network_wired_data: boolean,
      number_of_fragments: integer,
      pva_valid: boolean,
      send_request_active: boolean,
      starting_fragment: rft$data_fragment_count;


    #keypoint (osk$entry, 0, rfk$send_data);
    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_send_data, TRUE);
    status.normal := TRUE;
    activity.complete := FALSE;
    activity.status.normal := TRUE;
    data_sent := 0;

    /main_program/
    BEGIN

      data_length := 0;
      number_of_fragments := 0;
      starting_fragment := LOWERBOUND(data_buffer^);
      cell_to_verify := ^last_data_cell;
      /validate_data_fragments/
      FOR index := LOWERBOUND(data_buffer^) TO UPPERBOUND(data_buffer^) DO
        IF data_buffer^[index].length > 0 THEN
          last_data_cell := i#ptr(data_buffer^[index].length,
                data_buffer^[index].address);
          pva_valid := mmp$verify_access (cell_to_verify, mmc$va_read);
          IF pva_valid THEN
            IF number_of_fragments = 0 THEN
              starting_fragment := index;
            IFEND;
            number_of_fragments := number_of_fragments + 1;
            data_length := data_length + data_buffer^[index].length;
          ELSE
            osp$set_status_abnormal(rfc$product_id, rfe$invalid_data_fragment,
                  'send data', status);
            EXIT /main_program/;
          IFEND;
        IFEND;
      FOREND /validate_data_fragments/;

      /wait_for_active_send/
      REPEAT

        get_exclusive_to_cid (connection_identifier, connection_entry_p, status);
        IF NOT status.normal THEN
          EXIT /main_program/;
        IFEND;

        send_request_active := connection_entry_p^.send_request_active;
        IF send_request_active THEN
          IF wait = osc$wait THEN
            enter_waiting_task_queue(connection_entry_p, local_status);
            rfp$unlock_table (connection_entry_p^.lock);
            pmp$wait(10000, 10000);
          ELSE
            rfp$unlock_table (connection_entry_p^.lock);
            osp$set_status_abnormal (rfc$product_id, rfe$send_data_active,
                  connection_entry_p^.connection_name, status);
            EXIT /main_program/;
          IFEND;
        IFEND;

      UNTIL NOT send_request_active;
      connection_name := connection_entry_p^.connection_name;

      update_connection_status (connection_entry_p, input_available,
            connection_unlocked, status);
      IF connection_unlocked THEN
        EXIT /main_program/;
      IFEND;

      IF connection_entry_p^.connection_attributes.connection_status.connection_state <>
            rfc$connected THEN
        set_connection_status (connection_entry_p, status);
        rfp$unlock_table (connection_entry_p^.lock);
        EXIT /main_program/;
      IFEND;


      IF (#OFFSET(data_buffer^[starting_fragment].address) MOD 8) <> 0 THEN
        network_wired_data := TRUE;
      ELSEIF (transmission_mode = rfc$message_mode) AND
             (connection_entry_p^.connection_attributes.message_block_size MOD 8 <> 0) THEN
        network_wired_data := TRUE;
      ELSEIF (transmission_mode = rfc$record_mode) AND
             (connection_entry_p^.connection_attributes.record_block_size MOD 8 <> 0) THEN
        network_wired_data := TRUE;
      ELSEIF  data_buffer^[starting_fragment].length < rfc$min_unwired_data_length THEN
        network_wired_data := TRUE;
      ELSE
        network_wired_data := FALSE;
      IFEND;

      ALLOCATE data_transfer_status IN osv$task_private_heap^;
      IF data_transfer_status = NIL THEN
        rfp$unlock_table (connection_entry_p^.lock);
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
              'task private', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'rfp$send_data', status);
        EXIT /main_program/;
      IFEND;
      data_transfer_status^.connection_name := connection_entry_p^.connection_name;
      data_transfer_status^.connection_entry_p := connection_entry_p;
      data_transfer_status^.transmission_mode := transmission_mode;
      data_transfer_status^.data_area := data_buffer;
      data_transfer_status^.end_of_message := end_of_message;
      data_transfer_status^.wait := wait;
      data_transfer_status^.activity_status := ^activity;
      data_transfer_status^.data_transferred := ^data_sent;
      IF transmission_mode = rfc$message_mode THEN
        data_transfer_status^.block_size := connection_entry_p^.connection_attributes.
              message_block_size;
      ELSE
        data_transfer_status^.block_size := connection_entry_p^.connection_attributes.
              record_block_size;
      IFEND;
      data_transfer_status^.file_mark :=
            connection_entry_p^.connection_attributes.send_record_terminator;
      data_transfer_status^.connection_descriptor := connection_entry_p^.connection_descriptor;
      data_transfer_status^.network_wired_data := network_wired_data;
      data_transfer_status^.next_to_queue_abn := connection_entry_p^.connection_attributes.
            outgoing_record_abn;
      data_transfer_status^.next_to_queue_index := starting_fragment;
      data_transfer_status^.next_to_queue_offset := 0;
      data_transfer_status^.bytes_transferred := 0;
      data_transfer_status^.outgoing_message_count := 0;
      data_transfer_status^.previous_error.normal := TRUE;
      data_transfer_status^.transfer_kind := rfc$tk_send_data;
      data_transfer_status^.outstanding_control_messages := NIL;
      data_transfer_status^.residue_data_on_send := FALSE;
      data_transfer_status^.control_message_header :=
            connection_entry_p^.control_message_header;
      data_transfer_status^.control_message_header.my_path_id :=
            connection_entry_p^.connection_descriptor.network_path;
      data_transfer_status^.control_message_header.connection_number :=
            connection_entry_p^.connection_descriptor.network_path;
      connection_entry_p^.send_request_active := TRUE;
      rfp$unlock_table (connection_entry_p^.lock);
      start_send_data (data_transfer_status, data_length, status);
      IF NOT status.normal THEN
        EXIT /main_program/;
      IFEND;

      IF wait = osc$wait THEN
        REPEAT
          #SPOIL (activity);
          pmp$wait (rfc$unit_request_wait_time,rfc$ur_expected_wait);
          rfp$process_pp_response_flag (rfc$pp_response_available);
        UNTIL activity.complete;
      IFEND;

    END /main_program/;

    osp$disestablish_cond_handler;
    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$send_data);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m, rfk$send_data);
    IFEND;
  PROCEND rfp$send_data;
?? TITLE := '    rfp$terminate_async_activity', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$terminate_async_activity (connection_identifier:
    amt$file_identifier;
        activity_types: rft$set_of_async_activities;
    VAR status: ost$status);

*copy rfh$terminate_async_activity

?? NEWTITLE := '      terminate_a_activity - condition handler', EJECT ??
    PROCEDURE terminate_a_activity (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$terminate_async_activity;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$terminate_async_activity;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_a_activity;
?? OLDTITLE, EJECT ??

    VAR
      connection_entry_p: ^rft$connection_entry,
      connection_name: fst$path_handle_name;


    osp$establish_condition_handler (^terminate_a_activity, FALSE);
    status.normal := TRUE;
    get_exclusive_to_cid (connection_identifier, connection_entry_p, status);
    IF status.normal THEN
      connection_name := connection_entry_p^.connection_name;
      rfp$unlock_table (connection_entry_p^.lock);
      terminate_async_activity (activity_types, connection_name);
    IFEND;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$terminate_async_activity);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m,
            rfk$terminate_async_activity);
    IFEND;
  PROCEND rfp$terminate_async_activity;
?? TITLE := '    rfp$terminate_connection', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$terminate_connection (connection_file:
        fst$file_reference;
        normal_termination: boolean;
    VAR connection_statistics: rft$connection_statistics;
    VAR status: ost$status);

*copy rfh$terminate_connection

?? NEWTITLE := '      terminate_term_connection - condition handler', EJECT ??
    PROCEDURE terminate_term_connection (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$terminate_connection;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$terminate_connection;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_term_connection;
?? OLDTITLE, EJECT ??

    VAR
      abnormal_termination: BOOLEAN,
      connection_entry_p: ^rft$connection_entry,
      path_handle_name: fst$path_handle_name,
      time: integer;


    #keypoint (osk$entry, 0, rfk$terminate_connection);
    osp$establish_condition_handler (^terminate_term_connection, FALSE);
    status.normal := true;
    pmp$zero_out_table (^connection_statistics, #SIZE(rft$connection_statistics));
    abnormal_termination := NOT normal_termination;

  /terminate_connection/
    BEGIN
      get_path_handle_name (connection_file, path_handle_name, status);
      IF NOT status.normal THEN
        EXIT /terminate_connection/;
      IFEND;
      get_exclusive_to_connection(path_handle_name, connection_entry_p, status);
      IF NOT status.normal THEN
        EXIT /terminate_connection/;
      IFEND;
      pmp$get_microsecond_clock (time, status);
      IF NOT status.normal THEN
        rfp$unlock_table (connection_entry_p^.lock);
        EXIT /terminate_connection/;
      IFEND;

      connection_entry_p^.connection_attributes.abnormal_termination := abnormal_termination;

      connection_statistics.connect_time :=
            (time - connection_entry_p^.connection_statistics.connect_time) DIV 1000;
      connection_statistics.bytes_sent := connection_entry_p^.connection_statistics.bytes_sent;
      connection_statistics.bytes_received := connection_entry_p^.connection_statistics.bytes_received;
      rfp$unlock_table (connection_entry_p^.lock);

      amp$return (connection_entry_p^.connection_name, status);

    END /terminate_connection/;

    IF status.normal THEN
      #keypoint (osk$exit, 0, rfk$terminate_connection);
    ELSE
      #keypoint (osk$exit, status.condition * osk$m, rfk$terminate_connection);
    IFEND;
  PROCEND rfp$terminate_connection;

?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '  Utility Procedures', EJECT ??
?? NEWTITLE := '    add_blocks_to_request', EJECT ??
  PROCEDURE add_blocks_to_request (data_transfer_status: ^rft$data_transfer_status;
        unit_request_idle: boolean;
    VAR blocks_to_add: rft$outstanding_blocks;
    VAR unit_request: ^SEQ ( * );
    VAR status: ost$status);


{     The purpose of this procedure is to add the network block data
{     descriptions to the pp send or receive data request. This routine
{     either builds blocks in network wired or in unwired buffers and controls
{     the timing of the switch from using unwired buffers to using network
{     wired buffers.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters
{       for the data transfer request.
{
{     UNIT_REQUEST_IDLE: (input) This parameter specifies if the pp request
{       is active at this time.  A value of TRUE indicates that the
{       pp request is not active and no blocks are queued in the send or receive
{       data request.
{
{     BLOCKS_TO_ADD: (input,output) This parameter specifies the maximum number
{       of blocks to add to the pp request.  Upon return, this parameter returns
{       the actual number of blocks that were added to the transfer request.
{
{     UNIT_REQUEST: (input,output) This parameter specifies the pp request
{       sequence to add the data blocks to.
{
{     STATUS: (output) This parameter returns the results of the procedure call.
{       A status of normal indicates that no erros were encountered.


    VAR
      blocks_built: boolean,
      unit_request_position: ^string ( * );

    status.normal := TRUE;
    NEXT unit_request_position: [ 0 ] IN unit_request;
    blocks_built := FALSE;

  /build_blocks/
    WHILE (NOT blocks_built) AND (status.normal) DO
      IF data_transfer_status^.switch_to_wired_buffers THEN
        IF unit_request_idle THEN
          switch_to_wired_buffers (data_transfer_status, status);
          blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
          IF NOT status.normal THEN
            EXIT add_blocks_to_request;
          IFEND;
        ELSE
          blocks_to_add := 0;
          RETURN;
        IFEND;
      IFEND;

      IF data_transfer_status^.network_wired_data THEN
        build_network_wired_blocks (data_transfer_status, unit_request, blocks_to_add,
              status);
        IF status.normal THEN
          IF blocks_to_add <> 0 THEN
            blocks_built := TRUE;
          ELSE
            IF unit_request_idle THEN
              IF data_transfer_status^.switch_to_wired_buffers THEN
                ; { This case would be an internal coding error }
              ELSE  { previous error was set }
                status := data_transfer_status^.previous_error;
              IFEND;
            ELSE    { This is an intermediate response.}
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      ELSE
        build_unwired_blocks (data_transfer_status, unit_request, blocks_to_add,
              status);
        IF status.normal THEN
          IF blocks_to_add <> 0 THEN
            blocks_built := TRUE;
          ELSE
            IF unit_request_idle THEN
              IF data_transfer_status^.switch_to_wired_buffers THEN
                switch_to_wired_buffers (data_transfer_status, status);
                blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
                IF NOT status.normal THEN
                  EXIT add_blocks_to_request;
                IFEND;
                RESET unit_request TO unit_request_position;
                CYCLE /build_blocks/;
              ELSE  { previous error was set }
                status := data_transfer_status^.previous_error;
              IFEND;
            ELSE    { This is an intermediate response.}
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    WHILEND /build_blocks/;

  PROCEND add_blocks_to_request;
?? TITLE := '    advise_out_in', EJECT ??
  PROCEDURE advise_out_in (data_transfer_status: ^rft$data_transfer_status;
     VAR status: ost$status);

{
{     The purpose of this procedure is to advise out any data pages that
{     have been processed and advise in any data pages that are to be queued
{     to the pp for transfer to the LCN network.  This routine is intended to
{     be called after data is queued to the LCN network.  This routine will
{     then advise in pages up to a maximum number begining with the next
{     page of data to be transfered.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters
{       for the data transfer request.

?? NEWTITLE := 'terminate_advise_out_in - condition handler', EJECT ??
    PROCEDURE terminate_advise_out_in
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           sfsa: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

{ This condition handler is designed to catch the case in which an attempt was
{ made to advise past the file limit.  When this happens, an abnormal status
{ will be returned.  This in turn will indicate that cleanup is required and
{ that the data transfer is no longer in progress.

      IF (condition.selector = mmc$segment_access_condition) THEN
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT advise_out_in;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND terminate_advise_out_in;
?? OLDTITLE, EJECT ??

    VAR
      first_page_offset: ost$byte_count,
      ignore_status: ost$status,
      in_length: ost$byte_count,
      in_pva: ^cell,
      last_page_offset: ost$byte_count,
      max_in_length: ost$byte_count,
      new_advise_in_segment: BOOLEAN,
      next_page_offset: ost$byte_count,
      out_length: ost$byte_count,
      out_pva: ^cell,
      page_size: ost$page_size;


    status.normal := TRUE;
    osp$establish_condition_handler (^terminate_advise_out_in, FALSE);
    out_pva := NIL;
    in_pva := NIL;
    out_length := 0;
    in_length := 0;
    new_advise_in_segment := FALSE;
    page_size := osv$page_size;

  /determine_advise_out_parameters/
    BEGIN
      IF (data_transfer_status^.next_to_advise_out_index <>
           data_transfer_status^.complete_index) THEN
        data_transfer_status^.next_to_advise_out_index :=
           data_transfer_status^.complete_index;
        data_transfer_status^.next_to_advise_out_offset := 0;
      IFEND;
      IF (data_transfer_status^.next_to_advise_out_offset <
           data_transfer_status^.complete_offset) THEN
        out_pva := i#ptr(data_transfer_status^.next_to_advise_out_offset,
              data_transfer_status^.data_area^[data_transfer_status^.next_to_advise_out_index].
              address);
        first_page_offset := #OFFSET(
              data_transfer_status^.data_area^[data_transfer_status^.next_to_advise_out_index].address);
        last_page_offset := (((first_page_offset + data_transfer_status^.complete_offset) DIV page_size)
              * page_size) - first_page_offset;
        out_length := last_page_offset - data_transfer_status^.next_to_advise_out_offset;
      ELSE
        last_page_offset := data_transfer_status^.next_to_advise_out_offset;
      IFEND;
    END /determine_advise_out_parameters/;

  /determine_advise_in_parameters/
    BEGIN
      IF NOT (data_transfer_status^.data_exhausted) THEN
        IF  (data_transfer_status^.next_to_queue_index > data_transfer_status^.next_to_advise_in_index)  THEN

          {  This is to make sure that the queuing does not get ahead of the advising.  This
          {  could occur if the user fragments are very small.

          data_transfer_status^.next_to_advise_in_index := data_transfer_status^.next_to_queue_index;
          data_transfer_status^.next_to_advise_in_offset := data_transfer_status^.next_to_queue_offset;
        ELSEIF  (data_transfer_status^.next_to_queue_index = data_transfer_status^.next_to_advise_in_index)
                AND (data_transfer_status^.next_to_advise_in_offset <
                             data_transfer_status^.next_to_queue_offset)  THEN
          data_transfer_status^.next_to_advise_in_offset := data_transfer_status^.next_to_queue_offset;
        IFEND;
        max_in_length := rfc$max_blocks_to_add * page_size * 2;
        IF  (data_transfer_status^.next_to_advise_in_index > data_transfer_status^.next_to_queue_index)  OR
            (data_transfer_status^.next_to_advise_in_offset <
             (data_transfer_status^.next_to_queue_offset + max_in_length))       THEN
          in_pva := i#ptr(data_transfer_status^.next_to_advise_in_offset,
                data_transfer_status^.data_area^[data_transfer_status^.next_to_advise_in_index].
                address);
          in_length := data_transfer_status^.data_area^[data_transfer_status^.next_to_advise_in_index].
                length - data_transfer_status^.next_to_advise_in_offset;
          IF in_length > max_in_length THEN
            in_length := max_in_length;
          ELSE
            IF  data_transfer_status^.next_to_advise_in_index <
                                       UPPERBOUND(data_transfer_status^.data_area^)  THEN
              data_transfer_status^.next_to_advise_in_index :=
                data_transfer_status^.next_to_advise_in_index + 1;
              data_transfer_status^.next_to_advise_in_offset := 0;
              new_advise_in_segment := TRUE;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    END /determine_advise_in_parameters/;

    IF  (in_length > (8 * page_size))  THEN
      mmp$advise_out_in (out_pva, out_length, in_pva, in_length, ignore_status);
      IF  NOT new_advise_in_segment  THEN
        data_transfer_status^.next_to_advise_in_offset :=
              data_transfer_status^.next_to_advise_in_offset + in_length;
      IFEND;

      {  The first time this is called 'block_descriptors' is not initialized.
      {  However, there should not be an 'advise out' either.

      IF  data_transfer_status^.block_descriptors <> NIL  THEN
        IF  (data_transfer_status^.next_to_advise_out_index =
              data_transfer_status^.block_descriptors^[data_transfer_status^.block_descriptor_out].
              data_fragment_index)  THEN
          data_transfer_status^.next_to_advise_out_offset := last_page_offset;
        ELSE
          data_transfer_status^.next_to_advise_out_index :=
              data_transfer_status^.block_descriptors^[data_transfer_status^.block_descriptor_out].
              data_fragment_index;
          data_transfer_status^.next_to_advise_out_offset :=
              data_transfer_status^.block_descriptors^[data_transfer_status^.block_descriptor_out].
              data_fragment_offset;
        IFEND;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND advise_out_in;
?? TITLE := '    allocate_connection_entry', EJECT ??
  PROCEDURE allocate_connection_entry (application_entry_p: ^rft$application_table_entry;
    VAR connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to allocate and link a
{     connection entry data structure into the connection list for
{     an application. This routine increments the connection count
{     in the application entry and initializes the connection entry
{     linkage.
{
{     APPLICATION_ENTRY_P: (input) This parameter specifies a pointer
{       to the application entry for which a connection table entry
{       is to be allocated.
{
{     CONNECTION_ENTRY_P: (output) This parameter returns a pointer
{       to the connection table entry that has been allocated. A NIL
{       pointer indicates that table allocation failed.
{
{     STATUS: (output) This parameter returns the status of the
{       allocation.  A status of normal indicates that the table
{       allocation succeeded.



    status.normal := TRUE;
    ALLOCATE connection_entry_p IN nav$network_paged_heap^;
    IF connection_entry_p <> NIL THEN
      pmp$zero_out_table (connection_entry_p, #SIZE(rft$connection_entry));
      application_entry_p^.number_of_active_connections :=
             application_entry_p^.number_of_active_connections + 1;
      connection_entry_p^.application_entry_p := application_entry_p;
      connection_entry_p^.connection_attributes.connection_status.connection_state :=
            rfc$not_viable;
      IF application_entry_p^.connection_table = NIL THEN
        connection_entry_p^.next_entry := NIL;
      ELSE
        connection_entry_p^.next_entry := application_entry_p^.connection_table;
      IFEND;
      application_entry_p^.connection_table := connection_entry_p;
    ELSE
      osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
            'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'allocate_connection_entry', status);
      EXIT allocate_connection_entry;
    IFEND;

  PROCEND allocate_connection_entry;
?? TITLE := '    allocate_network_wired_buffers', EJECT ??
  PROCEDURE allocate_network_wired_buffers (data_transfer_status: ^rft$data_transfer_status;
        data_length: rft$data_length;
    VAR status: ost$status);

{
{     The purpose of this procedure is to allocate the necessary network
{     wired buffers to transfer data to or from the LCN network.  The number
{     allocated is based on the amount of data to transfer.  If the number
{     required is greater than a maximum, the maximum is allocated and the
{     buffers will be reused as needed.  This routine waits until the
{     required buffers are obtained before exiting.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters
{      for the data transfer.
{
{     DATA_LENGTH: (input) This parameter specifies the length of the data
{       that is to be transferred.
{
{     STATUS: (output) This parameter returns the result of this procedure
{       call.  A status of normal indicates that the network wired buffers
{       were allocated.



    VAR
      number_of_blocks: integer,
      number_of_buffers_per_block: integer,
      number_reserved: rft$buffer_count,
      required_wired_buffers: rft$buffer_count;


    status.normal := TRUE;
    number_of_buffers_per_block :=
          (data_transfer_status^.block_size + #SIZE(rft$nbp_block_header) +
          (nlv$bm_large_buffer_size - 1)) DIV nlv$bm_large_buffer_size;
    IF data_length <> 0 THEN
      number_of_blocks := (data_length + (data_transfer_status^.block_size - 1)) DIV
             data_transfer_status^.block_size;
      IF number_of_blocks > data_transfer_status^.maximum_outstanding_blocks  THEN
        number_of_blocks := data_transfer_status^.maximum_outstanding_blocks;
      IFEND;
      required_wired_buffers := number_of_blocks * number_of_buffers_per_block;
      IF rfc$max_wired_buffers_per_req < required_wired_buffers THEN
        required_wired_buffers := rfc$max_wired_buffers_per_req;
        number_of_blocks := required_wired_buffers DIV number_of_buffers_per_block;
      IFEND;
    ELSE
      number_of_blocks := 1;
      required_wired_buffers := 1;
    IFEND;
    ALLOCATE data_transfer_status^.reserved_buffer_list: [ 1 .. required_wired_buffers]
          IN osv$task_private_heap^;
    REPEAT
      number_reserved := required_wired_buffers;
      rfp$reserve_wired_buffers(data_transfer_status^.reserved_buffer_list^,
            number_reserved);
      IF number_reserved <> required_wired_buffers THEN
        IF number_reserved <> 0 THEN
          rfp$release_wired_buffers(data_transfer_status^.reserved_buffer_list^,
              number_reserved);
        IFEND;
        pmp$wait (1000,1000);
      IFEND;
    UNTIL number_reserved = required_wired_buffers;
    data_transfer_status^.reserved_buffer_count := required_wired_buffers;
    data_transfer_status^.maximum_outstanding_blocks := number_of_blocks;

  PROCEND allocate_network_wired_buffers;
?? TITLE := '    build_back_message', EJECT ??
  PROCEDURE build_back_message (VAR data_transfer_status: ^rft$data_transfer_status;
    header_buffer: ^rft$nbp_block_header);

{
{     The purpose of this procedure is to build a back message for a received
{     network block. A back message entry is allocated, the back is
{     constructed, and linked into a local queue of backs to be sent.
{     This routine assumes the control message header has been set up and
{     updates only BACK related fields.
{
{     DATA_TRANSFER_STATUS: (input,output) This parameter specifies a
{       pointer to the data transfer status block to associate this back
{       with.
{
{     HEADER_BUFFER: (input) This parameter specifies the header of the block
{       for which the back is to be queued.


    VAR
      back_message: ^rft$outgoing_control_message,
      next_entry: ^rft$outgoing_control_message,
      present_entry: ^rft$outgoing_control_message;


    present_entry := NIL;
    next_entry := data_transfer_status^.outstanding_control_messages;
    WHILE next_entry <> NIL DO
      present_entry := next_entry;
      next_entry := present_entry^.next_entry;
    WHILEND;

    ALLOCATE back_message: [0]  IN nav$network_paged_heap^;
    IF back_message <> NIL THEN
      back_message^.purge_on_retry := FALSE;
      back_message^.control_message.header := data_transfer_status^.control_message_header;
      back_message^.control_message.header.name(2,1) := $CHAR(header_buffer^.connection_number);
      back_message^.control_message.header.length := 0;
      back_message^.control_message.header.block_type := rfc$nbp_block_type_back;
      back_message^.control_message.header.abn := header_buffer^.application_block_number;
      back_message^.control_message.data := '';
      back_message^.next_entry := NIL;
      IF present_entry = NIL THEN
        data_transfer_status^.outstanding_control_messages := back_message;
      ELSE
        present_entry^.next_entry := back_message;
      IFEND;
    IFEND;

  PROCEND build_back_message;
?? TITLE := '    build_connect_request', EJECT ??
  PROCEDURE build_connect_request (server_name: rft$application_name;
        requesting_application: rft$application_name;
        destination_host: rft$host_identifier;
        server_available_locally: boolean;
        connect_request: ^rft$nbp_outgoing_connect;
    VAR connection_descriptor: rft$connection_descriptor;
    VAR physical_identifier: rft$physical_identifier;
    VAR selected_path_p: ^rft$lcn_path_definition;
    VAR status: ost$status);

{
{     The purpose of this procedure is to search the configuration tables
{     for the requested server and destination host.  If the server/host
{     combination is found a connect message is formated and returned.
{     The remote host definitions and the local host definitions are
{     searched for the requested host/server combination.
{
{     SERVER_NAME: (input) This parameter specifies the server requested.
{
{     REQUESTING_APPLICATION: (input) This parameter specifies the application
{       that is requesting the connection.
{
{     DESTINATION_HOST: (input) This parameter specifies the remote host
{       where the specified server is to reside.
{
{     SERVER_AVAILABLE_LOCALLY: This parameter specifies if the requested
{       service is available locally.
{
{     CONNECT_REQUEST: (input,output)  This parameter specifies a pointer
{       to the connect request buffer.
{
{     CONNECTION_DESCRIPTOR: (output) This parameter returns the connection
{       descriptor for the connection.
{
{     PHYSICAL_IDENTIFIER: (output) This parameter returns the physical
{       identifier of the choosen remote host.
{
{     SELECTED_PATH_P: (output) This parameter returns a pointer to the selected
{       path.
{
{     STATUS: (output) This parameter returns the results of the request.
{       A status of normal indicates that the requested service has been found.
{

    VAR
      host_identifier: rft$destination_hosts,
      host_identifier_p: ^rft$destination_hosts,
      local_status: ost$status,
      map_lid_to_pid: boolean,
      number_of_hosts: rft$number_of_hosts;


    host_identifier_p := ^host_identifier;
    search_for_path (server_name, destination_host, server_available_locally,
          selected_path_p, physical_identifier, host_identifier_p, number_of_hosts,
          map_lid_to_pid, status);
    IF NOT status.normal THEN
      EXIT build_connect_request;
    IFEND;

    pmp$get_microsecond_clock (selected_path_p^.last_attempted_connect,
          local_status);

    CASE selected_path_p^.loopback OF
    = TRUE =
      connect_request^.nad_address :=
            rfv$status_table.local_nads^[selected_path_p^.destination_nad].address;
    = FALSE =
      connect_request^.nad_address :=
            rfv$status_table.remote_nads^[selected_path_p^.remote_nad].address;
      pmp$get_compact_date_time (rfv$status_table.remote_nads^
            [selected_path_p^.remote_nad].last_connect_time, local_status);
    CASEND;
    connect_request^.local_tcu_enables := selected_path_p^.local_tcu_mask;
    connect_request^.destination_device := selected_path_p^.destination_device;
    connect_request^.access_code := selected_path_p^.access_code;
    connect_request^.name := rfv$status_table.local_host^.subsystem_identifier;
    connect_request^.remote_tcu_enables := selected_path_p^.remote_tcu_mask;
    connect_request^.buffer_size := rfc$buffer_4128;
    connect_request^.logical_network := selected_path_p^.logical_network;
    connect_request^.logical_nad := selected_path_p^.logical_nad;
    connect_request^.requested_application := server_name;
    connect_request^.source_physical_id := rfv$status_table.local_host^.physical_identifier;
    connect_request^.requesting_application := requesting_application;
    connect_request^.application_block_number := 0;
    connect_request^.password := rfv$status_table.local_host^.connection_password;
    IF  destination_host.host_identifier_kind = rfc$physical_identifier THEN
      connect_request^.destination_id := destination_host.physical_identifier;
    ELSE
      IF map_lid_to_pid THEN
        connect_request^.destination_id := destination_host.physical_identifier;
      ELSE
        connect_request^.destination_id := destination_host.logical_identifier(1,3);
      IFEND;
    IFEND;

    connection_descriptor.nad_index := selected_path_p^.local_nad;
    connection_descriptor.logical_unit := rfv$status_table.local_nads^[selected_path_p^.local_nad].
          logical_unit_number;

  PROCEND build_connect_request;
?? TITLE := '    build_network_header', EJECT ??
  PROCEDURE build_network_header (data_transfer_status: ^rft$data_transfer_status;
        data_length: rft$nbp_text_length;
        data_exhausted: boolean;
        current_abn: rft$application_block_number;
        header_buffer_p: ^rft$nbp_block_header);

{
{     The purpose of this procedure is to build the level 6 network block
{     header that is transmitted with each network block of data.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the paramameters
{       for the data transfer request.
{
{     DATA_LENGTH: (input) This parameter specifies the amount of data in bytes,
{       that is in the network block.
{
{     DATA_EXHAUSTED: (input) This parameter specifies if this is the last
{       network block of data for this request. A value of true indicates that
{       this is the last block of data.
{
{     CURRENT_ABN: (input) This parameter specifies the block number of the
{       data block that is being sent.
{
{     HEADER_BUFFER_P: (input,output) This parameter specifies a pointer to
{       the header buffer.  The header is built in this buffer.


{     NOTE: The header buffer is zeroed out to preset fields.  Some RHF
{       implementations rely on unsed fields being zero.  This algorithm
{       provides compatability with older systems.

      pmp$zero_out_table (header_buffer_p, #SIZE(rft$nbp_block_header));
      header_buffer_p^.connection_number :=
            data_transfer_status^.connection_descriptor.network_path;
      header_buffer_p^.length := data_length * 8;
      header_buffer_p^.application_block_number := current_abn;
      CASE data_transfer_status^.transmission_mode OF
      = rfc$record_mode =
        header_buffer_p^.block_type := rfc$nbp_block_type_msg;
        header_buffer_p^.data_block_clarifier.pru_block := TRUE;
        IF (data_exhausted) AND (data_transfer_status^.end_of_message) THEN
          CASE data_transfer_status^.file_mark OF
          = rfc$rm_eoi =
            header_buffer_p^.data_block_clarifier.end_of_information := TRUE;
          = rfc$rm_eor =
            header_buffer_p^.data_block_clarifier.end_of_record := TRUE;
          = rfc$rm_eof =
            header_buffer_p^.data_block_clarifier.end_of_record := TRUE;
            header_buffer_p^.data_block_clarifier.eor_level := 0f(16);
          = rfc$rm_null =
            ;
          CASEND;
        IFEND;
      = rfc$message_mode =
        IF (data_exhausted) AND (data_transfer_status^.end_of_message) THEN
          header_buffer_p^.block_type := rfc$nbp_block_type_msg;
        ELSE
          header_buffer_p^.block_type := rfc$nbp_block_type_blk;
        IFEND;
      CASEND;

  PROCEND build_network_header;
?? TITLE := '    build_network_wired_blocks', EJECT ??
  PROCEDURE build_network_wired_blocks (data_transfer_status: ^rft$data_transfer_status;
    VAR unit_request: ^SEQ(*);
    VAR blocks_to_add: rft$outstanding_blocks;
    VAR status: ost$status);


{
{     The purpose of this procedure is to transform the data fragments specified
{     by the user into network blocks and add them to the send or receive pp
{     request.  This routine builds the network block subfunctions and adds
{     them to the pp transfer request.  If the transfer request is a send data
{     request, the data is moved to network wired buffers.  If the transfer
{     request is a receive data request, the request is built directing the pp
{     to write the incoming data into the specified network wired buffers.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters for
{       the data transfer request.
{
{     BLOCKS_TO_ADD: (input,output) This parameter specifies the number of network
{       blocks to add to the pp unit request. Upon return this parameter contains
{       the actual number of blocks added to the pp unit request.
{
{     UNIT_REQUEST: (input,output) This parameter specifies the pp unit request
{       to add the block definitions to.
{
{     STATUS: (ouput) This parameter specifies the results of the request.  A
{       normal status indicates that no abnormal conditions were encountered.

?? NEWTITLE := 'terminate_build_network_wired - condition handler', EJECT ??
    PROCEDURE terminate_build_network_wired (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

{ This condition handler is designed to prevent forseeable error situations
{ from causing unwanted RHFAM/VE side_effects.  Specifically, segment access
{ conditions and system conditions are not allowed to bubble up but are
{ converted to status instead.

      IF (condition.selector = mmc$segment_access_condition) OR
            (condition.selector = pmc$system_conditions) THEN
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT build_network_wired_blocks;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND terminate_build_network_wired;
?? OLDTITLE, EJECT ??

    VAR
      block_length: rft$bytes_transferred,
      block_size: integer,
      buffers_used: rft$buffer_count,
      current_abn: rft$application_block_number,
      current_block: rft$outstanding_blocks,
      current_fragment: rft$data_fragment_count,
      current_offset: rft$data_length,
      current_wired_buffer: rft$buffer_count,
      data_exhausted: boolean,
      data_p: ^cell,
      header_buffer: rft$nbp_block_header,
      header_buffer_p: ^rft$nbp_block_header,
      i: integer,
      index: integer,
      io_fragment: ^rft$io_fragment,
      move_data_length: rft$bytes_transferred,
      next_wired_buffer_in: rft$buffer_count,
      number_of_blocks: ^0..rfc$command_buffer_size,
      number_of_fragments: ^0..rfc$command_buffer_size,
      remaining_block_size: rft$block_size,
      remaining_fragment_length: rft$data_fragment_count,
      reserved_buffer_count: rft$buffer_count,
      reserved_buffer_list: ^rft$buffer_list,
      send_intermediate_response: ^BOOLEAN,
      temporary_block_length: rft$bytes_transferred,
      temporary_fragment: rft$data_fragment_count,
      temporary_offset: rft$data_length,
      wired_buffer_in: rft$buffer_count;

    osp$establish_condition_handler (^terminate_build_network_wired, FALSE);
    data_exhausted := FALSE;
    current_fragment := data_transfer_status^.next_to_queue_index;
    current_offset := data_transfer_status^.next_to_queue_offset;
    current_abn := data_transfer_status^.next_to_queue_abn;
    current_block := data_transfer_status^.block_descriptor_in;
    reserved_buffer_list := data_transfer_status^.reserved_buffer_list;
    current_wired_buffer := data_transfer_status^.next_wired_buffer_in;
    next_wired_buffer_in := current_wired_buffer;
    reserved_buffer_count := data_transfer_status^.reserved_buffer_count;

    IF blocks_to_add > rfc$max_blocks_to_add THEN
      blocks_to_add := rfc$max_blocks_to_add;
    IFEND;
    NEXT send_intermediate_response IN unit_request;
    IF send_intermediate_response = NIL THEN
      osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_network_wired_blocks', status);
      EXIT build_network_wired_blocks;
    IFEND;
    NEXT number_of_blocks IN unit_request;
    IF number_of_blocks = NIL THEN
      osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_network_wired_blocks', status);
      EXIT build_network_wired_blocks;
    IFEND;
    number_of_blocks^ := 0;

    /build_requested_blocks/
    FOR index := 1 TO blocks_to_add DO
      NEXT number_of_fragments IN unit_request;
      IF number_of_fragments = NIL THEN
        osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
              'the request overflowed the request sequence', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'build_network_wired_blocks', status);
        EXIT build_network_wired_blocks;
      IFEND;
      number_of_fragments^ := 0;

      data_transfer_status^.block_descriptors^[current_block].data_fragment_index :=
            current_fragment;
      data_transfer_status^.block_descriptors^[current_block].data_fragment_offset :=
            current_offset;
      data_transfer_status^.block_descriptors^[current_block].block_sequence_number := current_abn;
      data_transfer_status^.block_descriptors^[current_block].wired_buffer_index := current_wired_buffer;

      remaining_block_size := data_transfer_status^.block_size;
      block_length := 0;
      temporary_block_length := 0;
      temporary_fragment := current_fragment;
      temporary_offset := current_offset;

      CASE data_transfer_status^.transfer_kind OF
      = rfc$tk_send_data =
        block_size := data_transfer_status^.block_size + #SIZE(rft$nbp_block_header);
        wired_buffer_in := next_wired_buffer_in;
      /reset_send_buffers/
        WHILE block_size > 0 DO
          reserved_buffer_list^[wired_buffer_in].byte_count := 0;
          block_size := block_size - nlv$bm_large_buffer_size;
          wired_buffer_in := (wired_buffer_in MOD reserved_buffer_count) + 1;
        WHILEND /reset_send_buffers/;
        header_buffer_p := #LOC(reserved_buffer_list^[next_wired_buffer_in].buffer^);
        move_data_length := #size(rft$nbp_block_header);
        data_p := #LOC(header_buffer);
        rfp$move_data_to_wired_buffs(reserved_buffer_list^, data_p, reserved_buffer_count,
              current_wired_buffer, move_data_length);

      /advance_send_data_by_block/
        WHILE remaining_block_size > 0 {AND NOT data exhausted} DO
          remaining_fragment_length := data_transfer_status^.data_area^[temporary_fragment].length -
                temporary_offset;
          data_p := i#ptr(temporary_offset, data_transfer_status^.data_area^[temporary_fragment].address);
          IF remaining_fragment_length > remaining_block_size THEN
            move_data_length := remaining_block_size;
            temporary_offset := temporary_offset + move_data_length;
            rfp$move_data_to_wired_buffs(reserved_buffer_list^, data_p, reserved_buffer_count,
                  current_wired_buffer, move_data_length);
            temporary_block_length := temporary_block_length + remaining_block_size;
            remaining_block_size := 0;
          ELSE   {remainder of fragment fits in network block}
            move_data_length := remaining_fragment_length;
            rfp$move_data_to_wired_buffs(reserved_buffer_list^, data_p, reserved_buffer_count,
                  current_wired_buffer, move_data_length);
            remaining_block_size := remaining_block_size - remaining_fragment_length;
            temporary_block_length := temporary_block_length + remaining_fragment_length;
            IF temporary_fragment = UPPERBOUND(data_transfer_status^.data_area^) THEN
              temporary_offset := temporary_offset + remaining_fragment_length;
              data_exhausted := TRUE;
              IF data_transfer_status^.transmission_mode = rfc$record_mode THEN
                IF (remaining_block_size <> 0) AND
                    NOT (data_transfer_status^.end_of_message) THEN
                  osp$set_status_abnormal (rfc$product_id, rfe$unable_to_send_all_data,
                        'no end of message was specified', data_transfer_status^.previous_error);
                  EXIT /build_requested_blocks/;
                IFEND;
              IFEND;
              EXIT /advance_send_data_by_block/;
            IFEND;
            temporary_offset := 0;
            temporary_fragment := temporary_fragment + 1;
          IFEND;
        WHILEND /advance_send_data_by_block/;

        block_length := temporary_block_length;
        current_fragment := temporary_fragment;
        current_offset := temporary_offset;
        build_network_header (data_transfer_status, block_length, data_exhausted,
              current_abn, header_buffer_p);

      = rfc$tk_receive_data =

      /advance_receive_data_by_block/
        WHILE remaining_block_size > 0 {AND NOT data exhausted} DO
          remaining_fragment_length := data_transfer_status^.data_area^[temporary_fragment].length -
                temporary_offset;
          IF remaining_fragment_length > remaining_block_size THEN
            temporary_offset := temporary_offset + remaining_block_size;
            temporary_block_length := temporary_block_length + remaining_block_size;
            remaining_block_size := 0;
          ELSE   {remainder of fragment fits in the network block}
            remaining_block_size := remaining_block_size - remaining_fragment_length;
            temporary_block_length := temporary_block_length + remaining_fragment_length;
            IF temporary_fragment = UPPERBOUND(data_transfer_status^.data_area^) THEN

{     Round up the block length to a multiple of network blocks

              temporary_block_length := temporary_block_length + remaining_block_size;
              temporary_offset := temporary_offset + remaining_fragment_length;
              data_exhausted := TRUE;
              EXIT /advance_receive_data_by_block/;
            IFEND;
            temporary_offset := 0;
            temporary_fragment := temporary_fragment + 1;
          IFEND;
        WHILEND /advance_receive_data_by_block/;

        block_length := temporary_block_length;
        current_fragment := temporary_fragment;
        current_offset := temporary_offset;
        block_size := block_length + #SIZE(rft$nbp_block_header);
        wired_buffer_in := next_wired_buffer_in;
     /initialize_reserved_buffers/
        WHILE block_size > 0 DO
          IF block_size > nlv$bm_large_buffer_size THEN
            reserved_buffer_list^[wired_buffer_in].byte_count := nlv$bm_large_buffer_size;
          ELSE
            reserved_buffer_list^[wired_buffer_in].byte_count := block_size;
          IFEND;
          reserved_buffer_list^[wired_buffer_in].current_offset := 0;
          block_size := block_size - nlv$bm_large_buffer_size;
          wired_buffer_in := (wired_buffer_in MOD reserved_buffer_count) + 1;
        WHILEND /initialize_reserved_buffers/;
      CASEND;

      buffers_used := (block_length + #SIZE(rft$nbp_block_header) +
                       nlv$bm_large_buffer_size - 1) DIV nlv$bm_large_buffer_size;

    /build_io_fragments/
      FOR i := 1 TO buffers_used DO
        NEXT io_fragment IN unit_request;
        IF io_fragment = NIL THEN
          osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
              'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
              'build_network_wired_blocks', status);
          EXIT build_network_wired_blocks;
        IFEND;
        io_fragment^.address := reserved_buffer_list^[next_wired_buffer_in].buffer;
        io_fragment^.length := reserved_buffer_list^[next_wired_buffer_in].byte_count;
        io_fragment^.wired := TRUE;
        number_of_fragments^ := number_of_fragments^ + 1;
        next_wired_buffer_in := (next_wired_buffer_in MOD reserved_buffer_count) + 1;
      FOREND /build_io_fragments/;

      current_wired_buffer := next_wired_buffer_in;
      number_of_blocks^ := number_of_blocks^ + 1;
      data_transfer_status^.block_descriptors^[current_block].byte_count := block_length;

      current_abn := (current_abn + 1) MOD (rfc$max_appl_block_number + 1);
      current_block :=
            (current_block MOD UPPERBOUND(data_transfer_status^.block_descriptors^)) + 1;

      IF data_exhausted THEN
        EXIT /build_requested_blocks/;
      IFEND;

    FOREND /build_requested_blocks/;

    blocks_to_add := number_of_blocks^;
    data_transfer_status^.current_fragment_index :=  current_fragment;
    data_transfer_status^.current_fragment_offset := current_offset;
    data_transfer_status^.current_abn := current_abn;
    data_transfer_status^.block_descriptor_in := current_block;
    data_transfer_status^.next_wired_buffer_in := current_wired_buffer;
    data_transfer_status^.data_exhausted := data_exhausted;
    send_intermediate_response^ := NOT data_exhausted;

    osp$disestablish_cond_handler;

  PROCEND build_network_wired_blocks;
?? TITLE := '    build_transfer_request_header', EJECT ??
  PROCEDURE build_transfer_request_header (
        data_transfer_status: ^rft$data_transfer_status;
        termination_mark: rft$record_marks;
    VAR unit_request: ^ SEQ ( * );
    VAR status: ost$status);

{
{     The purpose of this procedure is to build the header portion of a
{     pp data transfer request.  This header is required whenever a
{     transfer request is initiated.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters
{      for the data transfer request.
{
{     TERMINATION_MARK: (input) This parameter specifies the file mark
{       that will terminate a receive data request when encountered by the
{       pp.
{
{     UNIT_REQUEST: (input,output) This parameter specifies the sequence to build
{       the data transfer request header in.
{
{     STATUS: (output) This parameter returns the results of the request.
{       A status of normal indicates that the transfer header was successfully
{       built.


    VAR
      asynchronous_request: ^boolean,
      command_identifier: ^rft$logical_commands,
      path_id: ^rft$path_identifier,
      transfer_type: ^rft$transfer_mode;



    status.normal := TRUE;
    RESET unit_request;
    NEXT command_identifier  IN  unit_request;
    IF  command_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_transfer_request_header', status);
      EXIT  build_transfer_request_header;
    IFEND;
    CASE data_transfer_status^.transfer_kind OF
    = rfc$tk_send_data =
      command_identifier^ := rfc$lc_send_data;
    = rfc$tk_receive_data =
      command_identifier^ := rfc$lc_receive_data;
      NEXT transfer_type IN  unit_request;
      IF  transfer_type = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
              'the request overflowed the request sequence', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'build_transfer_request_header', status);
        EXIT  build_transfer_request_header;
      IFEND;
      IF data_transfer_status^.transmission_mode = rfc$record_mode THEN
        transfer_type^.transfer_mode := rfc$tm_record_mode;
        transfer_type^.termination_mark := termination_mark;
      ELSE
        transfer_type^.transfer_mode := rfc$tm_message_mode;
      IFEND;
    CASEND;
    NEXT asynchronous_request IN  unit_request;
    IF  asynchronous_request = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_transfer_request_header', status);
      EXIT  build_transfer_request_header;
    IFEND;
    asynchronous_request^ := (data_transfer_status^.wait = osc$nowait);
    NEXT  path_id  IN  unit_request;
    IF  path_id = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_transfer_request', status);
      EXIT  build_transfer_request_header;
    IFEND;
    path_id^ := data_transfer_status^.connection_descriptor.network_path;


  PROCEND build_transfer_request_header;
?? TITLE := '    build_unwired_blocks', EJECT ??
  PROCEDURE build_unwired_blocks (data_transfer_status: ^rft$data_transfer_status;
    VAR unit_request: ^SEQ(*);
    VAR blocks_to_add: rft$outstanding_blocks;
    VAR status: ost$status);


{
{     The purpose of this procedure is to transform the data fragments specified
{     by the user into network blocks and add them to the send or receive pp
{     request.  This routine builds the network block subfunctions and adds
{     them to the pp transfer request.  In the case of send data, the subfunctions
{     direct the pp to the location of the data to be sent. In the case of receive
{     data, the subfunctions direct the pp to where the data is to be written.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters for
{       the data transfer request.
{
{     UNIT_REQUEST: (input,output) This parameter specifies the pp unit request
{       to add the block definitions to.
{
{     BLOCKS_TO_ADD: (input,output) This parameter specifies the number of network
{       blocks to add to the pp unit request. Upon return this parameter contains
{       the actual number of blocks added to the pp unit request.
{
{     STATUS: (ouput) This parameter specifies the results of the request.  A
{       normal status indicates that no abnormal conditions were encountered.


    VAR
      block: rft$outstanding_blocks,
      block_descriptors: ^rft$block_descriptors,
      block_size: rft$block_size,
      current_abn: rft$application_block_number,
      current_block: rft$outstanding_blocks,
      current_fragment: rft$data_fragment_count,
      current_offset: rft$data_length,
      data_exhausted: boolean,
      header_buffers: ^rft$header_buffers,
      header_fragment: ^rft$io_fragment,
      io_fragment: ^rft$io_fragment,
      number_of_blocks: ^0..rfc$command_buffer_size,
      number_of_fragments: ^0..rfc$command_buffer_size,
      remaining_fragment_length: rft$data_fragment_count,
      send_intermediate_response: ^BOOLEAN;

    data_exhausted := FALSE;
    current_fragment := data_transfer_status^.next_to_queue_index;
    current_offset := data_transfer_status^.next_to_queue_offset;
    current_abn := data_transfer_status^.next_to_queue_abn;
    current_block := data_transfer_status^.block_descriptor_in;
    block_size := data_transfer_status^.block_size;
    header_buffers := data_transfer_status^.header_buffers;
    block_descriptors := data_transfer_status^.block_descriptors;


    IF blocks_to_add > rfc$max_blocks_to_add THEN
      blocks_to_add := rfc$max_blocks_to_add;
    IFEND;
    NEXT send_intermediate_response IN unit_request;
    IF send_intermediate_response = NIL THEN
      osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_unwired_blocks', status);
      EXIT build_unwired_blocks;
    IFEND;
    NEXT number_of_blocks IN unit_request;
    IF number_of_blocks = NIL THEN
      osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
            'the request overflowed the request sequence', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'build_unwired_blocks', status);
      EXIT build_unwired_blocks;
    IFEND;
    number_of_blocks^ := 0;

    /build_requested_blocks/
    FOR block := 1 TO blocks_to_add DO
      NEXT number_of_fragments IN unit_request;
      IF number_of_fragments = NIL THEN
        osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
              'the request overflowed the request sequence', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'build_unwired_blocks', status);
        EXIT build_unwired_blocks;
      IFEND;
      number_of_fragments^ := 0;

      NEXT header_fragment IN unit_request;
      IF header_fragment = NIL THEN
        osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
              'the request overflowed the request sequence', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'build_unwired_blocks', status);
        EXIT build_unwired_blocks;
      IFEND;

      header_fragment^.length := #size(rft$nbp_block_header);
      header_fragment^.address := #loc(header_buffers^[current_block]);
      header_fragment^.wired := TRUE;
      number_of_fragments^ := 1;

      NEXT io_fragment IN unit_request;
      IF io_fragment = NIL THEN
        osp$set_status_abnormal ( rfc$product_id, rfe$request_processing_err,
              'the request overflowed the request sequence', status);
        osp$append_status_parameter(osc$status_parameter_delimiter,
              'build_unwired_blocks', status);
        EXIT build_unwired_blocks;
      IFEND;

      remaining_fragment_length := data_transfer_status^.data_area^[current_fragment].length -
            current_offset;
      io_fragment^.address := i#ptr(current_offset, data_transfer_status^.
            data_area^[current_fragment].address);
      block_descriptors^[current_block].data_fragment_index :=
            current_fragment;
      block_descriptors^[current_block].data_fragment_offset :=
            current_offset;
      block_descriptors^[current_block].block_sequence_number := current_abn;
      IF remaining_fragment_length > block_size THEN
        current_offset := current_offset + block_size;
        io_fragment^.length := block_size;
      ELSEIF remaining_fragment_length = block_size THEN
        IF current_fragment = UPPERBOUND(data_transfer_status^.data_area^) THEN
          data_exhausted := TRUE;
        ELSE
          data_transfer_status^.switch_to_wired_buffers := TRUE;
        IFEND;
        current_offset := current_offset + remaining_fragment_length;
        io_fragment^.length := remaining_fragment_length;
      ELSE  { remaining data does not fill the network block }
        CASE data_transfer_status^.transfer_kind OF
        = rfc$tk_send_data =
          IF current_fragment = UPPERBOUND(data_transfer_status^.data_area^) THEN
            data_exhausted := TRUE;
            IF (NOT data_transfer_status^.end_of_message) AND
                  (data_transfer_status^.transmission_mode = rfc$record_mode) THEN
              osp$set_status_abnormal (rfc$product_id, rfe$unable_to_send_all_data,
                    'no end of message was specified', data_transfer_status^.previous_error);
              EXIT /build_requested_blocks/;
            IFEND;
            current_offset := current_offset + remaining_fragment_length;
          ELSE
            data_transfer_status^.switch_to_wired_buffers := TRUE;
            EXIT /build_requested_blocks/;
          IFEND;
        = rfc$tk_receive_data =
          data_transfer_status^.switch_to_wired_buffers := TRUE;
          EXIT /build_requested_blocks/;
        CASEND;
        io_fragment^.length := remaining_fragment_length;
      IFEND;
      number_of_fragments^ := number_of_fragments^ + 1;
      block_descriptors^[current_block].byte_count := io_fragment^.length;
      io_fragment^.wired := FALSE;
      number_of_blocks^ := number_of_blocks^ + 1;

      IF data_transfer_status^.transfer_kind = rfc$tk_send_data THEN
        build_network_header (data_transfer_status, io_fragment^.length, data_exhausted,
              current_abn, ^header_buffers^[current_block].header);
      IFEND;

      current_abn := (current_abn + 1) MOD (rfc$max_appl_block_number + 1);
      current_block := (current_block MOD UPPERBOUND(block_descriptors^)) + 1;

      IF data_exhausted THEN
        EXIT /build_requested_blocks/;
      IFEND;

    FOREND /build_requested_blocks/;

    blocks_to_add := number_of_blocks^;
    data_transfer_status^.current_fragment_index :=  current_fragment;
    data_transfer_status^.current_fragment_offset := current_offset;
    data_transfer_status^.current_abn := current_abn;
    data_transfer_status^.block_descriptor_in := current_block;
    data_transfer_status^.data_exhausted := data_exhausted;
    send_intermediate_response^ := NOT (data_exhausted OR data_transfer_status^.switch_to_wired_buffers);

  PROCEND build_unwired_blocks;
?? TITLE := '    rfp$change_attributes', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$change_attributes (
        connection_file: fst$file_reference;
        file_attributes: rft$change_attributes;
    VAR status: ost$status);

*copyc rfh$change_attributes

?? NEWTITLE := '      terminate_change - condition handler', EJECT ??
    PROCEDURE terminate_change (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        IF connection_entry_p <> NIL THEN
          rfp$unlock_table (connection_entry_p^.lock);
        IFEND;
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$change_attributes;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$change_attributes;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_change;
?? OLDTITLE, EJECT ??


    VAR
      connection_entry_p: ^rft$connection_entry,
      path_handle_name: fst$path_handle_name;


    connection_entry_p := NIL;
    osp$establish_condition_handler (^terminate_change, FALSE);
    status.normal := TRUE;

    get_path_handle_name (connection_file, path_handle_name, status);
    IF NOT status.normal THEN
      EXIT rfp$change_attributes;
    IFEND;
    get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
    IF NOT status.normal THEN
      EXIT rfp$change_attributes;
    IFEND;
    merge_change_attributes (^connection_entry_p^.connection_attributes,
          ^file_attributes, status);
    rfp$unlock_table (connection_entry_p^.lock);

  PROCEND rfp$change_attributes;
?? TITLE := '    rfp$check_for_event', EJECT ??
  PROCEDURE [XDCL] rfp$check_for_event (event: ost$i_activity;
    VAR event_occurred: boolean;
    VAR status: ost$status);

{
{     The purpose of this procedure is to check for the occurrance of
{     the specified event in the RHFAM tables.
{
{     EVENT: (input) This parameter specifies the event to check for.
{
{     EVENT_OCCURRED: (output) This parameter specifies if the event
{       has occurred. This parameter is not meaningful if the status
{       parameter is not normal.
{
{     STATUS: (output) This parameter returns the status of the request.
{       A status of normal indicates that the event was successfully
{       checked.
{
{     NOTE: PMP$WAIT must not be called within this routine unless an
{       abnormal status or an event occurred is going to be returned.
{       If it is called, it could absorb a ready task flag that was
{       raised because of another event occuring.  The ready flag
{       would have intended to pull the task out of the pmp$wait in
{       osp$i_await_activity but it would be spent getting out of the
{       pmp$wait in these routines.

?? NEWTITLE := '      terminate_check_event - condition handler', EJECT ??
    PROCEDURE terminate_check_event (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      VAR
        activity_status: ^ost$activity_status,
        current_request: ^rft$outstanding_requests,
        mgmt_status: ^rft$connection_mgmt_status,
        previous_request: ^rft$outstanding_requests;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        block_exit_expected := TRUE;
        EXIT rfp$check_for_event;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          current_request := rfv$outstanding_requests;
        /complete_synchronous_request/
          WHILE current_request <> NIL DO
            IF (current_request^.request_id.ring_1_id.address <> NIL) AND
               (NOT current_request^.request_id.ring_1_id.address^.asynchronous_request) THEN
              mgmt_status := current_request^.request_status;
              activity_status := mgmt_status^.activity_status;
              REPEAT
                #SPOIL (activity_status^);
                syp$cycle;
                rfp$process_pp_response_flag (rfc$pp_response_available);
              UNTIL activity_status^.complete;
              FREE activity_status  IN osv$task_private_heap^;
              current_request := rfv$outstanding_requests;
              EXIT /complete_synchronous_request/;
            IFEND;
            current_request := current_request^.next_entry;
          WHILEND /complete_synchronous_request/;
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, condition_status,
                status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_path_status THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          block_exit_expected := TRUE;
          EXIT rfp$check_for_event;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_check_event;
?? OLDTITLE, EJECT ??


    VAR
      application_entry_p: ^rft$application_table_entry,
      block_exit_expected: boolean,
      connection_descriptor: rft$connection_descriptor,
      connection_entry_p: ^rft$connection_entry,
      connection_unlocked: boolean,
      event_queue_entry_p : ^rft$rhfam_event_table_entry,
      event_to_enter: rft$rhfam_event_table_entry,
      first_pass: boolean,
      input_available: boolean,
      ignore_status: ost$status,
      job_name: jmt$system_supplied_name,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      job_table_locked: boolean,
      new_entry: boolean,
      path_handle_name: fst$path_handle_name,
      server_entry_p: ^rft$rhfam_server_table_entry,
      server_name: rft$application_name,
      switched_connection: ^rft$switched_connection,
      user_job_name: jmt$user_supplied_name;


    block_exit_expected := FALSE;
    first_pass := TRUE;
    osp$establish_condition_handler (^terminate_check_event, TRUE);
    status.normal := TRUE;
    event_occurred := FALSE;


{     The checking of RHFAM events is done in a two pass loop.  The
{     first pass checks for the event and if the event has not occurred,
{     an entry is placed in the RHFAM event queue.  The second pass is
{     used to close the window where the event occurs after the test is
{     made and before the event is entered into the event queue.  This case
{     will cause a several second delay before the system task will
{     again check for the condition and restart the task.  In the case
{     of incoming connects, the system task will not restart the task
{     and the event will never occur.

  /check_event_loop/
    WHILE (NOT event_occurred) AND
          (status.normal ) DO
      CASE event.activity OF
      = rfc$i_await_server_response =
      get_path_handle_name (event.file^, path_handle_name, status);
        IF status.normal THEN
          get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
          IF status.normal THEN
            connection_descriptor := connection_entry_p^.connection_descriptor;
            update_connection_status (connection_entry_p, input_available,
                  connection_unlocked, status);
            IF NOT connection_unlocked THEN
              CASE connection_entry_p^.connection_attributes.connection_status.
                    connection_state OF
              = rfc$outgoing_connect_active =
                ;
              = rfc$connected, rfc$connect_rejected =
                event_occurred := TRUE;
              ELSE
                set_connection_status (connection_entry_p, status);
              CASEND;
              rfp$unlock_table (connection_entry_p^.lock);
            IFEND;
          IFEND;
        IFEND;

        IF (first_pass) AND
           (status.normal) AND
           (NOT event_occurred) THEN
          rfp$lock_table (rfv$status_table.lock);
          IF rfv$status_table.system_task_is_up THEN
            event_to_enter.event_kind := rfc$ana_await_server_response;
            event_to_enter.asr_connection_descriptor := connection_descriptor;
            enter_event_queue (^event_to_enter, event_queue_entry_p, status);
          ELSE
            osp$set_status_abnormal (rfc$product_id,
                  rfe$system_task_not_active, 'Await incoming connection', status);
          IFEND;
          rfp$unlock_table (rfv$status_table.lock);
        IFEND;

      = rfc$i_await_incoming_connect =
        job_table_locked := FALSE;
        rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
        IF job_table_entry_p <> NIL THEN
          job_table_locked := TRUE;
          server_name := event.application_name;
          find_application_entry (server_name, job_table_entry_p, application_entry_p);
          IF application_entry_p <> NIL THEN
            IF application_entry_p^.application_kind = rfc$server THEN
              job_name := job_table_entry_p^.job_name;
              job_table_entry_p^.lock := tmv$null_global_task_id;
              job_table_locked := FALSE;
              rfp$lock_table (rfv$rhfam_server_table.lock);
              find_server_entry (server_name, FALSE, server_entry_p, status);
              IF status.normal THEN
                event_occurred := (server_entry_p^.incoming_connect <> NIL);
              IFEND;
              rfp$unlock_table(rfv$rhfam_server_table.lock);
            ELSE
              osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on_as_server,
                'Await incoming connection', status);
              osp$append_status_parameter (osc$status_parameter_delimiter, server_name, status);
            IFEND;
          ELSE
            osp$set_status_abnormal (rfc$product_id, rfe$not_signed_on,
              'Await incoming connection', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, server_name, status);
          IFEND;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$not_an_rhfam_job,
                'Await incoming connection', status);
        IFEND;

        IF job_table_locked THEN
           job_table_entry_p^.lock := tmv$null_global_task_id;
        IFEND;

        IF (first_pass) AND
           (status.normal) AND
           (NOT event_occurred) THEN
          rfp$lock_table (rfv$status_table.lock);
          IF rfv$status_table.system_task_is_up THEN
            event_to_enter.event_kind := rfc$ana_await_incoming_connect;
            event_to_enter.aic_job_name := job_name;
            event_to_enter.aic_server_name := server_name;
            enter_event_queue (^event_to_enter, event_queue_entry_p, status);
          ELSE
            osp$set_status_abnormal (rfc$product_id,
                  rfe$system_task_not_active, 'Await incoming connection', status);
          IFEND;
          rfp$unlock_table (rfv$status_table.lock);
        IFEND;

      = rfc$i_await_switch_offer =
        rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
        IF job_table_entry_p <> NIL THEN
          rfp$lock_table (rfv$switched_connection_queue.lock);
          switched_connection := rfv$switched_connection_queue.first_entry;

        /find_switched_connection/
          WHILE switched_connection <> NIL DO
            IF (job_table_entry_p^.job_name = switched_connection^.destination_job) AND
               (event.application_name = switched_connection^.destination_application) THEN
              event_occurred := TRUE;
              EXIT /find_switched_connection/;
            IFEND;
            switched_connection := switched_connection^.next_entry;
          WHILEND /find_switched_connection/;

          IF (first_pass) AND
             (NOT event_occurred) THEN
            event_to_enter.event_kind := rfc$ana_await_switch_offer;
            event_to_enter.aso_application_name := event.application_name;
            enter_event_queue (^event_to_enter, event_queue_entry_p, status);
          IFEND;
          rfp$unlock_table (rfv$switched_connection_queue.lock);
          job_table_entry_p^.lock := tmv$null_global_task_id;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$not_an_rhfam_job,
                'Await switch offer', status);
        IFEND;

      = rfc$i_await_switch_accept =
        IF first_pass THEN
          get_path_handle_name (event.connection_file^, path_handle_name, status);
          IF status.normal THEN
            get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
            IF status.normal THEN
              CASE connection_entry_p^.connection_attributes.connection_status.connection_state OF
              = rfc$switch_offered =
                event_to_enter.event_kind := rfc$ana_await_switch_accept;
                pmp$get_job_names(user_job_name, event_to_enter.asa_source_job, ignore_status);
                enter_event_queue (^event_to_enter, event_queue_entry_p, status);

{     The connection that is offered for switch is effectively locked until it is either
{     accepted by the new job or the switch offer is withdrawn.  The job accepting the switch
{     sets the connection state without locking the placeholder connection entry, and then
{     issues a ready task for any task waiting for switch accept on the connection.  To prevent
{     a timing window, the waiting task rechecks the connection status after entering the
{     event queue.

                event_occurred := (connection_entry_p^.connection_attributes.connection_status.
                      connection_state = rfc$switch_accepted);
              = rfc$switch_accepted =
                event_occurred := TRUE;
              ELSE
                set_connection_status (connection_entry_p, status);
              CASEND;
              rfp$unlock_table (connection_entry_p^.lock);
            IFEND;
          IFEND;
        IFEND;
      = rfc$i_await_connection_event =
        get_exclusive_to_cid (event.connection_file_identifier, connection_entry_p, status);
        IF status.normal THEN
          connection_descriptor := connection_entry_p^.connection_descriptor;
          update_connection_status (connection_entry_p, input_available,
                connection_unlocked, status);
          IF NOT connection_unlocked THEN
            CASE connection_entry_p^.connection_attributes.connection_status.connection_state OF
            = rfc$connected =
              CASE event.event_type OF
              = rfc$input_available =
                event_occurred := (connection_entry_p^.connection_attributes.connection_status.
                      input_available);
              = rfc$output_below_threshold =
                event_occurred := connection_entry_p^.connection_attributes.connection_status.
                      output_below_threshold;
              ELSE
                osp$set_status_abnormal (rfc$product_id, rfe$invalid_connection_event, '',status);
              CASEND;
            = rfc$terminated =
              CASE event.event_type OF
              = rfc$input_available =
                IF NOT input_available THEN
                  set_connection_status (connection_entry_p, status);
                ELSE
                  event_occurred := input_available;
                IFEND;
              = rfc$output_below_threshold =
                set_connection_status (connection_entry_p, status);
              ELSE
                osp$set_status_abnormal (rfc$product_id, rfe$invalid_connection_event, '',status);
              CASEND;
            ELSE
              set_connection_status (connection_entry_p, status);
            CASEND;
            rfp$unlock_table (connection_entry_p^.lock);

            IF (first_pass) AND
               (status.normal) AND
               (NOT event_occurred) THEN
              rfp$lock_table (rfv$status_table.lock);
              IF rfv$status_table.system_task_is_up THEN
                event_to_enter.event_kind := rfc$ana_await_connection_event;
                event_to_enter.ace_connection_descriptor := connection_descriptor;
                event_to_enter.ace_input_available := (event.event_type = rfc$input_available);
                event_to_enter.ace_output_buffer_available :=
                      (event.event_type = rfc$output_below_threshold);
                event_to_enter.ace_asynchronous_wait := FALSE;
                event_to_enter.ace_data_transfer_in_progress := FALSE;
                enter_event_queue (^event_to_enter, event_queue_entry_p, status);
              ELSE
                osp$set_status_abnormal (rfc$product_id,
                      rfe$system_task_not_active, 'Await incoming connection', status);
              IFEND;
              rfp$unlock_table (rfv$status_table.lock);
            IFEND;
          IFEND;
        IFEND;
      ELSE
        {  This case should never happen. Ignore the undefined event.
      CASEND;
      IF first_pass THEN
        first_pass := FALSE;
      ELSE
        EXIT /check_event_loop/;
      IFEND;
    WHILEND /check_event_loop/;
    osp$disestablish_cond_handler;

  PROCEND rfp$check_for_event;
?? TITLE := '    rfp$close_file', EJECT ??
  PROCEDURE  [XDCL] rfp$close_file (file_identifier: amt$file_identifier;
        layer: amt$fap_layer_number;
        call_block: amt$call_block;
    VAR status: ost$status);

{     The purpose of this procedure is to perform the close processing
{     required on a connection file. It is called by the RHFAM network
{     FAP during close processing.
{
{     FILE_IDENTIFIER: (input) This parameter specifies the file identifier
{       of the connection file that is being closed.
{
{     LAYER: (input) This parameter specifies the fap layer number that
{       this routine is being called from.
{
{     CALL_BLOCK: (input) This parameter specifies the file manager call
{       block that the RHFAM network fap was called with.
{
{     STATUS: (output) This parameter returns the status of the request.
{


?? NEWTITLE := '      terminate_close_file - condition handler', EJECT ??
    PROCEDURE terminate_close_file (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$close_file;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$close_file;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_close_file;
?? OLDTITLE, EJECT ??


      VAR
        activities: rft$set_of_async_activities,
        connection_entry_p: ^rft$connection_entry,
        connection_name: fst$path_handle_name;


    osp$establish_condition_handler (^terminate_close_file, FALSE);
    get_exclusive_to_cid (file_identifier, connection_entry_p, status);
    IF status.normal THEN
      IF connection_entry_p^.open_count > 0 THEN
        connection_entry_p^.open_count := connection_entry_p^.open_count - 1;
      IFEND;
      connection_name := connection_entry_p^.connection_name;
      rfp$unlock_table (connection_entry_p^.lock);
      activities := $rft$set_of_async_activities[rfc$aa_all_async_activities];
      terminate_async_activity (activities, connection_name);

{     Wait for send or receive complete.

      get_exclusive_to_connection (connection_name, connection_entry_p, status);
      IF status.normal THEN
        rfp$unlock_table (connection_entry_p^.lock);
      IFEND;
    IFEND;

  PROCEND rfp$close_file;
?? TITLE := '    complete_received_blocks', EJECT ??
  PROCEDURE  complete_received_blocks (request_response: ^rft$request_response_buffer;
    VAR data_transfer_status: ^rft$data_transfer_status;
    VAR remaining_blocks: rft$outstanding_blocks;
    VAR status: ost$status);

{
{     The purpose of this procedure is to complete the processing associated with
{     any blocks that have been successfully received from the network.  This
{     routine determines the number of blocks that have been processed and updates
{     the data transfer status to reflect the received blocks. In the event of
{     an error, the data transfer status is updated to reflect the last correctly
{     received block.
{
{     REQUEST_RESPONSE: (input) This parameter specifies the pointer to the
{       ring 1 request response buffer.
{
{     DATA_TRANSFER_STATUS: (input,output) This parameter specifies the pointer
{       to the data transfer status block.
{
{     REMAINING_BLOCKS: (output) This parameter returns the number of network blocks
{       that are still queued in the pp request.
{
{     STATUS: (output) This parameter returns the result of this procedure call.
{       A status of normal indicates no errors have occurred.

?? NEWTITLE := 'terminate_complete_received - condition handler', EJECT ??
    PROCEDURE terminate_complete_received (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

{ This condition handler is designed to prevent forseeable error situations
{ from causing unwanted RHFAM/VE side_effects.  Specifically, segment access
{ conditions and system conditions are not allowed to bubble up but are
{ converted to status instead.

      IF (condition.selector = mmc$segment_access_condition) OR
            (condition.selector = pmc$system_conditions) THEN
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT complete_received_blocks;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND terminate_complete_received;
?? OLDTITLE, EJECT ??

    VAR
      blocks_processed: rft$outstanding_blocks,
      cb_present_out: rft$command_entry,
      command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
      current_fragment: rft$data_fragment_count,
      current_offset: rft$data_length,
      data_bytes_delivered: rft$transfer_length,
      data_p: ^cell,
      data_shortage: rft$data_length,
      header: rft$nbp_block_header,
      header_buffer: ^rft$nbp_block_header,
      move_data_length: rft$bytes_transferred,
      bd_present_out: 1 .. rfc$max_outstanding_blocks,
      receive_buffer_exhausted: boolean,
      remaining_block_size: rft$block_size,
      remaining_fragment_length: rft$data_fragment_count,
      reserved_buffer_count: rft$buffer_count,
      reserved_buffer_list: ^rft$buffer_list,
      wired_buffer_index: rft$buffer_count;


    osp$establish_condition_handler (^terminate_complete_received, FALSE);
    blocks_processed := 0;
    data_shortage := 0;
    receive_buffer_exhausted := FALSE;
    current_offset := data_transfer_status^.complete_offset;
    current_fragment := data_transfer_status^.complete_index;
    cb_present_out := data_transfer_status^.present_r1_out_ptr;
    bd_present_out := data_transfer_status^.block_descriptor_out;
    command_buffer := #LOC(request_response^.command_buffer);

{     Note - The previous out pointer in the response buffer is a pointer
{            to the next subfunction that is to be processed by monitor.
{            The present ring 1 out pointer in the data transfer status
{            structure is the next subfunction to be processed by this
{            code.

    /complete_blocks/
    WHILE cb_present_out <> request_response^.previous_out_ptr DO
      #SPOIL (request_response^.previous_out_ptr);

{     Advance to next subfunction.

      data_bytes_delivered := command_buffer^[cb_present_out].sf_transfer_length;
      cb_present_out := cb_present_out + command_buffer^[cb_present_out].sf_length DIV 8;
      IF cb_present_out >= rfc$cbi_limit_pointer THEN
        cb_present_out := cb_present_out - rfc$cbi_limit_pointer + rfc$cbi_first_io_entry;
      IFEND;
      blocks_processed := blocks_processed + 1;

{     Locate network block header.

      IF data_transfer_status^.network_wired_data THEN
        reserved_buffer_list := data_transfer_status^.reserved_buffer_list;
        reserved_buffer_count := data_transfer_status^.reserved_buffer_count;
        wired_buffer_index := data_transfer_status^.block_descriptors^[bd_present_out].
              wired_buffer_index;
        data_p := #LOC(header);
        header_buffer := data_p;
        move_data_length := #SIZE(rft$nbp_block_header);
        rfp$move_data_from_wired_buffs(reserved_buffer_list^, data_p, reserved_buffer_count,
              wired_buffer_index, move_data_length);
      ELSE
        header_buffer := ^data_transfer_status^.header_buffers^[bd_present_out].header;
      IFEND;

{     Verify network block integrity.
{
{       Verify that the data delivered by the PPU equals or exceeds the amount of
{       data indicated in the network block header.

      remaining_block_size := (header_buffer^.length + 7) DIV 8;
      IF remaining_block_size > data_bytes_delivered THEN
        osp$set_status_abnormal (rfc$product_id, rfe$network_block_exceeded,
              '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              data_bytes_delivered, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, remaining_block_size,
              10, FALSE, status);
        EXIT /complete_blocks/;
      IFEND;

{       Verify that the data indicated in the network block header does not exceed
{       the defined block size.  This test is required because of data padding that
{       may occur and may not be caught by the previous test.

      IF  remaining_block_size > data_transfer_status^.block_size THEN
        osp$set_status_abnormal (rfc$product_id, rfe$network_block_exceeded,
              '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, data_transfer_status^.
              block_descriptors^[bd_present_out].byte_count, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, remaining_block_size,
              10, FALSE, status);
        EXIT /complete_blocks/;
      IFEND;

      CASE data_transfer_status^.transmission_mode OF
      = rfc$record_mode =
        IF data_transfer_status^.block_descriptors^[bd_present_out].block_sequence_number <>
              header_buffer^.application_block_number THEN
          osp$set_status_abnormal(rfc$product_id, rfe$block_sequence_error,
                data_transfer_status^.connection_name, status);
          osp$append_status_integer(osc$status_parameter_delimiter,
                data_transfer_status^.block_descriptors^[bd_present_out].block_sequence_number,
                10, FALSE, status);
          osp$append_status_integer(osc$status_parameter_delimiter,
                header_buffer^.application_block_number,
                10, FALSE, status);
          EXIT /complete_blocks/;
        IFEND;
        IF remaining_block_size < data_transfer_status^.block_size THEN
          IF (NOT header_buffer^.data_block_clarifier.end_of_information) AND
             (NOT header_buffer^.data_block_clarifier.end_of_record) THEN
            osp$set_status_abnormal (rfc$product_id, rfe$partial_network_block,
                  '', status);
            EXIT /complete_blocks/;
          IFEND;
        IFEND;
      = rfc$message_mode =
        build_back_message (data_transfer_status, header_buffer);
      CASEND;

{     Deliver data block.

      data_shortage := data_shortage + (data_transfer_status^.block_size - remaining_block_size);
      IF data_transfer_status^.network_wired_data THEN
        reserved_buffer_count := data_transfer_status^.reserved_buffer_count;
      /advance_by_block_in_fragments/
        WHILE remaining_block_size > 0 DO
          remaining_fragment_length := data_transfer_status^.data_area^[current_fragment].length -
                current_offset;
          data_p := i#ptr(current_offset, data_transfer_status^.data_area^[current_fragment].address);
          IF remaining_fragment_length > remaining_block_size THEN
            move_data_length := remaining_block_size;
            data_transfer_status^.bytes_transferred := data_transfer_status^.bytes_transferred +
                  move_data_length;
            rfp$move_data_from_wired_buffs(reserved_buffer_list^, data_p, reserved_buffer_count,
                  wired_buffer_index, move_data_length);
            current_offset := current_offset + remaining_block_size;
            remaining_block_size := 0;
          ELSE   {remainder of block does not fit in fragment OR}
                 {remainder of block just fits in fragment}
            move_data_length := remaining_fragment_length;
            data_transfer_status^.bytes_transferred := data_transfer_status^.bytes_transferred +
                  move_data_length;
            rfp$move_data_from_wired_buffs(reserved_buffer_list^, data_p, reserved_buffer_count,
                  wired_buffer_index, move_data_length);
            remaining_block_size := remaining_block_size - remaining_fragment_length;
            IF current_fragment = UPPERBOUND(data_transfer_status^.data_area^) THEN
              receive_buffer_exhausted := TRUE;
              IF (remaining_block_size <> 0) THEN
                save_residue_data (data_transfer_status, remaining_block_size,
                      wired_buffer_index, status);
                remaining_block_size := 0;
                IF NOT status.normal THEN
                  EXIT /complete_blocks/;
                IFEND;
              IFEND;
            ELSE
              current_offset := 0;
              current_fragment := current_fragment + 1;
            IFEND;
          IFEND;
        WHILEND /advance_by_block_in_fragments/;
      ELSE
        data_transfer_status^.bytes_transferred := data_transfer_status^.bytes_transferred +
              remaining_block_size;
        current_offset := current_offset + remaining_block_size;
      IFEND;
      bd_present_out := (bd_present_out MOD
            UPPERBOUND(data_transfer_status^.block_descriptors^)) + 1;
    WHILEND /complete_blocks/;

    data_transfer_status^.complete_offset := current_offset;
    data_transfer_status^.complete_index := current_fragment;
    data_transfer_status^.present_r1_out_ptr := cb_present_out;
    data_transfer_status^.block_descriptor_out := bd_present_out;
    data_transfer_status^.total_blocks_queued := data_transfer_status^.total_blocks_queued -
          blocks_processed;

    IF (data_shortage <> 0) AND
       (NOT receive_buffer_exhausted) THEN
       reset_next_to_queue (data_shortage, data_transfer_status);
    IFEND;

    remaining_blocks := data_transfer_status^.total_blocks_queued;

    osp$disestablish_cond_handler;

  PROCEND complete_received_blocks;
?? TITLE := '    complete_sent_blocks', EJECT ??
  PROCEDURE  complete_sent_blocks (request_response: ^rft$request_response_buffer;
        data_transfer_status: ^rft$data_transfer_status;
    VAR remaining_blocks: rft$outstanding_blocks);

{
{     The purpose of this procedure is to complete the processing associated with
{     any blocks that have been successfully transmitted to the network.  This
{     routine determines the number of blocks that have been processed and updates
{     the data transfer status to reflect the sent blocks.
{
{     REQUEST_RESPONSE: (input) This parameter specifies the pointer to the
{       ring 1 request response buffer.
{
{     DATA_TRANSFER_STATUS: (input,output) This parameter specifies the pointer
{       to the data transfer status block.
{
{     REMAINING_BLOCKS: (output) This parameter returns the number of network blocks
{       that are still queued in the pp request.


    VAR
      block_size: rft$block_size,
      blocks_processed: rft$outstanding_blocks,
      cb_present_out: rft$command_entry,
      command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
      bd_present_out: integer,
      remaining_fragment_length: rft$data_fragment_count,
      wired_buffer_index: rft$buffer_count;


    blocks_processed := 0;
    cb_present_out := data_transfer_status^.present_r1_out_ptr;
    bd_present_out := data_transfer_status^.block_descriptor_out;
    command_buffer := #LOC(request_response^.command_buffer);

{     Note - The previous out pointer in the response buffer is a pointer
{            to the next subfunction that is to be processed by monitor.
{            The present ring 1 out pointer in the data transfer status
{            structure is the next subfunction to be processed by this
{            code.

  /complete_blocks/
    WHILE cb_present_out <> request_response^.previous_out_ptr DO
      #SPOIL (request_response^.previous_out_ptr);

{     Advance to next subfunction.

      cb_present_out := cb_present_out + command_buffer^[cb_present_out].sf_length DIV 8;
      IF cb_present_out >= rfc$cbi_limit_pointer THEN
        cb_present_out := cb_present_out - rfc$cbi_limit_pointer + rfc$cbi_first_io_entry;
      IFEND;
      blocks_processed := blocks_processed + 1;

{     Complete block processing.

      IF data_transfer_status^.network_wired_data THEN
        block_size := data_transfer_status^.block_descriptors^[bd_present_out].byte_count +
              #SIZE(rft$nbp_block_header);
        wired_buffer_index := data_transfer_status^.block_descriptors^[bd_present_out].wired_buffer_index;
      /reset_network_wired_buffers/
        WHILE block_size > 0 DO
          block_size := block_size -
                data_transfer_status^.reserved_buffer_list^[wired_buffer_index].byte_count;
          data_transfer_status^.reserved_buffer_list^[wired_buffer_index].byte_count := 0;
          data_transfer_status^.reserved_buffer_list^[wired_buffer_index].current_offset := 0;
          wired_buffer_index :=
                (wired_buffer_index MOD data_transfer_status^.reserved_buffer_count) + 1;
        WHILEND /reset_network_wired_buffers/;
      IFEND;
      data_transfer_status^.bytes_transferred := data_transfer_status^.bytes_transferred +
        data_transfer_status^.block_descriptors^[bd_present_out].byte_count;

      block_size := data_transfer_status^.block_descriptors^[bd_present_out].byte_count;
      /advance_in_data_fragments/
      WHILE block_size > 0 DO
        remaining_fragment_length := data_transfer_status^.data_area^[data_transfer_status^.
              complete_index].length - data_transfer_status^.complete_offset;
        IF remaining_fragment_length > block_size THEN  {block fits in fragment}
          data_transfer_status^.complete_offset :=
            data_transfer_status^.complete_offset + block_size;
          block_size := 0;
        ELSE  {block does not fit in fragment or just fits}
          block_size := block_size - remaining_fragment_length;
          data_transfer_status^.complete_offset := 0;

{     The routine queueing the data blocks will not queue a block that is larger
{     than the upper fragment. Therefore if at the upperbound of the data fragments,
{     the block size will equal the fragment size.

          IF data_transfer_status^.complete_index <> UPPERBOUND(data_transfer_status^.data_area^) THEN
            data_transfer_status^.complete_index :=
              data_transfer_status^.complete_index + 1;
          IFEND;
        IFEND;
      WHILEND /advance_in_data_fragments/;
      bd_present_out :=
            (bd_present_out MOD UPPERBOUND(data_transfer_status^.block_descriptors^)) + 1;
    WHILEND /complete_blocks/;

    IF data_transfer_status^.transmission_mode = rfc$message_mode THEN
      data_transfer_status^.outgoing_message_count :=
            data_transfer_status^.outgoing_message_count + blocks_processed;
    IFEND;

    data_transfer_status^.present_r1_out_ptr := cb_present_out;
    data_transfer_status^.block_descriptor_out := bd_present_out;
    data_transfer_status^.total_blocks_queued := data_transfer_status^.total_blocks_queued -
          blocks_processed;
    remaining_blocks := data_transfer_status^.total_blocks_queued;

  PROCEND complete_sent_blocks;
?? TITLE := '    rfp$continue_data_transfer', EJECT ??
  PROCEDURE [XDCL] rfp$continue_data_transfer (
        command_buffer: ^ARRAY [ rft$command_entry ] OF rft$command;
        completion_state: rft$transfer_state;
    VAR current_request: ^rft$outstanding_requests;
    VAR release_request: boolean);

{     The purpose of this procedure is to continue the data transfer process
{     when a pp unit request response has been received.  This routine
{     determines the number of network blocks that were sent/received, updates the
{     transfer statistics, and adds new blocks to the pp unit request to
{     reach the maximum network blocks queued. If the data transfer is complete
{     any buffers are released and the activity status is set for the user.
{
{     NOTE: This routine is executing as the result of a pp response system flag.
{     Therefore this request should not call any wait routines.  If a wait
{     routine is called, another copy of this procedure could run causing
{     unpredicable results.
{
{     COMMAND_BUFFER: (input) This parameter specifies a pointer to the
{       completed unit request command buffer.
{
{     COMPLETION_STATE: (input) This parmeter specifies a pointer to the
{       status of the completed transfer request.
{
{     CURRENT_REQUEST: (input) This parameter specifies the pointer to the
{       current request that that has been completed.
{
{     RELEASE_REQUEST: (output) This parameter specifies if the caller should
{       release the unit request buffer associated with this request.  If
{       true, the transfer is complete or is being suspended.
{

    VAR
      blocks_to_add: rft$outstanding_blocks,
      current_time: integer,
      data_transfer_status: ^rft$data_transfer_status,
      event: rft$rhfam_event_table_entry,
      event_occurred_type: rft$event_occurred_type,
      ignore_status: ost$status,
      remaining_blocks: rft$outstanding_blocks,
      request_response: ^rft$request_response_buffer,
      status: ost$status,
      unit_request_idle: boolean;


    release_request := FALSE;
    unit_request_idle := TRUE;
    status.normal := TRUE;
    data_transfer_status := current_request^.request_status;
    request_response := current_request^.request_id.ring_1_id.address;
    remaining_blocks := data_transfer_status^.maximum_outstanding_blocks;

    IF NOT (completion_state.transfer_state = rfc$ts_resource_limit_change) AND
       data_transfer_status^.previous_error.normal THEN
      CASE data_transfer_status^.transfer_kind OF
      = rfc$tk_send_data =
        complete_sent_blocks (request_response, data_transfer_status,
              remaining_blocks);
      = rfc$tk_receive_data =
        complete_received_blocks (request_response, data_transfer_status,
              remaining_blocks,
              data_transfer_status^.previous_error);
      CASEND;
    IFEND;

    CASE completion_state.transfer_state OF
    = rfc$ts_intermediate =
      blocks_to_add := data_transfer_status^.maximum_outstanding_blocks - remaining_blocks;
      IF (NOT data_transfer_status^.data_exhausted) AND
         (data_transfer_status^.previous_error.normal) AND
         (blocks_to_add <> 0) THEN
        unit_request_idle := FALSE;
        continue_data_transfer(data_transfer_status, blocks_to_add,
              current_request, unit_request_idle, data_transfer_status^.previous_error);
      IFEND;
    = rfc$ts_normal =
      IF remaining_blocks <> 0 THEN
        reset_data_buffer(data_transfer_status);
      IFEND;
      blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
      IF (NOT data_transfer_status^.data_exhausted) AND
         (data_transfer_status^.previous_error.normal) THEN
        continue_data_transfer(data_transfer_status, blocks_to_add,
              current_request, unit_request_idle, data_transfer_status^.previous_error);
        IF (unit_request_idle) AND
           (NOT data_transfer_status^.previous_error.normal) THEN
          terminate_transfer_request (data_transfer_status^.previous_error, data_transfer_status);
          release_request := TRUE;
        IFEND;
      ELSE
        terminate_transfer_request (data_transfer_status^.previous_error,
              data_transfer_status);
        release_request := TRUE;
      IFEND;
    = rfc$ts_retryable_error =
      IF remaining_blocks <> 0 THEN
        reset_data_buffer(data_transfer_status);
      IFEND;
      blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
      IF data_transfer_status^.previous_error.normal THEN
        continue_data_transfer(data_transfer_status, blocks_to_add,
              current_request, unit_request_idle, data_transfer_status^.previous_error);
        IF (unit_request_idle) AND
           (NOT data_transfer_status^.previous_error.normal) THEN
          terminate_transfer_request (data_transfer_status^.previous_error, data_transfer_status);
          release_request := TRUE;
        IFEND;
      ELSE
        terminate_transfer_request (data_transfer_status^.previous_error,
              data_transfer_status);
        release_request := TRUE;
      IFEND;
    = rfc$ts_resource_limit =
      IF remaining_blocks <> 0 THEN
        reset_data_buffer(data_transfer_status);
      IFEND;

      IF data_transfer_status^.previous_error.normal THEN
        rfp$lock_table(data_transfer_status^.connection_entry_p^.lock);
        IF data_transfer_status^.connection_entry_p^.connection_attributes.connection_status.
              connection_state = rfc$connected THEN
          event.event_kind := rfc$ana_await_connection_event;
          event.ace_connection_descriptor := data_transfer_status^.connection_entry_p^.
                connection_descriptor;
          CASE data_transfer_status^.transfer_kind OF
          = rfc$tk_receive_data =
            event.ace_input_available := TRUE;
            event.ace_output_buffer_available := FALSE;
          = rfc$tk_send_data =
            event.ace_input_available := FALSE;
            event.ace_output_buffer_available := TRUE;
          CASEND;
          event.ace_asynchronous_wait := (data_transfer_status^.wait = osc$nowait);
          event.ace_data_transfer_in_progress := TRUE;
          pmp$get_microsecond_clock (current_time, ignore_status);
          event.ace_asynchronous_timeout := current_time + (data_transfer_status^.
                connection_entry_p^.connection_attributes.data_transfer_timeout*1000);
          enter_event_queue (^event, current_request^.waiting_event, status);
          rfp$unlock_table(data_transfer_status^.connection_entry_p^.lock);
          IF status.normal THEN
            suspend_data_transfer (current_request, status);
            IF NOT status.normal THEN
              remove_data_transfer_event (current_request^.waiting_event);
              terminate_transfer_request (status, data_transfer_status);
              release_request := TRUE;
            IFEND;
          ELSE
            terminate_transfer_request (status, data_transfer_status);
            release_request := TRUE;
          IFEND;
        ELSE
          set_connection_status (data_transfer_status^.connection_entry_p,
                status);
          rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
          terminate_transfer_request (status, data_transfer_status);
          release_request := TRUE;
        IFEND;
      ELSE
        terminate_transfer_request (data_transfer_status^.previous_error,
              data_transfer_status);
        release_request := TRUE;
      IFEND;

    = rfc$ts_resource_limit_change =
        event_occurred_type := current_request^.waiting_event^.event_occurred_type;
        remove_data_transfer_event (current_request^.waiting_event);
        CASE event_occurred_type OF
        = rfc$eot_input_available, rfc$eot_output_below_threshold =
          blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
          restart_data_transfer(current_request, data_transfer_status^.termination_mark,
                blocks_to_add, status);
          IF NOT status.normal THEN
            terminate_transfer_request (status, data_transfer_status);
            release_request := TRUE;
          IFEND;
        = rfc$eot_timeout =
          CASE data_transfer_status^.transfer_kind OF
          = rfc$tk_send_data =
            osp$set_status_abnormal (rfc$product_id, rfe$transfer_timeout,
                  'Send data', status);
          = rfc$tk_receive_data =
            osp$set_status_abnormal (rfc$product_id, rfe$transfer_timeout,
                  'Receive_data', status);
          CASEND;
          terminate_transfer_request (status, data_transfer_status);
          release_request := TRUE;
        = rfc$eot_connection_terminated =
          osp$set_status_abnormal (rfc$product_id, rfe$connection_terminated,
                data_transfer_status^.connection_name, status);
          data_transfer_status^.reason_for_termination := rfc$peer_termination;
          terminate_transfer_request (status, data_transfer_status);
          release_request := TRUE;
        = rfc$eot_async_terminated =
          terminate_transfer_request (data_transfer_status^.previous_error, data_transfer_status);
          release_request := TRUE;
        ELSE
          rfp$lock_table(data_transfer_status^.connection_entry_p^.lock);
          set_connection_status (data_transfer_status^.connection_entry_p, status);
          rfp$unlock_table(data_transfer_status^.connection_entry_p^.lock);
          terminate_transfer_request (status, data_transfer_status);
          release_request := TRUE;
        CASEND;

    = rfc$ts_fatal_error =
      IF remaining_blocks <> 0 THEN
        reset_data_buffer(data_transfer_status);
      IFEND;
      osp$set_status_abnormal (rfc$product_id, rfe$connection_terminated,
            data_transfer_status^.connection_name, status);
      data_transfer_status^.reason_for_termination := rfc$media_failure;
      terminate_transfer_request (status, data_transfer_status);
      release_request := TRUE;
    = rfc$ts_broken =
      IF remaining_blocks <> 0 THEN
        reset_data_buffer(data_transfer_status);
      IFEND;
      osp$set_status_abnormal (rfc$product_id, rfe$connection_terminated,
            data_transfer_status^.connection_name, status);
      data_transfer_status^.reason_for_termination := rfc$peer_termination;
      terminate_transfer_request (status, data_transfer_status);
      release_request := TRUE;
    = rfc$ts_alert =
      IF remaining_blocks <> 0 THEN
        reset_data_buffer(data_transfer_status);
      IFEND;
      CASE data_transfer_status^.transfer_kind OF
      = rfc$tk_send_data =
        osp$set_status_abnormal (rfc$product_id, rfe$invalid_alert_received,
              data_transfer_status^.connection_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER(completion_state.alert_kind), 10, FALSE, status);
        terminate_transfer_request (status, data_transfer_status);
        release_request := TRUE;
      = rfc$tk_receive_data =
        CASE data_transfer_status^.transmission_mode OF
        = rfc$record_mode =
          CASE completion_state.alert_kind OF
          = rfc$ak_eoi_block =
            IF (data_transfer_status^.connection_entry_p^.residue_input_data = NIL) THEN
              data_transfer_status^.complete_message_received := TRUE;
              data_transfer_status^.file_mark_received := rfc$rm_eoi;
            ELSE
              rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
              data_transfer_status^.connection_entry_p^.residue_input_data^.
                    record_mark_encountered := TRUE;
              data_transfer_status^.connection_entry_p^.residue_input_data^.
                    record_mark := rfc$rm_eoi;
              rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
            IFEND;
            terminate_transfer_request (data_transfer_status^.previous_error,
                  data_transfer_status);
            release_request := TRUE;
          = rfc$ak_eof_block =
            IF (rfc$rm_eof >= data_transfer_status^.file_mark) OR
               (data_transfer_status^.data_exhausted) OR
               (NOT data_transfer_status^.previous_error.normal) THEN
              IF (data_transfer_status^.connection_entry_p^.residue_input_data = NIL) THEN
                data_transfer_status^.complete_message_received := TRUE;
                data_transfer_status^.file_mark_received := rfc$rm_eof;
              ELSE
              rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
              data_transfer_status^.connection_entry_p^.residue_input_data^.
                    record_mark_encountered := TRUE;
              data_transfer_status^.connection_entry_p^.residue_input_data^.
                    record_mark := rfc$rm_eof;
              rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
              IFEND;
              terminate_transfer_request (data_transfer_status^.previous_error,
                    data_transfer_status);
              release_request := TRUE;
            ELSE
              suspend_data_transfer (current_request, status);
              data_transfer_status^.termination_mark := data_transfer_status^.file_mark;
              IF NOT data_transfer_status^.network_wired_data THEN
                data_transfer_status^.switch_to_wired_buffers := TRUE;
              IFEND;
              blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
              restart_data_transfer (current_request, data_transfer_status^.termination_mark,
                    blocks_to_add, status);
              IF NOT status.normal THEN
                terminate_transfer_request (status, data_transfer_status);
                release_request := TRUE;
              IFEND;
            IFEND;
          = rfc$ak_eor_block =
            IF (rfc$rm_eor >= data_transfer_status^.file_mark) OR
               (data_transfer_status^.data_exhausted) OR
               (NOT data_transfer_status^.previous_error.normal) THEN
              IF (data_transfer_status^.connection_entry_p^.residue_input_data = NIL) THEN
                data_transfer_status^.complete_message_received := TRUE;
                data_transfer_status^.file_mark_received := rfc$rm_eor;
              ELSE
                rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
                data_transfer_status^.connection_entry_p^.residue_input_data^.
                      record_mark_encountered := TRUE;
                data_transfer_status^.connection_entry_p^.residue_input_data^.
                      record_mark := rfc$rm_eor;
                rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
              IFEND;
              terminate_transfer_request (data_transfer_status^.previous_error,
                    data_transfer_status);
              release_request := TRUE;
            ELSE
              suspend_data_transfer (current_request, status);
              data_transfer_status^.termination_mark := data_transfer_status^.file_mark;
              IF NOT data_transfer_status^.network_wired_data THEN
                data_transfer_status^.switch_to_wired_buffers := TRUE;
              IFEND;
              blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
              restart_data_transfer (current_request, data_transfer_status^.termination_mark,
                    blocks_to_add, status);
              IF NOT status.normal THEN
                terminate_transfer_request (status, data_transfer_status);
                release_request := TRUE;
              IFEND;
            IFEND;
          = rfc$ak_message_block =
            IF data_transfer_status^.previous_error.normal THEN
              osp$set_status_abnormal (rfc$product_id, rfe$receive_mode_conflict,
                    'message mode', status);
              osp$append_status_parameter(osc$status_parameter_delimiter, 'record mode',
                    status);
              osp$append_status_parameter(osc$status_parameter_delimiter,
                    data_transfer_status^.connection_name, status);
              terminate_transfer_request (status, data_transfer_status);
            ELSE
              terminate_transfer_request (data_transfer_status^.previous_error,
                    data_transfer_status);
            IFEND;
            release_request := TRUE;
          ELSE
            osp$set_status_abnormal (rfc$product_id, rfe$invalid_alert_received,
                  data_transfer_status^.connection_name, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  $INTEGER(completion_state.alert_kind), 10, FALSE, status);
            terminate_transfer_request (status, data_transfer_status);
          CASEND;
        = rfc$message_mode =
          CASE completion_state.alert_kind OF
          = rfc$ak_record_block =
            IF data_transfer_status^.previous_error.normal THEN
              osp$set_status_abnormal (rfc$product_id, rfe$receive_mode_conflict,
                    'record mode', status);
              osp$append_status_parameter(osc$status_parameter_delimiter, 'message mode',
                    status);
              osp$append_status_parameter(osc$status_parameter_delimiter,
                    data_transfer_status^.connection_name, status);
              terminate_transfer_request (status, data_transfer_status);
            ELSE
              terminate_transfer_request (data_transfer_status^.previous_error,
                    data_transfer_status);
            IFEND;
            release_request := TRUE;
          = rfc$ak_end_of_message =
            IF (data_transfer_status^.connection_entry_p^.residue_input_data = NIL) THEN
              data_transfer_status^.complete_message_received := TRUE;
            ELSE
              rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
              data_transfer_status^.connection_entry_p^.residue_input_data^.
                    record_mark_encountered := TRUE;
              rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
            IFEND;
            terminate_transfer_request (data_transfer_status^.previous_error,
                  data_transfer_status);
            release_request := TRUE;
          ELSE
            osp$set_status_abnormal (rfc$product_id, rfe$invalid_alert_received,
                  '', status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  $INTEGER(completion_state.alert_kind), 10, FALSE, status);
            terminate_transfer_request (status, data_transfer_status);
          CASEND;

        CASEND;
      CASEND;
    CASEND;

  PROCEND rfp$continue_data_transfer;
?? TITLE := '    continue_data_transfer', EJECT ??
  PROCEDURE continue_data_transfer (
    VAR data_transfer_status: ^rft$data_transfer_status;
        blocks_to_add: rft$outstanding_blocks;
        current_request: ^rft$outstanding_requests;
    VAR unit_request_idle: boolean;
    VAR status: ost$status);

{
{     The purpose of this procedure is to continue the data transfer
{     that is in progress.
{
{     DATA_TRANSFER_STATUS: (input,output) This parameter specifies the
{       parameters of the data transfer operation.
{
{     BLOCKS_TO_ADD: (input) This parameter specifies the number of
{       network blocks to add to the pp unit request.
{
{     CURRENT_REQUEST: (input) This parameter specifies a pointer to
{       the PP request to be continued.
{
{     UNIT_REQUEST_IDLE: (input,output) This parameter specifies if the pp request
{       is active at this time.  A value of TRUE indicates that the
{       pp request is not active and no blocks are queued in the send or receive
{       data request.
{
{     STATUS: (output)  This parameter returns the status of the request.
{

    VAR
      blocks_to_queue,
      remaining_blocks: rft$outstanding_blocks,
      restart_request: boolean,
      unit_request: ^SEQ (*);



    status.normal := TRUE;
    PUSH unit_request: [[ rft$command_entry,
            { number of blocks }
          REP rfc$max_blocks_to_add OF rft$command_entry,
            { number of fragments associated with each block }
          REP (rfc$max_blocks_to_add * 4) OF rft$io_fragment]];
            { maximum of four fragments per block }
    blocks_to_queue := blocks_to_add;
    restart_request := unit_request_idle;

  /queue_blocks/
    REPEAT
      RESET unit_request;
      add_blocks_to_request (data_transfer_status, restart_request, blocks_to_queue,
            unit_request, status);
      IF (NOT status.normal) OR
         (blocks_to_queue = 0) THEN
        EXIT /queue_blocks/;
      IFEND;

      RESET unit_request;
      rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
      IF data_transfer_status^.connection_entry_p^.connection_attributes.
            connection_status.connection_state = rfc$connected THEN
        IF data_transfer_status^.outstanding_control_messages <> NIL THEN
          queue_control_messages (data_transfer_status^.connection_entry_p^.connection_descriptor.
                nad_index, data_transfer_status^.outstanding_control_messages);
        IFEND;
        rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
        CASE data_transfer_status^.transfer_kind OF
        = rfc$tk_send_data =
          rfp$continue_io_request( unit_request, current_request^.request_id,
                ioc$explicit_write, restart_request, status);
        = rfc$tk_receive_data =
          rfp$continue_io_request( unit_request, current_request^.request_id,
                ioc$explicit_read, restart_request, status);
        CASEND;
        IF status.normal THEN
          restart_request := FALSE;
          data_transfer_status^.total_blocks_queued := data_transfer_status^.total_blocks_queued +
                blocks_to_queue;
          data_transfer_status^.next_to_queue_abn := data_transfer_status^.current_abn;
          data_transfer_status^.next_to_queue_index := data_transfer_status^.current_fragment_index;
          data_transfer_status^.next_to_queue_offset := data_transfer_status^.current_fragment_offset;
          advise_out_in (data_transfer_status, status);
          IF status.normal THEN
            CASE data_transfer_status^.transfer_kind OF
            = rfc$tk_send_data =
              complete_sent_blocks (current_request^.request_id.ring_1_id.address,
                    data_transfer_status, remaining_blocks);
            = rfc$tk_receive_data =
              complete_received_blocks (current_request^.request_id.ring_1_id.address,
                    data_transfer_status, remaining_blocks, status);
            CASEND;
            blocks_to_queue := data_transfer_status^.maximum_outstanding_blocks - remaining_blocks;
          IFEND;
        IFEND;
      ELSE
        set_connection_status (data_transfer_status^.connection_entry_p, status);
        rfp$unlock_table(data_transfer_status^.connection_entry_p^.lock);
        delete_control_messages (data_transfer_status^.outstanding_control_messages);
      IFEND;
    UNTIL  (blocks_to_queue < 4)    { need to add at least 4 or not worth it }
       OR  (current_request^.request_id.ring_1_id.address^.response_posted)
       OR  (data_transfer_status^.data_exhausted)
       OR  (data_transfer_status^.switch_to_wired_buffers)
       OR  (NOT status.normal);  {  /queue_buffers/  }

    unit_request_idle := restart_request;

  PROCEND continue_data_transfer;
?? TITLE := '    delete_control_messages', EJECT ??
  PROCEDURE [INLINE] delete_control_messages (
    VAR control_message_pointer: ^rft$outgoing_control_message);

{
{     The purpose of this procedure is to release any unqueued control
{     messages when it is determined that for hardware reasons or
{     system task shutdown that they can not be sent.
{
{     CONTROL_MESSAGE_POINTER: (input,output) This parameter specifies
{       a pointer to a linked list of control messages that are to
{       be released. On return this parameter is set to NIL.
{


    VAR
      present_entry: ^rft$outgoing_control_message;


    WHILE control_message_pointer <> NIL DO
      present_entry := control_message_pointer;
      control_message_pointer := present_entry^.next_entry;
      FREE present_entry IN nav$network_paged_heap^;
    WHILEND;

  PROCEND delete_control_messages;
?? TITLE := '    rfp$delete_connection', EJECT ??
  PROCEDURE [XDCL] rfp$delete_connection (connection_file: fst$path_handle_name;
    VAR status: ost$status);

{
{     The purpose of this procedure is to terminate the specified connection.
{     Terminating a connection removes the connection from a job and releases
{     the path that has been established in the LCN network.  If the path is still
{     viable in the network this request issues a pp request to purge the
{     connection. This routine may be called at job termination to
{     delete connections that are still active.  During job termination, signals
{     and flags are disabled, so the pp response processor is called from
{     this routine to process the pp response to the purge path request.
{
{     CONNECTION_FILE: (input) This parameter specifies the file name to
{       delete from the $local catalog.
{
{     STATUS: (output) This parameter returns the result of the request.
{


?? NEWTITLE := '      terminate_delete_connect - condition handler', EJECT ??
    PROCEDURE terminate_delete_connect (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        mgmt_status: ^rft$connection_mgmt_status,
        current_request: ^rft$outstanding_requests,
        previous_request: ^rft$outstanding_requests;

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$delete_connection;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          current_request := rfv$outstanding_requests;
          previous_request := NIL;
        /complete_recovered_requests/
          WHILE current_request <> NIL DO
            IF current_request^.request_kind = rfc$rk_accept_connect_request THEN
              mgmt_status := current_request^.request_status;
              FREE mgmt_status^.activity_status IN osv$task_private_heap^;
              IF previous_request = NIL THEN
                rfv$outstanding_requests := current_request^.next_entry;
              ELSE
                previous_request^.next_entry := current_request^.next_entry;
              IFEND;
              FREE mgmt_status IN osv$task_private_heap^;
              FREE current_request IN osv$task_private_heap^;
              EXIT /complete_recovered_requests/;
            IFEND;
            previous_request := current_request;
            current_request := current_request^.next_entry;
          WHILEND /complete_recovered_requests/;
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$delete_connection;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_delete_connect;
?? OLDTITLE, EJECT ??


    VAR
      abnormal_termination: ^boolean,
      activity_status: ^ost$activity_status,
      back_processing_complete: boolean,
      command_identifier: ^rft$logical_commands,
      connection_entry_p: ^rft$connection_entry,
      connection_status: ^rft$connection_table_entry,
      connection_timeout: boolean,
      connection_timeout_time: integer,
      entry_to_delete: ^rft$outgoing_control_message,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_status: ost$status,
      locked: boolean,
      nad_index: rft$local_nads,
      path_id: ^rft$path_identifier,
      present_entry: ^rft$outgoing_control_message,
      previous_entry: ^rft$outgoing_control_message,
      purge_path: boolean,
      request_info: ^ SEQ( * ),
      start_time: integer,
      time: integer,
      unit_request_status: ^rft$connection_mgmt_status,
      wait_back_processing: boolean,
      xcb: ^ost$execution_control_block;


      osp$establish_condition_handler (^terminate_delete_connect, FALSE);
      status.normal := TRUE;
      back_processing_complete := FALSE;
      pmp$find_executing_task_xcb (xcb);
      pmp$get_microsecond_clock (start_time, local_status);

    /wait_termination_processing/
      REPEAT
        get_exclusive_to_job (connection_file, job_table_entry_p,
              connection_entry_p, status);
        IF NOT status.normal THEN
          EXIT rfp$delete_connection;
        IFEND;

        IF connection_entry_p^.connection_attributes.connection_status.connection_state =
              rfc$switch_offered THEN
          remove_switch_offer (job_table_entry_p^.job_name, connection_entry_p);
        IFEND;

        IF (connection_entry_p^.connection_attributes.connection_status.connection_state >=
              rfc$not_viable) OR
           (connection_entry_p^.connection_attributes.connection_status.connection_state =
              rfc$switch_accepted) THEN
          remove_connection_entry (connection_entry_p);
          job_table_entry_p^.lock := tmv$null_global_task_id;
          EXIT rfp$delete_connection;
        IFEND;

        purge_path := connection_entry_p^.connection_attributes.abnormal_termination;
        nad_index := connection_entry_p^.connection_descriptor.nad_index;
        rfp$test_set_table_lock (rfv$status_table.local_nads^[nad_index].
              outgoing_cm_queue.lock, locked);
        IF NOT locked THEN
          rfp$unlock_table (connection_entry_p^.lock);
          job_table_entry_p^.lock := tmv$null_global_task_id;
          syp$cycle;
          CYCLE /wait_termination_processing/;
        IFEND;

        pmp$get_microsecond_clock (time, local_status);
        connection_timeout := (time > (start_time + (connection_entry_p^.connection_attributes.
              connection_timeout * 1000)));

        connection_status := ^rfv$status_table.local_nads^[nad_index].
               connection_table^[connection_entry_p^.connection_descriptor.
               network_path];

        IF ((connection_status^.connection_state <> rfc$ps_established) OR
                (connection_status^.connection_clarifier <> rfc$pce_normal)) OR
           (xcb^.task_is_terminating) OR
           (pmc$sf_terminate_task IN xcb^.system_flags) OR
           (connection_timeout) THEN
          purge_path := TRUE;
        IFEND;

        present_entry := rfv$status_table.local_nads^[nad_index].
              outgoing_cm_queue.first_entry;
        IF purge_path THEN
          previous_entry := NIL;
          IF (present_entry <> NIL) AND
             (rfv$status_table.local_nads^[nad_index].processing_out_control_mess) THEN
            present_entry^.purge_on_retry := TRUE;
            previous_entry := present_entry;
            present_entry := present_entry^.next_entry;
          IFEND;
        /delete_queued_backs/
          WHILE present_entry <> NIL DO
            IF present_entry^.control_message.header.my_path_id =
                  connection_entry_p^.connection_descriptor.network_path THEN
              entry_to_delete := present_entry;
              present_entry := present_entry^.next_entry;
              IF previous_entry = NIL THEN
                rfv$status_table.local_nads^[nad_index].outgoing_cm_queue.first_entry :=
                  present_entry;
              ELSE
                previous_entry^.next_entry := present_entry;
              IFEND;
              FREE entry_to_delete IN nav$network_paged_heap^;
            ELSE
              previous_entry := present_entry;
              present_entry := present_entry^.next_entry;
            IFEND;
          WHILEND /delete_queued_backs/;
          rfp$unlock_table (rfv$status_table.local_nads^[nad_index].outgoing_cm_queue.lock);
          back_processing_complete := TRUE;
        ELSE
          wait_back_processing := FALSE;
        /locate_outstanding_backs/
          WHILE present_entry <> NIL DO
            IF present_entry^.control_message.header.my_path_id =
                  connection_entry_p^.connection_descriptor.network_path THEN
              wait_back_processing := TRUE;
              EXIT /locate_outstanding_backs/;
            IFEND;
            present_entry := present_entry^.next_entry;
          WHILEND /locate_outstanding_backs/;
          rfp$unlock_table (rfv$status_table.local_nads^[nad_index].outgoing_cm_queue.lock);
          IF NOT wait_back_processing THEN
            IF connection_entry_p^.connection_attributes.outgoing_message_count =
                  connection_entry_p^.connection_attributes.acks_received_count THEN
              back_processing_complete := TRUE;
              EXIT /wait_termination_processing/;
            IFEND;
          IFEND;
          rfp$unlock_table (connection_entry_p^.lock);
          job_table_entry_p^.lock := tmv$null_global_task_id;
          syp$cycle;
        IFEND;
      UNTIL back_processing_complete;  {wait_termination_processing}

    job_table_entry_p^.lock := tmv$null_global_task_id;
    /queue_disconnect_request/
      BEGIN
        PUSH request_info: [[rft$logical_commands,    {command identifier}
                             boolean,                 {abnormal termination}
                             rft$path_identifier]];   {path identifier}
        RESET request_info;
        NEXT command_identifier  IN  request_info;
        IF  command_identifier = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$delete_connection', status);
          EXIT  /queue_disconnect_request/;
        IFEND;
        command_identifier^ := rfc$lc_disconnect_paths;
        NEXT  abnormal_termination IN  request_info;
        IF  abnormal_termination = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$delete_connection', status);
          EXIT  /queue_disconnect_request/;
        IFEND;
        abnormal_termination^ := purge_path;
        NEXT  path_id IN  request_info;
        IF  path_id = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$delete_connection', status);
          EXIT  /queue_disconnect_request/;
        IFEND;
        path_id^ := connection_entry_p^.connection_descriptor.network_path;

        ALLOCATE unit_request_status IN osv$task_private_heap^;
        IF  unit_request_status = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                'task private', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$delete_connection', status);
          EXIT  /queue_disconnect_request/;
        IFEND;

{     The structure activity status is allocated in task private to insure
{     it is writeable by ring 3 code. Pointers to this variable are stored in
{     a task private segment and thus inherit ring 3 privileges.

        ALLOCATE activity_status IN osv$task_private_heap^;
        IF  activity_status = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                'task private', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$delete_connection', status);
          EXIT  /queue_disconnect_request/;
        IFEND;
        unit_request_status^.internal_use := FALSE;
        unit_request_status^.connection := connection_entry_p;
        unit_request_status^.activity_status := activity_status;
        activity_status^.complete := FALSE;
        activity_status^.status.normal := TRUE;
        connection_entry_p^.active_pp_requests := connection_entry_p^.active_pp_requests + 1;
        nad_index := connection_entry_p^.connection_descriptor.nad_index;
        rfp$unlock_table (connection_entry_p^.lock);
        rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_disconnect_path,
              unit_request_status, request_info, status);
        IF  NOT status.normal  THEN
          rfp$remove_connection(0, connection_entry_p);
          EXIT  rfp$delete_connection;
        IFEND;
        REPEAT
          #SPOIL (activity_status^);
          syp$cycle;
          rfp$process_pp_response_flag (rfc$pp_response_available);
        UNTIL activity_status^.complete;
        IF NOT activity_status^.status.normal THEN
          status := activity_status^.status;
        IFEND;
        FREE activity_status IN osv$task_private_heap^;
        RETURN;
      END /queue_disconnect_request/;
      rfp$unlock_table (connection_entry_p^.lock);

  PROCEND rfp$delete_connection;
?? TITLE := '    delink_connection_entry', EJECT ??
  PROCEDURE  delink_connection_entry (
        connection_entry_p: ^rft$connection_entry);

{
{     The purpose of this procedure is to delink the specified
{     connection entry data structure from the connection entry list.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies a pointer
{       to the connection entry to remove.


    VAR
      current_entry_p: ^rft$connection_entry,
      previous_entry_p: ^rft$connection_entry;


    previous_entry_p := NIL;
    current_entry_p := connection_entry_p^.application_entry_p^.connection_table;
    WHILE current_entry_p <> NIL DO
      IF current_entry_p^.connection_name =
            connection_entry_p^.connection_name THEN
        IF previous_entry_p = NIL THEN
          connection_entry_p^.application_entry_p^.connection_table :=
                current_entry_p^.next_entry;
        ELSE
          previous_entry_p^.next_entry := current_entry_p^.next_entry;
        IFEND;
        RETURN;
      IFEND;
      previous_entry_p := current_entry_p;
      current_entry_p := current_entry_p^.next_entry;
    WHILEND ;

  PROCEND delink_connection_entry;
?? TITLE := '    deliver_residue_data', EJECT ??
  PROCEDURE deliver_residue_data (data_transfer_status: ^rft$data_transfer_status;
    VAR residue_input_data: ^rft$residue_data;
    VAR transfer_complete: boolean;
    VAR status: ost$status);

{
{     The purpose of this routine is to deliver to the application any residue
{     data that was received during a previous receive data request, but could
{     not be delivered because of a buffer full condition.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters for
{       the data transfer request.
{
{     RESIDUE_INPUT_DATA: (input,output) This parameter specifies a pointer to
{       the residue data.  Upon exit, if all the data has been delivered, this
{       pointer is set to NIL.
{
{     TRANSFER_COMPLETE: (output) This parameter returns a value of TRUE if all
{       residue data is delivered and the residue data had a receive data
{       termination indicator.
{
{     STATUS: (output) This parameter returns the status of this request.



    VAR
      current_fragment: rft$data_fragment_count,
      current_offset: rft$data_length,
      residue_data: ^SEQ ( * ),
      delivered_data_buffer: ^cell,
      remaining_fragment_length: rft$data_fragment_count,
      saved_data_buffer: ^cell;


    status.normal := TRUE;
    transfer_complete := FALSE;

    current_offset := data_transfer_status^.next_to_queue_offset;
    current_fragment := data_transfer_status^.next_to_queue_index;
    NEXT residue_data: [[REP 0 OF CELL]] IN residue_input_data^.data_pointer;
  /deliver_data_to_application/
    WHILE residue_input_data^.remaining_data > 0 DO
      remaining_fragment_length := data_transfer_status^.data_area^[current_fragment].length -
            current_offset;
      delivered_data_buffer := i#ptr(current_offset,
            data_transfer_status^.data_area^[current_fragment].address);
      saved_data_buffer := residue_data;
      IF remaining_fragment_length > residue_input_data^.remaining_data THEN
        data_transfer_status^.bytes_transferred := data_transfer_status^.bytes_transferred +
              residue_input_data^.remaining_data;
        i#move (saved_data_buffer, delivered_data_buffer, residue_input_data^.remaining_data);
        current_offset := current_offset + residue_input_data^.remaining_data;
        residue_input_data^.remaining_data := 0;
      ELSE   {remainder of block either just fits in fragment or exceeds fragment length}
        data_transfer_status^.bytes_transferred := data_transfer_status^.bytes_transferred +
              remaining_fragment_length;
        i#move (saved_data_buffer, delivered_data_buffer, remaining_fragment_length);
        residue_input_data^.remaining_data := residue_input_data^.remaining_data -
              remaining_fragment_length;
        NEXT residue_data:
              [[REP remaining_fragment_length OF CELL]] IN residue_input_data^.data_pointer;
        IF current_fragment = UPPERBOUND(data_transfer_status^.data_area^) THEN
          transfer_complete := TRUE;
          EXIT /deliver_data_to_application/;
        IFEND;
        current_offset := 0;
        current_fragment := current_fragment + 1;
      IFEND;
    WHILEND /deliver_data_to_application/;

    IF (residue_input_data^.remaining_data = 0) THEN
      IF residue_input_data^.record_mark_encountered THEN
        data_transfer_status^.complete_message_received :=
              residue_input_data^.record_mark_encountered;
        IF data_transfer_status^.transmission_mode = rfc$record_mode THEN
          data_transfer_status^.file_mark_received :=
                residue_input_data^.record_mark;
        IFEND;
        transfer_complete := TRUE;
      IFEND;
      rfp$lock_table(data_transfer_status^.connection_entry_p^.lock);
      FREE data_transfer_status^.connection_entry_p^.residue_input_data IN nav$network_paged_heap^;
      rfp$unlock_table(data_transfer_status^.connection_entry_p^.lock);
    IFEND;

    data_transfer_status^.next_to_queue_offset := current_offset;
    data_transfer_status^.next_to_queue_index := current_fragment;

  PROCEND deliver_residue_data;
?? TITLE := '    determine_path_state', EJECT ??
  PROCEDURE determine_path_state (path_p: ^rft$lcn_path_definition;
    VAR path_enabled: boolean);

{
{     The purpose of this procedure is to determine if the specified path
{     is in a useable state.  It checks that the path is enabled, the NAD
{     is enabled and that the TCU's at both ends are ON.
{
{     PATH_P: (input) This parameter specifies a pointer to the path to
{       check.
{
{     PATH_ENABLED: (output) This parameter returns a value of TRUE if
{       the path is usable.



    VAR
      local_nad_tcu: integer,
      local_tcu_state: rft$element_state,
      local_trunk: rft$component_name,
      remote_nad_tcu: integer,
      remote_tcu_state: rft$element_state,
      remote_trunk: rft$component_name,
      temp_enabled: boolean;


    path_enabled := NOT path_p^.disabled;
    IF path_enabled THEN
      path_enabled := (rfv$status_table.local_nads^[path_p^.local_nad].
            current_status.device_status = rfc$es_on);
      IF path_enabled THEN
        CASE path_p^.loopback OF
        = TRUE =
          path_enabled := (rfv$status_table.local_nads^[path_p^.destination_nad].
                current_status.device_status = rfc$es_on);
          IF rfv$status_table.local_nads^[path_p^.destination_nad].address =
             rfv$status_table.local_nads^[path_p^.local_nad].address THEN
            RETURN
          IFEND;
        = FALSE =
          path_enabled := (rfv$status_table.remote_nads^[path_p^.remote_nad].
                current_status.device_status = rfc$es_on);
        CASEND;
        IF path_enabled THEN
          temp_enabled := FALSE;
          FOR local_nad_tcu := LOWERBOUND(path_p^.local_tcu_mask) TO
                UPPERBOUND(path_p^.local_tcu_mask) DO
            IF path_p^.local_tcu_mask[local_nad_tcu] THEN
              local_trunk := rfv$status_table.local_nads^[path_p^.local_nad].
                    trunk_control_units[local_nad_tcu];
              local_tcu_state := rfv$status_table.local_nads^[path_p^.local_nad].current_status.
                    tcu_status[local_nad_tcu];
              FOR remote_nad_tcu := LOWERBOUND(path_p^.remote_tcu_mask) TO
                    UPPERBOUND(path_p^.remote_tcu_mask) DO
                IF path_p^.remote_tcu_mask[remote_nad_tcu] THEN
                  CASE path_p^.loopback OF
                  = TRUE =
                    remote_trunk := rfv$status_table.local_nads^[path_p^.destination_nad].
                          trunk_control_units[remote_nad_tcu];
                    remote_tcu_state := rfv$status_table.local_nads^[path_p^.destination_nad].
                          current_status.tcu_status[remote_nad_tcu];
                  = FALSE =
                    remote_trunk := rfv$status_table.remote_nads^[path_p^.remote_nad].
                          trunk_control_units[remote_nad_tcu];
                    remote_tcu_state := rfv$status_table.remote_nads^[path_p^.remote_nad].
                          current_status.tcu_status[remote_nad_tcu];
                  CASEND;
                  IF remote_trunk = local_trunk THEN
                    IF (local_tcu_state = rfc$es_on) AND (remote_tcu_state = rfc$es_on) THEN
                      path_enabled := TRUE;
                      RETURN;
                    IFEND;
                  IFEND;
                IFEND;
              FOREND;
            IFEND;
          FOREND;
          path_enabled := temp_enabled;
        IFEND;
      IFEND;
    IFEND;

  PROCEND determine_path_state;
?? TITLE :='    enter_event_queue', EJECT ??
  PROCEDURE enter_event_queue(event: ^rft$rhfam_event_table_entry;
    VAR event_queue_entry_p: ^rft$rhfam_event_table_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to enter the event specified into the
{     RHFAM event queue.
{
{     EVENT: (input) This parameter specifies a pointer to the event that
{       is to be entered into the queue. The caller must initialize the
{       varient portion of this structure.
{
{     STATUS: (output) This parameter returns the result of the request. A status
{       of normal indicates that the event has been entered into the event
{       queue.


    VAR
      current_event: ^rft$rhfam_event_table_entry,
      duplicate: boolean,
      global_task_id: ost$global_task_id,
      previous_event: ^rft$rhfam_event_table_entry;


    previous_event := NIL;
    pmp$get_executing_task_gtid (global_task_id);
    rfp$lock_table (rfv$rhfam_event_table.lock);
    current_event := rfv$rhfam_event_table.first_entry;
    duplicate := FALSE;
    WHILE current_event <> NIL DO
      IF (current_event^.task_id = global_task_id) AND
         (current_event^.event_kind = event^.event_kind) THEN
        CASE event^.event_kind OF
        = rfc$ana_await_server_response =
          duplicate := (current_event^.asr_connection_descriptor =
                event^.asr_connection_descriptor);
        = rfc$ana_await_incoming_connect =
          duplicate := ((current_event^.aic_job_name = event^.aic_job_name) AND
                       (current_event^.aic_server_name = event^.aic_server_name));
        = rfc$ana_await_connection_event =
          IF NOT current_event^.ace_data_transfer_in_progress THEN
            duplicate := ((current_event^.ace_connection_descriptor =
                event^.ace_connection_descriptor) AND (current_event^.ace_input_available =
                event^.ace_input_available) AND (current_event^.ace_output_buffer_available =
                event^.ace_output_buffer_available));
          IFEND;
        = rfc$ana_await_switch_offer =
          duplicate := (current_event^.aso_application_name = event^.aso_application_name);
        = rfc$ana_await_switch_accept =
          duplicate := (current_event^.asa_source_job = event^.asa_source_job);
        CASEND;
        IF duplicate THEN
          current_event^.event_occurred_type := rfc$eot_no_event;
          rfp$unlock_table (rfv$rhfam_event_table.lock);
          event_queue_entry_p := current_event;
          RETURN;
        IFEND;
      IFEND;
      previous_event := current_event;
      current_event := current_event^.next_entry;
    WHILEND;
    ALLOCATE event_queue_entry_p IN nav$network_paged_heap^;
    IF event_queue_entry_p = NIL THEN
      rfp$unlock_table (rfv$rhfam_event_table.lock);
      osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
            'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'enter_event_queue', status);
      EXIT enter_event_queue;
    IFEND;

    event_queue_entry_p^ := event^;
    event_queue_entry_p^.next_entry := NIL;
    event_queue_entry_p^.task_id := global_task_id;
    event_queue_entry_p^.event_occurred_type := rfc$eot_no_event;

    IF previous_event = NIL THEN
      rfv$rhfam_event_table.first_entry := event_queue_entry_p;
    ELSE
      previous_event^.next_entry := event_queue_entry_p;
    IFEND;
    rfp$unlock_table (rfv$rhfam_event_table.lock);

  PROCEND enter_event_queue;
?? TITLE := '    enter_switched_connect_queue', EJECT ??
  PROCEDURE enter_switched_connect_queue (
        destination_job: jmt$system_supplied_name;
    VAR connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to enter a connection into
{     the switched connection queue.  This connection may then be
{     accepted by the destination job.
{
{     DESTINATION_JOB: (input) This parameter specifies the name of the
{       job to offer the connection to.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies a pointer
{       to the connection table entry of the connection that is being
{       offered for switch.
{
{     STATUS: (output) This parameter returns the status of the
{       switch offer. A status of normal indicates that the connection
{       has been sucessfully offered.


    VAR
      new_connection_entry_p: ^rft$connection_entry,
      next_entry: ^rft$switched_connection,
      next_connection_entry_p: ^rft$connection_entry,
      present_entry: ^rft$switched_connection,
      switched_connection: ^rft$switched_connection,
      user_supplied_name: jmt$user_supplied_name;


    rfp$lock_table (rfv$switched_connection_queue.lock);
    present_entry := NIL;
    next_entry := rfv$switched_connection_queue.first_entry;
    WHILE next_entry <> NIL DO
      present_entry := next_entry;
      next_entry := present_entry^.next_entry;
    WHILEND;

    ALLOCATE switched_connection IN nav$network_paged_heap^;
    IF switched_connection <> NIL THEN
      switched_connection^.next_entry := NIL;
      IF present_entry = NIL THEN
        rfv$switched_connection_queue.first_entry := switched_connection;
      ELSE
        present_entry^.next_entry := switched_connection;
      IFEND;
    ELSE
      rfp$unlock_table (rfv$switched_connection_queue.lock);
      osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
            'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'enter_switched_connect_queue', status);
      EXIT enter_switched_connect_queue;
    IFEND;

{     Initialize switched connection entry.

    switched_connection^.destination_job := destination_job;
    pmp$get_job_names (user_supplied_name, switched_connection^.source_job, status);
    switched_connection^.connection_entry_p := connection_entry_p;
    switched_connection^.destination_application :=
          connection_entry_p^.application_entry_p^.application_name;
    switched_connection^.source_application_kind := connection_entry_p^.
          application_entry_p^.application_kind;
    link_new_connection_entry (connection_entry_p^.application_entry_p,
          new_connection_entry_p, status);
    IF NOT status.normal THEN
      rfp$unlock_table (rfv$switched_connection_queue.lock);
      EXIT enter_switched_connect_queue;
    IFEND;
    switched_connection^.connection_entry_source_job := new_connection_entry_p;

{     A pointer to all connection entries is maintained in the status table.
{     To avoid having to update this pointer the process used to switch the
{     connection is to allocate a new entry to use as a placeholder at the
{     source job.  The active connection entry is then pointed to by the
{     switched connection queue until the receiving job picks it up.

    delink_connection_entry (connection_entry_p);

{     Copy connection entry contents to placeholder.

    next_connection_entry_p := new_connection_entry_p^.next_entry;
    new_connection_entry_p^ := connection_entry_p^;

{     Unlock connection entry. Placeholder connection entry inherited
{     the lock and will be cleared later by the calling routine.
{     Replace next_entry pointer that was destroyed because of copy.
{     The inline procedure osp$clear_job_signature_lock is used to
{     unlock the connection entry to prevent the subsystem activity count
{     from being decremented.

    osp$clear_job_signature_lock (connection_entry_p^.lock);
    new_connection_entry_p^.next_entry := next_connection_entry_p;

{     Change pointer to point to new connection entry.

    connection_entry_p := new_connection_entry_p;

{     Set source job connection entry state to switched.

    connection_entry_p^.
          connection_attributes.connection_status.connection_state :=
          rfc$switch_offered;
    connection_entry_p^.
          connection_attributes.connection_status.destination_job :=
          destination_job;
    rfp$unlock_table (rfv$switched_connection_queue.lock);

  PROCEND enter_switched_connect_queue;
?? TITLE :='    enter_waiting_task_queue', EJECT ??
  PROCEDURE enter_waiting_task_queue(connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{     The purpose of this procedure is to enter the running task into a list of
{     tasks to be restarted when a data transfer request is complete.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies the connection entry
{       pointer to the connection entry that the task wishes to wait on.
{
{     STATUS: (output) This parameter returns the result of the request. A status
{       of normal indicates that the task has been entered into the wait queue.


    VAR
      current_waiting_task: ^rft$waiting_task_queue,
      global_task_id: ost$global_task_id,
      local_status: ost$status,
      new_task: ^rft$waiting_task_queue,
      previous_waiting_task: ^rft$waiting_task_queue,
      task_id: pmt$task_id;


    previous_waiting_task := NIL;
    current_waiting_task := connection_entry_p^.waiting_tasks;
    pmp$get_executing_task_gtid (global_task_id);
    WHILE current_waiting_task <> NIL DO
      IF connection_entry_p^.waiting_tasks^.global_task_id =
            global_task_id THEN
        EXIT enter_waiting_task_queue;
      IFEND;
      previous_waiting_task := current_waiting_task;
      current_waiting_task := current_waiting_task^.next_entry;
    WHILEND;
    ALLOCATE new_task IN nav$network_paged_heap^;
    IF new_task = NIL THEN
      osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
            'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'enter_waiting_task_queue', status);
      EXIT enter_waiting_task_queue;
    IFEND;
    new_task^.global_task_id := global_task_id;
    new_task^.next_entry := NIL;
    IF previous_waiting_task = NIL THEN
      connection_entry_p^.waiting_tasks := new_task;
    ELSE
      previous_waiting_task^.next_entry := new_task;
    IFEND;


  PROCEND enter_waiting_task_queue;
?? TITLE := '    rfp$fetch', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$fetch (
        connection_identifier: amt$file_identifier;
    VAR file_attributes: rft$get_attributes;
    VAR status: ost$status);

*copyc rfh$fetch

?? NEWTITLE := '      terminate_fetch - condition handler', EJECT ??
    PROCEDURE terminate_fetch (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        IF connection_entry_p <> NIL THEN
          rfp$unlock_table (connection_entry_p^.lock);
        IFEND;
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$fetch;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$fetch;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_fetch;
?? OLDTITLE, EJECT ??


    VAR
      connection_entry_p: ^rft$connection_entry;


    connection_entry_p := NIL;
    osp$establish_condition_handler (^terminate_fetch, FALSE);
    status.normal := TRUE;

    get_exclusive_to_cid (connection_identifier, connection_entry_p, status);
    IF NOT status.normal THEN
      EXIT rfp$fetch;
    IFEND;
    fetch_get_attributes (^connection_entry_p^.connection_attributes,
          ^file_attributes, status);
    rfp$unlock_table (connection_entry_p^.lock);

  PROCEND rfp$fetch;
?? TITLE := '    fetch_get_attributes', EJECT ??
  PROCEDURE fetch_get_attributes (
        connection_attributes: ^rft$connection_attributes;
        attributes: ^rft$get_attributes;
    VAR status: ost$status);

{
{     The purpose of this procedure is to fetch the specified attributes
{     of the connection.
{
{     CONNECTION_ATTRIBUTES: (input,output) This parameter specifies a
{       pointer to the current connection attributes.
{
{     ATTRIBUTES: (input,output) This parameter specifies a pointer to the
{       attribute keys to return.
{
{     STATUS: (output) This parameter returns the result of the request.



    VAR
      attribute_index : integer;

    status.normal := TRUE;
    IF attributes <> NIL THEN
      FOR attribute_index := LOWERBOUND (attributes^) TO UPPERBOUND (attributes^) DO
        CASE attributes^ [attribute_index].key OF
        = rfc$client_name =
          attributes^[attribute_index].client_name :=
                connection_attributes^.client_name;
        = rfc$server_name =
          attributes^[attribute_index].server_name :=
                 connection_attributes^.server_name;
        = rfc$client_host =
          attributes^[attribute_index].client_host :=
                 connection_attributes^.client_host;
        = rfc$server_host =
          attributes^[attribute_index].server_host :=
                 connection_attributes^.server_host;
        = rfc$destination_host =
          attributes^[attribute_index].destination_host :=
                 connection_attributes^.destination_host;
        = rfc$connection_timeout =
          attributes^[attribute_index].connection_timeout :=
                 connection_attributes^.connection_timeout;
        = rfc$data_transfer_timeout =
          attributes^[attribute_index].data_transfer_timeout :=
                 connection_attributes^.data_transfer_timeout;
        = rfc$record_block_size =
          attributes^[attribute_index].record_block_size :=
                 connection_attributes^.record_block_size;
        = rfc$message_block_size =
          attributes^[attribute_index].message_block_size :=
                 connection_attributes^.message_block_size;
        = rfc$incoming_record_abn =
          attributes^[attribute_index].incoming_record_abn :=
                 connection_attributes^.incoming_record_abn;
        = rfc$outgoing_record_abn =
          attributes^[attribute_index].outgoing_record_abn :=
                 connection_attributes^.outgoing_record_abn;
        = rfc$receive_record_terminator =
          attributes^[attribute_index].receive_record_terminator :=
                 connection_attributes^.receive_record_terminator;
        = rfc$file_mark_received =
          attributes^[attribute_index].file_mark_received :=
                 connection_attributes^.file_mark_received;
        = rfc$send_record_terminator =
          attributes^[attribute_index].send_record_terminator :=
                 connection_attributes^.send_record_terminator;
        = rfc$connection_status =
          attributes^[attribute_index].connection_status :=
                 connection_attributes^.connection_status;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$invalid_attribute_key,
                'get file attributes', status);
        CASEND;
      FOREND;
    IFEND;
  PROCEND fetch_get_attributes;
?? TITLE := '    find_application_entry', EJECT ??
  PROCEDURE find_application_entry (application_name: rft$application_name;
        job_table_entry_p: ^rft$rhfam_job_table_entry;
    VAR application_entry_p: ^rft$application_table_entry);

{
{     The purpose of this procedure is to locate the specified
{     applications's application table entry and return a pointer to
{     the entry.
{
{     APPLICATION_NAME: (input) This parameter specifies the application to
{       locate.
{
{     JOB_TABLE_ENTRY_P: (input) This parameter specifies the pointer to
{       to the job table entry.
{
{     APPLICATION_ENTRY_P: (output) This parameter returns a pointer to
{       the application table entry that was found. A NIL pointer indicates
{       no application entry was found.
{



    application_entry_p := job_table_entry_p^.application_entry;
    WHILE application_entry_p <> NIL DO
      IF application_entry_p^.application_name = application_name THEN
        RETURN;
      IFEND;
      application_entry_p := application_entry_p^.next_entry;
    WHILEND;

  PROCEND find_application_entry;
?? TITLE := '    rfp$find_connection_entry', EJECT ??
  PROCEDURE rfp$find_connection_entry (connection_file: fst$path_handle_name;
        job_table_entry_p: ^rft$rhfam_job_table_entry;
    VAR connection_entry_p: ^rft$connection_entry);

{
{     The purpose of this procedure is to locate the specified
{     connection table entry and return a pointer to
{     the entry.
{
{     CONNECTION_FILE: (input) This parameter specifies the connection to
{       locate.
{
{     JOB_TABLE_ENTRY_P: (input) This parameter specifies the pointer to
{       to the job table entry.
{
{     CONNECTION_ENTRY_P: (output) This parameter specifies a pointer to
{       the connection table entry specified by connection name.
{       A NIL pointer indicates no connection entry was found.
{



    VAR
      application_entry_p: ^rft$application_table_entry;


    connection_entry_p := NIL;
    application_entry_p := job_table_entry_p^.application_entry;
    WHILE application_entry_p <> NIL DO
      connection_entry_p := application_entry_p^.connection_table;
      WHILE connection_entry_p <> NIL DO
        IF connection_entry_p^.connection_name =
              connection_file THEN
          RETURN;
        IFEND;
        connection_entry_p := connection_entry_p^.next_entry;
      WHILEND;
      application_entry_p := application_entry_p^.next_entry;
    WHILEND;

  PROCEND rfp$find_connection_entry;
?? TITLE := '    find_server_entry', EJECT ??
  PROCEDURE [INLINE] find_server_entry (server_name: rft$application_name;
        require_active: boolean;
    VAR server_entry_p: ^rft$rhfam_server_table_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to locate the specified
{     server table entry and return a pointer to the entry.
{
{     SERVER_NAME: (input) This parameter specifies the server to
{       locate.
{
{     REQUIRE_ACTIVE: (input); This parameter specifies if the server
{       definition must be active to match.
{
{     SERVER_ENTRY_P: (input) This parameter specifies the pointer to
{       to the specified server table entry. A NIL pointer indicates no
{       server table entry was found.
{
{     STATUS: (output) This parameter returns the results of the request.
{       A status of normal means the server was found.
{



    status.normal := TRUE;
    server_entry_p := rfv$rhfam_server_table.first_entry;
    WHILE server_entry_p <> NIL DO
      IF (server_entry_p^.server_name = server_name) THEN
        IF require_active THEN
          IF server_entry_p^.server_active THEN
            RETURN;
          ELSE
            osp$set_status_abnormal (rfc$product_id, rfe$appl_not_active,
                  server_name, status);
            EXIT find_server_entry;
          IFEND;
        ELSE
          RETURN;
        IFEND;
      IFEND;
      server_entry_p := server_entry_p^.next_entry;
    WHILEND;

    osp$set_status_abnormal (rfc$product_id, rfe$appl_not_defined,
          server_name, status);

  PROCEND find_server_entry;
?? TITLE := '    rfp$get_attributes', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$get_attributes (
        connection_file: fst$file_reference;
    VAR file_attributes: rft$get_attributes;
    VAR status: ost$status);

*copyc rfh$get_attributes


?? NEWTITLE := '      terminate_get_attributes - condition handler', EJECT ??
    PROCEDURE terminate_get_attributes (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        IF connection_entry_p <> NIL THEN
          rfp$unlock_table (connection_entry_p^.lock);
        IFEND;
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$get_attributes;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$get_attributes;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_get_attributes;
?? OLDTITLE, EJECT ??


    VAR
      connection_entry_p: ^rft$connection_entry,
      path_handle_name: fst$path_handle_name;


    connection_entry_p := NIL;
    osp$establish_condition_handler (^terminate_get_attributes, FALSE);
    status.normal := TRUE;

    get_path_handle_name (connection_file, path_handle_name, status);
    IF NOT status.normal THEN
      EXIT rfp$get_attributes;
    IFEND;
    get_exclusive_to_connection (path_handle_name, connection_entry_p, status);
    IF NOT status.normal THEN
      EXIT rfp$get_attributes;
    IFEND;
    fetch_get_attributes (^connection_entry_p^.connection_attributes,
          ^file_attributes, status);
    rfp$unlock_table (connection_entry_p^.lock);

  PROCEND rfp$get_attributes;
?? TITLE := '    get_exclusive_to_connection', EJECT ??
  PROCEDURE get_exclusive_to_connection(connection_file: fst$path_handle_name;
    VAR connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to acquire exclusive access to a connection
{     entry.  Exclusive access to a connection entry means getting the connection
{     entry lock with no active pp requests, no send data request and no receive
{     data request on the specifed connection file.  The connection entry is
{     locked upon successful completion of this request, and must be unlocked
{     by the calling routine.
{
{     CONNECTION_FILE: (input) This parameter specifies the connection to
{       acquire access to.
{
{     CONNECTION_ENTRY_P: (output) This parameter returns the pointer to the
{       connection table entry.
{
{     STATUS: (output) This parameter returns the completion status of the
{       request.  A status of normal indicates that the connection was found
{       and the job table was successfully locked.  An abnormal status
{       indicates that the job table was not locked.


    VAR
      active_request: boolean,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_status: ost$status,
      new_entry: boolean;


    status.normal := TRUE;

    /get_exclusive_access/
    REPEAT
      rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
      IF job_table_entry_p = NIL  THEN
        connection_entry_p := NIL;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_not_active,
              connection_file, status);
        EXIT get_exclusive_to_connection;
      IFEND;
      rfp$find_connection_entry (connection_file, job_table_entry_p, connection_entry_p);
      IF connection_entry_p = NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id, rfe$connection_not_active,
              connection_file, status);
        EXIT get_exclusive_to_connection;
      IFEND;
      rfp$lock_table (connection_entry_p^.lock);
      job_table_entry_p^.lock := tmv$null_global_task_id;
      active_request:= false;
      IF connection_entry_p^.active_pp_requests <> 0 THEN
        rfp$unlock_table (connection_entry_p^.lock);
        active_request := TRUE;
        syp$cycle;
      ELSEIF (connection_entry_p^.receive_request_active) OR
         (connection_entry_p^.send_request_active) THEN
        active_request := TRUE;
        enter_waiting_task_queue(connection_entry_p, local_status);
        rfp$unlock_table (connection_entry_p^.lock);
        connection_entry_p := NIL;
        job_table_entry_p := NIL;
        pmp$wait(10000, 10000);
      IFEND;
    UNTIL NOT active_request;

  PROCEND get_exclusive_to_connection;
?? TITLE :='    get_exclusive_to_cid', EJECT ??
  PROCEDURE get_exclusive_to_cid (connection_identifier: amt$file_identifier;
    VAR connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);


{     The purpose of this procedure is to acquire exclusive access to a connection
{     entry.  Exclusive access to a connection entry means getting the
{     connection entry lock with no active pp requests.  The connection entry
{     is locked upon successful completion of this request, and must be
{     unlocked by the calling routine. This routine does not check for
{     active send or receive requests.
{
{     CONNECTION_IDENTIFIER: (input) This parameter specifies the connection
{       identifier of the connection file to acquire access to.
{
{     CONNECTION_ENTRY_P: (output) This parameter returns a pointer to
{       the connection entry of the specified connection.
{
{     STATUS: (output) This parameter returns the status of the request.
{       A value of normal indicates that the connection has been locked.
{



    VAR
      active_pp_requests: boolean,
      file_instance_p: ^bat$task_file_entry,
      file_is_valid: boolean,
      job_table_entry_p : ^rft$rhfam_job_table_entry,
      new_entry: boolean;


    status.normal := TRUE;

    REPEAT
      job_table_entry_p := NIL;
      connection_entry_p := NIL;
      bap$validate_file_identifier (connection_identifier, file_instance_p,
            file_is_valid);
      IF NOT file_is_valid THEN
        osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, '',
              status);
        EXIT get_exclusive_to_cid;
      IFEND;
      IF file_instance_p^.device_class <> rmc$rhfam_device THEN
        osp$set_status_abnormal (rfc$product_id, rfe$file_device_class_not_rhf,
              ' ', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              file_instance_p^.local_file_name, status);
        EXIT get_exclusive_to_cid;
      IFEND;
      rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
      IF job_table_entry_p = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$connection_not_active,
              file_instance_p^.local_file_name, status);
        EXIT get_exclusive_to_cid;
      IFEND;
      rfp$find_connection_entry (file_instance_p^.local_file_name,
            job_table_entry_p, connection_entry_p);
      IF connection_entry_p = NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id, rfe$connection_not_active,
              file_instance_p^.local_file_name, status);
        EXIT get_exclusive_to_cid;
      IFEND;
      rfp$lock_table (connection_entry_p^.lock);
      job_table_entry_p^.lock := tmv$null_global_task_id;
      active_pp_requests := (connection_entry_p^.active_pp_requests <> 0);
      IF active_pp_requests THEN
        rfp$unlock_table (connection_entry_p^.lock);
        syp$cycle;
      IFEND;
    UNTIL NOT active_pp_requests;

  PROCEND get_exclusive_to_cid;
?? TITLE := '    get_exclusive_to_job', EJECT ??
  PROCEDURE get_exclusive_to_job(connection_file: fst$path_handle_name;
    VAR job_table_entry_p: ^rft$rhfam_job_table_entry;
    VAR connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to acquire exclusive access to a connection
{     entry.  Exclusive access to a connection entry means getting the job table
{     entry lock with no active pp requests, no send data request and no receive
{     data request on the specifed connection file.  The job table entry and the
{     connection entry are locked upon successful completion of
{     this request, and both must be unlocked  by the calling routine.
{
{     CONNECTION_FILE: (input) This parameter specifies the connection to
{       acquire access to.
{
{     JOB_TABLE_ENTRY_P: (output) This parameter returns the pointer to the
{       locked job table entry.
{
{     CONNECTION_ENTRY_P: (output) This parameter returns the pointer to the
{       connection table entry.
{
{     STATUS: (output) This parameter returns the completion status of the
{       request.  A status of normal indicates that the connection was found
{       and the job table was successfully locked.  An abnormal status
{       indicates that the job table was not locked.


    VAR
      active_request: boolean,
      local_status: ost$status,
      new_entry: boolean;


    status.normal := TRUE;
    /get_exclusive_access/
    REPEAT
      rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
      IF job_table_entry_p = NIL  THEN
        connection_entry_p := NIL;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_not_active,
              connection_file, status);
        EXIT get_exclusive_to_job;
      IFEND;
      rfp$find_connection_entry (connection_file, job_table_entry_p, connection_entry_p);
      IF connection_entry_p = NIL THEN
        job_table_entry_p^.lock := tmv$null_global_task_id;
        osp$set_status_abnormal (rfc$product_id, rfe$connection_not_active,
              connection_file, status);
        EXIT get_exclusive_to_job;
      IFEND;
      rfp$lock_table (connection_entry_p^.lock);
      active_request:= false;
      IF connection_entry_p^.active_pp_requests <> 0 THEN
        rfp$unlock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        active_request := TRUE;
        syp$cycle;
      ELSEIF (connection_entry_p^.receive_request_active) OR
         (connection_entry_p^.send_request_active) THEN
        active_request := TRUE;
        enter_waiting_task_queue(connection_entry_p, local_status);
        rfp$unlock_table (connection_entry_p^.lock);
        job_table_entry_p^.lock := tmv$null_global_task_id;
        connection_entry_p := NIL;
        job_table_entry_p := NIL;
        pmp$wait(10000, 10000);
      IFEND;
    UNTIL NOT active_request;

  PROCEND get_exclusive_to_job;
?? TITLE := '    get_incoming_connect', EJECT ??
  PROCEDURE get_incoming_connect (server_name: rft$application_name;
    VAR incoming_connect: rft$incoming_connect;
    VAR incoming_connect_available: boolean;
    VAR access_method_accept: boolean;
    VAR status: ost$status);

{
{     The purpose of this procedure is to obtain from the rhfam server
{     table an incoming connect that has been assigned to the specified
{     server by the rhfam system task. If an incoming connect is found
{     it is returned to the caller and the incoming connect buffer is
{     released from the network paged section.
{
{     SERVER_NAME: (input) This parameter specifies the server to get
{       an incoming connect for.
{
{     INCOMING_CONNECT: (OUTPUT) This parameter returns the incoming
{       connect that has been received.
{
{     INCOMING_CONNECT_AVAILABLE: (output) This parameter returns a
{       TRUE value if an incoming connect has been found for the specified
{       server. A value of FALSE indicates that no connect is available.
{
{     ACCESS_METHOD_ACCEPT: (output) This parameter returns the access
{       method accept attribute of this server.  A value of TRUE indicates
{       that the system task has accepted the connection request on
{       behalf of the server.  A value of FALSE indicates that the server
{       must accept or reject the connection.
{


  VAR
    active_incoming_connects: boolean,
    incoming_connect_p: ^rft$incoming_connect,
    server_entry_p: ^rft$rhfam_server_table_entry;


    incoming_connect_available := false;

  /wait_for_active_incoming/
    REPEAT
      rfp$lock_table (rfv$rhfam_server_table.lock);
      find_server_entry(server_name, FALSE, server_entry_p, status);
      IF NOT status.normal THEN
        rfp$unlock_table (rfv$rhfam_server_table.lock);
        EXIT get_incoming_connect;
      IFEND;
      active_incoming_connects :=
            (server_entry_p^.active_incoming_connects <> 0);
      IF active_incoming_connects THEN
        rfp$unlock_table (rfv$rhfam_server_table.lock);
        syp$cycle;
      IFEND;
    UNTIL NOT active_incoming_connects;

    IF server_entry_p^.incoming_connect <> NIL THEN
      incoming_connect_p := server_entry_p^.incoming_connect;
      incoming_connect := incoming_connect_p^;
      incoming_connect_available := TRUE;
      server_entry_p^.incoming_connect := incoming_connect_p^.next_entry;
      access_method_accept := server_entry_p^.access_method_accept;
      FREE incoming_connect_p IN nav$network_paged_heap^;
    IFEND;
    rfp$unlock_table (rfv$rhfam_server_table.lock);

  PROCEND get_incoming_connect;
?? TITLE := '    rfp$get_local_host_physical_id', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$get_local_host_physical_id (
    VAR physical_identifier: rft$physical_identifier;
    VAR status: ost$status);

*copyc rfh$get_local_host_physical_id

?? NEWTITLE := '      terminate_get_local_host - condition handler', EJECT ??
    PROCEDURE terminate_get_local_host (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$get_local_host_physical_id;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$get_local_host_physical_id;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_get_local_host;
?? OLDTITLE, EJECT ??


    VAR
      local_physical_id : rft$physical_identifier;

    status.normal := TRUE;
    osp$establish_condition_handler (^terminate_get_local_host, FALSE);
    rfp$lock_table (rfv$status_table.lock);
    IF rfv$status_table.system_task_is_up THEN
      local_physical_id := rfv$status_table.local_host^.physical_identifier;
    ELSE
      osp$set_status_abnormal (rfc$product_id,
            rfe$system_task_not_active, 'rfp$find_available_service', status);
    IFEND;
    rfp$unlock_table (rfv$status_table.lock);

    IF status.normal THEN
      physical_identifier := local_physical_id;
    IFEND;

  PROCEND rfp$get_local_host_physical_id;
?? TITLE := '    get_path_status', EJECT ??
  PROCEDURE get_path_status (
        connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to build and queue a request
{     to get the specified paths present status.  The connection entry
{     must be locked upon entry to this procedure and will be unlocked
{     upon return.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies the pointer
{       to the connection table entry to get the status for.
{
{     STATUS: (output) This parameter returns the result of the request.
{

    VAR
      activity_status: ^ost$activity_status,
      command_identifier: ^rft$logical_commands,
      nad_index: rft$local_nads,
      path_id: ^rft$path_identifier,
      request_info: ^ SEQ( * ),
      unit_request_status: ^rft$connection_mgmt_status;


      status.normal := TRUE;

    /queue_path_status_request/
      BEGIN
        ALLOCATE unit_request_status IN osv$task_private_heap^;
        IF  unit_request_status = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                'task private', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'get_path_status', status);
          EXIT  /queue_path_status_request/;
        IFEND;
        unit_request_status^.internal_use := FALSE;
        unit_request_status^.connection := connection_entry_p;

{     The structure activity status is allocated in task private to insure
{     it is writeable by ring 3 code. Pointers to this variable are stored in
{     a task private segment and thus inherit ring 3 privileges.

        ALLOCATE activity_status IN osv$task_private_heap^;
        IF  activity_status = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                'task private', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'get_path_status', status);
          EXIT  /queue_path_status_request/;
        IFEND;
        unit_request_status^.activity_status := activity_status;

        activity_status^.complete := FALSE;
        activity_status^.status.normal := TRUE;

        PUSH request_info: [[rft$logical_commands,       {command_identifier}
              rft$path_identifier]];                     {path identifier}

        RESET request_info;
        NEXT command_identifier  IN  request_info;
        IF  command_identifier = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'get_path_status', status);
          EXIT  /queue_path_status_request/;
        IFEND;
        command_identifier^ := rfc$lc_read_path_status_table;
        NEXT  path_id IN  request_info;
        IF  path_id = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'get_path_status', status);
          EXIT  /queue_path_status_request/;
        IFEND;
        path_id^ := connection_entry_p^.connection_descriptor.network_path;
        nad_index := connection_entry_p^.connection_descriptor.nad_index;
        unit_request_status^.connection^.active_pp_requests :=
              unit_request_status^.connection^.active_pp_requests + 1;
        rfp$unlock_table (connection_entry_p^.lock);
        rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_path_status,
              unit_request_status, request_info, status);
        IF status.normal THEN
          REPEAT
            #SPOIL (activity_status^);
            pmp$wait (rfc$unit_request_wait_time, rfc$ur_expected_wait);
            rfp$process_pp_response_flag (rfc$pp_response_available);
          UNTIL activity_status^.complete;
          IF NOT activity_status^.status.normal THEN
            status := activity_status^.status;
          IFEND;
          FREE activity_status IN osv$task_private_heap^;
          EXIT get_path_status;
        ELSE
          rfp$lock_table (connection_entry_p^.lock);
          unit_request_status^.connection^.active_pp_requests :=
                unit_request_status^.connection^.active_pp_requests - 1;
          FREE unit_request_status IN osv$task_private_heap^;
        IFEND;
      END /queue_path_status_request/;
      rfp$unlock_table (connection_entry_p^.lock);

  PROCEND get_path_status;
?? TITLE := '    get_switched_connection', EJECT ??
  PROCEDURE   get_switched_connection (application_name: rft$application_name;
    VAR switched_connection: ^rft$switched_connection);

{
{     The purpose of this procedure is to locate an entry in the switched
{     connection queue, delink the entry from the queue and return a pointer
{     to the found entry.  It is the responsibility of the calling routine
{     to deallocate the entry when finished with it.
{
{     APPLICATION_NAME: (input) This parameter specifies the name of the
{       application that is asking for a switched connection.
{
{     SWITCHED_CONNECTION: (output) This parameter returns a pointer to
{       the switched connection that was found.  A value of NIL indicates
{       that no switched connection was found.



    VAR
      ignore_status: ost$status,
      previous_entry: ^rft$switched_connection,
      system_supplied_name: jmt$system_supplied_name,
      user_supplied_name: jmt$user_supplied_name;


    rfp$lock_table (rfv$switched_connection_queue.lock);
    previous_entry := NIL;
    switched_connection := rfv$switched_connection_queue.first_entry;
    pmp$get_job_names (user_supplied_name, system_supplied_name, ignore_status);
  /find_switched_connection/
    WHILE switched_connection <> NIL DO
      IF (application_name = switched_connection^.destination_application) AND
         (system_supplied_name = switched_connection^.destination_job) THEN
        EXIT /find_switched_connection/;
      IFEND;
      previous_entry := switched_connection;
      switched_connection := switched_connection^.next_entry;
    WHILEND /find_switched_connection/;

    IF switched_connection <> NIL THEN
      switched_connection^.connection_entry_source_job^.connection_attributes.
            connection_status.connection_state := rfc$switch_accepted;
      IF previous_entry = NIL THEN
        rfv$switched_connection_queue.first_entry := switched_connection^.next_entry;
      ELSE
        previous_entry^.next_entry := switched_connection^.next_entry;
      IFEND;
    IFEND;
    rfp$unlock_table (rfv$switched_connection_queue.lock);

  PROCEND get_switched_connection;
?? TITLE := '    rfp$job_termination', EJECT ??
  PROCEDURE [XDCL] rfp$job_termination;

{
{     The purpose of this procedure is remove any tables that RHFAM
{     has associated with this job. It assumes that no connections
{     are associated with the job.  The connections are previously
{     terminated by the local name table manager when the local files
{     are returned.
{

    VAR
      application_entry_p: ^rft$application_table_entry,
      client_definition_p: ^rft$rhfam_client_table_entry,
      ignore_status: ost$status,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      next_application_entry_p: ^rft$application_table_entry,
      new_entry: boolean;


  /main_section/
    BEGIN
    rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
    IF job_table_entry_p <> NIL THEN
      application_entry_p := job_table_entry_p^.application_entry;
      WHILE application_entry_p <> NIL DO
        next_application_entry_p := application_entry_p^.next_entry;
        CASE application_entry_p^.application_kind OF
        = rfc$client =
          rfp$lock_table (rfv$rhfam_client_table.lock);
          rfp$find_client_entry (application_entry_p^.application_name, FALSE,
                client_definition_p, ignore_status);
          IF ignore_status.normal THEN
            client_definition_p^.connections_reserved := client_definition_p^.
                  connections_reserved - application_entry_p^.maximum_allowed_connections;
          IFEND;
          rfp$unlock_table (rfv$rhfam_client_table.lock);
        = rfc$server =
          sign_off_server (application_entry_p^.application_name, job_table_entry_p^.job_name,
                application_entry_p^.maximum_allowed_connections, ignore_status);
        = rfc$partner =
          ;
        CASEND;
        FREE application_entry_p IN nav$network_paged_heap^;
        application_entry_p := next_application_entry_p;
      WHILEND;
      remove_job_table_entry(job_table_entry_p);
    IFEND;
    END /main_section/;

  PROCEND rfp$job_termination;
?? TITLE := '    link_new_connection_entry', EJECT ??
  PROCEDURE link_new_connection_entry (application_entry_p: ^rft$application_table_entry;
    VAR connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to allocate and link a
{     connection entry data structure into the connection list for
{     an application. This routine increments the connection count
{     in the application entry and initializes the connection entry
{     linkage.
{
{     APPLICATION_ENTRY_P: (input) This parameter specifies a pointer
{       to the application entry for which a connection table entry
{       is to be allocated.
{
{     CONNECTION_ENTRY_P: (output) This parameter returns a pointer
{       to the connection table entry that has been allocated. A NIL
{       pointer indicates that table allocation failed.
{
{     STATUS: (output) This parameter returns the status of the
{       allocation.  A status of normal indicates that the table
{       allocation succeeded.



    ALLOCATE connection_entry_p IN nav$network_paged_heap^;
    IF connection_entry_p <> NIL THEN
      pmp$zero_out_table (connection_entry_p, #SIZE(rft$connection_entry));
      connection_entry_p^.application_entry_p := application_entry_p;
      IF application_entry_p^.connection_table = NIL THEN
        application_entry_p^.connection_table := connection_entry_p;
        connection_entry_p^.next_entry := NIL;
      ELSE
        connection_entry_p^.next_entry := application_entry_p^.connection_table;
        application_entry_p^.connection_table := connection_entry_p;
      IFEND;
    ELSE
      osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
            'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter,
            'link_new_connection_entry', status);
      EXIT link_new_connection_entry;
    IFEND;

  PROCEND link_new_connection_entry;
?? TITLE := '    rfp$lock_job_table_entry', EJECT ??
  PROCEDURE [XDCL] rfp$lock_job_table_entry (create_new_entry: BOOLEAN;
    VAR new_entry_created: BOOLEAN;
    VAR job_table_entry_p:^rft$rhfam_job_table_entry);

{
{     The purpose of this procedure is to set the entry lock on a RHFAM
{     job table entry.  This procedure first obtains the global table lock
{     and if the entry lock is not set, the entry lock is set and the
{     pointer to the table entry is returned.  If the entry lock is set
{     the global lock is released, a delay is performed and the entry lock
{     is again attempted.
{
{     CREATE_NEW_ENTRY: (input) This parameter states whether or not a new job
{       table is to be created if an existing entry is not found.
{
{     NEW_ENTRY_CREATED: (output) This parameter states whether or not a new
{       job table entry has been created.  This parameter is only meaningful if the
{       create_new_entry parameter is TRUE.
{
{     JOB_TABLE_ENTRY_P: (output) This parameter specifies the pointer to
{       the locked job table entry. A NIL value indicates that no job table
{       entry was found.
{


    VAR
      global_task_id: ost$global_task_id,
      local_status: ost$status,
      system_supplied_name: jmt$system_supplied_name,
      user_supplied_name: jmt$user_supplied_name;


    job_table_entry_p := NIL;
    new_entry_created := FALSE;
    pmp$get_executing_task_gtid (global_task_id);

    rfp$lock_table (rfv$rhfam_job_table.lock);
    IF rfv$job_entry_pointer <> NIL THEN
    /lock_entry/
      WHILE rfv$job_entry_pointer <> NIL DO
        IF rfv$job_entry_pointer^.lock = tmv$null_global_task_id THEN
          job_table_entry_p := rfv$job_entry_pointer;
          job_table_entry_p^.lock := global_task_id;
          EXIT /lock_entry/;
        ELSE
          rfp$unlock_table (rfv$rhfam_job_table.lock);
          syp$cycle;
          rfp$lock_table (rfv$rhfam_job_table.lock);
          CYCLE /lock_entry/;
        IFEND;
      WHILEND /lock_entry/;

    ELSE
      IF  create_new_entry  THEN

        ALLOCATE rfv$job_entry_pointer IN nav$network_paged_heap^;

        pmp$get_job_names (user_supplied_name, system_supplied_name, local_status);
        job_table_entry_p := rfv$job_entry_pointer;
        job_table_entry_p^.lock := global_task_id;
        job_table_entry_p^.job_name := system_supplied_name;
        job_table_entry_p^.next_entry := NIL;
        job_table_entry_p^.application_entry := NIL;

{     Add new entry to end of rhfam job table.

        IF rfv$rhfam_job_table.first_entry = NIL THEN
          rfv$rhfam_job_table.first_entry := job_table_entry_p;
          rfv$rhfam_job_table.last_entry := job_table_entry_p;
        ELSE
          rfv$rhfam_job_table.last_entry^.next_entry := job_table_entry_p;
          rfv$rhfam_job_table.last_entry := job_table_entry_p;
        IFEND;
        new_entry_created := TRUE;
      IFEND;
    IFEND;

    rfp$unlock_table (rfv$rhfam_job_table.lock);

  PROCEND rfp$lock_job_table_entry;
?? TITLE := '    rfp$lock_table', EJECT ??
  PROCEDURE [XDCL] rfp$lock_table (VAR lock: ost$signature_lock);

{
{     The purpose of this procedure is to obtain the global lock on a
{     RHFAM ring 3 table.  This procedure increments the system table lock
{     count to prevent unnecessary swapping.
{
{     LOCK: (input,output)  This parameter specifies the signature lock to
{       obtain.
{


    osp$begin_subsystem_activity;
    osp$set_job_signature_lock(lock);

  PROCEND rfp$lock_table;
?? TITLE := '    merge_change_attributes', EJECT ??
  PROCEDURE merge_change_attributes (
        connection_attributes: ^rft$connection_attributes;
        attributes: ^rft$change_attributes;
    VAR status: ost$status);

{     The purpose of this procedure is to merge the specified attributes
{     with the current connection attributes.
{
{     CONNECTION_ATTRIBUTES: (input,output) This parameter specifies a
{       pointer to the current connection attributes.
{
{     ATTRIBUTES: (input) This parameter specifies a pointer to the
{       attributes to merge with the connection attributes.
{
{     STATUS: (output) This parameter returns the result of the attribute
{       merge.
{



    VAR
      attribute_index: integer,
      invalid_attribute_value: boolean;

    status.normal := TRUE;
    invalid_attribute_value := FALSE;
    IF attributes <> NIL THEN
      FOR attribute_index := LOWERBOUND (attributes^) TO UPPERBOUND (attributes^) DO
        CASE attributes^ [attribute_index].key OF
        = rfc$connection_timeout =
          IF (attributes^[attribute_index].connection_timeout >=
                    LOWERVALUE(rft$connection_timeout)) AND
             (attributes^[attribute_index].connection_timeout <=
                    UPPERVALUE(rft$connection_timeout)) THEN
            connection_attributes^.connection_timeout :=
                  attributes^[attribute_index].connection_timeout;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$data_transfer_timeout =
          IF (attributes^[attribute_index].data_transfer_timeout >=
                    LOWERVALUE(rft$transfer_timeout)) AND
             (attributes^[attribute_index].data_transfer_timeout <=
                    UPPERVALUE(rft$transfer_timeout)) THEN
            connection_attributes^.data_transfer_timeout :=
                  attributes^ [attribute_index].data_transfer_timeout;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$record_block_size =
          IF (attributes^[attribute_index].record_block_size >=
                    LOWERVALUE(rft$block_size)) AND
             (attributes^[attribute_index].record_block_size <=
                    UPPERVALUE(rft$block_size)) THEN
            IF attributes^ [attribute_index].record_block_size <> 0 THEN
              connection_attributes^.record_block_size :=
                    attributes^ [attribute_index].record_block_size;
            ELSE
              connection_attributes^.record_block_size :=
                    rfc$max_block_size;
            IFEND;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$message_block_size =
          IF (attributes^[attribute_index].message_block_size >=
                    LOWERVALUE(rft$block_size)) AND
             (attributes^[attribute_index].message_block_size <=
                    UPPERVALUE(rft$block_size)) THEN
            IF attributes^[attribute_index].message_block_size <> 0 THEN
              connection_attributes^.message_block_size :=
                    attributes^ [attribute_index].message_block_size;
            ELSE
              connection_attributes^.message_block_size :=
                    rfc$max_block_size;
            IFEND;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$incoming_record_abn =
          IF (attributes^[attribute_index].incoming_record_abn >=
                    LOWERVALUE(rft$application_block_number)) AND
             (attributes^[attribute_index].incoming_record_abn <=
                    UPPERVALUE(rft$application_block_number)) THEN
            connection_attributes^.incoming_record_abn :=
                  attributes^ [attribute_index].incoming_record_abn;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$outgoing_record_abn =
          IF (attributes^[attribute_index].outgoing_record_abn >=
                    LOWERVALUE(rft$application_block_number)) AND
             (attributes^[attribute_index].outgoing_record_abn <=
                    UPPERVALUE(rft$application_block_number)) THEN
            connection_attributes^.outgoing_record_abn :=
                  attributes^ [attribute_index].outgoing_record_abn;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$receive_record_terminator =
          IF (attributes^[attribute_index].receive_record_terminator >=
                    LOWERVALUE(rft$record_marks)) AND
             (attributes^[attribute_index].receive_record_terminator <=
                    UPPERVALUE(rft$record_marks)) THEN
            connection_attributes^.receive_record_terminator :=
                  attributes^[attribute_index].receive_record_terminator;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$send_record_terminator =
          IF (attributes^[attribute_index].send_record_terminator >=
                    LOWERVALUE(rft$record_marks)) AND
             (attributes^[attribute_index].send_record_terminator <=
                    UPPERVALUE(rft$record_marks)) THEN
            connection_attributes^.send_record_terminator :=
                  attributes^ [attribute_index].send_record_terminator;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$invalid_attribute_key,
                'change file attributes', status);
        CASEND;
      FOREND;
    IFEND;
    IF (status.normal) AND
       (invalid_attribute_value) THEN
      osp$set_status_abnormal (rfc$product_id, rfe$invalid_attribute_value,
            'change file attributes', status);
    IFEND;

  PROCEND merge_change_attributes;
?? TITLE := '    merge_creation_attributes', EJECT ??
  PROCEDURE merge_creation_attributes (
        connection_attributes: ^rft$connection_attributes;
        attributes: ^rft$create_attributes;
    VAR status: ost$status);

{     The purpose of this procedure is to merge the specified attributes
{     with the current connection attributes.
{
{     CONNECTION_ATTRIBUTES: (input,output) This parameter specifies a
{       pointer to the current connection attributes.
{
{     ATTRIBUTES: (input) This parameter specifies a pointer to the
{       attributes to merge with the connection attributes.
{
{     STATUS: (output) This parameter returns the result of the attribute
{       merge.
{



    VAR
      attribute_index: integer,
      invalid_attribute_value: boolean;


    status.normal := TRUE;
    invalid_attribute_value := FALSE;
    IF attributes <> NIL THEN
      FOR attribute_index := LOWERBOUND (attributes^) TO UPPERBOUND (attributes^) DO
        CASE attributes^ [attribute_index].key OF
        = rfc$connection_timeout =
          IF (attributes^[attribute_index].connection_timeout >=
                    LOWERVALUE(rft$connection_timeout)) AND
             (attributes^[attribute_index].connection_timeout <=
                    UPPERVALUE(rft$connection_timeout)) THEN
            connection_attributes^.connection_timeout :=
                  attributes^[attribute_index].connection_timeout;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$data_transfer_timeout =
          IF (attributes^[attribute_index].data_transfer_timeout >=
                    LOWERVALUE(rft$transfer_timeout)) AND
             (attributes^[attribute_index].data_transfer_timeout <=
                    UPPERVALUE(rft$transfer_timeout)) THEN
            connection_attributes^.data_transfer_timeout :=
                  attributes^ [attribute_index].data_transfer_timeout;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$record_block_size =
          IF (attributes^[attribute_index].record_block_size >=
                    LOWERVALUE(rft$block_size)) AND
             (attributes^[attribute_index].record_block_size <=
                    UPPERVALUE(rft$block_size)) THEN
            IF attributes^ [attribute_index].record_block_size <> 0 THEN
              connection_attributes^.record_block_size :=
                    attributes^ [attribute_index].record_block_size;
            ELSE
              connection_attributes^.record_block_size :=
                    rfc$max_block_size;
            IFEND;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$message_block_size =
          IF (attributes^[attribute_index].message_block_size >=
                    LOWERVALUE(rft$block_size)) AND
             (attributes^[attribute_index].message_block_size <=
                    UPPERVALUE(rft$block_size)) THEN
            IF attributes^[attribute_index].message_block_size <> 0 THEN
              connection_attributes^.message_block_size :=
                    attributes^ [attribute_index].message_block_size;
            ELSE
              connection_attributes^.message_block_size :=
                    rfc$max_block_size;
            IFEND;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$incoming_record_abn =
          IF (attributes^[attribute_index].incoming_record_abn >=
                    LOWERVALUE(rft$application_block_number)) AND
             (attributes^[attribute_index].incoming_record_abn <=
                    UPPERVALUE(rft$application_block_number)) THEN
            connection_attributes^.incoming_record_abn :=
                  attributes^ [attribute_index].incoming_record_abn;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$outgoing_record_abn =
          IF (attributes^[attribute_index].outgoing_record_abn >=
                    LOWERVALUE(rft$application_block_number)) AND
             (attributes^[attribute_index].outgoing_record_abn <=
                    UPPERVALUE(rft$application_block_number)) THEN
            connection_attributes^.outgoing_record_abn :=
                  attributes^ [attribute_index].outgoing_record_abn;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$receive_record_terminator =
          IF (attributes^[attribute_index].receive_record_terminator >=
                    LOWERVALUE(rft$record_marks)) AND
             (attributes^[attribute_index].receive_record_terminator <=
                    UPPERVALUE(rft$record_marks)) THEN
            connection_attributes^.receive_record_terminator :=
                  attributes^[attribute_index].receive_record_terminator;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        = rfc$send_record_terminator =
          IF (attributes^[attribute_index].send_record_terminator >=
                    LOWERVALUE(rft$record_marks)) AND
             (attributes^[attribute_index].send_record_terminator <=
                    UPPERVALUE(rft$record_marks)) THEN
            connection_attributes^.send_record_terminator :=
                  attributes^ [attribute_index].send_record_terminator;
          ELSE
            invalid_attribute_value := TRUE;
          IFEND;
        ELSE
          osp$set_status_abnormal (rfc$product_id, rfe$invalid_attribute_key,
                'creation file attributes', status);
        CASEND;
      FOREND;
    IFEND;
    IF (status.normal) AND
       (invalid_attribute_value) THEN
      osp$set_status_abnormal (rfc$product_id, rfe$invalid_attribute_value,
            'creation file attributes', status);
    IFEND;

  PROCEND merge_creation_attributes;
?? TITLE := '    rfp$open_file', EJECT ??
  PROCEDURE  [XDCL] rfp$open_file (file_identifier: amt$file_identifier;
        layer: amt$fap_layer_number;
        call_block: amt$call_block;
    VAR status: ost$status);

{     The purpose of this procedure is to perform the open processing
{     required on a connection file. It is called by the RHFAM network
{     FAP during open processing.
{
{     FILE_IDENTIFIER: (input) This parameter specifies the file identifier
{       of the connection file that is being opened.
{
{     LAYER: (input) This parameter specifies the fap layer number that
{       this routine is being called from.
{
{     CALL_BLOCK: (input) This parameter specifies the file manager call
{       block that the RHFAM network fap was called with.
{
{     STATUS: (output) This parameter returns the status of the request.
{


?? NEWTITLE := '      terminate_open_file - condition handler', EJECT ??
    PROCEDURE terminate_open_file (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        block_exit_expected := TRUE;
        EXIT rfp$open_file;
      = pmc$block_exit_processing =
        IF block_exit_expected THEN
          condition_status.normal := TRUE;
        ELSE
          osp$set_status_from_condition (rfc$product_id, condition, sfsa,
                condition_status, status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          block_exit_expected := TRUE;
          EXIT rfp$open_file;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_open_file;
?? OLDTITLE, EJECT ??


    VAR
      block_exit_expected: boolean,
      connection_entry_p: ^rft$connection_entry,
      connect_in_progress: boolean,
      connection_unlocked: boolean,
      input_available: boolean;



    block_exit_expected := FALSE;
    osp$establish_condition_handler (^terminate_open_file, TRUE);

{     During the connection process, an application may be able
{     to get to this code before the system task has time to
{     update the path status table with the correct path state.
{     If this occurs, update_connection_status will unlock the
{     connection and retrieve the path status.  In this case the
{     status returned will be normal but the connection will be
{     unlocked. This loop waits for the status table to be updated
{     with the proper status.

    /wait_for_path_status_to_sync/
    REPEAT
      get_exclusive_to_connection (call_block.open.local_file_name,
            connection_entry_p, status);
      IF status.normal THEN
        connect_in_progress := (rfc$outgoing_connect_active = connection_entry_p^.connection_attributes.
              connection_status.connection_state);
        update_connection_status(connection_entry_p, input_available,
              connection_unlocked, status);
        IF connection_unlocked THEN
          IF status.normal THEN
            IF NOT connect_in_progress THEN
              syp$cycle;
            ELSE
              get_exclusive_to_connection (call_block.open.local_file_name,
                    connection_entry_p, status);
              IF NOT status.normal THEN
                osp$disestablish_cond_handler;
                EXIT rfp$open_file;
              IFEND;
            IFEND;
          ELSE
            osp$disestablish_cond_handler;
            EXIT rfp$open_file;
          IFEND;
        IFEND;
      ELSE
        osp$disestablish_cond_handler;
        EXIT rfp$open_file;
      IFEND;
    UNTIL (NOT connection_unlocked) OR connect_in_progress;

    IF (connection_entry_p^.connection_attributes.connection_status.connection_state =
          rfc$connected) OR
       ((connection_entry_p^.connection_attributes.connection_status.connection_state =
          rfc$terminated) AND input_available) THEN
      connection_entry_p^.open_count := connection_entry_p^.open_count + 1;
    ELSE
      set_connection_status (connection_entry_p, status);
    IFEND;
    rfp$unlock_table (connection_entry_p^.lock);
    osp$disestablish_cond_handler;

  PROCEND rfp$open_file;
?? TITLE := '    queue_control_messages', EJECT ??
  PROCEDURE  queue_control_messages (
        nad_index: rft$local_nads;
    VAR control_messages: ^rft$outgoing_control_message);

{
{     The purpose of this routine is to add a list of control
{     messages to the local NAD outstanding control message queue.
{
{     NAD_INDEX: (input) This parameter specifies the local
{       nad index to queue the list of control messages to.
{
{     CONTROL_MESSAES: (input,output) This parameter specifies
{       a pointer to a list of control messages to add to the local
{       NAD outstanding control message queue.



    VAR
      ignore_status: ost$status,
      next_entry: ^rft$outgoing_control_message,
      present_entry: ^rft$outgoing_control_message,
      ready_system_task: boolean;


    present_entry := NIL;
    ready_system_task := FALSE;
    rfp$lock_table(rfv$status_table.local_nads^[nad_index].
          outgoing_cm_queue.lock);
    next_entry := rfv$status_table.local_nads^[nad_index].outgoing_cm_queue.first_entry;
    WHILE next_entry <> NIL DO
      present_entry := next_entry;
      next_entry := present_entry^.next_entry;
    WHILEND;

    IF present_entry = NIL THEN
      rfv$status_table.local_nads^[nad_index].outgoing_cm_queue.first_entry :=
            control_messages;
    ELSE
      present_entry^.next_entry := control_messages;
    IFEND;

    IF NOT rfv$status_table.local_nads^[nad_index].processing_out_control_mess THEN
      ready_system_task := TRUE;
    IFEND;
    rfp$unlock_table(rfv$status_table.local_nads^[nad_index].
          outgoing_cm_queue.lock);
    control_messages := NIL;

    IF ready_system_task THEN
      pmp$ready_task(rfv$system_task_id, ignore_status);
    IFEND;

  PROCEND queue_control_messages;
?? TITLE := '    rfp$recover_task_activity', EJECT ??
  PROCEDURE [XDCL] rfp$recover_task_activity (VAR status: ost$status);

{
{     The purpose of this routine is to terminate any asynchronous send
{     or receive data requests that were in progress when a deadstart recovery
{     occurred.  Only the asynchronous requests are terminated.  The remaining
{     requests are handled by condition handlers in the appropriate routines.
{
{     STATUS: (output) This parameter returns the result of the request.
{

?? NEWTITLE := '      terminate_recovery - condition handler', EJECT ??
    PROCEDURE terminate_recovery (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$recover_task_activity;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_recovery;
?? OLDTITLE, EJECT ??

    VAR
      current_request: ^rft$outstanding_requests,
      previous_request: ^rft$outstanding_requests,
      request_to_free: ^rft$outstanding_requests,
      transfer_status: ^rft$data_transfer_status;


    osp$establish_condition_handler (^terminate_recovery, FALSE);
    status.normal := TRUE;
    current_request := rfv$outstanding_requests;
    previous_request := NIL;
    request_to_free := NIL;

  /complete_recovered_requests/
    WHILE current_request <> NIL DO
      CASE current_request^.request_kind OF
      = rfc$rk_send_data, rfc$rk_receive_data =
        transfer_status := current_request^.request_status;
        IF transfer_status^.wait = osc$nowait THEN
          osp$set_status_abnormal (rfc$product_id, rfe$system_interrupt, '',
                transfer_status^.activity_status^.status);
          transfer_status^.activity_status^.complete := TRUE;
          IF previous_request = NIL THEN
            rfv$outstanding_requests := current_request^.next_entry;
          ELSE
            previous_request^.next_entry := current_request^.next_entry;
          IFEND;
          FREE transfer_status IN osv$task_private_heap^;
          request_to_free := current_request;
        IFEND;
      ELSE
          ;
      CASEND;
      previous_request := current_request;
      current_request := current_request^.next_entry;
      IF request_to_free <> NIL THEN
        FREE request_to_free IN osv$task_private_heap^;
      IFEND;
    WHILEND /complete_recovered_requests/;

  PROCEND rfp$recover_task_activity;
?? TITLE := '    remove_data_transfer_event', EJECT ??
  PROCEDURE remove_data_transfer_event (VAR event: ^rft$rhfam_event_table_entry);

{
{     The purpose of this routine is to remove a resource limit wait event
{     from the rhfam event queue.
{
{     EVENT: (input,output) This parameter specifies a pointer to the resource
{       limit event that is to be removed from the event queue.  Upon return,
{       this pointer is set to NIL.



    VAR
      current_entry_p: ^rft$rhfam_event_table_entry,
      previous_entry_p: ^rft$rhfam_event_table_entry;



    previous_entry_p := NIL;
    rfp$lock_table(rfv$rhfam_event_table.lock);
    current_entry_p := rfv$rhfam_event_table.first_entry;
  /remove_event/
    WHILE current_entry_p <> NIL DO
      IF #offset(current_entry_p) = #offset(event) THEN
        IF previous_entry_p = NIL THEN
          rfv$rhfam_event_table.first_entry := current_entry_p^.next_entry;
        ELSE
          previous_entry_p^.next_entry := current_entry_p^.next_entry;
        IFEND;
        FREE event IN nav$network_paged_heap^;
        EXIT /remove_event/;
      IFEND;
      previous_entry_p := current_entry_p;
      current_entry_p := current_entry_p^.next_entry;
    WHILEND /remove_event/;
    rfp$unlock_table(rfv$rhfam_event_table.lock);

  PROCEND remove_data_transfer_event;
?? TITLE := '    rfp$remove_connection', EJECT ??
  PROCEDURE [XDCL] rfp$remove_connection (
         response_seq_number: integer;
     VAR connection_entry_p: ^rft$connection_entry);

{     The purpose of this procedure is to remove the connection entry from
{     this jobs connection table. This procedure is called as the result of
{     a disconnect lcn path request. If the application that this connection
{     is assigned to is of type server or partner, the number of current
{     connections assigned to this server is decremented.
{
{     RESPONSE_SEQ_NUMBER: (input) This paramter specifies the sequence
{       number of the disconnect response that is being processed.
{
{     CONNECTION_ENTRY_P: (input,output) This parameter specifies the
{       connection to remove.  On completion, this parameter is
{       set to NIL;


    VAR
      application_kind: rft$application_kinds,
      application_name: rft$application_name,
      client_entry_p: ^rft$rhfam_client_table_entry,
      connection_status: rft$connection_status,
      job_table_entry_p: ^rft$rhfam_job_table_entry,
      local_status: ost$status,
      new_entry: boolean,
      server_entry_p: ^rft$rhfam_server_table_entry;


    rfp$lock_job_table_entry (FALSE, new_entry, job_table_entry_p);
    rfp$lock_table (connection_entry_p^.lock);
    application_kind := connection_entry_p^.application_entry_p^.application_kind;
    application_name := connection_entry_p^.application_entry_p^.application_name;

    remove_connection_entry_p (response_seq_number, connection_entry_p);
    connection_status := connection_entry_p^.connection_attributes.connection_status;

    remove_connection_entry (connection_entry_p);
    job_table_entry_p^.lock := tmv$null_global_task_id;

    IF connection_status.connection_state < rfc$not_viable THEN
      CASE application_kind OF
      = rfc$server =
        rfp$lock_table (rfv$rhfam_server_table.lock);
        find_server_entry (application_name, FALSE, server_entry_p, local_status);
        IF local_status.normal THEN
          server_entry_p^.current_connections := server_entry_p^.current_connections - 1;
        IFEND;
        rfp$unlock_table (rfv$rhfam_server_table.lock);
      = rfc$client =
        rfp$lock_table (rfv$rhfam_client_table.lock);
        rfp$find_client_entry (application_name, FALSE, client_entry_p, local_status);
        IF local_status.normal THEN
          client_entry_p^.current_connections := client_entry_p^.current_connections - 1;
        IFEND;
        rfp$unlock_table (rfv$rhfam_client_table.lock);
      = rfc$partner =
        rfp$lock_table (rfv$rhfam_server_table.lock);
        find_server_entry (application_name, FALSE, server_entry_p, local_status);
        IF local_status.normal THEN
          server_entry_p^.current_connections := server_entry_p^.current_connections - 1;
          server_entry_p^.partner_job_connections := server_entry_p^.partner_job_connections - 1;
          rfp$unlock_table (rfv$rhfam_server_table.lock);
        ELSE
          rfp$unlock_table (rfv$rhfam_server_table.lock);
          rfp$lock_table (rfv$rhfam_client_table.lock);
          rfp$find_client_entry (application_name, FALSE, client_entry_p, local_status);
          IF local_status.normal THEN
            client_entry_p^.current_connections := client_entry_p^.current_connections - 1;
          IFEND;
          rfp$unlock_table (rfv$rhfam_client_table.lock);
        IFEND;
      ELSE
        ;
      CASEND;
    IFEND;

  PROCEND rfp$remove_connection;
?? TITLE := '    remove_connection_entry', EJECT ??
  PROCEDURE  remove_connection_entry (
    VAR connection_entry_p: ^rft$connection_entry);

{     The purpose of this procedure is to delink and free the specified
{     connection entry data structure.
{
{     CONNECTION_ENTRY_P: (input,output) This parameter specifies a pointer
{       to the connection entry to remove.  This parameter is set to NIL
{       upon return.


    VAR
      current_entry_p: ^rft$connection_entry,
      previous_entry_p: ^rft$connection_entry;


    previous_entry_p := NIL;
    current_entry_p := connection_entry_p^.application_entry_p^.connection_table;
    WHILE current_entry_p <> NIL DO
      IF current_entry_p^.connection_name =
            connection_entry_p^.connection_name THEN
        IF previous_entry_p = NIL THEN
          connection_entry_p^.application_entry_p^.connection_table :=
                current_entry_p^.next_entry;
        ELSE
          previous_entry_p^.next_entry := current_entry_p^.next_entry;
        IFEND;
        connection_entry_p^.application_entry_p^.number_of_active_connections :=
              connection_entry_p^.application_entry_p^.number_of_active_connections - 1;
        IF connection_entry_p^.residue_input_data <> NIL THEN
          FREE connection_entry_p^.residue_input_data IN nav$network_paged_heap^;
        IFEND;
        IF connection_entry_p^.waiting_tasks <> NIL THEN
          wakeup_waiting_tasks (connection_entry_p);
        IFEND;

{     The old connection entry is unlocked which also decrements the subsystem
{     activity count.

        rfp$unlock_table (connection_entry_p^.lock);
        FREE connection_entry_p IN nav$network_paged_heap^;
        RETURN;
      IFEND;
      previous_entry_p := current_entry_p;
      current_entry_p := current_entry_p^.next_entry;
    WHILEND ;

  PROCEND remove_connection_entry;
?? TITLE := '    remove_connection_entry_p', EJECT ??
  PROCEDURE remove_connection_entry_p (
        response_seq_number: integer;
        connection_entry_p: ^rft$connection_entry);

{
{     The purpose of this procedure is to remove the connection entry pointer
{     from the local nad table. If the connection state is rfc$not_viable or
{     greater, then the number of active connections and the connection
{     entry pointer have been removed from the status table connection entry
{     by the system task.
{
{     RESPONSE_SEQ_NUMBER: (input) This paramter specifies the sequence
{       number of the disconnect response that is being processed.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies a pointer to the
{       connection entry that is to be removed.
{


    VAR
      locked: boolean,
      locks_set: boolean,
      nad_index: rft$local_nads;

    nad_index := connection_entry_p^.connection_descriptor.nad_index;
    locks_set := FALSE;
  /lock_tables/
    REPEAT
      IF connection_entry_p^.connection_attributes.connection_status.connection_state <
            rfc$not_viable THEN
        rfp$test_set_table_lock (rfv$status_table.local_nads^[nad_index].
              connection_table_lock, locked);
        IF NOT locked THEN
          rfp$unlock_table (connection_entry_p^.lock);
          syp$cycle;
          rfp$lock_table (connection_entry_p^.lock);
        ELSE
          locks_set := TRUE;
        IFEND;
      ELSE
        EXIT remove_connection_entry_p;
      IFEND;
    UNTIL locks_set;

    rfv$status_table.local_nads^[nad_index].connections_established :=
          rfv$status_table.local_nads^[nad_index].connections_established - 1;
    rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
          connection_descriptor.network_path].connection_table_entry := NIL;
    rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
          connection_descriptor.network_path].processing_incoming_connect := FALSE;
    IF response_seq_number >
          rfv$status_table.local_nads^[nad_index].last_status_seq_number THEN
      rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
             connection_descriptor.network_path].connection_state := rfc$ps_unused;
      rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
            connection_descriptor.network_path].connection_clarifier := rfc$pcu_empty;
    IFEND;
    rfp$unlock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);

  PROCEND remove_connection_entry_p;
?? TITLE := '    remove_job_table_entry', EJECT ??
  PROCEDURE remove_job_table_entry(
    VAR job_table_entry_p: ^rft$rhfam_job_table_entry);


{
{     The purpose of this procedure is to remove the specified rhfam job
{     table entry from the list of rhfam job table entries.
{
{     JOB_TABLE_ENTRY_P: (input, output) This parameter specifies a pointer
{       to the job table entry to be removed.  This routine assumes that the
{       corresponding job table entry has been locked by the calling procedure.
{       Upon return this parameter is set to NIL.



    VAR
      current_entry_p: ^rft$rhfam_job_table_entry,
      previous_entry_p: ^rft$rhfam_job_table_entry;


    rfp$lock_table(rfv$rhfam_job_table.lock);
    previous_entry_p := NIL;
    current_entry_p := rfv$rhfam_job_table.first_entry;
    WHILE current_entry_p <> NIL DO
      IF current_entry_p^.job_name = job_table_entry_p^.job_name THEN
        IF previous_entry_p = NIL THEN
          rfv$rhfam_job_table.first_entry := current_entry_p^.next_entry;
        ELSE
          previous_entry_p^.next_entry := current_entry_p^.next_entry;
        IFEND;
        IF  current_entry_p = rfv$rhfam_job_table.last_entry  THEN
          rfv$rhfam_job_table.last_entry := previous_entry_p;
        IFEND;
        rfv$job_entry_pointer := NIL;
        rfp$unlock_table(rfv$rhfam_job_table.lock);
        FREE job_table_entry_p IN nav$network_paged_heap^;
        RETURN;
      IFEND;
      previous_entry_p := current_entry_p;
      current_entry_p := current_entry_p^.next_entry;
    WHILEND;
    rfv$job_entry_pointer := NIL;
    job_table_entry_p := NIL;
    rfp$unlock_table(rfv$rhfam_job_table.lock);
  PROCEND remove_job_table_entry;
?? TITLE := '    remove_switch_offer', EJECT ??
  PROCEDURE remove_switch_offer (job_name: jmt$system_supplied_name;
    VAR connection_entry_p: ^rft$connection_entry);

{
{     The purpose of this procedure is to remove a connection from the
{     switched connection queue and reset the connection status to
{     connected. The switched connection is located, delinked and the
{     data structure is released.
{
{     JOB_NAME (input): This parameter specifies the job name of the
{       connection to remove from the switched queue.
{
{     CONNECTION_ENTRY_P: (input,output) This parameter specifies the
{       connection to remove from the switched queue.



    VAR
      previous_entry: ^rft$switched_connection,
      switched_connection: ^rft$switched_connection;


    rfp$lock_table (rfv$switched_connection_queue.lock);
    previous_entry := NIL;
    switched_connection := rfv$switched_connection_queue.first_entry;
  /find_switched_connection/
    WHILE switched_connection <> NIL DO
      IF (job_name = switched_connection^.source_job) AND
         (connection_entry_p^.connection_name =
          switched_connection^.connection_entry_p^.connection_name) THEN
        EXIT /find_switched_connection/;
      IFEND;
      previous_entry := switched_connection;
      switched_connection := switched_connection^.next_entry;
    WHILEND /find_switched_connection/;

    IF switched_connection <> NIL THEN
      IF previous_entry = NIL THEN
        rfv$switched_connection_queue.first_entry := switched_connection^.next_entry;
      ELSE
        previous_entry^.next_entry := switched_connection^.next_entry;
      IFEND;

{     Remove placeholder connection entry from source job.

      delink_connection_entry (connection_entry_p);
      FREE connection_entry_p IN nav$network_paged_heap^;

{     Switch connection entry pointer to active connection entry.

      connection_entry_p := switched_connection^.connection_entry_p;
      rfp$lock_table (connection_entry_p^.lock);

{     Relink active connection entry into connections for source job.

      connection_entry_p^.next_entry :=
            connection_entry_p^.application_entry_p^.connection_table;
      connection_entry_p^.application_entry_p^.connection_table :=
            connection_entry_p;
      FREE switched_connection IN nav$network_paged_heap^;
    IFEND;

    rfp$unlock_table (rfv$switched_connection_queue.lock);

  PROCEND remove_switch_offer;
?? TITLE := '    rfp$remove_waits', EJECT ??
  PROCEDURE [XDCL] rfp$remove_waits;

{
{     The purpose of this procedure is to delink and free events from the
{     event queue for the presently executing task.
{


    VAR
      current_entry_p: ^rft$rhfam_event_table_entry,
      free_entry: ^rft$rhfam_event_table_entry,
      global_task_id: ost$global_task_id,
      previous_entry_p: ^rft$rhfam_event_table_entry;


    previous_entry_p := NIL;
    pmp$get_executing_task_gtid (global_task_id);
    rfp$lock_table(rfv$rhfam_event_table.lock);
    current_entry_p := rfv$rhfam_event_table.first_entry;
  /remove_wait/
    WHILE current_entry_p <> NIL DO
      IF (current_entry_p^.task_id = global_task_id) THEN
        IF ((current_entry_p^.event_kind <> rfc$ana_await_connection_event) OR
           ((current_entry_p^.event_kind = rfc$ana_await_connection_event) AND
            (NOT current_entry_p^.ace_asynchronous_wait))) THEN
          IF previous_entry_p = NIL THEN
            rfv$rhfam_event_table.first_entry := current_entry_p^.next_entry;
          ELSE
            previous_entry_p^.next_entry := current_entry_p^.next_entry;
          IFEND;
          free_entry := current_entry_p;
          current_entry_p := current_entry_p^.next_entry;
          FREE free_entry IN nav$network_paged_heap^;
          CYCLE /remove_wait/;
        IFEND;
      IFEND;
      previous_entry_p := current_entry_p;
      current_entry_p := current_entry_p^.next_entry;
    WHILEND /remove_wait/;
    rfp$unlock_table(rfv$rhfam_event_table.lock);

  PROCEND rfp$remove_waits;
?? TITLE := '    request_lcn_connection', EJECT ??
  PROCEDURE request_lcn_connection (connection_entry_p: ^rft$connection_entry;
        connect_request: ^rft$nbp_outgoing_connect;
    VAR status: ost$status);

{
{     The purpose of this request is to build and queue the pp request to
{     request an lcn connection.  This routine assumes that the connection
{     entry is locked upon entry.
{
{     NOTE: This routine unlocks the connection entry before exit.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies a pointer to
{       the connection entry pointer that the lcn connection is to be made
{       for.
{
{     CONNECT_REQUEST: (input) This parameter specifies a pointer to the
{       network block protocal that is to be used to request the connection.
{
{     STATUS: (output) This parameter returns the results of the request.
{       A status of normal indicates that the request connection was
{       successfully completed.


    VAR
      activity_status: ^ost$activity_status,
      command_identifier: ^rft$logical_commands,
      connect_request_p: ^rft$nbp_outgoing_connect,
      maintenance_connection: ^boolean,
      nad_index: rft$local_nads,
      request_info: ^SEQ (* ),
      unit_request_status: ^rft$connection_mgmt_status;


    /request_connection/
      BEGIN
        PUSH request_info: [[rft$logical_commands,   {command identifier}
              boolean,                               {maintenance connection}
              rft$nbp_outgoing_connect]];            {outgoing connect message}
        RESET request_info;
        NEXT command_identifier  IN  request_info;
        IF  command_identifier = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$request_connection', status);
          EXIT  /request_connection/;
        IFEND;
        command_identifier^ := rfc$lc_request_connection;
        NEXT  maintenance_connection  IN  request_info;
        IF  maintenance_connection = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$request_connection', status);
          EXIT  /request_connection/;
        IFEND;
        maintenance_connection^ := FALSE;
        NEXT  connect_request_p IN  request_info;
        IF  connect_request_p = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err,
                'the request overflowed the request sequence', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$request_connection', status);
          EXIT  /request_connection/;
        IFEND;
        connect_request_p^ := connect_request^;
        ALLOCATE unit_request_status IN osv$task_private_heap^;
        IF  unit_request_status = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                'task private', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$request_connection', status);
          EXIT  /request_connection/;
        IFEND;
        unit_request_status^.internal_use := FALSE;
        unit_request_status^.connection := connection_entry_p;

{     The structure activity status is allocated in task private to insure
{     it is writeable by ring 3 code. Pointers to this variable are stored in
{     a task private segment and thus inherit ring 3 privileges.

        ALLOCATE activity_status IN osv$task_private_heap^;
        IF  activity_status = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted,
                'task private', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
                'rfp$request_connection', status);
          EXIT  /request_connection/;
        IFEND;
        unit_request_status^.activity_status := activity_status;
        activity_status^.complete := FALSE;
        activity_status^.status.normal := TRUE;
        nad_index := connection_entry_p^.connection_descriptor.nad_index;
        connection_entry_p^.active_pp_requests := connection_entry_p^.active_pp_requests + 1;
        rfp$unlock_table (connection_entry_p^.lock);
        rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_request_connection,
              unit_request_status, request_info, status);
        IF  NOT status.normal  THEN
          rfp$lock_table (connection_entry_p^.lock);
          connection_entry_p^.active_pp_requests :=
                connection_entry_p^.active_pp_requests - 1;
          EXIT  /request_connection/;
        IFEND;
        REPEAT
          #SPOIL (activity_status^);
          pmp$wait (rfc$unit_request_wait_time,rfc$ur_expected_wait);
          rfp$process_pp_response_flag (rfc$pp_response_available);
        UNTIL activity_status^.complete;
        IF NOT activity_status^.status.normal THEN
          status := activity_status^.status;
        IFEND;
        FREE activity_status IN osv$task_private_heap^;
        EXIT request_lcn_connection;
      END /request_connection/;

      IF NOT status.normal THEN
        rfp$unlock_table (connection_entry_p^.lock);
      IFEND;

  PROCEND request_lcn_connection;
?? TITLE := '    reset_data_buffer', EJECT ??
  PROCEDURE reset_data_buffer (data_transfer_status: ^rft$data_transfer_status);

{
{     The purpose of this procedure is to reset a data transfer request.
{     Data is queued to be sent to the network and conditions may exist
{     that cause the data to not be sent at the present time.  This routine
{     resets the data transfer such that when the data transfer is
{     continued, the blocks that were queued and not sent are requeued.
{
{     DATA_TRANSFER_STATUS: (input,output) This parameter specifies the
{       data transfer to be reset.  The appropriate fields in this structure
{       are updated upon return.



    VAR
      block_descriptor_out: rft$outstanding_blocks;

    block_descriptor_out := data_transfer_status^.block_descriptor_out;
    data_transfer_status^.next_to_queue_index := data_transfer_status^.
          complete_index;
    data_transfer_status^.next_to_queue_offset := data_transfer_status^.
          complete_offset;
    data_transfer_status^.next_to_queue_abn := data_transfer_status^.
          block_descriptors^[block_descriptor_out].block_sequence_number;
    data_transfer_status^.data_exhausted := FALSE;
    data_transfer_status^.total_blocks_queued := 0;
    data_transfer_status^.block_descriptor_in := block_descriptor_out;
    data_transfer_status^.switch_to_wired_buffers := FALSE;


  PROCEND reset_data_buffer;
?? TITLE := '    reset_next_to_queue', EJECT ??
  PROCEDURE reset_next_to_queue (data_shortage: rft$data_length;
    VAR data_transfer_status: ^rft$data_transfer_status);

{
{     The purpose of this procedure is to reset the next to queue index
{     and offset to account for a short network block that has been
{     received.  This index must be backed up so that the end of the
{     data fragment buffer can be correctly detected. This routine assumes
{     that the receive buffer is not full and that the complete pointers
{     are valid.
{
{     DATA_SHORTAGE: (input) This parameter specifies the number of bytes
{       of data shortage that occurred.
{
{     DATA_TRANSFER_STATUS: (input,output) This parameter specifies the
{       parameters for the data transfer request.


    VAR
      data_bytes_short: rft$data_length,
      offset_differential: integer;


      data_bytes_short := data_shortage;
      IF data_transfer_status^.data_exhausted THEN
        IF data_transfer_status^.total_blocks_queued = 0 THEN
          data_transfer_status^.next_to_queue_index := data_transfer_status^.complete_index;
          data_transfer_status^.next_to_queue_offset := data_transfer_status^.complete_offset;
          data_transfer_status^.data_exhausted := FALSE;
        IFEND;
      ELSE
        WHILE data_bytes_short > 0 DO
          offset_differential := data_transfer_status^.next_to_queue_offset - data_bytes_short;
          IF offset_differential >= 0 THEN
            data_bytes_short := 0;
            data_transfer_status^.next_to_queue_offset := offset_differential;
          ELSE
            IF data_transfer_status^.data_area^[data_transfer_status^.next_to_queue_index].
                  length <> 0 THEN
              data_bytes_short := data_bytes_short - data_transfer_status^.next_to_queue_offset - 1;
              data_transfer_status^.next_to_queue_index :=
                    data_transfer_status^.next_to_queue_index - 1;
              IF data_transfer_status^.data_area^[data_transfer_status^.next_to_queue_index].
                    length <> 0 THEN
                data_transfer_status^.next_to_queue_offset :=
                      data_transfer_status^.data_area^[data_transfer_status^.
                      next_to_queue_index].length - 1;
              ELSE
                data_transfer_status^.next_to_queue_offset := 0;
              IFEND;
            ELSE
              data_transfer_status^.next_to_queue_index :=
                    data_transfer_status^.next_to_queue_index - 1;
            IFEND;
          IFEND;
        WHILEND;
        data_transfer_status^.data_exhausted := FALSE;
      IFEND;

  PROCEND reset_next_to_queue;
?? TITLE := '    restart_data_transfer', EJECT ??
  PROCEDURE restart_data_transfer(current_request: ^rft$outstanding_requests;
        termination_mark: rft$record_marks;
    VAR blocks_to_add: rft$outstanding_blocks;
    VAR status: ost$status);

{
{     The purpose of this procedure is to restart a data transfer after it
{     has been suspended either because of a resource limit condition in the
{     NAD or after suspending a data transfer on a record mark termination
{     that is of less priority than that specified on the receive data call.
{
{     CURRENT_REQUEST: (input) This parameter specifies a pointer to the
{       request that is to be restarted.
{
{     TERMINATION_MARK: (input) This parameter specifies the termination mark
{       to be used for the data transfer.
{
{     BLOCKS_TO_ADD: (input,output) This parameter specifies the number of
{       network blocks to add to the pp unit request. Upon return this parameter
{       returns the number of blocks added to the request.
{
{     STATUS: (output) This parameter returns the status of the request.



    VAR
      data_transfer_status: ^rft$data_transfer_status,
      done: boolean,
      nad_index: rft$local_nads,
      unit_request: ^SEQ (  * );



    data_transfer_status := current_request^.request_status;
    PUSH unit_request: [[rft$logical_commands, rft$transfer_mode, boolean,
          rft$path_identifier,
          BOOLEAN,
                { intermediate response flag }
          rft$command_entry,
                { block count }
          REP data_transfer_status^.maximum_outstanding_blocks OF rft$command_entry,
                { fragment count }
          REP (data_transfer_status^.maximum_outstanding_blocks * 4) OF rft$io_fragment]];
                { assume maximum of 4 fragments per block }
    RESET unit_request;
    build_transfer_request_header (data_transfer_status, data_transfer_status^.termination_mark,
          unit_request, status);
    IF  NOT status.normal THEN
      EXIT  restart_data_transfer;
    IFEND;

    add_blocks_to_request (data_transfer_status, TRUE, blocks_to_add,
          unit_request, status);
    IF NOT status.normal THEN
      EXIT restart_data_transfer;
    IFEND;
    RESET unit_request;

    data_transfer_status^.present_r1_out_ptr := rfc$cbi_first_io_entry;
    rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
    IF data_transfer_status^.connection_entry_p^.connection_attributes.
          connection_status.connection_state = rfc$connected THEN
      IF data_transfer_status^.outstanding_control_messages <> NIL THEN
        queue_control_messages (data_transfer_status^.connection_entry_p^.connection_descriptor.
              nad_index, data_transfer_status^.outstanding_control_messages);
      IFEND;
      nad_index := data_transfer_status^.connection_entry_p^.
            connection_descriptor.nad_index;
      rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);

      done := FALSE;
      REPEAT
        rfp$lock_table (rfv$status_table.lock);
        IF (NOT rfv$status_table.system_task_is_up) OR
           (rfv$status_table.local_nads^[nad_index].current_status.device_status <> rfc$es_on) THEN
          osp$set_status_abnormal (rfc$product_id, rfe$local_nad_down, 'to the NAD', status);
          done := TRUE;
        ELSEIF rfv$status_table.local_nads^[nad_index].requests_posted <
              rfc$max_concurrent_requests THEN
          rfv$status_table.local_nads^[nad_index].requests_posted :=
                rfv$status_table.local_nads^[nad_index].requests_posted + 1;
          done := TRUE;
        ELSE
          rfp$unlock_table (rfv$status_table.lock);
          syp$cycle;
          current_request^.processing_request := TRUE;
          rfp$process_pp_response_flag (rfc$pp_response_available);
          current_request^.processing_request := FALSE;
        IFEND;
      UNTIL done;
      rfp$unlock_table (rfv$status_table.lock);
      IF NOT status.normal THEN
        EXIT restart_data_transfer;
      IFEND;

      rfp$post_request (unit_request, current_request^.request_id, status);
      IF NOT status.normal THEN
        rfp$lock_table (rfv$status_table.lock);
          rfv$status_table.local_nads^[nad_index].requests_posted :=
                rfv$status_table.local_nads^[nad_index].requests_posted - 1;
        rfp$unlock_table (rfv$status_table.lock);
      ELSE
        data_transfer_status^.total_blocks_queued := blocks_to_add;
        data_transfer_status^.next_to_queue_abn := data_transfer_status^.current_abn;
        data_transfer_status^.next_to_queue_index := data_transfer_status^.current_fragment_index;
        data_transfer_status^.next_to_queue_offset := data_transfer_status^.current_fragment_offset;
        current_request^.posted := TRUE;
        advise_out_in (data_transfer_status, data_transfer_status^.previous_error);
      IFEND;
    ELSE
      set_connection_status (data_transfer_status^.connection_entry_p, status);
      rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
      delete_control_messages (data_transfer_status^.outstanding_control_messages);
    IFEND;

  PROCEND restart_data_transfer;
?? TITLE := '    rfp$return_lid_type', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$return_lid_type (
        lid_name: rft$logical_identifier;
    VAR lid_type: rft$type_of_lid;
    VAR status: ost$status);

*copyc rfh$return_lid_type

?? NEWTITLE := '      terminate_return_lid_type - condition handler', EJECT ??
    PROCEDURE terminate_return_lid_type (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$return_lid_type;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$return_lid_type;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_return_lid_type;
?? OLDTITLE, EJECT ??


    VAR
      lid_index: ost$non_negative_integers,
      remote_host: ^rft$remote_host_definition,
      temp_lid: rft$logical_identifier,
      temp_type: rft$type_of_lid;

    status.normal := TRUE;
    temp_lid := lid_name;
    temp_type := rfc$unknown_logical_id;
    osp$establish_condition_handler (^terminate_return_lid_type, FALSE);
    rfp$lock_table (rfv$status_table.lock);

  /find_lid/
    BEGIN
      IF rfv$status_table.system_task_is_up THEN
        IF rfv$status_table.local_host^.physical_identifier = temp_lid THEN
          temp_type := rfc$local_physical_id;
          EXIT /find_lid/;
        ELSE
          FOR lid_index := 1 TO UPPERBOUND (rfv$status_table.local_host^.logical_identifiers) DO
            IF rfv$status_table.local_host^.logical_identifiers [lid_index].logical_id = temp_lid THEN
              temp_type := rfc$local_logical_id;
              EXIT /find_lid/;
            IFEND;
          FOREND;

          remote_host := rfv$status_table.remote_hosts;
          WHILE remote_host <> NIL DO
            IF remote_host^.physical_identifier = temp_lid THEN
              temp_type := rfc$remote_physical_id;
              EXIT /find_lid/;
            ELSE
              FOR lid_index := 1 TO UPPERBOUND (remote_host^.logical_identifiers) DO
                IF remote_host^.logical_identifiers [lid_index].logical_id = temp_lid THEN
                  temp_type := rfc$remote_logical_id;
                  EXIT /find_lid/;
                IFEND;
              FOREND;
            IFEND;
            remote_host := remote_host^.next_entry;
          WHILEND;
        IFEND;
      IFEND;
    END /find_lid/;

    rfp$unlock_table (rfv$status_table.lock);
    lid_type := temp_type;
  PROCEND rfp$return_lid_type;
?? TITLE := '    save_residue_data', EJECT ??
  PROCEDURE save_residue_data (data_transfer_status: ^rft$data_transfer_status;
        remaining_block_size: rft$block_size;
        wired_buffer_index: rft$buffer_count;
    VAR status: ost$status);

{
{     The purpose of this routine is to save any residue data that has been
{     received from the NAD but could not be delivered to the user because
{     of a buffer full condition.  Data is read in complete blocks from the
{     NAD.  If a buffer full is detected, any remaining data is moved
{     (at most a network block - 1) to the network paged section to be saved
{     until it can be delivered on the next receive data.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters
{       of the data transfer.
{
{     REMAINING_BLOCK_SIZE: (input) This parameter specifies the amount
{       of data that is to be saved.
{
{     WIRED_BUFFER_INDEX: (input) This parameter specifies the index of
{       the wired buffer that contains the start of the data.
{
{     STATUS: (output) This parameter returns the status of the request.
{       A status of normal indicates that the data was saved.



    VAR
      buffer_index: rft$buffer_count,
      data_count: rft$bytes_transferred,
      data: ^SEQ ( * ),
      data_p: ^cell,
      residue_data: ^rft$residue_data;

    status.normal := TRUE;
    ALLOCATE residue_data: [[REP remaining_block_size OF CELL]] IN nav$network_paged_heap^;
    IF residue_data = NIL THEN
      osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
            'network paged', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            'save_residue_data', status);
      EXIT save_residue_data;
    IFEND;

    residue_data^.remaining_data := remaining_block_size;
    residue_data^.record_mark_encountered := FALSE;

    residue_data^.data_pointer := ^residue_data^.data;
    RESET residue_data^.data_pointer;
    NEXT data: [[REP remaining_block_size OF CELL]] IN residue_data^.data_pointer;
    data_count := remaining_block_size;
    buffer_index := wired_buffer_index;
    data_p := data;
    rfp$move_data_from_wired_buffs (data_transfer_status^.reserved_buffer_list^, data_p,
          data_transfer_status^.reserved_buffer_count, buffer_index,
          data_count);
    RESET residue_data^.data_pointer;

    rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
    data_transfer_status^.connection_entry_p^.residue_input_data := residue_data;
    rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
  PROCEND save_residue_data;
?? TITLE := '    search_for_path', EJECT ??
  PROCEDURE search_for_path (server_name: rft$application_name;
        destination_host: rft$host_identifier;
        server_available_locally: boolean;
    VAR selected_path_p: ^rft$lcn_path_definition;
    VAR selected_pid: rft$physical_identifier;
    VAR host_identifiers: ^rft$destination_hosts;
    VAR number_of_hosts: rft$number_of_hosts;
    VAR map_lid_to_pid: boolean;
    VAR status: ost$status);


{     The purpose of this procedure is to search the local configuration
{     file for a path definition to a remote host.
{
{     SERVER_NAME: (input) This parameter specifies the server name that
{       must be present on the remote host.
{
{     DESTINATION_HOST: (input) This parameter specifies the remote host
{       to search for.
{
{     SERVER_AVAILABLE_LOCALLY: (input) This parameter specifies if the
{       requested server is available locally.
{
{     SELECTED_PATH_P: (output) This parameter returns a pointer to the
{       selected path. This parameter is not meaningful if status is not
{       normal.
{
{     SELECTED_PID: (output) This parameter returns the physical identifier
{       of the remote host choosen.
{
{     HOST_IDENTIFIERS: (output) This parameter returns an array of the
{       physical identifiers that match the specified logical identifier
{       and server name.  This parameter is returned whether the elements
{       are 'on' or 'off'
{
{     NUMBER_OF_HOSTS: (output) This parameter returns the number of hosts
{       that match on server name and destination host.
{
{     MAP_LID_TO_PID: (output) This parameter returns the lid to pid
{       mapping status for the specified lid. A status of TRUE indicates
{       that the PID should be used in the connection request message.
{
{     STATUS: (output) This parameter returns the status of the search.
{       A status of normal means that a path has been found and it is
{       operational.



    VAR
      associated_paths_p: ^rft$lcn_paths,
      earliest_connect_time: integer,
      index: integer,
      least_number_of_connects: rft$concurrent_connections,
      local_host_p: ^rft$local_host_definition,
      logical_id_index: integer,
      path_enabled: boolean,
      path_index: integer,
      remote_host_p: ^rft$remote_host_definition,
      remote_host_defined: boolean,
      remote_host_enabled: boolean,
      remote_host_matches: boolean,
      remote_lid_enabled: boolean,
      remote_path_defined: boolean,
      remote_server_defined: boolean;



    status.normal := TRUE;
    selected_path_p := NIL;
    remote_host_defined := FALSE;
    remote_host_enabled := FALSE;
    remote_server_defined := FALSE;
    remote_path_defined := FALSE;
    number_of_hosts := 0;
    earliest_connect_time := UPPERVALUE(INTEGER);
    least_number_of_connects := UPPERVALUE(rft$concurrent_connections);


    remote_host_p := rfv$status_table.remote_hosts;
    /locate_remote_path/
      WHILE remote_host_p <> NIL DO
        remote_host_matches := FALSE;
        remote_lid_enabled := TRUE;
        CASE destination_host.host_identifier_kind OF
        = rfc$physical_identifier =
          IF remote_host_p^.physical_identifier = destination_host.
                physical_identifier THEN
            remote_host_matches := TRUE;
          IFEND;
        = rfc$logical_identifier =
          /check_for_remote_lid/
          FOR logical_id_index := 1 TO UPPERBOUND (remote_host_p^.logical_identifiers) DO
            IF destination_host.logical_identifier = remote_host_p^.
                  logical_identifiers[logical_id_index].logical_id THEN
              remote_host_matches := TRUE;
              IF remote_host_p^.logical_identifiers[logical_id_index].disabled THEN
                remote_lid_enabled := FALSE;
              ELSE
                map_lid_to_pid := remote_host_p^.logical_identifiers[logical_id_index].
                      map_lid_to_pid;
              IFEND;
              EXIT /check_for_remote_lid/;
            IFEND;
          FOREND /check_for_remote_lid/;
        CASEND;
        IF remote_host_matches THEN
          remote_host_defined := TRUE;
          remote_server_defined := TRUE;
          number_of_hosts := number_of_hosts + 1;
          IF number_of_hosts <= UPPERBOUND(host_identifiers^) THEN
            host_identifiers^[number_of_hosts].host_identifier_kind := rfc$physical_identifier;
            host_identifiers^[number_of_hosts].physical_identifier :=
                  remote_host_p^.physical_identifier;
          IFEND;
          IF (remote_lid_enabled) AND
             (NOT remote_host_p^.disabled) THEN
            remote_host_enabled := TRUE;
            associated_paths_p := remote_host_p^.associated_paths;
            IF associated_paths_p <> NIL THEN
              remote_path_defined := TRUE;
              FOR path_index := 1 TO UPPERBOUND (associated_paths_p^) DO
                determine_path_state (^associated_paths_p^[path_index], path_enabled);
                IF path_enabled THEN
                  IF rfv$status_table.local_nads^[associated_paths_p^[path_index].local_nad].
                        connections_established <= least_number_of_connects THEN
                    IF associated_paths_p^[path_index].last_attempted_connect <
                          earliest_connect_time THEN
                      selected_path_p := ^associated_paths_p^ [path_index];
                      selected_pid := remote_host_p^.physical_identifier;
                      earliest_connect_time := selected_path_p^.last_attempted_connect;
                      least_number_of_connects := rfv$status_table.local_nads^
                            [selected_path_p^.local_nad].connections_established;
                    IFEND;
                  IFEND;
                IFEND;
              FOREND;
            IFEND;
          IFEND;
        IFEND;
        remote_host_p := remote_host_p^.next_entry;
      WHILEND /locate_remote_path/;

    /locate_local_path/
      BEGIN
        local_host_p := rfv$status_table.local_host;
        remote_host_matches := FALSE;
        remote_lid_enabled := TRUE;
        CASE destination_host.host_identifier_kind OF
        = rfc$physical_identifier =
          IF local_host_p^.physical_identifier = destination_host.
                physical_identifier THEN
            remote_host_matches := TRUE;
          IFEND;
        = rfc$logical_identifier =
          /check_for_local_lid/
          FOR index := 1 TO UPPERBOUND (local_host_p^.logical_identifiers) DO
            IF destination_host.logical_identifier = local_host_p^.
                  logical_identifiers[index].logical_id THEN
              remote_host_matches := TRUE;
              IF local_host_p^.logical_identifiers[index].disabled THEN
                remote_lid_enabled := FALSE;
              ELSE
                map_lid_to_pid := local_host_p^.logical_identifiers[index].
                      map_lid_to_pid;
              IFEND;
              EXIT /check_for_local_lid/;
            IFEND;
          FOREND /check_for_local_lid/;
        CASEND;
        IF remote_host_matches THEN
          remote_host_defined := TRUE;
          IF server_available_locally THEN
            remote_server_defined := TRUE;
            number_of_hosts := number_of_hosts + 1;
            IF number_of_hosts <= UPPERBOUND(host_identifiers^) THEN
              host_identifiers^[number_of_hosts].host_identifier_kind := rfc$physical_identifier;
              host_identifiers^[number_of_hosts].physical_identifier :=
                    rfv$status_table.local_host^.physical_identifier;
            IFEND;
            IF selected_path_p = NIL THEN
              IF (remote_lid_enabled) AND
                 (NOT local_host_p^.disabled) THEN
                remote_host_enabled := TRUE;
                associated_paths_p := local_host_p^.associated_paths;
                IF associated_paths_p <> NIL THEN
                  remote_path_defined := TRUE;
                  FOR path_index := 1 TO UPPERBOUND (associated_paths_p^) DO
                    determine_path_state (^associated_paths_p^[path_index], path_enabled);
                    IF path_enabled THEN
                      IF rfv$status_table.local_nads^[associated_paths_p^[path_index].local_nad].
                          connections_established <= least_number_of_connects THEN
                        IF associated_paths_p^[path_index].last_attempted_connect <
                              earliest_connect_time THEN
                          selected_path_p := ^associated_paths_p^ [path_index];
                          selected_pid := local_host_p^.physical_identifier;
                          earliest_connect_time := selected_path_p^.last_attempted_connect;
                          least_number_of_connects := rfv$status_table.local_nads^
                                [selected_path_p^.local_nad].connections_established;
                        IFEND;
                      IFEND;
                    IFEND;
                  FOREND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      END /locate_local_path/;


    IF NOT remote_host_defined THEN
      CASE destination_host.host_identifier_kind OF
      = rfc$physical_identifier =
        osp$set_status_abnormal (rfc$product_id, rfe$destination_host_undefined,
              destination_host.physical_identifier, status);
      = rfc$logical_identifier =
        osp$set_status_abnormal (rfc$product_id,rfe$destination_host_undefined,
              destination_host.logical_identifier, status);
      CASEND;
      EXIT search_for_path;
    IFEND;

    IF NOT remote_host_enabled THEN
      CASE destination_host.host_identifier_kind OF
      = rfc$physical_identifier =
        osp$set_status_abnormal (rfc$product_id, rfe$destination_host_disabled,
              destination_host.physical_identifier, status);
      = rfc$logical_identifier =
        osp$set_status_abnormal (rfc$product_id,rfe$destination_host_disabled,
              destination_host.logical_identifier, status);
      CASEND;
      EXIT search_for_path;
    IFEND;

    IF NOT remote_server_defined THEN
      osp$set_status_abnormal (rfc$product_id, rfe$remote_server_undefined,
            server_name, status);
      EXIT search_for_path;
    IFEND;

    IF NOT remote_path_defined THEN
      osp$set_status_abnormal(rfc$product_id, rfe$path_to_remote_undefined,
            server_name, status);
      CASE destination_host.host_identifier_kind OF
      = rfc$physical_identifier =
        osp$append_status_parameter (osc$status_parameter_delimiter,
              destination_host.physical_identifier, status);
      = rfc$logical_identifier =
        osp$append_status_parameter (osc$status_parameter_delimiter,
              destination_host.logical_identifier, status);
      CASEND;
      EXIT search_for_path;
    IFEND;

    IF selected_path_p = NIL THEN
      osp$set_status_abnormal (rfc$product_id, rfe$paths_to_destination_down,
            server_name, status);
    IFEND;

  PROCEND search_for_path;
?? TITLE := '    rfp$set_connection_entry_p', EJECT ??
  PROCEDURE [XDCL] rfp$set_connection_entry_p (connection_entry_p: ^rft$connection_entry;
        response_seq_number: integer;
    VAR status: ost$status);

{
{     The purpose of this procedure is to enter the connection entry pointer
{     into the local nad table under the NAD associated with the connection.
{     This routine verifies that RHFAM is not in shutdown and that the NAD
{     is not UP.
{
{     NOTE: This routine assumes that the connection entry is locked upon
{       entry.  This locking algorithm does not conflict with the system
{       task because until the pointer is entered into the connection entry
{       in the status table, the system task does not know about the
{       connection and therefore does not try to lock the connection entry.
{
{     RESPONSE_SEQ_NUMBER: (input) This paramter specifies the sequence
{       number of the disconnect response that is being processed.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies a pointer to the
{       connection entry that is to be registered with RHFAM.
{
{     STATUS: (output) This parameter returns the result of the request.
{       A value of TRUE indicates that the connection has been registered.


    VAR
      nad_index: rft$local_nads;

    status.normal := TRUE;
    nad_index := connection_entry_p^.connection_descriptor.nad_index;
    rfp$lock_table(rfv$status_table.lock);
    IF rfv$status_table.system_task_is_up THEN
      rfp$lock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
      IF rfv$status_table.local_nads^[nad_index].current_status.device_status =
            rfc$es_on THEN
        IF (rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
              connection_descriptor.network_path].connection_table_entry = NIL)  AND
           ((connection_entry_p^.connection_attributes.connection_status.connection_state <>
                rfc$outgoing_connect_active)  OR
            (NOT rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
              connection_descriptor.network_path].processing_incoming_connect))  THEN
          rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
                connection_descriptor.network_path].connection_table_entry :=
                connection_entry_p;
          rfv$status_table.local_nads^[nad_index].connections_established :=
                rfv$status_table.local_nads^[nad_index].connections_established + 1;
          rfv$status_table.local_nads^[nad_index].statistics.connections_established :=
                rfv$status_table.local_nads^[nad_index].statistics.connections_established + 1;
          IF connection_entry_p^.connection_attributes.connection_status.connection_state =
                rfc$outgoing_connect_active THEN
            IF response_seq_number >
                   rfv$status_table.local_nads^[nad_index].last_status_seq_number THEN
              rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
                    connection_descriptor.network_path].connection_state := rfc$ps_connecting;
              rfv$status_table.local_nads^[nad_index].connection_table^[connection_entry_p^.
                    connection_descriptor.network_path].connection_clarifier :=
                    rfc$pcc_locally_initiated;
            IFEND;
          IFEND;
        ELSE
         osp$set_status_abnormal (rfc$product_id, rfe$local_nad_busy,
               rfv$status_table.local_nads^[nad_index].name, status);
        IFEND;
      ELSE
        connection_entry_p^.connection_attributes.connection_status.connection_state :=
              rfc$local_nad_failure;
        osp$set_status_abnormal (rfc$product_id, rfe$local_nad_down,
              '', status);
      IFEND;
      rfp$unlock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
    ELSE
      connection_entry_p^.connection_attributes.connection_status.connection_state :=
            rfc$system_task_shutdown;
      osp$set_status_abnormal (rfc$product_id, rfe$system_task_not_active,
            '', status);
    IFEND;
    rfp$unlock_table(rfv$status_table.lock);

  PROCEND rfp$set_connection_entry_p;
?? TITLE := '    set_connection_status', EJECT ??
  PROCEDURE set_connection_status (connection_entry_p: ^rft$connection_entry;
    VAR status: ost$status);

{
{     The purpose of this procedure is to set the status parameter to
{     reflect the current state of the connection in the connection
{     table.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies the
{       connection to return the status of.
{
{     STATUS: (output) This parameter returns the status of the
{       connection.
{


    CASE connection_entry_p^.connection_attributes.connection_status.
          connection_state OF
    = rfc$outgoing_connect_active =
      osp$set_status_abnormal (rfc$product_id, rfe$connect_in_progress,
            connection_entry_p^.connection_name, status);
    = rfc$incoming_connect_active =
      osp$set_status_abnormal (rfc$product_id, rfe$connection_waiting_accept,
            'Incoming connect', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            connection_entry_p^.connection_name, status);
    = rfc$connected =
      osp$set_status_abnormal (rfc$product_id, rfe$connected,
            connection_entry_p^.connection_name, status);
    = rfc$connect_rejected =
      osp$set_status_abnormal (rfc$product_id, rfe$connection_rejected,
            connection_entry_p^.connection_name, status);
    = rfc$switch_offered =
      osp$set_status_abnormal (rfc$product_id, rfe$switch_offered,
            connection_entry_p^.connection_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            connection_entry_p^.connection_attributes.connection_status.
            destination_job, status);
    = rfc$switch_accepted =
      osp$set_status_abnormal (rfc$product_id, rfe$switch_accepted,
            connection_entry_p^.connection_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            connection_entry_p^.connection_attributes.connection_status.
            receiving_job, status);
    = rfc$terminated =
      osp$set_status_abnormal (rfc$product_id, rfe$connection_terminated,
            connection_entry_p^.connection_name, status);
    = rfc$not_viable =
      osp$set_status_abnormal (rfc$product_id, rfe$unexpected_connection_state,
            connection_entry_p^.connection_name, status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            $integer(connection_entry_p^.connection_attributes.connection_status.
            connection_state), 10, FALSE, status);
    = rfc$system_task_shutdown =
      osp$set_status_abnormal (rfc$product_id, rfe$system_task_shutdown,
            connection_entry_p^.connection_name, status);
    = rfc$local_nad_failure =
      osp$set_status_abnormal (rfc$product_id, rfe$local_nad_failure,
            connection_entry_p^.connection_name, status);
    = rfc$system_interrupt =
      osp$set_status_abnormal (rfc$product_id, rfe$system_interrupt,
            connection_entry_p^.connection_name, status);
    ELSE
      osp$set_status_abnormal (rfc$product_id, rfe$unexpected_connection_state,
            connection_entry_p^.connection_name, status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            $integer(connection_entry_p^.connection_attributes.connection_status.
            connection_state), 10, FALSE, status);
    CASEND;

  PROCEND set_connection_status;
?? TITLE := '    sign_off_server', EJECT ??
  PROCEDURE sign_off_server (server_name: rft$application_name;
        job_name: jmt$system_supplied_name;
        current_connections: rft$application_connections;
    VAR status: ost$status);

{
{     The purpose of this procedure is to locate a server entry in the
{     defined server table, remove the server identifier, and decrement
{     the number of connections reserved by this server.
{
{     SERVER_NAME: (input) This parameter specifies the server that
{       is signing off.
{
{     JOB_NAME: (input) This parameter specifies the job name of the server
{       that is signing off.
{
{     STATUS: (output) A value of normal is returned if the server definition
{       is successfully removed.
{


    VAR
      current_entry_p: ^rft$server_identifier,
      previous_entry_p: ^rft$server_identifier,
      server_entry_p: ^rft$rhfam_server_table_entry;


    rfp$lock_table (rfv$rhfam_server_table.lock);
    find_server_entry(server_name, FALSE, server_entry_p, status);
    IF status.normal THEN
      server_entry_p^.connections_reserved := server_entry_p^.connections_reserved -
            current_connections;

      previous_entry_p := NIL;
      current_entry_p := server_entry_p^.server_identifier;

    /remove_identifier/
      WHILE current_entry_p <> NIL DO
        IF current_entry_p^.job_name = job_name THEN
          IF previous_entry_p = NIL THEN
            server_entry_p^.server_identifier := current_entry_p^.next_entry;
          ELSE
            previous_entry_p^.next_entry := current_entry_p^.next_entry;
          IFEND;
          FREE current_entry_p IN nav$network_paged_heap^;
          EXIT /remove_identifier/;
        IFEND;
        previous_entry_p := current_entry_p;
        current_entry_p := current_entry_p^.next_entry;
      WHILEND /remove_identifier/;

    IFEND;
    rfp$unlock_table (rfv$rhfam_server_table.lock);

  PROCEND sign_off_server;
?? TITLE := '    sign_on_server', EJECT ??
  PROCEDURE sign_on_server (server_entry_p: ^rft$rhfam_server_table_entry;
        system_supplied_name: jmt$system_supplied_name;
    VAR maximum_connections: rft$application_connections;
    VAR status: ost$status);

{
{     The purpose of this procedure is to verify that the server
{     signing on is the server started by RHFAM or if the server is
{     not defined, then to register the server as an implicit server
{     definition.
{
{     SERVER_ENTRY_P: (input) This parameter specifies a pointer to the
{       server definition of the server that is signing on.
{
{     SYSTEM_SUPPLIED_NAME: (input) This parameter specifies the job name
{       of the currently executing job.
{
{     MAXIMUM_CONNECTIONS: (input,output) This parameter specifies the number
{       of connections the server wishes to sign on with.  On return, this
{       parameter returns the actual number of connections the server was
{       signed on with.
{
{     STATUS: (output) This parameter returns the status of the request.
{       A status of normal indicates that the server was successfully signed
{       on.



    VAR
      remaining_connections: rft$application_connections,
      server_identifier_p: ^rft$server_identifier;


    status.normal := TRUE;
    IF server_entry_p^.rhfam_initiated_server THEN

{     Server was started by RHFAM so match on server identifier to
{     insure this is the job started by RHFAM.

      server_identifier_p := server_entry_p^.server_identifier;
      WHILE server_identifier_p <> NIL DO
        IF server_identifier_p^.job_name = system_supplied_name THEN
          IF maximum_connections <> server_entry_p^.server_job_max_connections THEN
            osp$set_status_abnormal (rfc$product_id, rfe$max_connection_mismatch,
                  server_entry_p^.server_name, status);
            EXIT sign_on_server;
          IFEND;
          server_identifier_p^.server_signed_on := TRUE;
          EXIT sign_on_server;
        IFEND;
        server_identifier_p := server_identifier_p^.next_entry;
      WHILEND;

      osp$set_status_abnormal (rfc$product_id, rfe$not_registered_server,
            server_entry_p^.server_name, status);
    ELSE

{     This server was not started by RHFAM so allocate a server identifier record.

      ALLOCATE server_identifier_p IN nav$network_paged_heap^;
      IF server_identifier_p = NIL THEN
        osp$set_status_abnormal (rfc$product_id, rfe$heap_exhausted,
              'network paged', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              'sign_on_server', status);
        EXIT sign_on_server;
      IFEND;
      remaining_connections := server_entry_p^.maximum_connections -
            server_entry_p^.connections_reserved;
      IF maximum_connections = 0 THEN
        maximum_connections := remaining_connections;
      ELSE
        IF remaining_connections <  maximum_connections THEN
          osp$set_status_abnormal (rfc$product_id, rfe$defined_connects_exceeded,
                server_entry_p^.server_name, status);
          osp$append_status_integer (osc$status_parameter_delimiter, maximum_connections,
                10, FALSE, status);
          EXIT sign_on_server;
        IFEND;
      IFEND;
      server_entry_p^.connections_reserved := server_entry_p^.connections_reserved +
              maximum_connections;
      server_identifier_p^.job_name := system_supplied_name;
      pmp$get_microsecond_clock (server_identifier_p^.server_started_time, status);
      server_identifier_p^.server_signed_on := TRUE;

{     Link new server identifier into list of server identifiers.

      server_identifier_p^.next_entry := server_entry_p^.server_identifier;
      server_entry_p^.server_identifier := server_identifier_p;

    IFEND;

  PROCEND sign_on_server;
?? TITLE := '    start_receive_data', EJECT ??
  PROCEDURE start_receive_data (VAR data_transfer_status: ^rft$data_transfer_status;
        data_length: rft$data_length;
    VAR residue_input_data: ^rft$residue_data;
    VAR status: ost$status);


{
{     The purpose of this procedure is to allocate any necessary buffers
{     and initialize the receive data pp unit request.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters for
{       the data send operation. A NIL pointer is returned if an error has occurred
{       and the transfer was terminated.
{
{     DATA_LENGTH: (input) This parameter specifies the total data length for this
{       request.
{
{     RESIDUE_INPUT_DATA: (input) This parameter specifies a pointer to any residue
{       data that has been received from the network but not yet delivered to the
{       application because of a buffer full condition.  A nil pointer indicates
{       no residue data.
{
{     STATUS: (output) A value of normal is returned if the send data request
{       has been successfully initiated.
{


    VAR
      blocks_to_add: rft$outstanding_blocks,
      nad_index: rft$local_nads,
      transfer_complete: boolean,
      unit_request: ^SEQ ( * );


    data_transfer_status^.present_r1_out_ptr := rfc$cbi_first_io_entry;
    data_transfer_status^.block_descriptors := NIL;
    data_transfer_status^.block_descriptor_in := 1;
    data_transfer_status^.block_descriptor_out := 1;
    data_transfer_status^.reserved_buffer_list := NIL;
    data_transfer_status^.next_wired_buffer_in := 1;
    data_transfer_status^.next_wired_buffer_out := 1;
    data_transfer_status^.data_exhausted := FALSE;
    data_transfer_status^.next_to_advise_out_index := data_transfer_status^.next_to_queue_index;
    data_transfer_status^.next_to_advise_out_offset :=
          data_transfer_status^.next_to_queue_offset;
    data_transfer_status^.next_to_advise_in_index := data_transfer_status^.next_to_queue_index;
    data_transfer_status^.next_to_advise_in_offset :=
          data_transfer_status^.next_to_queue_offset;
    data_transfer_status^.complete_index := data_transfer_status^.next_to_queue_index;
    data_transfer_status^.complete_offset := data_transfer_status^.next_to_queue_offset;
    data_transfer_status^.switch_to_wired_buffers := FALSE;
    data_transfer_status^.termination_mark := rfc$rm_eor;
    data_transfer_status^.header_buffers := NIL;
    data_transfer_status^.maximum_outstanding_blocks := rfc$max_outstanding_blocks;

    {  Start the disk processing to minimize future page faulting.
    {  WARNING - 'data_transfer_status^.block_decriptors' must equal the NIL value.

    advise_out_in (data_transfer_status, status);
    IF NOT status.normal THEN
      terminate_transfer_request (status, data_transfer_status);
      EXIT start_receive_data;
    IFEND;

    IF residue_input_data <> NIL THEN
      deliver_residue_data (data_transfer_status, residue_input_data, transfer_complete,
            status);
      IF (transfer_complete) OR
         (NOT status.normal) THEN
        terminate_transfer_request (status, data_transfer_status);
        EXIT start_receive_data;
      IFEND;
      data_transfer_status^.network_wired_data := TRUE;
    IFEND;

    IF data_transfer_status^.network_wired_data THEN
      allocate_network_wired_buffers (data_transfer_status, data_length, status);
      IF NOT status.normal THEN
        terminate_transfer_request (status, data_transfer_status);
        EXIT start_receive_data;
      IFEND;
    ELSE
      ALLOCATE  data_transfer_status^.header_buffers:
            [ 1 .. data_transfer_status^.maximum_outstanding_blocks ]
            IN nav$network_wired_heap^;
    IFEND;

    ALLOCATE data_transfer_status^.block_descriptors:
          [ 1 .. data_transfer_status^.maximum_outstanding_blocks ]
          IN osv$task_private_heap^;

    PUSH unit_request: [[rft$logical_commands, rft$transfer_mode, boolean, rft$path_identifier,
          BOOLEAN,
                { intermediate response flag }
          rft$command_entry,
                { block count }
          REP data_transfer_status^.maximum_outstanding_blocks OF rft$command_entry,
                { fragment count }
          REP (data_transfer_status^.maximum_outstanding_blocks * 4) OF rft$io_fragment]];
                { assume maximum of 4 fragments per block }
    RESET unit_request;
    build_transfer_request_header (data_transfer_status, rfc$rm_eor, unit_request, status);
    IF  NOT status.normal THEN
      terminate_transfer_request (status, data_transfer_status);
      EXIT  start_receive_data;
    IFEND;

    blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
    add_blocks_to_request (data_transfer_status, TRUE, blocks_to_add,
          unit_request, status);
    IF NOT status.normal THEN
      terminate_transfer_request (status, data_transfer_status);
      EXIT start_receive_data;
    IFEND;

    rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
    IF (data_transfer_status^.connection_entry_p^.connection_attributes.
          connection_status.connection_state = rfc$connected) OR
       (data_transfer_status^.connection_entry_p^.connection_attributes.
          connection_status.connection_state = rfc$terminated) THEN
      nad_index := data_transfer_status^.connection_entry_p^.
            connection_descriptor.nad_index;
      rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
      rfp$queue_request(nad_index, 1, rfc$unit_request,
          rfc$rk_receive_data, data_transfer_status, unit_request, status);
      IF NOT status.normal THEN
        terminate_transfer_request (status, data_transfer_status);
      ELSE
        data_transfer_status^.total_blocks_queued := blocks_to_add;
        data_transfer_status^.next_to_queue_abn := data_transfer_status^.current_abn;
        data_transfer_status^.next_to_queue_index := data_transfer_status^.current_fragment_index;
        data_transfer_status^.next_to_queue_offset := data_transfer_status^.current_fragment_offset;
      IFEND;
    ELSE
      set_connection_status (data_transfer_status^.connection_entry_p, status);
      rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
      terminate_transfer_request (status, data_transfer_status);
    IFEND;

  PROCEND start_receive_data;
?? TITLE := '    start_send_data', EJECT ??
  PROCEDURE start_send_data (VAR data_transfer_status: ^rft$data_transfer_status;
        data_length: rft$data_length;
    VAR status: ost$status);


{
{     The purpose of this procedure is to allocate any necessary buffers
{     and initialize the send data pp unit request.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies the parameters for
{       the data send operation. A NIL pointer is returned if an error has occurred
{       and the transfer was terminated.
{
{     DATA_LENGTH: (input) This parameter specifies the total data length for this
{       request.
{
{     STATUS: (output) A value of normal is returned if the send data request
{       has been successfully initiated.
{


    VAR
      blocks_to_add: rft$outstanding_blocks,
      nad_index: rft$local_nads,
      unit_request: ^SEQ ( * );


    data_transfer_status^.present_r1_out_ptr := rfc$cbi_first_io_entry;
    data_transfer_status^.block_descriptor_in := 1;
    data_transfer_status^.block_descriptor_out := 1;
    data_transfer_status^.next_wired_buffer_in := 1;
    data_transfer_status^.next_wired_buffer_out := 1;
    data_transfer_status^.data_exhausted := FALSE;
    data_transfer_status^.next_to_advise_out_index := data_transfer_status^.next_to_queue_index;
    data_transfer_status^.next_to_advise_out_offset :=
          data_transfer_status^.next_to_queue_offset;
    data_transfer_status^.next_to_advise_in_index := data_transfer_status^.next_to_queue_index;
    data_transfer_status^.next_to_advise_in_offset :=
          data_transfer_status^.next_to_queue_offset;
    data_transfer_status^.complete_index := data_transfer_status^.next_to_queue_index;
    data_transfer_status^.complete_offset := data_transfer_status^.next_to_queue_offset;
    data_transfer_status^.switch_to_wired_buffers := FALSE;
    data_transfer_status^.reserved_buffer_list := NIL;
    data_transfer_status^.block_descriptors := NIL;
    data_transfer_status^.header_buffers := NIL;
    data_transfer_status^.maximum_outstanding_blocks := rfc$max_outstanding_blocks;

    {  Start the disk processing to minimize future page faulting.
    {  WARNING - 'data_transfer_status^.block_decriptors' must equal the NIL value.

    advise_out_in (data_transfer_status, status);
    IF NOT status.normal THEN
      terminate_transfer_request (status, data_transfer_status);
      EXIT start_send_data;
    IFEND;

    IF data_transfer_status^.network_wired_data THEN
      allocate_network_wired_buffers (data_transfer_status, data_length, status);
      IF NOT status.normal THEN
        terminate_transfer_request (status, data_transfer_status);
        EXIT start_send_data;
      IFEND;
    ELSE
      ALLOCATE  data_transfer_status^.header_buffers:
            [ 1 .. data_transfer_status^.maximum_outstanding_blocks ]
            IN nav$network_wired_heap^;
    IFEND;

    ALLOCATE data_transfer_status^.block_descriptors:
          [ 1 .. data_transfer_status^.maximum_outstanding_blocks ]
          IN osv$task_private_heap^;

    PUSH unit_request: [[rft$logical_commands, boolean, rft$path_identifier,
          BOOLEAN,
                { intermediate response flag }
          rft$command_entry,
                { block count }
          REP data_transfer_status^.maximum_outstanding_blocks OF rft$command_entry,
                { fragment count }
          REP (data_transfer_status^.maximum_outstanding_blocks * 4) OF rft$io_fragment]];
                { assume maximum of 4 fragments per block }
    RESET unit_request;
    build_transfer_request_header (data_transfer_status, rfc$rm_eor, unit_request, status);
    IF NOT status.normal THEN
      terminate_transfer_request (status, data_transfer_status);
      EXIT  start_send_data;
    IFEND;

    blocks_to_add := data_transfer_status^.maximum_outstanding_blocks;
    add_blocks_to_request (data_transfer_status, TRUE, blocks_to_add,
          unit_request, status);
    IF NOT status.normal THEN
      terminate_transfer_request (status, data_transfer_status);
      EXIT start_send_data;
    IFEND;

    rfp$lock_table (data_transfer_status^.connection_entry_p^.lock);
    IF data_transfer_status^.connection_entry_p^.connection_attributes.
          connection_status.connection_state = rfc$connected THEN
      nad_index := data_transfer_status^.connection_entry_p^.
            connection_descriptor.nad_index;
      rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
      rfp$queue_request(nad_index, 1, rfc$unit_request,
          rfc$rk_send_data, data_transfer_status, unit_request, status);
      IF NOT status.normal THEN
        terminate_transfer_request (status, data_transfer_status);
      ELSE
        data_transfer_status^.total_blocks_queued := blocks_to_add;
        data_transfer_status^.next_to_queue_abn := data_transfer_status^.current_abn;
        data_transfer_status^.next_to_queue_index := data_transfer_status^.current_fragment_index;
        data_transfer_status^.next_to_queue_offset := data_transfer_status^.current_fragment_offset;
      IFEND;
    ELSE
      set_connection_status (data_transfer_status^.connection_entry_p, status);
      rfp$unlock_table (data_transfer_status^.connection_entry_p^.lock);
      terminate_transfer_request (status, data_transfer_status);
    IFEND;

  PROCEND start_send_data;
?? TITLE := '    rfp$store', EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$store (
        connection_identifier: amt$file_identifier;
        file_attributes: rft$change_attributes;
    VAR status: ost$status);

*copyc rfh$store

?? NEWTITLE := '      terminate_store - condition handler', EJECT ??
    PROCEDURE terminate_store (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sfsa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);


      CASE condition.selector OF
      = mmc$segment_access_condition, pmc$system_conditions =
        IF connection_entry_p <> NIL THEN
          rfp$unlock_table (connection_entry_p^.lock);
        IFEND;
        osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
              condition_status);
        EXIT rfp$store;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          osp$set_status_from_condition (rfc$product_id, condition, sfsa, status,
                condition_status);
          EXIT rfp$store;
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;
    PROCEND terminate_store;
?? OLDTITLE, EJECT ??

    VAR
      connection_entry_p: ^rft$connection_entry;


    connection_entry_p := NIL;
    osp$establish_condition_handler (^terminate_store, FALSE);
    status.normal := TRUE;

    get_exclusive_to_cid (connection_identifier, connection_entry_p, status);
    IF NOT status.normal THEN
      EXIT rfp$store;
    IFEND;
    merge_change_attributes (^connection_entry_p^.connection_attributes,
          ^file_attributes, status);
    rfp$unlock_table (connection_entry_p^.lock);

  PROCEND rfp$store;
?? TITLE := '    suspend_data_transfer', EJECT ??
  PROCEDURE [INLINE]  suspend_data_transfer(current_request: ^rft$outstanding_requests;
    VAR status: ost$status);


{     The purpose of this procedure is to suspend the data transfer on
{     a connection when a NAD resource limit is reached.  The PP request
{     is removed from the unit queue and the number of requests posted
{     to the NAD is decremented.  It is assumed that the resource limit is
{     going to be of sufficient duration to warrant removing the request
{     from the unit request queue.
{
{     CURRENT_REQUEST: (input) This parameter specifies the request to
{       remove from the unit queue.
{
{     STATUS: (output) This parameter returns the result of the procedure.
{       A status of normal indicates the procedure completed normally.



    rfp$delink_request (current_request^.request_id, status);
    rfp$lock_table (rfv$status_table.lock);
    rfv$status_table.local_nads^[current_request^.request_id.ring_3_id.nad].requests_posted :=
      rfv$status_table.local_nads^[current_request^.request_id.ring_3_id.nad].requests_posted -1;
    rfp$unlock_table (rfv$status_table.lock);
    current_request^.posted := FALSE;

  PROCEND suspend_data_transfer;
?? TITLE := '    switch_to_wired_buffers', EJECT ??
  PROCEDURE switch_to_wired_buffers (data_transfer_status: ^rft$data_transfer_status;
    VAR status: ost$status);

{
{     The purpose of this routine is to change the data transfer mode from
{     using unwired buffers to using network wired buffers.  Any structures
{     allocated and used only during unwired transfers are released and the
{     necessy buffers to transfer in network wired mode are allocated.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies a pointer to
{       the data transfer parameters.
{
{     STATUS: (output) This parameter returns the status of the request.
{       A status of normal indicates that the switch was successfully made.



    VAR
      current_fragment: rft$data_fragment_count,
      current_offset: rft$data_length,
      data_length: rft$data_length;

    status.normal := TRUE;
    data_transfer_status^.next_wired_buffer_out := 1;
    data_transfer_status^.next_wired_buffer_in := 1;
    data_transfer_status^.switch_to_wired_buffers := FALSE;
    data_transfer_status^.network_wired_data := TRUE;

    FREE data_transfer_status^.header_buffers IN nav$network_wired_heap^;
    current_fragment := data_transfer_status^.next_to_queue_index;
    current_offset := data_transfer_status^.next_to_queue_offset;
    data_length := 0;
    WHILE current_fragment <= UPPERBOUND(data_transfer_status^.data_area^) DO
      data_length := data_length + data_transfer_status^.data_area^[current_fragment].length -
            current_offset;
      current_offset := 0;
      current_fragment := current_fragment + 1;
    WHILEND;
    allocate_network_wired_buffers (data_transfer_status, data_length, status);

  PROCEND switch_to_wired_buffers;
?? TITLE := '    terminate_async_activity', EJECT ??
  PROCEDURE terminate_async_activity (requests: rft$set_of_async_activities;
        connection_name: fst$path_handle_name);


{     The purpose of this procedure is to terminate the asynchronous activities
{     that are specified.  To do this the outstanding request queue is scanned
{     and any requests that do not have an error already set and that match
{     the requests to terminate are told to terminate.  These requests will
{     then terminate when any outstanding PP requests complete.
{
{     REQUESTS: (input) This parameter specifies a set of activities that are
{       to be terminated.
{
{     CONNECTION_NAME: (input) This parameter specifies the connection file to
{       terminate the requests for.



    VAR
      current_request: ^rft$outstanding_requests,
      data_transfer_status: ^rft$data_transfer_status,
      process_pp_responses: boolean;


    process_pp_responses := FALSE;
    current_request := rfv$outstanding_requests;
    WHILE current_request <> NIL DO
      IF (current_request^.request_kind = rfc$rk_send_data) OR
         (current_request^.request_kind = rfc$rk_receive_data) THEN
        data_transfer_status := current_request^.request_status;
        IF (data_transfer_status^.connection_name = connection_name) AND
           data_transfer_status^.previous_error.normal THEN
          CASE data_transfer_status^.transfer_kind OF
          = rfc$tk_send_data =
            IF (rfc$aa_send_data IN requests) OR
               (rfc$aa_all_async_activities IN requests) THEN
              osp$set_status_abnormal (rfc$product_id, rfe$async_req_terminated,
                    'Send data', data_transfer_status^.previous_error);
              osp$append_status_parameter (osc$status_parameter_delimiter, connection_name,
                    data_transfer_status^.previous_error);
              IF current_request^.waiting_event <> NIL THEN
                rfp$lock_table (rfv$rhfam_event_table.lock);
                IF current_request^.waiting_event^.event_occurred_type = rfc$eot_no_event THEN
                  current_request^.waiting_event^.event_occurred_type := rfc$eot_async_terminated;
                  process_pp_responses := TRUE;
                IFEND;
                rfp$unlock_table (rfv$rhfam_event_table.lock);
              IFEND;
            IFEND;
          = rfc$tk_receive_data =
            IF (rfc$aa_receive_data IN requests) OR
               (rfc$aa_all_async_activities IN requests) THEN
              osp$set_status_abnormal (rfc$product_id, rfe$async_req_terminated,
                    'Receive data', data_transfer_status^.previous_error);
              osp$append_status_parameter (osc$status_parameter_delimiter, connection_name,
                    data_transfer_status^.previous_error);
              IF current_request^.waiting_event <> NIL THEN
                rfp$lock_table (rfv$rhfam_event_table.lock);
                IF current_request^.waiting_event^.event_occurred_type = rfc$eot_no_event THEN
                  current_request^.waiting_event^.event_occurred_type := rfc$eot_async_terminated;
                  process_pp_responses := TRUE;
                IFEND;
                rfp$unlock_table (rfv$rhfam_event_table.lock);
              IFEND;
            IFEND;
          CASEND;
        IFEND;
      IFEND;
      current_request := current_request^.next_entry;
    WHILEND;

    IF process_pp_responses THEN
      rfp$process_pp_response_flag (rfc$pp_response_available);
    IFEND;

  PROCEND terminate_async_activity;
?? TITLE := '    terminate_transfer_request', EJECT ??
  PROCEDURE terminate_transfer_request (
        status: ost$status;
    VAR data_transfer_status: ^rft$data_transfer_status);

{
{     The purpose of this procedure is to terminate an active data transfer
{     process. This routine updates the connection table entry from the
{     data transfer status block, releases any transfer buffers and sets
{     the activity status complete parameter.
{
{     DATA_TRANSFER_STATUS: (input) This parameter specifies a pointer
{       to the data transfer parameters.
{
{     STATUS: (input) This parameter specifies the ending status of the
{       data transfer.  It is returned to the data transfer initiator in
{       the activity status parameter.
{



    VAR
      activity_status_p: ^ost$activity_status,
      buffer_count: rft$buffer_count,
      bytes_transferred: rft$bytes_transferred,
      bytes_transferred_p: ^rft$bytes_transferred,
      connection_entry_p: ^rft$connection_entry,
      end_of_message: boolean,
      end_of_message_p: ^boolean,
      local_nad_index: rft$local_nads,
      transfer_kind: rft$transfer_kinds;



    IF data_transfer_status^.block_descriptors <> NIL THEN
      FREE data_transfer_status^.block_descriptors IN osv$task_private_heap^;
    IFEND;
    IF data_transfer_status^.network_wired_data THEN
      buffer_count := data_transfer_status^.reserved_buffer_count;
      IF data_transfer_status^.reserved_buffer_list <> NIL THEN
        rfp$release_wired_buffers(data_transfer_status^.reserved_buffer_list^, buffer_count);
        FREE data_transfer_status^.reserved_buffer_list IN osv$task_private_heap^;
      IFEND;
    ELSE
      IF data_transfer_status^.header_buffers <> NIL THEN
        FREE data_transfer_status^.header_buffers IN nav$network_wired_heap^;
      IFEND;
    IFEND;

    local_nad_index := 0;
    connection_entry_p := data_transfer_status^.connection_entry_p;
    transfer_kind := data_transfer_status^.transfer_kind;
    bytes_transferred := data_transfer_status^.bytes_transferred;
    bytes_transferred_p :=data_transfer_status^.data_transferred;
    activity_status_p := data_transfer_status^.activity_status;
    rfp$lock_table (connection_entry_p^.lock);
    IF connection_entry_p^.connection_attributes.connection_status.connection_state =
          rfc$connected THEN
      local_nad_index := connection_entry_p^.connection_descriptor.nad_index;
      IF data_transfer_status^.outstanding_control_messages <> NIL THEN
        queue_control_messages (local_nad_index, data_transfer_status^.
              outstanding_control_messages);
      IFEND;
      IF NOT (status.normal) AND (status.condition = rfe$connection_terminated) THEN
        connection_entry_p^.connection_attributes.connection_status.connection_state :=
              rfc$terminated;
        connection_entry_p^.connection_attributes.connection_status.reason_for_termination :=
              data_transfer_status^.reason_for_termination;
      IFEND;
    ELSE
      delete_control_messages (data_transfer_status^.outstanding_control_messages);
    IFEND;
    CASE transfer_kind OF
    = rfc$tk_send_data =
      CASE data_transfer_status^.transmission_mode OF
      = rfc$record_mode =
        connection_entry_p^.connection_attributes.outgoing_record_abn :=
              data_transfer_status^.next_to_queue_abn;
      = rfc$message_mode =
        connection_entry_p^.connection_attributes.outgoing_message_count :=
              connection_entry_p^.connection_attributes.outgoing_message_count +
              data_transfer_status^.outgoing_message_count;
      CASEND;
      connection_entry_p^.connection_statistics.bytes_sent :=
            connection_entry_p^.connection_statistics.bytes_sent  +
            bytes_transferred;
      connection_entry_p^.send_request_active := FALSE;
    = rfc$tk_receive_data =
      CASE data_transfer_status^.transmission_mode OF
      = rfc$record_mode =
        connection_entry_p^.connection_attributes.incoming_record_abn :=
               data_transfer_status^.next_to_queue_abn;
        IF data_transfer_status^.complete_message_received THEN
          connection_entry_p^.connection_attributes.file_mark_received :=
                data_transfer_status^.file_mark_received;
        IFEND;
      = rfc$message_mode =
        ;
      CASEND;
      end_of_message := data_transfer_status^.complete_message_received;
      end_of_message_p := data_transfer_status^.end_of_message_p;
      connection_entry_p^.connection_statistics.bytes_received :=
            connection_entry_p^.connection_statistics.bytes_received  +
            bytes_transferred;
      connection_entry_p^.receive_request_active := FALSE;
    CASEND;

    wakeup_waiting_tasks (connection_entry_p);
    rfp$unlock_table (connection_entry_p^.lock);
    FREE data_transfer_status IN osv$task_private_heap^;
    IF local_nad_index <> 0 THEN
      rfp$lock_table (rfv$status_table.lock);
      IF rfv$status_table.system_task_is_up THEN
        CASE transfer_kind OF
        = rfc$tk_receive_data =
          rfv$status_table.local_nads^[local_nad_index].statistics.bytes_received :=
                rfv$status_table.local_nads^[local_nad_index].statistics.bytes_received +
                bytes_transferred;
        = rfc$tk_send_data =
          rfv$status_table.local_nads^[local_nad_index].statistics.bytes_sent :=
                rfv$status_table.local_nads^[local_nad_index].statistics.bytes_sent +
                bytes_transferred;
        CASEND;
      IFEND;
      rfp$unlock_table (rfv$status_table.lock);
    IFEND;
    bytes_transferred_p^ := bytes_transferred;
    IF transfer_kind = rfc$tk_receive_data THEN
      end_of_message_p^ := end_of_message;
    IFEND;
    IF NOT status.normal THEN
      activity_status_p^.status := status;
    IFEND;
    activity_status_p^.complete := TRUE;

  PROCEND terminate_transfer_request;
?? TITLE := '    rfp$test_set_table_lock', EJECT ??
  PROCEDURE [XDCL] rfp$test_set_table_lock (VAR lock: ost$signature_lock;
    VAR locked: boolean);

{
{     The purpose of this procedure is to test and set a signature
{     lock on a RHFAM ring 3 table. If the table is not locked,
{     the lock is set. If the table is locked, control is returned
{     without setting the lock.
{
{     LOCK: (input,output)  This parameter specifies the signature lock to
{       obtain.
{
{     LOCKED: (output) This parameter returns a TRUE value if the
{       signature lock was set by this call.  A value of FALSE is
{       returned if the lock was previously set.
{


    osp$begin_subsystem_activity;
    osp$test_set_job_sig_lock(lock, locked);
    IF NOT locked THEN
      osp$end_subsystem_activity;
    IFEND;

  PROCEND rfp$test_set_table_lock;
?? TITLE := '    update_connection_status', EJECT ??
  PROCEDURE update_connection_status (
        connection_entry_p: ^rft$connection_entry;
    VAR input_available: boolean;
    VAR connection_unlocked: boolean;
    VAR status: ost$status);

{
{     The purpose of this procedure is to update the connection status
{     of the specified connection.  The present state of the connection
{     is compared with the present state of the connection in the NAD.
{     If the connection state in the connection entry does not match the
{     connection state as reported by the NAD hardware, the connection
{     entry state is updated. The connection entry must be locked
{     upon entry to this routine.  On exit the calling routine must
{     check to see if the connection entry has been unlocked.
{
{     CONNECTION_ENTRY_P: (input) This parameter specifies the pointer
{       to the connection table entry to get the status for.
{
{     INPUT_AVAILABLE: (output) This parameter returns a flag giving the
{       current status of input available on the connection.  A value of
{       true indicates that input is available.  A connection in a state
{       of terminated by peer termination may still have input that can
{       be received by an application.
{
{     CONNECTION_UNLOCKED: (output) This parameter returns the present
{       lock status of the connection entry.  If a pp request is needed
{       to update the connection status, the connection will be unlocked.
{
{     STATUS: (output) This parameter returns the result of the request.


    VAR
      connection_status: ^rft$connection_table_entry;


      status.normal := TRUE;
      input_available := FALSE;
      connection_unlocked := FALSE;
      CASE connection_entry_p^.connection_attributes.connection_status.
            connection_state OF
      = rfc$connected =
        connection_status := ^rfv$status_table.local_nads^[connection_entry_p^.connection_descriptor.
               nad_index].connection_table^[connection_entry_p^.connection_descriptor.
               network_path];
        CASE connection_status^.connection_state OF
        = rfc$ps_established =
          CASE connection_status^.connection_clarifier OF
          = rfc$pce_normal, rfc$pce_local_host_uninformed =
            input_available := (connection_status^.input_available) OR
                  (connection_entry_p^.residue_input_data <> NIL);
            connection_entry_p^.connection_attributes.connection_status.
                  input_available := input_available;
            connection_entry_p^.connection_attributes.connection_status.
                  output_below_threshold := connection_status^.output_below_threshold;
          = rfc$pce_incoming_disconnect =
            input_available := (connection_status^.input_available) OR
                  (connection_entry_p^.residue_input_data <> NIL);
            connection_entry_p^.connection_attributes.connection_status.
                   connection_state := rfc$terminated;
            connection_entry_p^.connection_attributes.connection_status.
                   reason_for_termination := rfc$peer_termination;
          ELSE
            get_path_status(connection_entry_p, status);
            connection_unlocked := TRUE;
          CASEND;
        ELSE
          get_path_status(connection_entry_p, status);
          connection_unlocked := TRUE;
        CASEND;
      = rfc$terminated =
        IF connection_entry_p^.connection_attributes.connection_status.
            reason_for_termination = rfc$peer_termination THEN
          connection_status := ^rfv$status_table.local_nads^[connection_entry_p^.connection_descriptor.
                 nad_index].connection_table^[connection_entry_p^.connection_descriptor.
                 network_path];
          CASE connection_status^.connection_state OF
          = rfc$ps_established =
            CASE connection_status^.connection_clarifier OF
            = rfc$pce_incoming_disconnect =
              input_available := (connection_status^.input_available) OR
                    (connection_entry_p^.residue_input_data <> NIL);
            ELSE
              ;
            CASEND;
          ELSE
            ;
          CASEND;
        IFEND;
      = rfc$outgoing_connect_active =
        connection_status := ^rfv$status_table.local_nads^[connection_entry_p^.connection_descriptor.
               nad_index].connection_table^[connection_entry_p^.connection_descriptor.
               network_path];
        CASE connection_status^.connection_state OF
        = rfc$ps_established =
          CASE connection_status^.connection_clarifier OF
          = rfc$pce_normal, rfc$pce_local_host_uninformed =
            connection_entry_p^.connection_attributes.connection_status.
                  connection_state := rfc$connected;
            connection_entry_p^.connection_attributes.connection_status.
                  input_available := connection_status^.input_available;
            connection_entry_p^.connection_attributes.connection_status.
                  output_below_threshold := connection_status^.output_below_threshold;
            rfp$lock_table (rfv$status_table.lock);
            connection_entry_p^.selected_path^.disabled := FALSE;
            connection_entry_p^.selected_path^.failure_count := 0;
            rfp$unlock_table (rfv$status_table.lock);
          = rfc$pce_incoming_disconnect =
            connection_entry_p^.connection_attributes.connection_status.
                   connection_state := rfc$terminated;
            connection_entry_p^.connection_attributes.connection_status.
                   reason_for_termination := rfc$peer_termination;
            input_available := connection_status^.input_available;
          ELSE
            get_path_status(connection_entry_p, status);
            connection_unlocked := TRUE;
          CASEND;
        = rfc$ps_connecting =
          CASE connection_status^.connection_clarifier OF
          = rfc$pcc_remote_reject, rfc$pcc_local_reject, rfc$pcc_network_reject =
            get_path_status(connection_entry_p, status);
            connection_unlocked := TRUE;
          ELSE
            ;     {still connecting}
          CASEND;
        ELSE
          get_path_status(connection_entry_p, status);
          connection_unlocked := TRUE;
        CASEND;
      = rfc$incoming_connect_active =
        ;
      = rfc$connect_rejected =
        ;
      = rfc$switch_offered =
        ;
      = rfc$switch_accepted =
        ;
      = rfc$system_task_shutdown =
        ;
      = rfc$local_nad_failure =
        ;
      = rfc$system_interrupt =
        ;
      ELSE
        rfp$unlock_table (connection_entry_p^.lock);
        connection_unlocked := TRUE;
        osp$set_status_abnormal (rfc$product_id, rfe$unexpected_connection_state,
              connection_entry_p^.connection_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $integer(connection_entry_p^.connection_attributes.connection_status.
              connection_state), 10, FALSE, status);
      CASEND;

  PROCEND update_connection_status;
?? TITLE := '    rfp$unlock_table ', EJECT ??
  PROCEDURE [XDCL] rfp$unlock_table (VAR lock: ost$signature_lock);

{
{     The purpose of this procedure is to release a global lock on a RHFAM
{     ring 3 table.  This procedure decrements the system buffer locked
{     count that was incremented when the table was locked.
{
{     LOCK: (input,output)  This parameter specifies the signature lock to
{       obtain.
{


    osp$clear_job_signature_lock(lock);
    osp$end_subsystem_activity;

  PROCEND rfp$unlock_table;
?? TITLE := '    wakeup_accept_switch_waits', EJECT ??
  PROCEDURE wakeup_accept_switch_waits (source_job: jmt$system_supplied_name);

{     The purpose of this procedure is to send a ready task to all tasks
{     that are waiting for switch offer accepts under the specified
{     job name.
{
{     SOURCE_JOB: (input) This parameter specifies the source job of the
{       connection that is being accepted.
{

    VAR
      current_wait: ^rft$rhfam_event_table_entry,
      ignore_status: ost$status;


    rfp$lock_table (rfv$rhfam_event_table.lock);
    current_wait := rfv$rhfam_event_table.first_entry;
  /wakeup_waits/
    WHILE current_wait <> NIL DO
      IF current_wait^.event_kind = rfc$ana_await_switch_accept THEN
        IF source_job = current_wait^.asa_source_job THEN
          current_wait^.event_occurred_type := rfc$eot_switch_accept;
          pmp$ready_task (current_wait^.task_id, ignore_status);
        IFEND;
      IFEND;
      current_wait := current_wait^.next_entry;
    WHILEND /wakeup_waits/;
    rfp$unlock_table (rfv$rhfam_event_table.lock);

  PROCEND wakeup_accept_switch_waits;
?? TITLE := '    wakeup_wait_switch_offers', EJECT ??
  PROCEDURE wakeup_wait_switch_offers (application_name: rft$application_name);


{     The purpose of this procedure is to ready any tasks that are waiting
{     for a connection switch offer.  All tasks that are waiting for
{     the specified application name are sent a ready task.
{
{     APPLICATION_NAME: (input) This parameter specifies the application
{       name of the switched connection.



    VAR
      current_wait: ^rft$rhfam_event_table_entry,
      ignore_status: ost$status;


    rfp$lock_table (rfv$rhfam_event_table.lock);
    current_wait := rfv$rhfam_event_table.first_entry;
  /wakeup_waits/
    WHILE current_wait <> NIL DO
      IF current_wait^.event_kind = rfc$ana_await_switch_offer THEN
        IF application_name = current_wait^.aSo_application_name THEN
          current_wait^.event_occurred_type := rfc$eot_switch_offer;
          pmp$ready_task (current_wait^.task_id, ignore_status);
        IFEND;
      IFEND;
      current_wait := current_wait^.next_entry;
    WHILEND /wakeup_waits/;
    rfp$unlock_table (rfv$rhfam_event_table.lock);

  PROCEND wakeup_wait_switch_offers;
?? TITLE := '    wakeup_waiting_tasks', EJECT ??
  PROCEDURE wakeup_waiting_tasks (connection_entry_p: ^rft$connection_entry);

{     The purpose of this procedure is to wake up any tasks that have
{     been suspended due to active send or receive data requests.  This
{     routine issues a pmp$ready task to all waiting tasks and frees all
{     the waiting task entries.
{
{     CONNECTION_ENTRY_P: (input,output) This parameter specifies the
{       connection entry to wake up the tasks for.



    VAR
      current_waiting_task: ^rft$waiting_task_queue,
      ignore_status: ost$status,
      next_waiting_task: ^rft$waiting_task_queue;


    next_waiting_task := connection_entry_p^.waiting_tasks;
    IF next_waiting_task <> NIL THEN
      connection_entry_p^.waiting_tasks := NIL;
      WHILE next_waiting_task <> NIL DO
        current_waiting_task := next_waiting_task;
        pmp$ready_task (current_waiting_task^.global_task_id, ignore_status);
        next_waiting_task := current_waiting_task^.next_entry;
        FREE current_waiting_task IN nav$network_paged_heap^;
      WHILEND;
    IFEND;

  PROCEND wakeup_waiting_tasks;
?? OLDTITLE ??
?? OLDTITLE ??
MODEND rfm$external_interface;
