*copyc osd$default_pragmats
?? TITLE := 'RHFAM/VE : Process PP Response System Flag : R23D' ??
?? NEWTITLE := '  Common Decks' ??
MODULE rfm$process_pp_response_flag;
?? EJECT ??
*copyc rft$r1_interface_defs
?? EJECT ??
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc cml$rhfam_failure_data
*copyc cml$rhfam_network_failure
*copyc cmp$return_desc_data_by_lun_lpn
*copyc dpp$put_critical_message
*copyc fsp$close_file
*copyc i#move
*copyc jmp$submit_job
*copyc nav$network_paged_heap
*copyc nav$network_wired_heap
*copyc osp$establish_condition_handler
*copyc osp$set_status_from_condition
*copyc osp$set_status_abnormal
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osv$task_private_heap
*copyc oss$task_private
*copyc oss$job_paged_literal
*copyc pfp$attach
*copyc pmp$continue_to_cause
*copyc pmp$exit
*copyc pmp$log
*copyc pmp$get_executing_task_gtid
*copyc pmp$get_microsecond_clock
*copyc pmp$generate_unique_name
*copyc pmp$ready_task
*copyc rfd$mc_initialization_prams
*copyc rfd$nad_general_status
*copyc rfd$path_status_table
*copyc rfe$condition_codes
*copyc rft$network_block_protocol
*copyc rfp$release_wired_buffers
*copyc rfp$move_data_from_wired_buffs
*copyc rfp$change_nad_status
*copyc rfp$common_internal_procs
*copyc rfp$continue_data_transfer
*copyc rfp$delink_request
*copyc rfp$re_issue_request
*copyc rfp$set_connection_entry_p
*copyc rfp$lock_table
*copyc rfp$unlock_table
*copyc rfp$post_request
*copyc rfp$remove_connection
*copyc rfv$status_table
*copyc rfv$pp_interface_error
*copyc rfv$rhfam_event_table
*copyc rfv$rhfam_server_table
*copyc rfv$status_response_pending
*copyc rfv$system_task_id
*copyc sfp$emit_statistic
*copyc syp$cycle
*copyc tmv$null_global_task_id
?? TITLE := '  Global Variables' ??
?? EJECT ??

  VAR
      rfv$failure_data_symptoms: [XDCL, READ, oss$job_paged_literal]
        ARRAY [rft$failure_data_symptoms] OF STRING(25) :=
        ['FUNCTION TIMEOUT', 'CHANNEL ACTIVATE FAILED', 'CHANNEL HUNG EMPTY','PRIME FLAG TIMEOUT',
         'FLAG FUNCTION TIMEOUT', 'ABNORMAL NAD RESPONSE', 'NAD HARDWARE ABNORMAL',
         'INPUT TERMINATED EARLY', 'OUTPUT TERMINATED EARLY', 'CHANNEL PARITY ERROR',
         'UNIVERSAL COMMAND TIMEOUT', 'MEMORY ERROR ADDRESS', 'CONCURRENT CHANNEL ERROR'];

  VAR
      rfv$network_break_rc: [XDCL, READ, oss$job_paged_literal]
        ARRAY [rfc$ctnrc_no_response .. rfc$ctnrc_connection_limit_ntn] OF STRING(25) :=
        ['no answer from remote NAD', 'local TCU/TCI problem    ', 'bad remote NAD response  ',
         'remote NAD not running   ', 'remote NAD not responding', 'remote NAD hardware error',
         'unknown network failure  ', 'unknown network failure  ', 'long haul NAD lost link  ',
         'long haul NAD cannot link', 'unknown network failure  ', 'unknown network failure  ',
         'unknown network failure  ', 'unknown network failure  ', 'unknown network failure  ',
         'unknown network failure  ', 'remote NAD autoloaded    ', 'remote NAD saturated     ',
         'TCUs do not validate     ', 'path purged by remote NAD', 'remote host is inactive  ',
         'microcode level mismatch ', 'unknown network failure  ', 'unknown network failure  ',
         'NTN NAD is saturated     ', 'NTN NAD found invalid TCU', 'NTN NAD routing undefined',
         'NTN to NTN is not allowed', 'NTN link is saturated    '];

  VAR
      rfv$network_failure_symptoms: [XDCL, READ, oss$job_paged_literal]
        ARRAY [rft$network_failure_symptoms] OF STRING(25) :=
        ['CONNECTION FAILURE', 'NOT BEING USED'];

  VAR
      rfv$outstanding_requests: [XDCL, oss$task_private] ^rft$outstanding_requests := NIL;

  VAR
      rfv$request_names: [XDCL, READ, #GATE, oss$job_paged_literal]
        ARRAY [rft$nad_request_kinds] OF  STRING(25) :=
        ['local NAD load', 'local NAD status', 'local NAD dump', 'local NAD general status',
         'send data', 'receive data', 'request connection', 'accept connect request',
         'reject connect request', 'obtain connect request', 'remote NAD dump',
         'remote NAD load', 'remote NAD general status', 'path status', 'disconnect path',
         'send control message', 'receive control message', 'resume PP', 'idle PP'];

{    There is a fair amount of code in this module and RFM$EXTERNAL_INTERFACE under the
{    auspicies of synchronizing with status.  The status is a local copy of the NAD
{    path control table (actually only a subset of the NAD table).  This table is maintained
{    by the system task and is updated each time the NAD has encountered a path state change.
{    This table is also updated by other tasks during connection establishment and termination.
{    These asynchronous updates must be synchronized with the system task update.  There is
{    some additional synchronization within the system task, since PP responses are not
{    guaranteed to be processed in the order of their completion.  This code is somewhat
{    complex and may lead to a new design somewhere down the road.  For now, the coder should
{    be aware of these synchronization requirements and deal with them appropriately.

  TYPE
     rft$clear_connection_id = RECORD
       next_entry: ^rft$clear_connection_id,
       local_nad: rft$local_nads,
       connection_id: rft$concurrent_connections,
       sequence_number: INTEGER,
     RECEND;

  VAR
     rfv$clear_connection_id: [oss$task_private] ^rft$clear_connection_id := NIL;
?? TITLE := '  RFP$PROCESS_PP_RESPONSE_FLAG' ??
?? EJECT ??
  PROCEDURE  [XDCL] rfp$process_pp_response_flag(flag_id: ost$system_flag);

*copyc rfh$process_pp_response_flag
?? NEWTITLE := '    RESPONSE_PROCESSOR_CLEANUP' ??
?? EJECT ??
    PROCEDURE  response_processor_cleanup(condition: pmt$condition;
                                          condition_descriptor: ^pmt$condition_information;
                                          sfsa: ^ost$stack_frame_save_area;
                                      VAR condition_status: ost$status);


    {     This condition handler is designed to prevent normal occurrances from
    {     from causing unwanted RHFAM/VE side-affects.
    {
    {     1)  The user has passed a bad return parameter.  Segment access or
    {         possible system condition (ring 0 error).   The current request
    {         is removed (the ring 1 buffer is removed, if present).  The error condition
    {         is logged and the outer routine is EXITed.
    {
    {     2)  The system has just completed a recovery deadstart.  The request
    {         being process is removed from the list and the condition is
    {         sent to the next processor.  If control returns after the
    {         continue to cause routine is called, the outer routine is EXITed.
    {
    {     3)  All other conditions are logged.  (NOTE - the interactive condition
    {         should never be seen by this procedure).

      VAR
          status,
          ignore_status: ost$status,
          run_time_error: ^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);
        IF  condition_status.normal  THEN
          IF current_request^.request_kind <> rfc$rk_disconnect_path THEN

{     Note - During the disconnect path function, this code is running under file management code
{       that prevents the logging of error messages because the local file table is locked.

            rfp$log_the_status(status);
          IFEND;
        IFEND;
        IF  current_request <> NIL  THEN
          IF  (current_request^.request_id.ring_1_id.address <> NIL)  AND
              (current_request^.posted)  THEN
            rfp$delink_request(current_request^.request_id, ignore_status);
          IFEND;
          remove_outstanding_request(current_request);
        IFEND;
        pmp$exit (condition_status);

      = pmc$user_defined_condition =
        IF  condition.user_condition_name = 'OSC$JOB_RECOVERY'  THEN
          osp$set_status_from_condition(rfc$product_id, condition, sfsa, status, condition_status);
          IF  condition_status.normal  THEN
            IF current_request^.request_kind <> rfc$rk_disconnect_path THEN

{     Note - During the disconnect path function, this code is running under file management code
{       that prevents the logging of error messages because the local file table is locked.

              rfp$log_the_status(status);
            IFEND;
          IFEND;
          IF  current_request <> NIL  THEN
            remove_outstanding_request(current_request);
          IFEND;
          pmp$continue_to_cause(pmc$execute_standard_procedure, condition_status);

          {  We cannot continue after a recovery deadstart.  This routine relies to heavily  }
          {  on the network and mainframe global segments.                                   }

          pmp$exit (condition_status);
        ELSEIF condition.user_condition_name = 'CYE$RUN_TIME_CONDITION' THEN

          {  Here if this exception is due to a run time condition (ie. a range
          {  checking error). Attempt to write a message to the system dayfile.

          IF current_request^.request_kind <> rfc$rk_disconnect_path THEN
            run_time_error := condition_descriptor;
            rfp$log_the_status(run_time_error^);
          IFEND;
          condition_status.normal := TRUE;
        ELSE
          condition_status.normal := TRUE;
        IFEND;
      ELSE
        osp$set_status_from_condition(rfc$product_id, condition, sfsa, status, condition_status);
        IF  condition_status.normal  THEN
          IF current_request^.request_kind <> rfc$rk_disconnect_path THEN
            rfp$log_the_status(status);
          IFEND;
        IFEND;
        condition_status.normal := TRUE;
      CASEND;

    PROCEND response_processor_cleanup;
?? OLDTITLE ??
?? EJECT ??

    VAR
        release_request: BOOLEAN,
        transfer_status: rft$transfer_state,
        command_buff: ^ARRAY [rft$command_entry] OF rft$command,
        current_request: ^rft$outstanding_requests;

    current_request := rfv$outstanding_requests;

    {  NOTE - the condition handler must be established after current_request is initialized.

    osp$establish_condition_handler(^response_processor_cleanup, FALSE);
    WHILE  current_request <> NIL  DO
      IF current_request^.request_id.ring_1_id.address <> NIL THEN
        command_buff := #LOC(current_request^.request_id.ring_1_id.address^.command_buffer);
      ELSE
        command_buff := NIL;
      IFEND;
      IF  current_request^.request_id.ring_3_id.location.kind = rfc$pp_request  THEN
        IF  current_request^.request_id.ring_1_id.address^.response_posted  THEN
          rfp$completed_pp_request(command_buff, current_request);
          remove_outstanding_request(current_request);
        ELSE
          current_request := current_request^.next_entry;
        IFEND;

      ELSE  {assume unit request}
        IF NOT current_request^.processing_request THEN
          IF  (current_request^.waiting_event = NIL) AND
              (current_request^.request_id.ring_1_id.address^.response_posted)  THEN
            rfp$completed_unit_request(command_buff, current_request);
          ELSEIF  (current_request^.request_kind = rfc$rk_send_data)  OR
                  (current_request^.request_kind = rfc$rk_receive_data)  THEN
            release_request := FALSE;
            IF  current_request^.waiting_event = NIL  THEN
              transfer_status.transfer_state := rfc$ts_intermediate;
              rfp$continue_data_transfer(command_buff, transfer_status, current_request, release_request);
            ELSE
              IF  current_request^.waiting_event^.event_occurred_type <> rfc$eot_no_event  THEN
                transfer_status.transfer_state := rfc$ts_resource_limit_change;
                rfp$continue_data_transfer(command_buff, transfer_status, current_request, release_request);
              IFEND;
            IFEND;
            IF  release_request  THEN
              remove_outstanding_request(current_request);
            ELSE
              current_request := current_request^.next_entry;
            IFEND;
          ELSE
            current_request := current_request^.next_entry;
          IFEND;
        ELSE
          current_request := current_request^.next_entry;
        IFEND;
      IFEND;
    WHILEND;

  PROCEND rfp$process_pp_response_flag;
?? NEWTITLE := '    RFP$COMPLETED_PP_REQUEST' ??
?? EJECT ??
  PROCEDURE rfp$completed_pp_request(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                 VAR current_request: ^rft$outstanding_requests);

{    The purpose of this procedure is to process a completed pp request.
{
{    command_buff: (input) This parameter points to the command buffer of the request.
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.

    VAR
        response_value: integer,
        request_id: rft$request_identifier,
        status: ost$status;

    status.normal := TRUE;
    request_id := current_request^.request_id;

    CASE  command_buff^[rfc$cbi_pp_request].pp_function_code  OF

    = rfc$pp_idle =
      IF  request_id.ring_1_id.address^.response.response_code.primary_response = ioc$normal_response  THEN
        rfv$status_table.local_nads^[request_id.ring_3_id.nad].pp[request_id.ring_3_id.pp].pp_state :=
          rfc$pps_idle;
      ELSE
        osp$set_status_abnormal(rfc$product_id, rfe$unexpected_response, 'pp idle request', status);
        response_value := $INTEGER(request_id.ring_1_id.address^.response.response_code.primary_response);
        osp$append_status_integer(osc$status_parameter_delimiter, response_value, 10, FALSE, status);
      IFEND;

    = rfc$pp_resume =
      IF  request_id.ring_1_id.address^.response.response_code.primary_response = ioc$normal_response  THEN
        rfv$status_table.local_nads^[request_id.ring_3_id.nad].pp[request_id.ring_3_id.pp].pp_state :=
          rfc$pps_normal;
      ELSE
        osp$set_status_abnormal(rfc$product_id, rfe$unexpected_response, 'pp resume request', status);
        response_value := $INTEGER(request_id.ring_1_id.address^.response.response_code.primary_response);
        osp$append_status_integer(osc$status_parameter_delimiter, response_value, 10, FALSE, status);
      IFEND;

    ELSE
      osp$set_status_abnormal(rfc$product_id, rfe$unknown_request, 'pp', status);
      osp$append_status_integer(osc$status_parameter_delimiter,
        command_buff^[rfc$cbi_pp_request].pp_function_code, 16, TRUE, status);
    CASEND;

    IF  NOT status.normal  THEN
      rfp$log_the_status(status);
    IFEND;
    rfp$delink_request(request_id, status);
    IF  NOT status.normal  THEN
      rfp$log_the_status(status);
    IFEND;

  PROCEND rfp$completed_pp_request;
?? TITLE := '    REMOVE_OUTSTANDING_REQUEST' ??
?? EJECT ??
  PROCEDURE  remove_outstanding_request(VAR request: ^rft$outstanding_requests);

{    The purpose of this procedure is to remove a request identifier from the
{    outstanding request queue.
{
{    request: (input,output) This parameter points to the entry to be removed
{      from the list.  Upon exit this parameter points to the next entry in the
{      outstanding request list.

    VAR
        next_request,
        previous_request: ^rft$outstanding_requests;

    IF  request^.posted  THEN
      rfp$lock_table(rfv$status_table.lock);
      rfv$status_table.local_nads^[request^.request_id.ring_3_id.nad].requests_posted :=
        rfv$status_table.local_nads^[request^.request_id.ring_3_id.nad].requests_posted - 1;
      rfp$unlock_table(rfv$status_table.lock);
    IFEND;
    IF  rfv$outstanding_requests^.request_id.ring_3_id.entry = request^.request_id.ring_3_id.entry  THEN
      rfv$outstanding_requests := request^.next_entry;
    ELSE
      previous_request := rfv$outstanding_requests;
      WHILE  previous_request^.next_entry^.request_id.ring_3_id.entry <> request^.request_id.ring_3_id.entry
                                                                                                          DO
        previous_request := previous_request^.next_entry;
      WHILEND;
      previous_request^.next_entry := request^.next_entry;
    IFEND;
    next_request := request^.next_entry;

    FREE  request  IN  osv$task_private_heap^;

    request := next_request;

  PROCEND remove_outstanding_request;
?? OLDTITLE ??
?? TITLE := '  RFP$COMPLETED_UNIT_REQUEST' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$completed_unit_request(command_buff:^ARRAY[rft$command_entry] OF rft$command;
                                          VAR current_request: ^rft$outstanding_requests);

{    The purpose of this procedure is to process a completed unit request.
{
{    command_buff: (input) This parameter points to the command buffer of the corresponding request.
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.

    VAR
        recoverable: boolean,
        pp_response: ^iot$pp_response,
        detailed_status: ^rft$detailed_status,
        release_request: boolean,
        abnormal_stat: iot$abnormal_status,
        abnormal_status: ^rft$abnormal_status,
        response_value,
        state_value: integer,
        transfer_status: rft$transfer_state,
        ignore_status,
        status: ost$status;

    status.normal := TRUE;
    release_request := TRUE;
    detailed_status := ^current_request^.request_id.ring_1_id.address^.detailed_status;
    pp_response := ^current_request^.request_id.ring_1_id.address^.response;

  /main_section/
    BEGIN

      IF    (pp_response^.response_code.primary_response <> ioc$normal_response)  AND
            (pp_response^.response_code.primary_response <> ioc$abnormal_response)  THEN
        rfp$delink_request(current_request^.request_id, ignore_status);
        osp$set_status_abnormal(rfc$product_id, rfe$unexpected_response, 'unit request', status);
        response_value := $INTEGER(pp_response^.response_code.primary_response);
        osp$append_status_integer(osc$status_parameter_delimiter, response_value, 10, FALSE, status);
        EXIT  /main_section/;
      IFEND;

      CASE  current_request^.request_kind  OF

      = rfc$rk_local_nad_load =

        process_local_load_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_local_nad_dump =

        process_local_dump_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_local_nad_status =

        process_nad_status_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_request_connection =

        process_req_connect_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_obtain_connect_request =

        process_obt_connect_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_accept_connect_request =

        process_acc_connect_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_reject_connect_request =

        process_rej_connect_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_send_data, rfc$rk_receive_data =

        abnormal_stat := pp_response^.abnormal_status;
        abnormal_status := #LOC(abnormal_stat);
        IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN
          transfer_status.transfer_state := rfc$ts_normal;
        ELSEIF  (abnormal_status^.invalid_status_value) AND
                (detailed_status^.last_mc_status.response = rfc$nr_transfer_not_ready) AND
                (NOT detailed_status^.last_mc_status.hardware_fault)  THEN
          transfer_status.transfer_state := rfc$ts_resource_limit;
        ELSEIF  ((detailed_status^.last_mc_status.response = rfc$nr_abort) OR
                 (detailed_status^.last_mc_status.response = rfc$nr_flush) OR
                 (detailed_status^.last_mc_status.response = rfc$nr_disconnected) OR
                 (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge))
              AND (abnormal_status^.invalid_status_value)
              AND (NOT detailed_status^.last_mc_status.hardware_fault) THEN
          transfer_status.transfer_state := rfc$ts_broken;
        ELSE
          IF  abnormal_status^.alert_condition_encountered  THEN
            log_alert_condition(pp_response^.alert_conditions, pp_response^.alert_mask,
              current_request^.request_kind, transfer_status, ignore_status);
          ELSE
            log_nad_error(pp_response, detailed_status, current_request^.request_kind,
              current_request^.retry_count, current_request^.request_id.ring_3_id.nad,
              command_buff^[rfc$cbi_unit_request_2].lc_path_id, FALSE, recoverable);
            IF  recoverable  THEN
              current_request^.retry_count := current_request^.retry_count + 1;
              transfer_status.transfer_state := rfc$ts_retryable_error;
            ELSE
              transfer_status.transfer_state := rfc$ts_fatal_error;
            IFEND;
          IFEND;
        IFEND;
        rfp$continue_data_transfer(command_buff, transfer_status, current_request, release_request);
        IF  release_request  THEN
          rfp$delink_request(current_request^.request_id, ignore_status);
        IFEND;

      = rfc$rk_disconnect_path =

        rfp$process_disconnect_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_path_status =

        process_path_status_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_send_control_mess =

        process_send_ctrl_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      = rfc$rk_receive_control_mess =

        process_rec_ctrl_response(command_buff, pp_response, detailed_status, current_request,
          release_request, status);

      ELSE   { end unit request CASE statement }
        rfp$delink_request(current_request^.request_id, ignore_status);
        osp$set_status_abnormal(rfc$product_id, rfe$unknown_request, 'unit', status);
        osp$append_status_integer(osc$status_parameter_delimiter,
          command_buff^[rfc$cbi_unit_request_1].lc_function_code, 16, TRUE, status);
      CASEND;

    END /main_section/;

    IF  NOT status.normal  THEN
      IF current_request^.request_kind <> rfc$rk_disconnect_path THEN

{     Note - During the disconnect path function, this code is running under file management code
{       that prevents the logging of error messages because the local file table is locked.

        rfp$log_the_status(status);
      IFEND;
    IFEND;

    IF  release_request  THEN
      remove_outstanding_request(current_request);
    ELSE
      current_request := current_request^.next_entry;
    IFEND;

  PROCEND rfp$completed_unit_request;
?? NEWTITLE := '    PROCESS_LOCAL_LOAD_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_local_load_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                         pp_response: ^iot$pp_response;
                                         detailed_status: ^rft$detailed_status;
                                     VAR current_request: ^rft$outstanding_requests;
                                     VAR release_request: BOOLEAN;
                                     VAR status: ost$status);

{    The purpose of this procedure is to process a completed local NAD load request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.

    CONST
        rfc$180_device_type = 212,
        rfc$current_microcode_revision = 0,
        rfc$nt_starting_address = 66;

    VAR
        request_info: ^SEQ(*),
        mc_status: ^rft$nad_general_status,
        actual_memory,
        unused_memory: rft$nad_memory_size,
        nad_address: rft$nad_address,
        tcu_enabled: rft$tcu_mask,
        device_type,
        revision_level: 0..0ff(16),
        tcu_index: rfc$min_tcu .. rfc$max_tcu,
        recoverable: boolean,
        current_time: integer,
        response_value,
        state_value: integer,
        load_request_status: ^rft$load_dump_status,
        nad_index: rft$local_nads,
        local_nad: ^rft$local_nad_entry,
        local_status,
        ignore_status: ost$status;

    load_request_status := current_request^.request_status;
    nad_index := current_request^.request_id.ring_3_id.nad;
    local_nad := ^rfv$status_table.local_nads^[nad_index];

  /main_section/
    BEGIN

      { Response will be abnormal at beginning of NAD test, if 32K/48K NAD memory size.

      IF  (pp_response^.response_code.primary_response = ioc$normal_response)  OR
            ( (load_request_status^.state = rfc$lt_mem_test_read)  AND
              (load_request_status^.nt_data = rfc$nt_inc_addr) )  THEN

        IF  load_request_status^.state = rfc$ls_get_mc_status  THEN
          mc_status := #LOC(command_buff^[rfc$cbi_general_buffer]);
{         IF  load_request_status^.initial_phase  THEN
            actual_memory := mc_status^.actual_memory_size;
            unused_memory := mc_status^.unused_memory;
{         ELSE
            nad_address := mc_status^.nad_address;
            tcu_enabled := mc_status^.actual_tcus;
            revision_level := mc_status^.microcode_revision_level;
            device_type := mc_status^.device_interface_type;
{         IFEND;
        IFEND;

        rfp$delink_request(current_request^.request_id, status);
        IF  NOT status.normal  THEN
          EXIT  /main_section/;
        IFEND;

        CASE  load_request_status^.state  OF

        = rfc$lt_mem_test_begin, rfc$lt_mem_test_write, rfc$lt_mem_test_read =

          IF  load_request_status^.state = rfc$lt_mem_test_begin  THEN
            load_request_status^.state := rfc$lt_mem_test_write;
            load_request_status^.current_nad_address := rfc$nt_starting_address;
            load_request_status^.nt_data := rfc$nt_inc_addr;
            IF load_request_status^.mem_test_first_pass THEN
              load_request_status^.nt_length := (((rfc$max_nad_memory_size * 2) DIV 6) * 6) + 6;
            IFEND;
            load_request_status^.nt_offset := load_request_status^.current_nad_address * 2;
          IFEND;

          IF  load_request_status^.state = rfc$lt_mem_test_read  THEN
            IF  (load_request_status^.nt_length - load_request_status^.nt_offset)  > 0  THEN
              check_data_in_wired_buffs(load_request_status^.buffer_list^,
                load_request_status^.number_of_buffers, nad_index, load_request_status, status);
              IF  NOT status.normal  THEN
                EXIT  /main_section/;
              IFEND;
            IFEND;
            IF  load_request_status^.state = rfc$lt_mem_test_write  THEN
              load_request_status^.current_nad_address := rfc$nt_starting_address;
              load_request_status^.nt_offset := load_request_status^.current_nad_address * 2;
            ELSEIF  load_request_status^.state = rfc$lt_mem_test_begin  THEN
              rfp$change_nad_status(local_nad^.logical_unit_number, rfc$es_on);
              EXIT  /main_section/;
            ELSE
              IF  load_request_status^.state = rfc$ls_begin_load  THEN
                load_request_status^.current_nad_address := 0;
              IFEND;
            IFEND;
          IFEND;

          IF  load_request_status^.state = rfc$lt_mem_test_write  THEN
            IF  (load_request_status^.nt_length - load_request_status^.nt_offset)  > 0  THEN
              put_data_in_wired_buffs(load_request_status^.buffer_list^,
                load_request_status^.number_of_buffers, load_request_status, status);
              IF  NOT status.normal  THEN
                EXIT  /main_section/;
              IFEND;
            ELSE  { NAD memory written
              load_request_status^.state := rfc$lt_mem_test_read;
              load_request_status^.current_nad_address := rfc$nt_starting_address;
              load_request_status^.nt_offset := load_request_status^.current_nad_address * 2;
              IF  (load_request_status^.mem_test_first_pass)  AND
                  (load_request_status^.nt_length > (rfc$max_nad_memory_size * 2))  THEN
                load_request_status^.nt_length := (((rfc$max_nad_memory_size * 2) DIV 6) * 6);
              IFEND;
            IFEND;
          IFEND;

        = rfc$ls_begin_load, rfc$ls_sending_microcode, rfc$ls_sending_init_prams =

          {        Continue load request      }

        = rfc$ls_go_sent =

          load_request_status^.state := rfc$ls_get_mc_status;

        = rfc$ls_get_mc_status =

{ The following clause is commented out as a temporary fix to the problem of
{ 2 times too much memory being requested of the NAD when the default memory size
{ is set to 0ff(16). 0ff(16) indicates that the amount of NAD memory available
{ should be determined and the appropriate amount used.
{
{         IF  load_request_status^.initial_phase  THEN
{           load_request_status^.initial_phase := FALSE;
{           load_request_status^.state := rfc$ls_begin_load;
{           load_request_status^.time_of_first_go := 0;
{           load_request_status^.current_nad_address := 0;
{           unused_memory := (actual_memory - load_request_status^.init_prams.memory_size) + unused_memory;
{           load_request_status^.init_prams.memory_size := actual_memory;
{           load_request_status^.init_prams.type_1_buff_count :=
{             load_request_status^.init_prams.type_1_buff_count + (unused_memory DIV
{             (rfc$nad_type_1_buff_lgth + rfc$nad_type_1_header_lgth));
{           unused_memory := unused_memory MOD (rfc$nad_type_1_buff_lgth + rfc$nad_type_1_header_lgth);
{           load_request_status^.init_prams.control_messages :=
{             load_request_status^.init_prams.control_messages +
{             (unused_memory DIV rfc$nad_ctrl_mess_buff_lgth);
{         ELSE
            rfp$lock_table(rfv$status_table.lock);
            IF  local_nad^.current_status.device_status = rfc$es_down  THEN
              local_nad^.current_status.device_status := rfc$es_on;
            IFEND;
            local_nad^.address := nad_address;
            FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
              IF  (local_nad^.current_status.tcu_status[tcu_index] <> rfc$es_off)  THEN
                IF  tcu_enabled[tcu_index]  THEN
                  local_nad^.current_status.tcu_status[tcu_index] := rfc$es_on;
                ELSE
                  local_nad^.current_status.tcu_status[tcu_index] := rfc$es_down;
                IFEND;
              IFEND;
            FOREND;
            local_nad^.maintenance_status.reloads_performed :=
              local_nad^.maintenance_status.reloads_performed + 1;
            rfp$unlock_table(rfv$status_table.lock);
            IF  local_nad^.address <> local_nad^.defined_address  THEN
              osp$set_status_abnormal(rfc$product_id, rfe$nad_address_mismatch, local_nad^.name,
                local_status);
              osp$append_status_integer(osc$status_parameter_delimiter, local_nad^.defined_address,
                16, TRUE, local_status);
              osp$append_status_integer(osc$status_parameter_delimiter, local_nad^.address, 16, TRUE,
                local_status);
              rfp$log_the_status(local_status);
            IFEND;
            IF  device_type <> rfc$180_device_type  THEN
              osp$set_status_abnormal(rfc$product_id, rfe$nad_device_type_mismatch, local_nad^.name,
                local_status);
              osp$append_status_integer(osc$status_parameter_delimiter, device_type,
                10, FALSE, local_status);
              osp$append_status_integer(osc$status_parameter_delimiter, rfc$180_device_type, 10,
                FALSE, local_status);
              rfp$log_the_status(local_status);
            IFEND;
            IF  revision_level <> rfc$current_microcode_revision  THEN
              osp$set_status_abnormal(rfc$product_id, rfe$nad_microcode_mismatch, local_nad^.name,
                local_status);
              osp$append_status_integer(osc$status_parameter_delimiter, revision_level,
                10, FALSE, local_status);
              osp$append_status_integer(osc$status_parameter_delimiter, rfc$current_microcode_revision, 10,
                FALSE, local_status);
              rfp$log_the_status(local_status);
            IFEND;
            FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
              IF  (local_nad^.trunk_control_units[tcu_index] <> '') AND
                  (local_nad^.current_status.tcu_status[tcu_index] = rfc$es_down)  THEN
                osp$set_status_abnormal(rfc$product_id, rfe$nad_tcu_unavailable, local_nad^.name,
                  local_status);
                osp$append_status_parameter(osc$status_parameter_delimiter,
                  local_nad^.trunk_control_units[tcu_index], local_status);
                osp$append_status_integer(osc$status_parameter_delimiter, tcu_index, 10, FALSE,
                  local_status);
                rfp$log_the_status(local_status);
              IFEND;
            FOREND;
            osp$set_status_abnormal(rfc$product_id, rfe$microcode_loaded, 'SUCCEEDED', status);
            osp$append_status_parameter(osc$status_parameter_delimiter, 'local NAD:  ', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
              local_nad^.name, status);
{         IFEND;

        ELSE

          osp$set_status_abnormal(rfc$product_id, rfe$abnormal_state, 'load request', status);
          state_value := $INTEGER(load_request_status^.state);
          osp$append_status_integer(osc$status_parameter_delimiter, state_value, 10, FALSE, status);
        CASEND;

      ELSE  {  ioc$abnormal_response  }

        IF  (load_request_status^.state = rfc$ls_go_sent)
            AND (pp_response^.response_code.secondary_response = 1) {detailed status appended}
            AND (detailed_status^.last_mc_status.response = 0)
            AND (NOT detailed_status^.last_mc_status.hardware_fault)  THEN
          pmp$get_microsecond_clock(current_time, ignore_status);
          IF  (current_time - load_request_status^.time_of_first_go) < (10*1000*1000)  THEN { 10 seconds }
            rfp$delink_request(current_request^.request_id, status);
            EXIT  /main_section/;
          IFEND;
        IFEND;

        log_nad_error(pp_response, detailed_status, current_request^.request_kind,
          current_request^.retry_count, nad_index, 0, TRUE, recoverable);
        rfp$delink_request(current_request^.request_id, status);
        IF  NOT status.normal  THEN
          EXIT  /main_section/;
        IFEND;
        IF  recoverable  THEN
          current_request^.retry_count := current_request^.retry_count + 1;
          IF  (load_request_status^.state = rfc$lt_mem_test_begin)   OR
              (load_request_status^.state = rfc$lt_mem_test_write)   OR
              (load_request_status^.state = rfc$lt_mem_test_read)  THEN
            load_request_status^.state := rfc$lt_mem_test_begin;
          ELSE
            load_request_status^.state := rfc$ls_begin_load;
          IFEND;
          load_request_status^.time_of_first_go := 0;
          load_request_status^.current_nad_address := 0;
        ELSE
          rfv$status_table.local_nads^[nad_index].maintenance_status.reload_failed := TRUE;
          osp$set_status_abnormal(rfc$product_id, rfe$microcode_loaded, 'FAILED', status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'local NAD: ', status);
          osp$append_status_parameter(osc$status_parameter_delimiter,
            rfv$status_table.local_nads^[nad_index].name, status);
        IFEND;
      IFEND;

    END /main_section/;

    IF  status.normal  THEN

      {   NOTE - status is abnormal for failures and for completed local loads }

      PUSH  request_info : [[REP  2*rfc$command_buffer_size OF rft$command]];
      RESET request_info;
      rfp$build_load_request(load_request_status, request_info, status);
      IF  status.normal  THEN
        rfp$post_request(request_info, current_request^.request_id, status);
        IF  status.normal  THEN
          release_request := FALSE;
        IFEND;
      IFEND;
    IFEND;

    IF  NOT status.normal  THEN
      IF  (load_request_status^.state = rfc$lt_mem_test_begin)   OR
          (load_request_status^.state = rfc$lt_mem_test_write)   OR
          (load_request_status^.state = rfc$lt_mem_test_read)  THEN
        local_nad^.maintenance_status.reload_failed := TRUE;
      IFEND;
      rfv$status_table.local_nads^[nad_index].maintenance_status.test_requested := FALSE;
      fsp$close_file(load_request_status^.mc_file_id, ignore_status);
      amp$return(load_request_status^.mc_lfn, ignore_status);
      rfp$release_wired_buffers(load_request_status^.buffer_list^, load_request_status^.number_of_buffers);
      FREE  load_request_status^.buffer_list  IN  osv$task_private_heap^;
      FREE  load_request_status  IN  osv$task_private_heap^;
    IFEND;

  PROCEND process_local_load_response;
 ?? NEWTITLE := '      PUT_DATA_IN_WIRED_BUFFS' ??
 ?? EJECT ??
  PROCEDURE [INLINE] put_data_in_wired_buffs(VAR buffer_list: rft$buffer_list;
                                                 buffer_count: rft$buffer_count;
                                             VAR load_request_status: ^rft$load_dump_status;
                                             VAR status: ost$status);

{    This procedure stores test data in network wired buffers.
{
{    buffer_list: (input,output) This parameter specifies the list of wired buffers to write.
{
{    buffer_count: (input) This parameter specifies the number of wired buffers.
{
{    load_request_status: (input,output). This parameter points to the load_dump_status block,
{      which contains the current offset of the next portion of test data. On exit, the offset is updated.


    VAR
        buffer_ptr: ^CELL,
        bytes_remaining: rft$bytes_transferred,
        current_buffer: rft$buffer_count,
        dest_ptr: ^rft$nad_memory_size,
        index: integer,
        nad_addr: rft$nad_memory_size,
        nad_data: rft$nad_memory_size,
        nad_data_inc: integer,
        room_in_buffer: rft$bytes_transferred;


    nad_addr := ((load_request_status^.nt_offset DIV 2) MOD (rfc$max_nad_memory_size+1));
    bytes_remaining := load_request_status^.nt_length - load_request_status^.nt_offset;

    CASE  load_request_status^.nt_data OF

    = rfc$nt_inc_addr =
      nad_data := nad_addr;
      nad_data_inc := 1;

    = rfc$nt_dec_addr =
      nad_data := 0ffff(16) - nad_addr;
      nad_data_inc := -1;

    = rfc$nt_con_5555 =
      nad_data := 05555(16);
      nad_data_inc := 0;

    = rfc$nt_con_aaaa =
      nad_data := 0aaaa(16);
      nad_data_inc := 0;

    ELSE
      nad_data := 0;
      nad_data_inc := 0;

    CASEND;

    status.normal := TRUE;
    FOR current_buffer := 1 TO buffer_count DO
      buffer_list[current_buffer].byte_count := 0;
    FOREND;

    current_buffer := 1;
    WHILE  (bytes_remaining > 0) AND
           (current_buffer <= buffer_count) DO
      room_in_buffer := buffer_list[current_buffer].length;
      IF  room_in_buffer > bytes_remaining  THEN
        room_in_buffer := bytes_remaining;
      IFEND;

      FOR  index := 0 TO ((room_in_buffer DIV 2) - 1) DO
        buffer_ptr := i#ptr((index * 2), buffer_list[current_buffer].buffer);
        dest_ptr := buffer_ptr;
        dest_ptr^ := nad_data;
        nad_data := ((nad_data + nad_data_inc) MOD (rfc$max_nad_memory_size+1));
      FOREND;
      buffer_list[current_buffer].byte_count := room_in_buffer;
      bytes_remaining := bytes_remaining - room_in_buffer;
      current_buffer := current_buffer + 1;
    WHILEND;
    load_request_status^.nt_offset := load_request_status^.nt_length - bytes_remaining;
  PROCEND put_data_in_wired_buffs;
?? TITLE := '      CHECK_DATA_IN_WIRED_BUFFS' ??
?? EJECT ??
  PROCEDURE [INLINE] check_data_in_wired_buffs(VAR buffer_list: rft$buffer_list;
                                                   buffer_count: rft$buffer_count;
                                                   nad_index: rft$local_nads;
                                               VAR load_request_status: ^rft$load_dump_status;
                                               VAR status: ost$status);

{    This procedure checks test data read from NAD memory into the network wired buffers.
{
{    buffer_list: (input,output) This parameter specifies the list of buffers to check.
{
{    buffer_count: (input) This parameter specifies the number of wired buffers.
{
{    nad_index: (input) This parameter specifies the local NAD that is being tested.
{
{    load_request_status: (input,output). This parameter points to the load-dump-status block,
{      which contains the current offset of the next portion of test data. On exit, the offset is updated.

    CONST
        nad_memory_bank_words = 4000(16);    { Number of 16-bit words }

    VAR
        buffer_ptr: ^CELL,
        bytes_remaining: rft$bytes_transferred,
        current_buffer: rft$buffer_count,
        data_in_buffer: rft$bytes_transferred,
        index: rft$bytes_transferred,
        nad_addr: rft$nad_memory_size,
        nad_data: rft$nad_memory_size,
        nad_data_inc: integer,
        source_ptr: ^rft$nad_memory_size;


    nad_addr := load_request_status^.nt_offset DIV 2;
    bytes_remaining := load_request_status^.nt_length - load_request_status^.nt_offset;

    CASE  load_request_status^.nt_data OF

    = rfc$nt_inc_addr =
      nad_data := nad_addr;
      nad_data_inc := 1;

    = rfc$nt_dec_addr =
      nad_data := 0ffff(16) - nad_addr;
      nad_data_inc := -1;

    = rfc$nt_con_5555 =
      nad_data := 05555(16);
      nad_data_inc := 0;

    = rfc$nt_con_aaaa =
      nad_data := 0aaaa(16);
      nad_data_inc := 0;

    ELSE
      nad_data := 0;
      nad_data_inc := 0;

    CASEND;

    status.normal := TRUE;
    current_buffer := 1;
    /check_data/
    WHILE  (bytes_remaining > 0) AND
           (current_buffer <= buffer_count) AND
           (buffer_list[current_buffer].byte_count > 0)  DO
      data_in_buffer := buffer_list[current_buffer].byte_count;
      IF  data_in_buffer > bytes_remaining  THEN
        data_in_buffer := bytes_remaining;
      IFEND;

      FOR  index := 0 TO ((data_in_buffer DIV 2) - 1) DO
        buffer_ptr := i#ptr((index * 2), buffer_list[current_buffer].buffer);
        source_ptr := buffer_ptr;
        IF  nad_data = source_ptr^  THEN
          nad_data := ((nad_data + nad_data_inc) MOD (rfc$max_nad_memory_size+1));
        ELSE
          IF  (load_request_status^.mem_test_first_pass)  AND
              (((nad_data - 1) MOD nad_memory_bank_words) >= 0FFB(16))  THEN
            load_request_status^.nt_length := (((nad_data - 1) * 2) DIV 6) * 6;
            bytes_remaining := 0;
            EXIT /check_data/;
          ELSE
            log_nad_memory_error(nad_index, (nad_addr+index), nad_data, source_ptr^);
            osp$set_status_abnormal(rfc$product_id, rfe$test_nad_failure,
              rfv$status_table.local_nads^[nad_index].name, status);
            rfp$log_the_status(status);
            osp$set_status_abnormal(rfc$product_id, rfe$microcode_loaded, 'FAILED', status);
            osp$append_status_parameter(osc$status_parameter_delimiter, 'local NAD:  ', status);
            osp$append_status_parameter(osc$status_parameter_delimiter,
            rfv$status_table.local_nads^[nad_index].name, status);
            RETURN;
          IFEND;
        IFEND;
      FOREND;
      buffer_list[current_buffer].byte_count := 0;
      bytes_remaining := bytes_remaining - data_in_buffer;
      current_buffer := current_buffer + 1;
      nad_addr := nad_addr + (data_in_buffer DIV 2);
    WHILEND/check_data/;

    IF  bytes_remaining > 0  THEN
      load_request_status^.nt_offset := load_request_status^.nt_length - bytes_remaining;
    ELSE
      IF load_request_status^.mem_test_first_pass THEN
        load_request_status^.mem_test_first_pass := FALSE;
        load_request_status^.state := rfc$lt_mem_test_begin;
      ELSE
        load_request_status^.state := rfc$lt_mem_test_write;

        CASE  load_request_status^.nt_data OF
        = rfc$nt_inc_addr =
          load_request_status^.nt_data := rfc$nt_dec_addr;

        = rfc$nt_dec_addr =
          load_request_status^.nt_data := rfc$nt_con_5555;

        = rfc$nt_con_5555 =
          load_request_status^.nt_data := rfc$nt_con_aaaa;


        ELSE {testing done
          load_request_status^.state := rfc$ls_begin_load;
        CASEND;
      IFEND;
    IFEND;

  PROCEND check_data_in_wired_buffs;
?? TITLE := '            LOG_NAD_MEMORY_ERROR' ??
?? EJECT ??
  PROCEDURE  log_nad_memory_error(nad_index: rft$local_nads;
                                  mem_addr: rft$nad_memory_size;
                                  mem_val1: rft$nad_memory_size;
                                  mem_val2: rft$nad_memory_size);

{    This procedure generates and logs a message indicating a NAD memory test error.
{
{    The message has the form "device-identifier*UF*MEMORY ERROR ADDRESS xxxx EXPECTED yyyy ACTUAL zzzz"
{      where device-identifier shows the system and NAD names, IOU, PP, and channel numbers (decimal),
{      and xxxx, yyyy, and zzzz (hexidecimal) show the address, expected and actual contents of the
{      word in NAD memory.
{
{    nad_index: (input) This parameter specifies the local NAD that failed.
{
{    mem_addr: (input) This parameter specifies the faulty NAD memory address.
{
{    mem_val1: (input) This parameter specifies the value expected.
{
{    mem_val2: (input) This parameter specifies the value actually read.


    VAR
        concurrent_channel_flag: integer,
        counters: ^ARRAY [1..*] OF sft$counter,
        descriptor_data: ost$string,
        ignore: ost$status,
        iou_number: dst$iou_number,
        local_nad: ^rft$local_nad_entry,
        message: ^STRING(*),
        pp_number: 0..31,
        request_kind: rft$nad_request_kinds,
        severity_value: 0..4,
        str_len: integer,
        symptom: rft$failure_data_symptoms;

    symptom := rfc$memory_error_address;
    local_nad := ^rfv$status_table.local_nads^[nad_index];
    PUSH  counters : [1..15];
    cmp$return_desc_data_by_lun_lpn(local_nad^.logical_unit_number,
      local_nad^.pp[1].pp_number, iou_number, descriptor_data, pp_number);
    PUSH  message : [descriptor_data.size+4+20+31];
    message^(1,descriptor_data.size) := descriptor_data.value;
    message^(descriptor_data.size+1,4) := '*UF*';
    message^(descriptor_data.size+1+4,25) := rfv$failure_data_symptoms[symptom];
    stringrep(message^(descriptor_data.size+1+4+20,30), str_len, mem_addr:5:#(16),
      ' EXPECTED':9, mem_val1:5:#(16), ' ACTUAL':7, mem_val2:5:#(16));
    severity_value := 1;

    concurrent_channel_flag :=0;
    IF local_nad^.concurrent_channel THEN
      concurrent_channel_flag := 1*40(16);
    IFEND;
    counters^[1] := pp_number + concurrent_channel_flag + iou_number * 1000(16);
    counters^[2] := local_nad^.channel_number + concurrent_channel_flag + iou_number * 1000(16);
    counters^[3] := 0;
    counters^[4] := 0;
    counters^[5] := 1;     { $380-170 }
    counters^[6] := 0;
    counters^[7] := severity_value;
    counters^[8] := ORD(symptom);
    counters^[9] := 0;
    counters^[10] := 0;
    counters^[11] := 0;
    counters^[12] := 0;
    counters^[13] := 0ffff(16);
    counters^[14] := 0ffff(16);
    counters^[15] := 0;
    sfp$emit_statistic(cml$rhfam_failure_data, message^, counters, ignore);

  PROCEND log_nad_memory_error;
?? OLDTITLE ??
?? TITLE := '    PROCESS_LOCAL_DUMP_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_local_dump_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                         pp_response: ^iot$pp_response;
                                         detailed_status: ^rft$detailed_status;
                                     VAR current_request: ^rft$outstanding_requests;
                                     VAR release_request: BOOLEAN;
                                     VAR status: ost$status);

{    The purpose of this procedure is to process a completed local NAD dump request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.

    CONST
        nad_memory_bank_size = 4000(16)*2;   {  Number of 8-bit bytes  }

    VAR
        buffer_count,
        current_buffer: rft$buffer_count,
        buffer_size,
        byte_count: rft$bytes_transferred,
        current_command_index,
        last_command_index: rft$command_entry,
        current_bank: 0..4,
        current_location: INTEGER,
        request_info: ^SEQ(*),
        recoverable: boolean,
        dump_request_status: ^rft$load_dump_status,
        nad_index: rft$local_nads,
        segment_ptr: amt$segment_pointer,
        ignore_status: ost$status;

    dump_request_status := current_request^.request_status;
    nad_index := current_request^.request_id.ring_3_id.nad;

  /main_section/
    BEGIN
      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN

        rfp$delink_request(current_request^.request_id, status);
        IF  NOT status.normal  THEN
          EXIT  /main_section/;
        IFEND;
        byte_count := 0;
        FOR  current_buffer := 1  TO  dump_request_status^.buffers_in_use  DO
          byte_count := byte_count + dump_request_status^.buffer_list^[current_buffer].byte_count;
        FOREND;
        current_buffer := 1;
        rfp$move_data_from_wired_buffs(dump_request_status^.buffer_list^, dump_request_status^.mc_image,
          dump_request_status^.number_of_buffers, current_buffer, byte_count);
        IF  dump_request_status^.state <> rfc$ds_end_of_dump  THEN
          PUSH  request_info : [[REP  2*rfc$command_buffer_size OF rft$command]];
          RESET request_info;
          rfp$build_dump_request(dump_request_status, request_info, status);
          IF  status.normal  THEN
            rfp$post_request(request_info, current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
            IFEND;
          IFEND;
        IFEND;

      ELSE  {  ioc$abnormal_response  }

        {  determine the amount of NAD memory dumped.

        current_command_index := rfc$cbi_general_buffer;
        last_command_index := ((pp_response^.last_command - pp_response^.request_rma -
        #SIZE(rft$peripheral_request)) DIV 8) + 1;

        {  determine number of buffers completed.

        current_buffer := 1;
        byte_count := 0;
        WHILE  current_command_index <= last_command_index  DO
          IF  command_buff^[current_command_index].pc_function_code = rfc$pc_input_8_in_8_mode  THEN
            IF  current_command_index = last_command_index  THEN
              byte_count := byte_count + pp_response^.transfer_count;
            ELSE
              byte_count := byte_count + dump_request_status^.buffer_list^[current_buffer].byte_count;
              current_buffer := current_buffer + 1;
            IFEND;
          IFEND;
          current_command_index := current_command_index + 1;
        WHILEND;

        { determine if error occurred on a memory increment boundary.

        current_location := #OFFSET(dump_request_status^.mc_image) + byte_count;
        current_bank := current_location DIV nad_memory_bank_size;
        current_location := current_location MOD nad_memory_bank_size;

        { The PP attempts to read up to the nearest multiple of six to prevent channel errors.

        IF  (current_location <> 0) OR
            (current_bank = 0)  THEN

          {   IF error is not near a NAD memory boundary then log it.

          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, nad_index, 0, TRUE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          ELSE
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'fatal NAD error', status);
            osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_LOCAL_DUMP_RESPONSE',
              status);
          IFEND;
        IFEND;

        {  Move all data that has been successfully dumped to the buffer.

        current_buffer := 1;
        rfp$move_data_from_wired_buffs(dump_request_status^.buffer_list^, dump_request_status^.mc_image,
          dump_request_status^.number_of_buffers, current_buffer, byte_count);
        rfp$delink_request(current_request^.request_id, ignore_status);
      IFEND;

    END /main_section/;

    IF  (NOT status.normal)  OR  (release_request)  THEN
      segment_ptr.kind := amc$cell_pointer;
      segment_ptr.cell_pointer := dump_request_status^.mc_image;
      amp$set_segment_eoi(dump_request_status^.mc_file_id, segment_ptr, ignore_status);
      fsp$close_file(dump_request_status^.mc_file_id, ignore_status);
      amp$return(dump_request_status^.mc_lfn, ignore_status);
      rfp$release_wired_buffers(dump_request_status^.buffer_list^, dump_request_status^.number_of_buffers);
      FREE  dump_request_status^.buffer_list  IN  osv$task_private_heap^;
      FREE  dump_request_status  IN  osv$task_private_heap^;
    IFEND;

  PROCEND process_local_dump_response;
?? TITLE := '    PROCESS_NAD_STATUS_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_nad_status_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                         pp_response: ^iot$pp_response;
                                         detailed_status: ^rft$detailed_status;
                                     VAR current_request: ^rft$outstanding_requests;
                                     VAR release_request: BOOLEAN;
                                     VAR status: ost$status);

{    The purpose of this procedure is to process a completed local NAD status request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.

    VAR
        local_nad: ^rft$local_nad_entry,
        recoverable: BOOLEAN,
        connection_entry: ^rft$connection_table_entry,
        connection_status: ^PACKED ARRAY [rft$concurrent_connections] OF rft$nad_status_entry,
        largest_path_id,
        number_of_changes,
        path_id,
        con_index: rft$concurrent_connections,
        current_time: integer,
        nad_index: rft$local_nads,
        previous_connect_entry,
        connect_entry_to_free,
        current_connect_entry: ^rft$clear_connection_id,
        ignore_status: ost$status;

      nad_index := current_request^.request_id.ring_3_id.nad;

  /main_section/
      BEGIN

        local_nad := ^rfv$status_table.local_nads^[nad_index];
        IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN

          number_of_changes := pp_response^.transfer_count DIV #SIZE(rft$nad_status_entry);
          connection_status := #LOC(command_buff^[rfc$cbi_general_buffer]);
          largest_path_id := 0;
          rfp$lock_table(local_nad^.connection_table_lock);
          local_nad^.last_status_seq_number :=
            current_request^.request_id.ring_1_id.address^.response_seq_number;

        /update_connection_table/
          FOR  con_index := 0  TO  (number_of_changes-1)  DO
            path_id := connection_status^[con_index].path_identifier;

            {      This is a consistency check.

            IF  path_id > UPPERBOUND(local_nad^.connection_table^)  THEN
              EXIT /update_connection_table/;
            IFEND;
            connection_entry := ^local_nad^.connection_table^[path_id];

            {  This test is necessary because the NAD will pad the data to handle the assembly/disassembly
            {  cases.  The PAD is assumed to be binary zeroes.

            IF  (connection_status^[con_index].path_state = rfc$ps_unused)  AND
                (connection_status^[con_index].path_clarifier = rfc$pcu_empty)  THEN
              EXIT /update_connection_table/;
            IFEND;

            largest_path_id := path_id;
            connection_entry^.connection_state := connection_status^[con_index].path_state;
            connection_entry^.connection_clarifier := connection_status^[con_index].path_clarifier;
            connection_entry^.input_available := connection_status^[con_index].input_available;
            connection_entry^.output_below_threshold :=
              connection_status^[con_index].output_below_threshold;
          FOREND /update_connection_table/;
          local_nad^.current_max_connect_id := largest_path_id;
          IF  rfv$clear_connection_id <> NIL  THEN
            current_connect_entry := rfv$clear_connection_id;
            previous_connect_entry := NIL;
            REPEAT
              IF  nad_index = current_connect_entry^.local_nad  THEN
                IF  current_connect_entry^.sequence_number > local_nad^.last_status_seq_number  THEN
                  local_nad^.connection_table^[current_connect_entry^.connection_id].connection_state :=
                    rfc$ps_unused;
                  local_nad^.connection_table^[current_connect_entry^.connection_id].connection_clarifier :=
                    rfc$pcu_empty;
                IFEND;
                connect_entry_to_free := current_connect_entry;
                current_connect_entry := current_connect_entry^.next_entry;
                FREE  connect_entry_to_free  IN  osv$task_private_heap^;
                IF  previous_connect_entry = NIL  THEN
                  rfv$clear_connection_id := current_connect_entry;
                ELSE
                  previous_connect_entry^.next_entry := current_connect_entry;
                IFEND;
              ELSE
                previous_connect_entry := current_connect_entry;
                current_connect_entry := current_connect_entry^.next_entry;
              IFEND;
            UNTIL  current_connect_entry = NIL;
          IFEND;
          rfp$unlock_table(local_nad^.connection_table_lock);

          pmp$get_microsecond_clock(current_time, ignore_status);
          local_nad^.status_posted := FALSE;
          local_nad^.status_change_available := TRUE;
          local_nad^.last_status_change := current_time;

          rfp$delink_request(current_request^.request_id, status);

        ELSE  {  ioc$abnormal_response  }

          IF  rfv$clear_connection_id <> NIL  THEN
            current_connect_entry := rfv$clear_connection_id;
            previous_connect_entry := NIL;
            REPEAT
              IF  nad_index = current_connect_entry^.local_nad  THEN
                connect_entry_to_free := current_connect_entry;
                current_connect_entry := current_connect_entry^.next_entry;
                FREE  connect_entry_to_free  IN  osv$task_private_heap^;
                IF  previous_connect_entry = NIL  THEN
                  rfv$clear_connection_id := current_connect_entry;
                ELSE
                  previous_connect_entry^.next_entry := current_connect_entry;
                IFEND;
              ELSE
                previous_connect_entry := current_connect_entry;
                current_connect_entry := current_connect_entry^.next_entry;
              IFEND;
            UNTIL  current_connect_entry = NIL;
          IFEND;

          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, nad_index, 0, FALSE, recoverable);

          IF  NOT recoverable  THEN
            rfp$delink_request(current_request^.request_id, status);
            local_nad^.status_posted := FALSE;
          ELSE
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  NOT status.normal  THEN
              rfp$delink_request(current_request^.request_id, ignore_status);
              local_nad^.status_posted := FALSE;
            ELSE
              release_request := FALSE;
            IFEND;
          IFEND;
        IFEND;
     END /main_section/;

  PROCEND process_nad_status_response;
?? TITLE := '    PROCESS_REQ_CONNECT_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_req_connect_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                          pp_response: ^iot$pp_response;
                                          detailed_status: ^rft$detailed_status;
                                      VAR current_request: ^rft$outstanding_requests;
                                      VAR release_request: BOOLEAN;
                                      VAR status: ost$status);

{    The purpose of this procedure is to process a completed create connection request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.

    VAR
        response_seq_number: INTEGER,
        job_table_entry_p: ^rft$rhfam_job_table_entry,
        new_entry,
        recoverable: boolean,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        ignore_status: ost$status;


  /main_section/
    BEGIN

      connection_mgmt_status := current_request^.request_status;
      response_seq_number := current_request^.request_id.ring_1_id.address^.response_seq_number;

      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN

        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$synchronize_with_status(current_request^.request_id.ring_3_id.nad);
            rfp$lock_table(connection_mgmt_status^.connection^.lock);
            connection_mgmt_status^.connection^.connection_descriptor.network_path :=
              command_buff^[rfc$cbi_unit_request_2].lc_path_id;
            connection_mgmt_status^.connection^.active_pp_requests :=
              connection_mgmt_status^.connection^.active_pp_requests - 1;
            connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state :=
              rfc$outgoing_connect_active;

            {  This routine expects the connection entry to be locked upon entry.

            rfp$set_connection_entry_p(connection_mgmt_status^.connection, response_seq_number, status);

            {  and assumes the caller will release the lock upon exit.

            rfp$unlock_table(connection_mgmt_status^.connection^.lock);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
        FREE connection_mgmt_status IN osv$task_private_heap^;
        rfp$delink_request(current_request^.request_id, status);

      ELSE  {  ioc$abnormal_response  }

        IF  (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge)
            AND (NOT detailed_status^.last_mc_status.hardware_fault)
            AND (NOT detailed_status^.last_mc_status.function_flag)  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$local_nad_busy,
            rfv$status_table.local_nads^[current_request^.request_id.ring_3_id.nad].name, status);
        ELSE
          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, current_request^.request_id.ring_3_id.nad, 0, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
        IFEND;
        rfp$delink_request(current_request^.request_id, ignore_status);
        IF  status.normal  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'fatal NAD error', status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_REQ_CONNECT_RESPONSE',
            status);
        IFEND;
        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$synchronize_with_status(current_request^.request_id.ring_3_id.nad);
            rfp$remove_connection(response_seq_number, connection_mgmt_status^.connection);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
        FREE connection_mgmt_status IN osv$task_private_heap^;
      IFEND;
    END /main_section/;

  PROCEND process_req_connect_response;
?? TITLE := '    PROCESS_OBT_CONNECT_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_obt_connect_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                          pp_response: ^iot$pp_response;
                                          detailed_status: ^rft$detailed_status;
                                      VAR current_request: ^rft$outstanding_requests;
                                      VAR release_request: BOOLEAN;
                                      VAR status: ost$status);

{    The purpose of this procedure is to process a completed create connection request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        response_seq_number: INTEGER,
        clear_connect_entry: ^rft$clear_connection_id,
        connect_request: ^rft$nbp_incoming_connect,
        recoverable: boolean,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        nad_index: rft$local_nads,
        connection_index: rft$concurrent_connections,
        ignore_status: ost$status;

  /main_section/
    BEGIN
      connection_mgmt_status := current_request^.request_status;
      nad_index := current_request^.request_id.ring_3_id.nad;
      connection_index := command_buff^[rfc$cbi_unit_request_2].lc_path_id;
      response_seq_number := current_request^.request_id.ring_1_id.address^.response_seq_number;

      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN
        connect_request := #LOC(command_buff^[rfc$cbi_general_buffer]);
        process_incoming_connect(connect_request, pp_response^.transfer_count, connection_index,
          nad_index, current_request, release_request, status);
        IF  NOT release_request  THEN
          EXIT /main_section/;
        IFEND;
      ELSE  {  ioc$abnormal_response  }

        IF  ((detailed_status^.last_mc_status.response = rfc$nr_abort) OR
             (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge))
            AND (NOT detailed_status^.last_mc_status.hardware_fault)
            AND (NOT detailed_status^.last_mc_status.function_flag)  THEN
          rfp$delink_request(current_request^.request_id, ignore_status);
          purge_path(command_buff^[rfc$cbi_unit_request_2].lc_path_id, current_request, status);
          IF  status.normal  THEN
            release_request := FALSE;
            EXIT /main_section/;
          IFEND;
        ELSE
          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, nad_index,
            command_buff^[rfc$cbi_unit_request_2].lc_path_id, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
          rfp$delink_request(current_request^.request_id, ignore_status);
        IFEND;
        rfp$lock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
        rfv$status_table.local_nads^[nad_index].connection_table^[connection_index].
          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_index].
            connection_state := rfc$ps_unused;
          rfv$status_table.local_nads^[nad_index].connection_table^[connection_index].
            connection_clarifier := rfc$pcu_empty;
        IFEND;
        IF  rfv$status_response_pending^[nad_index].in_host  THEN
          ALLOCATE  clear_connect_entry  IN  osv$task_private_heap^;
          IF  clear_connect_entry <> NIL  THEN
            clear_connect_entry^.local_nad := nad_index;
            clear_connect_entry^.connection_id := connection_index;
            clear_connect_entry^.sequence_number := response_seq_number;
            clear_connect_entry^.next_entry := rfv$clear_connection_id;
            rfv$clear_connection_id := clear_connect_entry;
          IFEND;
        IFEND;
        rfp$unlock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
      IFEND;
      FREE connection_mgmt_status IN osv$task_private_heap^;
    END /main_section/;

  PROCEND process_obt_connect_response;
?? NEWTITLE := '      PROCESS_INCOMING_CONNECT' ??
?? EJECT ??
  PROCEDURE process_incoming_connect(connect_request: ^rft$nbp_incoming_connect;
                                     request_length: rft$transfer_length;
                                     connection: rft$path_identifier;
                                     nad_index: rft$local_nads;
                                 VAR current_request: ^rft$outstanding_requests;
                                 VAR release_request: BOOLEAN;
                                 VAR status: ost$status);

{    The purpose of this routine is to validate an incoming connect request and to assign
{    the request to the respective server for processing.
{
{    connect_request: (input) This parameter contains a pointer to the incoming connect request.
{
{    request_length: (input) This parameter specifies the length of the connect request.
{
{    connection: (input) This parameter specifies the corresponding path identifier (relative to the
{      local NAD) of the incoming request.
{
{    nad_index: (input) This parameter specifies the local NAD that received the incoming connect
{      request.
{
{    current_request: (input, output) This parameter specifies the supporting request information.  This
{      is used if an ACCEPT or REJECT request is required.
{
{    release_request: (input,output) This parameter specifies whether the current_request can be deleted.
{      Code assumes an initial value of TRUE.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        cm_routing: rft$nbp_control_message_header,
        path_entry: ^rft$lcn_path_definition,
        remote_host: ^rft$remote_host_definition,
        lid_index: rft$logical_ids_per_host,
        server_name: rft$application_name,
        server_id_index: rft$concurrent_connections,
        server_entry: ^rft$rhfam_server_table_entry,
        reject_code: rft$reject_code,
        ignore_status: ost$status,
        remote_host_found,
        accept_in_progress,
        matching_lid_found,
        matching_server_found: boolean;


    accept_in_progress := FALSE;
    status.normal := TRUE;
    reject_code := 0;

  /validate_incoming_connect/
    BEGIN

      IF  request_length < #SIZE(rft$nbp_incoming_connect)  THEN
        reject_code := rfc$nbp_password_undefined;  {  This should have a more meaningful code !!!! }
        EXIT /validate_incoming_connect/;
      IFEND;
      IF  connect_request^.password <> rfv$status_table.local_host^.connection_password  THEN
        reject_code := rfc$nbp_password_undefined;
        EXIT /validate_incoming_connect/;
      IFEND;
      IF  rfv$status_table.local_host^.disabled  THEN
        reject_code := rfc$nbp_server_lid_disabled;
        EXIT /validate_incoming_connect/;
      IFEND;
      IF  connect_request^.destination_id = rfv$status_table.local_host^.physical_identifier  THEN
        matching_lid_found := TRUE;
      ELSE
        matching_lid_found := FALSE;
      /find_matching_lid/
        FOR  lid_index := 1  TO  UPPERBOUND(rfv$status_table.local_host^.logical_identifiers)  DO
          IF  connect_request^.destination_id =
                rfv$status_table.local_host^.logical_identifiers[lid_index].logical_id(1,3)  THEN
            matching_lid_found := TRUE;
            EXIT /find_matching_lid/;
          IFEND;
        FOREND  /find_matching_lid/;
        IF  (matching_lid_found)  AND
            (rfv$status_table.local_host^.logical_identifiers[lid_index].disabled)  THEN
          reject_code := rfc$nbp_server_lid_disabled;
          EXIT /validate_incoming_connect/;
        IFEND;
      IFEND;

      cm_routing.nad_address := connect_request^.nad_address;
      cm_routing.logical_network := 0;
      cm_routing.logical_nad := 0;
      cm_routing.destination_device := connect_request^.destination_device;
      cm_routing.local_tcu_enables := connect_request^.local_tcu_enables;
      IF  rfv$status_table.local_host^.physical_identifier = connect_request^.source_physical_id  THEN
        find_matching_path(rfv$status_table.local_host^.associated_paths, nad_index,
          cm_routing, path_entry);
      ELSE
        remote_host := rfv$status_table.remote_hosts;
        remote_host_found := FALSE;
      /find_matching_remote_host/
        WHILE  remote_host <> NIL  DO
          IF  remote_host^.physical_identifier = connect_request^.source_physical_id  THEN
            find_matching_path(remote_host^.associated_paths, nad_index,
              cm_routing, path_entry);
            remote_host_found := TRUE;
            EXIT /find_matching_remote_host/;
          IFEND;
          remote_host := remote_host^.next_entry;
        WHILEND /find_matching_remote_host/;
        IF  NOT remote_host_found  THEN
          reject_code := rfc$nbp_client_pid_undefined;
          EXIT /validate_incoming_connect/;
        IFEND;
        IF  remote_host^.disabled  THEN
          reject_code := rfc$nbp_client_pid_disabled;
          EXIT /validate_incoming_connect/;
        IFEND;
      IFEND;
      IF  path_entry <> NIL  THEN
        rfp$lock_table(rfv$status_table.lock);
        path_entry^.disabled := FALSE;
        path_entry^.failure_count := 0;
        rfp$unlock_table(rfv$status_table.lock);
      IFEND;

      rfp$lock_table(rfv$rhfam_server_table.lock);

    /server_table_update/
      BEGIN
        server_name := connect_request^.requested_application;
        server_entry := rfv$rhfam_server_table.first_entry;
        matching_server_found := FALSE;

      /find_matching_server/
        WHILE  server_entry <> NIL  DO
          IF  (server_name = server_entry^.server_name)  THEN
            matching_server_found := TRUE;
            EXIT /find_matching_server/;
          IFEND;
          server_entry := server_entry^.next_entry;
        WHILEND  /find_matching_server/;
        IF  NOT matching_server_found  THEN
          reject_code := rfc$nbp_server_undefined;
          EXIT /server_table_update/;
        IFEND;
        IF  (NOT server_entry^.server_active)  THEN
          reject_code := rfc$nbp_server_disabled;
          EXIT /server_table_update/;
        IFEND;
        IF  (NOT server_entry^.rhfam_initiated_server) AND
            (server_entry^.connections_reserved = 0 ) THEN
          reject_code := rfc$nbp_server_undefined;
          EXIT /server_table_update/;
        IFEND;
        IF  (server_entry^.validate_connection_lid)  AND
            (NOT matching_lid_found)  THEN
          reject_code := rfc$nbp_server_lid_undefined;
          EXIT /server_table_update/;
        IFEND;
        IF  (server_entry^.current_connections >= server_entry^.maximum_connections)  OR
            ((NOT server_entry^.rhfam_initiated_server) AND
             (server_entry^.current_connections >= server_entry^.connections_reserved))  THEN
          reject_code := rfc$nbp_requested_server_busy;
          EXIT /server_table_update/;
        IFEND;
        IF  reject_code <> 0  THEN
          EXIT /server_table_update/;
        IFEND;

        {  The server table is locked upon entry into assign_connect.  The assign connect
        {  routine have the lock set upon return.

        assign_connect_to_server(connection, connect_request, server_entry, current_request,
          accept_in_progress, status);
        IF  NOT status.normal  THEN
           reject_code := rfc$nbp_requested_host_busy;
        IFEND;
      END /server_table_update/;
      rfp$unlock_table(rfv$rhfam_server_table.lock);

    END  /validate_incoming_connect/;

    IF  accept_in_progress  THEN
      release_request := FALSE;
    ELSE
      rfp$delink_request(current_request^.request_id, ignore_status);
      IF  reject_code <> 0  THEN
        IF  NOT status.normal  THEN
          rfp$log_the_status(status);
        IFEND;
        reject_connect_request(connection, reject_code, current_request, status);
        IF  status.normal  THEN
          release_request := FALSE;
        IFEND;
      ELSE  {  getting here means that the request is assigned to a server.
        wake_up_server_job(server_name);
      IFEND;
    IFEND;

  PROCEND process_incoming_connect;
?? NEWTITLE := '        ASSIGN_CONNECT_TO_SERVER' ??
?? EJECT ??
  PROCEDURE assign_connect_to_server(connection: rft$path_identifier;
                                     connect_request: ^rft$nbp_incoming_connect;
                                 VAR server_entry: ^rft$rhfam_server_table_entry;
                                 VAR current_request: ^rft$outstanding_requests;
                                 VAR accept_in_progress: BOOLEAN;
                                 VAR status: ost$status);

{    The purpose of this routine is to assign a valid connect request to a server application for
{    further processing.
{
{    NOTE - This routine assumes the calling procedure has locked the server table.
{           Upon return the lock will still be set.
{
{    connection: (input) This parameter specifies the path of the incoming connect request.
{
{    connect_request: (input) This parameter specifies a pointer to the incoming connect request.
{
{    server_entry: (input,output) This parameter specifies the server entry, of the corresponding server,
{      to assign the incoming connect request.
{
{    current_request: (input, output) This parameter specifies the supporting request information.  This
{      is used if an ACCEPT or REJECT request is required.
{
{    accept_in_progress: (input, output) This parameter specifies whether the current_request can be
{      deleted.  Code assumes the initial value is FALSE.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        current_time: INTEGER,
        ignore_status: ost$status,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        current_connect,
        incoming_connect: ^rft$incoming_connect;

    status.normal := TRUE;

    pmp$get_microsecond_clock(current_time, ignore_status);
    ALLOCATE incoming_connect IN nav$network_paged_heap^;
    IF  incoming_connect = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ASSIGN CONNECT TO SERVER', status);
      RETURN;
    IFEND;
    incoming_connect^.connect_message := connect_request^;
    incoming_connect^.connection_descriptor.nad_index := current_request^.request_id.ring_3_id.nad;
    incoming_connect^.connection_descriptor.logical_unit :=
      current_request^.request_id.ring_3_id.location.logical_unit;
    incoming_connect^.connection_descriptor.network_path := connection;
    incoming_connect^.time_received := current_time;
    incoming_connect^.connection_status.connection_state := rfc$incoming_connect_active;
    incoming_connect^.next_entry := NIL;

    IF  server_entry^.access_method_accept  THEN
      server_entry^.current_connections := server_entry^.current_connections + 1;
      server_entry^.active_incoming_connects := server_entry^.active_incoming_connects + 1;
      rfp$unlock_table(rfv$rhfam_server_table.lock);
      connection_mgmt_status := current_request^.request_status;
      connection_mgmt_status^.server_entry_p := server_entry;
      connection_mgmt_status^.incoming_connect := incoming_connect;
      rfp$delink_request(current_request^.request_id, ignore_status);
      accept_connect_request(connection, current_request, status);
      rfp$lock_table(rfv$rhfam_server_table.lock);
      IF  status.normal  THEN
        accept_in_progress := TRUE;
      ELSE
        FREE incoming_connect IN nav$network_paged_heap^;
        server_entry^.current_connections := server_entry^.current_connections - 1;
        server_entry^.active_incoming_connects := server_entry^.active_incoming_connects - 1;
      IFEND;
    ELSE
      server_entry^.current_connections := server_entry^.current_connections + 1;
      IF  (server_entry^.rhfam_initiated_server)  AND
          ((server_entry^.current_connections - server_entry^.partner_job_connections)
                                              > server_entry^.connections_reserved)  THEN
        server_entry^.active_incoming_connects := server_entry^.active_incoming_connects + 1;
        rfp$unlock_table(rfv$rhfam_server_table.lock);
        rfp$start_server_job(server_entry, status);
        rfp$lock_table(rfv$rhfam_server_table.lock);
        server_entry^.active_incoming_connects := server_entry^.active_incoming_connects - 1;
        IF  NOT status.normal  THEN
          FREE incoming_connect IN nav$network_paged_heap^;
          server_entry^.current_connections := server_entry^.current_connections - 1;
          RETURN;
        IFEND;
      IFEND;
      current_connect := server_entry^.incoming_connect;
      IF  current_connect = NIL  THEN
        server_entry^.incoming_connect := incoming_connect;
      ELSE
        WHILE  current_connect^.next_entry <> NIL  DO
          current_connect := current_connect^.next_entry;
        WHILEND;
        current_connect^.next_entry := incoming_connect;
      IFEND;
    IFEND;

  PROCEND assign_connect_to_server;
?? OLDTITLE ??
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '  RFP$START_SERVER_JOB' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$start_server_job(VAR server: ^rft$rhfam_server_table_entry;
                                        VAR status: ost$status);

*copyc rfh$start_server_job

    VAR
        current_time: INTEGER,
        new_server_id: ^rft$server_identifier,
        job_start_up_attrs: ^jmt$job_submission_options,
        job_name: jmt$system_supplied_name,
        path: ^pft$path,
        password: pft$name,
        cycle_selector: pft$cycle_selector,
        usage_selections: pft$usage_selections,
        share_selections: pft$share_selections,
        unique_name: ost$unique_name,
        server_file_name: amt$local_file_name,
        ignore_status: ost$status;

    ALLOCATE  new_server_id  IN  nav$network_paged_heap^;
    IF  new_server_id = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'network paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$START_SERVER_JOB', status);
      RETURN;
    IFEND;

    pmp$generate_unique_name(unique_name, ignore_status);
    server_file_name := unique_name.value;

    PUSH path : [1..5];
    path^[1] := osc$null_name;
    path^[2] := rfc$rhfam_master_catalog;
    path^[3] := rfc$rhfam_sub_catalog;
    path^[4] := rfc$server_sub_catalog;
    path^[5] := server^.server_name;
    usage_selections := $pft$usage_selections[pfc$read];
    share_selections := $pft$share_selections[pfc$read,pfc$execute];
    cycle_selector.cycle_option := pfc$highest_cycle;
    password := rfc$password;

    pfp$attach(server_file_name, path^, cycle_selector, password, usage_selections, share_selections,
      pfc$no_wait, status);
    IF  NOT status.normal  THEN
      FREE  new_server_id  IN  nav$network_paged_heap^;
      RETURN;
    IFEND;

    PUSH job_start_up_attrs : [1..1];
    job_start_up_attrs^[1].key := jmc$immediate_init_candidate;
    job_start_up_attrs^[1].immediate_init_candidate := TRUE;
    jmp$submit_job(server_file_name, job_start_up_attrs, job_name, status);

    amp$return(server_file_name, ignore_status);

    IF  NOT status.normal  THEN
      FREE  new_server_id  IN  nav$network_paged_heap^;
    ELSE
      pmp$get_microsecond_clock(current_time, ignore_status);
      rfp$lock_table(rfv$rhfam_server_table.lock);
      new_server_id^.job_name := job_name;
      new_server_id^.server_signed_on := FALSE;
      new_server_id^.server_started_time := current_time;
      new_server_id^.next_entry := server^.server_identifier;
      server^.server_identifier := new_server_id;
      server^.connections_reserved := server^.connections_reserved + server^.server_job_max_connections;
      rfp$unlock_table(rfv$rhfam_server_table.lock);
    IFEND;

  PROCEND rfp$start_server_job;
?? NEWTITLE := '    ACCEPT_CONNECT_REQUEST' ??
?? EJECT ??
  PROCEDURE  accept_connect_request(connection: rft$path_identifier;
                                VAR current_request: ^rft$outstanding_requests;
                                VAR status: ost$status);

{    The purpose of this routine is to accept an incoming connect request.
{
{    connection: (input) This parameter specifies the local NAD connection identifier.
{
{    current_request: (input, output) This paramter contains all the information of the current
{      request.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        path_identifier: ^rft$path_identifier;

    status.normal := TRUE;

    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, 'command id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ACCEPT_CONNECT_REQUEST', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$lc_accept_connect_request;
    NEXT path_identifier IN request_info;
    IF  path_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'path id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ACCEPT_CONNECT_REQUEST', status);
      RETURN;
    IFEND;
    path_identifier^ := connection;
    RESET request_info;
    rfp$post_request(request_info, current_request^.request_id, status);

    IF  status.normal  THEN
      current_request^.retry_count := 0;
      current_request^.request_kind := rfc$rk_accept_connect_request;
    IFEND;

  PROCEND accept_connect_request;
?? TITLE := '    PURGE_PATH' ??
?? EJECT ??
  PROCEDURE  purge_path(connection: rft$path_identifier;
                    VAR current_request: ^rft$outstanding_requests;
                    VAR status: ost$status);

{    The purpose of this routine is to purge the NAD path for a specified connection.
{
{    connection: (input) This parameter specifies the local NAD connection identifier.
{
{    current_request: (input, output) This paramter contains all the information of the current
{      request.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        abnormal_termination: ^BOOLEAN,
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        path_identifier: ^rft$path_identifier;

    status.normal := TRUE;

    PUSH  request_info : [[rft$logical_commands,BOOLEAN,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, 'command id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'PURGE_PATH', status);
      RETURN;
    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, 'termination type too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'PURGE_PATH', status);
      RETURN;
    IFEND;
    abnormal_termination^ := TRUE;
    NEXT path_identifier IN request_info;
    IF  path_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'path id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'PURGE_PATH', status);
      RETURN;
    IFEND;
    path_identifier^ := connection;
    RESET request_info;
    rfp$post_request(request_info, current_request^.request_id, status);

    IF  status.normal  THEN
      current_request^.retry_count := 0;
      current_request^.request_kind := rfc$rk_disconnect_path;
    IFEND;

  PROCEND purge_path;
?? TITLE := '    REJECT_CONNECT_REQUEST' ??
?? EJECT ??
  PROCEDURE  reject_connect_request(connection: rft$path_identifier;
                                    reject_code: rft$reject_code;
                                VAR current_request: ^rft$outstanding_requests;
                                VAR status: ost$status);

{    The purpose of this routine is to reject an incoming connect request.
{
{    connection: (input) This parameter specifies the local NAD connection identifier.
{
{    reject_code: (input) This parameter specifies the reject code to send to the source host.
{
{    current_request: (input, output) This paramter contains all the information of the current
{      request.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        reject_id: ^rft$reject_code,
        path_identifier: ^rft$path_identifier;

    status.normal := TRUE;

    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, 'command id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'REJECT_CONNECT_REQUEST', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$lc_reject_connect_request;
    NEXT path_identifier IN request_info;
    IF  path_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'path id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'REJECT_CONNECT_REQUEST', status);
      RETURN;
    IFEND;
    path_identifier^ := connection;
    NEXT reject_id IN request_info;
    IF  reject_id = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'reject code too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'REJECT_CONNECT_REQUEST', status);
      RETURN;
    IFEND;
    reject_id^ := reject_code;
    RESET request_info;
    rfp$post_request(request_info, current_request^.request_id, status);

    IF  status.normal  THEN
      current_request^.retry_count := 0;
      current_request^.request_kind := rfc$rk_reject_connect_request;
    IFEND;

  PROCEND reject_connect_request;
?? OLDTITLE ??
?? TITLE := '    WAKE_UP_SERVER_JOB' ??
?? EJECT ??
  PROCEDURE  wake_up_server_job(server_name: rft$application_name);

{    The purpose of this routine is to scan the list of tasks, which are waiting
{    for an RHFAM event, and readying a task (if any) that is waiting for an
{    incoming connect request for the specified server.
{
{    server_name: (input) This parameter specifies the name of the server application that
{      was requested on the incoming connect request.

    VAR
        task_id: ost$global_task_id,
        event_entry: ^rft$rhfam_event_table_entry,
        ignore_status: ost$status;

    task_id := tmv$null_global_task_id;
    rfp$lock_table(rfv$rhfam_event_table.lock);
    event_entry := rfv$rhfam_event_table.first_entry;

  /find_waiting_task/
    WHILE  event_entry <> NIL  DO
      IF  (event_entry^.event_occurred_type = rfc$eot_no_event) AND
          (event_entry^.event_kind = rfc$ana_await_incoming_connect) AND
          (event_entry^.aic_server_name = server_name) THEN
        event_entry^.event_occurred_type := rfc$eot_incoming_connect;
        task_id := event_entry^.task_id;
        EXIT /find_waiting_task/;
      IFEND;
      event_entry := event_entry^.next_entry;
    WHILEND /find_waiting_task/;

    rfp$unlock_table(rfv$rhfam_event_table.lock);

    IF  task_id <> tmv$null_global_task_id  THEN
      pmp$ready_task(task_id, ignore_status);
    IFEND;

  PROCEND wake_up_server_job;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '    PROCESS_ACC_CONNECT_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_acc_connect_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                          pp_response: ^iot$pp_response;
                                          detailed_status: ^rft$detailed_status;
                                      VAR current_request: ^rft$outstanding_requests;
                                      VAR release_request: BOOLEAN;
                                      VAR status: ost$status);

{    The purpose of this procedure is to process a completed accept incoming connect request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        current_connect: ^rft$incoming_connect,
        server: ^rft$rhfam_server_table_entry,
        server_name: rft$application_name,
        job_table_entry_p: ^rft$rhfam_job_table_entry,
        new_entry,
        recoverable: boolean,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        nad_index: rft$local_nads,
        connection_index: rft$concurrent_connections,
        response_seq_number: INTEGER,
        clear_connect_entry: ^rft$clear_connection_id,
        ignore_status: ost$status;

  /main_section/
    BEGIN
      connection_mgmt_status := current_request^.request_status;
      nad_index := current_request^.request_id.ring_3_id.nad;
      connection_index := command_buff^[rfc$cbi_unit_request_2].lc_path_id;
      response_seq_number := current_request^.request_id.ring_1_id.address^.response_seq_number;

      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN

        IF  connection_mgmt_status^.internal_use  THEN
          server_name := '';
          server := connection_mgmt_status^.server_entry_p;
          rfp$lock_table(rfv$rhfam_server_table.lock);
          IF  (server^.rhfam_initiated_server)  AND
            ((server^.current_connections - server^.partner_job_connections)
                                              > server^.connections_reserved)  THEN
            rfp$unlock_table(rfv$rhfam_server_table.lock);
            rfp$start_server_job(server, status);
            rfp$lock_table(rfv$rhfam_server_table.lock);
            server^.active_incoming_connects := server^.active_incoming_connects - 1;
            IF  NOT status.normal  THEN
              FREE connection_mgmt_status^.incoming_connect IN nav$network_paged_heap^;
              server^.current_connections := server^.current_connections - 1;
              rfp$unlock_table(rfv$rhfam_server_table.lock);
              rfp$delink_request(current_request^.request_id, ignore_status);
              purge_path(connection_index, current_request, ignore_status);
              IF  ignore_status.normal  THEN
                release_request := FALSE;
              ELSE
                FREE connection_mgmt_status IN osv$task_private_heap^;
              IFEND;
              EXIT /main_section/;
            IFEND;
          ELSE   {  Do not have to start Server Job  }
            server^.active_incoming_connects := server^.active_incoming_connects - 1;
            server_name := server^.server_name;
          IFEND;

          {  Queue request for server job.

          current_connect := server^.incoming_connect;
          IF  current_connect = NIL  THEN
            server^.incoming_connect := connection_mgmt_status^.incoming_connect;
          ELSE
            WHILE  current_connect^.next_entry <> NIL  DO
              current_connect := current_connect^.next_entry;
            WHILEND;
            current_connect^.next_entry := connection_mgmt_status^.incoming_connect;
          IFEND;
          rfp$unlock_table(rfv$rhfam_server_table.lock);
          IF  server_name <> ''  THEN
            wake_up_server_job(server_name);
          IFEND;

        ELSE  {  user mode request  }
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$lock_table(connection_mgmt_status^.connection^.lock);
            connection_mgmt_status^.connection^.active_pp_requests :=
              connection_mgmt_status^.connection^.active_pp_requests - 1;
            IF  connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state
                  < rfc$not_viable  THEN
              connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state :=
                  rfc$connected;
              connection_mgmt_status^.connection^.connection_attributes.connection_status.input_available :=
                  FALSE;
              connection_mgmt_status^.connection^.connection_attributes.connection_status.
                  output_below_threshold := TRUE;
            IFEND;
            rfp$unlock_table(connection_mgmt_status^.connection^.lock);
          IFEND;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
        FREE connection_mgmt_status IN osv$task_private_heap^;
        rfp$delink_request(current_request^.request_id, status);

      ELSE  {  ioc$abnormal_response  }

        IF  ((detailed_status^.last_mc_status.response = rfc$nr_abort) OR
             (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge))
            AND (NOT detailed_status^.last_mc_status.hardware_fault)
            AND (NOT detailed_status^.last_mc_status.function_flag)  THEN
          rfp$delink_request(current_request^.request_id, ignore_status);
          get_path_status(connection_index, current_request, status);
          IF  status.normal  THEN
            IF  connection_mgmt_status^.internal_use  THEN
              server := connection_mgmt_status^.server_entry_p;
              FREE connection_mgmt_status^.incoming_connect IN nav$network_paged_heap^;
              rfp$lock_table(rfv$rhfam_server_table.lock);
              server^.current_connections := server^.current_connections - 1;
              server^.active_incoming_connects := server^.active_incoming_connects - 1;
              rfp$unlock_table(rfv$rhfam_server_table.lock);
            IFEND;
            release_request := FALSE;
            EXIT /main_section/;
          IFEND;
        ELSE
          log_nad_error(pp_response,detailed_status,current_request^.request_kind,
            current_request^.retry_count, nad_index, connection_index, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
          rfp$delink_request(current_request^.request_id, ignore_status);
        IFEND;
        IF  status.normal  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'fatal NAD error', status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_ACC_CONNECT_RESPONSE',
            status);
        IFEND;
        IF  connection_mgmt_status^.internal_use  THEN
          server := connection_mgmt_status^.server_entry_p;
          FREE connection_mgmt_status^.incoming_connect IN nav$network_paged_heap^;
          rfp$lock_table(rfv$rhfam_server_table.lock);
          server^.current_connections := server^.current_connections - 1;
          server^.active_incoming_connects := server^.active_incoming_connects - 1;
          rfp$unlock_table(rfv$rhfam_server_table.lock);
        ELSE   {  user mode request  }
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$lock_table(connection_mgmt_status^.connection^.lock);
            connection_mgmt_status^.connection^.active_pp_requests :=
              connection_mgmt_status^.connection^.active_pp_requests - 1;
            IF  connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state
                  < rfc$not_viable  THEN
              connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state :=
                rfc$terminated;
              connection_mgmt_status^.connection^.connection_attributes.connection_status.
                reason_for_termination := rfc$media_failure;
            IFEND;
            rfp$unlock_table(connection_mgmt_status^.connection^.lock);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
          rfp$lock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
          rfv$status_table.local_nads^[nad_index].connection_table^[connection_index].
            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_index].
              connection_state := rfc$ps_unused;
            rfv$status_table.local_nads^[nad_index].connection_table^[connection_index].
              connection_clarifier := rfc$pcu_empty;
          IFEND;
          IF  rfv$status_response_pending^[nad_index].in_host  THEN
            ALLOCATE  clear_connect_entry  IN  osv$task_private_heap^;
            IF  clear_connect_entry <> NIL  THEN
              clear_connect_entry^.local_nad := nad_index;
              clear_connect_entry^.connection_id := connection_index;
              clear_connect_entry^.sequence_number := response_seq_number;
              clear_connect_entry^.next_entry := rfv$clear_connection_id;
              rfv$clear_connection_id := clear_connect_entry;
            IFEND;
          IFEND;
          rfp$unlock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
        IFEND;
        FREE connection_mgmt_status IN osv$task_private_heap^;
      IFEND;
    END /main_section/;

  PROCEND process_acc_connect_response;
?? NEWTITLE := '      GET_PATH_STATUS' ??
?? EJECT ??
  PROCEDURE  get_path_status(connection: rft$path_identifier;
                         VAR current_request: ^rft$outstanding_requests;
                         VAR status: ost$status);

{    The purpose of this routine is to obtain the path status for a specified connection.
{
{    connection: (input) This parameter specifies the local NAD connection identifier.
{
{    current_request: (input, output) This paramter contains all the information of the current
{      request.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        path_identifier: ^rft$path_identifier;

    status.normal := TRUE;

    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, 'command id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'GET_PATH_STATUS', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$lc_read_path_status_table;
    NEXT path_identifier IN request_info;
    IF  path_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'path id too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'GET_PATH_STATUS', status);
      RETURN;
    IFEND;
    path_identifier^ := connection;
    RESET request_info;
    rfp$post_request(request_info, current_request^.request_id, status);

    IF  status.normal  THEN
      current_request^.retry_count := 0;
      current_request^.request_kind := rfc$rk_path_status;
    IFEND;

  PROCEND get_path_status;
?? OLDTITLE ??
?? TITLE := '    PROCESS_REJ_CONNECT_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_rej_connect_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                          pp_response: ^iot$pp_response;
                                          detailed_status: ^rft$detailed_status;
                                      VAR current_request: ^rft$outstanding_requests;
                                      VAR release_request: BOOLEAN;
                                      VAR status: ost$status);

{    The purpose of this procedure is to process a completed reject incoming connect request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        clear_connect_entry: ^rft$clear_connection_id,
        response_seq_number: INTEGER,
        local_nad: ^rft$local_nad_entry,
        nad_index: rft$local_nads,
        connection_index: rft$concurrent_connections,
        job_table_entry_p: ^rft$rhfam_job_table_entry,
        new_entry,
        recoverable: boolean,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        ignore_status: ost$status;

  /main_section/
    BEGIN
      connection_mgmt_status := current_request^.request_status;
      nad_index := current_request^.request_id.ring_3_id.nad;
      local_nad := ^rfv$status_table.local_nads^[nad_index];
      connection_index := command_buff^[rfc$cbi_unit_request_2].lc_path_id;
      response_seq_number := current_request^.request_id.ring_1_id.address^.response_seq_number;
      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN
        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$synchronize_with_status(nad_index);
            rfp$remove_connection(response_seq_number, connection_mgmt_status^.connection);
          IFEND;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
        rfp$delink_request(current_request^.request_id, status);

      ELSE  {  ioc$abnormal_response  }

        IF  ((detailed_status^.last_mc_status.response = rfc$nr_abort) OR
             (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge))
            AND (NOT detailed_status^.last_mc_status.hardware_fault)
            AND (NOT detailed_status^.last_mc_status.function_flag)  THEN
          rfp$delink_request(current_request^.request_id, ignore_status);
          purge_path(command_buff^[rfc$cbi_unit_request_2].lc_path_id, current_request, status);
          IF  status.normal  THEN
            release_request := FALSE;
            EXIT /main_section/;
          IFEND;
        ELSE
          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, nad_index,
            command_buff^[rfc$cbi_unit_request_2].lc_path_id, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
          rfp$delink_request(current_request^.request_id, ignore_status);
        IFEND;
        IF  status.normal  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'fatal NAD error', status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_REJ_CONNECT_RESPONSE',
            status);
        IFEND;
        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$synchronize_with_status(nad_index);
            rfp$remove_connection(response_seq_number, connection_mgmt_status^.connection);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
      IFEND;

      IF  connection_mgmt_status^.internal_use  THEN
        rfp$lock_table(local_nad^.connection_table_lock);
        local_nad^.connection_table^[connection_index].processing_incoming_connect := FALSE;
        IF  response_seq_number > local_nad^.last_status_seq_number  THEN
          local_nad^.connection_table^[connection_index].connection_state := rfc$ps_unused;
          local_nad^.connection_table^[connection_index].connection_clarifier := rfc$pcu_empty;
        IFEND;
        IF  rfv$status_response_pending^[nad_index].in_host  THEN
          ALLOCATE  clear_connect_entry  IN  osv$task_private_heap^;
          IF  clear_connect_entry <> NIL  THEN
            clear_connect_entry^.local_nad := nad_index;
            clear_connect_entry^.connection_id := connection_index;
            clear_connect_entry^.sequence_number := response_seq_number;
            clear_connect_entry^.next_entry := rfv$clear_connection_id;
            rfv$clear_connection_id := clear_connect_entry;
          IFEND;
        IFEND;
        rfp$unlock_table(local_nad^.connection_table_lock);
      IFEND;
      FREE connection_mgmt_status IN osv$task_private_heap^;

    END /main_section/;

  PROCEND process_rej_connect_response;
?? TITLE := '    PROCESS_DISCONNECT_RESPONSE' ??
?? EJECT ??
  PROCEDURE [XDCL,#GATE] rfp$process_disconnect_response (command_buff:
                                ^ARRAY [rft$command_entry] OF rft$command;
                                         pp_response: ^iot$pp_response;
                                         detailed_status: ^rft$detailed_status;
                                     VAR current_request: ^rft$outstanding_requests;
                                     VAR release_request: BOOLEAN;
                                     VAR status: ost$status);

{    The purpose of this procedure is to process a completed terminate connection request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        clear_connect_entry: ^rft$clear_connection_id,
        response_seq_number: INTEGER,
        job_table_entry_p: ^rft$rhfam_job_table_entry,
        new_entry,
        recoverable: boolean,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        nad_index: rft$local_nads,
        connection_index: rft$concurrent_connections,
        ignore_status: ost$status;

  /main_section/
    BEGIN
      connection_mgmt_status := current_request^.request_status;
      nad_index := current_request^.request_id.ring_3_id.nad;
      connection_index := command_buff^[rfc$cbi_unit_request_2].lc_path_id;
      response_seq_number := current_request^.request_id.ring_1_id.address^.response_seq_number;

      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN
        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$synchronize_with_status(nad_index);
            rfp$remove_connection(response_seq_number, connection_mgmt_status^.connection);
          IFEND;
          connection_mgmt_status^.activity_status^. complete := TRUE;
        IFEND;
        rfp$delink_request(current_request^.request_id, status);

      ELSE  {  ioc$abnormal_response  }

        IF  (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge)
            AND (detailed_status^.last_mc_function = (rfc$nf_normal_disconnect + rfc$nf_flag_function))
            AND (NOT detailed_status^.last_mc_status.hardware_fault)
            AND (NOT detailed_status^.last_mc_status.function_flag)  THEN
          rfp$delink_request(current_request^.request_id, ignore_status);
          purge_path(command_buff^[rfc$cbi_unit_request_2].lc_path_id, current_request, status);
          IF  status.normal  THEN
            release_request := FALSE;
            EXIT /main_section/;
          IFEND;
        ELSE
          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, current_request^.request_id.ring_3_id.nad,
            command_buff^[rfc$cbi_unit_request_2].lc_path_id, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
          rfp$delink_request(current_request^.request_id, ignore_status);
        IFEND;
        IF  status.normal  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'fatal NAD error', status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_DISCONNECT_RESPONSE',
            status);
        IFEND;
        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$synchronize_with_status(nad_index);
            rfp$remove_connection(response_seq_number, connection_mgmt_status^.connection);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
      IFEND;

      IF  (connection_index <> 0)  AND
          (connection_mgmt_status^.internal_use)  THEN
        rfp$lock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
        rfv$status_table.local_nads^[nad_index].connection_table^[connection_index].
          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_index].
            connection_state := rfc$ps_unused;
          rfv$status_table.local_nads^[nad_index].connection_table^[connection_index].
            connection_clarifier := rfc$pcu_empty;
        IFEND;
        IF  rfv$status_response_pending^[nad_index].in_host  THEN
          ALLOCATE  clear_connect_entry  IN  osv$task_private_heap^;
          IF  clear_connect_entry <> NIL  THEN
            clear_connect_entry^.local_nad := nad_index;
            clear_connect_entry^.connection_id := connection_index;
            clear_connect_entry^.sequence_number := response_seq_number;
            clear_connect_entry^.next_entry := rfv$clear_connection_id;
            rfv$clear_connection_id := clear_connect_entry;
          IFEND;
        IFEND;
        rfp$unlock_table(rfv$status_table.local_nads^[nad_index].connection_table_lock);
      IFEND;
      FREE connection_mgmt_status IN osv$task_private_heap^;
    END /main_section/;

  PROCEND rfp$process_disconnect_response;
?? NEWTITLE := '      SYNCHRONIZE_WITH_STATUS' ??
?? EJECT ??
  PROCEDURE [XDCL,#GATE] rfp$synchronize_with_status (nad: rft$local_nads);

{    The purpose of this routine is to make sure that the local nad status has been
{    processed before the remove connection pointer routine clears out the state
{    and clarifier in the local nad table.
{
{    nad: (input) This parameter specifies the corresponding local NAD to synchronize with.

   VAR
     starting_wait_time: ost$free_running_clock,
     ignore_status: ost$status,
     current_time: ost$free_running_clock;

    starting_wait_time := #free_running_clock (0);

    /wait_for_response/
    WHILE  rfv$status_response_pending^[nad].in_host  AND
           rfv$status_table.system_task_is_up  DO
      #SPOIL (rfv$status_response_pending^);
      #SPOIL (rfv$status_table);
      syp$cycle;
      current_time := #free_running_clock(0);
      IF current_time > starting_wait_time + 45000000 THEN
        dpp$put_critical_message('LCN timeout occurred', ignore_status);
        EXIT /wait_for_response/;
      IFEND;
    WHILEND /wait_for_response/;

  PROCEND rfp$synchronize_with_status;
?? OLDTITLE ??
?? TITLE := '    PROCESS_PATH_STATUS_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_path_status_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                          pp_response: ^iot$pp_response;
                                          detailed_status: ^rft$detailed_status;
                                      VAR current_request: ^rft$outstanding_requests;
                                      VAR release_request: BOOLEAN;
                                      VAR status: ost$status);

{    The purpose of this procedure is to process a completed path status request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        job_table_entry_p: ^rft$rhfam_job_table_entry,
        new_entry,
        recoverable: boolean,
        connection_mgmt_status: ^rft$connection_mgmt_status,
        ignore_status: ost$status;

  /main_section/
    BEGIN

      connection_mgmt_status := current_request^.request_status;

      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN

        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$lock_table(connection_mgmt_status^.connection^.lock);
            connection_mgmt_status^.connection^.active_pp_requests :=
              connection_mgmt_status^.connection^.active_pp_requests - 1;
            IF  connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state
                  < rfc$not_viable  THEN
              set_connection_status(^command_buff^[rfc$cbi_general_buffer],
                current_request^.request_id.ring_3_id.nad,
                connection_mgmt_status^.connection, status);
            IFEND;
            rfp$unlock_table(connection_mgmt_status^.connection^.lock);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
        FREE connection_mgmt_status IN osv$task_private_heap^;
        rfp$delink_request(current_request^.request_id, status);

      ELSE  {  ioc$abnormal_response  }

        log_nad_error(pp_response, detailed_status, current_request^.request_kind,
          current_request^.retry_count, current_request^.request_id.ring_3_id.nad,
          command_buff^[rfc$cbi_unit_request_2].lc_path_id, FALSE, recoverable);
        IF  recoverable  THEN
          current_request^.retry_count := current_request^.retry_count + 1;
          rfp$re_issue_request(current_request^.request_id, status);
          IF  status.normal  THEN
            release_request := FALSE;
            EXIT /main_section/;
          IFEND;
        IFEND;
        rfp$delink_request(current_request^.request_id, ignore_status);
        IF  status.normal  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'fatal NAD error', status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_PATH_STATUS_RESPONSE',
            status);
        IFEND;
        IF  NOT connection_mgmt_status^.internal_use  THEN
          IF  connection_mgmt_status^.connection <> NIL  THEN
            rfp$lock_table(connection_mgmt_status^.connection^.lock);
            connection_mgmt_status^.connection^.active_pp_requests :=
              connection_mgmt_status^.connection^.active_pp_requests - 1;
            IF  connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state
                  < rfc$not_viable  THEN
              connection_mgmt_status^.connection^.connection_attributes.connection_status.connection_state :=
                rfc$terminated;
              connection_mgmt_status^.connection^.connection_attributes.connection_status.
                reason_for_termination := rfc$media_failure;
            IFEND;
            rfp$unlock_table(connection_mgmt_status^.connection^.lock);
          IFEND;
          connection_mgmt_status^.activity_status^.status := status;
          connection_mgmt_status^.activity_status^.complete := TRUE;
        IFEND;
        FREE connection_mgmt_status IN osv$task_private_heap^;
      IFEND;

    END /main_section/;

  PROCEND process_path_status_response;
?? NEWTITLE := '      SET_CONNECTION_STATUS' ??
?? EJECT ??
  PROCEDURE set_connection_status(path_status: ^CELL;
                                  nad_index: rft$local_nads;
                              VAR connection: ^rft$connection_entry;
                              VAR status: ost$status);

{    The purpose of this routine is to retrieve the current connection status from
{    a complete read path status request.  The connection entry is updated and an appropriate
{    status message is formatted.
{
{    NOTE - the caller of this routine must set any required locks, and also validate that the
{           corresponding connection is indeed viable.
{
{    path_status: (input) This parameter specifies a pointer to the path status buffer.
{
{    nad_index: (input) This parameter specifies the index of the local nad, which contains
{      this path.
{
{    connection: (input, output) This parameter specifies the pointer of the connection entry
{      which corresponds to the path status information.
{
{    status: (output) The status is abnormal only if a connection state change has occurred.

    VAR
        path_status_table: ^rft$path_status_table;


    status.normal := TRUE;
    path_status_table := path_status;

    CASE  path_status_table^.path_state  OF
    = rfc$ps_connecting =
      CASE  path_status_table^.path_clarifier  OF
      = rfc$pcc_remote_reject =
        connection^.connection_attributes.connection_status.connection_state := rfc$connect_rejected;
        connection^.connection_attributes.connection_status.server_response :=
          path_status_table^.receive_code.reject_code;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
          status);
      = rfc$pcc_network_reject =
        connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
        connection^.connection_attributes.connection_status.reason_for_termination :=
          rfc$media_failure;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
          status);
        log_network_failure(nad_index, connection^.control_message_header, path_status_table);
      ELSE
        {  should be a connect in progress  }
      CASEND;

    = rfc$ps_established =
      CASE  path_status_table^.path_clarifier  OF
      = rfc$pce_normal, rfc$pce_local_host_uninformed =
        {  path in normal state }
      = rfc$pce_local_disconnect_1, rfc$pce_local_disconnect_2 =
        connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
        connection^.connection_attributes.connection_status.reason_for_termination :=
          rfc$local_termination;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
          status);
      = rfc$pce_incoming_disconnect =
        connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
        connection^.connection_attributes.connection_status.reason_for_termination :=
          rfc$peer_termination;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
          status);
      ELSE  { invalid state clarifier }
        connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
        connection^.connection_attributes.connection_status.reason_for_termination :=
          rfc$media_failure;
        osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
          status);
      CASEND;

    = rfc$ps_flushing =      { treat as a remote disconnect }
      connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
      connection^.connection_attributes.connection_status.reason_for_termination :=
        rfc$peer_termination;
      osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
        status);

    = rfc$ps_aborted =       { treat as a media failure }
      connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
      connection^.connection_attributes.connection_status.reason_for_termination :=
        rfc$media_failure;
      osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
        status);
      log_network_failure(nad_index, connection^.control_message_header, path_status_table);

    ELSE                     { unknown state, treat as media failure }

      connection^.connection_attributes.connection_status.connection_state := rfc$terminated;
      connection^.connection_attributes.connection_status.reason_for_termination :=
        rfc$media_failure;
      osp$set_status_abnormal(rfc$product_id, rfe$connection_terminated, connection^.connection_name,
        status);
    CASEND;

  PROCEND set_connection_status;
?? NEWTITLE := '        LOG_NETWORK_FAILURE' ??
?? EJECT ??
  PROCEDURE log_network_failure(nad_index: rft$local_nads;
                                cm_routing: rft$nbp_control_message_header;
                                path_status_table: ^rft$path_status_table);

{    The purpose of this routine is to extract the information from the path status table
{    and log it in the engineering log.
{
{    nad_index: (input) This parameter contains the index of the corresponding NAD.
{
{    cm_routing: (input) This parameter contains the control message routing information
{      which is used to find a matching path.
{
{    path_status_table: (input) This parameter contains the pointer to the path status table.


   VAR
        rfv$log_network_break_rc: [STATIC,READ,oss$job_paged_literal] ARRAY [0..28] OF BOOLEAN :=
          [TRUE,TRUE,TRUE,FALSE,TRUE,TRUE,FALSE,FALSE,TRUE,TRUE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,
           FALSE,FALSE,TRUE,FALSE,FALSE,TRUE,FALSE,FALSE,FALSE,TRUE,TRUE,TRUE,FALSE];

    VAR
        concurrent_channel_flag: integer,
        pp_number: 0..31,
        descriptor_data: ost$string,
        counters: ^ARRAY [1..*] OF sft$counter,
        message: ^STRING(*),
        tcu_index: rfc$min_tcu..rfc$max_tcu,
        local_nad: ^rft$local_nad_entry,
        reason_code: INTEGER,
        paths: ^rft$lcn_paths,
        path_entry: ^rft$lcn_path_definition,
        current_time: INTEGER,
        iou_number: dst$iou_number,
        ignore_status: ost$status,
        generate_log: BOOLEAN,
        remote_host_entry: ^rft$remote_host_definition;


    {   Find matching path in the RHFAM configuration file.

    paths := rfv$status_table.local_host^.associated_paths;
    find_matching_path(paths, nad_index, cm_routing, path_entry);
    IF  path_entry = NIL  THEN
      remote_host_entry := rfv$status_table.remote_hosts;

    /check_remote_paths/
      WHILE  remote_host_entry <> NIL  DO
        paths := remote_host_entry^.associated_paths;
        find_matching_path(paths, nad_index, cm_routing, path_entry);
        IF  path_entry <> NIL  THEN
          EXIT /check_remote_paths/;
        IFEND;
        remote_host_entry := remote_host_entry^.next_entry;
      WHILEND /check_remote_paths/;
    IFEND;

    IF  path_entry <> NIL  THEN
      reason_code := path_status_table^.receive_code.reason_code;
      IF  (reason_code <> rfc$ctnrc_path_disappeared)  THEN
        pmp$get_microsecond_clock(current_time, ignore_status);
        rfp$lock_table(rfv$status_table.lock);
        path_entry^.failure_count := path_entry^.failure_count + 1;
        IF  NOT path_entry^.disabled  THEN
          path_entry^.time_disabled := current_time;
          path_entry^.disabled := TRUE;
        IFEND;
        IF  (path_entry^.last_network_break_rc <> reason_code)  OR
            (path_entry^.failure_count = 1)  THEN
          path_entry^.last_network_break_rc := reason_code;
          generate_log := TRUE;
        ELSE
          generate_log := FALSE;
        IFEND;
        rfp$unlock_table(rfv$status_table.lock);
        IF  (generate_log)  AND
            ((reason_code >= 0)  AND  (reason_code <= 28))  AND
            (rfv$log_network_break_rc[reason_code])  THEN

          {  send log message to engineering log  }

          local_nad := ^rfv$status_table.local_nads^[path_entry^.local_nad];
          PUSH  counters : [1..20];
          cmp$return_desc_data_by_lun_lpn(local_nad^.logical_unit_number,
            local_nad^.pp[1].pp_number, iou_number, descriptor_data, pp_number);
          PUSH  message : [descriptor_data.size+4+25];
          message^(1,descriptor_data.size) := descriptor_data.value;
          message^(descriptor_data.size+1,4) := '*IM*';
          message^(descriptor_data.size+1+4,25) := rfv$network_failure_symptoms[rfc$connection_failure];

          concurrent_channel_flag :=0;
          IF local_nad^.concurrent_channel THEN
            concurrent_channel_flag := 1*40(16);
          IFEND;
          counters^[1] := pp_number + concurrent_channel_flag + iou_number * 1000(16);
          counters^[2] := local_nad^.channel_number + concurrent_channel_flag + iou_number * 1000(16);
          counters^[3] := 0;
          counters^[4] := 0;
          counters^[5] := 1;   { $380-170 }
          counters^[6] := 0;
          counters^[7] := 3;   { informative message }
          counters^[8] := ORD(rfc$connection_failure);
          counters^[9] := 0;
          counters^[10] := path_status_table^.my_id;
          counters^[11] := reason_code;
          counters^[12] := 0;
          counters^[13] := 0;
          IF  path_entry^.local_tcu_mask[0]  THEN
            counters^[12] := counters^[12] + 1;
          IFEND;
          IF  path_entry^.local_tcu_mask[1]  THEN
            counters^[12] := counters^[12] + 2;
          IFEND;
          IF  path_entry^.local_tcu_mask[2]  THEN
            counters^[12] := counters^[12] + 4;
          IFEND;
          IF  path_entry^.local_tcu_mask[3]  THEN
            counters^[12] := counters^[12] + 8;
          IFEND;
          IF  path_entry^.remote_tcu_mask[0]  THEN
            counters^[13] := counters^[13] + 1;
          IFEND;
          IF  path_entry^.remote_tcu_mask[1]  THEN
            counters^[13] := counters^[13] + 2;
          IFEND;
          IF  path_entry^.remote_tcu_mask[2]  THEN
            counters^[13] := counters^[13] + 4;
          IFEND;
          IF  path_entry^.remote_tcu_mask[3]  THEN
            counters^[13] := counters^[13] + 8;
          IFEND;
          counters^[14] := cm_routing.nad_address;
          counters^[15] := path_entry^.logical_network;
          counters^[16] := path_entry^.logical_nad;
          counters^[17] := path_status_table^.receive_code.logical_network;
          counters^[18] := path_status_table^.receive_code.nad_address;
          counters^[19] := path_status_table^.receive_code.hop_count;
          counters^[20] := path_status_table^.his_id;
          sfp$emit_statistic(cml$rhfam_network_failure, message^, counters, ignore_status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND log_network_failure;
?? NEWTITLE := '          FIND_MATCHING_PATH' ??
?? EJECT ??
  PROCEDURE find_matching_path(paths: ^rft$lcn_paths;
                               nad_index: rft$local_nads;
                               cm_routing: rft$nbp_control_message_header;
                           VAR path: ^rft$lcn_path_definition);

{    The purpose of this routine is to match LCN routing parameters with the
{    paths defined in the currently active configuration file.
{
{    paths: (input) This parameter specifies a list of paths to compare against the
{      routing information.
{
{    nad_index: (input) This parameter specifies the index of the local NAD that
{      received the routing block.
{
{    cm_routing: (input) This parameter specifies the routing information of a
{      corresponding network path.
{
{    path: (output) This parameter returns a pointer to the matching path entry.  A value
{      of NIL means that no matching path was found.


    VAR
        path_index: INTEGER,
        tcu_index: rfc$min_tcu .. rfc$max_tcu,
        path_entry: ^rft$lcn_path_definition;

    path := NIL;
    IF paths <> NIL  THEN
    /find_path/
      FOR  path_index := 1  TO  UPPERBOUND(paths^)  DO
        path_entry := ^paths^[path_index];
        IF  (nad_index = path_entry^.local_nad) AND
            (((path_entry^.loopback) AND
              (cm_routing.nad_address =
                     rfv$status_table.local_nads^[path_entry^.destination_nad].address)) OR
             ((NOT path_entry^.loopback) AND
              (cm_routing.nad_address =
                     rfv$status_table.remote_nads^[path_entry^.remote_nad].address)))  AND
            (cm_routing.logical_network = path_entry^.logical_network)  AND
            (cm_routing.logical_nad = path_entry^.logical_nad)  AND
            (cm_routing.destination_device = path_entry^.destination_device)  THEN
          FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
            IF  cm_routing.local_tcu_enables[tcu_index]  AND
                path_entry^.local_tcu_mask[tcu_index]  THEN
              path := path_entry;
              EXIT /find_path/;
            IFEND;
          FOREND;
        IFEND;
      FOREND /find_path/;
    IFEND;

  PROCEND find_matching_path;
?? OLDTITLE ??
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '    PROCESS_SEND_CTRL_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_send_ctrl_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                        pp_response: ^iot$pp_response;
                                        detailed_status: ^rft$detailed_status;
                                    VAR current_request: ^rft$outstanding_requests;
                                    VAR release_request: BOOLEAN;
                                    VAR status: ost$status);

{    The purpose of this procedure is to process a completed send control message request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        request_size: INTEGER,
        abnormal_stat: iot$abnormal_status,
        abnormal_status: ^rft$abnormal_status,
        local_nad: ^rft$local_nad_entry,
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        entry_to_free,
        current_entry: ^rft$outgoing_control_message,
        control_message: ^rft$nbp_control_message,
        control_message_text_size: ^rft$control_message_text,
        table_locked,
        recoverable: BOOLEAN,
        ignore_status: ost$status;

  /main_section/
    BEGIN

      local_nad := ^rfv$status_table.local_nads^[current_request^.request_id.ring_3_id.nad];
      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN
        rfp$delink_request(current_request^.request_id, status);
        rfp$lock_table(local_nad^.outgoing_cm_queue.lock);
        table_locked := TRUE;

      /queue_next_request/
        BEGIN

          {   Make sure the queue has not been flushed by a termination request  }

          IF  (local_nad^.outgoing_cm_queue.first_entry <> NIL)  THEN

            {  Clear out the message that was just sent  }

            entry_to_free := local_nad^.outgoing_cm_queue.first_entry;
            local_nad^.outgoing_cm_queue.first_entry := entry_to_free^.next_entry;
            current_entry := local_nad^.outgoing_cm_queue.first_entry;
            FREE  entry_to_free  IN  nav$network_paged_heap^;
            IF  current_entry <> NIL  THEN
              request_size := #SIZE(rft$logical_commands) + #SIZE(rft$control_message_text) +
                rfc$max_control_message_size;
              PUSH  request_info : [[REP request_size OF CELL]];
              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, 'command id too big',
                  status);
                osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_SEND_CTRL_RESPONSE',
                  status);
                EXIT /queue_next_request/;
              IFEND;
              command_identifier^ := rfc$lc_send_control_message;
              NEXT  control_message_text_size IN  request_info;
              IF  control_message_text_size = NIL  THEN
                osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'text size too big',
                  status);
                osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_SEND_CTRL_RESPONSE',
                  status);
                EXIT /queue_next_request/;
              IFEND;
              control_message_text_size^ := #SIZE(current_entry^.control_message.data);
              NEXT  control_message : [control_message_text_size^] IN  request_info;
              IF  control_message = NIL  THEN
                osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'message too big',
                  status);
                osp$append_status_parameter(osc$status_parameter_delimiter, 'PROCESS_SEND_CTRL_RESPONSE',
                  status);
                EXIT /queue_next_request/;
              IFEND;
              control_message^ := current_entry^.control_message;
              rfp$unlock_table(local_nad^.outgoing_cm_queue.lock);
              table_locked := FALSE;
              rfp$post_request(request_info, current_request^.request_id, status);
              IF  status.normal  THEN
                release_request := FALSE;
                EXIT /main_section/;
              IFEND;
            IFEND;
          IFEND;
        END /queue_next_request/;
        local_nad^.processing_out_control_mess := FALSE;
        IF  table_locked  THEN
          rfp$unlock_table(local_nad^.outgoing_cm_queue.lock);
        IFEND;

      ELSE  {  ioc$abnormal_response  }

        abnormal_stat := pp_response^.abnormal_status;
        abnormal_status := #LOC(abnormal_stat);
        IF  NOT ((abnormal_status^.invalid_status_value)
                 AND ((detailed_status^.last_mc_status.response = rfc$nr_transfer_not_ready) OR
                      (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge))
                 AND (NOT detailed_status^.last_mc_status.hardware_fault))  THEN
          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, current_request^.request_id.ring_3_id.nad, 0, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
        IFEND;
        rfp$delink_request(current_request^.request_id, ignore_status);
        relink_control_message_queue(local_nad);
      IFEND;
    END /main_section/;

  PROCEND process_send_ctrl_response;
?? NEWTITLE := '      RELINK_CONTROL_MESSAGE_QUEUE' ??
?? EJECT ??
  PROCEDURE relink_control_message_queue(local_nad: ^rft$local_nad_entry);

{    This routine is called after a failure to send a control message.  This routine will
{    flush all control messages associated with a disconnected path.  If there are no
{    messages removed from this queue then a check is made to see if there are any
{    messages destined for a remote NAD that is not the same as the destination NAD
{    for the entry at the head of the list.  If such a message is found it is placed at the
{    head of the list.  This is to help regulate data flow when NAD saturation cases are encountered.
{
{    local_nad: (input) This parameter specifies a pointer to the local NAD entry.

    VAR
        entry_flushed: BOOLEAN,
        connection: rft$concurrent_connections,
        destination_nad: rft$nad_address,
        previous_entry,
        entry_to_flush,
        current_entry: ^rft$outgoing_control_message;

    entry_flushed := FALSE;
    rfp$lock_table(local_nad^.outgoing_cm_queue.lock);

    {   We should free all entries associated with a terminated path.

    current_entry := local_nad^.outgoing_cm_queue.first_entry;
    IF  current_entry <> NIL  THEN
      destination_nad := current_entry^.control_message.header.nad_address;
      previous_entry := NIL;
      REPEAT
        connection := current_entry^.control_message.header.my_path_id;
        IF  (local_nad^.connection_table^[connection].connection_state <> rfc$ps_established) OR
            (local_nad^.connection_table^[connection].connection_clarifier <> rfc$pce_normal) OR
            (current_entry^.purge_on_retry)  THEN
          entry_flushed := TRUE;
          entry_to_flush := current_entry;
          current_entry := current_entry^.next_entry;
          FREE  entry_to_flush  IN  nav$network_paged_heap^;
          IF  previous_entry = NIL  THEN
            local_nad^.outgoing_cm_queue.first_entry := current_entry;
          ELSE
            previous_entry^.next_entry := current_entry;
          IFEND;
        ELSE
          previous_entry := current_entry;
          current_entry := current_entry^.next_entry;
        IFEND;
      UNTIL  current_entry = NIL;
      IF  NOT entry_flushed  THEN
        current_entry := local_nad^.outgoing_cm_queue.first_entry;
        previous_entry := NIL;
      /rethread_queue/
        WHILE  current_entry <> NIL  DO
          IF  current_entry^.control_message.header.nad_address <> destination_nad  THEN
            IF  previous_entry <> NIL  THEN
              previous_entry^.next_entry := current_entry^.next_entry;
              current_entry^.next_entry := local_nad^.outgoing_cm_queue.first_entry;
              local_nad^.outgoing_cm_queue.first_entry := current_entry;
            IFEND;
            EXIT /rethread_queue/;
          ELSE
            previous_entry := current_entry;
            current_entry := current_entry^.next_entry;
          IFEND;
        WHILEND  /rethread_queue/;
      IFEND;
    IFEND;
    local_nad^.processing_out_control_mess := FALSE;
    rfp$unlock_table(local_nad^.outgoing_cm_queue.lock);

  PROCEND relink_control_message_queue;
?? OLDTITLE ??
?? TITLE := '    PROCESS_REC_CTRL_RESPONSE' ??
?? EJECT ??
  PROCEDURE  process_rec_ctrl_response(command_buff: ^ARRAY [rft$command_entry] OF rft$command;
                                       pp_response: ^iot$pp_response;
                                       detailed_status: ^rft$detailed_status;
                                   VAR current_request: ^rft$outstanding_requests;
                                   VAR release_request: BOOLEAN;
                                   VAR status: ost$status);

{    The purpose of this procedure is to process a completed receive control message request.
{
{    command_buff: (input) This parameter specifies a pointer to the command buffer of the
{      corresponding request.
{
{    pp_response: (input) This parameter speicifies a pointer to the corresponding pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status (if any).
{
{    current_request: (input,output) This parameter specifies the pointer to the completed request.
{
{    release_request: (input,output) This parameter states whether the corresponding request has been
{      completed and should be removed from the outstanding request queue.  The calling routine must
{      initialize this to TRUE.
{
{    status: (output) This parameter returns the results of the request.  The calling routine must
{      initialize the status to normal.


    VAR
        abnormal_stat: iot$abnormal_status,
        abnormal_status: ^rft$abnormal_status,
        local_nad: ^rft$local_nad_entry,
        data_length: rft$control_message_text,
        control_message: ^rft$nbp_control_message,
        reject_tried,
        recoverable: boolean,
        ignore_status: ost$status;

  /main_section/
    BEGIN
      local_nad := ^rfv$status_table.local_nads^[current_request^.request_id.ring_3_id.nad];
      IF  pp_response^.response_code.primary_response = ioc$normal_response  THEN
        data_length := command_buff^[rfc$cbi_unit_request_1].lc_length -
          #SIZE(rft$nbp_control_message_header);
        PUSH control_message : [data_length];
        i#move(#LOC(command_buff^[rfc$cbi_general_buffer]), #LOC(control_message^),
          command_buff^[rfc$cbi_unit_request_1].lc_length);
        process_control_message(control_message, current_request^.request_id.ring_3_id.nad,
          control_message^.header.my_path_id,
          command_buff^[rfc$cbi_unit_request_1].lc_flags.rejected_control_message);
        rfp$delink_request(current_request^.request_id, status);
        get_next_control_message(current_request, local_nad, FALSE, status);
        IF  status.normal  THEN
          release_request := FALSE;
        ELSE
          local_nad^.processing_in_control_mess := FALSE;
        IFEND;

      ELSE  {  ioc$abnormal_response  }

        abnormal_stat := pp_response^.abnormal_status;
        abnormal_status := #LOC(abnormal_stat);
        IF  (abnormal_status^.invalid_status_value)
            AND ((detailed_status^.last_mc_status.response = rfc$nr_transfer_not_ready) OR
                 (detailed_status^.last_mc_status.response = rfc$nr_negative_acknowledge))
            AND (NOT detailed_status^.last_mc_status.hardware_fault)  THEN
          reject_tried := command_buff^[rfc$cbi_unit_request_1].lc_flags.rejected_control_message;
          rfp$delink_request(current_request^.request_id, ignore_status);
          IF  reject_tried  THEN
            local_nad^.processing_in_control_mess := FALSE;
          ELSE
            get_next_control_message(current_request, local_nad, TRUE, status);
            IF  status.normal  THEN
              release_request := FALSE;
            ELSE
              local_nad^.processing_in_control_mess := FALSE;
            IFEND;
          IFEND;
        ELSE
          log_nad_error(pp_response, detailed_status, current_request^.request_kind,
            current_request^.retry_count, current_request^.request_id.ring_3_id.nad, 0, FALSE, recoverable);
          IF  recoverable  THEN
            current_request^.retry_count := current_request^.retry_count + 1;
            rfp$re_issue_request(current_request^.request_id, status);
            IF  status.normal  THEN
              release_request := FALSE;
              EXIT /main_section/;
            IFEND;
          IFEND;
          rfp$delink_request(current_request^.request_id, ignore_status);
          local_nad^.processing_in_control_mess := FALSE;
          local_nad^.connection_table^[0].input_available := FALSE;
        IFEND;
      IFEND;
    END /main_section/;

  PROCEND process_rec_ctrl_response;
?? NEWTITLE := '      GET_NEXT_CONTROL_MESSAGE' ??
?? EJECT ??
  PROCEDURE  get_next_control_message(VAR current_request: ^rft$outstanding_requests;
                                          local_nad: ^rft$local_nad_entry;
                                          get_rejected_control_message: BOOLEAN;
                                      VAR status: ost$status);

    VAR
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        rejected_control_message: ^BOOLEAN,
        physical_from: ^rft$physical_from;

  /process_incoming_messages/
    BEGIN
      PUSH  request_info : [[rft$logical_commands,BOOLEAN,rft$physical_from]];
      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, 'command id too big',
          status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'GET_NEXT_CONTROL_MESSAGE',
          status);
        EXIT /process_incoming_messages/;
      IFEND;
      command_identifier^ := rfc$lc_receive_control_message;
      NEXT  rejected_control_message  IN  request_info;
      IF  rejected_control_message = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'reject flag too big',
          status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'GET_NEXT_CONTROL_MESSAGE',
          status);
        EXIT /process_incoming_messages/;
      IFEND;
      rejected_control_message^ := get_rejected_control_message;
      NEXT  physical_from  IN  request_info;
      IF  physical_from = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'physical from too big',
          status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'GET_NEXT_CONTROL_MESSAGE',
          status);
        EXIT /process_incoming_messages/;
      IFEND;
      physical_from^.compare_name := TRUE;
      physical_from^.criteria := rfc$pf_match_first_character;
      physical_from^.char1 := rfv$status_table.local_host^.subsystem_identifier(1,1);
      RESET request_info;
      rfp$post_request(request_info, current_request^.request_id, status);
    END /process_incoming_messages/;

  PROCEND get_next_control_message;
?? TITLE := '      PROCESS_CONTROL_MESSAGE' ??
?? EJECT ??
  PROCEDURE  process_control_message(control_message: ^rft$nbp_control_message;
                                     nad_index: rft$local_nads;
                                     connection_number: rft$concurrent_connections;
                                     rejected: BOOLEAN);

{    The purpose of this routine is to process incoming control messages.
{
{    control_message: (input) This parameter specifies the incoming control message that
{      was received.
{
{    nad_index: (input) This parameter specifies the nad that the incoming control message
{      was received from.
{
{    connection_number: (input) This parameter specifies the connection number of the
{      destination path.
{
{    rejected: (input) This parameter specifies whether the control message was a rejected
{      control message.

    VAR
        status: ost$status,
        connection_entry: ^rft$connection_entry,
        local_nad: ^rft$local_nad_entry,
        rejected_string: STRING(11);

    local_nad := ^rfv$status_table.local_nads^[nad_index];
    IF  (NOT rejected)  AND
        (control_message^.header.block_type = rfc$nbp_block_type_back)  THEN
      rfp$lock_table(local_nad^.connection_table_lock);
      connection_entry := local_nad^.connection_table^[connection_number].connection_table_entry;
      IF  connection_entry <> NIL  THEN
        rfp$lock_table(connection_entry^.lock);
        connection_entry^.connection_attributes.acks_received_count :=
          connection_entry^.connection_attributes.acks_received_count + 1;
        rfp$unlock_table(connection_entry^.lock);
      IFEND;
      rfp$unlock_table(local_nad^.connection_table_lock);
    ELSE
      IF  rejected  THEN
        rejected_string := 'A REJECTED';
      ELSE
        rejected_string := 'AN ABNORMAL';
      IFEND;
      osp$set_status_abnormal(rfc$product_id, rfe$unexpected_control_message, rejected_string, status);
      osp$append_status_parameter(osc$status_parameter_delimiter, local_nad^.name, status);
      osp$append_status_integer(osc$status_parameter_delimiter, control_message^.header.my_path_id, 10,
        FALSE, status);
      osp$append_status_integer(osc$status_parameter_delimiter, control_message^.header.his_path_id, 10,
        FALSE, status);
      osp$append_status_integer(osc$status_parameter_delimiter, control_message^.header.block_type,  10,
        FALSE, status);
      rfp$log_the_status(status);
    IFEND;

  PROCEND process_control_message;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '  MISCELLANEOUS ERROR PROCESSING ROUTINES' ??
?? NEWTITLE := '    LOG_NAD_ERROR' ??
?? EJECT ??
  PROCEDURE  log_nad_error(pp_response: ^iot$pp_response;
                           detailed_status: ^rft$detailed_status;
                           request_kind: rft$nad_request_kinds;
                           retry_count: 0..rfc$max_nad_retries;
                           nad_index: rft$local_nads;
                           connection_number: rft$concurrent_connections;
                           retry_on_processor_halt: BOOLEAN;
                       VAR recoverable: BOOLEAN);

{    The purpose of this request is to extract all meaningful information from an abnormal
{    NAD status and log appropriate diagnostics.
{
{    pp_response: (input) This parameter specifies the pointer to the response buffer.
{
{    detailed_status: (input) This parameter specifies the pointer to the detailed status buffer.
{
{    request_kind: (input) This parameter specifies the NAD function sequence that was currently
{      being executed.
{
{    retry_count: (input) This parameter speicifies the number of retries that have been attempted.
{
{    nad_index: (input) This parameter specifies the local nad table index of the corresponding
{      local NAD.
{
{    connection_number: (input) This parameter specifies the connection number of the local
{      path that was being processed at the time of the failure.  A value of zero means
{      that a non-path related function was issued.
{
{    retry_on_processor_halt: (input)  This parameter specifies whether or not retries are
{      permissible on a processor halt condition.
{
{    recoverable: (output) This parameter returns a value stating whether or not the request can
{      be retried.


    VAR
        transfer_status: rft$transfer_state,
        abnormal_stat: iot$abnormal_status,
        nad_requires_maintenance: BOOLEAN,
        status: ost$status,
        abnormal_status: ^rft$abnormal_status;

    recoverable := FALSE;
    nad_requires_maintenance := FALSE;

    abnormal_stat := pp_response^.abnormal_status;
    abnormal_status := #LOC(abnormal_stat);
    IF  abnormal_status^.alert_condition_encountered  THEN
      log_alert_condition(pp_response^.alert_conditions, pp_response^.alert_mask, request_kind,
        transfer_status, status);
      IF request_kind <> rfc$rk_disconnect_path THEN

{     Note - During the disconnect path function, this code is running under file management code
{       that prevents the logging of error messages because the local file table is locked.

        rfp$log_the_status(status);
      IFEND;
    ELSEIF  abnormal_status^.interface_error  THEN
      log_interface_error(pp_response^.interface_error_code, request_kind, status);
      IF request_kind <> rfc$rk_disconnect_path THEN

{     Note - During the disconnect path function, this code is running under file management code
{       that prevents the logging of error messages because the local file table is locked.

        rfp$log_the_status(status);
      IFEND;

    ELSE  {  all other conditions should be NAD processing errors.

      log_nad_processing_error(pp_response, detailed_status, abnormal_status, request_kind,
        retry_on_processor_halt, retry_count, nad_index, connection_number, recoverable);
    IFEND;

  PROCEND log_nad_error;
?? NEWTITLE := '      LOG_ALERT_CONDITION' ??
?? EJECT ??
  PROCEDURE  log_alert_condition(alert_condition: iot$alert_conditions;
                                 alert_mask: iot$alert_conditions;
                                 request_kind: rft$nad_request_kinds;
                             VAR transfer_status: rft$transfer_state;
                             VAR status: ost$status);

{    This routine is used to generate a log message for an alert condition.  This routine also
{    returns the current transfer status, as determined by the alert condition that was
{    encountered.
{
{    alert_condition: (input) This parameter specifies the condition that was encountered.
{
{    request_kind: (input) This parameter specifies the NAD function sequence that was currently
{      being executed.
{
{    transfer_status: (output) This parameter returns the current transfer status based on the
{      alert condition encountered.
{
{    status: (output) This parameter contains the message to log.

    VAR
        condition_string: STRING(28),
        switch_condition_ptr: ^cell,
        condition: ^rft$alert_conditions,
        mask: ^rft$alert_conditions;

    condition := #LOC(alert_condition);
    mask := #LOC(alert_mask);
    transfer_status.transfer_state := rfc$ts_alert;

    IF  condition^.end_of_message  AND  mask^.end_of_message  THEN
      condition_string := 'end of message encountered  ';
      transfer_status.alert_kind := rfc$ak_end_of_message;

    ELSEIF  condition^.eoi_mark_encountered  AND  mask^.eoi_mark_encountered  THEN
      condition_string := 'eoi mark encountered       ';
      transfer_status.alert_kind := rfc$ak_eoi_block;

    ELSEIF  condition^.eof_mark_encountered  AND  mask^.eof_mark_encountered  THEN
      condition_string := 'eof mark encountered       ';
      transfer_status.alert_kind := rfc$ak_eof_block;

    ELSEIF  condition^.eor_mark_encountered  AND  mask^.eor_mark_encountered  THEN
      condition_string := 'eor mark encountered       ';
      transfer_status.alert_kind := rfc$ak_eor_block;

    ELSEIF  condition^.pru_block_next  AND  mask^.pru_block_next  THEN
      condition_string := 'record block encountered    ';
      transfer_status.alert_kind := rfc$ak_record_block;

    ELSEIF  condition^.non_pru_block_next  AND  mask^.non_pru_block_next  THEN
      condition_string := 'message block encountered   ';
      transfer_status.alert_kind := rfc$ak_message_block;

    ELSEIF  condition^.long_input_block  AND  mask^.long_input_block  THEN
      condition_string := 'long input block encountered';
      transfer_status.alert_kind := rfc$ak_long_input;

    ELSE  {  unknown alert condition   }
      condition_string := 'unknown alert encountered   ';

      {  This should never happen.  To prevent further errors, an EOI status is returned.
      {  This will fake the caller into thinking the transfer has ended, which will cause
      {  termination processing to occur.

      transfer_status.alert_kind := rfc$ak_eoi_block;
    IFEND;

    osp$set_status_abnormal(rfc$product_id, rfe$alert_condition, condition_string, status);
    osp$append_status_parameter(osc$status_parameter_delimiter, rfv$request_names[request_kind],
      status);

  PROCEND log_alert_condition;
?? TITLE := '      LOG_INTERFACE_ERROR' ??
?? EJECT ??
  PROCEDURE  log_interface_error(interface_error_code: iot$interface_error_code;
                                 request_kind: rft$nad_request_kinds;
                             VAR status: ost$status);

{    The purpose of this routine is to generate a log message for an invalid status condition.
{
{    interface_error_code: (input) This parameter specifies the interface error code that was
{      returned from the pp.
{
{    request_kind: (input) This parameter specifies the NAD function sequence that was currently
{      being executed.
{
{    status: (output) This parameter contains the formatted message.

    VAR
        iec_string: STRING(23);

    CASE  interface_error_code  OF
    = 020A(16) =
      iec_string := 'unknown channel number ';
    = 0211(16) =
      iec_string := 'maximum units exceeded ';
    = 0220(16) =
      iec_string := 'invalid PP number      ';
    = 0301(16) =
      iec_string := 'LUN in UD <> LUN in UIT';
    = 0306(16) =
      iec_string := 'invalid unit type      ';
    = 0501(16) =
      iec_string := 'invalid command code   ';
    = 0503(16) =
      iec_string := 'channel hardware error ';
    = 0505(16) =
      iec_string := 'length error in command';
    = 050B(16) =
      iec_string := 'invalid parameter value';
    ELSE
      iec_string := 'unknown interface error';
    CASEND;

    osp$set_status_abnormal(rfc$product_id, rfe$interface_error, iec_string, status);
    osp$append_status_parameter(osc$status_parameter_delimiter, rfv$request_names[request_kind],
      status);

  PROCEND log_interface_error;
?? TITLE := '      LOG_NAD_PROCESSING_ERROR' ??
?? EJECT ??
  PROCEDURE  log_nad_processing_error(pp_response: ^iot$pp_response;
                                      detailed_status: ^rft$detailed_status;
                                      abnormal_status: ^rft$abnormal_status;
                                      request_kind: rft$nad_request_kinds;
                                      retry_on_processor_halt: BOOLEAN;
                                      retry_count: 0..rfc$max_nad_retries;
                                      nad_index: rft$local_nads;
                                      connection_number: rft$concurrent_connections;
                                  VAR recoverable: BOOLEAN);

{    The purpose of this procedure is to generate a log message for a NAD interface error.
{
{    pp_response: (input) This parameter specifies a pointer to the pp response.
{
{    detailed_status: (input) This parameter specifies a pointer to the detailed status field.
{
{    abnormal_status: (input) This parameter specifies a pointer to the abnormal status that was
{      returned by the PP.
{
{    request_kind: (input) This parameter specifies the NAD function sequence that was currently
{      being executed.
{
{    retry_on_processor_halt: (input) This parameter specifies whether or not retries are
{      allowed if the processor is not running (used for dumps and loads).
{
{    retry_count: (input) This parameter specifies the number of retries that have been
{      made while attempting to complete this request.
{
{    nad_index: (input) This parameter specifies the local NAD that failed.
{
{    connection_number: (input) This parameter specifies the connection number of the local
{      path that was being processed at the time of the failure.  A value of zero means
{      that a non-path related function was issued.
{
{    recoverable: (output) This parameter returns a BOOLEAN value stating whether or not
{      the request is a candidate for retrying.

    TYPE
        output_nad_status = PACKED RECORD
          mc_func: 0..0ffff(16),
          mc_stat: 0..0ffff(16),
          hw_func: 0..0ffff(16),
          hw_stat: 0..0ffff(16),
        RECEND;

    VAR
        pp_number: 0..31,
        concurrent_channel_flag : integer,
        descriptor_data: ost$string,
        iou_number: dst$iou_number,
        ignore: ost$status,
        counters: ^ARRAY [1..*] OF sft$counter,
        message: ^STRING(*),
        local_nad: ^rft$local_nad_entry,
        switch_ptr: ^CELL,
        temp_status: ^output_nad_status,
        severity_value: 0..4,
        symptom: rft$failure_data_symptoms;

    recoverable := FALSE;

    IF  abnormal_status^.function_timeout  THEN
      symptom := rfc$function_timeout;
    ELSEIF  abnormal_status^.channel_activate_failed  THEN
      symptom := rfc$channel_activate_failed;
    ELSEIF  abnormal_status^.channel_hung_empty  THEN
      symptom := rfc$channel_hung_empty;
    ELSEIF  abnormal_status^.prime_flag_timeout  THEN
      symptom := rfc$prime_flag_timeout;
    ELSEIF  abnormal_status^.flag_function_timeout  THEN
      symptom := rfc$flag_function_timeout;
    ELSEIF  abnormal_status^.invalid_status_value  THEN
      symptom := rfc$abnormal_nad_response;
    ELSEIF  abnormal_status^.hardware_fault  THEN
      symptom := rfc$nad_hardware_abnormal;
    ELSEIF  abnormal_status^.input_transfer_abnormal  THEN
      symptom := rfc$input_terminated_early;
    ELSEIF  abnormal_status^.output_transfer_abnormal  THEN
      symptom := rfc$output_terminated_early;
    ELSEIF  abnormal_status^.channel_parity_error  THEN
      symptom := rfc$channel_parity_error;
    ELSEIF  abnormal_status^.universal_command_timeout  THEN
      symptom := rfc$universal_command_timeout;
    ELSE
      {  NAD assumed to be already down  }
      RETURN;
    IFEND;

    IF  detailed_status^.last_hw_status.nad_processor_not_running  THEN
      IF  (retry_count < rfc$max_nad_retries) AND
          (retry_on_processor_halt)  THEN
        rfp$change_nad_status(rfv$status_table.local_nads^[nad_index].logical_unit_number, rfc$es_on);
        recoverable := TRUE;
      IFEND;
    ELSE
      IF  retry_count < rfc$max_nad_retries  THEN
        recoverable := TRUE;
      IFEND;
    IFEND;
    local_nad := ^rfv$status_table.local_nads^[nad_index];
    PUSH  counters : [1..15];
    cmp$return_desc_data_by_lun_lpn(local_nad^.logical_unit_number,
      local_nad^.pp[1].pp_number, iou_number, descriptor_data, pp_number);
    concurrent_channel_flag :=0;
    IF local_nad^.concurrent_channel THEN
      concurrent_channel_flag := 1*40(16);
      IF symptom = rfc$channel_parity_error THEN
        symptom := rfc$concurrent_channel_error
      IFEND;
    IFEND;
    PUSH  message : [descriptor_data.size+4+25];
    message^(1,descriptor_data.size) := descriptor_data.value;
    IF  recoverable  THEN
      message^(descriptor_data.size+1,4) := '*IF*';
      severity_value := 2;
    ELSE
      message^(descriptor_data.size+1,4) := '*UF*';
      severity_value := 1;
    IFEND;
    message^(descriptor_data.size+1+4,25) := rfv$failure_data_symptoms[symptom];
    switch_ptr := detailed_status;
    temp_status := switch_ptr;

    counters^[1] := pp_number + concurrent_channel_flag + iou_number * 1000(16);
    IF symptom = rfc$concurrent_channel_error THEN
      counters^[1] := counters^[1] + pp_response^.interface_error_code * 1000000000000(16)
    IFEND;
    counters^[2] := local_nad^.channel_number + concurrent_channel_flag + iou_number * 1000(16);
    counters^[3] := 0;
    counters^[4] := 0;
    counters^[5] := 1;     { $380-170 }
    counters^[6] := ORD(request_kind);
    counters^[7] := severity_value;
    counters^[8] := ORD(symptom);
    counters^[9] := retry_count;
    counters^[10] := connection_number;
    counters^[11] := temp_status^.mc_func;
    counters^[12] := temp_status^.hw_func;
    counters^[13] := temp_status^.mc_stat;
    counters^[14] := temp_status^.hw_stat;
    counters^[15] := pp_response^.transfer_count;
    sfp$emit_statistic(cml$rhfam_failure_data, message^, counters, ignore);
    IF  NOT recoverable  THEN
      rfp$lock_table(rfv$status_table.lock);
      IF  rfv$status_table.local_nads^[nad_index].current_status.device_status = rfc$es_on  THEN
        rfv$status_table.local_nads^[nad_index].current_status.device_status := rfc$es_down;
      IFEND;
      rfp$unlock_table(rfv$status_table.lock);
    IFEND;

  PROCEND log_nad_processing_error;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '  RFP$QUEUE_REQUEST' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$queue_request(nad_index: rft$local_nads;
                                     pp_index: 1..2;
                                     request_type: rft$request_types;
                                     nad_request: rft$nad_request_kinds;
                                     request_status: ^cell;
                                 VAR request_info: ^SEQ(*);
                                 VAR status: ost$status);

*copyc rfh$queue_request

    VAR
        done: BOOLEAN,
        task_id: ost$global_task_id,
        local_nad: ^rft$local_nad_entry,
        current_request: 0..rfc$max_r3_request_id,
        request: ^rft$outstanding_requests,
        ignore_status: ost$status,
        request_id: rft$request_identifier;

    status.normal := TRUE;

    ALLOCATE  request  IN  osv$task_private_heap^;
    IF  request = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$QUEUE_REQUEST', status);
      RETURN;
    IFEND;
    pmp$get_executing_task_gtid(task_id);
    done := FALSE;
    REPEAT
      rfp$lock_table(rfv$status_table.lock);
      IF  (rfv$system_task_id <> task_id) AND
          ((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;
        rfp$process_pp_response_flag(rfc$pp_response_available);
      IFEND;
    UNTIL done;
    rfp$unlock_table(rfv$status_table.lock);
    IF  NOT status.normal  THEN
      FREE  request  IN  osv$task_private_heap^;
      RETURN;
    IFEND;
    local_nad := ^rfv$status_table.local_nads^[nad_index];
    IF  rfv$outstanding_requests = NIL  THEN
      current_request := 1;
    ELSE
      current_request := (rfv$outstanding_requests^.request_id.ring_3_id.entry + 1)
        MOD rfc$max_r3_request_id;
    IFEND;
    request_id.ring_3_id.entry := current_request;
    request_id.ring_3_id.nad := nad_index;
    request_id.ring_3_id.pp := pp_index;
    request_id.ring_3_id.location.kind := request_type;
    IF  request_type = rfc$unit_request  THEN
      request_id.ring_3_id.location.logical_unit := local_nad^.logical_unit_number;
    ELSE
      request_id.ring_3_id.location.logical_pp := local_nad^.pp[pp_index].pp_number;
    IFEND;
    RESET request_info;
    rfp$post_request(request_info, request_id, status);
    IF  NOT status.normal  THEN
      rfp$lock_table(rfv$status_table.lock);
      local_nad^.requests_posted := local_nad^.requests_posted - 1;
      rfp$unlock_table(rfv$status_table.lock);
      FREE  request  IN  osv$task_private_heap^;
    ELSE
      request^.waiting_event := NIL;
      request^.posted := TRUE;
      request^.processing_request := FALSE;
      request^.request_id := request_id;
      request^.request_status := request_status;
      request^.retry_count := 0;
      request^.request_kind := nad_request;
      request^.next_entry := rfv$outstanding_requests;
      rfv$outstanding_requests := request;
    IFEND;

  PROCEND rfp$queue_request;
?? OLDTITLE ??
MODEND rfm$process_pp_response_flag;
