?? RIGHT := 110 ??
MODULE pfm$change_catalog_contents;
?? NEWTITLE := 'NOS/VE Permanent Files : CHANGE_CATALOG_CONTENTS Command Processor' ??
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parameter_list
*copyc fsc$local
*copyc fse$path_exception_conditions
*copyc fst$file_access_condition
*copyc fst$path_element_index
*copyc oft$display_message
*copyc osd$exception_policies
*copyc osd$integer_limits
*copyc ose$disk_ft_exceptions
*copyc oss$job_paged_literal
*copyc ost$status
*copyc ost$string
*copyc ost$user_identification
*copyc pfc$chacc_help_module_name
*copyc pfe$external_archive_conditions
?? POP ??
?? EJECT ??
*copyc amp$get_next
*copyc amp$return
*copyc amv$nil_file_identifier
*copyc avp$family_administrator
*copyc avp$system_administrator
*copyc clp$build_path_subtitle
*copyc clp$change_variable
*copyc clp$close_display
*copyc clp$convert_data_to_string
*copyc clp$convert_file_ref_to_string
*copyc clp$convert_integer_to_rjstring
*copyc clp$count_list_elements
*copyc clp$create_procedure_variable
*copyc clp$delete_variable
*copyc clp$evaluate_file_reference
*copyc clp$evaluate_parameters
*copyc clp$get_fs_path_elements
*copyc clp$get_value
*copyc clp$get_work_area
*copyc clp$horizontal_tab_display
*copyc clp$include_file
*copyc clp$make_file_value
*copyc clp$make_list_value
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_data_representation
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$trimmed_string_size
*copyc fsp$change_cycle_damage
*copyc fsp$convert_fs_structure_to_pf
*copyc fsp$open_file
*copyc fsp$path_element
*copyc i#current_sequence_position
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc ofp$display_status_message
*copyc osp$append_status_parameter
*copyc osp$chacc_applicable_policy
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$file_access_condition
*copyc osp$find_access_condition_entry
*copyc osp$find_applicable_policy
*copyc osp$find_help_module
*copyc osp$find_parameter_prompt
*copyc osp$format_help_message
*copyc osp$format_wait_message
*copyc osp$generate_log_message
*copyc osp$get_installed_policies
*copyc osp$get_login_user_criteria
*copyc osp$get_policy
*copyc osp$get_policy_list
*copyc osp$get_relevant_path_string
*copyc osp$get_union_of_policies
*copyc osp$remove_policy
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osv$task_shared_heap
*copyc pfp$check_archive_entries
*copyc pfp$convert_pft$path_to_fs_str
*copyc pfp$convert_pft$path_to_string
*copyc pfp$get_families_in_set
*copyc pfp$get_family_set
*copyc pfp$get_object_information
*copyc pfp$get_volumes_set_name
*copyc pfp$purge
*copyc pfp$r3_change
*copyc pfp$r3_get_object_information
*copyc pfp$r3_release_data
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pmp$get_family_names
*copyc pmp$get_unique_name
*copyc pmp$log_ascii
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    max_damage_string_size = 27,
    max_header_text_size = 7,
    max_exception_string_size = 19,
    max_files_per_command = 100,
    max_message_params = 9,
    minimum_line_size = path_column_number + osc$max_name_size + 3,
    path_column_number = 59,
    retrieve_files_command = 'RETRIEVE_FILES WAIT=NO FILES=(..';

  TYPE
    administrator_types = (family_administrator, system_administrator),

    blank_line_option = (blank_line_before, blank_line_before_and_after, blank_line_after,
          only_template_lines),

    boolean_values = (false_value, true_value),

    catalog_options = (co_all, co_policies, co_list),

    chacc_control_info = record
      criteria: ost$ecp_criteria,
      delete_damage_conditions: array [1 .. 1] of pft$change_descriptor,
      exception_policies: ^ost$ecp_header,
      family_sequence: ^SEQ ( * ),
      master_catalog_sequence: ^SEQ ( * ),
      message_parameters: array [1 .. max_message_params] of ^ost$message_parameter,
      message_templates: array [message_ordinals] of ^ost$message_template,
      object_list: ^chacc_object_list_entry,
      object_stats: chacc_statistics,
      output_info: clt$display_control,
      perform_changes: boolean,
      retrieve_info: chacc_retrieve_info,
      summary_count: ost$non_negative_integers,
      union_of_actions: ost$ecp_actions,
      union_of_policies: ost$ecp_policy_criteria,
    recend,

    chacc_object_list_entry = record
      file_reference: fst$path,
      object_kind: object_kind,
      number_of_path_elements: fst$path_element_index,
      next_object: ^chacc_object_list_entry,
    recend,

    chacc_retrieve_info = record
      display_info: clt$display_control,
      case automatic_retrieval: boolean of
      = TRUE =
        current_command_file_count: ost$non_negative_integers,
        include_file_info: clt$display_control,
        unique_file_name: fst$path,

      = FALSE =
        ,
      casend,
    recend,

    chacc_statistics = record
      busy_damaged_cycles: ost$non_negative_integers,
      damage_cleared: chacc_damage_statistics,
      delete_pending: ost$non_negative_integers,
      deleted: chacc_exception_statistics,
      objects_scanned: chacc_object_statistics,
      release_pending: ost$non_negative_integers,
      released_with_emi: chacc_exception_statistics,
      released_with_eni: chacc_exception_statistics,
    recend,

    chacc_damage_statistics = record
      media_image_inconsistent: ost$non_negative_integers,
      parent_catalog_restored: ost$non_negative_integers,
      respf_modification_mismatch: ost$non_negative_integers,
    recend,

    chacc_exception_statistics = record
      media_missing: ost$non_negative_integers,
      undefined_data: ost$non_negative_integers,
      volume_unavailable: ost$non_negative_integers,
    recend,

    chacc_object_statistics = record
      families: ost$non_negative_integers,
      master_catalogs: ost$non_negative_integers,
      subcatalogs: ost$non_negative_integers,
      files: ost$non_negative_integers,
      cycles: ost$non_negative_integers,
      maximum_catalog_nesting: ost$non_negative_integers,
      maximum_files_per_catalog: ost$non_negative_integers,
      maximum_cycles_per_file: ost$non_negative_integers,
    recend,

    damage_symptoms = (none, media_image_inconsistent, parent_catalog_restored, respf_modification_mismatch),

    exception_conditions = (media_missing, undefined_data, volume_unavailable),

    header_types = (actions, summary),

    message_ordinals = (mt#administrator_notes, mt#all_referenced, mt#applic_exception_policies,
          mt#busy_cycles_deleted, mt#busy_cycles_released, mt#busy_damaged_cycles, mt#cleared_condition,
          mt#conditions_cleared, mt#counts_by_condition, mt#cycle_busy_damage, mt#cycle_busy_delete,
          mt#cycle_busy_release, mt#cycles_deleted, mt#delete_option, mt#deleted_cycle,
          mt#emi_cycles_released, mt#enabled_matching_image, mt#enabled_nonmatching_image,
          mt#eni_cycles_released, mt#header_line, mt#login_users_applicable, mt#modification_dates_and_times,
          mt#no_changes, mt#object_error, mt#object_warning, mt#objects_scanned, mt#parameters, mt#path_part,
          mt#release_option, mt#set_damage_condition, mt#total_cycles_applicable, mt#total_cycles_released,
          mt#totals, mt#undefined_object, mt#unexpected_abnormal_status, mt#user_notes),

    object_kind = (catalog_object, family_object, file_object, set_object, volume_object);

?? OLDTITLE ??
?? NEWTITLE := 'Global Variables Declared by This Module', EJECT ??
?? FMT (FORMAT := OFF) ??
?? EJECT ??
    VAR
      administrator_names: [oss$job_paged_literal, READ] array [administrator_types] OF string (6) := [
            'FAMILY',
            'SYSTEM'],
      boolean_names: [oss$job_paged_literal, READ] array [boolean_values] OF string (5) := [
            'FALSE',
            'TRUE '],

      catalog_option_names: [oss$job_paged_literal, READ] array [catalog_options] OF string (27)
          := [
            'ALL                        ',
            'EXCEPTION_POLICY_REFERENCES',
            '"list of catalogs"         '],

      damage_symptom_names: [oss$job_paged_literal, READ] array [damage_symptoms] OF string
          (max_damage_string_size) := [
            'NONE                       ',
            'MEDIA_IMAGE_INCONSISTENT   ',
            'PARENT_CATALOG_RESTORED    ',
            'RESPF_MODIFICATION_MISMATCH'],

      exception_condition_names: [oss$job_paged_literal, READ] array [exception_conditions] OF string
          (max_exception_string_size) := [
            'MEDIA_MISSING      ',
            'UNDEFINED_DATA     ',
            'VOLUME_UNAVAILABLE '],

      header_text: [oss$job_paged_literal, READ] array [header_types] OF string
          (max_header_text_size) := [
            'Actions',
            'Summary'],

      initial_control_info: [oss$job_paged_literal, READ] chacc_control_info := [
            {criteria} *,
            {delete_damage_conditions} [[pfc$delete_damage_change, $fst$cycle_damage_symptoms[]]],
            {exception_policies} NIL,
            {family_sequence} NIL,
            {master_catalog_sequence} NIL,
            {message_parameters}*,
            {message_templates} *,
            {object_list} NIL,
            {object_stats} *,
            {output_info} *,
            {perform_changes} FALSE,
            {retrieve_info}[
               {retrieve_file_list_info} *,
               {automatic_retrieval} FALSE],
            {summary_count} 0,
            {union_of_actions} $ost$ecp_actions [],
            {union_of_policies} $ost$ecp_policy_criteria []],

      initial_damage_stats: [oss$job_paged_literal, READ] chacc_damage_statistics := [
            {media_image_inconsistent} 0,
            {parent_catalog_restored} 0,
            {respf_modification_mismatch} 0],

      initial_exception_stats: [oss$job_paged_literal, READ] chacc_exception_statistics := [
            {media_missing} 0,
            {undefined_data} 0,
            {volume_unavailable} 0],

      initial_object_stats: [oss$job_paged_literal, READ] chacc_object_statistics := [
            {families} 0,
            {master_catalogs} 0,
            {subcatalogs} 0,
            {files} 0,
            {cycles} 0,
            {maximum_catalog_nesting} 0,
            {maximum_files_per_catalog} 0,
            {maximum_cycles_per_file} 0],

      object_names: [oss$job_paged_literal, READ] array [object_kind] of string (7) :=
           [
            'Catalog',
            'Family ',
            'File   ',
            'Set    ',
            'Volume '],

      parameter_prompt_names: [oss$job_paged_literal, READ] array [message_ordinals] of pmt$program_name :=
           [
            'ADMINISTRATOR_NOTES            ',
            'ALL_REFERENCED                 ',
            'APPLICABLE_EXCEPTION_POLICIES  ',
            'BUSY_CYCLES_DELETED            ',
            'BUSY_CYCLES_RELEASED           ',
            'BUSY_DAMAGED_CYCLES            ',
            'CLEARED_CONDITION              ',
            'CONDITIONS_CLEARED             ',
            'COUNTS_BY_CONDITION            ',
            'CYCLE_BUSY_DAMAGE              ',
            'CYCLE_BUSY_DELETE              ',
            'CYCLE_BUSY_RELEASE             ',
            'CYCLES_DELETED                 ',
            'DELETE_OPTION                  ',
            'DELETED_CYCLE                  ',
            'EMI_CYCLES_RELEASED            ',
            'ENABLED_MATCHING_IMAGE         ',
            'ENABLED_NONMATCHING_IMAGE      ',
            'ENI_CYCLES_RELEASED            ',
            'HEADER_LINE                    ',
            'LOGIN_USERS_APPLICABLE         ',
            'MODIFICATION_DATES_AND_TIMES   ',
            'NO_CHANGES                     ',
            'OBJECT_ERROR                   ',
            'OBJECT_WARNING                 ',
            'OBJECTS_SCANNED                ',
            'PARAMETERS                     ',
            'PATH_PART                      ',
            'RELEASE_OPTION                 ',
            'SET_DAMAGE_CONDITION           ',
            'TOTAL_CYCLES_APPLICABLE        ',
            'TOTAL_CYCLES_RELEASED          ',
            'TOTALS                         ',
            'UNDEFINED_OBJECT               ',
            'UNEXPECTED_ABNORMAL_STATUS     ',
            'USER_NOTES                     '];
?? FMT (FORMAT := ON) ??
?? NEWTITLE := '[XDCL] pfp$change_catalog_contents_cmd ', EJECT ??

  PROCEDURE [XDCL] pfp$change_catalog_contents_cmd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? EJECT ??
{ Design:

{    This module is packaged in task services.  As a result, a new task is
{    not created each time the CHANGE_CATALOG_CONTENTS command is executed.
{    This implies that the command is responsible for closing all of its
{    files.  Thus extensive use of block-exit condition handling is
{    required.

{    Because condition handlers are executed asynchronously with respect to
{    the program, it is necessary for the program to #SPOIL any variable
{    used in both the program and the condition handler each time the
{    variable is updated by an assignment statement within the program.
{    Note that passing the variable as a VAR parameter does an automatic
{    #SPOIL.  This is why variables such as CONTROL_INFO are passed as VAR
{    parameters in most situations.

{    This command is implemented using recursive programming.  The variable
{    CONTROL_INFO contains control information which is common to all levels
{    of nesting within the program.  Do not add fields to this record to
{    define data which is temporary in nature (i.e.  not global to the
{    program); otherwise, the recursive nature of the program will create a
{    problem.

{    The recursion is performed in the procedure CHANGE_CATALOG.  Within
{    this procedure, files are processed first and then catalogs.  If you
{    change the order of processing, you will run into trouble because the
{    PATH information necessary to process cycles is stored in
{    CONTROL_INFO.CRITERIA.FILE which changes as one recurses.

{ Purpose:

{    The purpose of this procedure is to implement the
{    CHANGE_CATALOG_CONTENTS command.  This command is used by both a normal
{    user and FAMILY/SYSTEM administrators.  When a normal user uses this
{    command, he is limited to operating on files for which he has CONTROL
{    permission.  An administrator implicitly has CONTROL permission to
{    all files for which the administrator is responsible.

?? EJECT ??
{ PROCEDURE (osm$chacc) change_catalog_contents, chacc (
{   catalog, catalogs, c: (CHECK) any of
{       key
{         all
{         (exception_policy_references, epr)
{       keyend
{       list of file
{     anyend = exception_policy_references
{   delete_damage_condition, delete_damage_conditions, ddc: list of key
{       (media_image_inconsistent, mii)
{       (parent_catalog_restored, pcr)
{       (respf_modification_mismatch, rmm)
{     keyend = $optional
{   output, o: (BY_NAME) file = $output
{   perform_changes, pc: (BY_NAME) boolean = $confirm true
{   retrieve_files, rf: (BY_NAME) boolean = false
{   retrieve_file_list, rfl: (BY_NAME) file = $optional
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 15] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 3] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        default_value: string (27),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 6] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type5: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 10, 21, 14, 29, 55, 760],
    clc$command, 15, 7, 0, 0, 0, 0, 7, 'OSM$CHACC'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['CATALOG                        ',clc$nominal_entry, 1],
    ['CATALOGS                       ',clc$alias_entry, 1],
    ['DDC                            ',clc$abbreviation_entry, 2],
    ['DELETE_DAMAGE_CONDITION        ',clc$nominal_entry, 2],
    ['DELETE_DAMAGE_CONDITIONS       ',clc$alias_entry, 2],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['PC                             ',clc$abbreviation_entry, 4],
    ['PERFORM_CHANGES                ',clc$nominal_entry, 4],
    ['RETRIEVE_FILES                 ',clc$nominal_entry, 5],
    ['RETRIEVE_FILE_LIST             ',clc$nominal_entry, 6],
    ['RF                             ',clc$abbreviation_entry, 5],
    ['RFL                            ',clc$abbreviation_entry, 6],
    ['STATUS                         ',clc$nominal_entry, 7]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$extended_parameter_checking, 157,
  clc$optional_default_parameter, 0, 27],
{ PARAMETER 2
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 245,
  clc$optional_parameter, 0, 0],
{ PARAMETER 3
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 4
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$confirm_default_parameter, 0, 4],
{ PARAMETER 5
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 6
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 7
    [15, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    118, [[1, 0, clc$keyword_type], [3], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['EPR                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['EXCEPTION_POLICY_REFERENCES    ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$file_type]]
      ]
    ,
    'exception_policy_references'],
{ PARAMETER 2
    [[1, 0, clc$list_type], [229, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [6], [
      ['MEDIA_IMAGE_INCONSISTENT       ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['MII                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['PARENT_CATALOG_RESTORED        ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['PCR                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['RESPF_MODIFICATION_MISMATCH    ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['RMM                            ', clc$abbreviation_entry, clc$normal_usage_entry, 3]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 4
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 5
    [[1, 0, clc$boolean_type],
    'false'],
{ PARAMETER 6
    [[1, 0, clc$file_type]],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$catalog = 1,
      p$delete_damage_condition = 2,
      p$output = 3,
      p$perform_changes = 4,
      p$retrieve_files = 5,
      p$retrieve_file_list = 6,
      p$status = 7;

    VAR
      pvt: array [1 .. 7] of clt$parameter_value;


    VAR
      current_object: ^chacc_object_list_entry,
      exception_actions: ost$ecp_actions,
      ignore_status: ost$status,
      control_info: chacc_control_info;

?? NEWTITLE := 'add_one', EJECT ??

    PROCEDURE [INLINE] add_one
      (VAR integer_value {input, output} : ost$non_negative_integers);

      integer_value := integer_value + 1;

    PROCEND add_one;
?? OLDTITLE ??
?? NEWTITLE := 'allocate_catalog_segments', EJECT ??

    PROCEDURE allocate_catalog_segments;

      VAR
        segment_pointer: amt$segment_pointer;

      segment_pointer.kind := amc$sequence_pointer;

      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
      IF status.normal THEN
        control_info.family_sequence := segment_pointer.sequence_pointer;
        #SPOIL (control_info);

        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF status.normal THEN
          control_info.master_catalog_sequence := segment_pointer.sequence_pointer;
          #SPOIL (control_info);
        IFEND;
      IFEND;

      IF NOT status.normal THEN
        EXIT pfp$change_catalog_contents_cmd;
      IFEND;
    PROCEND allocate_catalog_segments;
?? OLDTITLE ??
?? NEWTITLE := 'chacc_cmd_block_exit_handler', EJECT ??

    PROCEDURE chacc_cmd_block_exit_handler
      (    condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status,
        segment_pointer: amt$segment_pointer;

      IF control_info.exception_policies <> NIL THEN
        segment_pointer.kind := amc$cell_pointer;
        segment_pointer.cell_pointer := control_info.exception_policies;
        mmp$delete_scratch_segment (segment_pointer, ignore_status);
        control_info.exception_policies := NIL;
        #SPOIL (control_info);
      IFEND;

      IF control_info.family_sequence <> NIL THEN
        segment_pointer.kind := amc$cell_pointer;
        segment_pointer.cell_pointer := control_info.family_sequence;
        mmp$delete_scratch_segment (segment_pointer, ignore_status);
        control_info.family_sequence := NIL;
        #SPOIL (control_info);
      IFEND;

      IF control_info.master_catalog_sequence <> NIL THEN
        segment_pointer.kind := amc$cell_pointer;
        segment_pointer.cell_pointer := control_info.master_catalog_sequence;
        mmp$delete_scratch_segment (segment_pointer, ignore_status);
        control_info.master_catalog_sequence := NIL;
        #SPOIL (control_info);
      IFEND;

      IF control_info.object_list <> NIL THEN
        segment_pointer.kind := amc$cell_pointer;
        segment_pointer.cell_pointer := control_info.object_list;
        mmp$delete_scratch_segment (segment_pointer, ignore_status);
        control_info.object_list := NIL;
        #SPOIL (control_info);
      IFEND;

      IF control_info.output_info.file_id <> amv$nil_file_identifier THEN
        clp$close_display (control_info.output_info, ignore_status);
        control_info.output_info.file_id := amv$nil_file_identifier;
        #SPOIL (control_info);
      IFEND;

      IF control_info.retrieve_info.display_info.file_id <> amv$nil_file_identifier THEN
        clp$close_display (control_info.retrieve_info.display_info, ignore_status);
        control_info.retrieve_info.display_info.file_id := amv$nil_file_identifier;
        #SPOIL (control_info);
      IFEND;

      IF control_info.retrieve_info.automatic_retrieval THEN
        IF control_info.retrieve_info.unique_file_name <> '' THEN
          amp$return (control_info.retrieve_info.unique_file_name, ignore_status);
          control_info.retrieve_info.unique_file_name := '';
          #SPOIL (control_info);
        IFEND;
      IFEND;

    PROCEND chacc_cmd_block_exit_handler;

?? OLDTITLE ??
?? NEWTITLE := 'change_catalog_contents', EJECT ??



    PROCEDURE change_catalog_contents;

      VAR
        current_object: ^chacc_object_list_entry,
        totals: chacc_statistics;

?? NEWTITLE := 'accumulate_statistics', EJECT ??

      PROCEDURE accumulate_statistics;

?? NEWTITLE := 'accumulate_damage_stats', EJECT ??

        PROCEDURE accumulate_damage_stats
          (    add_damaged: chacc_damage_statistics;
           VAR total_damaged: chacc_damage_statistics);

          total_damaged.media_image_inconsistent := total_damaged.media_image_inconsistent +
                add_damaged.media_image_inconsistent;

          total_damaged.parent_catalog_restored := total_damaged.parent_catalog_restored +
                add_damaged.parent_catalog_restored;

          total_damaged.respf_modification_mismatch := total_damaged.respf_modification_mismatch +
                add_damaged.respf_modification_mismatch;

        PROCEND accumulate_damage_stats;
?? OLDTITLE ??
?? NEWTITLE := 'accumulate_exception_stats', EJECT ??

        PROCEDURE accumulate_exception_stats
          (    add_exceptions: chacc_exception_statistics;
           VAR total_exceptions: chacc_exception_statistics);

          total_exceptions.media_missing := total_exceptions.media_missing + add_exceptions.media_missing;

          total_exceptions.undefined_data := total_exceptions.undefined_data + add_exceptions.undefined_data;

          total_exceptions.volume_unavailable := total_exceptions.volume_unavailable +
                add_exceptions.volume_unavailable;

        PROCEND accumulate_exception_stats;
?? OLDTITLE ??
?? NEWTITLE := 'accumulate_objects_scanned', EJECT ??

        PROCEDURE accumulate_objects_scanned
          (    subtotal_scanned: chacc_object_statistics;
           VAR total_scanned: chacc_object_statistics);

          total_scanned.families := total_scanned.families + subtotal_scanned.families;
          total_scanned.master_catalogs := total_scanned.master_catalogs + subtotal_scanned.master_catalogs;
          total_scanned.subcatalogs := total_scanned.subcatalogs + subtotal_scanned.subcatalogs;
          total_scanned.files := total_scanned.files + subtotal_scanned.files;
          total_scanned.cycles := total_scanned.cycles + subtotal_scanned.cycles;

          IF total_scanned.maximum_catalog_nesting < subtotal_scanned.maximum_catalog_nesting THEN
            total_scanned.maximum_catalog_nesting := subtotal_scanned.maximum_catalog_nesting;
          IFEND;

          IF total_scanned.maximum_files_per_catalog < subtotal_scanned.maximum_files_per_catalog THEN
            total_scanned.maximum_files_per_catalog := subtotal_scanned.maximum_files_per_catalog;
          IFEND;

          IF total_scanned.maximum_cycles_per_file < subtotal_scanned.maximum_cycles_per_file THEN
            total_scanned.maximum_cycles_per_file := subtotal_scanned.maximum_cycles_per_file;
          IFEND;

        PROCEND accumulate_objects_scanned;
?? OLDTITLE ??
?? EJECT ??

        totals.busy_damaged_cycles := totals.busy_damaged_cycles +
              control_info.object_stats.busy_damaged_cycles;

        accumulate_damage_stats (control_info.object_stats.damage_cleared, totals.damage_cleared);

        totals.delete_pending := totals.delete_pending + control_info.object_stats.delete_pending;

        accumulate_exception_stats (control_info.object_stats.deleted, totals.deleted);

        accumulate_exception_stats (control_info.object_stats.released_with_emi, totals.released_with_emi);

        accumulate_exception_stats (control_info.object_stats.released_with_eni, totals.released_with_eni);

        totals.release_pending := totals.release_pending + control_info.object_stats.release_pending;

        accumulate_objects_scanned (control_info.object_stats.objects_scanned, totals.objects_scanned);

        #SPOIL (totals);

      PROCEND accumulate_statistics;
?? OLDTITLE ??
?? NEWTITLE := 'build_file_reference ', EJECT ??

      PROCEDURE [INLINE] build_file_reference
        (    input_path: fst$file_reference;
             next_node: pft$name;
         VAR path: string ( * <= fsc$max_path_size);
         VAR path_size: integer);

        STRINGREP (path, path_size, input_path, '.', next_node (1, clp$trimmed_string_size (next_node)));
        path (path_size + 1, * ) := ' ';

      PROCEND build_file_reference;
?? OLDTITLE ??
?? NEWTITLE := 'chacc_block_exit_handler', EJECT ??

      PROCEDURE chacc_block_exit_handler
        (    condition: pmt$condition;
             ignore_condition_information: ^pmt$condition_information;
             ignore_save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);

        VAR
          ignore_status: ost$status,
          segment_pointer: amt$segment_pointer;

        IF control_info.output_info.file_id <> amv$nil_file_identifier THEN
          terminate_chacc ({normal_termination} FALSE);
        IFEND;

      PROCEND chacc_block_exit_handler;

?? OLDTITLE ??
?? NEWTITLE := 'change_catalog ', EJECT ??

      PROCEDURE change_catalog
        (    catalog_reference: ^fst$file_reference;
             catalog_depth: fst$path_element_index;
         VAR control_info: chacc_control_info);

        VAR
          actions: ost$ecp_actions,
          change_index: ost$non_negative_integers,
          cycle_damage_symptoms: fst$cycle_damage_symptoms,
          cycle_entry: ost$non_negative_integers,
          cycle_selector: pft$cycle_selector,
          delete_damage_condition: boolean,
          data_released: boolean,
          file_entry: ost$positive_integers,
          file_access_condition: fst$file_access_condition,
          ignore_status: ost$status,
          include_volume: boolean,
          index: integer,
          object_list: ^fst$goi_object_list,
          path_size: integer,
          p_new_path: ^pft$path,
          p_release_data_info: ^pft$release_data_info;

?? NEWTITLE := 'build_path ', EJECT ??

        PROCEDURE build_path
          (    file: ^fst$file_reference;
           VAR path: ^pft$path);

          VAR
            evaluated_file_reference: fst$evaluated_file_reference;

          clp$evaluate_file_reference (file^, $clt$file_ref_parsing_options [], FALSE,
                evaluated_file_reference, status);

          IF status.normal THEN
            fsp$convert_fs_structure_to_pf (evaluated_file_reference, path);
          ELSE
            EXIT pfp$change_catalog_contents_cmd;
          IFEND;
        PROCEND build_path;

?? OLDTITLE ??
?? NEWTITLE := 'display_file_action', EJECT ??

        PROCEDURE display_file_action
          (    cycle_number: fst$cycle_number,
               message_template: ^ost$message_template;
               text: string ( * <= max_damage_string_size);
           VAR control_info: chacc_control_info);

          VAR
            cycle_string: string (4),
            i: 0 .. fsc$max_path_elements,
            ignore_status: ost$status,
            length: integer,
            local_message_template: ^ost$message_template,
            chunk_count: 0 .. fsc$max_path_elements,
            cycle_reference: fst$path,
            display_chunks: clt$path_display_chunks,
            suffix: string (2);

          initialize_message_parameters;

          cycle_reference := control_info.criteria.file (1, path_size);
          STRINGREP (cycle_string, length, cycle_number);

          IF (path_size + length) <= fsc$max_path_size THEN
            STRINGREP (cycle_reference, length, control_info.criteria.file (1, path_size),
                  cycle_string (1, length));
            cycle_reference (path_size + 1, 1) := '.';
          IFEND;

          clp$build_path_subtitle (cycle_reference, length, control_info.output_info.page_width -
                path_column_number, chunk_count, display_chunks);

          local_message_template := message_template;
          control_info.message_parameters [1] := ^text;

          FOR i := 1 TO chunk_count DO
            control_info.message_parameters [2] := ^cycle_reference
                  (display_chunks [i].position, display_chunks [i].length);
            IF i = chunk_count THEN
              suffix := '';
            ELSE
              suffix := '..';
            IFEND;
            control_info.message_parameters [3] := ^suffix;

            format_and_output_lines (only_template_lines, local_message_template, control_info);
            local_message_template := control_info.message_templates [mt#path_part];
          FOREND;

        PROCEND display_file_action;
?? OLDTITLE ??
?? NEWTITLE := 'get_applicable_policy', EJECT ??

        PROCEDURE get_applicable_policy
          (VAR applicable_actions: ost$ecp_actions);

          VAR
            ignore_applicable_policy: ^ost$ecp_policy_header,
            ignore_wait: boolean,
            local_actions: ost$ecp_actions,
            local_status: ost$status,
            access_condition_entry: fst$access_condition_entry,
            cycle_reference: fst$path,
            cycle_string: string (4),
            entry_found: boolean,
            length: integer,
            wait_message: oft$display_message;

          applicable_actions := $ost$ecp_actions [];

          CASE file_access_condition OF
          = fsc$data_restoration_required, fsc$media_missing, fsc$volume_unavailable =
            control_info.criteria.condition := file_access_condition;
            control_info.criteria.family_path_name := p_new_path^ [pfc$family_name_index];

            IF avp$system_administrator () OR avp$family_administrator () THEN
              control_info.criteria.login_family := p_new_path^ [pfc$family_name_index];
              control_info.criteria.login_user := p_new_path^ [pfc$master_catalog_name_index];
            IFEND;

            IF file_access_condition <> fsc$data_restoration_required THEN
              control_info.criteria.mass_storage_class := cycle_list^ [cycle_entry].cycle_device_information^.
                    mass_storage_device_info.mass_storage_class;
              control_info.criteria.volume_list := cycle_list^ [cycle_entry].cycle_device_information^.
                    mass_storage_device_info.volume_list;
            IFEND;

            osp$find_applicable_policy (control_info.criteria, control_info.exception_policies, local_actions,
                  ignore_applicable_policy, local_status);
            IF local_status.normal THEN
              applicable_actions := local_actions;
              osp$find_access_condition_entry (file_access_condition, access_condition_entry, entry_found);
              IF entry_found THEN
                cycle_reference := control_info.criteria.file (1, path_size);
                STRINGREP (cycle_string, length, cycle_selector.cycle_number);

                IF (path_size + length) <= fsc$max_path_size THEN
                  STRINGREP (cycle_reference, length, control_info.criteria.file (1, path_size),
                        cycle_string (1, length));
                  cycle_reference (path_size + 1, 1) := '.';
                IFEND;
                osp$format_wait_message (^access_condition_entry, ^control_info.criteria.file,
                      control_info.criteria.mass_storage_class, cycle_list^ [cycle_entry].
                      cycle_device_information^.mass_storage_device_info.volume_condition_list,
                      control_info.criteria.volume_list, wait_message);
              IFEND;
            IFEND;
          ELSE
          CASEND;

        PROCEND get_applicable_policy;
?? OLDTITLE ??


?? NEWTITLE := 'remove_damage_condition', EJECT ??

      PROCEDURE remove_damage_condition;

        VAR
          delete_damage_conditions: ^array [1 .. 1] of pft$change_descriptor;

        PUSH delete_damage_conditions;

        delete_damage_conditions^ [1].change_type := pfc$delete_damage_change;

        delete_damage_conditions^ [1].delete_damage_condition :=
              $fst$cycle_damage_symptoms [fsc$respf_modification_mismatch];

        pfp$r3_change (p_new_path^, cycle_selector, object_list^ [file_entry].password,
              delete_damage_conditions^, local_status);

      PROCEND remove_damage_condition;
?? OLDTITLE ??
?? NEWTITLE := 'report_busy_change', EJECT ??

        PROCEDURE report_busy_change;

          add_one (control_info.object_stats.busy_damaged_cycles);

          display_file_action (cycle_selector.cycle_number, control_info.
                message_templates [mt#cycle_busy_damage], '', control_info);

        PROCEND report_busy_change;
?? OLDTITLE ??
?? NEWTITLE := 'report_damage_deletion', EJECT ??

        PROCEDURE report_damage_deletion
            (    mmi_present: boolean);

          IF mmi_present THEN
            add_one (control_info.object_stats.damage_cleared.media_image_inconsistent);
            #SPOIL (control_info);
?? FMT (FORMAT := OFF) ??
            display_file_action (cycle_selector.cycle_number,
                  control_info.message_templates [mt#cleared_condition],
                  damage_symptom_names [media_image_inconsistent], control_info);
?? FMT (FORMAT := ON) ??
          IFEND;

          IF (fsc$parent_catalog_restored IN cycle_list^ [cycle_entry].cycle_information^.damage_symptoms) AND
                (fsc$parent_catalog_restored IN control_info.delete_damage_conditions [1].
                delete_damage_condition) THEN
            add_one (control_info.object_stats.damage_cleared.parent_catalog_restored);
            #SPOIL (control_info);
?? FMT (FORMAT := OFF) ??
            display_file_action (cycle_selector.cycle_number,
                  control_info.message_templates [mt#cleared_condition],
                  damage_symptom_names [parent_catalog_restored], control_info);
?? FMT (FORMAT := ON) ??
          IFEND;

          IF (fsc$respf_modification_mismatch IN cycle_list^ [cycle_entry].cycle_information^.
                damage_symptoms) AND (fsc$respf_modification_mismatch IN
                control_info.delete_damage_conditions [1].delete_damage_condition) THEN
            add_one (control_info.object_stats.damage_cleared.respf_modification_mismatch);
            #SPOIL (control_info);
            display_file_action (cycle_selector.cycle_number, control_info.
                  message_templates [mt#cleared_condition], damage_symptom_names
                  [respf_modification_mismatch], control_info);
          IFEND;

        PROCEND report_damage_deletion;

?? OLDTITLE ??
?? NEWTITLE := 'report_delete', EJECT ??

        PROCEDURE report_delete;

          VAR
            text: string (max_exception_string_size);

          update_exception_statistic (file_access_condition, control_info.object_stats.deleted, text);

          display_file_action (cycle_selector.cycle_number, control_info.message_templates [mt#deleted_cycle],
                text, control_info);

          IF cycle_list^ [cycle_entry].cycle_information^.outstanding_access_modes <> $pft$usage_selections
                [] THEN
            text := exception_condition_names [volume_unavailable];
            add_one (control_info.object_stats.release_pending);

            display_file_action (cycle_selector.cycle_number, control_info.
                  message_templates [mt#cycle_busy_delete], text, control_info);
          IFEND;

        PROCEND report_delete;
?? OLDTITLE ??
?? NEWTITLE := 'report_release', EJECT ??

        PROCEDURE report_release;

?? NEWTITLE := 'add_file_to_command', EJECT ??

          PROCEDURE add_file_to_command;

            VAR
              length: integer,
              line: string (fsc$max_path_size + 3) {for ' ..'} ;

            IF control_info.retrieve_info.current_command_file_count = max_files_per_command THEN
              clp$put_display (control_info.retrieve_info.include_file_info, ')', clc$no_trim, status);
              control_info.retrieve_info.current_command_file_count := 0;
              #SPOIL (control_info);
            IFEND;

            IF status.normal THEN
              IF (control_info.retrieve_info.current_command_file_count = 0) THEN
                clp$put_display (control_info.retrieve_info.include_file_info, retrieve_files_command,
                      clc$no_trim, status);
              IFEND;
              IF status.normal THEN
                STRINGREP (line, length, control_info.criteria.file (1, path_size), ' ..');
                clp$put_display (control_info.retrieve_info.include_file_info, line (1, length),
                      clc$no_trim, status);
              IFEND;
            IFEND;

            IF status.normal THEN
              add_one (control_info.retrieve_info.current_command_file_count);
              #SPOIL (control_info);
            ELSE
              EXIT pfp$change_catalog_contents_cmd;
            IFEND;

          PROCEND add_file_to_command;
?? OLDTITLE ??
?? NEWTITLE := 'convert_date_time', EJECT ??

          PROCEDURE convert_date_time
            (    date_time: ost$date_time;
             VAR str: ost$string);

            VAR
              date: ost$date,
              local_status: ost$status,
              time: ost$time;

            IF (date_time.year >= UPPERVALUE (date_time.year)) AND
                  (date_time.month >= UPPERVALUE (date_time.month)) AND
                  (date_time.day >= UPPERVALUE (date_time.day)) AND
                  (date_time.hour >= UPPERVALUE (date_time.hour)) AND
                  (date_time.minute >= UPPERVALUE (date_time.minute)) AND
                  (date_time.second >= UPPERVALUE (date_time.second)) AND
                  (date_time.millisecond >= UPPERVALUE (date_time.millisecond)) THEN
              str.size := 4;
              str.value := 'NONE';
              RETURN;
            IFEND;

            pmp$format_compact_date (date_time, osc$iso_date, date, local_status);
            IF local_status.normal THEN
              str.size := STRLENGTH (date.iso);
              str.value (1, str.size) := date.iso;
            ELSE
              str.size := 10;
              str.value (1, 10) := '????-??-??';
            IFEND;

            str.value (str.size + 1) := ' ';
            pmp$format_compact_time (date_time, osc$millisecond_time, time, local_status);
            IF local_status.normal THEN
              str.value (str.size + 2, STRLENGTH (time.millisecond)) := time.millisecond;
              str.size := str.size + 1 + STRLENGTH (time.millisecond);
            ELSE
              str.value (str.size + 2, 12) := '??:??:??.???';
              str.size := str.size + 1 + 12;
            IFEND;

          PROCEND convert_date_time;
?? OLDTITLE ??
?? EJECT ??

          VAR
            evaluated_file_reference: fst$evaluated_file_reference,
            new_date_string: ost$string,
            old_date_string: ost$string,
            text: string (max_exception_string_size);

          IF p_release_data_info^.valid_archive_entry_found THEN
            update_exception_statistic (file_access_condition, control_info.object_stats.released_with_emi,
                  text);
            display_file_action (cycle_selector.cycle_number, control_info.
                  message_templates [mt#enabled_matching_image], text, control_info);
          ELSE
            update_exception_statistic (file_access_condition, control_info.object_stats.released_with_eni,
                  text);
?? FMT (FORMAT := OFF) ??
            display_file_action (cycle_selector.cycle_number,
                  control_info.message_templates [mt#enabled_nonmatching_image], text, control_info);
?? FMT (FORMAT := ON) ??

            convert_date_time (p_release_data_info^.old_data_modification_date_time, old_date_string);
            convert_date_time (p_release_data_info^.new_data_modification_date_time, new_date_string);
            control_info.message_parameters [1] := ^old_date_string.value (1, old_date_string.size);
            control_info.message_parameters [2] := ^new_date_string.value (1, new_date_string.size);

            format_and_output_lines (only_template_lines, control_info.
                  message_templates [mt#modification_dates_and_times], control_info);
          IFEND;

          IF p_release_data_info^.cycle_attached THEN
            text := exception_condition_names [volume_unavailable];
            add_one (control_info.object_stats.release_pending);

            display_file_action (cycle_selector.cycle_number, control_info.
                  message_templates [mt#cycle_busy_release], text, control_info);
          IFEND;

          IF control_info.retrieve_info.display_info.file_id <> amv$nil_file_identifier THEN
            clp$put_display (control_info.retrieve_info.display_info, control_info.criteria.
                  file (1, path_size), clc$no_trim, status);
            IF status.normal AND control_info.retrieve_info.automatic_retrieval THEN
              add_file_to_command;
            IFEND;
          IFEND;

          IF NOT status.normal THEN
            EXIT pfp$change_catalog_contents_cmd;
          IFEND;

        PROCEND report_release;
?? OLDTITLE ??
?? NEWTITLE := 'report_damage_setting', EJECT ??

      PROCEDURE report_damage_setting;

        format_and_output_lines (only_template_lines, control_info.
              message_templates [mt#set_damage_condition], control_info);

      PROCEND report_damage_setting;
?? OLDTITLE ??
?? NEWTITLE := 'update_exception_statistic', EJECT ??

        PROCEDURE update_exception_statistic
          (    file_access_condition: fst$file_access_condition;
           VAR exception_statistic: chacc_exception_statistics;
           VAR text: string (max_exception_string_size));

          CASE file_access_condition OF

          = fsc$data_restoration_required =
            text := exception_condition_names [undefined_data];
            add_one (exception_statistic.undefined_data);

          = fsc$media_missing =
            text := exception_condition_names [media_missing];
            add_one (exception_statistic.media_missing);

          = fsc$volume_unavailable =
            text := exception_condition_names [volume_unavailable];
            add_one (exception_statistic.volume_unavailable);
          ELSE
          CASEND;

        PROCEND update_exception_statistic;
?? OLDTITLE ??
?? EJECT ??

        CONST
          message_prefix = 'CHACC',
          message_prefix_size = 5;

        VAR
          catalog: ost$positive_integers,
          cycle_count: ost$positive_integers,
          cycle_list: ^fst$goi_object_list,
          file_count: ost$positive_integers,
          header: ^fst$goi_object_information,
          information_request: fst$goi_information_request,
          local_status: ost$status,
          mmi_present: boolean,
          next_catalog_object: ^SEQ ( * ),
          path: ^fst$path,
          relevant_path_size: fst$path_size,
          switch: 0 .. 4,
          wait_message: oft$display_message;

        CASE catalog_depth OF
        = 1 =
          add_one (control_info.object_stats.objects_scanned.families);
        = 2 =
          add_one (control_info.object_stats.objects_scanned.master_catalogs);
        ELSE
          add_one (control_info.object_stats.objects_scanned.subcatalogs);
        CASEND;

        IF control_info.object_stats.objects_scanned.maximum_catalog_nesting < catalog_depth THEN
          control_info.object_stats.objects_scanned.maximum_catalog_nesting := catalog_depth;
        IFEND;
        #SPOIL (control_info);

        information_request.catalog_depth.depth_specification := fsc$specific_depth;
        information_request.catalog_depth.depth := 1;
        information_request.object_information_requests := $fst$goi_object_info_requests
              [fsc$goi_catalog_object_list, fsc$goi_file_object_list, fsc$goi_cycle_object_list,
              fsc$goi_cycle_info, fsc$goi_cycle_device_info, fsc$goi_set_name];

        next_catalog_object := control_info.master_catalog_sequence;
        pfp$get_object_information (catalog_reference^, information_request, {validation_criteria} NIL,
              control_info.master_catalog_sequence, local_status);
        IF local_status.normal THEN
          NEXT header IN next_catalog_object;
          IF header <> NIL THEN
            IF (header^.object <> NIL) AND (header^.object^.object_type = fsc$goi_catalog_object) AND
                  (header^.object^.subcatalog_and_file_object_list <> NIL) THEN
              control_info.criteria.set_name := header^.set_name;

              object_list := header^.object^.subcatalog_and_file_object_list;

              file_count := (UPPERBOUND (object_list^) - LOWERBOUND (object_list^)) + 1;
              IF control_info.object_stats.objects_scanned.maximum_files_per_catalog < file_count THEN
                control_info.object_stats.objects_scanned.maximum_files_per_catalog := file_count;
              IFEND;
              #SPOIL (control_info);

            /file_object_loop/
              FOR file_entry := LOWERBOUND (object_list^) TO UPPERBOUND (object_list^) DO
                IF (object_list^ [file_entry].object_type = fsc$goi_file_object) AND
                      (object_list^ [file_entry].cycle_object_list <> NIL) THEN
                  add_one (control_info.object_stats.objects_scanned.files);
                  #SPOIL (control_info);

                  build_file_reference (header^.resolved_path^, object_list^ [file_entry].file_name,
                        control_info.criteria.file, path_size);

                  IF (control_info.object_stats.objects_scanned.files MOD 100) = 0 THEN
                    wait_message.text := message_prefix;
                    osp$get_relevant_path_string (control_info.criteria.file, wait_message.
                          text (message_prefix_size + 2, * ), relevant_path_size);
                    wait_message.size := message_prefix_size + relevant_path_size + 1;
                    ofp$display_status_message (wait_message.text (1, wait_message.size), ignore_status);

                  IFEND;

                  PUSH p_new_path: [1 .. catalog_depth + 1];
                  build_path (^control_info.criteria.file (1, path_size), p_new_path);

                  cycle_list := object_list^ [file_entry].cycle_object_list;
                  cycle_count := (UPPERBOUND (cycle_list^) - LOWERBOUND (cycle_list^)) + 1;
                  control_info.object_stats.objects_scanned.cycles :=
                        control_info.object_stats.objects_scanned.cycles + cycle_count;
                  #SPOIL (control_info);

                  IF control_info.object_stats.objects_scanned.maximum_cycles_per_file < cycle_count THEN
                    control_info.object_stats.objects_scanned.maximum_cycles_per_file := cycle_count;
                  IFEND;
                  #SPOIL (control_info);

                /cycle_object_loop/
                  FOR cycle_entry := LOWERBOUND (cycle_list^) TO (UPPERBOUND (cycle_list^)) DO
                    cycle_selector.cycle_option := pfc$specific_cycle;
                    cycle_selector.cycle_number := cycle_list^ [cycle_entry].cycle_number;
                    #SPOIL (control_info);

                    IF cycle_list^ [cycle_entry].cycle_device_class = rmc$mass_storage_device THEN
                      IF control_info.delete_damage_conditions [1].delete_damage_condition <>
                            $fst$cycle_damage_symptoms [] THEN

                        delete_damage_condition :=
                              (((control_info.delete_damage_conditions [1].delete_damage_condition *
                              cycle_list^ [cycle_entry].cycle_information^.damage_symptoms) <>
                              $fst$cycle_damage_symptoms []) OR
                              (fsc$media_image_inconsistent IN
                              control_info.delete_damage_conditions [1].delete_damage_condition));

                        IF delete_damage_condition THEN
                          mmi_present := FALSE;
                          IF control_info.perform_changes THEN
                            pfp$r3_change (p_new_path^, cycle_selector, object_list^ [file_entry].password,
                                  control_info.delete_damage_conditions, local_status);
                            IF (fsc$media_image_inconsistent IN
                                  control_info.delete_damage_conditions [1].delete_damage_condition) THEN
                              IF local_status.normal THEN
                                mmi_present := cycle_list^ [cycle_entry].cycle_device_information^.
                                      mass_storage_device_info.resides_online;
                              ELSE
                                local_status.normal :=
                                      local_status.condition = pfe$no_media_image_inconsistent;
                              IFEND;
                            IFEND;
                          IFEND;

                          IF local_status.normal THEN
                            report_damage_deletion (mmi_present);
                          ELSEIF (local_status.condition = pfe$cycle_busy) THEN
                            report_busy_change;
                          ELSEIF NOT osp$file_access_condition (local_status) THEN
                            CASE local_status.condition OF
                            = pfe$incorrect_password, pfe$usage_not_permitted =
                            ELSE
                              output_log_message (^control_info.criteria.file,
                                    'CHANGE_CATALOG - PFP$R3_CHANGE',
                                    mt#unexpected_abnormal_status, local_status);
                            CASEND;
                          IFEND;
                        IFEND; {delete damage condition worthwhile}
                      IFEND; {delete damage condition requested}

                      IF (control_info.exception_policies <> NIL) THEN

                        file_access_condition := cycle_list^ [cycle_entry].cycle_device_information^.
                              mass_storage_device_info.object_condition;

                        IF file_access_condition IN $fst$file_access_conditions
                              [fsc$data_restoration_required, fsc$media_missing, fsc$volume_unavailable] THEN

                          get_applicable_policy (actions);

                          IF actions <> $ost$ecp_actions [] THEN
                            data_released := FALSE;
                            IF (osc$ecp_enable_matching_image IN actions) OR
                                  (osc$ecp_enable_nonmatch_image IN actions) THEN
                              PUSH p_release_data_info;
                              p_release_data_info^.perform_changes := control_info.perform_changes;
                              p_release_data_info^.release_attached_cycle_data := TRUE;
                              p_release_data_info^.update_last_release_date_time := TRUE;
                              p_release_data_info^.valid_archive_entry_required :=
                                    NOT (osc$ecp_enable_nonmatch_image IN actions);
                              pfp$r3_release_data (p_new_path^, cycle_selector,
                                    object_list^ [file_entry].password, p_release_data_info, local_status);
                              data_released := local_status.normal;
                              IF local_status.normal THEN
                                report_release;
                                IF (NOT p_release_data_info^.valid_archive_entry_required) AND
                                      (NOT p_release_data_info^.valid_archive_entry_found) AND
                                      (p_release_data_info^.new_data_modification_date_time <>
                                      p_release_data_info^.old_data_modification_date_time) THEN
                                  IF osc$ecp_set_damage_condition IN actions THEN
                                    report_damage_setting;
                                  ELSE
                                    remove_damage_condition;
                                  IFEND;
                                IFEND;
                              ELSE
                                CASE local_status.condition OF
                                = pfe$data_not_releasable, pfe$empty_archive_list, pfe$incorrect_password,
                                  pfe$usage_not_permitted =

                                ELSE
                                  output_log_message (^control_info.criteria.file,
                                       'CHANGE_CATALOG - PFP$R3_RELEASE_DATA', mt#unexpected_abnormal_status,
                                       local_status);
                               CASEND;
                             IFEND;
                           IFEND; {release test}

                           IF (osc$ecp_delete IN actions) AND (NOT data_released) THEN
                             IF control_info.perform_changes THEN
                               pfp$purge (p_new_path^, cycle_selector, object_list^ [file_entry].password,
                                     local_status);
                             ELSE
                               local_status.normal := TRUE;
                             IFEND;
                             IF local_status.normal THEN
                               report_delete;
                             ELSE
                               CASE local_status.condition OF
                               = pfe$incorrect_password, pfe$usage_not_permitted =

                               ELSE
                                 output_log_message (^control_info.criteria.file,
                                       'CHANGE_GETALOG - PFP$PURGE',
                                       mt#unexpected_abnormal_status, local_status);
                               CASEND;
                             IFEND;
                           IFEND; {delete test}
                         IFEND; {applicable policy exists test}
                       IFEND; {file access condition is relevant test}
                     IFEND; {applicable policies may exist test}
                   IFEND; {mass storage cycle test}
                 FOREND /cycle_object_loop/;
               IFEND; {file object with cycles test}
             FOREND /file_object_loop/;

             PUSH path;
             FOR catalog := LOWERBOUND (object_list^) TO UPPERBOUND (object_list^) DO
               IF object_list^ [catalog].object_type = fsc$goi_catalog_object THEN
                 build_file_reference (header^.resolved_path^, object_list^ [catalog].catalog_name, path^,
                       path_size);
                 change_catalog (^path^ (1, path_size), catalog_depth + 1, control_info);
               IFEND;
             FOREND;

           IFEND; {is it a nonempty catalog object}
         ELSE {header = NIL}
           output_log_message (catalog_reference, 'CHANGE_CATALOG - NEXT failed', mt#object_error,
                 local_status);
         IFEND;
       ELSE {abnormal getoi local_status}
         CASE local_status.condition OF
         = pfe$unknown_item =
           {Ignore.  User had visibility to catalog names but no permission to catalog contents}
         = pfe$catalog_volume_not_online =
           output_object_warning ('PFE$CATALOG_VOLUME_NOT_ONLINE', catalog_reference);
         = pfe$catalog_volume_unavailable =
           output_object_warning ('PFE$CATALOG_VOLUME_UNAVAILABLE', catalog_reference);
         ELSE
           output_log_message (catalog_reference, 'CHANGE_CATALOG - GETOI', mt#object_error, local_status);
         CASEND;
       IFEND;
     PROCEND change_catalog;
?? OLDTITLE ??

?? NEWTITLE := 'change_family', EJECT ??

     PROCEDURE change_family
       (    file_reference: ^fst$file_reference;
        VAR control_info: chacc_control_info);

       VAR
         family_catalog: ^fst$goi_object,
         i: ost$positive_integers,
         ignore_path_size: integer,
         information_request: fst$goi_information_request,
         local_status: ost$status,
         master_catalog: ^fst$goi_object,
         master_catalog_path: string (64),
         object: ^fst$goi_object_information;

       RESET control_info.family_sequence;

       information_request.catalog_depth.depth_specification := fsc$specific_depth;
       information_request.catalog_depth.depth := 1;
       information_request.object_information_requests := $fst$goi_object_info_requests
             [fsc$goi_catalog_object_list];

       pfp$get_object_information (file_reference^, information_request, {validation_criteria} NIL,
             control_info.family_sequence, local_status);

       IF local_status.normal THEN
         RESET control_info.family_sequence;

         NEXT object IN control_info.family_sequence;
         IF object <> NIL THEN
           family_catalog := object^.object;

           FOR i := LOWERBOUND (family_catalog^.subcatalog_and_file_object_list^)
                 TO UPPERBOUND (family_catalog^.subcatalog_and_file_object_list^) DO
             master_catalog := ^family_catalog^.subcatalog_and_file_object_list^ [i];
             build_file_reference (object^.resolved_path^, master_catalog^.catalog_name, master_catalog_path,
                   ignore_path_size);

             RESET control_info.master_catalog_sequence;
             change_catalog (^master_catalog_path, {catalog_depth} 2, control_info);

           FOREND;
         ELSE {header = NIL}
           output_log_message (file_reference, 'CHANGE_FAMILY - NEXT failed', mt#object_error, local_status);
         IFEND;
       ELSE {abnormal status from GETOI}
         output_log_message (file_reference, 'CHANGE_FAMILY - GETOI', mt#object_error, local_status);
       IFEND;
     PROCEND change_family;
?? OLDTITLE ??
?? NEWTITLE := 'terminate_chacc', EJECT ??

     PROCEDURE terminate_chacc
       (    normal_termination: boolean);

       VAR
         ignore_status: ost$status,
         segment_pointer: amt$segment_pointer;

       IF NOT normal_termination AND (current_object <> NIL) THEN
         were_changes_made;
         output_header (current_object^, header_text [summary], control_info);
         output_summary (control_info.object_stats);
         accumulate_statistics;
       IFEND;

       IF control_info.summary_count > 1 THEN
         initialize_message_parameters;
         format_and_output_lines (blank_line_before_and_after, control_info.message_templates [mt#totals],
               control_info);
         output_summary (totals);
         control_info.summary_count := 0;
         #SPOIL (control_info);
       IFEND;

       IF normal_termination AND control_info.retrieve_info.automatic_retrieval THEN
         IF control_info.retrieve_info.include_file_info.file_id <> amv$nil_file_identifier THEN
           IF (control_info.retrieve_info.current_command_file_count > 0) THEN
             clp$put_display (control_info.retrieve_info.include_file_info, ')', clc$no_trim, ignore_status);
             control_info.retrieve_info.current_command_file_count := 0;
             #SPOIL (control_info);
           IFEND;
           clp$close_display (control_info.retrieve_info.include_file_info, ignore_status);
           control_info.retrieve_info.include_file_info.file_id := amv$nil_file_identifier;
           #SPOIL (control_info);
           IF control_info.perform_changes THEN
             clp$include_file (control_info.retrieve_info.unique_file_name, {prompt} '',
                   {utility_name} osc$null_name, ignore_status);
           IFEND;
         IFEND;
       IFEND;

     PROCEND terminate_chacc;
?? OLDTITLE ??
?? EJECT ??
     initialize_statistics (totals);

     current_object := control_info.object_list;
     #SPOIL (current_object);

     WHILE (current_object <> NIL) DO
       output_header (current_object^, header_text [actions], control_info);

       IF current_object^.object_kind = family_object THEN
         add_one (control_info.object_stats.objects_scanned.families);
         #SPOIL (control_info);
         change_family (^current_object^.file_reference, control_info);
       ELSE
         RESET control_info.master_catalog_sequence;
         change_catalog (^current_object^.file_reference, current_object^.number_of_path_elements,
               control_info);
       IFEND;

       were_changes_made;
       output_header (current_object^, header_text [summary], control_info);
       output_summary (control_info.object_stats);

       current_object := current_object^.next_object;
       #SPOIL (current_object);
       accumulate_statistics;
       initialize_statistics (control_info.object_stats);
       #SPOIL (control_info);
     WHILEND;
     terminate_chacc ({normal_termination} TRUE);
     osp$disestablish_cond_handler;

   PROCEND change_catalog_contents;
?? OLDTITLE ??
?? NEWTITLE := 'count_damage_conditions', EJECT ??

   FUNCTION [INLINE] count_damage_conditions
     (    damage_conditions: chacc_damage_statistics): integer;

     count_damage_conditions := damage_conditions.media_image_inconsistent +
           damage_conditions.parent_catalog_restored + damage_conditions.respf_modification_mismatch;

   FUNCEND count_damage_conditions;
?? OLDTITLE ??
?? NEWTITLE := 'count_exceptions', EJECT ??

   FUNCTION [INLINE] count_exceptions
     (    exception_statistics: chacc_exception_statistics): integer;

     count_exceptions := exception_statistics.media_missing + exception_statistics.undefined_data +
           exception_statistics.volume_unavailable;

   FUNCEND count_exceptions;
?? OLDTITLE ??
?? NEWTITLE := 'count_scanned', EJECT ??

   FUNCTION [INLINE] count_scanned
     (    objects_scanned: chacc_object_statistics): ost$non_negative_integers;

     count_scanned := objects_scanned.families + objects_scanned.master_catalogs +
           objects_scanned.subcatalogs + objects_scanned.files + objects_scanned.cycles;
   FUNCEND count_scanned;
?? OLDTITLE ??
?? NEWTITLE := 'evaluate_parameters', EJECT ??

   PROCEDURE evaluate_parameters;

{Design:  This procedure is responsible for evaluating all of the explicitly
{and implicitly specified parameters to CHANGE_CATALOG_CONTENTS.  Implicit
{parameters are provided through exception condition policies defined by the
{MANAGE_EXCEPTION_POLICIES utility.

{An SCL "check" procedure is used for the CATALOG parameter.  This improves
{the usability of the command by validating the parameter values while the
{interactive user still has a chance to correct mistakes.

{The variable OBJECT_LIST is a global variable to the nested procedures that
{follow because:

{ 1) All explicitly specified catalog paths must first be evaluated to
{    perform the necessary validation in the "check" procedure.  Because the
{    evaluated_file_reference is useful to CHANGE_CATALOG, it is saved in
{    the OBJECT_LIST segment to avoid redundant calls to
{    CLP$EVALUATE_FILE_REFERENCE.

{ 2) For uniformity, all catalogs implicitly specified by the keywords ALL
{    and EXCEPTION_POLICY_REFERENCES are also processed and stored in the
{    OBJECT_LIST segment.  However, this processing is not necessary in the
{    "check" procedure and is done at the end of EVALUATE_PARAMETERS.

{ 3) Because it is not good practice to call anything prior to
{    CLP$EVALUATE_FILE_REFERENCE that could return abnormal status, the
{    "check" procedure creates the OBJECT_LIST segment and initializes the
{    OBJECT_LIST segment pointer variable below.  This segment is then used
{    to perform the process defined in (2) above.  The segment remains
{    allocated throughout this command and is deleted by the
{    block exit handler defined for PFP$CHANGE_CATALOG_CONTENTS_CMD.

     VAR
       object_list: amt$segment_pointer;

?? NEWTITLE := 'append_catalog_object', EJECT ??

     PROCEDURE append_catalog_object
       (    evaluated_file_reference: ^fst$evaluated_file_reference);

       VAR
         ignore_path_size: fst$path_size,
         insertion: ^^chacc_object_list_entry,
         node: ^chacc_object_list_entry,
         path: fst$path;

       clp$convert_file_ref_to_string (evaluated_file_reference^, FALSE, path, ignore_path_size, status);
       IF status.normal THEN
         IF control_info.object_list <> NIL THEN
           node := control_info.object_list;
           REPEAT
             IF (node^.object_kind = catalog_object) AND (node^.file_reference = path) THEN
               RETURN;
             ELSEIF node^.next_object = NIL THEN
               insertion := ^node^.next_object;
             IFEND;
             node := node^.next_object;
           UNTIL node = NIL;
         ELSE
           insertion := ^control_info.object_list;
         IFEND;

         NEXT insertion^ IN object_list.sequence_pointer;
         insertion^^.file_reference := path;
         insertion^^.object_kind := catalog_object;
         insertion^^.number_of_path_elements := evaluated_file_reference^.number_of_path_elements;
         insertion^^.next_object := NIL;

       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;

     PROCEND append_catalog_object;
?? OLDTITLE ??
?? NEWTITLE := 'append_family_object', EJECT ??

     PROCEDURE append_family_object
       (    family_name: ost$name);

       VAR
         evaluated_file_reference: fst$evaluated_file_reference,
         family_path: string (32),
         insertion: ^^chacc_object_list_entry,
         node: ^chacc_object_list_entry,
         path_size: integer;

       STRINGREP (family_path, path_size, ':', family_name);

       IF control_info.object_list <> NIL THEN
         node := control_info.object_list;
         REPEAT
           IF (node^.object_kind = family_object) AND (node^.file_reference = family_path) THEN
             RETURN;
           ELSEIF node^.next_object = NIL THEN
             insertion := ^node^.next_object;
           IFEND;
           node := node^.next_object;
         UNTIL node = NIL;
       ELSE
         insertion := ^control_info.object_list;
       IFEND;

       NEXT insertion^ IN object_list.sequence_pointer;
       insertion^^.file_reference := family_path;
       insertion^^.object_kind := family_object;
       insertion^^.number_of_path_elements := 1;
       insertion^^.next_object := NIL;

     PROCEND append_family_object;
?? OLDTITLE ??
?? NEWTITLE := 'check_catalog_parameter', EJECT ??

     PROCEDURE check_catalog_parameter
       (    pvt: ^clt$parameter_value_table;
            which_parameter: clt$which_parameter;
        VAR status: ost$status);


?? NEWTITLE := 'analyze_exception_policies', EJECT ??

       PROCEDURE analyze_exception_policies;


{ Design:
{ The purpose of this procedure is to determine whether any of the installed
{ exception policies pertain to the exception conditions PFE$UNDEFINED_DATA,
{ PFE$VOLUME_UNAVAILABLE, or PFE$VOLUME_NOT_ONLINE (or status conditons mapped to
{ these conditions).  If such policies exist and these policies have selected
{ any of the following actions, this session of CHACC will implement them, if
{ applicable: DELETE, ENABLE_MATCHING_IMAGE, ENABLE_NONMATCHING_IMAGE.

         VAR
           actions: ost$ecp_actions,
           exceptions: ost$ecp_conditions,
           i: ost$ecp_number_of_conditions,
           ignore_status: ost$status,
           installed_header: ^ost$ecp_header,
           local_status: ost$status,
           policy_criteria: ost$ecp_policy_criteria,
           segment_pointer: amt$segment_pointer;

?? NEWTITLE := 'anaep_block_exit_handler', EJECT ??

         PROCEDURE anaep_block_exit_handler
           (    condition: pmt$condition;
                ignore_condition_information: ^pmt$condition_information;
                ignore_save_area: ^ost$stack_frame_save_area;
            VAR handler_status: ost$status);

           IF segment_pointer.sequence_pointer <> NIL THEN
             mmp$delete_scratch_segment (segment_pointer, ignore_status);
             segment_pointer.sequence_pointer := NIL;
           IFEND;

         PROCEND anaep_block_exit_handler;
?? OLDTITLE ??
?? NEWTITLE := 'prune_exception_policies', EJECT ??

         PROCEDURE prune_exception_policies;

           VAR
             i: ost$positive_integers,
             policy: ^ost$ecp_policy_header;

           i := 1;
           REPEAT
             osp$get_policy (i, installed_header^, policy);
             IF (policy <> NIL) THEN
               IF (osp$chacc_applicable_policy (policy)) THEN
                 i := i + 1;
               ELSE
                 osp$remove_policy (policy, installed_header^);
               IFEND;
             IFEND;
           UNTIL policy = NIL;

         PROCEND prune_exception_policies;
?? OLDTITLE ??
?? EJECT ??
         segment_pointer.kind := amc$sequence_pointer;
         segment_pointer.sequence_pointer := NIL;
         #SPOIL (segment_pointer);

         actions := $ost$ecp_actions [];

         osp$establish_block_exit_hndlr (^anaep_block_exit_handler);

         mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
         IF status.normal THEN
           RESET segment_pointer.sequence_pointer;
           osp$get_installed_policies (segment_pointer.sequence_pointer, installed_header, local_status);
           IF local_status.normal THEN
             prune_exception_policies;
             osp$get_union_of_policies (installed_header, exceptions, policy_criteria, local_status);
             IF local_status.normal THEN
               FOR i := 1 TO UPPERBOUND (exceptions) DO
                 IF exceptions [i].specified THEN
                   actions := actions + exceptions [i].actions;
                 IFEND;
               FOREND;
             IFEND;
           IFEND;
         ELSE
           EXIT pfp$change_catalog_contents_cmd;
         IFEND;

         IF actions <> $ost$ecp_actions [] THEN
           control_info.union_of_actions := actions;
           control_info.union_of_policies := policy_criteria * $ost$ecp_policy_criteria
                 [osc$ecp_all_files, osc$ecp_families, osc$ecp_list_of_files, osc$ecp_mass_storage_classes,
                 osc$ecp_sets, osc$ecp_volumes];
           control_info.exception_policies := installed_header;
           #SPOIL (control_info);
         ELSE
           mmp$delete_scratch_segment (segment_pointer, ignore_status);
           segment_pointer.sequence_pointer := NIL;
           #SPOIL (segment_pointer);
         IFEND;

         osp$disestablish_cond_handler;

       PROCEND analyze_exception_policies;
?? OLDTITLE ??
?? NEWTITLE := 'validate_object_list', EJECT ??

       PROCEDURE validate_object_list;

         VAR
           current_catalog: ^clt$data_value,
           evaluated_file_reference: fst$evaluated_file_reference,
           family_name: ost$name,
           i: ost$positive_integers,
           information_request: fst$goi_information_request;

         current_catalog := pvt^ [p$catalog].value;

         FOR i := 1 TO clp$count_list_elements (pvt^ [p$catalog].value) DO
           clp$evaluate_file_reference (current_catalog^.element_value^.file_value^,
                 $clt$file_ref_parsing_options [], FALSE, evaluated_file_reference, status);
           IF status.normal THEN
             IF evaluated_file_reference.path_handle_info.path_handle.open_position.specified THEN
               osp$set_status_abnormal ('CL', cle$file_position_not_allowed, '', status);
             ELSEIF fsp$path_element (^evaluated_file_reference, 1) ^ = fsc$local THEN
               IF evaluated_file_reference.number_of_path_elements = 1 THEN
                 osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_cat, '', status);
               ELSE
                 osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_file, '', status);
               IFEND;
             ELSEIF (evaluated_file_reference.number_of_path_elements = 1) AND
                   (NOT (avp$system_administrator () OR avp$family_administrator ())) THEN
               osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$not_family_owner,
                     current_catalog^.element_value^.file_value^, status);
             ELSEIF evaluated_file_reference.cycle_reference.specification <> fsc$cycle_omitted THEN
               osp$set_status_abnormal ('CL', fse$catalogs_do_not_have_cycles,
                     current_catalog^.element_value^.file_value^, status);
             ELSE {valid path}
               RESET control_info.family_sequence;

               information_request.catalog_depth.depth_specification := fsc$specific_depth;
               information_request.catalog_depth.depth := 1;
               information_request.object_information_requests :=
                     $fst$goi_object_info_requests [fsc$goi_catalog_identity];

               pfp$r3_get_object_information (evaluated_file_reference, information_request,
                     {validation_criteria} NIL, control_info.family_sequence, status);

               IF status.normal THEN
                 IF (evaluated_file_reference.number_of_path_elements = 1) THEN
                   family_name := fsp$path_element (^evaluated_file_reference, 1) ^;
                   append_family_object (family_name);
                 ELSE
                   append_catalog_object (^evaluated_file_reference);
                 IFEND;
               ELSE
                 RETURN;
               IFEND;
             IFEND;
           ELSE
             RETURN;
           IFEND;
           current_catalog := current_catalog^.link;
         FOREND;

       PROCEND validate_object_list;
?? OLDTITLE ??
?? EJECT ??
{Design: This procedure assumes that the CATALOG parameter is the only parameter
{ to have a CHECK attribute.

       IF which_parameter.specific THEN
         analyze_exception_policies;

         mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, object_list, status);
         IF status.normal THEN
           RESET object_list.sequence_pointer;
           IF pvt^ [which_parameter.number].value^.kind = clc$keyword THEN
             IF pvt^ [p$catalog].value^.keyword_value = catalog_option_names [co_all] THEN
               IF NOT (avp$system_administrator () OR avp$family_administrator ()) THEN
                 osp$set_status_condition (ose$not_administrator, status);
                 osp$append_status_parameter (osc$status_parameter_delimiter,
                       catalog_option_names [co_all] (1, clp$trimmed_string_size
                       (catalog_option_names [co_all])), status);
                 osp$append_status_parameter (osc$status_parameter_delimiter, 'CATALOG', status);
                 osp$append_status_parameter (osc$status_parameter_delimiter, 'CHANGE_CATALOG_CONTENTS',
                       status);
               IFEND;
             ELSEIF pvt^ [p$catalog].value^.keyword_value = catalog_option_names [co_policies] THEN
               IF (avp$system_administrator ()) THEN
                 IF (control_info.union_of_actions = $ost$ecp_actions []) OR
                       (control_info.union_of_policies = $ost$ecp_policy_criteria []) THEN
                   osp$set_status_condition (ose$no_applicable_policies, status);
                 IFEND;
               ELSE
                 osp$set_status_condition (ose$not_system_administrator, status);
                 osp$append_status_parameter (osc$status_parameter_delimiter,
                       catalog_option_names [co_policies], status);
                 osp$append_status_parameter (osc$status_parameter_delimiter, 'CATALOG', status);
                 osp$append_status_parameter (osc$status_parameter_delimiter, 'CHANGE_CATALOG_CONTENTS',
                       status);
               IFEND;
             IFEND;
           ELSE
             validate_object_list;
           IFEND;
         IFEND;
       IFEND;
     PROCEND check_catalog_parameter;
?? OLDTITLE ??
?? NEWTITLE := 'get_all_families', EJECT ??

     PROCEDURE get_all_families;

       VAR
         family_count: pmt$family_name_count,
         family_name_list: ^pmt$family_name_list,
         i: ost$positive_integers;

       PUSH family_name_list: [1 .. pmc$family_name_count_maximum];
       pmp$get_family_names (family_name_list^, family_count, status);

       IF status.normal THEN
         FOR i := 1 TO family_count DO
           append_family_object (family_name_list^ [i]);
         FOREND;
       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;
     PROCEND get_all_families;

?? OLDTITLE ??
?? NEWTITLE := 'get_login_family', EJECT ??

     PROCEDURE get_login_family;

       VAR
         criteria: ost$ecp_criteria;

       osp$get_login_user_criteria (criteria, status);
       IF status.normal THEN
         append_family_object (criteria.login_family);
       IFEND;

     PROCEND get_login_family;

?? OLDTITLE ??
?? NEWTITLE := 'get_referenced_object_list', EJECT ??

     PROCEDURE get_referenced_object_list;

       VAR
         policy: ^ost$ecp_policy_header,
         policy_number: ost$positive_integers;

?? NEWTITLE := 'process_referenced_files', EJECT ??

       PROCEDURE process_referenced_files;

         CONST
           path_size = 1 {colon} + fsc$max_path_size {family_name} + 1 {period} + fsc$max_path_size
                 {master_catalog_name} ;

         VAR
           evaluated_file_reference: fst$evaluated_file_reference,
           family: ost$name,
           i: ost$non_negative_integers,
           local_status: ost$status,
           only_family: boolean;

         FOR i := LOWERBOUND (policy^.files.path_list^) TO UPPERBOUND (policy^.files.path_list^) DO
           CASE policy^.files.path_list^ [i].file_reference_type OF
           = osc$ecp_evaluated_reference, osc$ecp_wild_card_reference =
             clp$evaluate_file_reference (policy^.files.path_list^ [i].
                   path^, $clt$file_ref_parsing_options [clc$multiple_reference_allowed], FALSE,
                   evaluated_file_reference, local_status);

             IF local_status.normal THEN
               family := fsp$path_element (^evaluated_file_reference, 1) ^;
               IF family <> fsc$local THEN
                 only_family := (evaluated_file_reference.number_of_path_elements = 1);
                 only_family := only_family OR ((policy^.files.path_list^ [i].file_reference_type =
                       osc$ecp_wild_card_reference) AND (evaluated_file_reference.number_of_path_elements =
                       2));
                 IF only_family THEN
                   append_family_object (family);
                 ELSE
                   append_catalog_object (^evaluated_file_reference);
                 IFEND;
               IFEND;
             ELSE
               output_undefined_object_msg (file_object, policy^.files.path_list^ [i].path^);
             IFEND;
           ELSE {osc$ecp$generic_reference causes scope of ALL files}
           CASEND;
         FOREND;

       PROCEND process_referenced_files;
?? OLDTITLE ??
?? NEWTITLE := 'process_referenced_sets', EJECT ??

       PROCEDURE process_referenced_set
         (    set_name: stt$set_name);

         VAR
           i: ost$non_negative_integers,
           number_of_families: 0 .. pmc$family_name_count_maximum,
           family_list: ^array [1 .. * ] of ost$name,
           local_status: ost$status;

         PUSH family_list: [1 .. pmc$family_name_count_maximum];
         { If SET is not defined, normal status is returned and number_of_families is zero}
         pfp$get_families_in_set (set_name, family_list^, number_of_families, local_status);

         IF local_status.normal THEN
           IF number_of_families > 0 THEN
             FOR i := 1 TO number_of_families DO
               append_family_object (family_list^ [i]);
             FOREND;
           ELSE
             output_undefined_object_msg (set_object, set_name);
           IFEND;
         ELSE
           EXIT pfp$change_catalog_contents_cmd;
         IFEND;

       PROCEND process_referenced_set;
?? OLDTITLE ??
?? NEWTITLE := 'process_referenced_volumes', EJECT ??

       PROCEDURE process_referenced_volumes;

         VAR
           i: ost$non_negative_integers,
           local_status: ost$status,
           set_name: stt$set_name;

         FOR i := LOWERBOUND (policy^.volumes^) TO UPPERBOUND (policy^.volumes^) DO
           pfp$get_volumes_set_name (policy^.volumes^ [i], set_name, local_status);
           IF local_status.normal THEN
             process_referenced_set (set_name);
           ELSE
             output_undefined_object_msg (volume_object, policy^.volumes^ [i]);
           IFEND;
         FOREND;

       PROCEND process_referenced_volumes;
?? OLDTITLE ??

       VAR
         i: ost$non_negative_integers,
         local_set_name: stt$set_name,
         local_status: ost$status;

       policy_number := 1;

       REPEAT
         osp$get_policy (policy_number, control_info.exception_policies^, policy);

         IF policy <> NIL THEN
           IF policy^.families <> NIL THEN
             FOR i := LOWERBOUND (policy^.families^) TO UPPERBOUND (policy^.families^) DO
               pfp$get_family_set (policy^.families^ [i], local_set_name, local_status);
               IF local_status.normal THEN
                 append_family_object (policy^.families^ [i]);
               ELSE
                 output_undefined_object_msg (family_object, policy^.families^ [i]);
               IFEND;
             FOREND;
           IFEND;

           IF policy^.files.specified AND (NOT policy^.files.all_specified) THEN
             process_referenced_files;
           IFEND;

           IF policy^.sets <> NIL THEN
             FOR i := LOWERBOUND (policy^.sets^) TO UPPERBOUND (policy^.sets^) DO
               process_referenced_set (policy^.sets^ [i]);
             FOREND;
           IFEND;

           IF policy^.volumes <> NIL THEN
             process_referenced_volumes;
           IFEND;

           policy_number := policy_number + 1;
         IFEND;

       UNTIL policy = NIL;

     PROCEND get_referenced_object_list;
?? OLDTITLE ??
?? NEWTITLE := 'initialize_output_file', EJECT ??

     PROCEDURE initialize_output_file;

       VAR
         default_ring_attributes: amt$ring_attributes;

       default_ring_attributes.r1 := #RING (^default_ring_attributes);
       default_ring_attributes.r2 := #RING (^default_ring_attributes);
       default_ring_attributes.r3 := #RING (^default_ring_attributes);

       clp$open_display_reference (pvt [p$output].value^.file_value^, NIL, fsc$list, default_ring_attributes,
             control_info.output_info, status);
       IF status.normal THEN
         IF control_info.output_info.page_width < minimum_line_size THEN
           control_info.output_info.page_width := minimum_line_size;
           #SPOIL (control_info);
         IFEND;
       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;

     PROCEND initialize_output_file;
?? OLDTITLE ??
?? NEWTITLE := 'output_exception_actions', EJECT ??

     PROCEDURE output_exception_actions;

       initialize_message_parameters;

       format_and_output_lines (blank_line_before_and_after, control_info.
             message_templates [mt#applic_exception_policies], control_info);

       IF osc$ecp_login_users IN control_info.union_of_policies THEN
         IF avp$system_administrator () THEN
           control_info.message_parameters [1] := ^administrator_names [system_administrator];

           format_and_output_lines (blank_line_after, control_info.
                 message_templates [mt#login_users_applicable], control_info);

         ELSEIF avp$family_administrator () THEN
           control_info.message_parameters [1] := ^administrator_names [family_administrator];
           format_and_output_lines (blank_line_after, control_info.
                 message_templates [mt#login_users_applicable], control_info);
         IFEND;
       IFEND;

       IF (osc$ecp_enable_matching_image IN control_info.union_of_actions) OR
             (osc$ecp_enable_nonmatch_image IN control_info.union_of_actions) THEN
         format_and_output_lines (blank_line_after, control_info.message_templates [mt#release_option],
               control_info);
       IFEND;

       IF osc$ecp_delete IN control_info.union_of_actions THEN
         format_and_output_lines (blank_line_after, control_info.message_templates [mt#delete_option],
               control_info);
       IFEND;

     PROCEND output_exception_actions;
?? OLDTITLE ??
?? NEWTITLE := 'output_parameters', EJECT ??


     PROCEDURE output_parameters;

       VAR
         delete_damage: string (osc$max_string_size),
         delete_damage_size: integer,
         displayed_damage_condition: boolean;

?? NEWTITLE := 'add_damage_condition', EJECT ??

       PROCEDURE add_damage_condition
         (    damage_condition_string: string ( * <= osc$max_name_size);
          VAR {i/o} displayed_damage_condition: boolean;
          VAR {i/o} delete_damage: string ( * <= osc$max_string_size);
          VAR {i/o} delete_damage_size: integer);

         VAR
           temp_length: integer;

         temp_length := delete_damage_size;
         IF displayed_damage_condition THEN
           STRINGREP (delete_damage, delete_damage_size, delete_damage (1, temp_length), ', ',
                 damage_condition_string (1, clp$trimmed_string_size (damage_condition_string)));
         ELSE
           displayed_damage_condition := TRUE;
           STRINGREP (delete_damage, delete_damage_size, delete_damage (1, temp_length),
                 damage_condition_string (1, clp$trimmed_string_size (damage_condition_string)));
         IFEND;


       PROCEND add_damage_condition;
?? OLDTITLE ??
?? EJECT ??
       initialize_message_parameters;
       displayed_damage_condition := FALSE;
       delete_damage := ' ';
       delete_damage_size := 1;

       IF pvt [p$catalog].value^.kind = clc$keyword THEN
         IF pvt [p$catalog].value^.keyword_value = catalog_option_names [co_all] THEN
           control_info.message_parameters [1] := ^catalog_option_names [co_all];
         ELSEIF pvt [p$catalog].value^.keyword_value = catalog_option_names [co_policies] THEN
           control_info.message_parameters [1] := ^catalog_option_names [co_policies];
         IFEND;
       ELSE
         control_info.message_parameters [1] := ^catalog_option_names [co_list];
       IFEND;

       IF control_info.delete_damage_conditions [1].delete_damage_condition <> $fst$cycle_damage_symptoms
             [] THEN
         IF fsc$media_image_inconsistent IN control_info.delete_damage_conditions [1].
               delete_damage_condition THEN
           add_damage_condition (damage_symptom_names [media_image_inconsistent], displayed_damage_condition,
                 delete_damage, delete_damage_size);
         IFEND;

         IF fsc$parent_catalog_restored IN control_info.delete_damage_conditions [1].
               delete_damage_condition THEN
           add_damage_condition (damage_symptom_names [parent_catalog_restored], displayed_damage_condition,
                 delete_damage, delete_damage_size);
         IFEND;
         IF fsc$respf_modification_mismatch IN control_info.delete_damage_conditions [1].
               delete_damage_condition THEN
           add_damage_condition (damage_symptom_names [respf_modification_mismatch],
                 displayed_damage_condition, delete_damage, delete_damage_size);
         IFEND;
       ELSE
         STRINGREP (delete_damage, delete_damage_size, delete_damage (1, delete_damage_size),
               damage_symptom_names [none]);
       IFEND;

       control_info.message_parameters [2] := ^delete_damage (2, delete_damage_size);

       IF control_info.perform_changes THEN
         control_info.message_parameters [3] := ^boolean_names [true_value];
       ELSE
         control_info.message_parameters [3] := ^boolean_names [false_value];
       IFEND;

       IF control_info.retrieve_info.automatic_retrieval THEN
         control_info.message_parameters [4] := ^boolean_names [true_value];
       ELSE
         control_info.message_parameters [4] := ^boolean_names [false_value];
       IFEND;

       IF pvt [p$retrieve_file_list].specified THEN
         control_info.message_parameters [5] := ^pvt [p$retrieve_file_list].value^.file_value^;
       ELSE
         control_info.message_parameters [5] := ^damage_symptom_names [none];
       IFEND;

       format_and_output_lines (only_template_lines, control_info.message_templates [mt#parameters],
             control_info);

     PROCEND output_parameters;
?? OLDTITLE ??
?? EJECT ??

     VAR
       damage_conditions: ^clt$data_value;

     clp$evaluate_parameters (parameter_list, #SEQ (pdt), ^check_catalog_parameter, ^pvt, status);

     IF status.normal THEN
       control_info.perform_changes := pvt [p$perform_changes].value^.boolean_value.value;
       control_info.retrieve_info.automatic_retrieval := pvt [p$retrieve_files].value^.boolean_value.value;

       IF control_info.retrieve_info.automatic_retrieval THEN
         control_info.retrieve_info.current_command_file_count := 0;
         control_info.retrieve_info.include_file_info.file_id := amv$nil_file_identifier;
         control_info.retrieve_info.unique_file_name := '';
       IFEND;

       IF pvt [p$delete_damage_condition].specified THEN
         damage_conditions := pvt [p$delete_damage_condition].value;

         WHILE damage_conditions <> NIL DO
           IF damage_conditions^.element_value^.keyword_value =
                 damage_symptom_names [media_image_inconsistent] THEN
             control_info.delete_damage_conditions [1].delete_damage_condition :=
                   control_info.delete_damage_conditions [1].delete_damage_condition +
                   $fst$cycle_damage_symptoms [fsc$media_image_inconsistent];
           ELSEIF damage_conditions^.element_value^.keyword_value =
                 damage_symptom_names [respf_modification_mismatch] THEN
             control_info.delete_damage_conditions [1].delete_damage_condition :=
                   control_info.delete_damage_conditions [1].delete_damage_condition +
                   $fst$cycle_damage_symptoms [fsc$respf_modification_mismatch];
           ELSEIF damage_conditions^.element_value^.keyword_value =
                 damage_symptom_names [parent_catalog_restored] THEN
             control_info.delete_damage_conditions [1].delete_damage_condition :=
                   control_info.delete_damage_conditions [1].delete_damage_condition +
                   $fst$cycle_damage_symptoms [fsc$parent_catalog_restored];
           IFEND;
           damage_conditions := damage_conditions^.link;
         WHILEND;
       IFEND;

       initialize_output_file;

       output_parameters;

       IF (control_info.union_of_actions <> $ost$ecp_actions []) THEN
         output_exception_actions;
       IFEND;

       IF pvt [p$catalog].value^.keyword_value = catalog_option_names [co_all] THEN
         IF avp$system_administrator () THEN
           get_all_families;
         ELSEIF avp$family_administrator () THEN
           get_login_family;
         IFEND;
       ELSEIF pvt [p$catalog].value^.keyword_value = catalog_option_names [co_policies] THEN
         IF osc$ecp_all_files IN control_info.union_of_policies THEN
           format_and_output_lines (blank_line_after, control_info.message_templates [mt#all_referenced],
                 control_info);
           get_all_families;
         ELSE
           get_referenced_object_list;
         IFEND;
       IFEND;
     ELSE
       #SPOIL (control_info);
       EXIT pfp$change_catalog_contents_cmd;
     IFEND;
     #SPOIL (control_info);

   PROCEND evaluate_parameters;
?? OLDTITLE ??
?? NEWTITLE := 'format_and_output_lines', EJECT ??

   PROCEDURE format_and_output_lines
     (    blank_line_option: blank_line_option;
          message_template: ^ost$message_template;
      VAR control_info: chacc_control_info);

?? NEWTITLE := 'prefix_blank_line', EJECT ??

     FUNCTION prefix_blank_line: boolean;

       prefix_blank_line := FALSE;
       CASE blank_line_option OF
       = blank_line_before, blank_line_before_and_after =
         prefix_blank_line := TRUE;
       ELSE
       CASEND;

     FUNCEND prefix_blank_line;
?? OLDTITLE ??
?? NEWTITLE := 'suffix_blank_line', EJECT ??

     FUNCTION suffix_blank_line: boolean;

       suffix_blank_line := FALSE;
       CASE blank_line_option OF
       = blank_line_after, blank_line_before_and_after =
         suffix_blank_line := TRUE;
       ELSE
       CASEND;

     FUNCEND suffix_blank_line;
?? OLDTITLE ??

     VAR
       message_container: ost$status_message,
       message_container_ptr: ^ost$status_message,
       message_line: ^ost$status_message_line,
       message_line_count: ^ost$status_message_line_count,
       message_line_index: 1 .. osc$max_status_message_lines,
       message_line_size: ^ost$status_message_line_size;

{ Design:
{ The process of generating the HELP module used to generate the OUTPUT file of this
{ command does not handle blank lines properly.  Blank lines at the end of the template
{ are deleted and a single blank line at the beginning of the template becomes two
{ blank lines when output.  However, an embedded blank line is retained.  Because of
{ these idiosynchrasies, blank lines are handled outside of the message template.
{
     osp$format_help_message (message_template, ^control_info.message_parameters, osc$max_status_message_line,
           message_container, status);

     IF status.normal THEN
       IF prefix_blank_line () THEN
         clp$put_display (control_info.output_info, ' ', clc$no_trim, status);
       IFEND;

       IF status.normal THEN
         message_container_ptr := ^message_container;
         RESET message_container_ptr;
         NEXT message_line_count IN message_container_ptr;

       /output_lines/
         FOR message_line_index := 1 TO message_line_count^ DO
           NEXT message_line_size IN message_container_ptr;
           NEXT message_line: [message_line_size^] IN message_container_ptr;

           clp$put_display (control_info.output_info, message_line^ (2, (message_line_size^ -1)), clc$no_trim,
                 status);
           IF NOT status.normal THEN
             EXIT pfp$change_catalog_contents_cmd;
           IFEND;
         FOREND /output_lines/;
       IFEND;
     IFEND;

     IF status.normal AND suffix_blank_line () THEN
       clp$put_display (control_info.output_info, ' ', clc$no_trim, status);
     IFEND;

     IF NOT status.normal THEN
       EXIT pfp$change_catalog_contents_cmd;
     IFEND;

   PROCEND format_and_output_lines;
?? OLDTITLE ??
?? NEWTITLE := 'initialize_control_info', EJECT ??

   PROCEDURE initialize_control_info;

?? NEWTITLE := 'initialize_message_templates', EJECT ??

     PROCEDURE initialize_message_templates;

       VAR
         i: message_ordinals,
         ignore_online_manual_name: ost$online_manual_name,
         ignore_natural_language: ost$natural_language,
         message_module: pmt$program_name,
         message_module_ptr: ^ost$help_module;

       osp$find_help_module (pfc$chacc_help_module_name, message_module_ptr, ignore_online_manual_name,
             ignore_natural_language, status);
       IF status.normal THEN
         FOR i := LOWERBOUND (control_info.message_templates)
               TO UPPERBOUND (control_info.message_templates) DO
           osp$find_parameter_prompt (message_module_ptr, parameter_prompt_names [i],
                 control_info.message_templates [i], status);
           IF NOT status.normal THEN
             EXIT pfp$change_catalog_contents_cmd;
           IFEND;
         FOREND;
       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;

     PROCEND initialize_message_templates;
?? OLDTITLE ??
?? EJECT ??
     control_info := initial_control_info;

     osp$get_login_user_criteria (control_info.criteria, status);
     IF status.normal THEN
       control_info.criteria.condition := fsc$null_file_access_condition;
       control_info.criteria.family_path_name := osc$null_name;
       control_info.criteria.file := osc$null_name;
       control_info.criteria.mass_storage_class := rmc$unspecified_file_class;
       control_info.criteria.set_name := osc$null_name;
       control_info.criteria.volume_list := NIL;

       control_info.output_info.file_id := amv$nil_file_identifier;
       control_info.retrieve_info.display_info.file_id := amv$nil_file_identifier;

       initialize_message_parameters;
       initialize_message_templates;
       initialize_statistics (control_info.object_stats);
     ELSE
       EXIT pfp$change_catalog_contents_cmd;
     IFEND;

   PROCEND initialize_control_info;

?? OLDTITLE ??
?? NEWTITLE := 'initialize_message_parameters', EJECT ??

   PROCEDURE [INLINE] initialize_message_parameters;

     VAR
       i: integer;

     FOR i := LOWERBOUND (control_info.message_parameters) TO UPPERBOUND (control_info.message_parameters) DO
       control_info.message_parameters [i] := NIL;
     FOREND;

   PROCEND initialize_message_parameters;
?? OLDTITLE ??
?? NEWTITLE := 'initialize_retrieve_info', EJECT ??

   PROCEDURE [INLINE] initialize_retrieve_info;

     VAR
       default_ring_attributes: amt$ring_attributes,
       ignore_length: integer,
       unique_name: ost$name;

     default_ring_attributes.r1 := #RING (^default_ring_attributes);
     default_ring_attributes.r2 := #RING (^default_ring_attributes);
     default_ring_attributes.r3 := #RING (^default_ring_attributes);

     IF pvt [p$retrieve_file_list].specified THEN
       clp$open_display_reference (pvt [p$retrieve_file_list].value^.file_value^, {new_page_procedure} NIL,
             fsc$legible_data, default_ring_attributes, control_info.retrieve_info.display_info, status);
     IFEND;

     IF status.normal THEN
       pmp$get_unique_name (unique_name, status);
       IF status.normal THEN
         STRINGREP (control_info.retrieve_info.unique_file_name, ignore_length, ':$LOCAL.', unique_name);
         #SPOIL (control_info);
         IF control_info.retrieve_info.automatic_retrieval THEN
           clp$open_display_reference (control_info.retrieve_info.unique_file_name, {new_page_procedure} NIL,
                 fsc$legible_scl_include, default_ring_attributes,
                 control_info.retrieve_info.include_file_info, status);
           #SPOIL (control_info);
         IFEND;
       IFEND;
     IFEND;

     IF NOT status.normal THEN
       EXIT pfp$change_catalog_contents_cmd;
     IFEND;

   PROCEND initialize_retrieve_info;
?? OLDTITLE ??
?? NEWTITLE := 'initialize_statistics', EJECT ??

   PROCEDURE initialize_statistics
     (VAR statistics: chacc_statistics);

     statistics.busy_damaged_cycles := 0;
     statistics.damage_cleared := initial_damage_stats;
     statistics.delete_pending := 0;
     statistics.deleted := initial_exception_stats;
     statistics.objects_scanned := initial_object_stats;
     statistics.release_pending := 0;
     statistics.released_with_emi := initial_exception_stats;
     statistics.released_with_eni := initial_exception_stats;

   PROCEND initialize_statistics;
?? OLDTITLE ??
?? NEWTITLE := 'output_applicable_policies', EJECT ??

   PROCEDURE output_applicable_policies;

?? NEWTITLE := 'outap_handler', EJECT ??

     PROCEDURE outap_handler
       (    condition: pmt$condition;
            condition_information: ^pmt$condition_information;
            save_area: ^ost$stack_frame_save_area;
        VAR handler_status: ost$status);

       VAR
         ignore_status: ost$status;

       mmp$delete_scratch_segment (scratch_segment, ignore_status);

     PROCEND outap_handler;
?? OLDTITLE ??
?? EJECT ??

*copy clv$display_variables

     CONST
       max_subtitle_length = 30;

     VAR
       length: integer,
       local_status: ost$status,
       policy_number: ost$positive_integers,
       representation: ^clt$data_representation,
       result: ^clt$data_value,
       scratch_segment: amt$segment_pointer,
       subtitle: string (max_subtitle_length),
       work_area: ^clt$work_area;

     osp$establish_block_exit_hndlr (^outap_handler);

     mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, scratch_segment, status);
     IF status.normal THEN
       work_area := scratch_segment.sequence_pointer;
       policy_number := 1;

       osp$get_policy_list (control_info.exception_policies^, result, work_area);

       WHILE (result <> NIL) DO
         clp$convert_data_to_string (result^.element_value, clc$labeled_elem_representation,
               control_info.output_info.page_width, work_area, representation, status);
         IF status.normal THEN
           STRINGREP (subtitle, length, 'Policy Number:', policy_number);
           clp$put_display (control_info.output_info, subtitle (1, length), clc$trim, status);
           IF status.normal THEN
             clp$new_display_line (control_info.output_info, {skip_count} 1, status);
             IF status.normal THEN
               clp$put_data_representation (control_info.output_info, representation, status);
               result := result^.link;
               IF result <> NIL THEN
                 clp$new_display_line (control_info.output_info, {skip_count} 2, status);
                 IF status.normal THEN
                   policy_number := policy_number + 1;
                 IFEND;
               IFEND;
             IFEND;
           IFEND;
         IFEND;
       WHILEND;
     IFEND;

   PROCEND output_applicable_policies;
?? OLDTITLE ??
?? NEWTITLE := 'output_header', EJECT ??

   PROCEDURE output_header
     (    object: chacc_object_list_entry;
          text: string ( * <= max_header_text_size);
      VAR control_info: chacc_control_info);

     VAR
       fs_path: fst$path,
       fs_path_size: fst$path_size;

     initialize_message_parameters;

     control_info.message_parameters [1] := ^text;

     CASE object.object_kind OF
     = family_object =
       control_info.message_parameters [2] := ^object_names [family_object];
     = catalog_object =
       control_info.message_parameters [2] := ^object_names [catalog_object];
     ELSE
     CASEND;

     IF status.normal THEN
       control_info.message_parameters [3] := ^object.file_reference;
     ELSE
       EXIT pfp$change_catalog_contents_cmd;
     IFEND;

     format_and_output_lines (blank_line_before_and_after, control_info.message_templates [mt#header_line],
           control_info);

   PROCEND output_header;
?? OLDTITLE ??
?? NEWTITLE := 'output_log_message', EJECT ??

   PROCEDURE output_log_message
     (    file: ^fst$file_reference;
          optional_log_text: string ( * );
          message_ordinal: message_ordinals;
          status: ost$status);

     CONST
       asterisks = '*********************************************************************************',
       internal_error = '***************** CHANGE_CATALOG_CONTENTS Internal Error. ***********************',
       write_psr = '****************Please print this job log and submit a PSR. *********************';

     VAR
       ignore_status: ost$status;

     initialize_message_parameters;

     control_info.message_parameters [1] := file;

     format_and_output_lines (blank_line_before_and_after, control_info.message_templates [message_ordinal],
           control_info);

     pmp$log_ascii (asterisks, $pmt$ascii_logset [pmc$job_log], pmc$msg_origin_system, ignore_status);
     pmp$log_ascii (internal_error, $pmt$ascii_logset [pmc$job_log], pmc$msg_origin_system, ignore_status);
     pmp$log_ascii (write_psr, $pmt$ascii_logset [pmc$job_log], pmc$msg_origin_system, ignore_status);

     IF optional_log_text <> ' ' THEN
       pmp$log_ascii (optional_log_text, $pmt$ascii_logset [pmc$job_log], pmc$msg_origin_system,
             ignore_status);
     IFEND;

     IF file <> NIL THEN
       pmp$log_ascii (file^(1, clp$trimmed_string_size (file^)),
             $pmt$ascii_logset [pmc$job_log], pmc$msg_origin_system, ignore_status);
     IFEND;

     IF NOT status.normal THEN
       osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
     IFEND;

     pmp$log_ascii (asterisks, $pmt$ascii_logset [pmc$job_log], pmc$msg_origin_system, ignore_status);

   PROCEND output_log_message;
?? OLDTITLE ??
?? NEWTITLE := 'output_object_warning', EJECT ??

   PROCEDURE output_object_warning
     (    status_condition: string ( * );
          path: ^fst$file_reference);

     initialize_message_parameters;

     control_info.message_parameters [1] := ^status_condition;
     control_info.message_parameters [2] := ^path^ (1, clp$trimmed_string_size (path^));

     format_and_output_lines (blank_line_after, control_info.message_templates [mt#object_warning],
           control_info);

   PROCEND output_object_warning;
?? OLDTITLE ??
?? NEWTITLE := 'output_summary', EJECT ??

   PROCEDURE output_summary
     (    object_stats: chacc_statistics);


     VAR
       most_significant_digit: ost$positive_integers,
       number_of_digits: ost$positive_integers;

?? NEWTITLE := 'output_damage_summary', EJECT ??

     PROCEDURE output_damage_summary;

       VAR
         i: damage_symptoms,
         values: array [media_image_inconsistent .. respf_modification_mismatch] of string (8);

       initialize_message_parameters;

       clp$convert_integer_to_rjstring (count_damage_conditions (object_stats.damage_cleared), {radix} 10,
             {include_radix_specifier} FALSE, ' ', total_string, status);
       IF status.normal THEN
         control_info.message_parameters [1] := ^total_string (most_significant_digit, number_of_digits);
         FOR i := LOWERBOUND (values) TO UPPERBOUND (values) DO
           CASE i OF
           = media_image_inconsistent =
             clp$convert_integer_to_rjstring (object_stats.damage_cleared.media_image_inconsistent,
                   {radix} 10, {include_radix_specifier} FALSE, ' ', values [i], status);
           = parent_catalog_restored =
             clp$convert_integer_to_rjstring (object_stats.damage_cleared.parent_catalog_restored, {radix} 10,
                   {include_radix_specifier} FALSE, ' ', values [i], status);
           = respf_modification_mismatch =
             clp$convert_integer_to_rjstring (object_stats.damage_cleared.respf_modification_mismatch,
                   {radix} 10, {include_radix_specifier} FALSE, ' ', values [i], status);
           ELSE
           CASEND;

           IF status.normal THEN
             control_info.message_parameters [$INTEGER (i) + 1] := ^values [i] (most_significant_digit,
                   number_of_digits);
           ELSE
             EXIT pfp$change_catalog_contents_cmd;
           IFEND;
         FOREND;
         format_and_output_lines (blank_line_after, control_info.message_templates [mt#conditions_cleared],
               control_info);

       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;

     PROCEND output_damage_summary;
?? OLDTITLE ??
?? NEWTITLE := 'output_exception_summary', EJECT ??

     PROCEDURE output_exception_summary
       (    statistics: chacc_exception_statistics;
            message_template: ^ost$message_template);

       VAR
         i: exception_conditions,
         values: array [exception_conditions] of string (8);

       initialize_message_parameters;

       clp$convert_integer_to_rjstring (count_exceptions (statistics), {radix} 10,
             {include_radix_specifier} FALSE, ' ', total_string, status);
       IF status.normal THEN
         control_info.message_parameters [1] := ^total_string (most_significant_digit, number_of_digits);
         format_and_output_lines (only_template_lines, message_template, control_info);
         FOR i := LOWERBOUND (values) TO UPPERBOUND (values) DO
           CASE i OF
           = media_missing =
             clp$convert_integer_to_rjstring (statistics.media_missing, {radix} 10,
                   {include_radix_specifier} FALSE, ' ', values [i], status);
           = undefined_data =
             clp$convert_integer_to_rjstring (statistics.undefined_data, {radix} 10,
                   {include_radix_specifier} FALSE, ' ', values [i], status);
           = volume_unavailable =
             clp$convert_integer_to_rjstring (statistics.volume_unavailable, {radix} 10,
                   {include_radix_specifier} FALSE, ' ', values [i], status);
           ELSE
           CASEND;

           IF status.normal THEN
             control_info.message_parameters [$INTEGER (i) + 1] := ^values [i] (most_significant_digit,
                   number_of_digits);
           ELSE
             EXIT pfp$change_catalog_contents_cmd;
           IFEND;
         FOREND;
         format_and_output_lines (blank_line_after, control_info.message_templates [mt#counts_by_condition],
               control_info);

       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;

     PROCEND output_exception_summary;
?? OLDTITLE ??
?? NEWTITLE := 'output_integer', EJECT ??

     PROCEDURE output_integer
       (    blank_line_option: blank_line_option;
            integer_value: ost$non_negative_integers;
            message_template: ^ost$message_template);

       VAR
         i: exception_conditions,
         values: array [exception_conditions] of string (8);

       initialize_message_parameters;

       clp$convert_integer_to_rjstring (integer_value, {radix} 10, {include_radix_specifier} FALSE, ' ',
             total_string, status);
       IF status.normal THEN
         control_info.message_parameters [1] := ^total_string (most_significant_digit, number_of_digits);
         format_and_output_lines (blank_line_option, message_template, control_info);
       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;

     PROCEND output_integer;
?? OLDTITLE ??
?? EJECT ??

     TYPE
       scanned_objects = (totals, families, master_catalogs, subcatalogs, files, cycles,
             maximum_catalog_nesting, maximum_files_per_catalog, maximum_cycles_per_file);

     VAR
       i: scanned_objects,
       test_string: ost$string,
       total_deleted: ost$non_negative_integers,
       total: ost$non_negative_integers,
       total_released: ost$non_negative_integers,
       total_string: string (8),
       values: array [scanned_objects] of string (8);

     initialize_message_parameters;

     FOR i := LOWERBOUND (values) TO UPPERBOUND (values) DO
       CASE i OF
       = totals =
         total := count_scanned (object_stats.objects_scanned);

         clp$convert_integer_to_rjstring (total, {radix} 10, {include_radix_specifier} FALSE, ' ', values [i],
               status);
         IF status.normal THEN
           clp$convert_integer_to_string (total, {radix} 10, {include_radix_specifier} FALSE, test_string,
                 status);
           IF status.normal THEN
             number_of_digits := test_string.size;
             most_significant_digit := STRLENGTH (values [i]) - number_of_digits + 1;
           IFEND;
         IFEND;
       = families =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.families, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = master_catalogs =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.master_catalogs, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = subcatalogs =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.subcatalogs, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = files =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.files, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = cycles =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.cycles, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = maximum_catalog_nesting =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.maximum_catalog_nesting, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = maximum_files_per_catalog =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.maximum_files_per_catalog, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       = maximum_cycles_per_file =
         clp$convert_integer_to_rjstring (object_stats.objects_scanned.maximum_cycles_per_file, {radix} 10,
               {include_radix_specifier} FALSE, ' ', values [i], status);
       ELSE
       CASEND;

       IF status.normal THEN
         control_info.message_parameters [$INTEGER (i) + 1] := ^values [i] (most_significant_digit,
               number_of_digits);
       ELSE
         EXIT pfp$change_catalog_contents_cmd;
       IFEND;
     FOREND;

     format_and_output_lines (blank_line_after, control_info.message_templates [mt#objects_scanned],
           control_info);

     initialize_message_parameters;

     output_damage_summary;

     output_integer (blank_line_after, object_stats.busy_damaged_cycles, control_info.
           message_templates [mt#busy_damaged_cycles]);

     total_deleted := count_exceptions (object_stats.deleted);
     total_released := count_exceptions (object_stats.released_with_emi) +
           count_exceptions (object_stats.released_with_eni);

     output_integer (only_template_lines, total_deleted + total_released, control_info.
           message_templates [mt#total_cycles_applicable]);

     output_integer (only_template_lines, total_released, control_info.
           message_templates [mt#total_cycles_released]);

     initialize_message_parameters;

     output_exception_summary (object_stats.released_with_emi, control_info.
           message_templates [mt#emi_cycles_released]);

     output_exception_summary (object_stats.released_with_eni, control_info.
           message_templates [mt#eni_cycles_released]);

     output_exception_summary (object_stats.deleted, control_info.message_templates [mt#cycles_deleted]);

     output_integer (only_template_lines, object_stats.delete_pending, control_info.
           message_templates [mt#busy_cycles_deleted]);

     output_integer (only_template_lines, object_stats.release_pending, control_info.
           message_templates [mt#busy_cycles_released]);

     add_one (control_info.summary_count);

   PROCEND output_summary;
?? OLDTITLE ??
?? NEWTITLE := 'output_undefined_object_msg', EJECT ??

   PROCEDURE output_undefined_object_msg
     (    object_kind: object_kind;
          path: fst$file_reference);

     initialize_message_parameters;

     control_info.message_parameters [1] := ^object_names [object_kind];
     control_info.message_parameters [2] := ^path (1, clp$trimmed_string_size (path));

     format_and_output_lines (blank_line_after, control_info.message_templates [mt#undefined_object],
           control_info);

   PROCEND output_undefined_object_msg;
?? OLDTITLE ??
?? NEWTITLE := 'were_changes_made', EJECT ??

   PROCEDURE were_changes_made;

     initialize_message_parameters;

     IF (count_exceptions (control_info.object_stats.deleted) +
           count_exceptions (control_info.object_stats.released_with_emi) +
           count_exceptions (control_info.object_stats.released_with_eni) +
           count_damage_conditions (control_info.object_stats.damage_cleared) = 0) THEN

       format_and_output_lines (only_template_lines, control_info.message_templates [mt#no_changes],
             control_info);
     IFEND;

   PROCEND were_changes_made;
?? OLDTITLE ??
?? EJECT ??

   status.normal := TRUE;

   initialize_control_info;
   #SPOIL (control_info);
   osp$establish_block_exit_hndlr (^chacc_cmd_block_exit_handler);

   allocate_catalog_segments;

   evaluate_parameters;

   IF (control_info.union_of_actions <> $ost$ecp_actions []) OR
         (control_info.delete_damage_conditions [1].delete_damage_condition <> $fst$cycle_damage_symptoms [])
         THEN

     IF ($ost$ecp_actions [osc$ecp_enable_matching_image, osc$ecp_enable_nonmatch_image] *
           control_info.union_of_actions) <> $ost$ecp_actions [] THEN
       initialize_retrieve_info;
     IFEND;

     change_catalog_contents;

     IF (control_info.union_of_actions <> $ost$ecp_actions []) THEN
       IF avp$system_administrator () OR avp$family_administrator () THEN
         format_and_output_lines (blank_line_before_and_after, control_info.
               message_templates [mt#administrator_notes], control_info);
         output_applicable_policies;
       ELSE
         format_and_output_lines (blank_line_before_and_after, control_info.message_templates [mt#user_notes],
               control_info);
       IFEND;
     IFEND;
   ELSE
     osp$set_status_condition (ose$no_applicable_policies, status);
   IFEND;

 PROCEND pfp$change_catalog_contents_cmd;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pfp$set_cycle_damage_cmd ', EJECT ??

 PROCEDURE [XDCL, #GATE] pfp$set_cycle_damage_cmd
   (    parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE set_cycle_damage_conditions (
{   files, file, f: list of file = $required
{   password, pw: (SECURE) name = $optional
{   damage_conditions, dc: list of key
{       (media_image_inconsistent, mii)
{       (parent_catalog_restored, pcr)
{       (respf_modification_mismatch, rmm)
{     keyend = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 8] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 6] of clt$keyword_specification,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 7, 29, 23, 11, 9, 788],
    clc$command, 8, 4, 2, 0, 0, 0, 4, ''], [
    ['DAMAGE_CONDITIONS              ',clc$nominal_entry, 3],
    ['DC                             ',clc$abbreviation_entry, 3],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$alias_entry, 1],
    ['FILES                          ',clc$nominal_entry, 1],
    ['PASSWORD                       ',clc$nominal_entry, 2],
    ['PW                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 19, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 245,
  clc$required_parameter, 0, 0],
{ PARAMETER 4
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$list_type], [229, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [6], [
      ['MEDIA_IMAGE_INCONSISTENT       ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['MII                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['PARENT_CATALOG_RESTORED        ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['PCR                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['RESPF_MODIFICATION_MISMATCH    ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['RMM                            ', clc$abbreviation_entry, clc$normal_usage_entry, 3]]
      ]
    ],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

   CONST
     p$files = 1,
     p$password = 2,
     p$damage_conditions = 3,
     p$status = 4;

   VAR
     pvt: array [1 .. 4] of clt$parameter_value;

   VAR
     current_file: ^clt$data_value,
     damage_conditions: ^clt$data_value,
     damage_condition_set: fst$cycle_damage_symptoms,
     password: pft$password;

   clp$evaluate_parameters (parameter_list, #SEQ (pdt), {check_procedure} NIL, ^pvt, status);

   IF status.normal THEN
     damage_conditions := pvt [p$damage_conditions].value;
     damage_condition_set := $fst$cycle_damage_symptoms [];
     WHILE damage_conditions <> NIL DO
       IF damage_conditions^.element_value^.keyword_value =
             damage_symptom_names [media_image_inconsistent] THEN
         damage_condition_set := damage_condition_set + $fst$cycle_damage_symptoms
               [fsc$media_image_inconsistent];
       ELSEIF damage_conditions^.element_value^.keyword_value =
             damage_symptom_names [respf_modification_mismatch] THEN
         damage_condition_set := damage_condition_set + $fst$cycle_damage_symptoms
               [fsc$respf_modification_mismatch];
       ELSEIF damage_conditions^.element_value^.keyword_value =
             damage_symptom_names [parent_catalog_restored] THEN
         damage_condition_set := damage_condition_set + $fst$cycle_damage_symptoms
               [fsc$parent_catalog_restored];
       IFEND;
       damage_conditions := damage_conditions^.link;
     WHILEND;

     IF pvt [p$password].specified THEN
       password := pvt [p$password].value^.name_value;
     ELSE
       password := osc$null_name;
     IFEND;

     current_file := pvt [p$files].value;
     WHILE (current_file <> NIL) AND (current_file^.element_value <> NIL) DO
       fsp$change_cycle_damage (current_file^.element_value^.file_value^, password, damage_condition_set,
             status);
       IF status.normal THEN
         current_file := current_file^.link;
       ELSE
         RETURN;
       IFEND;
     WHILEND;
   IFEND;

 PROCEND pfp$set_cycle_damage_cmd;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pfp$get_file_list ', EJECT ??

  PROCEDURE [XDCL, #GATE] pfp$get_file_list
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE get_file_list, getfl (
{   file, f: file = $required
{   variable_name, vn: name = $required
{   list_size, ls: integer 1..1000 = 100
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (3),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [94, 3, 3, 21, 4, 21, 262],
    clc$command, 7, 4, 2, 0, 0, 0, 4, ''], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['LIST_SIZE                      ',clc$nominal_entry, 3],
    ['LS                             ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VN                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$optional_default_parameter, 0, 3],
{ PARAMETER 4
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, 1000, 10],
    '100'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$file = 1,
      p$variable_name = 2,
      p$list_size = 3,
      p$status = 4;

    VAR
      pvt: array [1 .. 4] of clt$parameter_value;

{ TYPE
{   file_list: list of file
{ TYPEND

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    type_specification : [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      name: string (9),
      qualifier: clt$list_type_qualifier_v2,
      element_type_spec: record
        header: clt$type_specification_header,
      recend,
    recend := [
      [1, 9, clc$list_type], 'FILE_LIST', [3, 0, clc$max_list_size, 0, FALSE
  , FALSE],
        [[1, 0, clc$file_type]]
      ];

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      file_attachment: ^fst$attachment_options,
      file_id: amt$file_identifier,
      file_position: amt$file_position,
      first_non_blank: string(1),
      i: ost$positive_integers,
      ignore_byte_address: amt$file_byte_address,
      ignore_status: ost$status,
      j: ost$positive_integers,
      link_list_node: boolean,
      list_node: ^clt$data_value,
      path: fst$path,
      transfer_count: amt$transfer_count,
      list_variable: ^clt$data_value,
      work_area: ^^clt$work_area;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF status.normal THEN
      PUSH file_attachment: [1 .. 2];

      file_attachment^ [1].selector := fsc$access_and_share_modes;
      file_attachment^ [1].access_modes.selector := fsc$specific_access_modes;
      file_attachment^ [1].share_modes.selector := fsc$specific_share_modes;
      file_attachment^ [1].access_modes.value := $fst$file_access_options [fsc$read];
      file_attachment^ [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];

      file_attachment^ [2].selector := fsc$private_read;
      file_attachment^ [2].private_read := FALSE;

      fsp$open_file (pvt [p$file].value^.file_value^, {access_level} amc$record, file_attachment,
            {default_creation_attributes} NIL, {mandated_creation_attributes} NIL, {attribute_validation} NIL,
            {override_attributes} NIL, file_id, status);

      IF status.normal THEN
        clp$get_work_area (#RING (^work_area), work_area, status);
        IF status.normal THEN
          clp$make_list_value (work_area^, list_node);
          list_variable := list_node;
          link_list_node := FALSE;
          clp$delete_variable (pvt [p$variable_name].value^.name_value, ignore_status);

        /file_loop/
          FOR i := 1 TO pvt [p$list_size].value^.integer_value.value DO
            amp$get_next (file_id, ^path, fsc$max_path_size, transfer_count, ignore_byte_address,
                  file_position, status);

            IF status.normal AND (file_position <> amc$eoi) THEN
              first_non_blank := ' ';
              IF transfer_count > 0 THEN
              /find_first_non_blank/
                FOR j := 1 to transfer_count DO
                  IF path (j, 1) <> ' ' THEN
                    first_non_blank := path (j, 1);
                    EXIT /find_first_non_blank/;
                  IFEND;
                FOREND /find_first_non_blank/;
              IFEND;
              IF first_non_blank = ':' THEN
                IF link_list_node THEN
                  clp$make_list_value (work_area^, list_node^.link);
                  list_node := list_node^.link;
                ELSE
                  link_list_node := TRUE;
                IFEND;
                clp$make_file_value (path (1, transfer_count), work_area^, list_node^.element_value);
              IFEND;
            ELSEIF (file_position = amc$eoi) AND (i = 1) THEN
              CYCLE /file_loop/; {Return ame$input_after_eoi status after next get}
            ELSEIF NOT status.normal THEN
              RETURN;
            ELSE
              EXIT /file_loop/;
            IFEND;
          FOREND /file_loop/;
          clp$create_procedure_variable (pvt [p$variable_name].value^.name_value, clc$local_scope,
                clc$read_write, clc$immediate_evaluation, #SEQ (type_specification), list_variable, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND pfp$get_file_list;

MODEND pfm$change_catalog_contents;
