?? RIGHT := 110 ??
?? TITLE := 'RHFAM/VE : System Task : R23D' ??
?? NEWTITLE := '  Common Decks' ??
module rfm$system_task;
*copyc rft$configuration_defs
?? EJECT ??
*copyc amp$fetch_access_information
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc clp$scan_parameter_list
*copyc cml$rhfam_usage_data
*copyc cmp$convert_channel_ordinal
*copyc cmp$convert_pp_ordinal
*copyc cmp$convert_iou_name
*copyc cmp$search_pp_table
*copyc cmp$execute_pp_program
*copyc cmp$reserve_element
*copyc cmp$release_element
*copyc cmp$get_element_definition
*copyc cmp$get_iou_definition
*copyc cmp$get_logical_unit_number
*copyc cmp$return_desc_data_by_lun_lpn
*copyc cmp$execute_pp_program
*copyc dpp$put_critical_message
*copyc fsp$open_file
*copyc fsp$close_file
*copyc jmv$executing_within_system_job
*copyc nav$network_paged_heap
*copyc nlp$bm_initialize_buffer_pools
*copyc nlv$bm_buffer_pool
*copyc nlc$bm_buffer_pool_index
*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter
*copyc osp$append_status_integer
*copyc osp$establish_condition_handler
*copyc osp$set_status_condition
*copyc osp$set_status_from_condition
*copyc osp$format_message
*copyc oss$job_paged_literal
*copyc osv$task_private_heap
*copyc pfp$attach
*copyc pfp$define
*copyc pfp$define_catalog
*copyc pfp$purge
*copyc pmp$generate_unique_name
*copyc pmp$get_executing_task_gtid
*copyc pmp$log
*copyc pmp$wait
*copyc pmp$get_microsecond_clock
*copyc pmp$ready_task
*copyc pmp$set_system_flag
*copyc pmp$zero_out_table
?? PUSH (LISTEXT := ON) ??
*copyc rfd$mc_initialization_prams
*copyc rfd$path_status_table
*copyc rfe$condition_codes
?? POP ??
*copyc rfp$change_nad_status
*copyc rfp$lock_table
*copyc rfp$move_data_to_wired_buffs
*copyc rfp$process_pp_response_flag
*copyc rfp$queue_request
*copyc rfp$reserve_wired_buffers
*copyc rfp$release_wired_buffers
*copyc rfp$reserve_request_buffers
*copyc rfp$release_request_buffers
*copyc rfp$set_system_task_id
*copyc rfp$start_server_job
*copyc rfp$unconditionally_status
*copyc rfp$unlock_table
*copyc rft$r1_interface_defs
*copyc rfv$network_wired_buffers
*copyc rfv$outstanding_requests
*copyc rfv$pp_interface_error
*copyc rfv$rhfam_server_table
*copyc rfv$rhfam_event_table
*copyc rfv$rhfam_client_table
*copyc rfv$system_task_id
*copyc rfv$status_table
*copyc sfp$emit_statistic
*copyc syp$cycle
*copyc tmv$null_global_task_id
?? TITLE := '  Global Variables' ??
?? EJECT ??
  VAR
      rfv$null_hardware_status: [STATIC,READ,oss$job_paged_literal] rft$nad_status_flags :=
        [rfc$sk_hardware_status,0,FALSE,FALSE,FALSE, FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE];

  VAR
      rfv$null_microcode_status: [STATIC,READ,oss$job_paged_literal] rft$nad_status_flags :=
        [rfc$sk_microcode_status,0,FALSE,FALSE, FALSE,FALSE,FALSE,FALSE,0];

  VAR
      rfv$initial_transfer_length: [STATIC,READ,oss$job_paged_literal] rft$transfer_lgth_addr := [0,0,0,0];

  VAR
      rfv$initial_transfer_address: [STATIC,READ,oss$job_paged_literal] rft$transfer_lgth_addr := [0,0,0,0];
?? TITLE := '  RFP$RHFAM_EVENT_PROCESSOR' ??
?? EJECT ??
  PROCEDURE  [XDCL, #GATE] rfp$rhfam_event_processor  (param_list: clt$parameter_list;
                                                  VAR  status: ost$status);

*copyc rfh$rhfam_event_processor
?? NEWTITLE := '    PROCESS_ABNORMAL_CONDITION' ??
?? EJECT ??
    PROCEDURE  process_abnormal_condition(condition: pmt$condition;
                                          condition_descriptor: ^pmt$condition_information;
                                          save_area: ^ost$stack_frame_save_area;
                                      VAR local_status: ost$status);

    {  The purpose of this procedure is to recognize a task termination condition and to
    {  attempt a graceful termination of the RHFAM/VE system task.
    {
    {  condition: (input) This parameter specifies the condition which caused the condition handler
    {    to be invoked.
    {
    {  condition_descriptor: (input) This parameter specifies a user defined condition.
    {
    {  stack_frame_save_area: (input) This parameter points to the stack frame save area of the
    {    routine that was executing at the time the trap occurred.
    {
    {  local_status: (output) This paramter specifies the current status.

      VAR
          critical_msg: string(40),
          ignore_status: ost$status,
          gtid: ost$global_task_id;

      local_status.normal := TRUE;
      CASE condition.selector OF
      = pmc$block_exit_processing =
        IF  status.normal  THEN
          osp$set_status_from_condition(rfc$product_id, condition, save_area, status, local_status);
          rfp$log_the_status (status);
        ELSE
          critical_msg(1,*) := 'RHFAM is not available.';
          dpp$put_critical_message(critical_msg,ignore_status);
        IFEND;

        pmp$get_executing_task_gtid(gtid);
        IF  gtid = rfv$system_task_id  THEN
          IF abnormal_exit THEN
            rfv$status_table.system_task_is_up := FALSE;
          ELSE
            termination_phase;
          IFEND;
        IFEND;
      = pmc$user_defined_condition =
        ;
      ELSE
        osp$set_status_from_condition(rfc$product_id, condition, save_area, status, local_status);
        rfp$log_the_status (status);
        abnormal_exit := TRUE;
        EXIT rfp$rhfam_event_processor;
      CASEND;

    PROCEND process_abnormal_condition;
?? OLDTITLE ??
?? EJECT ??
    CONST
         appl_startup_interval = 1*1000*1000,          { one second }
         reload_status_interval = 2*1000*1000,         { two seconds }
         nad_availability_interval = 30*1000*1000,     { thrity seconds }
         log_perf_stats_interval = 1*60*60*1000*1000;  { one hour }


    VAR
        reload_status_timer,
        appl_startup_timer,
        nad_availability_timer,
        log_perf_stats_timer,
        current_time: INTEGER,
        abnormal_exit,
        possible_connect_pending: BOOLEAN,
        ignore_status: ost$status;

    status.normal := TRUE;
    IF  NOT jmv$executing_within_system_job  THEN
      osp$set_status_condition ( rfe$invalid_task_origin,  status);
      rfp$log_the_status(status);
      RETURN;
    IFEND;

    abnormal_exit := FALSE;
    osp$establish_condition_handler (^process_abnormal_condition, TRUE);

    initialization_phase(status);
    IF NOT status.normal  THEN
      rfp$log_the_status(status);
      RETURN;
    IFEND;

    pmp$get_microsecond_clock(current_time, ignore_status);
    reload_status_timer := current_time;
    appl_startup_timer := current_time;
    nad_availability_timer := current_time;
    log_perf_stats_timer := current_time;
    possible_connect_pending := FALSE;

    {   The system task will execute forever or until one of the following conditions
    {   occurs:
    {
    {   1)  A catastrophic error is encountered in the local NAD statusing routine.
    {
    {   2)  The system task is terminated.  This shows up as a block exit condition.

 /main_section/
    REPEAT
      pmp$get_microsecond_clock(current_time, ignore_status);

      rfp$local_nad_statusing(current_time, possible_connect_pending, status);
      IF  NOT status.normal  THEN
        rfp$log_the_status(status);
        EXIT /main_section/;
      IFEND;

      IF  (current_time >= (appl_startup_timer + appl_startup_interval)) THEN
        appl_startup_timer := current_time;
        rfp$check_appl_startup(current_time);
      IFEND;

      IF  (current_time >= (reload_status_timer + reload_status_interval)) THEN
        reload_status_timer := current_time;
        rfp$auto_dump_and_reload(current_time);
      IFEND;

      IF  (current_time >= (nad_availability_timer + nad_availability_interval)) THEN
        nad_availability_timer := current_time;
        rfp$check_hardware_available(current_time);
      IFEND;

      IF  (current_time >= (log_perf_stats_timer + log_perf_stats_interval)) THEN
        log_perf_stats_timer := current_time;
        rfp$log_performance_statistics;
      IFEND;

      IF  possible_connect_pending  THEN
        syp$cycle;
      ELSE
        pmp$wait(5000, 100);
      IFEND;
      rfp$process_pp_response_flag(rfc$pp_response_available);

    UNTIL  FALSE;

  PROCEND rfp$rhfam_event_processor;
?? NEWTITLE := '    INITIALIZATION_PHASE' ??
?? EJECT ??
  PROCEDURE  initialization_phase(VAR status: ost$status);

{    This procedure performs the necessary actions to initialize the various RHFAM/VE
{    tables.  A description of the initialization phase activities is given in the
{    header information of this module.
{
{    status: (input) This procedure returns a status of NORMAL if all the initialization
{      activities have been successfully performed.

    VAR
       buffer_count: INTEGER;

    set_system_task_id(status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    activate_current_configuration(status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    reserve_configured_elements(status);
    IF  NOT status.normal  THEN
       RETURN;
    IFEND;

    buffer_count := (UPPERBOUND(rfv$status_table.local_nads^) - LOWERBOUND(rfv$status_table.local_nads^) + 1)
      * rfc$max_concurrent_requests;
    rfp$reserve_request_buffers(buffer_count, status);
    IF  NOT status.normal  THEN
       RETURN;
    IFEND;

    start_the_pps(status);
    IF  NOT status.normal  THEN
       RETURN;
    IFEND;

{   We must currently allocate the NAM/VE buffer pools if NAM/VE has
{   not already done so.  This code should be removed when we have
{   resolved the problem of NAM/VE not always being present.

    IF  nlv$bm_buffer_pool [nlc$bm_large_buffer_index].allocated_memory = NIL  THEN
      nlp$bm_initialize_buffer_pools(status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
    IFEND;

    load_the_nads(status);
    IF  NOT status.normal  THEN
       RETURN;
    IFEND;

{   At this point we can let the rest of the world know that RHFAM/VE is now
{   ready for action.

    rfv$status_table.system_task_is_up := TRUE;

  PROCEND initialization_phase;
?? NEWTITLE := '      SET_SYSTEM_TASK_ID' ??
?? EJECT ??
  PROCEDURE  set_system_task_id(VAR status: ost$status);

{    The purpose of this procedure is to set the system task name in the
{    status table.  This is to prevent multiple system tasks from being
{    initiated.
{
{    status: (output) This parameter returns the results of the request.
{      A status of normal means that the system task can continue to run.

    VAR
        system_startup: [STATIC,READ, oss$job_paged_literal] BOOLEAN := TRUE;

    rfp$lock_table(rfv$status_table.lock);
    IF  rfv$system_task_id = tmv$null_global_task_id  THEN
      rfp$set_system_task_id(system_startup);
    ELSE
      osp$set_status_condition ( rfe$system_task_running,  status);
    IFEND;
    rfp$unlock_table(rfv$status_table.lock);

  PROCEND set_system_task_id;
?? TITLE := '      ACTIVATE_CURRENT_CONFIGURATION' ??
?? EJECT ??
  PROCEDURE  activate_current_configuration(VAR status: ost$status);

{    The purpose of this procedure is to activate the currently installed RHFAM/VE
{    configuration file.  This file is assumed to be highest cycle of
{    $SYSTEM.RHFAM.CONFIGURATION_FILE.  The following procedure is followed to
{    activate the configuration:
{
{         1)  Attach the configuration file and open it for segment access.
{
{         2)  Determine the size of the configuration file and allocate a corresponding
{             amount of space in the network paged heap.
{
{         3)  Move each of the definitions from the configuration file into the heap.
{
{    status: (output) This parameter returns the result of the request.  A normal status
{      means that the above activation procedure was successfully performed.

    VAR
        config_file_lfn: amt$local_file_name,
        config_file_id: amt$file_identifier,
        config_file_ptr: ^SEQ(*),
        current_status_table_ptr: ^SEQ(*),
        unique_name: ost$unique_name,
        ignore_status: ost$status;

    pmp$generate_unique_name(unique_name, ignore_status);
    config_file_lfn := unique_name.value;
    attach_and_validate_file(config_file_lfn, config_file_id, config_file_ptr, status);
    IF  status.normal  THEN
      allocate_status_table(config_file_id, current_status_table_ptr, status);
      IF  status.normal  THEN
        move_defs_to_status_table(config_file_ptr, current_status_table_ptr, status);
        IF  NOT status.normal  THEN
          FREE  rfv$status_table.location  IN  nav$network_paged_heap^;
        IFEND;
      IFEND;
      fsp$close_file(config_file_id, ignore_status);
      amp$return(config_file_lfn, ignore_status);
    IFEND;

  PROCEND activate_current_configuration;
?? NEWTITLE := '        ATTACH_AND_VALIDATE_FILE' ??
?? EJECT ??
  PROCEDURE  attach_and_validate_file(config_file_lfn: amt$local_file_name;
                                      VAR config_file_id: amt$file_identifier;
                                      VAR config_file_ptr: ^SEQ(*);
                                      VAR status: ost$status);

{    The purpose of this procedure is to attach the currently installed
{    RHFAM configuration file and open it for segment access.  This code
{    also checks the configuration file header to verify that the configuration
{    file integrity.
{
{    config_file_lfn: (input) This parameter specifies the local file name of
{      the configuration file.
{
{    config_file_id: (output) This parameter returns the file identifier of the
{      open configuration file.
{
{    config_file_ptr: (output) This parameter returns a pointer within the
{      configuration file to the first entry in the status table (i.e. the
{      first beyond the header).
{
{    status: (output) This parameter returns the results of the request.  A
{      status of normal means that the requested configuration file has been
{      successfully opened.


    VAR
        ignore_status: ost$status,
        segment_ptr: amt$segment_pointer,
        file_open: BOOLEAN,
        configuration_header: ^string(rfc$config_label_length),
        path: ^pft$path,
        password: pft$name,
        usage_selections: pft$usage_selections,
        share_selections: pft$share_selections,
        cycle_selector: pft$cycle_selector;

    PUSH path : [1..4];
    path^[1] := rfc$rhfam_family_name;
    path^[2] := rfc$rhfam_master_catalog;
    path^[3] := rfc$rhfam_sub_catalog;
    path^[4] := rfc$configuration_file;
    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(config_file_lfn, path^, cycle_selector, password, usage_selections, share_selections,
                    pfc$no_wait, status);
    IF  (NOT status.normal)  THEN
      RETURN;
    IFEND;
    file_open := FALSE;

  /main_section/
    BEGIN

      fsp$open_file(config_file_lfn, amc$segment, NIL, NIL, NIL, NIL, NIL,
        config_file_id, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      file_open := TRUE;

      amp$get_segment_pointer(config_file_id, amc$sequence_pointer, segment_ptr, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      RESET segment_ptr.sequence_pointer;
      NEXT configuration_header IN segment_ptr.sequence_pointer;
      IF  configuration_header = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file, 'the file is empty', status);
        EXIT /main_section/;
      IFEND;

      IF  configuration_header^ <> rfc$configuration_label  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file, 'the label is wrong', status);
      IFEND;

    END /main_section/;

    IF  status.normal  THEN
      config_file_ptr := segment_ptr.sequence_pointer;
    ELSE
      IF  file_open  THEN
        fsp$close_file(config_file_id, ignore_status);
      IFEND;
      amp$return(config_file_lfn, ignore_status);
    IFEND;

  PROCEND attach_and_validate_file;
?? NEWTITLE := '          ALLOCATE_STATUS_TABLE' ??
?? EJECT ??
  PROCEDURE  allocate_status_table(config_file_id: amt$file_identifier;
                               VAR current_status_table_ptr: ^SEQ(*);
                               VAR status: ost$status);

{    The purpose of this procedure is to allocate an appropriate amount of space in the network paged
{    section for the RHFAM/VE status table.
{
{    NOTE - The space calculation does not have to take into account the extra alignment
{           overhead because there is an extra word allocated between each group of entries.
{           This word contains the entry count, which is of type INTEGER.
{
{    config_file_id: (input) This parameter specifies the file identifier of the current configuration file.
{
{    current_status_table_ptr: (input,output) This paramter points to the SEQUENCE that has been allocated
{      for the status table.  This parameter is only meaningful if the status is normal.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        access_information: ^amt$access_information,
        byte_size: integer,
        word_size: integer;


    PUSH access_information : [1..1];
    access_information^[1].key := amc$eoi_byte_address;
    amp$fetch_access_information(config_file_id, access_information^, status);
    byte_size := access_information^[1].eoi_byte_address;
    word_size := (byte_size + 7) DIV 8;
    ALLOCATE  rfv$status_table.location : [[REP word_size  OF  integer]]  IN  nav$network_paged_heap^;
    IF  rfv$status_table.location = NIL  THEN
      osp$set_status_condition ( rfe$configuration_too_big,  status);
      RETURN;
    IFEND;
    RESET rfv$status_table.location;
    current_status_table_ptr := rfv$status_table.location;

  PROCEND allocate_status_table;
?? OLDTITLE ??
?? TITLE := '        MOVE_DEFS_TO_STATUS_TABLE' ??
?? EJECT ??
  PROCEDURE  move_defs_to_status_table(VAR config_file_ptr: ^SEQ(*);
                                       VAR current_status_table_ptr: ^SEQ(*);
                                       VAR status: ost$status);

{    The purpose of this procedure is to move the configuration file definitions into
{    the status table.  This procedure also sets up the pointers to the various sub-tables
{    in the global status table (local_nad_table, remote_nad_table, local_host_table,
{    and the remote_host_table);
{
{    NOTE - no interlock is obtained while the status table is being created and the
{           RFV$STATUS_TABLE entries are updated.  This is because there is only one system task
{           running and no other tasks should access the table while the SYSTEM_TASK_IS_RUNNING flag
{           is FALSE.
{
{    config_file_ptr: (input,output) This variable points to the first entry in the configuration file
{      table.  (A RESET must be performed prior to calling this routine).
{
{    current_status_table_ptr: (input,output) This variable points to the first word address of the status
{      table sequence.  (A RESET must be performed prior to calling this routine).
{
{    status: (output) This parameter returns the results of the request.


    move_the_local_host_entry(config_file_ptr, current_status_table_ptr, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    move_the_remote_host_entries(config_file_ptr, current_status_table_ptr, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    move_the_local_nad_entries(config_file_ptr, current_status_table_ptr, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    move_the_remote_nad_entries(config_file_ptr, current_status_table_ptr, status);

  PROCEND move_defs_to_status_table;
?? NEWTITLE := '          ALIGN_SEQ_POINTER' ??
?? EJECT ??
  PROCEDURE [INLINE] align_seq_pointer(size_of_entry: INTEGER;
                                   VAR seq_pointer: ^SEQ(*));

{    The purpose of this routine is to word align the RHFAM status table sequence pointer
{    after each entry is moved into the sequence.  This is to insure that all ALIGNED
{    entries are maintained.
{
{    NOTE - This routine is covering for a CYBIL deficiency.
{
{    size_of_entry: (input) This parameter specifies the size of the entry moved into the
{      the status table.
{
{    seq_pointer: (input, output) This parameter specifies the current pointer to the RHFAM
{      status table sequence.


    VAR
        amount_to_align: 0..7,
        alignment_entry: ^STRING(*);

    amount_to_align := (8 - (size_of_entry MOD 8)) MOD 8;
    NEXT  alignment_entry : [amount_to_align] IN seq_pointer;

  PROCEND align_seq_pointer;
?? TITLE := '          MOVE_THE_LOCAL_HOST_ENTRY' ??
?? EJECT  ??
  PROCEDURE  move_the_local_host_entry(VAR config_file_ptr: ^SEQ(*);
                                       VAR current_status_table_ptr: ^SEQ(*);
                                       VAR status: ost$status);

{    The purpose of this procedure is to move the local host definition from the configuration
{    file into the status_table.
{
{    config_file_ptr: (input,output) Upon entry this variable specifies the pointer to the next
{      element in the configuration file.  Upon exit this parameter points to the element following
{      the local host definition.
{
{    current_status_table_ptr: (input,output) Upon entry this variable specifies the pointer to the next free
{      entry in the status table.  Upon exit this parameter points to the next free entry beyond the
{      local host definition.
{
{    status: (output) This parameter returns the results of the request.  If the returned status is
{      not NORMAL, then all other return parameters are undefined.

    VAR
        lid_count,
        path_count: ^integer,
        path_entry_1,
        path_entry_2: ^rft$lcn_paths,
        local_host_entry_1,
        local_host_entry_2: ^rft$local_host_definition;

    status.normal := TRUE;

    NEXT  lid_count  IN  config_file_ptr;
    IF  lid_count = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local host', status);
      RETURN;
    IFEND;
    NEXT  local_host_entry_1 : [1..lid_count^]  IN  config_file_ptr;
    IF  local_host_entry_1 = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local host', status);
      RETURN;
    IFEND;
    NEXT  local_host_entry_2 : [1..lid_count^]  IN  current_status_table_ptr;
    IF  local_host_entry_2 = NIL  THEN
      osp$set_status_condition ( rfe$configuration_too_big,  status);
      RETURN;
    IFEND;
    align_seq_pointer(#SIZE(local_host_entry_2^), current_status_table_ptr);
    local_host_entry_2^ := local_host_entry_1^;
    rfv$status_table.local_host := local_host_entry_2;
    NEXT  path_count  IN  config_file_ptr;
    IF  path_count = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file,
        'the local host path count is missing', status);
      RETURN;
    IFEND;
    IF  path_count^ <> 0  THEN
      NEXT  path_entry_1 : [1..path_count^]  IN  config_file_ptr;
      IF  path_entry_1 = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file,
          'the local host path count is invalid', status);
        RETURN;
      IFEND;
      NEXT  path_entry_2 : [1..path_count^]  IN  current_status_table_ptr;
      IF  path_entry_2 = NIL  THEN
        osp$set_status_condition ( rfe$configuration_too_big,  status);
        RETURN;
      IFEND;
      align_seq_pointer(#SIZE(path_entry_2^), current_status_table_ptr);
      path_entry_2^ := path_entry_1^;
      rfv$status_table.local_host^.associated_paths := path_entry_2;
    ELSE
      rfv$status_table.local_host^.associated_paths := NIL;
    IFEND;

  PROCEND move_the_local_host_entry;
?? TITLE := '          MOVE_THE_REMOTE_HOST_ENTRIES' ??
?? EJECT  ??
  PROCEDURE  move_the_remote_host_entries(VAR config_file_ptr: ^SEQ(*);
                                          VAR current_status_table_ptr: ^SEQ(*);
                                          VAR status: ost$status);

{    The purpose of this procedure is to move the remote host definitions from the configuration
{    file into the status_table.
{
{    config_file_ptr: (input,output) Upon entry this variable specifies the pointer to the next
{      element in the configuration file.  Upon exit this variable points to the element following
{      the last remote host definition.
{
{    current_status_table_ptr: (input,output) Upon entry this variable specifies the pointer to the next free
{      entry in the status table.  Upon exit this variable points to the next free entry beyond the
{      last remote host definition.
{
{    status: (output) This parameter returns the results of the request.  If the returned status is
{      not NORMAL, then all other return parameters are undefined.

    VAR
        index: integer,
        remote_host_count,
        lid_count,
        path_count: ^integer,
        path_entry_1,
        path_entry_2: ^rft$lcn_paths,
        first_entry: boolean,
        previous_remote_host,
        remote_host_entry_1,
        remote_host_entry_2: ^rft$remote_host_definition;

    status.normal := TRUE;

    NEXT  remote_host_count  IN  config_file_ptr;
    IF  (remote_host_count = NIL)  OR  (remote_host_count^ = 0) THEN
      rfv$status_table.remote_hosts := NIL;
      RETURN;
    IFEND;
    first_entry := TRUE;
    FOR  index := 1  TO  remote_host_count^  DO
      NEXT  lid_count  IN  config_file_ptr;
      IF  lid_count = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file, 'the remote host count is missing',
          status);
        RETURN;
      IFEND;
      NEXT  remote_host_entry_1 : [1..lid_count^]  IN  config_file_ptr;
      IF  remote_host_entry_1 = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file, 'the remote host count is invalid',
          status);
        RETURN;
      IFEND;
      NEXT  remote_host_entry_2 : [1..lid_count^]  IN  current_status_table_ptr;
      IF  remote_host_entry_2 = NIL  THEN
        osp$set_status_condition ( rfe$configuration_too_big,  status);
        RETURN;
      IFEND;
      align_seq_pointer(#SIZE(remote_host_entry_2^), current_status_table_ptr);
      remote_host_entry_2^ := remote_host_entry_1^;
      remote_host_entry_2^.next_entry := NIL;
      IF  first_entry  THEN
        rfv$status_table.remote_hosts := remote_host_entry_2;
        first_entry := FALSE;
        previous_remote_host := remote_host_entry_2;
      ELSE
        previous_remote_host^.next_entry := remote_host_entry_2;
        previous_remote_host := remote_host_entry_2;
      IFEND;
      NEXT  path_count  IN  config_file_ptr;
      IF  path_count = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file,
          'a remote host path count is missing', status);
        RETURN;
      IFEND;
      IF  path_count^ <> 0  THEN
        NEXT  path_entry_1 : [1..path_count^]  IN  config_file_ptr;
        IF  path_entry_1 = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file,
            'a remote host path count is invalid', status);
          RETURN;
        IFEND;
        NEXT  path_entry_2 : [1..path_count^]  IN  current_status_table_ptr;
        IF  path_entry_2 = NIL  THEN
          osp$set_status_condition ( rfe$configuration_too_big,  status);
          RETURN;
        IFEND;
        align_seq_pointer(#SIZE(path_entry_2^), current_status_table_ptr);
        path_entry_2^ := path_entry_1^;
        remote_host_entry_2^.associated_paths := path_entry_2;
      ELSE
        remote_host_entry_2^.associated_paths := NIL;
      IFEND;
    FOREND;

  PROCEND move_the_remote_host_entries;
?? TITLE := '          MOVE_THE_LOCAL_NAD_ENTRIES' ??
?? EJECT  ??
  PROCEDURE  move_the_local_nad_entries(VAR config_file_ptr: ^SEQ(*);
                                        VAR current_status_table_ptr: ^SEQ(*);
                                        VAR status: ost$status);


{    The purpose of this procedure is to move the local nad definitions from the configuration
{    file into the status_table.
{
{    config_file_ptr: (input,output) Upon entry this variable specifies the pointer to the next
{      element in the configuration file.  Upon exit this variable points to the element following
{      the last local nad definition.
{
{    current_status_table_ptr: (input,output) Upon entry this variable specifies the pointer to the next free
{      entry in the status table.  Upon exit this variable points to the next free entry beyond the
{      last local_nad definition.
{
{    status: (output) This parameter returns the results of the request.  If the returned status is
{      not NORMAL, then all other return parameters are undefined.


    VAR
        nad_index: rft$local_nads,
        connection_table: ^rft$connections,
        nad_count: ^integer,
        nad_table_1,
        nad_table_2: ^rft$local_nad_table;

    status.normal := TRUE;

    NEXT  nad_count  IN  config_file_ptr;
    IF  (nad_count = NIL)  OR  (nad_count^ = 0)  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local NAD', status);
      RETURN;
    IFEND;
    NEXT  nad_table_1 : [1..nad_count^]  IN  config_file_ptr;
    IF  nad_table_1 = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local NAD', status);
      RETURN;
    IFEND;
    NEXT  nad_table_2 : [1..nad_count^]  IN  current_status_table_ptr;
    IF  nad_table_2 = NIL  THEN
      osp$set_status_condition ( rfe$configuration_too_big,  status);
      RETURN;
    IFEND;
    align_seq_pointer(#SIZE(nad_table_2^), current_status_table_ptr);
    nad_table_2^ := nad_table_1^;
    rfv$status_table.local_nads := nad_table_2;
    FOR  nad_index := 1  TO  nad_count^  DO
      ALLOCATE connection_table : [0..rfc$max_connections] IN nav$network_paged_heap^;
      IF  connection_table = NIL  THEN
        osp$set_status_condition ( rfe$configuration_too_big,  status);
        RETURN;
      IFEND;
      pmp$zero_out_table(connection_table, #SIZE(connection_table^));
      rfv$status_table.local_nads^[nad_index].connection_table := connection_table;
    FOREND;

  PROCEND move_the_local_nad_entries;
?? TITLE := '          MOVE_THE_REMOTE_NAD_ENTRIES' ??
?? EJECT  ??
  PROCEDURE  move_the_remote_nad_entries(VAR config_file_ptr: ^SEQ(*);
                                         VAR current_status_table_ptr: ^SEQ(*);
                                         VAR status: ost$status);

{    The purpose of this procedure is to move the remote nad definitions from the configuration
{    file into the status_table.
{
{    config_file_ptr: (input,output) Upon entry this variable specifies the pointer to the next
{      element in the configuration file.  Upon exit this variable points to the element following
{      the last remote nad definition.
{
{    current_status_table_ptr: (input,output) Upon entry this variable specifies the pointer to the next free
{      entry in the status table.  Upon exit this variable points to the next free entry beyond the
{      last remote_nad definition.
{
{    status: (output) This parameter returns the results of the request.  If the returned status is
{      not NORMAL, then all other return parameters are undefined.

    VAR
        nad_count: ^integer,
        nad_table_1,
        nad_table_2: ^rft$remote_nad_table;

    status.normal := TRUE;

    NEXT  nad_count  IN  config_file_ptr;
    IF  (nad_count = NIL)  OR  (nad_count^ = 0)  THEN
      rfv$status_table.remote_nads := NIL;
      RETURN;
    IFEND;
    NEXT  nad_table_1 : [1..nad_count^]  IN  config_file_ptr;
    IF  nad_table_1 = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$invalid_config_file, 'the remote NAD count is missing',
        status);
      RETURN;
    IFEND;
    NEXT  nad_table_2 : [1..nad_count^]  IN  current_status_table_ptr;
    IF  nad_table_2 = NIL  THEN
      osp$set_status_condition ( rfe$configuration_too_big,  status);
      RETURN;
    IFEND;
    align_seq_pointer(#SIZE(nad_table_2^), current_status_table_ptr);
    nad_table_2^ := nad_table_1^;
    rfv$status_table.remote_nads := nad_table_2;

  PROCEND move_the_remote_nad_entries;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '      RESERVE_CONFIGURED_ELEMENTS' ??
?? EJECT ??
  PROCEDURE  reserve_configured_elements(VAR status: ost$status);

{    The purpose of this procedure is to reserve the channel and peripheral processor
{    elements.
{
{    status: (output) This parameter returns the results of the request.  A status of normal
{      means that there were no fatal errors while attempting to reserve the required elements.

    VAR
        nad_descriptor,
        chan_descriptor: cmt$element_descriptor,
        logical_pp_number : iot$pp_number,
        found : boolean,
        concurrent : boolean,
        physical_pp : dst$iou_resource,
        nad_definition,
        chan_definition: cmt$element_definition,
        iou_definition: cmt$iou_definition,
        iou_name: cmt$element_name,
        program_description: ARRAY [1..1] OF cmt$pp_program_description,
        element_access: ARRAY [1..1] OF cmt$hardware_address,
        nad_entry,
        local_nad_count: rft$local_nads,
        pp_entry: 1..2,
        elements: ^ARRAY [*] OF cmt$element_reservation,
        ignore_status: ost$status,
        error_string: STRING(57),
        element_count,
        current_element: INTEGER,
        pp_interface_table: ^iot$pp_interface_table,
        channel_name : cmt$element_name,
        channel_number : ost$physical_channel_number,
        channel_port : cmt$channel_port,
        channel: cmt$channel_ordinal;

    element_count := 0;
    local_nad_count := UPPERBOUND(rfv$status_table.local_nads^);
    FOR  nad_entry := 1  TO  local_nad_count  DO
      element_count := element_count + 2 + rfv$status_table.local_nads^[nad_entry].pp_drivers;
    FOREND;

    PUSH  elements : [1..element_count];
    current_element := 1;
    nad_descriptor.element_type := cmc$communications_element;
    nad_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
    chan_descriptor.element_type := cmc$data_channel_element;
    chan_descriptor.channel_descriptor.use_logical_identification := TRUE;
    FOR  nad_entry := 1  TO  local_nad_count  DO
      nad_descriptor.peripheral_descriptor.element_name :=
        rfv$status_table.local_nads^[nad_entry].name;
      cmp$get_element_definition(nad_descriptor, nad_definition, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      chan_descriptor.channel_descriptor.name :=
        nad_definition.communications_element.connection.port[0].element_name;
      chan_descriptor.channel_descriptor.iou :=
        nad_definition.communications_element.connection.port[0].iou;
      cmp$get_element_definition(chan_descriptor, chan_definition, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      channel := chan_definition.data_channel.ordinal;
      cmp$convert_channel_ordinal(channel, channel_name, channel_number,
                  concurrent, channel_port, status);
      iou_name := chan_definition.data_channel.iou;
      rfv$status_table.local_nads^[nad_entry].channel_ordinal := channel;
      rfv$status_table.local_nads^[nad_entry].channel_number := channel_number;
      rfv$status_table.local_nads^[nad_entry].concurrent_channel := concurrent;
      elements^[current_element].element_type := cmc$data_channel_element;
      elements^[current_element].channel_descriptor := chan_descriptor.channel_descriptor;
      current_element := current_element + 1;
      elements^[current_element].element_type := cmc$communications_element;
      elements^[current_element].peripheral_descriptor := nad_descriptor.peripheral_descriptor;
      current_element := current_element + 1;
      FOR  pp_entry := 1  TO  rfv$status_table.local_nads^[nad_entry].pp_drivers  DO
        elements^[current_element].element_type := cmc$pp_element;
        elements^[current_element].pp_reservation.selector := cmc$choose_pp_by_channel;
        elements^[current_element].pp_reservation.channel.iou := iou_name;
        elements^[current_element].pp_reservation.channel.ordinal := channel;
        current_element := current_element + 1;
      FOREND;
    FOREND;

    cmp$reserve_element(elements^, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    current_element := 1;
    FOR  nad_entry := 1  TO  local_nad_count  DO
      current_element := current_element + 2;
      FOR  pp_entry := 1  TO  rfv$status_table.local_nads^[nad_entry].pp_drivers  DO
        rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_state := rfc$pps_reserved;
        rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_id :=
          elements^[current_element].pp_reservation.acquired_pp_identification;
        current_element := current_element + 1;
      FOREND;
    FOREND;

    cmp$get_iou_definition (iou_name, iou_definition, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    IF iou_definition.kind = dsc$imn_i0_5x_model THEN
      program_description[1].iou_program_name := 'NDI0';
    ELSE
      program_description[1].iou_program_name := 'NPDR';
    IFEND;
    program_description[1].master_pp := TRUE;
    program_description[1].pp_program := NIL;
    program_description[1].communication_buffer_length := osc$min_page_size;
    program_description[1].element_access := ^element_access;
    element_access[1].physical_address_specifier := $cmt$physical_address_specifier
       [cmc$iou, cmc$channel, cmc$channel_address];
    element_access[1].channel_address := 0;
    FOR  nad_entry := 1  TO  local_nad_count  DO
      FOR  pp_entry := 1  TO  rfv$status_table.local_nads^[nad_entry].pp_drivers  DO
        program_description[1].pp_identification :=
          rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_id;
        element_access[1].iou := rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_id.iou;
        element_access[1].channel.ordinal := rfv$status_table.local_nads^[nad_entry].channel_ordinal;
        element_access[1].channel.iou := rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_id.iou;
        cmp$execute_pp_program(program_description, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        cmp$convert_pp_ordinal (program_description[1].pp_identification.ordinal, physical_pp);
        cmp$convert_iou_name (program_description[1].pp_identification.iou, physical_pp.iou_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        cmp$search_pp_table (physical_pp, logical_pp_number, found, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF NOT found THEN
          osp$set_status_condition ( rfe$pp_number_not_found,
               status);
          RETURN;
        IFEND;
        rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_number :=
               logical_pp_number;
        rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_state := rfc$pps_idle;
      FOREND;
      cmp$get_logical_unit_number(rfv$status_table.local_nads^[nad_entry].name,
        rfv$status_table.local_nads^[nad_entry].logical_unit_number, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND reserve_configured_elements;
?? TITLE := '      START_THE_PPS' ??
?? EJECT ??
  PROCEDURE  start_the_pps(VAR status: ost$status);

{    The purpose of this routine is to issue a resume request to each
{    of the PP drivers.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        active_pp_found : boolean,
        local_status: ost$status,
        command_identifier: ^rft$pp_commands,
        request_buf: ^SEQ(*),
        nad_index: rft$local_nads,
        pp_index: 1..2;

    status.normal := TRUE;

    PUSH  request_buf : [[rft$pp_commands]];
    IF  request_buf = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the local stack overflowed',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'START_THE_PPS', status);
      RETURN;
    IFEND;
    RESET request_buf;
    NEXT  command_identifier  IN  request_buf;
    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, 'START_THE_PPS', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$pp_resume;

  /resume_pp_loop/
    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      FOR  pp_index := 1  TO  rfv$status_table.local_nads^[nad_index].pp_drivers  DO
        IF  rfv$status_table.local_nads^[nad_index].pp[pp_index].pp_state = rfc$pps_idle  THEN
          rfp$queue_request(nad_index, pp_index, rfc$pp_request, rfc$rk_resume_pp, NIL, request_buf,
            local_status);
          IF  NOT  local_status.normal  THEN
            rfp$log_the_status(local_status);
          IFEND;
        IFEND;
      FOREND;
    FOREND /resume_pp_loop/;

{   wait for all of the PP's to resume.

    WHILE  (rfv$outstanding_requests <> NIL) AND
           (rfv$pp_interface_error.interface_error_code = 0)  DO
      pmp$wait(2000, 100);
      rfp$process_pp_response_flag(rfc$pp_response_available);
    WHILEND;


{   see if any PP's failed to start.

    IF  rfv$pp_interface_error.interface_error_code <> 0  THEN
      osp$set_status_condition ( rfe$pp_start_up_failed,  status);
      osp$append_status_integer(osc$status_parameter_delimiter, rfv$pp_interface_error.pp_number,
        10, TRUE, status);
      osp$append_status_integer(osc$status_parameter_delimiter,
        rfv$pp_interface_error.interface_error_code,16, TRUE, status);
      RETURN;
    IFEND;

    active_pp_found := FALSE;

  /find_active_pp/
    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      FOR  pp_index := 1  TO  rfv$status_table.local_nads^[nad_index].pp_drivers  DO
        IF  rfv$status_table.local_nads^[nad_index].pp[pp_index].pp_state = rfc$pps_normal  THEN
          active_pp_found := TRUE;
          EXIT /find_active_pp/;
        IFEND;
      FOREND;
    FOREND /find_active_pp/;

    IF  NOT active_pp_found  THEN
      osp$set_status_condition ( rfe$unable_to_start_a_pp,  status);
    IFEND;

  PROCEND start_the_pps;
?? TITLE := '      LOAD_THE_NADS' ??
?? EJECT ??
  PROCEDURE  load_the_nads(VAR status: ost$status);

{    The purpose of this routine is to load the local NADs and to also set up the
{    local NAD tables for normal processing.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        local_status: ost$status,
        nad_index: rft$local_nads;

    status.normal := TRUE;

    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      initialize_local_nad_entry(nad_index);
      rfp$local_nad_load(nad_index, local_status);
      IF  NOT local_status.normal  THEN
        rfp$log_the_status(local_status);
      IFEND;
    FOREND;

    {   wait for the load to complete.

    WHILE  rfv$outstanding_requests <> NIL  DO
      pmp$wait(2000, 100);
      rfp$process_pp_response_flag(rfc$pp_response_available);
    WHILEND;

  PROCEND load_the_nads;
?? NEWTITLE := '        INITIALIZE_LOCAL_NAD_ENTRY' ??
?? EJECT ??
  PROCEDURE  initialize_local_nad_entry(nad_index: rft$local_nads);

{    The purpose of this procedure is to initialize the status timers and flags in the
{    local nad entry.
{
{    nad_index: (input) This parameter specifies the index within the local NAD table of
{      the corresponding NAD definition.


    VAR
        con_index: rft$concurrent_connections,
        ignore_status: ost$status,
        nad_entry: ^rft$local_nad_entry,
        current_time: integer;


    nad_entry := ^rfv$status_table.local_nads^[nad_index];
    pmp$get_microsecond_clock(current_time, ignore_status);
    nad_entry^.status_posted := FALSE;
    nad_entry^.status_change_available := FALSE;
    nad_entry^.maintenance_status.test_requested := FALSE;
    nad_entry^.current_status.device_status := rfc$es_down;
    nad_entry^.last_status_change := current_time;
    nad_entry^.processing_out_control_mess := FALSE;
    nad_entry^.processing_in_control_mess := FALSE;
    nad_entry^.outgoing_cm_queue.first_entry := NIL;
    nad_entry^.incoming_connect_pending := FALSE;
    nad_entry^.current_max_connect_id := 0;
    FOR  con_index := LOWERBOUND(nad_entry^.connection_table^)  TO
                      UPPERBOUND(nad_entry^.connection_table^)  DO
      nad_entry^.connection_table^[con_index].connection_table_entry := NIL;
    FOREND;

  PROCEND initialize_local_nad_entry;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '    RFP$LOG_THE_STATUS' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$log_the_status (status_message : ost$status);

{
{    The purpose of this routine is to format a status message and write the formatted message
{    to the current output file.
{
{    status_message: (input) This parameter specifies the current status message that is to be
{      printed.

    CONST
        max_char_per_message_line = 72;
    VAR
        local_status: ost$status,
        number_of_message_lines : ^ost$status_message_line_count,
        length_of_message_line : ^ost$status_message_line_size,
        message_line : ^ost$status_message_line,
        message_sequence : ost$status_message,
        pointer_to_message_sequence : ^ost$status_message,
        line_counter : integer;

    osp$format_message(status_message, osc$current_message_level, max_char_per_message_line,
                       message_sequence, local_status);
    IF  NOT local_status.normal  THEN
      RETURN;
    IFEND;
    pointer_to_message_sequence := ^message_sequence;
    RESET pointer_to_message_sequence;
    NEXT  number_of_message_lines  IN  pointer_to_message_sequence;
    FOR  line_counter := 1  TO  number_of_message_lines^  DO
      NEXT  length_of_message_line  IN  pointer_to_message_sequence;
      NEXT  message_line : [length_of_message_line^]  IN  pointer_to_message_sequence;
      pmp$log(message_line^(1,length_of_message_line^), local_status);
      IF  NOT  local_status.normal  THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND rfp$log_the_status;
?? TITLE := '    RFP$LOCAL_NAD_STATUSING' ??
?? EJECT ??
  PROCEDURE  rfp$local_nad_statusing(current_time: INTEGER;
                                 VAR possible_connect_pending: BOOLEAN;
                                 VAR status: ost$status);

*copyc rfh$local_nad_statusing


    TYPE
        incoming_connect_entry = RECORD
          next_entry: ^incoming_connect_entry,
          nad_index: rft$local_nads,
          path_number: rft$concurrent_connections,
        RECEND;

    VAR
        connect_entry,
        connect_list: ^incoming_connect_entry,
        con_index: rft$concurrent_connections,
        connection_entry: ^rft$connection_table_entry,
        unconditionally_status: ^BOOLEAN,
        path_count: ^rft$path_identifier,
        new_connect_pending,
        check_event_list: BOOLEAN,
        ignore_status: ost$status,
        local_nad: ^rft$local_nad_entry,
        request: ^rft$outstanding_requests,
        command_identifier: ^rft$logical_commands,
        nad_index: rft$local_nads,
        request_info: ^SEQ(*);

    status.normal := TRUE;
    connect_list := NIL;
    check_event_list := FALSE;
    new_connect_pending := FALSE;
    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      local_nad := ^rfv$status_table.local_nads^[nad_index];
      IF  local_nad^.current_status.device_status = rfc$es_on  THEN
        IF  local_nad^.status_posted  THEN
          IF  ((local_nad^.last_status_change + rfc$status_change_threshold) <= current_time)  OR
              (local_nad^.incoming_connect_pending)  THEN
            rfp$unconditionally_status(local_nad^.logical_unit_number);
          IFEND;
        ELSE
          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, 'LOAD_THE_NADS', status);
            RETURN;
          IFEND;
          command_identifier^ := rfc$lc_status_nad;
          NEXT  unconditionally_status  IN  request_info;
          IF  unconditionally_status = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'status flag too big',
              status);
            osp$append_status_parameter(osc$status_parameter_delimiter, 'LOAD_THE_NADS', status);
            RETURN;
          IFEND;
          IF  ((local_nad^.last_status_change + rfc$status_change_threshold) <= current_time)  THEN
            unconditionally_status^ := TRUE;
          ELSE
            unconditionally_status^ := FALSE;
          IFEND;
          NEXT  path_count  IN  request_info;
          IF  path_count = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'path count too big',
              status);
            osp$append_status_parameter(osc$status_parameter_delimiter, 'LOAD_THE_NADS', status);
            RETURN;
          IFEND;
          path_count^ := UPPERBOUND(local_nad^.connection_table^) -
                         LOWERBOUND(local_nad^.connection_table^) + 1;
          rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_local_nad_status, NIL, request_info,
            status);
          IF  NOT status.normal  THEN
            RETURN;
          IFEND;
          local_nad^.status_posted := TRUE;
        IFEND;
        local_nad^.incoming_connect_pending := FALSE;
        IF  local_nad^.status_change_available  THEN
          rfp$lock_table(local_nad^.connection_table_lock);
          FOR  con_index := 1 TO local_nad^.current_max_connect_id  DO
            connection_entry := ^local_nad^.connection_table^[con_index];
            IF  (connection_entry^.connection_state = rfc$ps_connecting)  AND
                (connection_entry^.connection_clarifier = rfc$pcc_incoming_connect) AND
                (NOT connection_entry^.processing_incoming_connect)  THEN
              IF  (connection_entry^.connection_table_entry = NIL)  THEN
                PUSH connect_entry;
                connect_entry^.path_number := con_index;
                connect_entry^.nad_index := nad_index;
                connect_entry^.next_entry := connect_list;
                connect_list := connect_entry;
                connection_entry^.processing_incoming_connect := TRUE;
              ELSE
                new_connect_pending := TRUE;
                local_nad^.incoming_connect_pending := TRUE;
              IFEND;
            IFEND;
          FOREND;
          rfp$unlock_table(local_nad^.connection_table_lock);
          check_event_list := TRUE;
          local_nad^.status_change_available := FALSE;
        IFEND;
        IF  (current_time - local_nad^.last_status_change) >= (5*1000*1000)  THEN
          check_event_list := TRUE;
        IFEND;
        rfp$control_messages(nad_index);
      ELSE  { NAD is not ON }
        local_nad^.incoming_connect_pending := FALSE;
      IFEND;
    FOREND;

    IF  (check_event_list)  THEN
      rfp$check_event_list(current_time, FALSE);
    IFEND;

    WHILE  connect_list <> NIL  DO
      rfp$incoming_connect_requests(connect_list^.nad_index, connect_list^.path_number);
      connect_list := connect_list^.next_entry;
    WHILEND;

    possible_connect_pending := new_connect_pending;

  PROCEND rfp$local_nad_statusing;
?? NEWTITLE := '      RFP$INCOMING_CONNECT_REQUESTS' ??
?? EJECT ??
  PROCEDURE  rfp$incoming_connect_requests(nad_index: rft$local_nads;
                                           con_index: rft$concurrent_connections);

*copyc rfh$incoming_connect_requests

    VAR
        local_status: ost$status,
        request_info: ^SEQ(*),
        connection_mgmt_status: ^rft$connection_mgmt_status,
        command_identifier: ^rft$logical_commands,
        physical_from: ^rft$physical_from,
        path_identifier: ^rft$path_identifier;

    local_status.normal := TRUE;

  /main_section/
    BEGIN
      PUSH  request_info : [[rft$logical_commands,rft$physical_from,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',
          local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$INCOMING_CONNECT_REQUESTS',
          local_status);
        EXIT /main_section/;
      IFEND;
      command_identifier^ := rfc$lc_obtain_connect_request;
      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',
          local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$INCOMING_CONNECT_REQUESTS',
          local_status);
        EXIT /main_section/;
      IFEND;
      physical_from^.compare_name := TRUE;
      physical_from^.criteria := rfc$pf_match_both_characters;
      physical_from^.char1 := rfv$status_table.local_host^.subsystem_identifier(1,1);
      physical_from^.char2 := rfv$status_table.local_host^.subsystem_identifier(2,1);
      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',
          local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$INCOMING_CONNECT_REQUESTS',
          local_status);
        EXIT /main_section/;
      IFEND;
      path_identifier^ := con_index;
      ALLOCATE  connection_mgmt_status  IN  osv$task_private_heap^;
      IF  connection_mgmt_status = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$INCOMING_CONNECT_REQUEST',
          local_status);
        EXIT /main_section/;
      IFEND;
      connection_mgmt_status^.internal_use := TRUE;

      rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_obtain_connect_request, connection_mgmt_status,
        request_info, local_status);

      IF  NOT local_status.normal  THEN
        FREE  connection_mgmt_status  IN  osv$task_private_heap^;
      IFEND;

    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$log_the_status(local_status);
    IFEND;

  PROCEND rfp$incoming_connect_requests;
?? TITLE := '      RFP$CHECK_EVENT_LIST' ??
?? EJECT ??
  PROCEDURE  rfp$check_event_list(current_time: INTEGER;
                                  system_task_shutdown: BOOLEAN);

*copyc rfh$check_event_list

    TYPE
        task_entry = RECORD
          next_entry: ^task_entry,
          task_id: ost$global_task_id,
          asynchronous: BOOLEAN,
        RECEND;

    VAR
        asynchronous: BOOLEAN,
        task_list: ^task_entry,
        task_to_wake_up: ^task_entry,
        event_entry: ^rft$rhfam_event_table_entry,
        event_type: rft$event_occurred_type,
        ignore_status: ost$status;

    task_list := NIL;
    rfp$lock_table(rfv$rhfam_event_table.lock);

    event_entry := rfv$rhfam_event_table.first_entry;

    WHILE  event_entry <> NIL  DO
      event_type := event_entry^.event_occurred_type;
      IF event_type = rfc$eot_no_event  THEN
        asynchronous := FALSE;
        CASE  event_entry^.event_kind  OF
        = rfc$ana_await_server_response =

          IF  (rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_state <>
                                                                     rfc$ps_connecting)  OR
              NOT ((rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_clarifier
                                                                  = rfc$pcc_locally_initiated)
               OR  (rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_clarifier
                                                                  = rfc$pcc_sending_connect)
               OR  (rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_clarifier
                                                                  = rfc$pcc_remote_nad_accept))  THEN
            event_type := rfc$eot_server_response;
          IFEND;

        = rfc$ana_await_incoming_connect =

          {  This event is checked in the response processor when an incoming connect request is received.

        = rfc$ana_await_connection_event =

          asynchronous := event_entry^.ace_asynchronous_wait;

          {  NOTE - Input available must be checked prior to connection broken, because the
          {         NAD will set the connection broken (on normal disconnects) even if there
          {         is data in the input queue.  This will allow users to retrieve the remaining
          {         data.

          IF
              (event_entry^.ace_input_available  AND
                rfv$status_table.local_nads^[event_entry^.ace_connection_descriptor.nad_index].
                  connection_table^[event_entry^.ace_connection_descriptor.network_path].input_available)
                                                                                                     THEN
            event_type := rfc$eot_input_available;
          ELSEIF
              (rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_state <>
                                                                     rfc$ps_established)  OR
              ((rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_clarifier
                                                                  <> rfc$pce_normal)  AND
               (rfv$status_table.local_nads^[event_entry^.asr_connection_descriptor.nad_index].
                 connection_table^[event_entry^.asr_connection_descriptor.network_path].connection_clarifier
                                                                  <> rfc$pce_local_host_uninformed))  THEN
            event_type := rfc$eot_connection_terminated;
          ELSEIF
              (event_entry^.ace_output_buffer_available  AND
                rfv$status_table.local_nads^[event_entry^.ace_connection_descriptor.nad_index].
                  connection_table^[event_entry^.ace_connection_descriptor.network_path].
                                                                               output_below_threshold)  THEN
            event_type := rfc$eot_output_below_threshold;
          ELSEIF
              (event_entry^.ace_data_transfer_in_progress  AND
                (current_time >= event_entry^.ace_asynchronous_timeout))  THEN
            event_type := rfc$eot_timeout;
          IFEND;

        ELSE

          {  Any unexpected event type is simply ignored.

        CASEND;

        {  NOTE - the system task shutdown supercedes any other event that may have occurred.

        IF  system_task_shutdown  THEN
          event_type := rfc$eot_system_task_shutdown;
        IFEND;

        IF  event_type <> rfc$eot_no_event  THEN
          event_entry^.event_occurred_type := event_type;
          PUSH  task_to_wake_up;
          task_to_wake_up^.task_id := event_entry^.task_id;
          task_to_wake_up^.asynchronous := asynchronous;
          task_to_wake_up^.next_entry := task_list;
          task_list := task_to_wake_up;
        IFEND;
      IFEND;
      event_entry := event_entry^.next_entry;
    WHILEND;

    rfp$unlock_table(rfv$rhfam_event_table.lock);

    WHILE  task_list <> NIL  DO
      IF  task_list^.asynchronous  THEN
        pmp$set_system_flag(rfc$pp_response_available, task_list^.task_id, ignore_status);
      ELSE
        pmp$ready_task(task_list^.task_id, ignore_status);
      IFEND;
      task_list := task_list^.next_entry;
    WHILEND;

  PROCEND rfp$check_event_list;
?? TITLE := '      RFP$CONTROL_MESSAGES' ??
?? EJECT ??
  PROCEDURE  rfp$control_messages(nad_index: rft$local_nads);

*copyc rfh$control_messages

    VAR
        table_locked: BOOLEAN,
        request_size: INTEGER,
        local_nad: ^rft$local_nad_entry,
        status: ost$status,
        request_info: ^SEQ(*),
        command_identifier: ^rft$logical_commands,
        physical_from: ^rft$physical_from,
        rejected_control_message: ^BOOLEAN,
        connection: rft$concurrent_connections,
        current_entry: ^rft$outgoing_control_message,
        control_message: ^rft$nbp_control_message,
        control_message_text_size: ^rft$control_message_text;

    status.normal := TRUE;
    local_nad := ^rfv$status_table.local_nads^[nad_index];
    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;
    rfp$lock_table(local_nad^.outgoing_cm_queue.lock);
    table_locked := TRUE;

/process_outgoing_messages/
    BEGIN
      IF  (local_nad^.connection_table^[0].output_below_threshold)  AND
          (local_nad^.outgoing_cm_queue.first_entry <> NIL)  AND
          (NOT local_nad^.processing_out_control_mess)  THEN
        current_entry := local_nad^.outgoing_cm_queue.first_entry;
        NEXT  command_identifier  IN  request_info;
        IF  command_identifier = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'OCM command id too big',
            status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTROL_MESSAGES', status);
          EXIT /process_outgoing_messages/;
        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, 'OCM text size too big',
             status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTROL_MESSAGES', status);
          EXIT /process_outgoing_messages/;
        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, 'OCM message too big',
            status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTROL_MESSAGES', status);
          EXIT /process_outgoing_messages/;
        IFEND;
        control_message^ := current_entry^.control_message;
        local_nad^.processing_out_control_mess := TRUE;
        rfp$unlock_table(local_nad^.outgoing_cm_queue.lock);
        table_locked := FALSE;
        rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_send_control_mess, NIL, request_info,
          status);
        IF  NOT status.normal  THEN
          rfp$lock_table(local_nad^.outgoing_cm_queue.lock);
          table_locked := TRUE;
          local_nad^.processing_out_control_mess := FALSE;
          IF  current_entry^.purge_on_retry  THEN
            local_nad^.outgoing_cm_queue.first_entry := current_entry^.next_entry;
            FREE  current_entry  IN  nav$network_paged_heap^;
          IFEND;
        IFEND;
      IFEND;
    END /process_outgoing_messages/;

    IF  table_locked  THEN
      rfp$unlock_table(local_nad^.outgoing_cm_queue.lock);
    IFEND;
    IF  NOT status.normal  THEN
      rfp$log_the_status(status);
      status.normal := TRUE;
    IFEND;

  /process_incoming_messages/
    BEGIN
      IF  local_nad^.connection_table^[0].input_available  AND
          (NOT local_nad^.processing_in_control_mess)  THEN
        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, 'ICM command id too big',
            status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTROL_MESSAGES', 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, 'ICM reject too big',
            status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTROL_MESSAGES', status);
          EXIT /process_incoming_messages/;
        IFEND;
        rejected_control_message^ := FALSE;
        NEXT  physical_from  IN  request_info;
        IF  physical_from = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'ICM phy. from too big',
            status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTROL_MESSAGES', 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);
        rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_receive_control_mess, NIL, request_info,
          status);
        IF  status.normal  THEN
          local_nad^.processing_in_control_mess := TRUE;
        IFEND;
      IFEND;
    END /process_incoming_messages/;

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

  PROCEND rfp$control_messages;
?? OLDTITLE ??
?? TITLE := '    RFP$CHECK_APPL_STARTUP' ??
?? EJECT ??
  PROCEDURE rfp$check_appl_startup(current_time: INTEGER);

*copyc rfh$check_appl_startup

    TYPE
        purge_entry = RECORD
          next_entry: ^purge_entry,
          access_method_accept: BOOLEAN,
          descriptor: rft$connection_descriptor,
        RECEND,

        application_entry = RECORD
          next_entry: ^application_entry,
          name: rft$application_name,
          is_a_server: BOOLEAN,
        RECEND,

        server_job_entry_list = RECORD
          next_entry: ^server_job_entry_list,
          entry: ^rft$rhfam_server_table_entry,
          number_to_start: rft$application_connections,
        RECEND;

    VAR
        status: ost$status,
        nad_index: rft$local_nads,
        job_index: rft$application_connections,
        connects_over_committed: INTEGER,
        server_job_list,
        server_job_to_start: ^server_job_entry_list,
        application_list,
        application_to_purge_entry: ^application_entry,
        current_client_entry: ^rft$rhfam_client_table_entry,
        current_server_entry: ^rft$rhfam_server_table_entry,
        connect_to_free,
        previous_connect,
        current_connect: ^rft$incoming_connect,
        server_job_entry,
        previous_server_job_entry,
        server_to_free: ^rft$server_identifier,
        abort_all_connects: BOOLEAN,
        purge_list,
        connect_to_purge: ^purge_entry;

    purge_list := NIL;
    application_list := NIL;
    server_job_list := NIL;

    rfp$lock_table(rfv$rhfam_server_table.lock);
    current_server_entry := rfv$rhfam_server_table.first_entry;
    WHILE  current_server_entry <> NIL  DO
      IF  current_server_entry^.rhfam_initiated_server  THEN
        server_job_entry := current_server_entry^.server_identifier;
        previous_server_job_entry := NIL;
        WHILE  server_job_entry <> NIL  DO
          IF  (NOT server_job_entry^.server_signed_on)  AND
              ((current_time - server_job_entry^.server_started_time) >
               (rfv$status_table.local_host^.connection_timeout * 1000 * 1000))  THEN
            current_server_entry^.connections_reserved := current_server_entry^.connections_reserved -
              current_server_entry^.server_job_max_connections;
            server_to_free := server_job_entry;
            server_job_entry := server_job_entry^.next_entry;
            FREE  server_to_free  IN  nav$network_paged_heap^;
            IF  previous_server_job_entry = NIL  THEN
              current_server_entry^.server_identifier := server_job_entry;
            ELSE
              previous_server_job_entry^.next_entry := server_job_entry;
            IFEND;
          ELSE
            previous_server_job_entry := server_job_entry;
            server_job_entry := server_job_entry^.next_entry;
          IFEND;
        WHILEND;
      IFEND;
      IF  (NOT current_server_entry^.server_active)  AND
          (current_server_entry^.abort_connections)  THEN
        abort_all_connects := TRUE;
        PUSH  application_to_purge_entry;
        application_to_purge_entry^.name := current_server_entry^.server_name;
        application_to_purge_entry^.is_a_server := TRUE;
        application_to_purge_entry^.next_entry := application_list;
        application_list := application_to_purge_entry;
        current_server_entry^.abort_connections := FALSE;
      ELSE
        abort_all_connects := FALSE;
      IFEND;
      current_connect := current_server_entry^.incoming_connect;
      previous_connect := NIL;
      WHILE  current_connect <> NIL  DO
        IF  ((current_time - current_connect^.time_received) >
             (rfv$status_table.local_host^.connection_timeout * 1000 * 1000))  OR
            (abort_all_connects)  THEN
          PUSH  connect_to_purge;
          connect_to_purge^.descriptor := current_connect^.connection_descriptor;
          connect_to_purge^.access_method_accept := current_server_entry^.access_method_accept;
          connect_to_purge^.next_entry := purge_list;
          purge_list := connect_to_purge;
          current_server_entry^.current_connections := current_server_entry^.current_connections - 1;
          connect_to_free := current_connect;
          current_connect := current_connect^.next_entry;
          FREE  connect_to_free  IN  nav$network_paged_heap^;
          IF  previous_connect = NIL  THEN
            current_server_entry^.incoming_connect := current_connect;
          ELSE
            previous_connect^.next_entry := current_connect;
          IFEND;
        ELSE
          previous_connect := current_connect;
          current_connect := current_connect^.next_entry;
        IFEND;
      WHILEND;
      connects_over_committed := current_server_entry^.current_connections -
        current_server_entry^.partner_job_connections - current_server_entry^.connections_reserved;
      IF  (current_server_entry^.rhfam_initiated_server)  AND
          (current_server_entry^.active_incoming_connects = 0)  AND
          (connects_over_committed > 0)  THEN
        PUSH server_job_to_start;
        server_job_to_start^.entry := current_server_entry;
        server_job_to_start^.number_to_start := (connects_over_committed +
          current_server_entry^.server_job_max_connections - 1) DIV
          current_server_entry^.server_job_max_connections;
        server_job_to_start^.next_entry := server_job_list;
        server_job_list := server_job_to_start;
      IFEND;
      current_server_entry := current_server_entry^.next_entry;
    WHILEND;
    rfp$unlock_table(rfv$rhfam_server_table.lock);

    rfp$lock_table(rfv$rhfam_client_table.lock);
    current_client_entry := rfv$rhfam_client_table.first_entry;
    WHILE  current_client_entry <> NIL  DO
      IF  (NOT current_client_entry^.client_active)  AND
          (current_client_entry^.abort_connections)  THEN
        PUSH  application_to_purge_entry;
        application_to_purge_entry^.name := current_client_entry^.client_name;
        application_to_purge_entry^.is_a_server := FALSE;
        application_to_purge_entry^.next_entry := application_list;
        application_list := application_to_purge_entry;
        current_client_entry^.abort_connections := FALSE;
      IFEND;
      current_client_entry := current_client_entry^.next_entry;
    WHILEND;
    rfp$unlock_table(rfv$rhfam_client_table.lock);

    WHILE  purge_list <> NIL  DO
      IF  purge_list^.access_method_accept  THEN
        purge_path(purge_list^.descriptor);
      ELSE
        reject_incoming_connect(purge_list^.descriptor);
      IFEND;
      purge_list := purge_list^.next_entry;
    WHILEND;

    WHILE  server_job_list <> NIL  DO
      FOR  job_index := 1  TO  server_job_list^.number_to_start  DO
        rfp$start_server_job(server_job_list^.entry, status);
        IF  NOT status.normal  THEN
          rfp$log_the_status(status);
        IFEND;
      FOREND;
      server_job_list := server_job_list^.next_entry;
    WHILEND;

    WHILE  application_list <> NIL  DO
      FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
        clear_connection_entries(nad_index, application_list^.name, rfc$terminated);
      FOREND;
      IF  application_list^.is_a_server  THEN
        wake_up_tasks(application_list^.name);
      IFEND;
      application_list := application_list^.next_entry;
    WHILEND;

  PROCEND rfp$check_appl_startup;
?? NEWTITLE := '      PURGE_PATH' ??
?? EJECT ??
  PROCEDURE  purge_path(connection_descriptor: rft$connection_descriptor);

{    The purpose of this routine is to purge the NAD path for a specified connection.
{
{    connection_descriptor: (input) This parameter specifies the local NAD index and connection
{      number of the path to purge.


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

    status.normal := TRUE;

  /main_section/
    BEGIN
      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);
        EXIT /main_section/;
      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);
        EXIT /main_section/;
      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);
        EXIT /main_section/;
      IFEND;
      path_identifier^ := connection_descriptor.network_path;
      ALLOCATE connection_mgmt_status IN osv$task_private_heap^;
      IF  connection_mgmt_status = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'PURGE_PATH', status);
        EXIT /main_section/;
      IFEND;
      connection_mgmt_status^.internal_use := TRUE;
      rfp$queue_request(connection_descriptor.nad_index, 1, rfc$unit_request, rfc$rk_disconnect_path,
        connection_mgmt_status, request_info, status);
      IF  NOT status.normal  THEN
        FREE connection_mgmt_status IN osv$task_private_heap^;
      IFEND;

    END  /main_section/;

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

  PROCEND purge_path;
?? TITLE := '      REJECT_INCOMING_CONNECT' ??
?? EJECT ??
  PROCEDURE  reject_incoming_connect(connection_descriptor: rft$connection_descriptor);

{    The purpose of this routine is to reject the incoming connect across the specified path.
{    A reject code of rfc$nbp_requested_host_busy is used.
{
{    connection_descriptor: (input) This parameter specifies the local NAD index and connection
{      number of the path to purge.

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

    status.normal := TRUE;

  /main_section/
    BEGIN
      PUSH  request_info : [[rft$logical_commands,rft$path_identifier,rft$reject_code]];
      RESET request_info;
      NEXT command_identifier IN request_info;
      IF  command_identifier = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'command id too big',
          status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'REJECT_INCOMING_CONNECT', status);
        EXIT /main_section/;
      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_INCOMING_CONNECT', status);
        EXIT /main_section/;
      IFEND;
      path_identifier^ := connection_descriptor.network_path;
      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_INCOMING_CONNECT', status);
        EXIT /main_section/;
      IFEND;
      reject_id^ := rfc$nbp_requested_host_busy;
      ALLOCATE connection_mgmt_status IN osv$task_private_heap^;
      IF  connection_mgmt_status = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'REJECT_INCOMING_CONNECT', status);
        EXIT /main_section/;
      IFEND;
      connection_mgmt_status^.internal_use := TRUE;
      rfp$queue_request(connection_descriptor.nad_index, 1, rfc$unit_request, rfc$rk_reject_connect_request,
        connection_mgmt_status, request_info, status);
      IF  NOT status.normal  THEN
        FREE connection_mgmt_status IN osv$task_private_heap^;
      IFEND;

    END  /main_section/;

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

  PROCEND reject_incoming_connect;
?? TITLE := '      WAKE_UP_TASKS' ??
?? EJECT ??
  PROCEDURE  wake_up_tasks(server_name: rft$application_name);

{    The purpose of this routine is to scan the list of tasks, which are waiting
{    for incoming connect request from the corresponding server, and start the
{    task.  The event occurred type is set to incoming connect available.
{    The task being restarted must determine that the corresponding server
{    application has been disabled.
{
{    server_name: (input) This parameter specifies the name of the server that
{      is no longer enabled to receive incoming connects.

    TYPE
        task_entry = RECORD
          next_entry: ^task_entry,
          task_id: ost$global_task_id,
        RECEND;

    VAR
        task_list,
        task_to_wake_up: ^task_entry,
        event_entry: ^rft$rhfam_event_table_entry,
        ignore_status: ost$status;

    task_list := NIL;
    rfp$lock_table(rfv$rhfam_event_table.lock);

    event_entry := rfv$rhfam_event_table.first_entry;

    WHILE  event_entry <> NIL  DO
      IF event_entry^.event_occurred_type = rfc$eot_no_event  THEN
        CASE  event_entry^.event_kind  OF
        = rfc$ana_await_incoming_connect =

          IF  event_entry^.aic_server_name = server_name  THEN
            event_entry^.event_occurred_type := rfc$eot_incoming_connect;
            PUSH  task_to_wake_up;
            task_to_wake_up^.task_id := event_entry^.task_id;
            task_to_wake_up^.next_entry := task_list;
            task_list := task_to_wake_up;
          IFEND;

        ELSE

          {  Any other event type is simply ignored.

        CASEND;
      IFEND;
      event_entry := event_entry^.next_entry;
    WHILEND;

    rfp$unlock_table(rfv$rhfam_event_table.lock);

    WHILE  task_list <> NIL  DO
      pmp$ready_task(task_list^.task_id, ignore_status);
      task_list := task_list^.next_entry;
    WHILEND;

  PROCEND wake_up_tasks;
?? OLDTITLE ??
?? TITLE := '    RFP$CHECK_HARDWARE_AVAILABLE' ??
?? EJECT ??
  PROCEDURE  rfp$check_hardware_available(current_time: INTEGER);

*copyc rfh$check_hardware_available

    VAR
        paths: ^rft$lcn_paths,
        remote_host_entry: ^rft$remote_host_definition;

    {  Check to see if there are local paths to be enabled  }

    rfp$lock_table(rfv$status_table.lock);
    paths := rfv$status_table.local_host^.associated_paths;
    IF  paths <> NIL  THEN
      enable_timed_out_paths(current_time, paths);
    IFEND;

    {  Check to see if there are remote host paths to be enabled  }

    remote_host_entry := rfv$status_table.remote_hosts;
    WHILE  remote_host_entry <> NIL  DO
      paths := remote_host_entry^.associated_paths;
      IF  paths <> NIL  THEN
        enable_timed_out_paths(current_time, paths);
      IFEND;
      remote_host_entry := remote_host_entry^.next_entry;
    WHILEND;
    rfp$unlock_table(rfv$status_table.lock);

  PROCEND rfp$check_hardware_available;
?? NEWTITLE := '      ENABLE_TIMED_OUT_PATHS' ??
?? EJECT ??
  PROCEDURE  enable_timed_out_paths(current_time: INTEGER;
                                VAR paths: ^rft$lcn_paths);

{    The purpose of this routine is to enable any path that has been disabled for
{    the specified threshold level.
{
{    NOTE - The calling routine is required to set and clear the required lock.
{
{    current_time: (input) This parameter specifies the current time in microseconds.
{
{    paths: (input,output) This parameter specifies the list of paths to check.
{      Each path that has been disabled for the specified time is subsequently enabled.

    CONST
        rfc$initial_threshold = 30 * 1000 * 1000,           { 30 seconds }
        rfc$intermediate_threshold = 5 * 60 * 1000 * 1000,  { 5 minutes }
        rfc$long_term_threshold = 30 * 60 * 1000 * 1000;    { 30 minutes }

    CONST
        rfc$initial_retries = 10,          {  1 - 10 }
        rfc$intermediate_retries = 30,     { 11 - 30 }
        rfc$long_term_retries = 99999;     { 31 - forever }

    VAR
        time_disabled: INTEGER,
        path_index: rft$paths_per_host;

    FOR  path_index := LOWERBOUND(paths^)  TO  UPPERBOUND(paths^)  DO
      IF  (paths^[path_index].disabled)  THEN
        time_disabled := current_time - paths^[path_index].time_disabled;
        IF (((paths^[path_index].failure_count <= rfc$initial_retries)  AND
             (time_disabled >= rfc$initial_threshold))  OR
            ((paths^[path_index].failure_count <= rfc$intermediate_retries)  AND
             (time_disabled >= rfc$intermediate_threshold))  OR
            (time_disabled >= rfc$long_term_threshold))  THEN
          paths^[path_index].disabled := FALSE;
        IFEND;
      IFEND;
    FOREND;

  PROCEND enable_timed_out_paths;
?? OLDTITLE ??
?? TITLE := '    RFP$LOG_PERFORMANCE_STATISTICS' ??
?? EJECT ??
  PROCEDURE  rfp$log_performance_statistics;

*copyc rfh$log_performance_statistics

    VAR
        nad_index: rft$local_nads,
        local_nad: ^rft$local_nad_entry;

    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      local_nad := ^rfv$status_table.local_nads^[nad_index];
      IF  local_nad^.current_status.device_status <> rfc$es_off  THEN
        log_nad_statistics(local_nad);
      IFEND;
    FOREND;

  PROCEND rfp$log_performance_statistics;
?? NEWTITLE := '      LOG_NAD_STATISTICS' ??
?? EJECT ??
  PROCEDURE  log_nad_statistics(local_nad: ^rft$local_nad_entry);

{    The purpose of this routine is to log the performance statistics for a
{    specified local NAD.  This routine also clears the counters after the statistics
{    are logged.
{
{    local_nad: (input) This parameter specifies a pointer to the corresponding local
{      NAD to log.

    VAR
        concurrent_channel_flag: integer,
        descriptor_data: ost$string,
        iou_number: dst$iou_number,
        status: ost$status,
        pp_number: 0..31,
        counters: ^ARRAY [1..*] OF sft$counter;

    PUSH  counters : [1..5];
    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);
    IFEND;
    counters^[1] := local_nad^.channel_number + concurrent_channel_flag + iou_number * 1000(16);
    rfp$lock_table(rfv$status_table.lock);
    counters^[2] := local_nad^.statistics.bytes_sent;
    local_nad^.statistics.bytes_sent := 0;
    counters^[3] := local_nad^.statistics.bytes_received;
    local_nad^.statistics.bytes_received := 0;
    counters^[4] := local_nad^.maintenance_status.reloads_performed;
    IF  local_nad^.current_status.device_status <> rfc$es_off  THEN
      local_nad^.maintenance_status.reloads_performed := 0;
    IFEND;
    counters^[5] := local_nad^.statistics.connections_established;
    local_nad^.statistics.connections_established := 0;
    rfp$unlock_table(rfv$status_table.lock);
    sfp$emit_statistic(cml$rhfam_usage_data, descriptor_data.value(1,descriptor_data.size), counters, status);

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

  PROCEND log_nad_statistics;
?? OLDTITLE ??
?? TITLE := '    RFP$AUTO_DUMP_AND_RELOAD' ??
?? EJECT ??
*copyc rfh$nad_loading

*copyc rfh$nad_dumping
?? EJECT ??
  PROCEDURE  rfp$auto_dump_and_reload(current_time: INTEGER);

*copyc rfh$auto_dump_and_reload

    VAR
        local_nad: ^rft$local_nad_entry,
        con_index: rft$concurrent_connections,
        i: integer,
        critical_msg: string(55),
        local_status: ost$status,
        nad_index: rft$local_nads;

    {   NOTE - the requests_posted count is used to prevent multiple dumps or loads from
    {          occurring simultaneously for the same NAD.

  /reload_local_nads/
    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      local_nad := ^rfv$status_table.local_nads^[nad_index];
      IF  (local_nad^.current_status.device_status = rfc$es_down)  THEN
        IF  NOT local_nad^.maintenance_status.reload_in_progress  THEN
          rfp$unconditionally_status(local_nad^.logical_unit_number);
          clear_incoming_connects(nad_index);
          clear_connection_entries(nad_index, '       ', rfc$local_nad_failure);
          release_all_control_messages(nad_index);
          rfp$check_event_list(current_time, FALSE);
          IF  (local_nad^.requests_posted = 0)                          AND
              (NOT local_nad^.maintenance_status.reload_failed)         AND
              (   (local_nad^.maintenance_status.test_requested)          OR
                ( (local_nad^.maintenance_selections.perform_auto_reload)   AND
                  (local_nad^.maintenance_status.reloads_performed <
                   local_nad^.maintenance_selections.reload_threshold)))  THEN

            {  Tell the driver to process unit requests.

            rfp$change_nad_status(rfv$status_table.local_nads^[nad_index].logical_unit_number, rfc$es_on);

            {  Initiate the dump process.

            IF  (NOT local_nad^.maintenance_status.test_requested)  THEN
              rfp$local_nad_dump(nad_index, local_status);
              IF  NOT local_status.normal  THEN
                rfp$log_the_status(local_status);
              IFEND;
            IFEND;
            local_nad^.maintenance_status.reload_in_progress := TRUE;
          IFEND;
        IFEND;
        IF  (local_nad^.maintenance_status.reload_in_progress) AND
            (local_nad^.requests_posted = 0)  THEN

          {  Tell the driver to process unit requests.  (in case the dump failed)

          rfp$change_nad_status(local_nad^.logical_unit_number, rfc$es_on);

          {  Initiate the reload process.

          rfp$local_nad_load(nad_index, local_status);
          IF  NOT local_status.normal  THEN
            rfp$log_the_status(local_status);
            local_nad^.maintenance_status.reload_failed := TRUE;
          IFEND;
          local_nad^.maintenance_status.reload_in_progress := FALSE;
        IFEND;
        IF  (NOT local_nad^.maintenance_selections.perform_auto_reload) OR
            (local_nad^.maintenance_status.reload_failed) OR
            (local_nad^.maintenance_status.reloads_performed >=
                local_nad^.maintenance_selections.reload_threshold) THEN

          {   Changing the state to OFF prevents further access until an explicit operator
          {   action re-instates the device.

          local_nad^.maintenance_status.reload_failed := TRUE;
          local_nad^.current_status.device_status := rfc$es_off;
          log_nad_statistics(local_nad);

          stringrep(critical_msg, i, 'NAD ', local_nad^.name, ' is not available.');
          dpp$put_critical_message(critical_msg(1,i), {ignore} local_status);
        IFEND;
      IFEND;
      IF  (NOT local_nad^.maintenance_status.reload_failed) AND
          (local_nad^.current_status.device_status = rfc$es_off)  THEN
        rfp$unconditionally_status(local_nad^.logical_unit_number);
        clear_incoming_connects(nad_index);
        clear_connection_entries(nad_index, '       ', rfc$local_nad_failure);
        release_all_control_messages(nad_index);
        rfp$check_event_list(current_time, FALSE);
        WHILE  (local_nad^.requests_posted <> 0)  DO
          pmp$wait(1000, 100);
          rfp$process_pp_response_flag(rfc$pp_response_available);
        WHILEND;
        local_nad^.maintenance_status.reload_failed := TRUE;
        log_nad_statistics(local_nad);
      IFEND;
    FOREND;

  PROCEND rfp$auto_dump_and_reload;
?? NEWTITLE := '      RFP$LOCAL_NAD_LOAD' ??
?? EJECT ??
  PROCEDURE  [XDCL] rfp$local_nad_load(nad_index: rft$local_nads;
                                   VAR status: ost$status);
*copyc rfh$local_nad_load

    VAR
        actual_buff_size: nlt$bm_buffer_length,
        buffer_index: rft$buffer_count,
        mc_file_open: BOOLEAN,
        ignore_status: ost$status,
        request_info: ^SEQ(*),
        load_request_status: ^rft$load_dump_status;

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

    ALLOCATE  load_request_status  IN  osv$task_private_heap^;
    IF  load_request_status = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$LOCAL_NAD_LOAD', status);
      RETURN;
    IFEND;
    ALLOCATE  load_request_status^.buffer_list : [1..rfc$max_load_dump_buffers] IN  osv$task_private_heap^;
    IF  load_request_status^.buffer_list = NIL  THEN
      FREE  load_request_status  IN  osv$task_private_heap^;
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$LOCAL_NAD_LOAD', status);
      RETURN;
    IFEND;
    load_request_status^.number_of_buffers := 0;

  /main_section/
    BEGIN
      get_nad_microcode(rfc$mc_type_180,
        load_request_status^.mc_lfn, load_request_status^.mc_file_id,
        load_request_status^.mc_image, load_request_status^.mc_length, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      mc_file_open := TRUE;
      generate_mc_init_prams(nad_index, load_request_status^.init_prams);
      load_request_status^.number_of_buffers := rfc$max_load_dump_buffers;
      rfp$reserve_wired_buffers(load_request_status^.buffer_list^, load_request_status^.number_of_buffers);
      IF  load_request_status^.number_of_buffers = 0  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'network wired', status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$LOCAL_NAD_LOAD', status);
        EXIT /main_section/;
      IFEND;

{     Note. Reduce the space in each buffer to the next lower multiple of 6 bytes so the PP can send
{           multiples of 48-bits through the 12-bit channel to the 16-bit NAD, thus preventing the NAD
{           from padding test and load data.

      IF load_request_status^.buffer_list^[1].length > rfc$max_load_dump_buffer_size THEN
        actual_buff_size := (rfc$max_load_dump_buffer_size DIV 6) * 6;
      ELSE
        actual_buff_size := (load_request_status^.buffer_list^[1].length DIV 6) * 6;
      IFEND;

      FOR  buffer_index := 1 TO load_request_status^.number_of_buffers  DO
        load_request_status^.buffer_list^[buffer_index].length := actual_buff_size;
      FOREND;

      load_request_status^.time_of_first_go := 0;
      load_request_status^.state := rfc$lt_mem_test_begin;
      load_request_status^.mem_test_first_pass := TRUE;
      load_request_status^.initial_phase := TRUE;
      load_request_status^.current_nad_address := 0;

      { The request buffer size is set to two times the command buffer size.  This number was derived from
      { from the fact that each request size is no more than two times the actual command size.

      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  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_local_nad_load, load_request_status,
        request_info, status);

    END  /main_section/;

    IF  NOT status.normal  THEN
      IF  mc_file_open  THEN
        fsp$close_file(load_request_status^.mc_file_id, ignore_status);
        amp$return(load_request_status^.mc_lfn, ignore_status);
      IFEND;
      IF  load_request_status^.number_of_buffers <> 0  THEN
        rfp$release_wired_buffers(load_request_status^.buffer_list^, load_request_status^.number_of_buffers);
      IFEND;
      FREE  load_request_status^.buffer_list  IN  osv$task_private_heap^;
      FREE  load_request_status  IN  osv$task_private_heap^;
    IFEND;

  PROCEND rfp$local_nad_load;
?? NEWTITLE := '        GET_NAD_MICROCODE' ??
?? EJECT ??
  PROCEDURE get_nad_microcode(mc_type: rft$microcode_types;
                          VAR mc_lfn: amt$local_file_name;
                          VAR mc_fid: amt$file_identifier;
                          VAR mc_image: ^CELL;
                          VAR mc_length: INTEGER;
                          VAR status: ost$status);

{    The purpose of this request is to obtain the NAD microcode file.
{
{    mc_type: (input) This paramter specifies the type of microcode to load.
{      The name identified by the microcode type determines the name of the
{      microcode file.
{
{    mc_lfn: (output) This parameter returns the local file name of the
{      microcode file.
{
{    mc_fid: (output) This parameter returns the file identifier of the open
{      microcode file.
{
{    mc_image: (output) This parameter returns the pointer to the first byte
{      within the file.
{
{    mc_length: (output) This parameter returns the eoi_byte_address.
{
{    status: (output) This paramter returns the results of the request.  A status of
{      normal means that the microcode file was found and has been opened for segment
{      access.

    VAR
        mt_conversion_types: [STATIC,READ, oss$job_paged_literal] ARRAY [rft$microcode_types] OF string(4) :=
          ['C180', 'C170', 'VAX', 'IBM', 'C205', 'INET', 'NTN'];

    VAR
        access_info: ^amt$access_information,
        segment_ptr: amt$segment_pointer,
        ignore_status: ost$status,
        path: ^pft$path,
        password: pft$name,
        usage_selections: pft$usage_selections,
        share_selections: pft$share_selections,
        cycle_selector: pft$cycle_selector;

    PUSH path : [1..5];
    path^[1] := rfc$rhfam_family_name;
    path^[2] := rfc$rhfam_master_catalog;
    path^[3] := rfc$rhfam_sub_catalog;
    path^[4] := rfc$microcode_sub_catalog;
    path^[5] := mt_conversion_types[mc_type];
    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;
    mc_lfn(1,7) := '$RHFAM_';
    mc_lfn(8,*) := mt_conversion_types[mc_type];
    pfp$attach(mc_lfn, path^, cycle_selector, password, usage_selections, share_selections,
                    pfc$no_wait, status);
    IF  NOT status.normal  AND
        (status.condition <> pfe$cycle_busy) AND
        (status.condition <> pfe$lfn_in_use) THEN
      RETURN;
    IFEND;

    fsp$open_file(mc_lfn, amc$segment, NIL, NIL, NIL, NIL, NIL,
      mc_fid, status);
    IF  NOT status.normal  THEN
      amp$return(mc_lfn, ignore_status);
      RETURN;
    IFEND;

    amp$get_segment_pointer(mc_fid, amc$cell_pointer, segment_ptr, status);
    IF  NOT status.normal  THEN
      fsp$close_file(mc_fid, ignore_status);
      amp$return(mc_lfn, ignore_status);
      RETURN;
    IFEND;
    mc_image := segment_ptr.cell_pointer;

    PUSH access_info : [1..1];
    access_info^[1].key := amc$eoi_byte_address;
    amp$fetch_access_information(mc_fid, access_info^, status);
    IF  NOT status.normal  THEN
      fsp$close_file(mc_fid, ignore_status);
      amp$return(mc_lfn, ignore_status);
      RETURN;
    IFEND;
    mc_length := access_info^[1].eoi_byte_address;

  PROCEND get_nad_microcode;
?? TITLE := '        GENERATE_MC_INIT_PRAMS' ??
?? EJECT ??
  PROCEDURE generate_mc_init_prams(nad_table_index: rft$local_nads;
                               VAR init_prams: rft$mc_initialization_prams);

{    The purpose of this proceure is to generate the microcode intialization parameters
{    for the specified NAD.
{
{    nad_table_index: (input) This parameter specifies the index of withing the local NAD
{      table of the corresponding NAD.
{
{    init_prams: (output) This paramter returns the initialization table entries.

    VAR
        tcu_index: rfc$min_tcu .. rfc$max_tcu,
        nad_load_prams: rft$load_parameters;

    nad_load_prams := rfv$status_table.local_nads^[nad_table_index].maintenance_selections.load_parameters;
    pmp$zero_out_table(#LOC(init_prams), #SIZE(init_prams));
    init_prams.memory_size := rfc$default_memory_size;
    FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
      init_prams.tcu_enables[tcu_index] := TRUE;
    FOREND;
    init_prams.connecting_nads := nad_load_prams.maximum_nad_entries;
    init_prams.max_connections := nad_load_prams.maximum_connections;
    init_prams.system_buffers := nad_load_prams.maximum_connections + 1;
    init_prams.control_messages := nad_load_prams.maximum_connections;
    init_prams.type_1_buff_size := rfc$nad_type_1_buff_lgth;
    init_prams.type_1_buff_count := rfc$min_type_1_buffs;
    init_prams.incoming_control_messages := nad_load_prams.maximum_connections - 1;
    init_prams.outgoing_control_messages := nad_load_prams.maximum_connections - 1;
    init_prams.send_queue_limit := nad_load_prams.send_queue_limit;
    init_prams.receive_queue_limit := nad_load_prams.receive_queue_limit;
    init_prams.monitor_trace := nad_load_prams.monitor_trace;
    init_prams.trunk_trace := nad_load_prams.trunk_trace;
    init_prams.device_trace := nad_load_prams.device_trace;

  PROCEND generate_mc_init_prams;
?? TITLE := '        RFP$BUILD_LOAD_REQUEST' ??
?? EJECT ??
  PROCEDURE  [XDCL]  rfp$build_load_request(VAR load_request_status: ^rft$load_dump_status;
                                            VAR request_info: ^SEQ(*);
                                            VAR status: ost$status);

{    This routine builds requests, first for testing the local NAD, and then for loading the
{    microcode.
{
{    load_request_buffer: (input,output) This parameter points to the buffer specifying the
{      current microcode load status information.  This routine moves as much data as possible
{      into the wired buffers and returns the current microcode load status.
{
{    request_info: (input,output) This parameter specifies an adaptable sequence where the
{      request is to be placed.  Upon exit the sequence contains the load request functions.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        number_of_commands: ^0..rfc$command_buffer_size,
        command_identifier: ^rft$logical_commands,
        physical_command: ^rft$physical_commands;

    status.normal := TRUE;

    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, 'RFP$BUILD_LOAD_REQUEST', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$lc_process_physical_command;
    NEXT  number_of_commands  IN  request_info;
    IF  number_of_commands = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'command count too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$BUILD_LOAD_REQUEST', status);
      RETURN;
    IFEND;
    number_of_commands^ := 0;

    CASE  load_request_status^.state  OF
    = rfc$lt_mem_test_begin, rfc$lt_mem_test_write, rfc$lt_mem_test_read =
      test_nad_memory(load_request_status, request_info, number_of_commands, status);
    ELSE
      rfp$move_mc_to_wired_buffers(load_request_status, request_info, number_of_commands, status);
    CASEND;
  PROCEND rfp$build_load_request;
?? NEWTITLE := '          TEST_NAD_MEMORY' ??
?? EJECT ??
  PROCEDURE test_nad_memory(VAR load_request_status: ^rft$load_dump_status;
                            VAR request_info: ^SEQ(*);
                            VAR number_of_commands: ^0..rfc$command_buffer_size;
                            VAR status: ost$status);

{    The purpose of this procedure is to test the local NAD's memory before loading microcode.
{
{    The test first checks the channel and device interface (mem_test_begin).  If successful,
{    the test then writes (mem_test_write) and reads (mem_test_read) the lower 32K words
{    of NAD memory several times, using the wired buffers; module RFM$PROCESS_PP_RESPONSE_FLAG
{    supplies and checks the test data in the buffers.
{
{    load_request_status: (input,output) This parameter points to the buffer containing
{      current status of the microcode loading process.
{
{    request_info:(input,output) This parameter specifies the position within the adaptable sequence
{      for adding the next physical command entry.
{
{    number_of_commands: (input,output) This parameter points to the counter containing the number
{      of commands in the adaptable sequence.
{
{    status: (output) This parameter returns the results of the test.

    VAR
        actual_buff_size: nlt$bm_buffer_length,
        buffer_index: rft$buffer_count,
        remaining_bytes: rft$bytes_transferred;

      CASE  load_request_status^.state  OF

      = rfc$lt_mem_test_begin =

        add_nad_di_start_up(request_info, number_of_commands, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;

      = rfc$lt_mem_test_write =

          buffer_index := 1;
          WHILE (buffer_index <= load_request_status^.number_of_buffers)  AND
            (load_request_status^.buffer_list^[buffer_index].byte_count > 0)  DO
            add_nad_transfer_piece(rfc$io_output,
              load_request_status^.buffer_list^[buffer_index].byte_count,
              load_request_status^.buffer_list^[buffer_index].buffer,
              load_request_status^.current_nad_address, request_info, number_of_commands, status);
            IF  NOT status.normal  THEN
              RETURN;
            IFEND;
            buffer_index := buffer_index + 1;
          WHILEND;

      = rfc$lt_mem_test_read =

        actual_buff_size := load_request_status^.buffer_list^[1].length;
        remaining_bytes := load_request_status^.nt_length - load_request_status^.nt_offset;
        buffer_index := 1;
        WHILE  (buffer_index <= load_request_status^.number_of_buffers)  AND
               (remaining_bytes > 0) DO
          IF  remaining_bytes >= actual_buff_size  THEN
            load_request_status^.buffer_list^[buffer_index].byte_count := actual_buff_size;
            remaining_bytes := remaining_bytes - actual_buff_size;
          ELSE
            load_request_status^.buffer_list^[buffer_index].byte_count := remaining_bytes;
            remaining_bytes := 0;
          IFEND;
          add_nad_transfer_piece(rfc$io_input,
            load_request_status^.buffer_list^[buffer_index].byte_count,
            load_request_status^.buffer_list^[buffer_index].buffer,
            load_request_status^.current_nad_address,
            request_info, number_of_commands, status);
          IF  NOT status.normal  THEN
            RETURN;
          IFEND;
          buffer_index := buffer_index + 1;
        WHILEND;

      ELSE  {  This should never happen  }

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

  PROCEND test_nad_memory;
?? TITLE := '          RFP$MOVE_MC_TO_WIRED_BUFFERS' ??
?? EJECT ??
  PROCEDURE rfp$move_mc_to_wired_buffers(VAR load_request_status: ^rft$load_dump_status;
                                         VAR request_info: ^SEQ(*);
                                         VAR number_of_commands: ^0..rfc$command_buffer_size;
                                         VAR status: ost$status);

{    The purpose of this procedure is to move the microcode file image into the
{    network wired buffers.
{
{    load_request_buffer: (input,output) This parameter points to the buffer specifying the
{      current microcode load status information.  This routine moves as much data as possible
{      into the wired buffers and returns the current microcode load status.
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next command.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    number_of_commands: (input,output) This parameter points to the counter in the sequence, which
{      maintains a count of the number of commands in the sequence.
{
{    status: (output) This parameter returns the results of the request.
{

    VAR
        ignore_status: ost$status,
        mc_init_prams: ^rft$mc_initialization_prams,
        buffer_index,
        last_buffer,
        current_buffer: rft$buffer_count,
        fill_bytes,
        remaining_bytes: rft$bytes_transferred,
        fill_word: [STATIC,READ, oss$job_paged_literal] 0..0ffffffffff(16) := 0,
        fill_buffer,
        current_ptr: ^CELL,
        microcode_mask,
        microcode_value: rft$nad_status_flags,
        state_integer_value: integer,
        continuing_process: boolean;

    current_buffer := 1;

  /load_states/
    REPEAT

      CASE  load_request_status^.state  OF
      = rfc$ls_begin_load =

        add_nad_di_start_up(request_info, number_of_commands, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        load_request_status^.state := rfc$ls_sending_microcode;
        load_request_status^.mc_offset := 0;
        continuing_process := TRUE;

      = rfc$ls_sending_microcode =

        continuing_process := FALSE;
        remaining_bytes := load_request_status^.mc_length - load_request_status^.mc_offset;
        current_ptr := i#ptr(load_request_status^.mc_offset, load_request_status^.mc_image);
        rfp$move_data_to_wired_buffs(load_request_status^.buffer_list^, current_ptr,
          load_request_status^.number_of_buffers, current_buffer, remaining_bytes);
        load_request_status^.mc_offset := load_request_status^.mc_length - remaining_bytes;

        buffer_index := 1;
        WHILE  (buffer_index <= load_request_status^.number_of_buffers)  AND
               (load_request_status^.buffer_list^[buffer_index].byte_count =
                load_request_status^.buffer_list^[buffer_index].length)  DO
          add_nad_transfer_piece(rfc$io_output,
            load_request_status^.buffer_list^[buffer_index].byte_count,
            load_request_status^.buffer_list^[buffer_index].buffer,
            load_request_status^.current_nad_address, request_info, number_of_commands, status);
          load_request_status^.buffer_list^[buffer_index].byte_count := 0;
          IF  NOT status.normal  THEN
            RETURN;
          IFEND;
          buffer_index := buffer_index +1;
        WHILEND;

        IF  (remaining_bytes = 0)  THEN
          IF  (buffer_index <= load_request_status^.number_of_buffers)  THEN

            {  NOTE - The NAD microcode must be zero filled to the next multiple of six bytes.

            fill_bytes := (6 - (load_request_status^.buffer_list^[current_buffer].byte_count MOD 6)) MOD 6;
            fill_buffer := #LOC(fill_word);
            last_buffer := current_buffer;
            rfp$move_data_to_wired_buffs(load_request_status^.buffer_list^, fill_buffer,
              load_request_status^.number_of_buffers, current_buffer, fill_bytes);
            IF  last_buffer <> current_buffer  THEN
              add_nad_transfer_piece(rfc$io_output,
                load_request_status^.buffer_list^[last_buffer].byte_count,
                load_request_status^.buffer_list^[last_buffer].buffer,
                load_request_status^.current_nad_address, request_info, number_of_commands, status);
              load_request_status^.buffer_list^[last_buffer].byte_count := 0;
              IF  NOT status.normal  THEN
                RETURN;
              IFEND;
            IFEND;
            continuing_process := TRUE;
          IFEND;
          load_request_status^.state := rfc$ls_sending_init_prams;
        IFEND;

      = rfc$ls_sending_init_prams =

        continuing_process := FALSE;
        IF  (#SIZE(rft$mc_initialization_prams) >
            ((load_request_status^.buffer_list^[current_buffer].length) -
             (load_request_status^.buffer_list^[current_buffer].byte_count)))  THEN
          add_nad_transfer_piece(rfc$io_output,
            load_request_status^.buffer_list^[current_buffer].byte_count,
            load_request_status^.buffer_list^[current_buffer].buffer,
            load_request_status^.current_nad_address, request_info, number_of_commands, status);
          load_request_status^.buffer_list^[current_buffer].byte_count := 0;
          IF  NOT status.normal  THEN
            RETURN;
          IFEND;
          current_buffer := current_buffer + 1;
          IF  current_buffer > load_request_status^.number_of_buffers  THEN
            RETURN;
          IFEND;
        IFEND;
        last_buffer := current_buffer;
        mc_init_prams  := #LOC(load_request_status^.init_prams);
        remaining_bytes := #SIZE(rft$mc_initialization_prams);
        rfp$move_data_to_wired_buffs(load_request_status^.buffer_list^, mc_init_prams,
          load_request_status^.number_of_buffers, current_buffer, remaining_bytes);
        add_nad_transfer_piece(rfc$io_output,
          load_request_status^.buffer_list^[last_buffer].byte_count,
          load_request_status^.buffer_list^[last_buffer].buffer,
          load_request_status^.current_nad_address, request_info, number_of_commands, status);
        load_request_status^.buffer_list^[last_buffer].byte_count := 0;
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        load_request_status^.state := rfc$ls_send_go;
        continuing_process := TRUE;

      = rfc$ls_send_go =

        add_physical_function(rfc$di_go_nad, request_info, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        number_of_commands^ := number_of_commands^ + 1;
        microcode_mask := rfv$null_microcode_status;
        microcode_value := rfv$null_microcode_status;
        microcode_mask.response := rfc$nad_response_mask;
        microcode_value.response := rfc$nr_acknowledge;
        add_nad_status_request(rfc$sk_microcode_status, microcode_mask, microcode_value,
          request_info, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        number_of_commands^ := number_of_commands^ + 1;
        pmp$get_microsecond_clock(load_request_status^.time_of_first_go, ignore_status);

        load_request_status^.state := rfc$ls_go_sent;
        continuing_process := FALSE;

      = rfc$ls_go_sent =

        microcode_mask := rfv$null_microcode_status;
        microcode_value := rfv$null_microcode_status;
        microcode_mask.response := rfc$nad_response_mask;
        microcode_value.response := rfc$nr_acknowledge;
        add_nad_status_request(rfc$sk_microcode_status, microcode_mask, microcode_value,
          request_info, status);
        number_of_commands^ := number_of_commands^ + 1;
        continuing_process := FALSE;

      = rfc$ls_get_mc_status =

        rfp$form_obtain_status_req(0, 0, FALSE, request_info, status);
        continuing_process := FALSE;

      ELSE  {  This should never happen  }

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

    UNTIL  NOT continuing_process;

  PROCEND rfp$move_mc_to_wired_buffers;
?? NEWTITLE := '            RFP$FORM_OBTAIN_STATUS_REQ' ??
?? EJECT ??
  PROCEDURE  [XDCL] rfp$form_obtain_status_req(path_number: rft$path_identifier;
                                               retry_count: rft$retry_count;
                                               remote_status_primed: BOOLEAN;
                                           VAR request_buf: ^SEQ(*);
                                           VAR status: ost$status);

{    The purpose of this routine is to form a request to obtain the general status entry
{    from the specified nad.
{
{    path_number: (input) This parameter specifies the path number to be used to solicit the NAD
{      general status information from.  IF zero, the general status from the local NAD, identified
{      by the logical unit number, is obtained.  If non-zero, a remote general status is requested
{      from the remote NAD associated with the path identied by the path identifier.
{
{    retry_count: (input) This parameter specifies the number of retries to be attempted to
{      obtain a remote NAD general status.  This parameter is only meaningful if the corresponding
{      path identifier is non-zero.
{
{    remote_status_primed: (input) This parameter specifies whether or not the read remote status
{      has already been issued for the corresponding path.  This parameter is only meaningful if
{      the corresponding path identifier is non-zero.
{
{    request_buf: (input,output) This parameter contians a pointer to an adaptable sequence
{      which is to contain the ring 1 request.
{
{    status: (output) This parameter specifies the results of the request.

    VAR
        command_identifier: ^rft$logical_commands,
        retry_count_p: ^rft$retry_count,
        status_primed: ^BOOLEAN,
        path_id: ^rft$path_identifier;

    status.normal := TRUE;

    RESET request_buf;
    NEXT  command_identifier  IN  request_buf;
    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, 'RFP$FORM_OBTAIN_STATUS_REQ', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$lc_obtain_nad_general_stat;
    NEXT  status_primed  IN  request_buf;
    IF  status_primed = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'primed flag too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$FORM_OBTAIN_STATUS_REQ', status);
      RETURN;
    IFEND;
    status_primed^ := remote_status_primed;
    NEXT  path_id  IN  request_buf;
    IF  path_id = 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, 'RFP$FORM_OBTAIN_STATUS_REQ', status);
      RETURN;
    IFEND;
    path_id^ := path_number;
    NEXT  retry_count_p  IN  request_buf;
    IF  retry_count_p = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'retry count too big',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$FORM_OBTAIN_STATUS_REQ', status);
      RETURN;
    IFEND;
    retry_count_p^ := retry_count;

  PROCEND rfp$form_obtain_status_req;
?? OLDTITLE ??
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '      LOAD AND DUMP HELPER ROUTINES' ??
?? NEWTITLE := '        ADD_PHYSICAL_FUNCTION' ??
?? EJECT ??
  PROCEDURE  add_physical_function(nad_function: rft$nad_function_codes;
                               VAR request_info: ^SEQ(*);
                               VAR status: ost$status);

{    The purpose of this routine is to add a function nad entry into the physical command list of the
{    NAD request block.
{
{    nad_function: (input) This parameter specifies the NAD function to be issued.
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next function.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        function_code: ^rft$nad_function_codes,
        physical_command: ^rft$physical_commands;

    NEXT  physical_command  IN  request_info;
    IF  physical_command = 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, 'ADD_PHYSICAL_FUNCTION', status);
      RETURN;
    IFEND;
    physical_command^ := rfc$pc_function_nad;
    NEXT  function_code  IN  request_info;
    IF  function_code = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'function code too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_PHYSICAL_FUNCTION', status);
      RETURN;
    IFEND;
    function_code^ := nad_function;

  PROCEND add_physical_function;
?? TITLE := '        ADD_NAD_STATUS_REQUEST' ??
?? EJECT ??
  PROCEDURE  add_nad_status_request(nad_status_kind: rft$nad_status_kinds;
                                    nad_status_mask: rft$nad_status_flags;
                                    nad_status_value: rft$nad_status_flags;
                                VAR request_info: ^SEQ(*);
                                VAR status: ost$status);

{    The purpose of this routine is to add a function nad entry into the physical command list of the
{    NAD request block.
{
{    nad_status_kind: (input) This parameter specifies the type of NAD status.
{
{    nad_status_mask: (input) This parameter specifies the NAD status mask.
{
{    nad_status_value: (input) This parameter specifies the expected NAD status value.
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next function.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        nad_status: ^rft$nad_status_flags,
        physical_command: ^rft$physical_commands;

    NEXT  physical_command  IN  request_info;
    IF  physical_command = 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, 'ADD_NAD_STATUS_REQUEST', status);
      RETURN;
    IFEND;
    CASE  nad_status_kind  OF
    = rfc$sk_microcode_status =
      physical_command^ := rfc$pc_microcode_status;
    = rfc$sk_hardware_status =
      physical_command^ := rfc$pc_hardware_status;
    CASEND;
    NEXT  nad_status  IN  request_info;
    IF  nad_status = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'status mask too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_NAD_STATUS_REQUEST', status);
      RETURN;
    IFEND;
    nad_status^ := nad_status_mask;
    NEXT  nad_status  IN  request_info;
    IF  nad_status = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'status value too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_NAD_STATUS_REQUEST', status);
      RETURN;
    IFEND;
    nad_status^ := nad_status_value;

  PROCEND add_nad_status_request;
?? TITLE := '        ADD_XFR_LGTH_ADDR' ??
?? EJECT ??
  PROCEDURE  add_xfr_lgth_addr(transfer_address: rft$transfer_lgth_addr;
                               transfer_length: rft$transfer_lgth_addr;
                           VAR request_info: ^SEQ(*);
                           VAR status: ost$status);

{    The purpose of this routine is to add a function nad entry into the physical command list of the
{    NAD request block.
{
{    transfer_address: (input) This parameter specifies the NAD address to start sending/receiving the data.
{
{    transfer_length: (input) This parameter specifies the number of NAD words being sent/received.
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next command.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        xfr_lgth_addr: ^rft$transfer_lgth_addr,
        physical_command: ^rft$physical_commands;

    NEXT  physical_command  IN  request_info;
    IF  physical_command = 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, 'ADD_XFR_LGTH_ADDR', status);
      RETURN;
    IFEND;
    physical_command^ := rfc$pc_set_addr_and_length;
    NEXT  xfr_lgth_addr  IN  request_info;
    IF  xfr_lgth_addr = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'xfer length too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_XFR_LGTH_ADDR', status);
      RETURN;
    IFEND;
    xfr_lgth_addr^ := transfer_address;
    NEXT  xfr_lgth_addr  IN  request_info;
    IF  xfr_lgth_addr = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'xfer address too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_XFR_LGTH_ADDR', status);
      RETURN;
    IFEND;
    xfr_lgth_addr^ := transfer_length;

  PROCEND add_xfr_lgth_addr;
?? TITLE := '        ADD_IO_BUFFER' ??
?? EJECT ??
  PROCEDURE  add_io_buffer(io_type: rft$io_types;
                           buff_pva: ^cell;
                           buff_length: rft$transfer_length;
                       VAR request_info: ^SEQ(*);
                       VAR status: ost$status);

{    The purpose of this routine is to add a function nad entry into the physical command list of the
{    NAD request block.
{
{    io_type: (input) This parameter specifies the type of I/O performed.
{
{    buff_pva: (input) This parameter specifies the pointer to the data buffer.
{
{    buff_length: (input) This parameter specifies the length of the data buffer (in 8-bit bytes).
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next command.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    status: (output) This parameter returns the results of the request.


    VAR
        pva_ptr: ^^cell,
        length_ptr: ^rft$transfer_length,
        physical_command: ^rft$physical_commands;

    NEXT  physical_command  IN  request_info;
    IF  physical_command = 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, 'ADD_IO_BUFFER', status);
      RETURN;
    IFEND;
    CASE  io_type  OF
    = rfc$io_input =
      physical_command^ := rfc$pc_input_8_in_8_mode;
    = rfc$io_output =
      physical_command^ := rfc$pc_output_8_in_8_mode;
    CASEND;
    NEXT  length_ptr  IN  request_info;
    IF  length_ptr = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'pva length too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_IO_BUFFER', status);
      RETURN;
    IFEND;
    length_ptr^ := buff_length;
    NEXT  pva_ptr  IN  request_info;
    IF  pva_ptr = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'pva too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'ADD_IO_BUFFER', status);
      RETURN;
    IFEND;
    pva_ptr^ := buff_pva;

  PROCEND add_io_buffer;
?? TITLE := '        ADD_NAD_DI_START_UP' ??
?? EJECT ??
  PROCEDURE  add_nad_di_start_up(VAR request_info: ^SEQ(*);
                                 VAR number_of_commands: ^0..rfc$command_buffer_size;
                                 VAR status: ost$status);

{    The purpose of this procedure is to generate a direct NAD I/O request for the PP driver to
{    to process.
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next command.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    number_of_commands: (input,output) This parameter points to the counter in the sequence, which
{      maintains a count of the number of commands in the sequence.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        hardware_mask,
        hardware_value: rft$nad_status_flags;

    add_physical_function(rfc$di_interface_master_clear, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;
    add_physical_function(rfc$di_clear_parity_error, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;
    hardware_mask := rfv$null_hardware_status;
    hardware_value := rfv$null_hardware_status;
    hardware_mask.device_not_enabled := TRUE;
    add_nad_status_request(rfc$sk_hardware_status, hardware_mask, hardware_value, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;
    add_physical_function(rfc$di_processor_master_clear, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;

  PROCEND add_nad_di_start_up;
?? TITLE := '        ADD_NAD_TRANSFER_PIECE' ??
?? EJECT ??
  PROCEDURE  add_nad_transfer_piece(io_type: rft$io_types;
                                    bytes_to_transfer: rft$transfer_length;
                                    current_buffer: ^cell;
                                VAR nad_address: rft$nad_memory_size;
                                VAR request_info: ^SEQ(*);
                                VAR number_of_commands: ^0..rfc$command_buffer_size;
                                VAR status: ost$status);

{    The purpose of this procedure is to generate a direct NAD I/O request for the PP driver to
{    to process.
{
{    bytes_transferred: (input) This parameter specifies the number of bytes to be transferred.
{
{    current_buffer: (input) This parameter points to the buffer that is to be transferred.
{
{    nad_address: (input,output) This parameter specifies the starting address, within NAD memory, to
{      transfer the data.  Upon exit this parameter contains the next nad address.
{
{    request_info: (input,output) This paramter specifies the current location within the request sequence
{      to add the next command.  The physical command entry is added to the sequence and this pointer
{      upon return specifies the next entry location.
{
{    number_of_commands: (input,output) This parameter points to the counter in the sequence, which
{      maintains a count of the number of commands in the sequence.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        microcode_mask,
        microcode_value: rft$nad_status_flags,
        transfer_length,
        transfer_address: rft$transfer_lgth_addr;

    add_physical_function(rfc$di_set_addr_and_length, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;
    transfer_length := rfv$initial_transfer_length;
    transfer_address := rfv$initial_transfer_address;
    transfer_address.lower_8_bits := nad_address MOD 256;
    transfer_address.upper_8_bits := nad_address DIV 256;
    transfer_length.lower_8_bits := (bytes_to_transfer DIV 2) MOD 256;
    transfer_length.upper_8_bits := (bytes_to_transfer DIV 2) DIV 256;
    add_xfr_lgth_addr(transfer_address, transfer_length, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;
    add_io_buffer(io_type, current_buffer, bytes_to_transfer, request_info, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    number_of_commands^ := number_of_commands^ + 1;
    IF (nad_address + (bytes_to_transfer DIV 2)) > rfc$max_nad_memory_size THEN
      nad_address := 0;
    ELSE
      nad_address := nad_address + (bytes_to_transfer DIV 2);
    IFEND;

  PROCEND  add_nad_transfer_piece;
?? OLDTITLE ??
?? TITLE := '      RFP$LOCAL_NAD_DUMP' ??
?? EJECT ??
  PROCEDURE  [XDCL] rfp$local_nad_dump(nad_index: rft$local_nads;
                                   VAR status: ost$status);

*copyc rfh$local_nad_dump

    VAR
        request_info: ^SEQ(*),
        dump_file_open: BOOLEAN,
        ignore_status: ost$status,
        dump_request_status: ^rft$load_dump_status;

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

    ALLOCATE  dump_request_status  IN  osv$task_private_heap^;
    IF  dump_request_status = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$LOCAL_NAD_DUMP', status);
      RETURN;
    IFEND;
    ALLOCATE  dump_request_status^.buffer_list : [1..rfc$max_load_dump_buffers]  IN  osv$task_private_heap^;
    IF  dump_request_status^.buffer_list = NIL  THEN
      FREE  dump_request_status  IN  osv$task_private_heap^;
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'task private', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$LOCAL_NAD_DUMP', status);
      RETURN;
    IFEND;
    dump_request_status^.number_of_buffers := 0;

  /main_section/
    BEGIN
      get_dump_file(rfv$status_table.local_nads^[nad_index].maintenance_selections.dump_disposition,
        rfv$status_table.local_nads^[nad_index].name, dump_request_status^.mc_image,
        dump_request_status^.mc_lfn, dump_request_status^.mc_file_id, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      dump_file_open := TRUE;
      dump_request_status^.number_of_buffers := rfc$max_load_dump_buffers;
      rfp$reserve_wired_buffers(dump_request_status^.buffer_list^, dump_request_status^.number_of_buffers);
      IF  dump_request_status^.number_of_buffers = 0  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'network wired', status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$LOCAL_NAD_DUMP', status);
        EXIT /main_section/;
      IFEND;

      dump_request_status^.state := rfc$ds_begin_dump;
      dump_request_status^.current_nad_address := 0;

      { The request buffer size is set to two times the command buffer size.  This number was derived from
      { from the fact that each request size is no more than two times the actual command size.

      PUSH  request_info : [[REP  2*rfc$command_buffer_size OF integer]];
      RESET request_info;

      rfp$build_dump_request(dump_request_status, request_info, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      rfp$queue_request(nad_index, 1, rfc$unit_request, rfc$rk_local_nad_dump, dump_request_status,
        request_info, status);

    END  /main_section/;

    IF  NOT status.normal  THEN
      IF  dump_file_open  THEN
        fsp$close_file(dump_request_status^.mc_file_id, ignore_status);
        amp$return(dump_request_status^.mc_lfn, ignore_status);
      IFEND;
      IF  dump_request_status^.number_of_buffers <> 0  THEN
        rfp$release_wired_buffers(dump_request_status^.buffer_list^, dump_request_status^.number_of_buffers);
      IFEND;
      FREE  dump_request_status^.buffer_list  IN  osv$task_private_heap^;
      FREE  dump_request_status  IN  osv$task_private_heap^;
    IFEND;

  PROCEND rfp$local_nad_dump;
?? NEWTITLE := '        GET_DUMP_FILE' ??
?? EJECT ??
  PROCEDURE get_dump_file(dump_disposition: rft$dump_disposition;
                          nad_name: rft$component_name;
                      VAR dump_image: ^CELL;
                      VAR dump_lfn: amt$local_file_name;
                      VAR dump_fid: amt$file_identifier;
                      VAR status: ost$status);

{    The purpose of this request is to create a file to dump the nad memory
{    image onto.
{
{    dump_disposition: (input) This paramter specifies the destination of the nad
{      memory image dump.  This determines the file to contain the NAD dump.
{
{    nad_name: (input) This parameter defines the name of the nad being dumped.
{      This determines the file name to be used to save the nad dump image.
{
{    dump_image: (output) This parameter returns a pointer to the dump
{      file segment.
{
{    dump_lfn: (output) This parameter returns the local file name of the dump
{      file image.
{
{    dump_fid: (output) This parameter returns the file identifier of the
{      open dump file.
{
{    status: (output) This paramter returns the results of the request.  A status of
{      normal means that the microcode file was found and has been opened for segment
{      access.

    VAR
        ignore_status: ost$status,
        segment_ptr: amt$segment_pointer,
        file_attributes: ^fst$file_cycle_attributes,
        unique_name: ost$unique_name,
        catalog_path,
        file_path: ^pft$path,
        password: pft$name,
        retention: pft$retention,
        cycle_selector: pft$cycle_selector;

    pmp$generate_unique_name(unique_name, ignore_status);
    dump_lfn := unique_name.value;
    IF  (dump_disposition = rfc$dd_save_last)  OR
        (dump_disposition = rfc$dd_save_all)  THEN
      PUSH catalog_path : [1..4];
      catalog_path^[1] := rfc$rhfam_family_name;
      catalog_path^[2] := rfc$rhfam_master_catalog;
      catalog_path^[3] := rfc$rhfam_sub_catalog;
      catalog_path^[4] := rfc$dump_sub_catalog;
      pfp$define_catalog(catalog_path^, status);
      IF  (NOT status.normal) AND (status.condition <> pfe$name_already_subcatalog)  THEN
        RETURN;
      IFEND;

      PUSH file_path : [1..5];
      file_path^[1] := rfc$rhfam_family_name;
      file_path^[2] := rfc$rhfam_master_catalog;
      file_path^[3] := rfc$rhfam_sub_catalog;
      file_path^[4] := rfc$dump_sub_catalog;
      file_path^[5] := nad_name;
      password := rfc$password;

      IF  dump_disposition = rfc$dd_save_last  THEN
        cycle_selector.cycle_option := pfc$specific_cycle;
        cycle_selector.cycle_number := 1;
        pfp$purge(file_path^, cycle_selector, password, ignore_status);
      ELSE
        cycle_selector.cycle_option := pfc$highest_cycle;
      IFEND;
      retention := 999;
      pfp$define(dump_lfn, file_path^, cycle_selector, password, retention, pfc$no_log, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
    IFEND;

    PUSH file_attributes : [1..1];
    file_attributes^[1].selector := fsc$ring_attributes;
    file_attributes^[1].ring_attributes.r1 := osc$user_ring_2;
    file_attributes^[1].ring_attributes.r2 := osc$user_ring_2;
    file_attributes^[1].ring_attributes.r3 := osc$user_ring_2;
    fsp$open_file(dump_lfn, amc$segment, NIL, file_attributes, NIL, NIL, NIL,
      dump_fid, status);
    IF  NOT status.normal  THEN
      amp$return(dump_lfn, ignore_status);
      RETURN;
    IFEND;

    amp$get_segment_pointer(dump_fid, amc$cell_pointer, segment_ptr, status);
    IF  status.normal  THEN
      dump_image := segment_ptr.cell_pointer;
    ELSE
      fsp$close_file(dump_fid, ignore_status);
      amp$return(dump_lfn, ignore_status);
    IFEND;

  PROCEND get_dump_file;
?? TITLE := '        RFP$BUILD_DUMP_REQUEST' ??
?? EJECT ??
  PROCEDURE  [XDCL]  rfp$build_dump_request(VAR dump_request_status: ^rft$load_dump_status;
                                            VAR request_info: ^SEQ(*);
                                            VAR status: ost$status);

{    The purpose of this routine is to build the request for dumping the local NAD
{    memory image.
{
{    dump_request_buffer: (input,output) This parameter points to the buffer specifying the
{      current nad memory image dump status information.
{
{    request_info: (input,output) This parameter specifies an adaptable sequence where the
{      request is to be placed.  Upon exit the sequence contains the dump request functions.
{
{    status: (output) This parameter returns the results of the request.


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

    VAR
        memory_words_to_reset,
        memory_remaining_in_bank: INTEGER,
        reset_to_multiple_of_three: BOOLEAN,
        buff_index: 0..rfc$max_load_dump_buffers,
        buffer_size: nlt$bm_buffer_length,
        number_of_commands: ^0..rfc$command_buffer_size,
        command_identifier: ^rft$logical_commands,
        hardware_mask,
        hardware_value: rft$nad_status_flags,
        physical_command: ^rft$physical_commands;

    status.normal := TRUE;

    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, 'RFP$BUILD_DUMP_REQUEST', status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$lc_process_physical_command;
    NEXT  number_of_commands  IN  request_info;
    IF  number_of_commands = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'command count too big', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$BUILD_DUMP_REQUEST', status);
      RETURN;
    IFEND;
    number_of_commands^ := 0;

    CASE  dump_request_status^.state OF
    = rfc$ds_begin_dump =
      dump_request_status^.state := rfc$ds_continue_dump;
      add_physical_function(rfc$di_interface_master_clear, request_info, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      number_of_commands^ := number_of_commands^ + 1;
      hardware_mask := rfv$null_hardware_status;
      hardware_value := rfv$null_hardware_status;
      hardware_mask.device_not_enabled := TRUE;
      add_nad_status_request(rfc$sk_hardware_status, hardware_mask, hardware_value, request_info, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      number_of_commands^ := number_of_commands^ + 1;
      add_physical_function(rfc$di_step_processor, request_info, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      number_of_commands^ := number_of_commands^ + 1;

    = rfc$ds_continue_dump =
      add_physical_function(rfc$di_interface_master_clear, request_info, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      number_of_commands^ := number_of_commands^ + 1;
      hardware_mask := rfv$null_hardware_status;
      hardware_value := rfv$null_hardware_status;
      hardware_mask.nad_processor_not_running := TRUE;
      hardware_value.nad_processor_not_running := TRUE;
      add_nad_status_request(rfc$sk_hardware_status, hardware_mask, hardware_value, request_info, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      number_of_commands^ := number_of_commands^ + 1;

      dump_request_status^.buffers_in_use := 0;

    /queue_buffers/
      FOR  buff_index := 1  TO  dump_request_status^.number_of_buffers  DO

        {  To prevent NAD I/O errors, the PP cannot attempt a read beyond the NAD memory.
        {  Therefore each read operation should stop at a NAD memory boundary.

        IF dump_request_status^.buffer_list^[buff_index].length > rfc$max_load_dump_buffer_size THEN
          buffer_size := (rfc$max_load_dump_buffer_size DIV 6) * 6;
        ELSE
          buffer_size := (dump_request_status^.buffer_list^[buff_index].length DIV 6) * 6;
        IFEND;

        dump_request_status^.buffer_list^[buff_index].length := buffer_size;

        reset_to_multiple_of_three := FALSE;
        memory_remaining_in_bank := nad_memory_bank_size -
          (dump_request_status^.current_nad_address MOD nad_memory_bank_size);
        IF  (memory_remaining_in_bank * 2) < (buffer_size + 6)  THEN
          IF  memory_remaining_in_bank = ((memory_remaining_in_bank DIV 3) * 3)  THEN
            buffer_size := memory_remaining_in_bank * 2;
          ELSE
            buffer_size := ((memory_remaining_in_bank * 2) DIV 6) * 6;
            reset_to_multiple_of_three := TRUE;
          IFEND;
        IFEND;
        IF  (dump_request_status^.current_nad_address + (buffer_size DIV 2)) > rfc$max_nad_memory_size  THEN
          dump_request_status^.state := rfc$ds_end_of_dump;
        IFEND;
        add_nad_transfer_piece(rfc$io_input, buffer_size,
          dump_request_status^.buffer_list^[buff_index].buffer, dump_request_status^.current_nad_address,
          request_info, number_of_commands, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        dump_request_status^.buffer_list^[buff_index].byte_count := buffer_size;
        dump_request_status^.buffer_list^[buff_index].current_offset := 0;
        dump_request_status^.buffers_in_use := dump_request_status^.buffers_in_use + 1;
        IF  dump_request_status^.state = rfc$ds_end_of_dump  THEN
          EXIT /queue_buffers/;
        IFEND;
        IF  reset_to_multiple_of_three  THEN
          memory_words_to_reset := ((3 - (memory_remaining_in_bank MOD 3)) MOD 3);
          dump_request_status^.current_nad_address := dump_request_status^.current_nad_address -
            memory_words_to_reset;
          dump_request_status^.buffer_list^[buff_index].byte_count :=
            dump_request_status^.buffer_list^[buff_index].byte_count - (memory_words_to_reset*2);
        IFEND;
      FOREND /queue_buffers/;

    ELSE
      {  dump is complete, return normal status.
    CASEND;

  PROCEND rfp$build_dump_request;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '    TERMINATION_PHASE' ??
?? EJECT ??
  PROCEDURE termination_phase;

{    The purpose of this routine is to perform the various clean up
{    activities to allow the access method to gracefully go away.
{    This routine should only be called once the user has validated that
{    this is the system routine and subsequently plugged the corresponding
{    global system task id in the rfv$system_task_id variable.


    VAR
        request_active: BOOLEAN,
        client_entry: ^rft$rhfam_client_table_entry,
        server_entry: ^rft$rhfam_server_table_entry,
        connection_descriptor: rft$connection_descriptor,
        nad_index: rft$local_nads;

    {  The system task status must be set to down prior to removing the tables.

    rfv$status_table.system_task_is_up := FALSE;
    #SPOIL(rfv$status_table.system_task_is_up);

    {  Clean up all local NAD connections and corresponding data.

    IF   rfv$status_table.location <> NIL  THEN
      IF  rfv$status_table.local_nads <> NIL  THEN
        FOR  nad_index := 1 TO UPPERBOUND(rfv$status_table.local_nads^)  DO
          IF  rfv$status_table.local_nads^[nad_index].pp[1].pp_state = rfc$pps_normal  THEN
            rfp$unconditionally_status(rfv$status_table.local_nads^[nad_index].logical_unit_number);
            clear_incoming_connects(nad_index);
            clear_connection_entries(nad_index, '       ', rfc$system_task_shutdown);
            release_all_control_messages(nad_index);
            IF  rfv$status_table.local_nads^[nad_index].current_status.device_status = rfc$es_on  THEN
              connection_descriptor.nad_index := nad_index;
              connection_descriptor.network_path := 0; {  purge all paths  }
              purge_path(connection_descriptor);
            IFEND;
          IFEND;
        FOREND;

        {  Make sure all requests have completed.

        REPEAT
          request_active := FALSE;
          syp$cycle;
          rfp$process_pp_response_flag(rfc$pp_response_available);
          FOR  nad_index := 1 TO UPPERBOUND(rfv$status_table.local_nads^)  DO
            IF  rfv$status_table.local_nads^[nad_index].requests_posted <> 0  THEN
              request_active := TRUE;
            IFEND;
          FOREND;
        UNTIL  NOT request_active;

        rfp$check_event_list(0, TRUE);

        idle_the_pps;
        release_elements;
        rfp$release_request_buffers;
      IFEND;

      rfp$lock_table(rfv$rhfam_client_table.lock);
      client_entry := rfv$rhfam_client_table.first_entry;
      WHILE  client_entry <> NIL  DO
        client_entry^.abort_connections := FALSE;
        client_entry := client_entry^.next_entry;
      WHILEND;
      rfp$unlock_table(rfv$rhfam_client_table.lock);

      rfp$lock_table(rfv$rhfam_server_table.lock);
      server_entry := rfv$rhfam_server_table.first_entry;
      WHILE  server_entry <> NIL  DO
        server_entry^.abort_connections := FALSE;
        server_entry := server_entry^.next_entry;
      WHILEND;
      rfp$unlock_table(rfv$rhfam_server_table.lock);

      WHILE  rfv$status_table.display_active <> tmv$null_global_task_id  DO
        syp$cycle;
      WHILEND;

      IF  rfv$status_table.local_nads <> NIL  THEN
        FOR  nad_index := 1 TO UPPERBOUND(rfv$status_table.local_nads^)  DO
          IF  rfv$status_table.local_nads^[nad_index].connection_table <> NIL  THEN
            FREE rfv$status_table.local_nads^[nad_index].connection_table IN nav$network_paged_heap^;
          IFEND;
        FOREND;
        rfv$status_table.local_nads := NIL;
      IFEND;

      FREE rfv$status_table.location IN nav$network_paged_heap^;
    IFEND;

    rfp$set_system_task_id(FALSE);     {  This clears the system task id  }

  PROCEND termination_phase;
?? NEWTITLE := '      CLEAR_INCOMING_CONNECTS' ??
?? EJECT ??
  PROCEDURE clear_incoming_connects(nad_index: rft$local_nads);

{    The purpose of this routine is clear out all incoming connects that have
{    not been assigned to a connection file.
{
{    nad_index: (input) This parameter specifies the local nad, through which the corresponding
{      connections have been received.

    VAR
        current_server_entry: ^rft$rhfam_server_table_entry,
        job_index: INTEGER,
        previous_connect,
        current_connect,
        connect_to_purge: ^rft$incoming_connect;

    rfp$lock_table(rfv$rhfam_server_table.lock);
    current_server_entry := rfv$rhfam_server_table.first_entry;
    WHILE  current_server_entry <> NIL  DO
      current_connect := current_server_entry^.incoming_connect;
      previous_connect := NIL;
      WHILE  current_connect <> NIL  DO
        IF  (current_connect^.connection_descriptor.nad_index = nad_index)  THEN
          connect_to_purge := current_connect;
          current_connect := current_connect^.next_entry;
          FREE connect_to_purge IN nav$network_paged_heap^;
          current_server_entry^.current_connections := current_server_entry^.current_connections - 1;
          IF  previous_connect = NIL  THEN
            current_server_entry^.incoming_connect := current_connect;
          ELSE
            previous_connect^.next_entry := current_connect;
          IFEND;
        ELSE
          previous_connect := current_connect;
          current_connect := current_connect^.next_entry;
        IFEND;
      WHILEND;
      current_server_entry := current_server_entry^.next_entry;
    WHILEND;
    rfp$unlock_table(rfv$rhfam_server_table.lock);

  PROCEND clear_incoming_connects;
?? TITLE := '      CLEAR_CONNECTION_ENTRIES' ??
?? EJECT ??
  PROCEDURE clear_connection_entries(nad_index: rft$local_nads;
                                     application_name: rft$application_name;
                                     reason_code: rft$connection_states);

{    The purpose of this routine is to set the state of all connection entries, currently
{    active in the specified NAD, to a non-viable state.  This should prevent further
{    network access by the corresponding connection.
{
{    nad_index: (input) This parameter specifies the corresponding nad.
{
{    applicaition_name: (input) This parameter specifies the name of the
{      application that must be matched if the reason code is rfc$terminated.
{
{    reason_code: (input) This parameter specifies the reason for the removal of the
{      connection entry.  The reason code is essentially the new state of the connection.

    TYPE
        terminated_appl_connects = RECORD
          next_entry: ^terminated_appl_connects,
          appl_kind: rft$application_kinds,
          appl_name: rft$application_name,
        RECEND;

    VAR
        local_nad: ^rft$local_nad_entry,
        connection_entry: ^rft$connection_entry,
        appl_connect_terminated,
        appl_term_list: ^terminated_appl_connects,
        client_entry: ^rft$rhfam_client_table_entry,
        server_entry: ^rft$rhfam_server_table_entry,
        entry_cleared: BOOLEAN,
        connect_count,
        con_index: rft$concurrent_connections;

    connect_count := 0;
    appl_term_list := NIL;
    local_nad := ^rfv$status_table.local_nads^[nad_index];
    rfp$lock_table(local_nad^.connection_table_lock);
    FOR  con_index := 1  TO  UPPERBOUND(local_nad^.connection_table^)  DO
      connection_entry := local_nad^.connection_table^[con_index].connection_table_entry;
      IF  connection_entry <> NIL  THEN
        rfp$lock_table(connection_entry^.lock);
        IF  reason_code = rfc$terminated  THEN
          IF  connection_entry^.application_entry_p^.application_name = application_name  THEN
            connection_entry^.connection_attributes.connection_status.connection_state := reason_code;
            connection_entry^.connection_attributes.connection_status.reason_for_termination :=
              rfc$local_termination;
          IFEND;
        ELSE
          connection_entry^.connection_attributes.connection_status.connection_state := reason_code;
          connection_entry^.connection_descriptor.nad_index := 0;
          connection_entry^.connection_descriptor.logical_unit := 0;
          connection_entry^.connection_descriptor.network_path := 0;
          connect_count := connect_count + 1;
          PUSH  appl_connect_terminated;
          appl_connect_terminated^.appl_name := connection_entry^.application_entry_p^.application_name;
          appl_connect_terminated^.appl_kind := connection_entry^.application_entry_p^.application_kind;
          appl_connect_terminated^.next_entry := appl_term_list;
          appl_term_list := appl_connect_terminated;
        IFEND;
        rfp$unlock_table(connection_entry^.lock);
      IFEND;
      IF  reason_code <> rfc$terminated  THEN
        local_nad^.connection_table^[con_index].connection_table_entry := NIL;
        local_nad^.connection_table^[con_index].connection_state := rfc$ps_unused;
        local_nad^.connection_table^[con_index].connection_clarifier := rfc$pcu_empty;
        local_nad^.connection_table^[con_index].processing_incoming_connect := FALSE;
      IFEND;
    FOREND;
    rfp$unlock_table(local_nad^.connection_table_lock);
    rfp$lock_table(rfv$status_table.lock);
    local_nad^.connections_established := local_nad^.connections_established - connect_count;
    rfp$unlock_table(rfv$status_table.lock);

    WHILE  appl_term_list <> NIL  DO
      entry_cleared := FALSE;
      rfp$lock_table(rfv$rhfam_server_table.lock);
      server_entry := rfv$rhfam_server_table.first_entry;
    /find_matching_server/
      WHILE  server_entry <> NIL  DO
        IF  server_entry^.server_name = appl_term_list^.appl_name  THEN
          server_entry^.current_connections := server_entry^.current_connections - 1;
          IF  appl_term_list^.appl_kind = rfc$partner  THEN
            server_entry^.partner_job_connections := server_entry^.partner_job_connections - 1;
            entry_cleared := TRUE;
            EXIT /find_matching_server/;
          IFEND;
        IFEND;
        server_entry := server_entry^.next_entry;
      WHILEND /find_matching_server/;
      rfp$unlock_table(rfv$rhfam_server_table.lock);

      IF  NOT entry_cleared  THEN
        rfp$lock_table(rfv$rhfam_client_table.lock);
        client_entry := rfv$rhfam_client_table.first_entry;
      /find_matching_client/
        WHILE  client_entry <> NIL  DO
          IF  client_entry^.client_name = appl_term_list^.appl_name  THEN
            client_entry^.current_connections := client_entry^.current_connections - 1;
            EXIT /find_matching_client/;
          IFEND;
          client_entry := client_entry^.next_entry;
        WHILEND /find_matching_client/;
        rfp$unlock_table(rfv$rhfam_client_table.lock);
      IFEND;
      appl_term_list := appl_term_list^.next_entry;
    WHILEND;

  PROCEND clear_connection_entries;
?? TITLE := '      RELEASE_ALL_CONTROL_MESSAGES' ??
?? EJECT ??
  PROCEDURE  release_all_control_messages(nad_index: rft$local_nads);

{    The purpose of this routine is to release all control messages that have been queued to the
{    corresponding NAD.
{
{    nad_index: (input) This parameter specifies the local NAD, whose control messages should
{      be released.

    VAR
        local_nad: ^rft$local_nad_entry,
        previous_entry,
        current_entry: ^rft$outgoing_control_message;

    local_nad := ^rfv$status_table.local_nads^[nad_index];

    rfp$lock_table(local_nad^.outgoing_cm_queue.lock);

    current_entry := local_nad^.outgoing_cm_queue.first_entry;
    local_nad^.outgoing_cm_queue.first_entry := NIL;
    WHILE  current_entry <> NIL  DO
      previous_entry := current_entry;
      current_entry := current_entry^.next_entry;
      FREE previous_entry IN nav$network_paged_heap^;
    WHILEND;
    rfp$unlock_table(local_nad^.outgoing_cm_queue.lock);

  PROCEND release_all_control_messages;
?? TITLE := '      IDLE_THE_PPS' ??
?? EJECT ??
  PROCEDURE  idle_the_pps;

{    The purpose of this routine is to issue a idle pp request to each
{    of the PP drivers.

    VAR
        local_status: ost$status,
        command_identifier: ^rft$pp_commands,
        request_buf: ^SEQ(*),
        nad_index: rft$local_nads,
        pp_index: 1..2;

    PUSH  request_buf : [[rft$pp_commands]];
    IF  request_buf = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the local stack overflowed',
        local_status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'IDLE_THE_PPS', local_status);
      RETURN;
    IFEND;
    RESET request_buf;
    NEXT  command_identifier  IN  request_buf;
    IF  command_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'command id is too big',
        local_status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'IDLE_THE_PPS', local_status);
      RETURN;
    IFEND;
    command_identifier^ := rfc$pp_idle;

  /idle_pp_loop/
    FOR  nad_index := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      FOR  pp_index := 1  TO  rfv$status_table.local_nads^[nad_index].pp_drivers  DO
        IF  rfv$status_table.local_nads^[nad_index].pp[pp_index].pp_state = rfc$pps_normal  THEN
          rfp$queue_request(nad_index, pp_index, rfc$pp_request, rfc$rk_idle_pp, NIL, request_buf,
            local_status);
          IF  NOT  local_status.normal  THEN
            rfp$log_the_status(local_status);
          IFEND;
        IFEND;
      FOREND;
    FOREND /idle_pp_loop/;

{   wait for all of the PP's to idle.

    WHILE  (rfv$outstanding_requests <> NIL)  DO
      syp$cycle;
      rfp$process_pp_response_flag(rfc$pp_response_available);
    WHILEND;

  PROCEND idle_the_pps;
?? TITLE := '      RELEASE_ELEMENTS' ??
?? EJECT ??
  PROCEDURE  release_elements;

{    The purpose of this procedure is to release the channel and peripheral processor
{    elements.

    VAR
        status: ost$status,
        elements: ^ARRAY [*] OF cmt$element_reservation,
        element_count,
        current_element: INTEGER,
        channel: cmt$channel_ordinal,
        channel_name: cmt$element_name,
        channel_iou: cmt$element_name,
        pp_number: cmt$pp_ordinal,
        nad_descriptor: cmt$element_descriptor,
        nad_definition: cmt$element_definition,
        nad_entry: rft$local_nads,
        pp_entry: 1..2;

    element_count := 0;
    FOR  nad_entry := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
      IF  rfv$status_table.local_nads^[nad_entry].pp[1].pp_state >= rfc$pps_reserved  THEN
        element_count := element_count + 2 + rfv$status_table.local_nads^[nad_entry].pp_drivers;
      IFEND;
    FOREND;

    IF element_count > 0 THEN
      PUSH  elements : [1..element_count];
      current_element := 1;
      FOR  nad_entry := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
        IF  rfv$status_table.local_nads^[nad_entry].pp[1].pp_state >= rfc$pps_reserved  THEN
          channel := rfv$status_table.local_nads^[nad_entry].channel_ordinal;
          channel_iou := rfv$status_table.local_nads^[nad_entry].pp[1].pp_id.iou;
          nad_descriptor.element_type := cmc$communications_element;
          nad_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
          nad_descriptor.peripheral_descriptor.element_name :=
                rfv$status_table.local_nads^[nad_entry].name;
          cmp$get_element_definition(nad_descriptor, nad_definition, status);
          IF  NOT status.normal  THEN
            RETURN;
          IFEND;
          channel_name := nad_definition.communications_element.connection.
                port [0].element_name;
          elements^[current_element].element_type := cmc$data_channel_element;
          elements^[current_element].channel_descriptor.use_logical_identification := TRUE;
          elements^[current_element].channel_descriptor.name := channel_name;
          elements^[current_element].channel_descriptor.iou := channel_iou;
          current_element := current_element + 1;
          elements^[current_element].element_type := cmc$communications_element;
          elements^[current_element].peripheral_descriptor.use_logical_identification := TRUE;
          elements^[current_element].peripheral_descriptor.element_name :=
            rfv$status_table.local_nads^[nad_entry].name;
          current_element := current_element + 1;
          FOR  pp_entry := 1  TO  rfv$status_table.local_nads^[nad_entry].pp_drivers  DO
            elements^[current_element].element_type := cmc$pp_element;
            elements^[current_element].pp_reservation.selector := cmc$choose_pp_by_channel;
            elements^[current_element].pp_reservation.channel.iou := channel_iou;
            elements^[current_element].pp_reservation.channel.ordinal := channel;
            elements^[current_element].pp_reservation.acquired_pp_identification :=
              rfv$status_table.local_nads^[nad_entry].pp[pp_entry].pp_id;
            current_element := current_element + 1;
          FOREND;
        IFEND;
      FOREND;

      cmp$release_element(elements^, status);
      IF  NOT status.normal  THEN
        rfp$log_the_status(status);
      IFEND;

      FOR  nad_entry := 1  TO  UPPERBOUND(rfv$status_table.local_nads^)  DO
        rfv$status_table.local_nads^[nad_entry].pp[1].pp_state := rfc$pps_released;
      FOREND;
    IFEND;

  PROCEND release_elements;
?? OLDTITLE ??
?? OLDTITLE ??
MODEND rfm$system_task;
