*copyc osd$default_pragmats
?? TITLE := 'RHFAM/VE : Configuration Verification and Installation : R2DD' ??
?? NEWTITLE := '  Common Decks' ??
MODULE rfm$configuration_utility;
*copyc rfh$configuration_utility
?? EJECT ??
*copyc rfh$description_of_directives
?? EJECT ??
*copyc rft$config_utl_pointers
?? EJECT ??
*copyc rfe$condition_codes
?? EJECT ??
*copyc amp$get_next
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc clp$create_file_connection
*copyc clp$delete_file_connection
*copyc clp$end_scan_command_file
*copyc clp$get_data_line
*copyc clp$get_parameter_list_text
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc fsp$close_file
*copyc fsp$copy_file
*copyc fsp$open_file
*copyc jmp$system_job
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$format_message
*copyc osv$lower_to_upper
*copyc osp$set_status_abnormal
*copyc pfp$attach
*copyc pfp$define
*copyc pfp$define_catalog
*copyc pfp$purge
*copyc pmp$continue_to_cause
*copyc pmp$establish_condition_handler
*copyc pmp$generate_unique_name
*copyc pmp$zero_out_table
*copyc rfp$initialize_config_pointers
*copyc rfp$preserve_config_pointers
*copyc rfp$release_config_pointers
*copyc rfp$retrieve_config_pointers
?? TITLE := '  Global Variables' ??
?? EJECT ??
  TYPE
      configuration_search_modes = (csm_local, csm_remote, csm_both);

  VAR
      keyword_all: [READ] ost$name := 'ALL',
      rfv$config_utility: [READ] ost$name := 'rhfam_configuration_utility',
      rfv$verify_command: [READ] ost$name := 'verify_rhfam_configuration',
      rfv$install_command: [READ] ost$name := 'install_rhfam_configuration',
      rfv$install_config_bin: [READ] ost$name := 'install_rhfam_config_bin',
      echo_file: [READ] amt$local_file_name := '$echo';
?? TITLE := '  RFP$VERIFY_RHFAM_CONFIGURATION' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$verify_rhfam_configuration (parameter_list : clt$parameter_list;
                                               VAR status : ost$status);

*copyc rfh$verify_rhfam_configuration


*copyc rfd$pdt_verify_rhfam_config

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

{    The purpose of this procedure is clean up the environment upon termination of the
{    VERIFY_RHFAM_CONFIGURATION sub-utility.  The condition handler attempts to release all files,
{    file connections and scratch areas that were in use at the time the main procedure is exited
{    (either normally or abnormally).
{
{    condition: (input) This parameter specifies the condition that caused the abnormal block exit.
{      (not used by this routine).
{
{    condition_descriptor: (input) This parameter specifies the user defined condition. (not used by
{      this routine).
{
{    save_area: (input) This parameter points to the stack frame save area of the offending routine.
{      (not used by this routine).
{
{    status: (output) This parameter specifies the status at the time of the block exit.  This is passed
{      on, unaltered, to the next condition handler.

      VAR
          ignore_status : ost$status;

      IF  (current_state > open_command_file)  OR
          ((current_state = open_command_file)  AND
           (open_command_file_status.normal))  THEN
        fsp$close_file(save_info.temporary_command_file_fid, ignore_status);
        amp$return(temporary_command_file, ignore_status);
      IFEND;
      IF  (current_state > open_scratch_seg)  OR
          ((current_state = open_scratch_seg)  AND
           (open_scratch_seg_status.normal))  THEN
        fsp$close_file(save_info.temporary_fid, ignore_status);
        amp$return(temporary_file_lfn, ignore_status);
      IFEND;
      IF  (current_state > open_output_file) OR
          ((current_state = open_output_file)  AND
           (open_output_file_status.normal))  THEN
        fsp$close_file(save_info.output_fid, ignore_status);
      IFEND;
      IF  (current_state > init_global_vars)  OR
          ((current_state = init_global_vars)  AND
           (init_global_vars_status.normal))  THEN
        rfp$release_config_pointers;
      IFEND;
      IF  (current_state > push_utility)  OR
          ((current_state = push_utility)  AND
            (push_utility_status.normal))  THEN
        clp$pop_utility(ignore_status);
      IFEND;
      IF  (current_state > connect_echo_file)  OR
          ((current_state = connect_echo_file)  AND
           (connect_echo_file_status.normal))  THEN
        clp$delete_file_connection(echo_file, output_file.file.local_file_name, ignore_status);
      IFEND;
      pmp$continue_to_cause(pmc$execute_standard_procedure, status);
    PROCEND  clean_up_on_exit;
?? EJECT ??
    TYPE
        verify_states = (initial, connect_echo_file, push_utility, init_global_vars, open_output_file,
                         open_command_file, open_scratch_seg, ready_to_scan);

    VAR
        block_exit : [STATIC,READ] pmt$condition :=
                   [pmc$condition_combination,$pmt$condition_combination[pmc$block_exit_processing]],
        temporary_command_file: amt$local_file_name,
        temporary_file_lfn: amt$local_file_name,
        unique_name: ost$unique_name,
        exit_descriptor : pmt$established_handler,
        current_state: verify_states,
        input_file : clt$value,
        output_file : clt$value,
        save_info: rft$config_utl_pointers,
        segment_ptr: amt$segment_pointer,
        attachment_options: ^fst$attachment_options,
        connect_echo_file_status,
        push_utility_status,
        init_global_vars_status,
        open_output_file_status,
        open_scratch_seg_status,
        open_command_file_status,
        ignore_status: ost$status;

    status.normal := TRUE;
    current_state := initial;

  /main_section/
    BEGIN

      clp$scan_parameter_list(parameter_list, verify_configuration, status);
      IF  NOT status.normal  THEN
         RETURN;
      IFEND;
      pmp$generate_unique_name(unique_name, ignore_status);
      temporary_file_lfn := unique_name.value;
      pmp$generate_unique_name(unique_name, ignore_status);
      temporary_command_file := unique_name.value;
      clp$get_value('input', 1, 1, clc$low, input_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$get_value('output', 1, 1, clc$low, output_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      pmp$establish_condition_handler(block_exit, ^clean_up_on_exit, ^exit_descriptor, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      connect_echo_file_status.normal := FALSE;
      #SPOIL(connect_echo_file_status,current_state);
      current_state := connect_echo_file;
      clp$create_file_connection(echo_file, output_file.file.local_file_name, connect_echo_file_status);
      IF  NOT connect_echo_file_status.normal  THEN
        status := connect_echo_file_status;
        RETURN;
      IFEND;
      push_utility_status.normal := FALSE;
      #SPOIL(push_utility_status,current_state);
      current_state := push_utility;
      clp$push_utility(rfv$verify_command, clc$global_command_search, rfv$verify_directives, NIL,
                       push_utility_status);
      IF  NOT push_utility_status.normal  THEN
        status := push_utility_status;
        RETURN;
      IFEND;
      init_global_vars_status.normal := FALSE;
      #SPOIL(init_global_vars_status,current_state);
      current_state := init_global_vars;
      rfp$initialize_config_pointers(FALSE, save_info, init_global_vars_status);
      IF  NOT init_global_vars_status.normal  THEN
        status := init_global_vars_status;
        RETURN;
      IFEND;
      PUSH  attachment_options : [1..1];
      attachment_options^[1].selector := fsc$access_and_share_modes;
      attachment_options^[1].access_modes.selector := fsc$specific_access_modes;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$append];
      attachment_options^[1].share_modes.selector := fsc$determine_from_access_modes;
      open_output_file_status.normal := FALSE;
      #SPOIL(open_output_file_status,current_state);
      current_state := open_output_file;
      fsp$open_file(output_file.file.local_file_name, amc$record, attachment_options, NIL, NIL,
        NIL, NIL, save_info.output_fid, open_output_file_status);
      IF NOT open_output_file_status.normal THEN
        status := open_output_file_status;
        RETURN;
      IFEND;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$read, fsc$append, fsc$shorten];
      open_command_file_status.normal := FALSE;
      #SPOIL(open_command_file_status,current_state);
      current_state := open_command_file;
      fsp$open_file(temporary_command_file, amc$record, attachment_options, NIL, NIL,
        NIL, NIL, save_info.temporary_command_file_fid, open_command_file_status);
      IF NOT open_command_file_status.normal THEN
        status := open_command_file_status;
        RETURN;
      IFEND;
      open_scratch_seg_status.normal := FALSE;
      #SPOIL(open_scratch_seg_status,current_state);
      current_state := open_scratch_seg;
      fsp$open_file(temporary_file_lfn, amc$segment, attachment_options, NIL, NIL,
        NIL, NIL, save_info.temporary_fid, open_scratch_seg_status);
      IF NOT open_scratch_seg_status.normal THEN
        status := open_scratch_seg_status;
        RETURN;
      IFEND;
      current_state := ready_to_scan;
      amp$get_segment_pointer(save_info.temporary_fid, amc$sequence_pointer, segment_ptr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      save_info.temporary_seq := segment_ptr.sequence_pointer;
      RESET save_info.temporary_seq;
      rfp$preserve_config_pointers(save_info);
      clp$scan_command_file(input_file.file.local_file_name, rfv$verify_command, 'VRC', status);
    END  /main_section/;

    rfp$retrieve_config_pointers(save_info);

    IF status.normal THEN
      IF  NOT save_info.local_host_defined  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local host', status);
        rfp$output_status_message(save_info.output_fid, status);
        save_info.error_encountered := TRUE;
      IFEND;

      IF  save_info.local_nad_count = 0  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local NAD', status);
        rfp$output_status_message(save_info.output_fid, status);
        save_info.error_encountered := TRUE;
      IFEND;
    IFEND;

    IF save_info.error_encountered THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_file_error, input_file.file.local_file_name,
                              status);
      osp$append_status_parameter(osc$status_parameter_delimiter, output_file.file.local_file_name,
                                  status);
    IFEND;

  PROCEND rfp$verify_rhfam_configuration;
?? NEWTITLE := '    RFP$VERIFY_RHFAM_CONFIGURATION DIRECTIVES'??
?? EJECT ??
*copyc rfd$cdt_verify_directives
?? TITLE := '    RFP$VRC_QUIT' ??
?? EJECT ??
  PROCEDURE rfp$vrc_quit (parameter_list : clt$parameter_list;
                      VAR status : ost$status);
{
{    This procedure ends the verify configuration utility environment.
{

{ pdt quit

?? PUSH (LISTEXT := ON) ??

  VAR
    quit: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

    clp$scan_parameter_list(parameter_list, quit, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    clp$end_scan_command_file(rfv$verify_command, status);
  PROCEND rfp$vrc_quit;
?? OLDTITLE ??
?? TITLE := '  RFP$INSTALL_RHFAM_CONFIGURATION' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$install_rhfam_configuration (parameter_list : clt$parameter_list;
                                                VAR status : ost$status);

*copyc rfh$install_rhfam_configuration


*copyc rfd$pdt_install_rhfam_config
?? EJECT ??
    PROCEDURE  clean_up_on_exit(condition: pmt$condition;
                                condition_descriptor: ^pmt$condition_information;
                                save_area: ^ost$stack_frame_save_area;
                            VAR status: ost$status);

{    The purpose of this procedure is clean up the environment upon termination of the
{    INSTALL_RHFAM_CONFIGURATION sub-utility.  The condition handler attempts to release all files,
{    file connections and scratch areas that were in use at the time the main procedure is exited
{    (either normally or abnormally).
{
{    condition: (input) This parameter specifies the condition that caused the abnormal block exit.
{      (not used by this routine).
{
{    condition_descriptor: (input) This parameter specifies the user defined condition. (not used by
{      this routine).
{
{    save_area: (input) This parameter points to the stack frame save area of the offending routine.
{      (not used by this routine).
{
{    status: (output) This parameter specifies the status at the time of the block exit.  This is passed
{      on, unaltered, to the next condition handler.

      VAR
          ignore_status : ost$status;

      IF  ((current_state > open_command_file)  AND
           (current_state < close_command_file)) OR
          ((current_state = open_command_file)  AND
           (open_command_file_status.normal))    OR
          ((current_state = close_command_file)  AND
           (NOT open_command_file_status.normal))  THEN
        fsp$close_file(save_info.temporary_command_file_fid, ignore_status);
      IFEND;
      IF   (current_state > open_command_file)   OR
          ((current_state = open_command_file)  AND
           (open_command_file_status.normal))   THEN
        amp$return(temporary_command_file, ignore_status);
      IFEND;
      IF  ((current_state = copy_config_file)  AND
           (config_file_created_status.normal))  THEN
        delete_configuration_file(rfc$configuration_cmd_file, pfc$highest_cycle, ignore_status);
      IFEND;
      IF  (current_state > open_scratch_seg)  OR
          ((current_state = open_scratch_seg)  AND
           (open_scratch_seg_status.normal))  THEN
        fsp$close_file(save_info.temporary_fid, ignore_status);
        amp$return(temporary_file_lfn, ignore_status);
      IFEND;
      IF  (current_state > open_output_file)  OR
          ((current_state = open_output_file)  AND
           (open_output_file_status.normal))  THEN
        fsp$close_file(save_info.output_fid, ignore_status);
      IFEND;
      IF  (current_state > init_global_vars)  OR
          ((current_state = init_global_vars)  AND
           (init_global_vars_status.normal))  THEN
        rfp$release_config_pointers;
      IFEND;
      IF  (current_state > push_utility)  OR
          ((current_state = push_utility)  AND
           (push_utility_status.normal))  THEN
        clp$pop_utility(ignore_status);
      IFEND;
      pmp$continue_to_cause(pmc$execute_standard_procedure, status);
    PROCEND  clean_up_on_exit;
?? EJECT ??
    TYPE
        install_states = (initial, push_utility, init_global_vars, open_output_file, open_command_file,
                          open_scratch_seg, ready_to_scan, close_command_file, copy_config_file,
                          config_file_copied);

    VAR
        block_exit: [STATIC,READ] pmt$condition :=
                   [pmc$condition_combination,$pmt$condition_combination[pmc$block_exit_processing]],
        exit_descriptor: pmt$established_handler,
        temporary_command_file: amt$local_file_name,
        temporary_file_lfn: amt$local_file_name,
        unique_name: ost$unique_name,
        input_file: clt$value,
        output_file: clt$value,
        attachment_options: ^fst$attachment_options,
        configuration_fid: amt$file_identifier,
        save_info: rft$config_utl_pointers,
        segment_ptr: amt$segment_pointer,
        current_state: install_states,
        push_utility_status,
        init_global_vars_status,
        open_output_file_status,
        open_scratch_seg_status,
        open_command_file_status,
        config_file_created_status,
        ignore_status: ost$status;

    status.normal := TRUE;
    current_state := initial;

  /main_section/
    BEGIN

      clp$scan_parameter_list(parameter_list, install_configuration, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      pmp$generate_unique_name(unique_name, ignore_status);
      temporary_command_file := unique_name.value;
      pmp$generate_unique_name(unique_name, ignore_status);
      temporary_file_lfn := unique_name.value;
      clp$get_value('input', 1, 1, clc$low, input_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$get_value('error', 1, 1, clc$low, output_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      pmp$establish_condition_handler(block_exit, ^clean_up_on_exit, ^exit_descriptor, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      push_utility_status.normal := FALSE;
      #SPOIL(push_utility_status,current_state);
      current_state := push_utility;
      clp$push_utility(rfv$install_command, clc$global_command_search, rfv$install_directives, nil,
                       push_utility_status);
      IF NOT push_utility_status.normal THEN
        status := push_utility_status;
        RETURN;
      IFEND;
      init_global_vars_status.normal := FALSE;
      #SPOIL(init_global_vars_status,current_state);
      current_state := init_global_vars;
      rfp$initialize_config_pointers(TRUE, save_info, init_global_vars_status);
      IF NOT init_global_vars_status.normal THEN
        status := init_global_vars_status;
        RETURN;
      IFEND;
      PUSH  attachment_options : [1..1];
      attachment_options^[1].selector := fsc$access_and_share_modes;
      attachment_options^[1].access_modes.selector := fsc$specific_access_modes;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$append];
      attachment_options^[1].share_modes.selector := fsc$determine_from_access_modes;
      open_output_file_status.normal := FALSE;
      #SPOIL(open_output_file_status,current_state);
      current_state := open_output_file;
      fsp$open_file(output_file.file.local_file_name, amc$record, attachment_options, NIL, NIL,
        NIL, NIL, save_info.output_fid, open_output_file_status);
      IF NOT open_output_file_status.normal THEN
        status := open_output_file_status;
        RETURN;
      IFEND;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$read, fsc$append, fsc$shorten];
      open_command_file_status.normal := FALSE;
      #SPOIL(open_command_file_status,current_state);
      current_state := open_command_file;
      fsp$open_file(temporary_command_file, amc$record, attachment_options, NIL, NIL,
         NIL, NIL, save_info.temporary_command_file_fid, open_command_file_status);
      IF NOT open_command_file_status.normal THEN
        status := open_command_file_status;
        RETURN;
      IFEND;
      open_scratch_seg_status.normal := FALSE;
      #SPOIL(open_scratch_seg_status,current_state);
      current_state := open_scratch_seg;
      fsp$open_file(temporary_file_lfn, amc$segment, attachment_options, NIL, NIL,
        NIL, NIL, save_info.temporary_fid, open_scratch_seg_status);
      IF NOT open_scratch_seg_status.normal THEN
        status := open_scratch_seg_status;
        RETURN;
      IFEND;
      current_state := ready_to_scan;
      amp$get_segment_pointer(save_info.temporary_fid, amc$sequence_pointer, segment_ptr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      save_info.temporary_seq := segment_ptr.sequence_pointer;
      RESET save_info.temporary_seq;
      rfp$preserve_config_pointers(save_info);
      clp$scan_command_file(input_file.file.local_file_name, rfv$install_command, 'IRC', status);
      rfp$retrieve_config_pointers(save_info);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      IF save_info.error_encountered THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_file_error, input_file.file.local_file_name,
                                status);
        osp$append_status_parameter(osc$status_parameter_delimiter, output_file.file.local_file_name,
                                    status);
        RETURN;
      IFEND;
      open_command_file_status.normal := FALSE;
      #SPOIL(open_command_file_status,current_state);
      current_state := close_command_file;
      fsp$close_file(save_info.temporary_command_file_fid, open_command_file_status);
      IF NOT open_command_file_status.normal THEN
        status := open_command_file_status;
        RETURN;
      IFEND;
      config_file_created_status.normal := FALSE;
      #SPOIL(config_file_created_status,current_state);
      current_state := copy_config_file;
      copy_configuration_file(temporary_command_file, config_file_created_status, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      current_state := config_file_copied;
    END /main_section/;

  PROCEND rfp$install_rhfam_configuration;
?? NEWTITLE := '    RFP$INSTALL_RHFAM_CONFIGURATION DIRECTIVES' ??
?? EJECT ??
*copyc rfd$cdt_install_directives
?? TITLE := '    RFP$IRC_QUIT'??
?? EJECT ??
  PROCEDURE rfp$irc_quit (parameter_list : clt$parameter_list;
                      VAR status : ost$status);
{
{    This procedure ends the install configuration utility environment.
{

{ pdt quit

?? PUSH (LISTEXT := ON) ??

  VAR
    quit: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??
    VAR
      parameter_text: ^clt$parameter_list_text,
      save_info: rft$config_utl_pointers;

    status.normal :=  TRUE;
    rfp$retrieve_config_pointers(save_info);
    clp$get_parameter_list_text(^parameter_list, parameter_text, status);
    clp$scan_parameter_list(parameter_list, quit, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    write_cmd_line('quit', parameter_text^, save_info, status);
    clp$end_scan_command_file(rfv$install_command, status);
  PROCEND rfp$irc_quit;
?? OLDTITLE ??
?? TITLE := '  RFP$INSTALL_RHF_CONFIG_BIN' ??
?? EJECT ??
  PROCEDURE [XDCL] rfp$install_rhf_config_bin (parameter_list : clt$parameter_list;
                                                VAR status : ost$status);

*copyc rfh$install_rhf_config_bin


*copyc rfd$pdt_install_rhf_config_bin
?? EJECT ??
    PROCEDURE  clean_up_on_exit(condition: pmt$condition;
                                condition_descriptor: ^pmt$condition_information;
                                save_area: ^ost$stack_frame_save_area;
                            VAR status: ost$status);

{    The purpose of this procedure is clean up the environment upon termination of the
{    INSTALL_RHFAM_CONFIG_BIN sub-utility.  The condition handler attempts to release all files,
{    file connections and scratch areas that were in use at the time the main procedure is exited
{    (either normally or abnormally).
{
{    condition: (input) This parameter specifies the condition that caused the abnormal block exit.
{      (not used by this routine).
{
{    condition_descriptor: (input) This parameter specifies the user defined condition. (not used by
{      this routine).
{
{    save_area: (input) This parameter points to the stack frame save area of the offending routine.
{      (not used by this routine).
{
{    status: (output) This parameter specifies the status at the time of the block exit.  This is passed
{      on, unaltered, to the next condition handler.

      VAR
          ignore_status : ost$status;

      amp$return(input_file, ignore_status);
      IF  (current_state > open_command_file)  OR
          ((current_state = open_command_file)  AND
           (open_command_file_status.normal))  THEN
        fsp$close_file(save_info.temporary_command_file_fid, ignore_status);
        amp$return(temporary_command_file, ignore_status);
      IFEND;
      IF  ((current_state = build_config_file)  AND
           (config_file_created_status.normal))  THEN
        delete_configuration_file(rfc$configuration_file, pfc$highest_cycle, ignore_status);
      IFEND;
      IF  (current_state > open_scratch_seg)  OR
          ((current_state = open_scratch_seg)  AND
           (open_scratch_seg_status.normal))  THEN
        fsp$close_file(save_info.temporary_fid, ignore_status);
        amp$return(temporary_file_lfn, ignore_status);
      IFEND;
      IF  (current_state > open_output_file)  OR
          ((current_state = open_output_file)  AND
           (open_output_file_status.normal))  THEN
        fsp$close_file(save_info.output_fid, ignore_status);
      IFEND;
      IF  (current_state > init_global_vars)  OR
          ((current_state = init_global_vars)  AND
           (init_global_vars_status.normal))  THEN
        rfp$release_config_pointers;
      IFEND;
      IF  (current_state > push_utility)  OR
          ((current_state = push_utility)  AND
           (push_utility_status.normal))  THEN
        clp$pop_utility(ignore_status);
      IFEND;
      pmp$continue_to_cause(pmc$execute_standard_procedure, status);
    PROCEND  clean_up_on_exit;
?? EJECT ??
    TYPE
        install_states = (initial, push_utility, init_global_vars, open_output_file, open_command_file,
                          open_scratch_seg, ready_to_scan, build_config_file, config_file_built);

    VAR
        block_exit: [STATIC,READ] pmt$condition :=
                   [pmc$condition_combination,$pmt$condition_combination[pmc$block_exit_processing]],
        exit_descriptor: pmt$established_handler,
        temporary_command_file: amt$local_file_name,
        temporary_file_lfn: amt$local_file_name,
        unique_name: ost$unique_name,
        input_file: amt$local_file_name,
        output_file: clt$value,
        attachment_options: ^fst$attachment_options,
        configuration_fid: amt$file_identifier,
        save_info: rft$config_utl_pointers,
        segment_ptr: amt$segment_pointer,
        current_state: install_states,
        push_utility_status,
        init_global_vars_status,
        open_output_file_status,
        open_scratch_seg_status,
        open_command_file_status,
        config_file_created_status,
        ignore_status: ost$status;

    status.normal := TRUE;
    current_state := initial;

  /main_section/
    BEGIN

      clp$scan_parameter_list(parameter_list, install_config_bin, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF NOT jmp$system_job() THEN
        osp$set_status_abnormal(rfc$product_id, rfe$invalid_task_origin, '', status);
        RETURN;
      IFEND;
      pmp$generate_unique_name(unique_name, ignore_status);
      temporary_command_file := unique_name.value;
      pmp$generate_unique_name(unique_name, ignore_status);
      temporary_file_lfn := unique_name.value;
      clp$get_value('error', 1, 1, clc$low, output_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      pmp$establish_condition_handler(block_exit, ^clean_up_on_exit, ^exit_descriptor, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      pmp$generate_unique_name(unique_name, ignore_status);
      input_file := unique_name.value;
      attach_configuration_file(input_file, rfc$configuration_cmd_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      push_utility_status.normal := FALSE;
      #SPOIL(push_utility_status,current_state);
      current_state := push_utility;
      clp$push_utility(rfv$install_config_bin, clc$global_command_search, rfv$install_cmd_binary, nil,
                       push_utility_status);
      IF NOT push_utility_status.normal THEN
        status := push_utility_status;
        RETURN;
      IFEND;
      init_global_vars_status.normal := FALSE;
      #SPOIL(init_global_vars_status,current_state);
      current_state := init_global_vars;
      rfp$initialize_config_pointers(TRUE, save_info, init_global_vars_status);
      IF NOT init_global_vars_status.normal THEN
        status := init_global_vars_status;
        RETURN;
      IFEND;
      PUSH  attachment_options : [1..1];
      attachment_options^[1].selector := fsc$access_and_share_modes;
      attachment_options^[1].access_modes.selector := fsc$specific_access_modes;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$append];
      attachment_options^[1].share_modes.selector := fsc$determine_from_access_modes;
      open_output_file_status.normal := FALSE;
      #SPOIL(open_output_file_status,current_state);
      current_state := open_output_file;
      fsp$open_file(output_file.file.local_file_name, amc$record, attachment_options, NIL, NIL,
        NIL, NIL, save_info.output_fid, open_output_file_status);
      IF NOT open_output_file_status.normal THEN
        status := open_output_file_status;
        RETURN;
      IFEND;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$read, fsc$append, fsc$shorten];
      open_command_file_status.normal := FALSE;
      #SPOIL(open_command_file_status,current_state);
      current_state := open_command_file;
      fsp$open_file(temporary_command_file, amc$record, attachment_options, NIL, NIL,
         NIL, NIL, save_info.temporary_command_file_fid, open_command_file_status);
      IF NOT open_command_file_status.normal THEN
        status := open_command_file_status;
        RETURN;
      IFEND;
      open_scratch_seg_status.normal := FALSE;
      #SPOIL(open_scratch_seg_status,current_state);
      current_state := open_scratch_seg;
      fsp$open_file(temporary_file_lfn, amc$segment, attachment_options, NIL, NIL,
        NIL, NIL, save_info.temporary_fid, open_scratch_seg_status);
      IF NOT open_scratch_seg_status.normal THEN
        status := open_scratch_seg_status;
        RETURN;
      IFEND;
      current_state := ready_to_scan;
      amp$get_segment_pointer(save_info.temporary_fid, amc$sequence_pointer, segment_ptr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      save_info.temporary_seq := segment_ptr.sequence_pointer;
      RESET save_info.temporary_seq;
      rfp$preserve_config_pointers(save_info);
      clp$scan_command_file(input_file, rfv$install_config_bin, 'IRCB', status);
      rfp$retrieve_config_pointers(save_info);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      IF save_info.error_encountered THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_file_error, input_file,
                                status);
        osp$append_status_parameter(osc$status_parameter_delimiter, output_file.file.local_file_name,
                                    status);
        RETURN;
      IFEND;
      config_file_created_status.normal := FALSE;
      #SPOIL(config_file_created_status,current_state);
      current_state := build_config_file;
      create_the_status_table(save_info, config_file_created_status, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      current_state := config_file_built;
    END /main_section/;

  PROCEND rfp$install_rhf_config_bin;
?? NEWTITLE := '    RFP$INSTALL_RHF_CONFIG_BIN DIRECTIVES' ??
?? EJECT ??
*copyc rfd$cdt_install_bin_directives
?? TITLE := '    RFP$IRB_QUIT'??
?? EJECT ??
  PROCEDURE rfp$irb_quit (parameter_list : clt$parameter_list;
                      VAR status : ost$status);
{
{    This procedure ends the install configuration binary utility environment.
{

{ pdt quit

?? PUSH (LISTEXT := ON) ??

  VAR
    quit: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

    clp$scan_parameter_list(parameter_list, quit, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;

    clp$end_scan_command_file(rfv$install_config_bin, status);
  PROCEND rfp$irb_quit;
?? OLDTITLE ??
?? TITLE := '  CONFIGURATION COMMAND PROCESSORS' ??
?? NEWTITLE := '    RFP$DEFINE_LOCAL_HOST' ??
?? EJECT ??
  PROCEDURE rfp$define_local_host (parameter_list : clt$parameter_list;
                               VAR status : ost$status);

*copyc rfh$define_local_host

*copyc rfd$pdt_define_local_host

    VAR
        parameter_text: ^clt$parameter_list_text,
        save_info: rft$config_utl_pointers,
        physical_identifier,
        connection_password,
        subsystem_identifier,
        connection_timeout,
        data_transfer_timeout: clt$value,
        pid: rft$physical_identifier,
        logical_ids: ^ARRAY [1..*] OF rft$lids,
        number_of_lids: 0..clc$max_value_sets,
        local_host,
        lhost: ^rft$cu_local_host_entry,
        rhost: ^rft$cu_remote_host_entry,
        local_status: ost$status;

    status.normal := TRUE;
    rfp$retrieve_config_pointers(save_info);

  /main_section/
    BEGIN

      clp$get_parameter_list_text(^parameter_list, parameter_text, status);
      write_cmd_line('DEFLH', parameter_text^, save_info, status);
      clp$scan_parameter_list(parameter_list, define_local_host, local_status);
      IF  NOT local_status.normal  THEN
        IF  local_status.condition = cle$parameters_displayed  THEN
          RETURN;
        ELSE
          EXIT /main_section/;
        IFEND;
      IFEND;

      {   There may be only one local host definition.

      IF  save_info.local_host_defined  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$duplicate_local_host, '', local_status);
        EXIT /main_section/;
      IFEND;

      {    Each physical host identifier must be unique within a configuration file.

      clp$get_value('physical_identifier', 1, 1, clc$low, physical_identifier, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      #TRANSLATE(osv$lower_to_upper, physical_identifier.str.value(1,physical_identifier.str.size), pid);
      check_for_host_name_match(pid, csm_remote, NIL, save_info.remote_hosts, lhost, rhost);
      IF  (rhost <> NIL)  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$duplicate_component_name, pid, local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'HOST NAME',local_status);
        EXIT /main_section/;
      IFEND;
      clp$get_set_count('logical_identifiers', number_of_lids, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      IF  number_of_lids <> 0  THEN
        PUSH  logical_ids : [1..number_of_lids];
        get_logical_ids(logical_ids^, local_status);
        IF  NOT local_status.normal  THEN
          EXIT /main_section/;
        IFEND;
      IFEND;
      clp$get_value('connection_password', 1, 1, clc$low, connection_password, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('subsystem_identifier', 1, 1, clc$low, subsystem_identifier, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('connection_timeout', 1, 1, clc$low, connection_timeout, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('data_transfer_timeout', 1, 1, clc$low, data_transfer_timeout, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      {   create temporary entry in the temporary sequence.

      NEXT  local_host : [1..number_of_lids]  IN  save_info.temporary_seq;
      IF  local_host = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'temporary sequence',
                                local_status);
        EXIT /main_section/;
      IFEND;

      local_host^.entry.physical_identifier := pid;
      local_host^.entry.connection_password :=
                   connection_password.name.value(1,connection_password.name.size);
      local_host^.entry.subsystem_identifier :=
                   subsystem_identifier.name.value(1,subsystem_identifier.name.size);
      local_host^.entry.connection_timeout := connection_timeout.int.value;
      local_host^.entry.data_transfer_timeout := data_transfer_timeout.int.value;
      IF  number_of_lids <> 0  THEN
        local_host^.entry.logical_identifiers := logical_ids^;
      IFEND;
      local_host^.entry.disabled := FALSE;
      local_host^.entry.associated_paths := NIL;
      local_host^.number_of_paths := 0;
      local_host^.paths := NIL;
      save_info.local_host := local_host;
      save_info.local_host_defined := true;

    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$output_status_message(save_info.output_fid, local_status);
      save_info.error_encountered := TRUE;
    IFEND;

    rfp$preserve_config_pointers(save_info);

  PROCEND rfp$define_local_host;
?? TITLE := '    RFP$DEFINE_REMOTE_HOST' ??
?? EJECT ??
  PROCEDURE rfp$define_remote_host (parameter_list : clt$parameter_list;
                                VAR status : ost$status);

*copyc rfh$define_remote_host

*copyc rfd$pdt_define_remote_host

    VAR
        parameter_text: ^clt$parameter_list_text,
        save_info: rft$config_utl_pointers,
        physical_identifier: clt$value,
        pid: rft$physical_identifier,
        lhost: ^rft$cu_local_host_entry,
        rhost: ^rft$cu_remote_host_entry,
        logical_ids : ^ARRAY [1..*] OF rft$lids,
        number_of_lids: 0..clc$max_value_sets,
        remote_host: ^rft$cu_remote_host_entry,
        local_status: ost$status;

    status.normal := TRUE;
    rfp$retrieve_config_pointers(save_info);

  /main_section/
    BEGIN

      clp$get_parameter_list_text(^parameter_list, parameter_text, status);
      write_cmd_line('DEFRH', parameter_text^, save_info, status);
      clp$scan_parameter_list(parameter_list, define_remote_host, local_status);
      IF  NOT local_status.normal  THEN
        IF  local_status.condition = cle$parameters_displayed  THEN
          RETURN;
        ELSE
          EXIT /main_section/;
        IFEND;
      IFEND;

     {    Each physical host identifier must be unique within a configuration file.

      clp$get_value('physical_identifier', 1, 1, clc$low, physical_identifier, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      #TRANSLATE(osv$lower_to_upper, physical_identifier.str.value(1,physical_identifier.str.size), pid);
      check_for_host_name_match(pid, csm_both, save_info.local_host, save_info.remote_hosts, lhost, rhost);
      IF  (lhost <> NIL)  OR  (rhost <> NIL)  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$duplicate_component_name, pid, local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'HOST NAME',local_status);
        EXIT /main_section/;
      IFEND;
      clp$get_set_count('logical_identifiers', number_of_lids, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      IF  number_of_lids <> 0  THEN
        PUSH  logical_ids : [1..number_of_lids];
        get_logical_ids(logical_ids^, local_status);
        IF  NOT local_status.normal  THEN
          EXIT /main_section/;
        IFEND;
      IFEND;

      {   create temporary entry in the temporary sequence.

      NEXT  remote_host : [1..number_of_lids]  IN  save_info.temporary_seq;
      IF  remote_host = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'temporary sequence',
                                local_status);
        EXIT /main_section/;
      IFEND;
      remote_host^.entry.physical_identifier := pid;
      IF  number_of_lids <> 0  THEN
        remote_host^.entry.logical_identifiers := logical_ids^;
      IFEND;
      remote_host^.number_of_paths := 0;
      remote_host^.paths := NIL;
      remote_host^.entry.disabled := FALSE;
      remote_host^.entry.associated_paths := NIL;

      {  place the new entry at the head of the temporary list.

      save_info.remote_host_count := save_info.remote_host_count + 1;
      remote_host^.index := save_info.remote_host_count;
      remote_host^.next_entry := save_info.remote_hosts;
      save_info.remote_hosts := remote_host;

    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$output_status_message(save_info.output_fid, local_status);
      save_info.error_encountered := true;
    IFEND;

    rfp$preserve_config_pointers(save_info);

  PROCEND rfp$define_remote_host;
?? TITLE := '    RFP$DEFINE_LOCAL_NAD' ??
?? EJECT ??
  PROCEDURE rfp$define_local_nad (parameter_list : clt$parameter_list;
                              VAR status : ost$status);

*copyc rfh$define_local_nad

*copyc rfd$pdt_define_local_nad
    VAR
        parameter_text: ^clt$parameter_list_text,
        trunk_control_units: rft$trunk_control_units,
        tcu_access_codes: rft$nad_access_codes,
        nad_name: rft$component_name,
        nad_address: rft$nad_address,
        save_info: rft$config_utl_pointers,
        perform_auto_reload,
        reload_threshold,
        dump_disposition,
        maximum_connections,
        maximum_nad_entries,
        send_queue_limit,
        receive_queue_limit,
        monitor_trace,
        trunk_trace,
        device_trace,
        pp_drivers: clt$value,
        dump_disp: rft$dump_disposition,
        tcu_index: rfc$min_tcu..rfc$max_tcu,
        matching_local_nad: ^rft$cu_local_nad_entry,
        matching_remote_nad: ^rft$cu_remote_nad_entry,
        local_nad: ^rft$cu_local_nad_entry,
        local_status: ost$status;


    status.normal := TRUE;
    rfp$retrieve_config_pointers(save_info);

  /main_section/
    BEGIN

      clp$get_parameter_list_text(^parameter_list, parameter_text, status);
      write_cmd_line('DEFLN', parameter_text^, save_info, status);
      clp$scan_parameter_list(parameter_list, define_local_nad, local_status);
      IF  NOT local_status.normal  THEN
        IF  local_status.condition = cle$parameters_displayed  THEN
          RETURN;
        ELSE
          EXIT /main_section/;
        IFEND;
      IFEND;

      obtain_common_nad_params(save_info, nad_name, nad_address, trunk_control_units, tcu_access_codes,
        local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      clp$get_value('pp_drivers', 1, 1, clc$low, pp_drivers, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      clp$get_value('perform_auto_reload', 1, 1, clc$low, perform_auto_reload, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('reload_threshold', 1, 1, clc$low, reload_threshold, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('dump_disposition', 1, 1, clc$low, dump_disposition, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      convert_dump_disposition(dump_disposition.name.value(1,dump_disposition.name.size), dump_disp,
                               local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('maximum_connections', 1, 1, clc$low, maximum_connections, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('maximum_nad_entries', 1, 1, clc$low, maximum_nad_entries, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('send_queue_limit', 1, 1, clc$low, send_queue_limit, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('receive_queue_limit', 1, 1, clc$low, receive_queue_limit, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('monitor_trace', 1, 1, clc$low, monitor_trace, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('trunk_trace', 1, 1, clc$low, trunk_trace, local_status);
      IF  NOT local_status.normal  THEN
        RETURN;
      IFEND;
      clp$get_value('device_trace', 1, 1, clc$low, device_trace, local_status);
      IF  NOT local_status.normal  THEN
        RETURN;
      IFEND;

      {   create temporary entry in the temporary sequence.

      NEXT  local_nad  IN  save_info.temporary_seq;
      IF  local_nad = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'temporary sequence',
                                local_status);
        EXIT /main_section/;
      IFEND;

      {   Zero out the table so that the miscellaneous counters do not have to be initialized.

      pmp$zero_out_table(local_nad, #SIZE(rft$cu_local_nad_entry));

      local_nad^.entry.name := nad_name;
      local_nad^.entry.defined_address := nad_address;
      local_nad^.entry.address := nad_address;
      local_nad^.entry.pp_drivers := pp_drivers.int.value;
      FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
        local_nad^.entry.trunk_control_units[tcu_index] := trunk_control_units[tcu_index];
        local_nad^.entry.access_codes[tcu_index] := tcu_access_codes[tcu_index];
      FOREND;
      local_nad^.entry.maintenance_selections.perform_auto_reload := perform_auto_reload.bool.value;
      local_nad^.entry.maintenance_selections.reload_threshold := reload_threshold.int.value;
      local_nad^.entry.maintenance_selections.dump_disposition := dump_disp;
      local_nad^.entry.maintenance_selections.load_parameters.maximum_connections :=
                   maximum_connections.int.value;
      local_nad^.entry.maintenance_selections.load_parameters.maximum_nad_entries :=
                   maximum_nad_entries.int.value;
      local_nad^.entry.maintenance_selections.load_parameters.send_queue_limit :=
                   send_queue_limit.int.value;
      local_nad^.entry.maintenance_selections.load_parameters.receive_queue_limit :=
                   receive_queue_limit.int.value;
      local_nad^.entry.maintenance_selections.load_parameters.monitor_trace :=
                   monitor_trace.int.value;
      local_nad^.entry.maintenance_selections.load_parameters.device_trace :=
                   device_trace.int.value;
      local_nad^.entry.maintenance_selections.load_parameters.trunk_trace :=
                   trunk_trace.int.value;

      {  place the new entry at the head of the temporary list.

      save_info.local_nad_count := save_info.local_nad_count  + 1;
      IF  save_info.local_nad_count > rfc$max_local_nads  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'local nad table',
                                local_status);
        EXIT /main_section/;
      IFEND;
      local_nad^.index := save_info.local_nad_count;
      local_nad^.next_entry := save_info.local_nads;
      save_info.local_nads := local_nad;

    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$output_status_message(save_info.output_fid, local_status);
      save_info.error_encountered := true;
    IFEND;

    rfp$preserve_config_pointers(save_info);

  PROCEND rfp$define_local_nad;
?? TITLE := '    RFP$DEFINE_REMOTE_NAD' ??
?? EJECT ??
  PROCEDURE  rfp$define_remote_nad (parameter_list : clt$parameter_list;
                                VAR status : ost$status);

*copyc rfh$define_remote_nad

*copyc rfd$pdt_define_remote_nad

    VAR
        parameter_text: ^clt$parameter_list_text,
        trunk_control_units: rft$trunk_control_units,
        tcu_access_codes: rft$nad_access_codes,
        nad_name: rft$component_name,
        nad_address: rft$nad_address,
        connected_to_host: BOOLEAN,
        save_info: rft$config_utl_pointers,
        lhost: ^rft$cu_local_host_entry,
        rhost: ^rft$cu_remote_host_entry,
        the_parameter_is_specified: boolean,
        remote_nad: ^rft$cu_remote_nad_entry,
        microcode_type,
        inter_network_link,
        host_connection,
        logical_network: clt$value,
        host_connections: rft$host_connections,
        mc_type: rft$microcode_types,
        tcu_index: rfc$min_tcu..rfc$max_tcu,
        host_index: rfc$min_host_connect..rfc$max_host_connect,
        local_status: ost$status;

    status.normal := TRUE;
    rfp$retrieve_config_pointers(save_info);

  /main_section/
    BEGIN

      clp$get_parameter_list_text(^parameter_list, parameter_text, status);
      write_cmd_line('DEFRN', parameter_text^, save_info, status);
      clp$scan_parameter_list(parameter_list, define_remote_nad, local_status);
      IF  NOT local_status.normal  THEN
        IF  local_status.condition = cle$parameters_displayed  THEN
          RETURN;
        ELSE
          EXIT /main_section/;
        IFEND;
      IFEND;

      obtain_common_nad_params(save_info, nad_name, nad_address, trunk_control_units, tcu_access_codes,
        local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      clp$get_value('nad_type', 1, 1, clc$low, microcode_type, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      convert_microcode_type(microcode_type.name.value(1,microcode_type.name.size), mc_type,
                               local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      connected_to_host := FALSE;
      IF  (mc_type = rfc$mc_type_ntn)  OR  (mc_type = rfc$mc_type_inet)  THEN
        FOR  host_index := rfc$min_host_connect  TO  rfc$max_host_connect  DO
          host_connections[host_index] := '';     {  There cannot be a host directly connected to this NAD }
        FOREND;
        connected_to_host := TRUE;
      ELSE

        {   Obtaining the host connections is similar to the process required for obtaining the
        {   trunk connections.  See comment in routine OBTAIN_COMMON_NAD_PARAMETERS.

        clp$test_parameter('host_connection_0', the_parameter_is_specified, local_status);
        IF  the_parameter_is_specified  THEN
          clp$get_value('host_connection_0', 1, 1, clc$low, host_connection, local_status);
          IF  NOT local_status.normal  THEN
            EXIT /main_section/;
          IFEND;
          #TRANSLATE(osv$lower_to_upper, host_connection.str.value(1,host_connection.str.size),
            host_connections[rfc$min_host_connect]);
          connected_to_host := TRUE;
        ELSE

          {  If a host connection is not attached to a host, then the host connection entry must be set
          {  to the NIL string to prevent erroneous operations when referencing this entity.

          host_connections[rfc$min_host_connect] := '';
        IFEND;
        IF  mc_type <> rfc$mc_type_vax  THEN
          FOR  host_index := (rfc$min_host_connect + 1)  TO  rfc$max_host_connect  DO
            host_connections[host_index] := '';     {  Only host connection 0 is used on non-VAX NADS }
          FOREND;
        ELSE
          clp$test_parameter('host_connection_1', the_parameter_is_specified, local_status);
          IF  the_parameter_is_specified  THEN
            clp$get_value('host_connection_1', 1, 1, clc$low, host_connection, local_status);
            IF  NOT local_status.normal  THEN
              EXIT /main_section/;
            IFEND;
            #TRANSLATE(osv$lower_to_upper, host_connection.str.value(1,host_connection.str.size),
              host_connections[rfc$min_host_connect + 1]);
            connected_to_host := TRUE;
          ELSE
            host_connections[rfc$min_host_connect + 1] := '';
          IFEND;
          clp$test_parameter('host_connection_2', the_parameter_is_specified, local_status);
          IF  the_parameter_is_specified  THEN
            clp$get_value('host_connection_2', 1, 1, clc$low, host_connection, local_status);
            IF  NOT local_status.normal  THEN
              EXIT /main_section/;
            IFEND;
            #TRANSLATE(osv$lower_to_upper, host_connection.str.value(1,host_connection.str.size),
              host_connections[rfc$min_host_connect + 2]);
            connected_to_host := TRUE;
          ELSE
            host_connections[rfc$min_host_connect + 2] := '';
          IFEND;
          clp$test_parameter('host_connection_3', the_parameter_is_specified, local_status);
          IF  the_parameter_is_specified  THEN
            clp$get_value('host_connection_3', 1, 1, clc$low, host_connection, local_status);
            IF  NOT local_status.normal  THEN
              EXIT /main_section/;
            IFEND;
            #TRANSLATE(osv$lower_to_upper, host_connection.str.value(1,host_connection.str.size),
              host_connections[rfc$min_host_connect + 3]);
            connected_to_host := TRUE;
          ELSE
            host_connections[rfc$min_host_connect + 3] := '';
          IFEND;
        IFEND;
      IFEND;

      IF  NOT connected_to_host  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing,
          'HOST CONNECTION per REMOTE NAD', local_status);
        EXIT /main_section/;
      IFEND;

      {   Verify that the NAD is connected to a known remote host.

      FOR  host_index := rfc$min_host_connect  TO  rfc$max_host_connect  DO
        IF  host_connections[host_index] <> ''  THEN
          check_for_host_name_match(host_connections[host_index], csm_remote, NIL, save_info.remote_hosts,
            lhost, rhost);
          IF  rhost = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$invalid_host_connection, '', local_status);
            osp$append_status_integer(osc$status_parameter_delimiter, host_index, 10, FALSE,
                                      local_status);
            osp$append_status_parameter(osc$status_parameter_delimiter, nad_name, local_status);
            EXIT /main_section/;
          IFEND;
        IFEND;
      FOREND;

      {   create temporary entry in the temporary sequence.

      NEXT  remote_nad  IN  save_info.temporary_seq;
      IF  remote_nad = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'temporary sequence',
                                local_status);
        EXIT /main_section/;
      IFEND;

      {   Zero out the table so that the miscellaneous counters do not have to be initialized.

      pmp$zero_out_table(remote_nad, #SIZE(rft$cu_remote_nad_entry));

      remote_nad^.entry.name := nad_name;
      remote_nad^.entry.address := nad_address;
      FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
        remote_nad^.entry.trunk_control_units[tcu_index] := trunk_control_units[tcu_index];
        remote_nad^.entry.access_codes[tcu_index] := tcu_access_codes[tcu_index];
      FOREND;
      FOR  host_index := rfc$min_host_connect  TO  rfc$max_host_connect  DO
        remote_nad^.entry.host_connections[host_index] := host_connections[host_index];
      FOREND;
      remote_nad^.entry.microcode_type := mc_type;

      {  place the new entry at the head of the temporary list.

      save_info.remote_nad_count := save_info.remote_nad_count  + 1;
      remote_nad^.index := save_info.remote_nad_count;
      remote_nad^.next_entry := save_info.remote_nads;
      save_info.remote_nads := remote_nad;

    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$output_status_message(save_info.output_fid, local_status);
      save_info.error_encountered := true;
    IFEND;

    rfp$preserve_config_pointers(save_info);

   PROCEND rfp$define_remote_nad;
?? TITLE := '    RFP$DEFINE_LCN_PATH' ??
?? EJECT ??
  PROCEDURE rfp$define_lcn_path (parameter_list: clt$parameter_list;
                             VAR status : ost$status);

*copyc rfh$define_lcn_path

*copyc rfd$pdt_define_lcn_path

    VAR
        parameter_text: ^clt$parameter_list_text,
        save_info: rft$config_utl_pointers,
        local_nad,
        remote_nad,
        host_connection,
        logical_nad,
        logical_network,
        excluded_trunk,
        physical_identifier,
        access_code : clt$value,
        the_parameter_is_specified : boolean,
        log_network : rft$logical_network,
        log_nad : rft$logical_nad,
        host_connection_index : rfc$min_host_connect..rfc$max_host_connect,
        lcn_path : ^rft$cu_lcn_path_entry,
        set_count : 0..clc$max_value_sets,
        number_of_excluded_trunks : 0..3,
        excluded_trunks : ARRAY [1..3] OF rft$component_name,
        index : integer,
        ltcu,
        rtcu : rfc$min_tcu..rfc$max_tcu,
        ltcu_connection,
        rtcu_connection : rft$tcu_mask,
        lhost : ^rft$cu_local_host_entry,
        rhost : ^rft$cu_remote_host_entry,
        lnad_1, lnad_2 : ^rft$cu_local_nad_entry,
        rnad_1, rnad_2 : ^rft$cu_remote_nad_entry,
        pid : rft$physical_identifier,
        lnad_name,
        rnad_name : rft$component_name,
        trunk_match : boolean,
        local_status : ost$status;


    status.normal := TRUE;
    rfp$retrieve_config_pointers(save_info);

  /main_section/
    BEGIN

      clp$get_parameter_list_text(^parameter_list, parameter_text, status);
      write_cmd_line('DEFLP', parameter_text^, save_info, status);
      clp$scan_parameter_list(parameter_list, define_lcn_path, local_status);
      IF  NOT local_status.normal  THEN
        IF  local_status.condition = cle$parameters_displayed  THEN
          RETURN;
        ELSE
          EXIT /main_section/;
        IFEND;
      IFEND;

      save_info.deflp_encountered := TRUE;

      clp$get_value('logical_network', 1, 1, clc$low, logical_network, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      clp$get_value('logical_nad', 1, 1, clc$low, logical_nad, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      clp$get_set_count('exclude_trunk', set_count, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      number_of_excluded_trunks := set_count;
      FOR  index := 1  TO  number_of_excluded_trunks  DO
        clp$get_value('exclude_trunk', index, 1, clc$low, excluded_trunk, local_status);
        IF  NOT local_status.normal  THEN
          EXIT /main_section/;
        IFEND;
        excluded_trunks[index] := excluded_trunk.name.value(1,excluded_trunk.name.size);
      FOREND;

      FOR  index := (number_of_excluded_trunks + 1)  TO  3  DO
        excluded_trunks[index] := '';   { clear out any unused entries  }
      FOREND;

      clp$get_value('access_code', 1, 1, clc$low, access_code, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;

      clp$get_value('host_connection', 1, 1, clc$low, host_connection, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      host_connection_index := host_connection.int.value;

      {   The local NAD defined for this path must have been defined in this configuration file.

      clp$get_value('local_nad', 1, 1, clc$low, local_nad, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      lnad_name := local_nad.name.value(1,local_nad.name.size);
      check_for_nad_name_match(lnad_name, csm_local, save_info.local_nads, save_info.remote_nads,
        lnad_1, rnad_1);
      IF  lnad_1 = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$undefined_path_element, lnad_name, local_status);
        EXIT /main_section/;
      IFEND;

      {   The remote NAD defined for this path must have been previously defined in this
      {   configuration.
      {
      {   NOTE - the remote NAD can be either a local (i.e. loop-back path) or a remote NAD.

      clp$get_value('remote_nad', 1, 1, clc$low, remote_nad, local_status);
      IF  NOT local_status.normal  THEN
        EXIT /main_section/;
      IFEND;
      rnad_name := remote_nad.name.value(1,remote_nad.name.size);
      check_for_nad_name_match(rnad_name, csm_both, save_info.local_nads, save_info.remote_nads,
        lnad_2, rnad_2);
      IF  (lnad_2 = NIL)  AND  (rnad_2 = NIL)  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$undefined_path_element, rnad_name, local_status);
        EXIT /main_section/;
      IFEND;

      IF  (lnad_2 <> NIL)  THEN

        {   If the remote NAD is a local NAD then the path is a loopback path  }

        IF  NOT save_info.local_host_defined  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$undefined_path_element, 'LOCAL HOST', local_status);
          EXIT /main_section/;
        IFEND;
        lhost := save_info.local_host;
        rhost := NIL;
        host_connection_index := rfc$min_host_connect;  {  all VE NADs only have host connection zero  }
        log_network := rfc$min_logical_network;
        log_nad := rfc$min_logical_nad;
      ELSE
        IF  (rnad_2^.entry.microcode_type = rfc$mc_type_ntn)
            OR  (rnad_2^.entry.microcode_type = rfc$mc_type_inet)  THEN

          {   If the remote NAD is an NTN or an INET NAD then the physical identifier is needed to
          {   determine the destination host.

          clp$test_parameter('host_connection', the_parameter_is_specified, local_status);
          IF  the_parameter_is_specified  THEN
            clp$get_value('physical_identifier', 1, 1, clc$low, physical_identifier, local_status);
            IF  NOT local_status.normal  THEN
              EXIT /main_section/;
            IFEND;
            pid := physical_identifier.name.value(1,physical_identifier.name.size);
            check_for_host_name_match(pid, csm_both, save_info.local_host, save_info.remote_hosts,
              lhost, rhost);
            IF  (lhost = NIL)  AND  (rhost = NIL)  THEN
              osp$set_status_abnormal(rfc$product_id, rfe$undefined_path_element, pid, local_status);
              EXIT /main_section/;
            IFEND;
          ELSE
            osp$set_status_abnormal(rfc$product_id, rfe$physical_id_required, '', local_status);
            EXIT /main_section/;
          IFEND;
          log_network := logical_network.int.value;
          log_nad := logical_nad.int.value;

        ELSE
          IF  rnad_2^.entry.microcode_type <> rfc$mc_type_vax  THEN

            {  IF the destination NAD is not a VAX NAD, then the host connection must be zero.

            host_connection_index := rfc$min_host_connect;
          IFEND;

          {   Verify that the host connection specified by the user is valid.

          log_network := rfc$min_logical_network;
          log_nad := rfc$min_logical_nad;
          pid := rnad_2^.entry.host_connections[host_connection_index];
          check_for_host_name_match(pid, csm_remote, NIL, save_info.remote_hosts, lhost, rhost);

          {   Note - 'lhost' must be NIL after a call to the above routine.

          IF  rhost = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$invalid_host_connection, '', local_status);
            osp$append_status_integer(osc$status_parameter_delimiter, host_connection_index, 10, FALSE,
                                      local_status);
            osp$append_status_parameter(osc$status_parameter_delimiter, rnad_name, local_status);
            EXIT /main_section/;
          IFEND;
        IFEND;
      IFEND;

      {   Determine which, if any, trunks are common between the two NADs.

      IF  lnad_2 <> NIL  THEN         {  local NAD to local NAD connection  }
        determine_common_trunks(lnad_1^.entry.trunk_control_units, lnad_2^.entry.trunk_control_units,
          lnad_1^.entry.access_codes, lnad_2^.entry.access_codes, access_code.int.value, excluded_trunks,
          ltcu_connection, rtcu_connection, trunk_match);

      ELSE         {   local NAD to remote NAD connection  }

        determine_common_trunks(lnad_1^.entry.trunk_control_units, rnad_2^.entry.trunk_control_units,
          lnad_1^.entry.access_codes, rnad_2^.entry.access_codes, access_code.int.value, excluded_trunks,
          ltcu_connection, rtcu_connection, trunk_match);
      IFEND;

      IF  NOT trunk_match  AND          {  no matching trunks  }
          (lnad_1 <> lnad_2)  THEN      {  and not looping back through the same NAD  }
        osp$set_status_abnormal(rfc$product_id, rfe$no_trunk_match, lnad_name, local_status);
        osp$append_status_parameter(osc$status_parameter_delimiter, rnad_name, local_status);
        EXIT /main_section/;
      IFEND;

      {   create temporary entry in the temporary sequence.

      NEXT  lcn_path  IN  save_info.temporary_seq;
      IF  lcn_path = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'temporary sequence',
                                local_status);
        EXIT /main_section/;
      IFEND;
      pmp$zero_out_table(lcn_path, #SIZE(rft$lcn_path_definition));
      lcn_path^.entry.local_nad := lnad_1^.index;
      IF  lnad_2 <> NIL  THEN
        lcn_path^.entry.loopback := TRUE;
        lcn_path^.entry.destination_nad := lnad_2^.index;
      ELSE
        lcn_path^.entry.loopback := FALSE;
        lcn_path^.entry.remote_nad := rnad_2^.index;
      IFEND;
      lcn_path^.entry.access_code := access_code.int.value;
      lcn_path^.entry.logical_network := logical_network.int.value;
      lcn_path^.entry.logical_nad := logical_nad.int.value;
      lcn_path^.entry.destination_device := host_connection_index;
      lcn_path^.entry.local_tcu_mask := ltcu_connection;
      lcn_path^.entry.remote_tcu_mask := rtcu_connection;

      {   Link the path entry into the corresponding host entry.

      IF  lnad_2 <> NIL  THEN
        lhost^.number_of_paths := lhost^.number_of_paths + 1;
        lcn_path^.next_entry := lhost^.paths;
        lhost^.paths := lcn_path;
      ELSE
        rhost^.number_of_paths := rhost^.number_of_paths + 1;
        lcn_path^.next_entry := rhost^.paths;
        rhost^.paths := lcn_path;
      IFEND;
    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$output_status_message(save_info.output_fid, local_status);
      save_info.error_encountered := true;
    IFEND;

    rfp$preserve_config_pointers(save_info);

  PROCEND rfp$define_lcn_path;
?? TITLE := '    RFP$AUTO_PATH_GENERATION' ??
?? EJECT ??
  PROCEDURE  rfp$auto_path_generation (parameter_list : clt$parameter_list;
                                   VAR status : ost$status);

*copyc rfh$auto_path_generation

*copyc rfd$pdt_auto_path_generation

    VAR
        parameter_text: ^clt$parameter_list_text,
        save_info: rft$config_utl_pointers,
        lnad_1, lnad_2: ^rft$cu_local_nad_entry,
        rnad_2: ^rft$cu_remote_nad_entry,
        ltcu_mask, rtcu_mask: rft$tcu_mask,
        lhost: ^rft$cu_local_host_entry,
        rhost: ^rft$cu_remote_host_entry,
        excluded_trunks: ARRAY [1..3] OF rft$component_name,
        default_access_code: rft$nad_access_code,
        exclude_index: 1 .. 3,
        tcu_index: rfc$min_tcu .. rfc$max_tcu,
        host_index: rfc$min_host_connect .. rfc$max_host_connect,
        lcn_path: ^rft$cu_lcn_path_entry,
        match_found: boolean,
        local_status: ost$status;


    status.normal := TRUE;
    rfp$retrieve_config_pointers(save_info);

  /main_section/
    BEGIN

      clp$get_parameter_list_text(^parameter_list, parameter_text, status);
      write_cmd_line('AUTPG', parameter_text^, save_info, status);
      clp$scan_parameter_list(parameter_list, auto_path_generation, local_status);
      IF  NOT local_status.normal  THEN
        IF  local_status.condition = cle$parameters_displayed  THEN
          RETURN;
        ELSE
          EXIT /main_section/;
        IFEND;
      IFEND;

      IF  save_info.autpg_encountered  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$duplicate_autpg, '', local_status);
        EXIT /main_section/;
      IFEND;

      IF  save_info.deflp_encountered  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$autpg_after_deflp, '', local_status);
        EXIT /main_section/;
      IFEND;

      save_info.autpg_encountered := TRUE;

      FOR  exclude_index := 1  TO  3  DO
        excluded_trunks[exclude_index] := '';
      FOREND;


      lnad_1 := save_info.local_nads;
      WHILE  lnad_1 <> NIL  DO

        default_access_code := 0;
      /find_access_code/
        FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
          IF  lnad_1^.entry.trunk_control_units[tcu_index] <> ''  THEN
            default_access_code := lnad_1^.entry.access_codes[tcu_index];
            EXIT /find_access_code/;
          IFEND;
        FOREND /find_access_code/;

        IF  save_info.local_host_defined  THEN
          lnad_2 := save_info.local_nads;
          WHILE  lnad_2 <> NIL  DO
            determine_common_trunks(lnad_1^.entry.trunk_control_units, lnad_2^.entry.trunk_control_units,
                lnad_1^.entry.access_codes, lnad_2^.entry.access_codes, default_access_code,
                excluded_trunks, ltcu_mask, rtcu_mask, match_found);
            IF  (match_found) OR
                (lnad_1 = lnad_2)  THEN

              {   create temporary entry in the temporary sequence.

              NEXT  lcn_path  IN  save_info.temporary_seq;
              IF  lcn_path = NIL  THEN
                osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'temporary sequence',
                                        local_status);
                EXIT /main_section/;
              IFEND;

              pmp$zero_out_table(lcn_path, #SIZE(rft$lcn_path_definition));
              lcn_path^.entry.local_nad := lnad_1^.index;
              lcn_path^.entry.loopback := TRUE;
              lcn_path^.entry.destination_nad := lnad_2^.index;
              lcn_path^.entry.access_code := default_access_code;
              lcn_path^.entry.logical_network := rfc$min_logical_network;
              lcn_path^.entry.logical_nad := rfc$min_logical_nad;
              lcn_path^.entry.destination_device := rfc$min_host_connect;
              lcn_path^.entry.local_tcu_mask := ltcu_mask;
              lcn_path^.entry.remote_tcu_mask := rtcu_mask;

              {   Link the path entry into the local host entry.

              save_info.local_host^.number_of_paths := save_info.local_host^.number_of_paths + 1;
              lcn_path^.next_entry := save_info.local_host^.paths;
              save_info.local_host^.paths := lcn_path;
            IFEND;
            lnad_2 := lnad_2^.next_entry;
          WHILEND;
        IFEND;

        rnad_2 := save_info.remote_nads;
        WHILE  rnad_2 <> NIL  DO
          IF (rnad_2^.entry.microcode_type <> rfc$mc_type_ntn) AND
             (rnad_2^.entry.microcode_type <> rfc$mc_type_inet) THEN

            {      only local area network paths are created      }

            determine_common_trunks(lnad_1^.entry.trunk_control_units, rnad_2^.entry.trunk_control_units,
                lnad_1^.entry.access_codes, rnad_2^.entry.access_codes, default_access_code,
                excluded_trunks, ltcu_mask, rtcu_mask, match_found);

            IF  match_found  THEN

              FOR  host_index := rfc$min_host_connect  TO  rfc$max_host_connect  DO

                IF  rnad_2^.entry.host_connections[host_index] <> ''  THEN
                  check_for_host_name_match(rnad_2^.entry.host_connections[host_index], csm_remote, NIL,
                    save_info.remote_hosts, lhost, rhost);
                  IF  rhost = NIL  THEN
                    osp$set_status_abnormal(rfc$product_id, rfe$invalid_host_connection, '', local_status);
                    osp$append_status_integer(osc$status_parameter_delimiter, host_index, 10, FALSE,
                                              local_status);
                    osp$append_status_parameter(osc$status_parameter_delimiter, rnad_2^.entry.name,
                                                local_status);
                    EXIT /main_section/;
                  IFEND;

                  {   create temporary entry in the temporary sequence.

                  NEXT  lcn_path  IN  save_info.temporary_seq;
                  IF  lcn_path = NIL  THEN
                    osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow,
                                            'temporary sequence', local_status);
                    EXIT /main_section/;
                  IFEND;

                  pmp$zero_out_table(lcn_path, #SIZE(rft$lcn_path_definition));
                  lcn_path^.entry.local_nad := lnad_1^.index;
                  lcn_path^.entry.loopback := FALSE;
                  lcn_path^.entry.remote_nad := rnad_2^.index;
                  lcn_path^.entry.access_code := default_access_code;
                  lcn_path^.entry.logical_network := rfc$min_logical_network;
                  lcn_path^.entry.logical_nad := rfc$min_logical_nad;
                  lcn_path^.entry.destination_device := host_index;
                  lcn_path^.entry.local_tcu_mask := ltcu_mask;
                  lcn_path^.entry.remote_tcu_mask := rtcu_mask;

                  {   Link the path entry into the corresponding remote host entry.

                  rhost^.number_of_paths := rhost^.number_of_paths + 1;
                  lcn_path^.next_entry := rhost^.paths;
                  rhost^.paths := lcn_path;
                IFEND;
              FOREND;
            IFEND;
          IFEND;
          rnad_2 := rnad_2^.next_entry;
        WHILEND;
        lnad_1 := lnad_1^.next_entry;
      WHILEND;
    END /main_section/;

    IF  NOT local_status.normal  THEN
      rfp$output_status_message(save_info.output_fid, local_status);
      save_info.error_encountered := true;
    IFEND;

    rfp$preserve_config_pointers(save_info);

  PROCEND rfp$auto_path_generation;
?? OLDTITLE ??
?? TITLE := '  MISCELLANEOUS ROUTINES' ??
?? NEWTITLE := '    CHECK_FOR_HOST_NAME_MATCH' ??
?? EJECT ??
  PROCEDURE check_for_host_name_match (physical_identifier: rft$physical_identifier;
                                       search_mode: configuration_search_modes;
                                       local_host: ^rft$cu_local_host_entry;
                                       remote_hosts: ^rft$cu_remote_host_entry;
                                   VAR local_host_match: ^rft$cu_local_host_entry;
                                   VAR remote_host_match: ^rft$cu_remote_host_entry);

{    The purpose of this routine is to determine whether or not a host has been defined with
{    the specified physical identifier.
{
{    physical_identifer: (input) This parameter specifies the 3-character host identifier,
{      which must be unique within a configuration file.
{
{    search_mode: (input) This parameter specifies which tables are to be searched to find
{      the specified host.  The caller may search the local host table, remote host table,
{      or both of the tables.  (note - the local host table can only have one entry)
{
{    local_host_match: (output) This parameter points to the matching local host entry.
{      If NIL, then the local host entries' physical identifier did not match the
{      specified physical identifier.
{
{    remote_host_match: (output) This parameter points to the matching remote host entry.
{      If NIL, then none of the remote host entries' physical identifiers matched the
{      specified physical identifier.


    VAR
        remote_host : ^rft$cu_remote_host_entry;

    local_host_match := NIL;
    remote_host_match := NIL;

    IF  (local_host <> NIL)
        AND ((search_mode = csm_local)  OR  (search_mode = csm_both))  THEN
      IF  local_host^.entry.physical_identifier = physical_identifier  THEN
        local_host_match := local_host;
        RETURN;
      IFEND;
    IFEND;

    IF  (search_mode = csm_remote)  OR  (search_mode = csm_both)  THEN
      remote_host := remote_hosts;
      WHILE  remote_host <> NIL  DO
        IF  remote_host^.entry.physical_identifier = physical_identifier  THEN
          remote_host_match := remote_host;
          RETURN;
        IFEND;
        remote_host := remote_host^.next_entry;
      WHILEND;
    IFEND;

  PROCEND check_for_host_name_match;
?? TITLE := '    CHECK_FOR_NAD_NAME_MATCH' ??
?? EJECT ??
  PROCEDURE check_for_nad_name_match (nad_name: rft$component_name;
                                      search_mode: configuration_search_modes;
                                      local_nads: ^rft$cu_local_nad_entry;
                                      remote_nads: ^rft$cu_remote_nad_entry;
                                  VAR local_nad_match: ^rft$cu_local_nad_entry;
                                  VAR remote_nad_match: ^rft$cu_remote_nad_entry);

{    The purpose of this routine is to determine whether or not a nad has been defined with
{    the specified nad name.
{
{    nad_name: (input) This parameter specifies the element name of the local NAD,
{      which must be unique within a configuration file.
{
{    search_mode: (input) This parameter specifies which tables are to be searched to find
{      the specified host.  The caller may search the local nad table, remote nad table,
{      or both of the tables.
{
{    local_nad_match: (output) This parameter points to the matching local nad entry.
{      If NIL, then none of the defined local NAD entries have a matching nad_name.
{
{    remote_nad_match: (output) This parameter points to the matching remote nad entry.
{      If NIL, then none of the defined remote nad entries have a matching nad_name.


    VAR
        remote_nad : ^rft$cu_remote_nad_entry,
        local_nad : ^rft$cu_local_nad_entry;

    local_nad_match := NIL;
    remote_nad_match := NIL;

    IF  (search_mode = csm_local)  OR  (search_mode = csm_both)  THEN
      local_nad := local_nads;
      WHILE  local_nad <> NIL  DO
        IF  local_nad^.entry.name = nad_name  THEN
          local_nad_match := local_nad;
          RETURN;
        IFEND;
        local_nad := local_nad^.next_entry;
      WHILEND;
    IFEND;

    IF  (search_mode = csm_remote)  OR  (search_mode = csm_both)  THEN
      remote_nad := remote_nads;
      WHILE  remote_nad <> NIL  DO
        IF  remote_nad^.entry.name = nad_name  THEN
          remote_nad_match := remote_nad;
          RETURN;
        IFEND;
        remote_nad := remote_nad^.next_entry;
      WHILEND;
    IFEND;

  PROCEND check_for_nad_name_match;
?? TITLE := '    CONVERT_MICROCODE_TYPE' ??
?? EJECT ??
  PROCEDURE convert_microcode_type(name: string(*);
                               VAR microcode_type: rft$microcode_types;
                               VAR status: ost$status);

{    The purpose of this procedure is to convert the microcode type string value into a
{    valid microcode type code.
{
{    name: (input) This parameter specifies the microcode type string value to be converted.
{
{    microcode_type: (output) This parameter returns the internal microcode type code.
{
{    status: (output) This parameter specifies the results of the request.  If the return status
{      is normal, then the parameter microcode_type contains a valid value.

    VAR
        mt_conversion_table : [static] ARRAY [rft$microcode_types] OF string(4) :=
          ['C180', 'C170', 'VAX', 'IBM', 'C200', 'INET', 'NTN'],
        mt_index : rft$microcode_types;

    status.normal := TRUE;

    FOR  mt_index := rfc$mc_type_180  TO  rfc$mc_type_ntn  DO
      IF  mt_conversion_table[mt_index] = name  THEN
        microcode_type := mt_index;
        RETURN;
      IFEND;
    FOREND;

{    If you get to here no match was found, this means there is a major screw up somewhere.

    osp$set_status_abnormal(rfc$product_id, rfe$parameter_problem, 'NAD_TYPE', status);

  PROCEND convert_microcode_type;
?? TITLE := '    CONVERT_DUMP_DISPOSITION' ??
?? EJECT ??
  PROCEDURE convert_dump_disposition(name: string(*);
                                 VAR dump_disposition: rft$dump_disposition;
                                 VAR status: ost$status);

{    The purpose of this procedure is to convert the dump disposition string value into a
{    valid dump disposition code.
{
{    name: (input) This parameter specifies the dump dispostion string value to be converted.
{
{    dump_disposition: (output) This parameter returns the internal dump disposition code.
{
{    status: (output) This parameter specifies the results of the request.  If the return status
{      is normal, then the parameter dump_dispostion contains a valid value.

    VAR
        dd_conversion_table : [static] ARRAY [rft$dump_disposition] OF string(10) :=
          ['DISCARD', 'SAVE_LAST', 'SAVE_ALL'],
        dd_index : rft$dump_disposition;

    status.normal := TRUE;

    FOR  dd_index := rfc$dd_discard  TO  rfc$dd_save_all  DO
      IF  dd_conversion_table[dd_index] = name  THEN
        dump_disposition := dd_index;
        RETURN;
      IFEND;
    FOREND;

{    If you get to here no match was found, this means there is a major screw up somewhere.

    osp$set_status_abnormal(rfc$product_id, rfe$parameter_problem, 'DUMP_DISPOSITION', status);

  PROCEND convert_dump_disposition;
?? TITLE := '    DETERMINE_COMMON_TRUNKS' ??
?? EJECT ??
  PROCEDURE  determine_common_trunks(local_nad_trunks: rft$trunk_control_units;
                                     remote_nad_trunks: rft$trunk_control_units;
                                     local_tcu_access_codes: rft$nad_access_codes;
                                     remote_tcu_access_codes: rft$nad_access_codes;
                                     access_code: rft$nad_access_code;
                                     excluded_trunks: ARRAY [1..3] OF rft$component_name;
                                 VAR local_tcu_mask: rft$tcu_mask;
                                 VAR remote_tcu_mask: rft$tcu_mask;
                                 VAR common_trunk_found: boolean);

{    The purpose of this routine is to determine which trunks, if any, are common between two
{    NADs.  The criteria to determine a matching trunk is as follows:
{
{    1)   A Trunk Control Unit on the local NAD must be attached to a trunk with the same name
{         as a trunk attached to a Trunk Control Unit on the remote NAD.
{
{    2)   The trunk name must not reference a trunk that has been expicitly excluded by the user.
{
{    3)   The remote trunk control unit access code must be the same as the access code
{         specified by the user.
{
{    When a matching trunk is found, both the corresponding tcu mask flag in the local tcu
{    mask and the remote tcu mask are set to TRUE.
{
{
{    local_nad_trunks: (input) This parameter specifies the local NAD trunk attachments.
{
{    remote_nad_trunks: (input) This parameter specifies the remote NAD trunk attachments.
{
{    local_tcu_access_codes: (input) This parameter specifies the access codes which correspond
{      to each of the local NAD trunks.
{
{    remote_tcu_access_codes: (input) This parameter specifies the access codes which correspond
{      to each of the remote NAD trunks.
{
{    access_code: (input) This parameter specifies the access code which must be matched before
{      a trunk match is determined.
{
{    excluded_trunks: (input) This parameter specifies a list of trunk names which are note
{      to be considered as candidates for this compare operation.  Note - all entries that are not
{      defined must be set to the NIL string ('').
{
{    local_tcu_mask: (output) This parameter is an array of flags which denote the matching
{      trunk control units on the local NAD.
{
{    remote_tcu_mask: (output) This parameter is an array of flags which denote the matching
{      trunk control units on the remote NAD.
{
{    common_trunk_found: (output) This parameter returns a value of TRUE if there are any matching
{      trunks between the two NADs.

    VAR
        trunk_match: boolean,
        ltcu,
        rtcu: rfc$min_tcu..rfc$max_tcu;


    FOR  ltcu := rfc$min_tcu  TO  rfc$max_tcu  DO
      local_tcu_mask[ltcu] := FALSE;             {  initially assume no connects available  }
      remote_tcu_mask[ltcu] := FALSE;
    FOREND;
    trunk_match := FALSE;

    FOR  ltcu := rfc$min_tcu  TO  rfc$max_tcu  DO
      IF  local_nad_trunks[ltcu] <> ''  THEN
        FOR  rtcu := rfc$min_tcu  TO rfc$max_tcu  DO
          IF  (local_nad_trunks[ltcu] = remote_nad_trunks[rtcu])
              AND  (access_code = remote_tcu_access_codes[rtcu])
              AND  (NOT the_trunk_is_excluded(excluded_trunks, local_nad_trunks[ltcu]))  THEN
            local_tcu_mask[ltcu] := TRUE;
            remote_tcu_mask[rtcu] := TRUE;
            trunk_match := TRUE;
          IFEND;
        FOREND;
      IFEND;
    FOREND;

    common_trunk_found := trunk_match;

  PROCEND determine_common_trunks;
?? TITLE := '    GET_LOGICAL_IDS' ??
?? EJECT ??
  PROCEDURE  get_logical_ids(VAR lids: ARRAY [1..*] OF rft$lids;
                             VAR status: ost$status);

{    The purpose of this procedure is to get the values of the logical identifiers for the
{    DEFINE_LOCAL_HOST and DEFINE_REMOTE_HOST configurtion directives.  This procedure assumes
{    that CLP$SCAN_PARAMETER_LIST had been called prior to calling this procedure.
{
{    lids: (output) This parameter returns a list of the logical identifiers that have been
{      defined for the corresponding host.
{
{    status: (output) This parameter returns the results of the request.

    VAR
        lid1,lid2,
        lid_index: INTEGER,
        logical_identifier: clt$value;

    FOR  lid_index := 1  TO  UPPERBOUND(lids)  DO
      clp$get_value('logical_identifiers', lid_index, 1, clc$low, logical_identifier, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
      #TRANSLATE(osv$lower_to_upper, logical_identifier.str.value(1,logical_identifier.str.size),
        lids[lid_index].logical_id);
      lids[lid_index].disabled := FALSE;
      IF  logical_identifier.str.size <> #SIZE(rft$physical_identifier)  THEN
        lids[lid_index].map_lid_to_pid := TRUE;
      ELSE
        lids[lid_index].map_lid_to_pid := FALSE;
      IFEND;
    FOREND;

    FOR  lid1 := 1  TO  (UPPERBOUND(lids)-1)  DO
      FOR  lid2 := (lid1+1) TO  UPPERBOUND(lids)  DO
        IF  lids[lid1] = lids[lid2]  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$duplicate_lid, lids[lid1].logical_id, status);
          RETURN;
        IFEND;
      FOREND;
    FOREND;

  PROCEND get_logical_ids;
?? TITLE := '    OBTAIN_COMMON_NAD_PARAMS' ??
?? EJECT ??
  PROCEDURE obtain_common_nad_params (save_info: rft$config_utl_pointers;
                                  VAR nad_name: rft$component_name;
                                  VAR nad_address: rft$nad_address;
                                  VAR trunk_control_units: rft$trunk_control_units;
                                  VAR tcu_access_codes: rft$nad_access_codes;
                                  VAR status: ost$status);

{    The purpose of this procedure is to get the values of the common parameters for the
{    DEFINE_LOCAL_NAD and DEFINE_REMOTE_NAD configurtion directives.  This procedure assumes
{    that CLP$SCAN_PARAMETER_LIST prior to calling this procedure.
{
{    save_info: (input) This parameter contains the currently defined configuration
{      elements.
{
{    nad_name: (output) This parameter returns the name of the corresponding NAD.
{
{    nad_address: (output) This parameter returns the physical NAD address of the
{      corresponding NAD.
{
{    trunk_control_units: (output) This parameter returns the names of the trunks that
{      are physically attached to the corresponding NAD.
{
{    tcu_access_codes: (output) This parameter returns the access codes for each of the
{      defined trunks.
{
{    status: (output) This parameter value is NORMAL if all of the common parameters have
{      been successfully obtained.  Thus, none of the return parameters are valid if an
{      abnormal status is returned.

    VAR
        nad,
        address,
        trunk_control_unit,
        tcu_access_code: clt$value,
        the_parameter_is_specified: boolean,
        tcu_index: rfc$min_tcu .. rfc$max_tcu,
        matching_local_nad: ^rft$cu_local_nad_entry,
        matching_remote_nad: ^rft$cu_remote_nad_entry;

    {     Each NAD must be identified by a unique identifier.

    clp$get_value('nad', 1, 1, clc$low, nad, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    nad_name := nad.name.value(1,nad.name.size);
    IF  nad_name = keyword_all  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$all_is_not_a_legal_name, 'NAD', status);
      RETURN;
    IFEND;
    check_for_nad_name_match(nad_name, csm_both, save_info.local_nads, save_info.remote_nads,
      matching_local_nad, matching_remote_nad);
    IF  (matching_local_nad <> NIL)  OR  (matching_remote_nad <> NIL)  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$duplicate_component_name, nad_name, status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'NAD', status);
      RETURN;
    IFEND;

    clp$get_value('address', 1, 1, clc$low, address, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    nad_address := address.int.value;

    {   Obtaining the trunks connected to the corresponding trunk control units is a tedious
    {   repetitive process, which begs to be done in a FOR loop.  However, externalizing this
    {   as a list to the end user would not be very clean.

    clp$test_parameter('trunk_control_unit_0', the_parameter_is_specified, status);
    IF  the_parameter_is_specified  THEN
      clp$get_value('trunk_control_unit_0', 1, 1, clc$low, trunk_control_unit, status);
      IF  NOT status.normal  THEN
        RETURN;
      ELSE

        {  The Trunk Control Unit Access Code is only meaningful if a valid trunk is connected
        {  to the corresponding trunk control unit.

        clp$get_value('tcu_access_code_0', 1, 1, clc$low, tcu_access_code, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        trunk_control_units[rfc$min_tcu] :=
                                  trunk_control_unit.name.value(1,trunk_control_unit.name.size);
        tcu_access_codes[rfc$min_tcu] := tcu_access_code.int.value;
      IFEND;
    ELSE

      {  If a trunk is not attached to a trunk control unit the trunk name must be set to
      {  the NIL string to prevent erroneous operations when referencing this entity.

      trunk_control_units[rfc$min_tcu] := '';
    IFEND;

    clp$test_parameter('trunk_control_unit_1', the_parameter_is_specified, status);
    IF  the_parameter_is_specified  THEN
      clp$get_value('trunk_control_unit_1', 1, 1, clc$low, trunk_control_unit, status);
      IF  NOT status.normal  THEN
        RETURN;
      ELSE
        clp$get_value('tcu_access_code_1', 1, 1, clc$low, tcu_access_code, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        trunk_control_units[rfc$min_tcu + 1] :=
                                  trunk_control_unit.name.value(1,trunk_control_unit.name.size);
        tcu_access_codes[rfc$min_tcu + 1] := tcu_access_code.int.value;
      IFEND;
    ELSE
      trunk_control_units[rfc$min_tcu + 1] := '';
    IFEND;

    clp$test_parameter('trunk_control_unit_2', the_parameter_is_specified, status);
    IF  the_parameter_is_specified  THEN
      clp$get_value('trunk_control_unit_2', 1, 1, clc$low, trunk_control_unit, status);
      IF  NOT status.normal  THEN
        RETURN;
      ELSE
        clp$get_value('tcu_access_code_2', 1, 1, clc$low, tcu_access_code, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        trunk_control_units[rfc$min_tcu + 2] :=
                                  trunk_control_unit.name.value(1,trunk_control_unit.name.size);
        tcu_access_codes[rfc$min_tcu + 2] := tcu_access_code.int.value;
      IFEND;
    ELSE
      trunk_control_units[rfc$min_tcu + 2] := '';
    IFEND;

    clp$test_parameter('trunk_control_unit_3', the_parameter_is_specified, status);
    IF  the_parameter_is_specified  THEN
      clp$get_value('trunk_control_unit_3', 1, 1, clc$low, trunk_control_unit, status);
      IF  NOT status.normal  THEN
        RETURN;
      ELSE
        clp$get_value('tcu_access_code_3', 1, 1, clc$low, tcu_access_code, status);
        IF  NOT status.normal  THEN
          RETURN;
        IFEND;
        trunk_control_units[rfc$min_tcu + 3] :=
                                  trunk_control_unit.name.value(1,trunk_control_unit.name.size);
        tcu_access_codes[rfc$min_tcu + 3] := tcu_access_code.int.value;
      IFEND;
    ELSE
      trunk_control_units[rfc$min_tcu + 3] := '';
    IFEND;

    FOR  tcu_index := rfc$min_tcu  TO  rfc$max_tcu  DO
      IF  trunk_control_units[tcu_index] = keyword_all  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$all_is_not_a_legal_name, 'TRUNK CONTROL UNIT',
          status);
        RETURN;
      IFEND;
    FOREND;

  PROCEND obtain_common_nad_params;
?? TITLE := '    THE_TRUNK_IS_EXCLUDED' ??
?? EJECT ??
  FUNCTION the_trunk_is_excluded(excluded_trunk_list: ARRAY [*] OF rft$component_name;
                                 trunk_name: rft$component_name): BOOLEAN;

{
{    The purpose of this routine is to determine if the user has specified that a
{    trunk was not to be used for a specified path.  A value of TRUE is returned if the
{    specified trunk name is in the excluded trunk list.
{
{    excluded_trunk_list: (input) This parameter specifies an array of trunks that
{      are not eligible as candidates for this path definition.
{
{    trunk_name: (input) This parameter specifies the name of a trunk that is common
{      between the local NAD and the remote NAD that were specified in the path request.
{

    VAR
        index: integer;

    the_trunk_is_excluded := FALSE;
    FOR  index := LOWERBOUND(excluded_trunk_list)  TO  UPPERBOUND(excluded_trunk_list)  DO
      IF  trunk_name = excluded_trunk_list[index]  THEN
        the_trunk_is_excluded := TRUE;
        RETURN;
      IFEND;
    FOREND;

  FUNCEND the_trunk_is_excluded;
?? TITLE := '    RFP$OUTPUT_STATUS_MESSAGE' ??
?? EJECT ??
  PROCEDURE rfp$output_status_message (output_fid: amt$file_identifier;
                                       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.
{
{    status: (output) This parameter specifies whether or not the specified message was successfully
{      sent to the output file.
{
    CONST
        max_char_per_message_line = 72;
    VAR
        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, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    write_line('        ', output_fid, status);
    IF  NOT  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;
      write_line(message_line^(1,length_of_message_line^), output_fid, status);
      IF  NOT  status.normal  THEN
        RETURN;
      IFEND;
    FOREND;
    write_line('         ', output_fid, status);
  PROCEND rfp$output_status_message;
?? TITLE := '    CREATE_THE_STATUS_TABLE' ??
?? EJECT ??
  PROCEDURE create_the_status_table(VAR save_info: rft$config_utl_pointers;
                                    VAR config_file_created_status: ost$status;
                                    VAR status: ost$status);

{    The purpose of this procedure is to create the configuration file and move the
{    transformed configuration directives into the file.
{
{    The configuration file is a segment access file that is managed as a SEQUENCE.
{    The various configuration elements are arranged in element order as adaptable arrays.
{    The purpose of this scheme is so that the system task can allocate a HEAP of
{    space in the network paged section and move the configuration file definitions
{    into that heap.  This will preserve the locality of the definitions to
{    minimize any page faults while scanning through the configuration elements.
{    The adaptable arrays are used to further enhance the scanning performance.
{
{    save_info: (input) This parameter contains the information needed to build the
{      new configuration file.
{
{    config_file_created_status: (input,output) This parameter is used to maintain the status
{      of the new configuration file for recovery purposes.
{
{    status: (output) This parameter is set to NORMAL if the configuration file was successfully
{      created.

    VAR
        configuration_file_lfn: amt$local_file_name,
        unique_name: ost$unique_name,
        attachment_options: ^fst$attachment_options,
        configuration_fid: amt$file_identifier,
        status_table_ptr: ^SEQ(*),
        configuration_label : ^string(rfc$config_label_length),
        segment_ptr : amt$segment_pointer,
        ignore_status : ost$status;


    pmp$generate_unique_name(unique_name, ignore_status);
    configuration_file_lfn := unique_name.value;
    attach_configuration_file(configuration_file_lfn, rfc$configuration_file, status);
    IF NOT status.normal THEN
      create_configuration_file(configuration_file_lfn, rfc$configuration_file,
                              config_file_created_status, status);
      IF  NOT status.normal  THEN
        RETURN;
      IFEND;
    IFEND;

  /main_section/
    BEGIN
      PUSH  attachment_options : [1..3];
      attachment_options^[1].selector := fsc$access_and_share_modes;
      attachment_options^[1].access_modes.selector := fsc$specific_access_modes;
      attachment_options^[1].access_modes.value :=
        $fst$file_access_options[fsc$read, fsc$append, fsc$shorten];
      attachment_options^[1].share_modes.selector := fsc$determine_from_access_modes;
      attachment_options^[2].selector := fsc$create_file;
      attachment_options^[2].create_file := FALSE;
      attachment_options^[3].selector := fsc$open_position;
      attachment_options^[3].open_position := amc$open_at_boi;
      fsp$open_file(configuration_file_lfn, amc$segment, attachment_options, NIL, NIL,
        NIL, NIL, configuration_fid, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      amp$get_segment_pointer(configuration_fid, amc$sequence_pointer, segment_ptr, status);
      status_table_ptr := segment_ptr.sequence_pointer;
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      RESET status_table_ptr;

      {     Place the label in the configuration file.

      NEXT  configuration_label  IN  status_table_ptr;
      IF  configuration_label = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                status);
        EXIT /main_section/;
      IFEND;
      configuration_label^ := rfc$configuration_label;
      move_local_host_definition(save_info, status_table_ptr, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      move_remote_host_definitions(save_info, status_table_ptr, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      move_local_nad_definitions(save_info, status_table_ptr, status);
      IF  NOT status.normal  THEN
        EXIT /main_section/;
      IFEND;
      move_remote_nad_definitions(save_info, status_table_ptr, status);

    END /main_section/;

    IF  status.normal  THEN
      segment_ptr.kind := amc$sequence_pointer;
      segment_ptr.sequence_pointer := status_table_ptr;
      amp$set_segment_eoi(configuration_fid, segment_ptr, ignore_status);
    IFEND;
    fsp$close_file(configuration_fid, ignore_status);
    amp$return(configuration_file_lfn, ignore_status);

  PROCEND create_the_status_table;
?? NEWTITLE := '      MOVE_LOCAL_HOST_DEFINITION' ??
?? EJECT ??
  PROCEDURE move_local_host_definition(
                                   VAR save_info: rft$config_utl_pointers;
                                   VAR status_table_ptr: ^SEQ(*);
                                   VAR status: ost$status);

{    The purpose of this procedure is to move the local host definition from a
{    scratch segment into the configuration file.
{
{    save_info: (input) This parameter contains the pointer to the scratch segment, which
{      contains the interpreted configuration commands.
{
{    status_table_ptr: (input,output) This parameter contains the segment access pointer
{      to the configuration file.  This pointer is a sequence pointer and is updated
{      by this routine, as space is allocated within the sequence.
{
{    status: (output) This parameter specifies the results of the transfer.


    VAR
        index : integer,
        logical_id_count,
        path_count : ^integer,
        local_host_temp : ^rft$local_host_definition,
        local_host_paths : ^rft$lcn_paths;

    IF  NOT save_info.local_host_defined  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local host', status);
      RETURN;
    IFEND;
    NEXT logical_id_count  IN  status_table_ptr;
    IF  logical_id_count = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;
    logical_id_count^ := UPPERBOUND(save_info.local_host^.entry.logical_identifiers);
    NEXT  local_host_temp : [1..logical_id_count^] IN status_table_ptr;
    IF  local_host_temp = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;
    local_host_temp^ := save_info.local_host^.entry;

    NEXT path_count IN status_table_ptr;
    IF  path_count = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;
    path_count^ := save_info.local_host^.number_of_paths;
    IF  path_count^ <> 0  THEN
      NEXT  local_host_paths : [1..path_count^] IN status_table_ptr;
      IF  local_host_paths = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                status);
        RETURN;
      IFEND;
      FOR  index := 1  TO  path_count^  DO
        local_host_paths^[index] := save_info.local_host^.paths^.entry;
        save_info.local_host^.paths := save_info.local_host^.paths^.next_entry;
      FOREND;
    IFEND;
  PROCEND move_local_host_definition;
?? TITLE := '      MOVE_REMOTE_HOST_DEFINITIONS' ??
?? EJECT ??
  PROCEDURE move_remote_host_definitions(
                                     VAR save_info: rft$config_utl_pointers;
                                     VAR status_table_ptr: ^SEQ(*);
                                     VAR status: ost$status);
{    The purpose of this procedure is to move the remote hosts definition from a
{    scratch segment into the configuration file.
{
{    save_info: (input) This parameter contains the pointer to the scratch segment, which
{      contains the interpreted configuration commands.
{
{    status_table_ptr: (input,output) This parameter contains the segment access pointer
{      to the configuration file.  This pointer is a sequence pointer and is updated
{      by this routine, as space is allocated within the sequence.
{
{    status: (output) This parameter specifies the results of the transfer.


    VAR
        index : integer,
        path_count,
        server_count,
        logical_id_count : ^integer,
        number_of_remote_hosts : ^integer,
        host_count : rft$number_of_hosts,
        remote_host : ^rft$remote_host_definition,
        remote_host_paths : ^rft$lcn_paths;


    status.normal := TRUE;

    NEXT  number_of_remote_hosts  IN  status_table_ptr;
    IF  number_of_remote_hosts = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;
    number_of_remote_hosts^ := save_info.remote_host_count;
    IF  save_info.remote_host_count <> 0  THEN
      FOR  host_count := 1  TO  save_info.remote_host_count  DO
        NEXT logical_id_count  IN  status_table_ptr;
        IF  logical_id_count = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                  status);
          RETURN;
        IFEND;
        logical_id_count^ := UPPERBOUND(save_info.remote_hosts^.entry.logical_identifiers);
        NEXT  remote_host : [1..logical_id_count^] IN status_table_ptr;
        IF  remote_host = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                  status);
          RETURN;
        IFEND;
        remote_host^ := save_info.remote_hosts^.entry;
        NEXT  path_count  IN  status_table_ptr;
        IF  path_count = NIL  THEN
          osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                  status);
          RETURN;
        IFEND;
        path_count^ := save_info.remote_hosts^.number_of_paths;
        IF  path_count^ <> 0  THEN
          NEXT  remote_host_paths : [1..path_count^] IN status_table_ptr;
          IF  remote_host_paths = NIL  THEN
            osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                    status);
            RETURN;
          IFEND;
          FOR  index := 1  TO  path_count^  DO
            remote_host_paths^[index] := save_info.remote_hosts^.paths^.entry;
            save_info.remote_hosts^.paths := save_info.remote_hosts^.paths^.next_entry;
          FOREND;
        IFEND;
        save_info.remote_hosts := save_info.remote_hosts^.next_entry;
      FOREND;
    IFEND;
  PROCEND move_remote_host_definitions;
?? TITLE := '      MOVE_LOCAL_NAD_DEFINITIONS' ??
?? EJECT ??
  PROCEDURE move_local_nad_definitions(
                                   VAR save_info: rft$config_utl_pointers;
                                   VAR status_table_ptr: ^SEQ(*);
                                   VAR status: ost$status);

{    The purpose of this procedure is to move the local nad definitions from a
{    scratch segment into the configuration file.
{
{    save_info: (input) This parameter contains the pointer to the scratch segment, which
{      contains the interpreted configuration commands.
{
{    status_table_ptr: (input,output) This parameter contains the segment access pointer
{      to the configuration file.  This pointer is a sequence pointer and is updated
{      by this routine, as space is allocated within the sequence.
{
{    status: (output) This parameter specifies the results of the transfer.


    VAR
        nad_count : ^integer,
        index : integer,
        local_nad : ^rft$local_nad_table;


    IF  save_info.local_nad_count = 0  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$required_def_missing, 'local NAD', status);
      RETURN;
    IFEND;
    NEXT  nad_count  IN  status_table_ptr;
    IF  nad_count = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;
    nad_count^ := save_info.local_nad_count;
    NEXT  local_nad : [1..nad_count^] IN status_table_ptr;
    IF  local_nad = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;

    {     When moving the NADS into the adaptable array the original nad index must be preserved
    {     for the path entries to remain valid.

    FOR  index := 1  TO  nad_count^  DO
      local_nad^[save_info.local_nads^.index] := save_info.local_nads^.entry;
      save_info.local_nads := save_info.local_nads^.next_entry;
    FOREND;

  PROCEND move_local_nad_definitions;
?? TITLE := '      MOVE_REMOTE_NAD_DEFINITIONS' ??
?? EJECT ??
  PROCEDURE move_remote_nad_definitions(
                                    VAR save_info: rft$config_utl_pointers;
                                    VAR status_table_ptr: ^SEQ(*);
                                    VAR status: ost$status);

{    The purpose of this procedure is to move the remote nad definitions from a
{    scratch segment into the configuration file.
{
{    save_info: (input) This parameter contains the pointer to the scratch segment, which
{      contains the interpreted configuration commands.
{
{    status_table_ptr: (input,output) This parameter contains the segment access pointer
{      to the configuration file.  This pointer is a sequence pointer and is updated
{      by this routine, as space is allocated within the sequence.
{
{    status: (output) This parameter specifies the results of the transfer.


    VAR
        nad_count : ^integer,
        index : integer,
        remote_nad : ^rft$remote_nad_table;

    NEXT  nad_count  IN  status_table_ptr;
    IF  nad_count = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                              status);
      RETURN;
    IFEND;
    nad_count^ := save_info.remote_nad_count;
    IF  save_info.remote_nad_count <> 0  THEN
      NEXT  remote_nad : [1..nad_count^] IN status_table_ptr;
      IF  remote_nad = NIL  THEN
        osp$set_status_abnormal(rfc$product_id, rfe$configuration_overflow, 'status table SEQ',
                                status);
        RETURN;
      IFEND;

      {   When moving the remote NADs into the adaptable array, the original order must be preserved to
      {   allow the path entries to remain valid.

      FOR  index := 1  TO  nad_count^  DO
        remote_nad^[save_info.remote_nads^.index] := save_info.remote_nads^.entry;
        save_info.remote_nads := save_info.remote_nads^.next_entry;
      FOREND;
    IFEND;
  PROCEND move_remote_nad_definitions;
?? OLDTITLE ??
?? TITLE := '    ATTACH_CONFIGURATION_FILE' ??
?? EJECT ??
  PROCEDURE attach_configuration_file(file_lfn: amt$local_file_name;
                                      file_pfn : string(*);
                                  VAR status: ost$status);


    VAR
        cycle_number : pft$cycle_selector,
        password : pft$name,
        usage_selections : pft$usage_selections,
        share_mode : pft$share_selections,
        pfn : pft$name,
        file_path : ^pft$path;

    pfn := file_pfn;
    PUSH file_path : [1..4];
    file_path^[1] := rfc$rhfam_family_name;
    file_path^[2] := rfc$rhfam_master_catalog;
    file_path^[3] := rfc$rhfam_sub_catalog;
    file_path^[4] := pfn;
    cycle_number.cycle_option := pfc$highest_cycle;
    password := rfc$password;
    usage_selections := $pft$usage_selections[pfc$read, pfc$append, pfc$shorten];
    share_mode := $pft$share_selections[ ];
    pfp$attach(file_lfn, file_path^, cycle_number, password,
               usage_selections, share_mode, pfc$wait, status);

  PROCEND attach_configuration_file;
?? TITLE := '    COPY_CONFIGURATION_FILE' ??
?? EJECT ??
  PROCEDURE copy_configuration_file (   temporary_cmd_file : amt$local_file_name;
    VAR config_file_created_status: ost$status;
    VAR status: ost$status);

{    The purpose of this procedure is to create the configuration file and move the
{    transformed configuration directives into the file.
{
{    The configuration file is a segment access file that is managed as a SEQUENCE.
{    The various configuration elements are arranged in element order as adaptable arrays.
{    The purpose of this scheme is so that the system task can allocate a HEAP of
{    space in the network paged section and move the configuration file definitions
{    into that heap.  This will preserve the locality of the definitions to
{    minimize any page faults while scanning through the configuration elements.
{    The adaptable arrays are used to further enhance the scanning performance.
{
{    save_info: (input) This parameter contains the information needed to build the
{      new configuration file.
{
{    config_file_created_status: (input,output) This parameter is used to maintain the status
{      of the new configuration file for recovery purposes.
{
{    status: (output) This parameter is set to NORMAL if the configuration file was successfully
{      created.

    VAR
        configuration_cmd_file_lfn: amt$local_file_name,
        unique_name: ost$unique_name,
        ignore_status : ost$status;


    pmp$generate_unique_name(unique_name, ignore_status);
    configuration_cmd_file_lfn := unique_name.value;
    create_configuration_file(configuration_cmd_file_lfn, rfc$configuration_cmd_file,
                              config_file_created_status, status);
    IF  NOT status.normal  THEN
      RETURN;
    IFEND;
    attach_configuration_file (configuration_cmd_file_lfn,rfc$configuration_cmd_file, status);
    fsp$copy_file(temporary_cmd_file, configuration_cmd_file_lfn, NIL,
                                  NIL, NIL, status);

    amp$return(configuration_cmd_file_lfn, ignore_status);

  PROCEND copy_configuration_file;
?? TITLE := '    CREATE_CONFIGURATION_FILE' ??
?? EJECT ??
  PROCEDURE create_configuration_file(file_lfn: amt$local_file_name;
                                      file_pfn: string(*);
                                  VAR config_file_created_status: ost$status;
                                  VAR status: ost$status);

{    The purpose of this procedure is to create the file $SYSTEM.RHFAM.xxxxx
{    (where xxxxx is CONFIGURATION_FILE or CONFIGURATION_CMD_FILE)
{    If the sub-catalog RHFAM does not exist it will be created.  If a file specified
{    already exists a new cycle will be created.
{
{    NOTE - a site is required to manage the number of cycles of both the CONFIGURATION_FILE
{           and the CONFIGURATION_CMD_FILE.
{
{    file_lfn: (input) This parameter contains the local file name to attach the file with.
{
{    file_pfn: (input) This parameter contains the permanent file name of the file to be attached.
{
{    config_file_created_status: (input,output) This parameter is used to maintain the status
{      of the new configuration file for recovery purposes.
{
{    status: (output) A value of normal is returned if a new cycle of specified file
{      has been created and attached.

    VAR
        ignore_status: ost$status,
        cycle_number : pft$cycle_selector,
        password : pft$name,
        pfn : pft$name,
        catalog_path,
        file_path : ^pft$path;

    PUSH catalog_path : [1..3];
    catalog_path^[1] := rfc$rhfam_family_name;
    catalog_path^[2] := rfc$rhfam_master_catalog;
    catalog_path^[3] := rfc$rhfam_sub_catalog;
    pfp$define_catalog(catalog_path^, status);
    IF  (status.normal)  OR
        (status.condition = pfe$name_already_subcatalog)  OR
        (status.condition = pfe$not_master_catalog_owner)  THEN
      status.normal := TRUE;
      pfn := file_pfn;
      PUSH file_path : [1..4];
      file_path^[1] := rfc$rhfam_family_name;
      file_path^[2] := rfc$rhfam_master_catalog;
      file_path^[3] := rfc$rhfam_sub_catalog;
      file_path^[4] := pfn;
      password := rfc$password;
      cycle_number.cycle_option := pfc$highest_cycle;
      pfp$define(file_lfn, file_path^, cycle_number, password, pfc$maximum_retention,
                 pfc$no_log, config_file_created_status);
      IF  NOT config_file_created_status.normal  THEN
        status := config_file_created_status;
      IFEND;
    IFEND;

  PROCEND create_configuration_file;
?? TITLE := '    DELETE_CONFIGURATION_FILE' ??
?? EJECT ??
  PROCEDURE delete_configuration_file(file_pfn : string(*);
                                      cycle_to_delete : pft$cycle_options;
                                  VAR status: ost$status);

{    The purpose of this procedure is to delete the file $SYSTEM.RHFAM.xxxxx
{    (where xxxxx is CONFIGURATION_FILE or CONFIGURATION_CMD_FILE)
{    if an attempt to install an RHFAM configuration file has failed.  This removes the highest cycle,
{    which allows a previously installed configuration file to remain available to the system task for
{    activation.
{
{    file_pfn: (input) This parameter contains the permanent file name of the file to be attached.
{
{    status: (output) A value of normal is returned if the highest cycle of CONFIGURATION_FILE
{      has been deleted.

    VAR
        cycle_number : pft$cycle_selector,
        password : pft$name,
        pfn : pft$name,
        file_path : ^pft$path;

    pfn := file_pfn;
    PUSH file_path : [1..4];
    file_path^[1] := rfc$rhfam_family_name;
    file_path^[2] := rfc$rhfam_master_catalog;
    file_path^[3] := rfc$rhfam_sub_catalog;
    file_path^[4] := pfn;
    password := rfc$password;
    cycle_number.cycle_option := cycle_to_delete;
    pfp$purge(file_path^, cycle_number, password, status);
  PROCEND delete_configuration_file;
?? TITLE := '    WRITE_CMD_LINE' ??
?? EJECT ??
  PROCEDURE write_cmd_line (command : string(*);
                        command_text : string(*);
                        save_info : rft$config_utl_pointers;
                    VAR status : ost$status);
{
{      This procedure sends a string of characters to the command file.
{

    VAR
        byte_address : amt$file_byte_address,
        length  : integer,
        output_line : ^string (*);

    PUSH output_line :[STRLENGTH(command) + 1 + STRLENGTH(command_text)];
    stringrep (output_line^, length, command, ' ', command_text);
    amp$put_next(save_info.temporary_command_file_fid, output_line, length, byte_address, status);
  PROCEND write_cmd_line;
?? TITLE := '    WRITE_LINE' ??
?? EJECT ??
  PROCEDURE write_line (line_to_be_written_out : string(*);
                        output_fid: amt$file_identifier;
                    VAR status : ost$status);
{
{      This procedure sends a string of characters to the current output file (output_fid).
{

   VAR
        byte_address : amt$file_byte_address;

    amp$put_next(output_fid, #loc(line_to_be_written_out), strlength(line_to_be_written_out), byte_address,
                 status);
  PROCEND write_line;
?? OLDTITLE ??
?? OLDTITLE ??
MODEND rfm$configuration_utility;

