?? RIGHT := 110 ??
?? TITLE := ' NOS/VE Backup/Restore Utilities:  display_catalogs ' ??
MODULE pum$display_catalogs;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains procedures to display information from the permanent file catalog.

?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pus$literals
*copyc pfc$system_shared_queue_name
*copyc pud$backup_file
*copyc ame$attribute_validation_errors
*copyc pue$error_condition_codes
*copyc dmt$stored_fmd
*copyc dmt$stored_ms_fmd_header
*copyc dmt$stored_tape_fmd
*copyc dmt$stored_tape_fmd_version
*copyc fmt$static_label_header
*copyc fst$path_size
*copyc gft$file_kind
*copyc pft$cycle_info_desc_version_1
*copyc pft$cycle_info_desc_version_2
*copyc pft$device_class
*copyc rmt$tape_class
?? POP ??
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$trimmed_string_size
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$set_status_abnormal
*copyc pfp$convert_device_class_to_rm
*copyc pfp$convert_ord_to_shared_queue
*copyc pfp$find_archive_info
*copyc pfp$find_catalog_description
*copyc pfp$find_catalog_media
*copyc pfp$find_cycle_array
*copyc pfp$find_cycle_array_extended
*copyc pfp$find_cycle_array_version_2
*copyc pfp$find_cycle_directory
*copyc pfp$find_cycle_label
*copyc pfp$find_cycle_media
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_file_description
*copyc pfp$find_log_array
*copyc pfp$find_next_archive_entry
*copyc pfp$find_next_info_record
*copyc pfp$find_permit_array
*copyc pfp$get_family_info
*copyc pfp$get_item_info
*copyc pfp$get_master_catalog_info
*copyc pfp$get_multi_item_info
*copyc pfp$get_rem_media_req_info
*copyc pfp$get_rem_media_volume_list
*copyc pfp$get_set_list
*copyc pmp$convert_binary_unique_name
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pup$convert_gfn_to_string
*copyc pup$display_boolean
*copyc pup$display_integer
*copyc pup$display_line
*copyc pup$verify_system_administrator
*copyc puv$respf_backup_file_version
?? TITLE := '*** GLOBAL DEFINITIONS ***', EJECT ??

  CONST
    end_of_line = $CHAR (255);

  VAR
    catalog_info_selections: [READ, pus$literals] pft$catalog_info_selections :=
          [pfc$catalog_directory, pfc$catalog_description, pfc$catalog_permits, pfc$catalog_media_descriptor],
    file_info_selections: [READ, pus$literals] pft$file_info_selections :=
          [pfc$file_directory, pfc$file_description, pfc$file_permits, pfc$file_cycles_version_2,
          pfc$file_log, pfc$cycle_media_descriptor, pfc$cycle_label_descriptor],
    highest_date_time: [READ, pus$literals] ost$date_time := [255, 12, 31, 23, 59, 59, 999],
    master_catalog_path: [READ, pus$literals] array [1 .. 2] of pft$name := [osc$null_name, osc$null_name],
    no_file_info_selections: [READ, pus$literals] pft$file_info_selections := [],
    public_group: [READ, pus$literals] pft$group := [pfc$public];

?? TITLE := '*** PUP$DISPLAY_ALL_CATALOGS ***', EJECT ??

  PROCEDURE pup$display_all_catalogs;

    VAR
      directory_entry: pft$directory_array_entry,
      family_name: pft$name,
      index: pft$array_index,
      name_type: pft$name_type,
      offset: pft$info_offset,
      p_catalog_record: pft$p_info_record,
      p_directory_array: pft$p_directory_array,
      p_info: pft$p_info,
      p_info_body: pft$p_info,
      p_info_record: pft$p_info_record,
      segment_pointer: amt$segment_pointer,
      set_list: ^stt$set_list,
      cset,
      number_of_sets: stt$number_of_sets,
      status: ost$status;

    display_line (' Start of pfp$display_all_catalogs.');
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment_pointer, status);
    p_info := segment_pointer.sequence_pointer;
    RESET p_info;
    number_of_sets := 20;
    FOR cset := 1 TO 2 DO
      PUSH set_list: [1 .. number_of_sets];
      pfp$get_set_list (set_list^, number_of_sets, status);
    FOREND;
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    FOR cset := 1 TO number_of_sets DO
      pfp$get_family_info (set_list^ [cset], catalog_info_selections, p_info, status);
      IF status.normal THEN
        RESET p_info;
        pfp$find_next_info_record (p_info, p_info_record, status);
        IF status.normal THEN
          pfp$find_directory_array (p_info_record, p_directory_array, status);
          IF status.normal THEN
            IF (p_directory_array <> NIL) THEN
              p_info_body := ^p_info_record^.body;

            /process_directory_array/
              FOR index := 1 TO UPPERBOUND (p_directory_array^) DO
                display_blank_line;
                directory_entry := p_directory_array^ [index];
                family_name := directory_entry.name;
                name_type := directory_entry.name_type;
                offset := directory_entry.info_offset;
                IF (name_type = pfc$catalog_name) THEN
                  pfp$find_direct_info_record (p_info_body, offset, p_catalog_record, status);
                  IF status.normal THEN
                    pup$display_catalog_info (family_name, p_catalog_record, 2, status);
                    IF status.normal THEN
                      display_blank_line;
                      display_family_content (set_list^ [cset], family_name, 4, p_info, status);
                    IFEND;
                  IFEND;
                  IF NOT status.normal THEN
                    EXIT /process_directory_array/; {----->
                  IFEND;
                IFEND;
              FOREND /process_directory_array/;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    FOREND;
    mmp$delete_scratch_segment (segment_pointer, status);
    display_line (' End of pfp$display_all_catalogs.');

  PROCEND pup$display_all_catalogs;
?? TITLE := '*** PUP$DISPLAY_ALL_CATALOGS_CMD ***', EJECT ??

  PROCEDURE [XDCL] pup$display_all_catalogs_cmnd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE disac_pdt (
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [105, 5, 19, 13, 20, 22, 629],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, 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$status_type]]];

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

    CONST
      p$status = 1;

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

    pup$verify_system_administrator ('DISPLAY_ALL_CATALOGS           ', NIL, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pup$display_all_catalogs;

  PROCEND pup$display_all_catalogs_cmnd;

?? TITLE := '*** PUP$DISPLAY_CATALOG_INFO ***', EJECT ??

  PROCEDURE [XDCL] pup$display_catalog_info
    (    catalog_name: pft$name;
         p_catalog_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      p_catalog_description: pft$p_catalog_description,
      p_catalog_media_description: pft$p_catalog_media_description,
      p_catalog_fmd: ^SEQ ( * );

    IF catalog_name <> '' THEN
      display_blanks (output_column - 1);
      display ('Catalog_name: ');
      display_name (catalog_name);
      display_line ('');
    IFEND;
    pfp$find_catalog_description (p_catalog_record, p_catalog_description, status);
    IF status.normal THEN
      display_charge_id (p_catalog_description^.charge_id, output_column + 2);
      display_blank_line;
      display_permit_info (p_catalog_record, output_column + 2, status);

      pfp$find_catalog_media (p_catalog_record, p_catalog_media_description, p_catalog_fmd, status);
      IF status.normal THEN
        display_catalog_media (p_catalog_media_description^, p_catalog_fmd, output_column + 2);
      ELSEIF status.condition = pfe$unknown_catalog_media THEN
        display_blanks (output_column + 1);
        display_line (' Catalog media not present ');
        status.normal := TRUE;
      IFEND;
    IFEND;
  PROCEND pup$display_catalog_info;

?? TITLE := '*** [XDCL] PUP$DISPLAY_CYCLE_INFO_DESC_V1 ***', EJECT ??
{       PUP$DISPLAY_CYCLE_INFO_DESC_V1
{

  PROCEDURE [XDCL] pup$display_cycle_info_desc_v1
    (    p_cycle_info_desc_version_1: ^pft$cycle_info_desc_version_1;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Cycle_number: ');
    display_integer (p_cycle_info_desc_version_1^.cycle_number);
    display_line ('');

    display_cycle_statistics (p_cycle_info_desc_version_1^.cycle_statistics, output_column);

    display_expiration_date_time (p_cycle_info_desc_version_1^.expiration_date_time, output_column);

  PROCEND pup$display_cycle_info_desc_v1;

?? TITLE := '*** [XDCL] PUP$DISPLAY_CYCLE_INFO_DESC_V2 ***', EJECT ??
{       PUP$DISPLAY_CYCLE_INFO_DESC_V2
{

  PROCEDURE [XDCL] pup$display_cycle_info_desc_v2
    (    p_cycle_info_desc_version_2: ^pft$cycle_info_desc_version_2;
         p_file_media_descriptor: ^SEQ ( * ),
         output_column: integer);

    VAR
      device_class: rmt$device_class,
      ignore: ost$status,
      local_status: ost$status,
      shared_queue_name: ost$name,
      unique_name: ost$name;

    display_cycle_damage_symptoms (p_cycle_info_desc_version_2^.cycle_damage_symptoms, output_column);

    display_blanks (output_column - 1);
    display ('Cycle_number: ');
    display_integer (p_cycle_info_desc_version_2^.cycle_number);
    display_line ('');

    display_cycle_statistics (p_cycle_info_desc_version_2^.cycle_statistics, output_column);

    display_blanks (output_column - 1);
    display ('Data_modification_date_time: ');
    display_date_time (p_cycle_info_desc_version_2^.data_modification_date_time);
    display_line ('');

    display_pf_device_class (p_cycle_info_desc_version_2^.device_class, output_column);

    display_expiration_date_time (p_cycle_info_desc_version_2^.expiration_date_time, output_column);

    display_blanks (output_column - 1);
    pmp$convert_binary_unique_name (p_cycle_info_desc_version_2^.original_unique_name, unique_name, ignore);
    display ('Original_unique_name: ');
    display (unique_name);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Sparse_backup_file_format: ');
    display_boolean (p_cycle_info_desc_version_2^.sparse_backup_file_format);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Shared_queue: ');
    IF p_cycle_info_desc_version_2^.shared_queue_info.defined THEN
      pfp$convert_ord_to_shared_queue (p_cycle_info_desc_version_2^.shared_queue_info.shared_queue,
            shared_queue_name, local_status);
      IF NOT local_status.normal THEN
        shared_queue_name := pfc$system_shared_queue_name;
      IFEND;
    ELSE
      shared_queue_name := pfc$system_shared_queue_name;
    IFEND;
    display (shared_queue_name);
    display_line ('');

    display_retrieve_option (p_cycle_info_desc_version_2^.retrieve_option, output_column);

    display_blanks (output_column - 1);
    display ('Site_archive_option: ');
    display_integer (p_cycle_info_desc_version_2^.site_archive_option);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Site_backup_option: ');
    display_integer (p_cycle_info_desc_version_2^.site_backup_option);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Site_release_option: ');
    display_integer (p_cycle_info_desc_version_2^.site_release_option);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Fmd_checksum: ');
    display_integer (p_cycle_info_desc_version_2^.fmd_checksum);
    display_line ('');

    IF p_file_media_descriptor <> NIL THEN
      pfp$convert_device_class_to_rm (p_cycle_info_desc_version_2^.device_class, device_class);
      pup$display_fmd (device_class, p_file_media_descriptor^, output_column, ignore);
    ELSE
      display_blanks (output_column - 1);
      display_line ('File Media Descriptor Not Present');
    IFEND;

  PROCEND pup$display_cycle_info_desc_v2;

?? TITLE := '*** PUP$DISPLAY_FILE_INFO ***', EJECT ??
{       PUP$DISPLAY_FILE_INFO -
{

  PROCEDURE [XDCL] pup$display_file_info
    (    file_name: pft$name;
         p_file_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      column: integer;

    IF file_name <> osc$null_name THEN
      display_blanks (output_column - 1);
      display ('File_name: ');
      display_name (file_name);
      display_line ('');
    IFEND;

    column := output_column + 2;
    display_file_description (p_file_record, column, status);
    IF status.normal THEN
      display_blank_line;
      display_permit_info (p_file_record, column, status);
    IFEND;

    IF status.normal THEN
      display_blank_line;
      display_log_info (p_file_record, column, status);
    IFEND;

    IF status.normal THEN
      display_blank_line;
      display_cycle_info (p_file_record, column, status);
    IFEND;

    IF status.normal THEN
      display_blank_line;
      display_cycle_info_extended (p_file_record, column, status);
    IFEND;
  PROCEND pup$display_file_info;
?? TITLE := '*** PUP$DISPLAY_FILE_LABEL ***', EJECT ??

  PROCEDURE [XDCL] pup$display_file_label
    (    file_label: SEQ ( * );
         output_column: integer;
     VAR status: ost$status);

    VAR
      p_file_label_header: ^fmt$static_label_header,
      p_label: ^SEQ ( * ),
      p_stored_checksum: ^integer;

    p_label := ^file_label;
    display_blanks (output_column);
    display_line (' File label ');
    RESET p_label;
    NEXT p_stored_checksum IN p_label;
    IF p_stored_checksum = NIL THEN
      osp$set_status_abnormal (amc$access_method_id, ame$damaged_file_attributes, 'static label checksum',
            status);
      RETURN; {----->
    ELSE
      display_blanks (output_column + 2);
      display (' Checksum : ');
      display_integer (p_stored_checksum^);
      display_line ('');
    IFEND;

    NEXT p_file_label_header IN p_label;
    IF p_file_label_header = NIL THEN
      osp$set_status_abnormal (amc$access_method_id, ame$damaged_file_attributes, ' p_file_label_header',
            status);
      RETURN; {----->
    IFEND;

    IF p_file_label_header^.unique_character = '%' THEN
      display_blanks (output_column + 2);
      IF p_file_label_header^.file_previously_opened THEN
        display_line (' File previously opened ');
        display_blanks (output_column + 2);
        display (' Ring Attributes = (');
        display_integer (p_file_label_header^.ring_attributes.r1);
        display (', ');
        display_integer (p_file_label_header^.ring_attributes.r2);
        display (', ');
        display_integer (p_file_label_header^.ring_attributes.r3);
        display (')');
        display_line ('');
      ELSE
        display_line (' File not opened ');
      IFEND;
      display_blanks (output_column + 2);
      display (' job_routing_label_size');
      display_integer (p_file_label_header^.job_routing_label_size);
      display_line ('');
      display_blanks (output_column + 2);
      display (' revision_level');
      display_integer (p_file_label_header^.revision_level);
      display_line ('');
    ELSE { unique character <> '%' }
      display_blanks (output_column + 2);
      display_line (' Not current revision of label ');
    IFEND;

  PROCEND pup$display_file_label;
?? TITLE := ' [XDCL]  PUP$DISPLAY_FMD', EJECT ??

  PROCEDURE [XDCL] pup$display_fmd
    (    device_class: rmt$device_class;
         fmd: SEQ ( * );
         output_column: integer;
     VAR status: ost$status);

    VAR
      file_kind: [STATIC, READ, pus$literals] array [gft$file_kind] of ost$name := [
            {} 'File_kind job_permanent_file',
            {} 'File_kind device_file',
            {} 'File_kind save 2',
            {} 'File_kind save 3',
            {} 'File_kind catalog',
            {} 'File_kind job local file',
            {} 'File_kind unnamed_file',
            {} 'File_kind global_unnamed_file',
            {} 'File_kind monitor_only_file'];

    VAR
      access_kinds: [STATIC, READ, pus$literals] array [dmc$read_access .. dmc$write_access] of ost$name :=
            ['dmc$read_access',
            {} 'dmc$write_access'];

    VAR
      write_lock: [STATIC, READ, pus$literals] array [dmc$no_write_lock .. dmc$write_flush_lock] of
            ost$name := [
            {} 'dmc$no_write_lock',
            {} 'dmc$write_lock',
            {} 'dmc$write_flush_lock'];

    VAR
      disk_class: [STATIC, READ, pus$literals] array [dmt$class_member] of ost$name := ['  A', ' B', ' C',
            ' D', ' E', ' F', ' G', ' H', ' I', ' J', ' K', ' L', ' M', ' N', ' O', ' P', ' Q', ' R', ' S',
            ' T', ' U', ' V', ' W', ' X', ' Y', ' Z'];

    VAR
      ms_volume_count: dmt$fmd_index,
      p_ms_fmd: ^dmt$stored_fmd,
      p_ms_fmd_header: ^dmt$stored_ms_fmd_header,
      p_ms_fmd_subfile: ^dmt$stored_ms_fmd_subfile,
      p_ms_fmd_version: ^dmt$stored_ms_version_number,
      p_tape_fmd: ^pft$fmd,
      p_tape_fmd_header: ^dmt$stored_tape_fmd_header,
      p_tape_fmd_version: ^dmt$stored_tape_fmd_version,
      p_volume_list: ^rmt$volume_list,
      removable_media_req_info: fmt$removable_media_req_info,
      subfile: integer,
      tape_volume_count: 0 .. amc$max_vol_number,
      unique_name_string: string (60),
      volume: integer;

    display_rm_device_class (device_class, output_column);

    IF device_class = rmc$mass_storage_device THEN

      p_ms_fmd := ^fmd;
      RESET p_ms_fmd;
      NEXT p_ms_fmd_version IN p_ms_fmd;
      IF p_ms_fmd_version = NIL THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$unable_to_read_catalog_info,
              'NIL mass storage fmd_version', status);
        RETURN; {----->
      IFEND;
      NEXT p_ms_fmd_header: [dmc$current_fmd_version] IN p_ms_fmd;
      IF p_ms_fmd_header = NIL THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$unable_to_read_catalog_info, 'NIL fmd_header',
              status);
        RETURN; {----->
      IFEND;
      ms_volume_count := p_ms_fmd_header^.version_0_0.number_fmds;

      display_blanks (output_column - 1);
      display_line ('File Media Descriptor');

      display_blanks (output_column + 1);
      display ('Fmd header');
      display_line ('');

      display_blanks (output_column + 3);
      display ('Fmd_version_number: ');
      display_integer (p_ms_fmd_header^.fmd_version_number);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Clear_space ');
      display_boolean (p_ms_fmd_header^.version_0_0.clear_space);
      display_line ('');

      display_blanks (output_column + 3);
      display ('File_hash ');
      display_integer (p_ms_fmd_header^.version_0_0.file_hash);
      display_line ('');

      display_blanks (output_column + 3);
      display ('File_limit ');
      display_integer (p_ms_fmd_header^.version_0_0.file_limit);
      display_line ('');

      display_blanks (output_column + 3);
      display_line (file_kind [p_ms_fmd_header^.version_0_0.file_kind]);

      display_blanks (output_column + 3);
      display ('Locked_file.required');
      display_boolean (p_ms_fmd_header^.version_0_0.locked_file.required);
      IF p_ms_fmd_header^.version_0_0.locked_file.required THEN
        display_line ('');
        display_blanks (output_column + 5);
        IF (p_ms_fmd_header^.version_0_0.locked_file.locks = dmc$read_access) OR
              (p_ms_fmd_header^.version_0_0.locked_file.locks = dmc$write_access) THEN
          display (access_kinds [p_ms_fmd_header^.version_0_0.locked_file.locks]);
        ELSE
          display ('unknown lock');
        IFEND;
        display (', Read_lock_count');
        display_integer (p_ms_fmd_header^.version_0_0.locked_file.read_lock_count);
        display (',');
        display (write_lock [p_ms_fmd_header^.version_0_0.locked_file.write_lock]);
      IFEND;
      display_line ('');

      display_blanks (output_column + 3);
      display ('Number_of_volumes ');
      display_integer (ms_volume_count);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Overflow_allowed ');
      display_boolean (p_ms_fmd_header^.version_0_0.overflow_allowed);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Preset_value ');
      display_integer (p_ms_fmd_header^.version_0_0.preset_value);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Requested_allocation_size ');
      display_integer (p_ms_fmd_header^.version_0_0.requested_allocation_size);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Requested_class ');
      display (disk_class [p_ms_fmd_header^.version_0_0.requested_class]);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Requested_class_ordinal ');
      display_integer (p_ms_fmd_header^.version_0_0.requested_class_ordinal);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Requested_transfer_size ');
      display_integer (p_ms_fmd_header^.version_0_0.requested_transfer_size);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Requested_volume (rvsn, set) : (');
      display_name (p_ms_fmd_header^.version_0_0.requested_volume.recorded_vsn);
      display (', ');
      display_name (p_ms_fmd_header^.version_0_0.requested_volume.setname);
      display_line (')');

      FOR subfile := 1 TO ms_volume_count DO

        display_blanks (output_column + 1);
        display ('Subfile number ');
        display_integer (subfile);
        display_line ('');

        NEXT p_ms_fmd_subfile: [dmc$current_fmd_version] IN p_ms_fmd;
        IF p_ms_fmd_subfile = NIL THEN
          osp$set_status_abnormal (puc$pf_utility_id, pue$unable_to_read_catalog_info, 'NIL stored_subfile ',
                status);
          RETURN; {----->
        IFEND;

        display_blanks (output_column + 3);
        display ('Fmd_version_number ');
        display_integer (p_ms_fmd_subfile^.fmd_version_number);
        display_line ('');

        display_blanks (output_column + 3);
        display ('Recorded_vsn: ');
        display_line (p_ms_fmd_subfile^.version_0_0.recorded_vsn);

        display_blanks (output_column + 3);
        display ('Byte_address ');
        display_integer (p_ms_fmd_subfile^.version_0_0.stored_byte_address * dmc$byte_address_converter);
        display_line ('');

        display_blanks (output_column + 3);
        display ('Device_file_list_index ');
        display_integer (p_ms_fmd_subfile^.version_0_0.device_file_list_index);
        display_line ('');

        pup$convert_gfn_to_string (p_ms_fmd_subfile^.version_0_0.internal_vsn, unique_name_string);
        display_blanks (output_column + 3);
        display ('Internal_vsn ');
        display_line (unique_name_string);

      FOREND;

    ELSEIF device_class = rmc$magnetic_tape_device THEN

      p_tape_fmd := ^fmd;
      RESET p_tape_fmd;
      NEXT p_tape_fmd_version IN p_tape_fmd;
      IF p_tape_fmd_version = NIL THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$unable_to_read_catalog_info, 'NIL tape fmd_version',
              status);
        RETURN; {----->
      IFEND;

      display_blanks (output_column + 1);
      display ('Fmd header');
      display_line ('');

      display_blanks (output_column + 3);
      display ('Fmd_version_number: ');
      display_integer ($INTEGER (p_tape_fmd_version^));
      display_line ('');

      pfp$get_rem_media_req_info (p_tape_fmd, ^removable_media_req_info, tape_volume_count, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      display_density (removable_media_req_info.density, output_column + 4);

      display_blanks (output_column + 3);
      display ('Removable_media_group: ');
      display_name (removable_media_req_info.removable_media_group);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Number_of_volumes ');
      display_integer (tape_volume_count);
      display_line ('');

      display_blanks (output_column + 3);
      display ('Volume_overflow_allowed: ');
      display_boolean (removable_media_req_info.volume_overflow_allowed);
      display_line ('');

      PUSH p_volume_list: [1 .. tape_volume_count];
      pfp$get_rem_media_volume_list (p_tape_fmd, p_volume_list, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      FOR volume := 1 TO tape_volume_count DO

        display_blanks (output_column + 3);
        display ('Volume number ');
        display_integer (volume);
        display_line ('');

        display_blanks (output_column + 5);
        display ('Recorded_vsn: ');
        display (p_volume_list^ [volume].recorded_vsn);
        display_line ('');

        display_blanks (output_column + 5);
        display ('External_vsn: ');
        display (p_volume_list^ [volume].external_vsn);
        display_line ('');

      FOREND;

    IFEND;

  PROCEND pup$display_fmd;

?? TITLE := '*** PUP$DISPLAY_MASTER_CATALOG ***', EJECT ??
{       PUP$DISPLAY_MASTER_CATALOG -
{

  PROCEDURE [XDCL] pup$display_master_catalog;

    VAR
      master_catalog_name: pft$name,
      offset: pft$info_offset,
      p_catalog_record: pft$p_info_record,
      p_directory_array: pft$p_directory_array,
      p_info: pft$p_info,
      p_info_body: pft$p_info,
      p_info_record: pft$p_info_record,
      segment_pointer: amt$segment_pointer,
      status: ost$status;

    display_line (' Start of pfp$display_master_catalog.');
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment_pointer, status);
    p_info := segment_pointer.sequence_pointer;
    RESET p_info;
    pfp$get_item_info (master_catalog_path, public_group, catalog_info_selections, no_file_info_selections,
          p_info, status);
    IF status.normal THEN
      RESET p_info;
      pfp$find_next_info_record (p_info, p_info_record, status);
      IF status.normal THEN
        pfp$find_directory_array (p_info_record, p_directory_array, status);
        IF status.normal THEN
          master_catalog_name := p_directory_array^ [1].name;
          offset := p_directory_array^ [1].info_offset;
          p_info_body := ^p_info_record^.body;
          pfp$find_direct_info_record (p_info_body, offset, p_catalog_record, status);
          IF status.normal THEN
            pup$display_catalog_info (master_catalog_name, p_catalog_record, 2, status);
            IF status.normal THEN
              RESET p_info;
              display_blank_line;
              display_catalog_content (master_catalog_path, 4, p_info, status);
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
    mmp$delete_scratch_segment (segment_pointer, status);
    display_line (' End of pfp$display_master_catalog.');
  PROCEND pup$display_master_catalog;
?? TITLE := '    [XDCL] pup$display_master_catalog_cmnd ', EJECT ??

  PROCEDURE [XDCL] pup$display_master_catalog_cmnd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE dismc_pdt (
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [105, 5, 19, 13, 18, 52, 977],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, 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$status_type]]];

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

    CONST
      p$status = 1;

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

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pup$display_master_catalog;

  PROCEND pup$display_master_catalog_cmnd;

?? TITLE := '*** DISPLAY ***', EJECT ??
{       DISPLAY -
{

  PROCEDURE display
    (    strng: string ( * ));

    VAR
      index: [STATIC] integer := 1,
      line: [STATIC] string (255),
      size: integer,
      space: integer,
      status: ost$status;

    size := STRLENGTH (strng);
    IF (size > 0) THEN
      IF (strng = end_of_line) THEN
        pup$display_line (line (1, (index - 1)), status);
        index := 1;
      ELSE
        space := STRLENGTH (line) - index + 1;
        IF (size > space) THEN
          size := space;
        IFEND;
        line (index, size) := strng (1, size);
        index := index + size;
      IFEND;
    IFEND;
  PROCEND display;
?? TITLE := '*** DISPLAY_ACCESS_COUNT ***', EJECT ??
{       DISPLAY_ACCESS_COUNT -
{

  PROCEDURE display_access_count
    (    access_count: pft$access_count;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Access_count: ');
    display_integer (access_count);
    display_line ('');
  PROCEND display_access_count;
?? TITLE := '*** DISPLAY_ACCESS_DATE_TIME ***', EJECT ??
{       DISPLAY_ACCESS_DATE_TIME -
{

  PROCEDURE display_access_date_time
    (    access_date_time: ost$date_time;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Access_date_time: ');
    display_date_time (access_date_time);
    display_line ('');
  PROCEND display_access_date_time;
?? TITLE := '*** DISPLAY_ACCOUNT_NAME ***', EJECT ??
{       DISPLAY_ACCOUNT_NAME -
{

  PROCEDURE display_account_name
    (    account_name: avt$account_name;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Account: ');
    display_name (account_name);
    display_line ('');
  PROCEND display_account_name;

?? TITLE := 'DUMP_AMD', EJECT ??

  PROCEDURE dump_amd
    (VAR p_amd: pft$p_amd;
         output_column: integer);

    VAR
      amd_string_size: integer,
      p_amd_string: ^string ( * );

    RESET p_amd;
    amd_string_size := #SIZE (p_amd^);
    NEXT p_amd_string: [amd_string_size] IN p_amd;

    display_line (p_amd_string^ (1, amd_string_size));

  PROCEND dump_amd;

?? TITLE := 'DISPLAY_AMD', EJECT ??

  PROCEDURE display_amd
    (VAR amd_p: pft$p_amd;
         output_column: integer);

{NOTE: The following definitions reflect are ARCHIVE_VE definitions!

    TYPE
      t#afmd_descriptor = record {art$afmd_descriptor
        legible_media_descriptors_r: REL (SEQ ( * )) ^t#legible_media_descriptors,
        media_container_r: REL (SEQ ( * )) ^SEQ ( * ),
        case kind: 0 .. 0ff(16) of {art$afmd_descriptor_kind
        = 0 = {arc$system_supplied_descriptor
          version: 0 .. 15, {art$system_descriptor_version
        = 1 = {arc$side_supplied_descriptor
        casend,
      recend,
      t#legible_media_descriptors = array [1 .. * ] of t#legible_media_descriptor,
      t#legible_media_descriptor = string (osc$max_name_size), {art$legible_media_descriptor
      t#system_media_container = record {
        kind: 0 .. 0ff(16), {art$media_container_kind
        media_container: SEQ ( * ), {art$media_container
      recend;


    VAR
      afmd_container_p: pft$p_amd,
      afmd_descriptor_p: ^t#afmd_descriptor,
      i: integer,
      legible_media_descriptors_p: ^t#legible_media_descriptors,
      media_container_p: ^SEQ ( * ),
      sys_container_p: ^t#system_media_container,
      sys_container_size: integer;

?? NEWTITLE := 'add_css_container', EJECT ??

    PROCEDURE add_css_container
      (    tape_media_container_p: ^SEQ ( * ));

      display_line ('CSS Tape Container - details suppressed');

    PROCEND add_css_container;
?? OLDTITLE ??
?? NEWTITLE := 'add_nos_container', EJECT ??

    PROCEDURE add_nos_container
      (    tape_media_container_p: ^SEQ ( * ));

      display_line ('NOS Container - details suppressed');

    PROCEND add_nos_container;
?? OLDTITLE ??
?? NEWTITLE := 'add_tape_container', EJECT ??

    PROCEDURE add_tape_container
      (    tape_media_container_p: ^SEQ ( * ));

      TYPE
        t#system_tape_container = SEQ ( * ),
        t#system_tape_descriptor_v0 = record
          tape_media_status: t#tape_media_status,
          file_position: t#relative_file_position,
          original_path_name_r: REL (SEQ ( * )) ^pft$path,
          original_cycle_number: fst$cycle_number,
          number_of_tapes: t#number_of_media,
          case source: t#tape_descriptor_source of
          = c#system_tape_descriptor =
            tape_class: rmt$tape_class,
            tape_density: rmt$density,
            system_supplied_r: REL (SEQ ( * )) ^rmt$volume_list,
          = c#site_tape_descriptor =
            site_supplied: integer,
          casend,
        recend,
        t#system_tape_descriptor_v3 = record
          version: t#tape_descriptor_version, {art$tape_descriptor_version
          v0: t#system_tape_descriptor_v0,
        recend,
        t#tape_descriptor_version = 0 .. 15, { art$tape_descriptor_version
        t#tape_media_status = set of t#tape_media_condition,
        t#tape_media_condition = (c#tape_media_condition_1, c#tape_media_condition_2,
              c#tape_media_condition_3, c#tape_media_condition_4, c#tape_media_condition_5,
              c#tape_media_condition_6, c#tape_media_condition_7, c#tape_media_condition_8),
        t#relative_file_position = 0 .. 0ffff(16),
        t#number_of_media = 0 .. 100,
        t#tape_descriptor_source = (c#system_tape_descriptor, c#site_tape_descriptor);

      VAR
        container_p: ^t#system_tape_container,
        path_p: ^pft$path,
        tape_descriptor_p: ^t#system_tape_descriptor_v0,
        tape_list_p: ^rmt$volume_list,
        version: t#tape_descriptor_version,
        version_p: ^t#tape_descriptor_version;

?? NEWTITLE := 'add_pft$path', EJECT ??

      PROCEDURE add_pft$path
        (    path: pft$path;
             cycle_number: fst$cycle_number);

        VAR
          i: integer,
          local_status: ost$status,
          name_size: ost$name_size,
          size: fst$path_size,
          str: ost$string,
          value: fst$path;

        size := 1;
        value (1) := ':';
        FOR i := 1 TO UPPERBOUND (path) DO
          name_size := clp$trimmed_string_size (path [i]);
          value (size + 1, name_size) := path [i];
          value (size + name_size + 1, 1) := '.';
          size := size + name_size + 1;
        FOREND;

        clp$convert_integer_to_string (cycle_number, 10 {radix} , FALSE {exclude radix} , str, local_status);
        value (size + 1, str.size) := str.value (1, str.size);
        size := size + str.size;

        IF (UPPERBOUND (path) >= LOWERBOUND (path)) AND (local_status.normal) AND
              (size <= fsc$max_path_size) THEN
          display_line (value (1, size));
        ELSE
          display_line ('<improper pft$path');
        IFEND;

      PROCEND add_pft$path;
?? OLDTITLE ??
?? NEWTITLE := 'add_tape_media_status', EJECT ??

      PROCEDURE add_tape_media_status
        (    tape_media_status: t#tape_media_status);

        VAR
          displayed: boolean,
          tape_media_condition: t#tape_media_condition;

        display_blanks (output_column + 2);
        display ('Tape_Media_Status :');
        displayed := FALSE;

        FOR tape_media_condition := LOWERVALUE (tape_media_condition) TO UPPERVALUE (tape_media_condition) DO
          IF tape_media_condition IN tape_media_status THEN
            IF displayed THEN
              display (',');
            IFEND;

            CASE tape_media_condition OF
            = c#tape_media_condition_1 =
              display (' ERROR_FREE');
            = c#tape_media_condition_2 =
              display (' PARITY_ERRORS');
            ELSE
              display_integer ($INTEGER (tape_media_condition));
            CASEND;
            displayed := TRUE;
          IFEND;
        FOREND;

        IF NOT displayed THEN
          display_line ('[]');
        ELSE
          display_line ('');
        IFEND;

      PROCEND add_tape_media_status;
?? OLDTITLE ??
?? NEWTITLE := 'add_tape_vsn_list', EJECT ??

      PROCEDURE add_tape_vsn_list
        (    tape_list_p: ^rmt$volume_list);

        VAR
          i: integer;

        IF tape_list_p = NIL THEN
          display_line ('()');
          RETURN; {----->
        IFEND;

        display ('(');
        FOR i := LOWERBOUND (tape_list_p^) TO UPPERBOUND (tape_list_p^) DO
          IF i > LOWERBOUND (tape_list_p^) THEN
            display (', ');
          IFEND;
          display ('(');
          display (tape_list_p^ [i].recorded_vsn);
          display (', ');
          display (tape_list_p^ [i].external_vsn);
          display (')');
        FOREND;
        display_line (')');

      PROCEND add_tape_vsn_list;
?? OLDTITLE ??
?? EJECT ??
      container_p := tape_media_container_p;
      NEXT version_p IN container_p;
      IF version_p = NIL THEN
        display_line ('<improper Tape Container>');
        RETURN; {----->
      IFEND;

      IF version_p^ = 3 THEN
        version := 3;
        NEXT tape_descriptor_p IN container_p;
      ELSE
        version := 0;
        RESET container_p;
        NEXT tape_descriptor_p IN container_p;
      IFEND;

      IF tape_descriptor_p = NIL THEN
        display_line ('<improper Tape Container>');
        RETURN; {----->
      IFEND;

      path_p := #PTR (tape_descriptor_p^.original_path_name_r, container_p^);
      tape_list_p := #PTR (tape_descriptor_p^.system_supplied_r, container_p^);

      display_line ('Tape Container');
      display_blanks (output_column + 2);
      display ('Version :');
      display_integer (version);
      display_line ('');

{ Tape Media Status
      add_tape_media_status (tape_descriptor_p^.tape_media_status);

{ Relative File Position
      display_blanks (output_column + 2);
      display ('Relative_File_Position :');
      display_integer (tape_descriptor_p^.file_position);
      display_line ('');

{ Original Path
      display_blanks (output_column + 2);
      display ('Original_Path : ');
      IF path_p <> NIL THEN
        add_pft$path (path_p^, tape_descriptor_p^.original_cycle_number);
      ELSE
        display_line ('<unspecified>');
      IFEND;

{ Number of Tapes
      display_blanks (output_column + 2);
      display ('Number_Of_Tapes :');
      display_integer (tape_descriptor_p^.number_of_tapes);
      display_line ('');

*if false
{ - not displayed, probably always system...
{ Tape Descriptor Source
      local_node_pp^^.field_values^ [field_number].name := 'TAPE_DESCRIPTOR_SOURCE';
      clp$make_unspecified_value (work_area, local_node_pp^^.field_values^ [field_number].value);
      field_number := field_number + 1;
*ifend

{ Tape Density
      display_blanks (output_column + 2);
      display ('Density : ');
      CASE tape_descriptor_p^.tape_class OF
      = rmc$mt7 =
        display ('MT7$');
      = rmc$mt9 =
        display ('MT9$');
      = rmc$mt18 =
        display ('MT18$');
      ELSE
        display ('Unknown$');
      CASEND;

      CASE tape_descriptor_p^.tape_density OF
      = rmc$200 =
        display_line ('200');
      = rmc$556 =
        display_line ('556');
      = rmc$800 =
        display_line ('800');
      = rmc$1600 =
        display_line ('1600');
      = rmc$6250 =
        display_line ('6250');
      = rmc$38000 =
        display_line ('38000');
      ELSE
        display_line ('Unknown');
      CASEND;

{ VSN_List
      display_blanks (output_column + 2);
      display ('VSN_List : ');
      add_tape_vsn_list (tape_list_p);

    PROCEND add_tape_container;
?? OLDTITLE ??
?? EJECT ??
    display_blanks (output_column - 2);
    display ('Archive Media Descriptor: ');

    afmd_container_p := amd_p;
    RESET afmd_container_p;
    NEXT afmd_descriptor_p IN afmd_container_p;
    IF afmd_descriptor_p = NIL THEN
      dump_amd (amd_p, output_column);
      RETURN; {----->
    IFEND;
    display_line ('');

{ Kind
    display_blanks (output_column);
    display ('Kind : ');
    CASE afmd_descriptor_p^.kind OF
    = 0 = {arc$system_supplied_descriptor
      display ('SYSTEM_SUPPLIED_DESCRIPTOR');

    = 1 = {arc$side_supplied_descriptor
      display ('SITE_SUPPLIED_DESCRIPTOR');

    ELSE
      display_integer (afmd_descriptor_p^.kind);
    CASEND;
    display_line ('');

{ Version
    IF afmd_descriptor_p^.kind = 0 THEN
      display_blanks (output_column);
      display ('Version : ');
      display_integer (afmd_descriptor_p^.version);
      display_line ('');
    IFEND;

{ Legible Media Descriptor
    display_blanks (output_column);
    display ('Legible_Media_Descriptor : ');
    legible_media_descriptors_p := #PTR (afmd_descriptor_p^.legible_media_descriptors_r, afmd_container_p^);

    IF (legible_media_descriptors_p = NIL)
{         } OR (LOWERBOUND (legible_media_descriptors_p^) > UPPERBOUND (legible_media_descriptors_p^)) THEN
      display_line ('<improper LEGIBLE_MEDIA_DESCRIPTOR>');
    ELSE
      FOR i := LOWERBOUND (legible_media_descriptors_p^) TO UPPERBOUND (legible_media_descriptors_p^) DO
        IF i <> LOWERBOUND (legible_media_descriptors_p^) THEN
          display_blanks (output_column + 2);
        IFEND;
        display_line (legible_media_descriptors_p^ [i] (1, clp$trimmed_string_size (
              legible_media_descriptors_p^ [i])));
      FOREND;
    IFEND;

{ Media Container
    IF afmd_descriptor_p^.kind = 0 THEN
      display_blanks (output_column);
      display ('Media_Container : ');

      media_container_p := #PTR (afmd_descriptor_p^.media_container_r, afmd_container_p^);
      sys_container_p := NIL;

      IF media_container_p <> NIL THEN
        sys_container_size := #SIZE (media_container_p^) - 1;
        NEXT sys_container_p: [[REP sys_container_size OF cell]] IN media_container_p;
      IFEND;

      IF sys_container_p = NIL THEN
        display ('<improper Media Container>');
      ELSE
        CASE sys_container_p^.kind OF
        = 1 = { arc$tape_container
          add_tape_container (^sys_container_p^.media_container);

        = 2 = { arc$nos_container
          add_nos_container (^sys_container_p^.media_container);

        = 3 = { arc$css_container
          add_css_container (^sys_container_p^.media_container);

        ELSE
          display_line ('Unsupported Container');
        CASEND;
      IFEND;
    IFEND;

  PROCEND display_amd;

?? TITLE := '*** DISPLAY_APPLICATION_INFO ***', EJECT ??
{       DISPLAY_APPLICATION_INFO -
{

  PROCEDURE display_application_info
    (    application_info: pft$application_info;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Application_info: ');
    display_name (application_info);
    display_line ('');
  PROCEND display_application_info;

?? TITLE := '*** DISPLAY_ARCHIVE_ARRAY_ENTRY ***', EJECT ??
{       DISPLAY_ARCHIVE_ARRAY_ENTRY
{

  PROCEDURE display_archive_array_entry
    (    p_archive_array_entry: pft$p_archive_array_entry;
         output_column: integer);

    display_blanks (output_column);
    display ('Version: ');
    IF p_archive_array_entry^.version = pfc$archive_entry_version_1 THEN
      display_line ('pfc$archive_entry_version_1');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_2 THEN
      display_line ('pfc$archive_entry_version_2');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_3 THEN
      display_line ('pfc$archive_entry_version_3');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_4 THEN
      display_line ('pfc$archive_entry_version_4');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_5 THEN
      display_line ('pfc$archive_entry_version_5');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_6 THEN
      display_line ('pfc$archive_entry_version_6');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_7 THEN
      display_line ('pfc$archive_entry_version_7');
    ELSEIF p_archive_array_entry^.version = pfc$archive_entry_version_8 THEN
      display_line ('pfc$archive_entry_version_8');
    IFEND;

    display_blanks (output_column);
    display ('Archive_date_time: ');
    display_date_time (p_archive_array_entry^.archive_date_time);
    display_line ('');

    display_blanks (output_column);
    display_line ('Archive_identification');

    display_blanks (output_column + 2);
    display ('Application_identifier: ');
    display_name (p_archive_array_entry^.archive_identification.application_identifier);
    display_line ('');

    display_blanks (output_column + 2);
    display ('Media_device_class: ');
    display_name (p_archive_array_entry^.archive_identification.media_identifier.media_device_class);
    display_line ('');

    display_blanks (output_column + 2);
    display ('Media_volume_identifier: ');
    display_name (p_archive_array_entry^.archive_identification.media_identifier.media_volume_identifier);
    display_line ('');

    display_blanks (output_column);
    display ('File_size: ');
    display_integer (p_archive_array_entry^.file_size);
    display_line ('');

    display_blanks (output_column);
    display ('Last_release_date_time: ');
    display_date_time (p_archive_array_entry^.last_release_date_time);
    display_line ('');

    display_blanks (output_column);
    display_line ('Last_retrieval_status');

    display_blanks (output_column + 2);
    display ('Retrieval_date_time: ');
    display_date_time (p_archive_array_entry^.last_retrieval_status.retrieval_date_time);
    display_line ('');

    display_blanks (output_column + 4);
    display_line ('Status');

    display_blanks (output_column + 6);
    display ('Normal: ');
    display_boolean (p_archive_array_entry^.last_retrieval_status.normal);
    display_line ('');

    IF NOT p_archive_array_entry^.last_retrieval_status.normal THEN
      display_blanks (output_column + 6);
      display ('Condition: ');
      display_integer (p_archive_array_entry^.last_retrieval_status.condition);
      display_line ('');
    IFEND;

    display_modification_date_time (p_archive_array_entry^.modification_date_time, output_column + 1);

    display_blanks (output_column);
    display_line ('Release_candidate');

    display_blanks (output_column + 2);
    display ('Releasable:');
    display_boolean (p_archive_array_entry^.release_candidate.releasable);
    display_line ('');

    IF p_archive_array_entry^.release_candidate.releasable THEN
      display_blanks (output_column + 2);
      display ('Mark_date_time: ');
      display_date_time (p_archive_array_entry^.release_candidate.mark_date_time);
      display_line ('');
    IFEND;

  PROCEND display_archive_array_entry;

?? TITLE := '*** DISPLAY_ARCHIVE_INFO ***', EJECT ??
{       DISPLAY_ARCHIVE_INFO
{

  PROCEDURE display_archive_info
    (    p_archive_info_record: { input } pft$p_info_record;
         output_column: integer);

    VAR
      archive_identification: pft$archive_identification,
      p_archive_array_entry: pft$p_archive_array_entry,
      p_info_record: pft$p_info_record,
      p_info: pft$p_info,
      p_amd: pft$p_amd,
      status: ost$status;

    display_blank_line;
    display_blanks (output_column);
    display_line ('Archive Info ');
    p_info := ^p_archive_info_record^.body;
    archive_identification.application_identifier := osc$null_name;
    archive_identification.media_identifier.media_device_class := osc$null_name;
    archive_identification.media_identifier.media_volume_identifier := '';

    REPEAT
      pfp$find_next_archive_entry (archive_identification, p_info, p_info_record, p_archive_array_entry,
            p_amd, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      display_blanks (output_column + 2);
      display_line ('Archive Entry ');
      IF p_archive_array_entry <> NIL THEN
        display_archive_array_entry (p_archive_array_entry, output_column + 2);
      IFEND;
      IF p_amd <> NIL THEN
        display_amd (p_amd, output_column + 4);
      IFEND;
      display_blank_line;
    UNTIL FALSE;

  PROCEND display_archive_info;

?? TITLE := '*** DISPLAY_BOOLEAN  ***', EJECT ??

  PROCEDURE display_boolean
    (    value: boolean);

    IF value THEN
      display (' TRUE ');
    ELSE
      display (' FALSE ');
    IFEND;
  PROCEND display_boolean;
?? TITLE := '*** DISPLAY_BLANK_LINE ***', EJECT ??
{       DISPLAY_BLANK_LINE -
{

  PROCEDURE display_blank_line;

    display_line (' ');
  PROCEND display_blank_line;
?? TITLE := '*** DISPLAY_BLANKS ***', EJECT ??
{       DISPLAY_BLANKS -
{

  PROCEDURE display_blanks
    (    blank_count: integer);

    VAR
      blanks: [STATIC] string (255) := ' ',
      size: integer;

    size := STRLENGTH (blanks);
    IF (size > blank_count) THEN
      size := blank_count;
    IFEND;
    IF (size > 0) THEN
      display (blanks (1, size));
    IFEND;
  PROCEND display_blanks;
?? TITLE := '*** DISPLAY_CATALOG_CONTENT ***', EJECT ??
{       DISPLAY_CATALOG_CONTENT -
{

  PROCEDURE display_catalog_content
    (    path: pft$path;
         output_column: integer;
         p_info: pft$p_info;
     VAR status: ost$status);

    VAR
      directory_entry: pft$directory_array_entry,
      index: pft$array_index,
      item_name: pft$name,
      local_p_info: pft$p_info,
      name_type: pft$name_type,
      offset: pft$info_offset,
      p_directory_array: pft$p_directory_array,
      p_info_body: pft$p_info,
      p_info_record: pft$p_info_record,
      p_item_record: pft$p_info_record,
      p_successor_path: ^pft$path,
      successor_index: pft$array_index;

    successor_index := UPPERBOUND (path) + 1;
    PUSH p_successor_path: [1 .. successor_index];

  /copy_path/
    FOR index := 1 TO UPPERBOUND (path) DO
      p_successor_path^ [index] := path [index];
    FOREND /copy_path/;
    local_p_info := p_info;
    pfp$get_multi_item_info (path, public_group, catalog_info_selections, file_info_selections, local_p_info,
          status);
    IF status.normal THEN
      local_p_info := p_info;
      pfp$find_next_info_record (local_p_info, p_info_record, status);
      IF status.normal THEN
        pfp$find_directory_array (p_info_record, p_directory_array, status);
        IF status.normal THEN
          IF (p_directory_array <> NIL) THEN
            p_info_body := ^p_info_record^.body;

          /process_directory_array/
            FOR index := 1 TO UPPERBOUND (p_directory_array^) DO
              display_blank_line;
              directory_entry := p_directory_array^ [index];
              item_name := directory_entry.name;
              name_type := directory_entry.name_type;
              offset := directory_entry.info_offset;
              pfp$find_direct_info_record (p_info_body, offset, p_item_record, status);
              IF status.normal THEN
                CASE name_type OF
                = pfc$file_name =
                  pup$display_file_info (item_name, p_item_record, output_column, status);
                = pfc$catalog_name =
                  pup$display_catalog_info (item_name, p_item_record, output_column, status);
                  IF status.normal THEN
                    display_blank_line;
                    p_successor_path^ [successor_index] := item_name;
                    display_catalog_content (p_successor_path^, output_column + 2, local_p_info, status);
                  IFEND;
                ELSE
                CASEND;
              IFEND;
              IF NOT status.normal THEN
                EXIT /process_directory_array/; {----->
              IFEND;
            FOREND /process_directory_array/;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND display_catalog_content;
?? TITLE := '*** DISPLAY_CATALOG_MEDIA  ***', EJECT ??

  PROCEDURE display_catalog_media
    (    catalog_media_description: pft$catalog_media_description;
         p_catalog_media: ^SEQ ( * );
         output_column: integer);

    VAR
      unique_name: ost$name,
      ignore: ost$status;

    display_blanks (output_column - 1);
    display_line ('Catalog media description ');
    pmp$convert_binary_unique_name (catalog_media_description.internal_name, unique_name, ignore);
    display_blanks (output_column + 1);
    display ('Internal name :');
    display (unique_name);
    display_line ('');

    display_blanks (output_column + 1);
    IF catalog_media_description.catalog_type = pfc$external_catalog THEN
      display_line ('External catalog ');

      display_blanks (output_column + 1);
      pmp$convert_binary_unique_name (catalog_media_description.global_file_name, unique_name, ignore);
      display ('Global file name: ');
      display (unique_name);
      display_line ('');

      display_blanks (output_column + 1);
      display ('Checksum ');
      display_integer (catalog_media_description.checksum);
      display_line ('');

      display_blanks (output_column + 1);
      display ('Media type [version=');
      display_integer ($INTEGER (catalog_media_description.file_media_type.media_version));

      pup$display_fmd (catalog_media_description.file_media_type.device_class, p_catalog_media^,
            output_column + 1, ignore);
    ELSE
      display_line ('Internal catalog ');
    IFEND;

  PROCEND display_catalog_media;

?? TITLE := '*** DISPLAY_CHARGE_ID ***', EJECT ??
{       DISPLAY_CHARGE_ID -
{

  PROCEDURE display_charge_id
    (    charge_id: pft$charge_id;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Charge_id: ');
    display_name (charge_id.account);
    display (', ');
    display_name (charge_id.project);
    display_line ('');
  PROCEND display_charge_id;
?? TITLE := '*** DISPLAY_CREATION_DATE_TIME ***', EJECT ??
{       DISPLAY_CREATION_DATE_TIME -
{

  PROCEDURE display_creation_date_time
    (    creation_date_time: ost$date_time;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Creation_date_time: ');
    display_date_time (creation_date_time);
    display_line ('');
  PROCEND display_creation_date_time;

?? TITLE := '*** DISPLAY_CYCLE_ARRAY_ENTRY_V1 ***', EJECT ??
{       DISPLAY_CYCLE_ARRAY_ENTRY_V1
{

  PROCEDURE display_cycle_array_entry_v1
    (    cycle_array_entry: pft$cycle_array_entry;
         output_column: integer);

    VAR
      ignore: ost$status;

    display_blanks (output_column - 1);
    display ('Cycle_number: ');
    display_integer (cycle_array_entry.cycle_number);
    display_line ('');

    display_cycle_statistics (cycle_array_entry.cycle_statistics, output_column);

    display_expiration_date_time (cycle_array_entry.expiration_date_time, output_column);

  PROCEND display_cycle_array_entry_v1;

?? TITLE := '*** DISPLAY_CYCLE_ARRAY_ENTRY_V2 ***', EJECT ??
{       DISPLAY_CYCLE_ARRAY_ENTRY_V2
{

  PROCEDURE display_cycle_array_entry_v2
    (    cycle_array_entry: pft$cycle_array_entry_version_2;
         output_column: integer);

    VAR
      ignore: ost$status,
      local_status: ost$status,
      shared_queue_name: ost$name,
      unique_name: ost$name;

    display_blanks (output_column - 1);
    display ('Bytes_allocated: ');
    display_integer (cycle_array_entry.bytes_allocated);
    display_line ('');

    display_cycle_damage_symptoms (cycle_array_entry.cycle_damage_symptoms, output_column);

    display_blanks (output_column - 1);
    display ('Cycle_number: ');
    display_integer (cycle_array_entry.cycle_number);
    display_line ('');

    display_cycle_statistics (cycle_array_entry.cycle_statistics, output_column);

    display_blanks (output_column - 1);
    display ('Data_modification_date_time: ');
    display_date_time (cycle_array_entry.data_modification_date_time);
    display_line ('');

    display_data_residence (cycle_array_entry.data_residence, output_column);

    display_rm_device_class (cycle_array_entry.device_class, output_column);

    display_blanks (output_column - 1);
    display ('EOI: ');
    display_integer (cycle_array_entry.bytes_allocated);
    display_line ('');

    display_expiration_date_time (cycle_array_entry.expiration_date_time, output_column);

    display_blanks (output_column - 1);
    pmp$convert_binary_unique_name (cycle_array_entry.original_unique_name, unique_name, ignore);
    display ('Original_unique_name: ');
    display (unique_name);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Sparse_allocation: ');
    display_boolean (cycle_array_entry.sparse_allocation);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Shared_queue: ');
    IF cycle_array_entry.shared_queue_info.defined THEN
      pfp$convert_ord_to_shared_queue (cycle_array_entry.shared_queue_info.shared_queue, shared_queue_name,
            local_status);
      IF NOT local_status.normal THEN
        shared_queue_name := pfc$system_shared_queue_name;
      IFEND;
    ELSE
      shared_queue_name := pfc$system_shared_queue_name;
    IFEND;
    display (shared_queue_name);
    display_line ('');

    display_retrieve_option (cycle_array_entry.retrieve_option, output_column);

    display_blanks (output_column - 1);
    display ('Site_archive_option: ');
    display_integer (cycle_array_entry.site_archive_option);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Site_backup_option: ');
    display_integer (cycle_array_entry.site_backup_option);
    display_line ('');

    display_blanks (output_column - 1);
    display ('Site_release_option: ');
    display_integer (cycle_array_entry.site_release_option);
    display_line ('');

  PROCEND display_cycle_array_entry_v2;

?? TITLE := '*** DISPLAY_CYCLE_DAMAGE_SYMPTOMS ***', EJECT ??
{       DISPLAY_CYCLE_DAMAGE_SYMPTOMS -
{

  PROCEDURE display_cycle_damage_symptoms
    (    cycle_damage_symptoms: fst$cycle_damage_symptoms;
         output_column: integer);

    VAR
      first_selection: boolean,
      cycle_damage_symptom: fst$cycle_damage_symptom;

    display_blanks (output_column - 1);
    display ('Cycle_damage_symptoms: [');
    first_selection := TRUE;

  /display_damage_symptoms/
    FOR cycle_damage_symptom := LOWERVALUE (cycle_damage_symptom) TO UPPERVALUE (cycle_damage_symptom) DO
      IF (cycle_damage_symptom IN cycle_damage_symptoms) THEN
        IF NOT first_selection THEN
          display (', ');
        IFEND;
        first_selection := FALSE;
        CASE cycle_damage_symptom OF
        = fsc$media_image_inconsistent =
          display ('Media_image_inconsistent');
        = fsc$respf_modification_mismatch =
          display ('Respf_modification_mismatch');
        = fsc$cycle_restored =
          display ('Cycle_restored');
        = fsc$parent_catalog_restored =
          display ('Parent_catalog_restored');
        ELSE
        CASEND;
      IFEND;
    FOREND /display_damage_symptoms/;
    display_line (']');
  PROCEND display_cycle_damage_symptoms;

?? TITLE := ' *** DISPLAY_CYCLE_EXTENDED_ENTRY ***', EJECT ??

  PROCEDURE display_cycle_extended_entry
    (    cycle_array_entry: pft$cycle_directory_array_entry;
         p_cycle_info_record: pft$p_info_record;
         output_column: integer);

    VAR
      binary_name: ost$name,
      p_archive_list: pft$p_info_record,
      p_cycle_label: ^SEQ ( * ),
      p_fmd_description: pft$p_file_media_description,
      status: ost$status;

    display_blanks (output_column - 1);
    display ('Cycle info extended cycle : ');
    display_integer (cycle_array_entry.cycle_number);
    display_line ('');

    pmp$convert_binary_unique_name (cycle_array_entry.internal_name, binary_name, status);
    display_blanks (output_column);
    display ('Internal name : ');
    display (binary_name);
    display_line ('');

    display_blanks (output_column);
    display ('Info offset : ');
    display_integer (cycle_array_entry.info_offset);
    display_line ('');

    display_blanks (output_column);
    display ('Cycle number: ');
    display_integer (cycle_array_entry.cycle_number);
    display_line ('');

    pfp$find_cycle_media (p_cycle_info_record, p_fmd_description, status);
    IF status.normal THEN
      pmp$convert_binary_unique_name (p_fmd_description^.global_file_name, binary_name, status);

      display_blanks (output_column);
      display ('Global file name : ');
      display (binary_name);
      display_line ('');

      display_blanks (output_column);
      display ('Checksum : ');
      display_integer (p_fmd_description^.checksum);
      display_line ('');

      display_blanks (output_column);
      display ('Media type [version=');
      display_integer ($INTEGER (p_fmd_description^.file_media_type.media_version));

      pup$display_fmd (p_fmd_description^.file_media_type.device_class,
            p_fmd_description^.file_media_descriptor, output_column, status);

    ELSE
      status.normal := TRUE;
      display_line (' Unable to locate file media info ');
    IFEND;

    pfp$find_cycle_label (p_cycle_info_record, p_cycle_label, status);
    IF status.normal THEN
      pup$display_file_label (p_cycle_label^, output_column, status);
    ELSE
      status.normal := TRUE;
      display_line (' Unable to find cycle label ');
    IFEND;

    pfp$find_archive_info (p_cycle_info_record, p_archive_list, status);
    IF status.normal AND (p_archive_list <> NIL) THEN
      display_archive_info (p_archive_list, output_column);
    ELSE
      status.normal := TRUE;
      display_line (' Unable to find archive info ');
    IFEND;

  PROCEND display_cycle_extended_entry;

?? TITLE := '*** DISPLAY_CYCLE_INFO ***', EJECT ??
{       DISPLAY_CYCLE_INFO -
{

  PROCEDURE display_cycle_info
    (    p_file_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      cycle_index: pft$array_index,
      p_cycle_array_version_1: ^pft$cycle_array,
      p_cycle_array_version_2: ^pft$cycle_array_version_2;

    IF puv$respf_backup_file_version = puc$backup_file_version_1 THEN
      pfp$find_cycle_array (p_file_record, p_cycle_array_version_1, status);
    ELSEIF puv$respf_backup_file_version = puc$backup_file_version_2 THEN
      pfp$find_cycle_array_version_2 (p_file_record, p_cycle_array_version_2, status);
    IFEND;

    IF status.normal THEN
      display_blanks (output_column - 1);
      display_line ('Cycles: ');
      IF puv$respf_backup_file_version = puc$backup_file_version_1 THEN
        IF (p_cycle_array_version_1 <> NIL) THEN

        /display_all_version_1_cycles/
          FOR cycle_index := 1 TO UPPERBOUND (p_cycle_array_version_1^) DO
            display_blank_line;
            display_cycle_array_entry_v1 (p_cycle_array_version_1^ [cycle_index], output_column + 2);
          FOREND /display_all_version_1_cycles/;
        IFEND;
      ELSEIF puv$respf_backup_file_version = puc$backup_file_version_2 THEN
        IF (p_cycle_array_version_2 <> NIL) THEN

        /display_all_version_2_cycles/
          FOR cycle_index := 1 TO UPPERBOUND (p_cycle_array_version_2^) DO
            display_blank_line;
            display_cycle_array_entry_v2 (p_cycle_array_version_2^ [cycle_index], output_column + 2);
          FOREND /display_all_version_2_cycles/;
        IFEND;
      IFEND;
    IFEND;
  PROCEND display_cycle_info;

?? TITLE := '*** DISPLAY_CYCLE_INFO_EXTENDED ***', EJECT ??
{       DISPLAY_CYCLE_INFO_EXTENDED -
{

  PROCEDURE display_cycle_info_extended
    (    p_file_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      cycle_index: pft$array_index,
      p_cycle_array_extended_record: pft$p_info_record,
      p_cycle_directory_array: pft$p_cycle_directory_array,
      p_cycle_info_extended_body: pft$p_info,
      p_cycle_info_record: pft$p_info_record;

    pfp$find_cycle_array_extended (p_file_record, p_cycle_array_extended_record, status);
    IF status.normal THEN
      p_cycle_info_extended_body := ^p_cycle_array_extended_record^.body;

      pfp$find_cycle_directory (p_cycle_array_extended_record, p_cycle_directory_array, status);
      IF status.normal AND (p_cycle_directory_array <> NIL) THEN
        display_blanks (output_column - 1);
        display_line ('Cycles Extended : ');

      /display_all_cycles/
        FOR cycle_index := 1 TO UPPERBOUND (p_cycle_directory_array^) DO
          pfp$find_direct_info_record (p_cycle_info_extended_body,
                p_cycle_directory_array^ [cycle_index].info_offset, p_cycle_info_record, status);
          IF status.normal THEN
            display_blank_line;
            display_cycle_extended_entry (p_cycle_directory_array^ [cycle_index], p_cycle_info_record,
                  output_column + 2);
          ELSE
            RETURN; {----->
          IFEND
        FOREND /display_all_cycles/;
      IFEND;
    ELSEIF (status.condition = pfe$unknown_cycle_array) THEN
      display_blanks (output_column - 1);
      display_line ('Cycle fmd, label, and archive information not included ');
      status.normal := TRUE;
    IFEND;
  PROCEND display_cycle_info_extended;
?? TITLE := '*** DISPLAY_CYCLE_STATISTICS ***', EJECT ??
{       DISPLAY_CYCLE_STATISTICS -
{

  PROCEDURE display_cycle_statistics
    (    cycle_statistics: pft$cycle_statistics;
         output_column: integer);

    VAR
      column: integer;

    display_blanks (output_column - 1);
    display_line ('Statistics: ');
    column := output_column + 2;
    display_creation_date_time (cycle_statistics.creation_date_time, column);
    display_modification_date_time (cycle_statistics.modification_date_time, column);
    display_access_date_time (cycle_statistics.access_date_time, column);
    display_access_count (cycle_statistics.access_count, column);
  PROCEND display_cycle_statistics;
?? TITLE := '*** DISPLAY_DATE_TIME ***', EJECT ??
{       DISPLAY_DATE_TIME -
{

  PROCEDURE display_date_time
    (    date_time: ost$date_time);

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

    pmp$format_compact_date (date_time, osc$mdy_date, date, status);
    display (date.mdy);
    display (' ');
    pmp$format_compact_time (date_time, osc$millisecond_time, time, status);
    display (time.millisecond);
  PROCEND display_date_time;

?? TITLE := '*** DISPLAY_DATA_RESIDENCE ***', EJECT ??
{       DISPLAY_DATA_RESIDENCE
{

  PROCEDURE display_data_residence
    (    data_residence: pft$data_residence;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Data_residence: ');

    CASE data_residence OF
    = pfc$unreleasable_data =
      display ('pfc$unreleasable_data');
    = pfc$releasable_data =
      display ('pfc$releasable_data');
    = pfc$release_data_requested =
      display ('pfc$release_data_requested');
    = pfc$offline_data =
      display ('pfc$offline_data');
    ELSE
      display ('pfc$unreleasable_data');
    CASEND;

    display_line ('');

  PROCEND display_data_residence;

?? TITLE := '*** DISPLAY_TAPE_DENSITY ***', EJECT ??
{       DISPLAY_TAPE_DENSITY
{

  PROCEDURE display_density
    (    density: rmt$density;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Density: ');

    CASE density OF
    = rmc$200 =
      display ('rmc$200');
    = rmc$556 =
      display ('rmc$556');
    = rmc$800 =
      display ('rmc$800');
    = rmc$1600 =
      display ('rmc$1600');
    = rmc$6250 =
      display ('rmc$6250');
    = rmc$38000 =
      display ('rmc$38000');
    ELSE
      display ('undefined');
    CASEND;

    display_line ('');

  PROCEND display_density;

?? TITLE := '*** DISPLAY_EXPIRATION_DATE_TIME ***', EJECT ??
{       DISPLAY_EXPIRATION_DATE_TIME -
{

  PROCEDURE display_expiration_date_time
    (    expiration_date_time: ost$date_time;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Expiration_date_time: ');
    IF (expiration_date_time = highest_date_time) THEN
      display ('None');
    ELSE
      display_date_time (expiration_date_time);
    IFEND;
    display_line ('');

  PROCEND display_expiration_date_time;
?? TITLE := '*** DISPLAY_FAMILY_CONTENT ***', EJECT ??
{       DISPLAY_FAMILY_CONTENT -
{

  PROCEDURE display_family_content
    (    set_name: stt$set_name;
         family_name: pft$name;
         output_column: integer;
         p_info: pft$p_info;
     VAR status: ost$status);

    VAR
      directory_entry: pft$directory_array_entry,
      index: pft$array_index,
      local_p_info: pft$p_info,
      master_catalog_name: pft$name,
      master_catalog_path: array [1 .. 2] of pft$name,
      name_type: pft$name_type,
      offset: pft$info_offset,
      p_catalog_record: pft$p_info_record,
      p_directory_array: pft$p_directory_array,
      p_info_body: pft$p_info,
      p_info_record: pft$p_info_record;

    local_p_info := p_info;
    pfp$get_master_catalog_info (set_name, family_name, catalog_info_selections, local_p_info, status);
    IF status.normal THEN
      local_p_info := p_info;
      pfp$find_next_info_record (local_p_info, p_info_record, status);
      IF status.normal THEN
        pfp$find_directory_array (p_info_record, p_directory_array, status);
        IF status.normal THEN
          IF (p_directory_array <> NIL) THEN
            master_catalog_path [pfc$family_name_index] := family_name;
            p_info_body := ^p_info_record^.body;

          /process_directory_array/
            FOR index := 1 TO UPPERBOUND (p_directory_array^) DO
              display_blank_line;
              directory_entry := p_directory_array^ [index];
              master_catalog_name := directory_entry.name;
              name_type := directory_entry.name_type;
              offset := directory_entry.info_offset;
              IF (name_type = pfc$catalog_name) THEN
                pfp$find_direct_info_record (p_info_body, offset, p_catalog_record, status);
                IF status.normal THEN
                  pup$display_catalog_info (master_catalog_name, p_catalog_record, output_column, status);
                  IF status.normal THEN
                    display_blank_line;
                    master_catalog_path [pfc$master_catalog_name_index] := master_catalog_name;
                    display_catalog_content (master_catalog_path, output_column + 2, local_p_info, status);
                  IFEND;
                IFEND;
                IF NOT status.normal THEN
                  EXIT /process_directory_array/; {----->
                IFEND;
              IFEND;
            FOREND /process_directory_array/;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND display_family_content;
?? TITLE := '*** DISPLAY_FAMILY_NAME ***', EJECT ??
{       DISPLAY_FAMILY_NAME -
{

  PROCEDURE display_family_name
    (    family_name: ost$family_name;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Family: ');
    display_name (family_name);
    display_line ('');
  PROCEND display_family_name;
?? TITLE := '*** DISPLAY_FILE_DESCRIPTION ***', EJECT ??
{       DISPLAY_FILE_DESCRIPTION -
{

  PROCEDURE display_file_description
    (    p_file_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      p_file_description: pft$p_file_description;

    pfp$find_file_description (p_file_record, p_file_description, status);
    IF status.normal THEN
      display_password (p_file_description^.password, output_column);
      display_charge_id (p_file_description^.charge_id, output_column);
      display_logging (p_file_description^.logging_selection, output_column);
    IFEND;
  PROCEND display_file_description;
?? TITLE := '*** DISPLAY_GROUP ***', EJECT ??
{       DISPLAY_GROUP -
{

  PROCEDURE display_group
    (    group: pft$group;
         output_column: integer);

    VAR
      column: integer;

    display_blanks (output_column - 1);
    display_line ('Group:');
    column := output_column + 2;
    display_group_type (group.group_type, column);
    CASE group.group_type OF
    = pfc$public =
    = pfc$family =
      display_family_name (group.family_description.family, column);
    = pfc$account =
      display_family_name (group.account_description.family, column);
      display_account_name (group.account_description.account, column);
    = pfc$project =
      display_family_name (group.project_description.family, column);
      display_account_name (group.project_description.account, column);
      display_project_name (group.project_description.project, column);
    = pfc$user =
      display_family_name (group.user_description.family, column);
      display_user_name (group.user_description.user, column);
    = pfc$user_account =
      display_family_name (group.user_account_description.family, column);
      display_account_name (group.user_account_description.account, column);
      display_user_name (group.user_account_description.user, column);
    = pfc$member =
      display_family_name (group.member_description.family, column);
      display_user_name (group.member_description.user, column);
      display_account_name (group.member_description.account, column);
      display_project_name (group.member_description.project, column);
    ELSE
    CASEND;
  PROCEND display_group;
?? TITLE := '*** DISPLAY_GROUP_TYPE ***', EJECT ??
{       DISPLAY_GROUP_TYPE -
{

  PROCEDURE display_group_type
    (    group_type: pft$group_types;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Group_type: ');
    CASE group_type OF
    = pfc$public =
      display ('Public');
    = pfc$family =
      display ('Family');
    = pfc$account =
      display ('Account');
    = pfc$project =
      display ('Project');
    = pfc$user =
      display ('User');
    = pfc$user_account =
      display ('User_account');
    = pfc$member =
      display ('Member');
    ELSE
    CASEND;
    display_line ('');
  PROCEND display_group_type;
?? TITLE := '*** DISPLAY_INTEGER ***', EJECT ??
{       DISPLAY_INTEGER -
{

  PROCEDURE display_integer
    (    intgr: integer);

    VAR
      length: integer,
      strng: string (30);

    STRINGREP (strng, length, intgr);
    display (strng (1, length));
  PROCEND display_integer;
?? TITLE := '*** DISPLAY_LINE ***', EJECT ??
{       DISPLAY_LINE -
{

  PROCEDURE display_line
    (    strng: string ( * ));

    display (strng);
    display (end_of_line);
  PROCEND display_line;
?? TITLE := '*** DISPLAY_LOG_ENTRY ***', EJECT ??
{       DISPLAY_LOG_ENTRY -
{

  PROCEDURE display_log_entry
    (    log_entry: pft$log_array_entry;
         output_column: integer);

    display_family_name (log_entry.user_id.family, output_column);
    display_user_name (log_entry.user_id.user, output_column);
    display_access_date_time (log_entry.access_date_time, output_column);
    display_access_count (log_entry.access_count, output_column);

    display_blanks (output_column - 1);
    display ('Last_cycle: ');
    display_integer (log_entry.last_cycle);
    display_line ('');
  PROCEND display_log_entry;
?? TITLE := '*** DISPLAY_LOGGING ***', EJECT ??
{       DISPLAY_LOGGING -
{

  PROCEDURE display_logging
    (    logging: pft$log;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Logging: ');
    CASE logging OF
    = pfc$log =
      display ('Log');
    = pfc$no_log =
      display ('No_log');
    ELSE
    CASEND;
    display_line ('');
  PROCEND display_logging;
?? TITLE := '*** DISPLAY_LOG_INFO ***', EJECT ??
{       DISPLAY_LOG_INFO -
{

  PROCEDURE display_log_info
    (    p_file_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      log_index: pft$array_index,
      p_log_array: pft$p_log_array;

    pfp$find_log_array (p_file_record, p_log_array, status);
    IF status.normal THEN
      display_blanks (output_column - 1);
      IF (p_log_array = NIL) THEN
        display_line ('Log: None ');
      ELSE
        display_line ('Log: ');

      /display_all_logs/
        FOR log_index := 1 TO UPPERBOUND (p_log_array^) DO
          display_blank_line;
          display_log_entry (p_log_array^ [log_index], output_column + 2);
        FOREND /display_all_logs/;
      IFEND;
    IFEND;
  PROCEND display_log_info;
?? TITLE := '*** DISPLAY_MODIFICATION_DATE_TIME ***', EJECT ??
{       DISPLAY_MODIFICATION_DATE_TIME -
{

  PROCEDURE display_modification_date_time
    (    modification_date_time: ost$date_time;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Modification_date_time: ');
    display_date_time (modification_date_time);
    display_line ('');
  PROCEND display_modification_date_time;
?? TITLE := '*** DISPLAY_NAME ***', EJECT ??
{       DISPLAY_NAME -
{

  PROCEDURE display_name
    (    name: string ( * <= 31));

    VAR
      size: integer;

    size := STRLENGTH (name);
    WHILE ((size > 0) AND (name (size) = ' ')) DO
      size := size - 1;
    WHILEND;
    display (name (1, size));
  PROCEND display_name;
?? TITLE := '*** DISPLAY_PASSWORD ***', EJECT ??
{       DISPLAY_PASSWORD -
{

  PROCEDURE display_password
    (    password: pft$password;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Password: ');
    display_name (password);
    display_line ('');
  PROCEND display_password;
?? TITLE := '*** DISPLAY_PERMIT_ENTRY ***', EJECT ??
{       DISPLAY_PERMIT_ENTRY -
{

  PROCEDURE display_permit_entry
    (    permit_entry: pft$permit_array_entry;
         output_column: integer);

    display_group (permit_entry.group, output_column);
    display_usage (permit_entry.usage_permissions, output_column);
    display_share (permit_entry.share_requirements, output_column);
    display_application_info (permit_entry.application_info, output_column);
  PROCEND display_permit_entry;
?? TITLE := '*** DISPLAY_PERMIT_INFO ***', EJECT ??
{       DISPLAY_PERMIT_INFO -
{

  PROCEDURE display_permit_info
    (    p_file_record: pft$p_info_record;
         output_column: integer;
     VAR status: ost$status);

    VAR
      p_permit_array: pft$p_permit_array,
      permit_index: pft$array_index;

    pfp$find_permit_array (p_file_record, p_permit_array, status);
    IF status.normal THEN
      display_blanks (output_column - 1);
      IF p_permit_array = NIL THEN
        display_line ('Permits: None ');
      ELSE
        display_line ('Permits:');

      /display_all_permits/
        FOR permit_index := 1 TO UPPERBOUND (p_permit_array^) DO
          display_permit_entry (p_permit_array^ [permit_index], output_column + 2);
        FOREND /display_all_permits/;
      IFEND;
    IFEND;
  PROCEND display_permit_info;

?? TITLE := '*** DISPLAY_PF_DEVICE_CLASS ***', EJECT ??
{       DISPLAY_PF_DEVICE_CLASS
{

  PROCEDURE display_pf_device_class
    (    pf_device_class: pft$device_class;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Device_class: ');

    CASE pf_device_class OF
    = pfc$connected_file_device =
      display ('pfc$connected_file_device');
    = pfc$interstate_link_device =
      display ('pfc$interstate_link_device');
    = pfc$local_queue_device =
      display ('pfc$local_queue_device');
    = pfc$log_device =
      display ('pfc$log_device');
    = pfc$magnetic_tape_device =
      display ('pfc$magnetic_tape_device');
    = pfc$mass_storage_device =
      display ('pfc$mass_storage_device');
    = pfc$memory_resident_device =
      display ('pfc$memory_resident_device');
    = pfc$network_device =
      display ('pfc$network_device');
    = pfc$null_device =
      display ('pfc$null_device');
    = pfc$pipeline_device =
      display ('pfc$pipeline_device');
    = pfc$rhfam_device =
      display ('pfc$rhfam_device');
    = pfc$terminal_device =
      display ('pfc$terminal_device');
    ELSE
      display ('pfc$mass_storage_device');
    CASEND;

    display_line ('');

  PROCEND display_pf_device_class;

?? TITLE := '*** DISPLAY_PROJECT_NAME ***', EJECT ??
{       DISPLAY_PROJECT_NAME -
{

  PROCEDURE display_project_name
    (    project_name: avt$project_name;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Project: ');
    display_name (project_name);
    display_line ('');
  PROCEND display_project_name;

?? TITLE := '*** DISPLAY_RM_DEVICE_CLASS ***', EJECT ??
{       DISPLAY_RM_DEVICE_CLASS
{

  PROCEDURE display_rm_device_class
    (    rm_device_class: rmt$device_class;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Device_class: ');

    CASE rm_device_class OF
    = rmc$connected_file_device =
      display ('rmc$connected_file_device');
    = rmc$interstate_link_device =
      display ('rmc$interstate_link_device');
    = rmc$local_queue_device =
      display ('rmc$local_queue_device');
    = rmc$log_device =
      display ('rmc$log_device');
    = rmc$magnetic_tape_device =
      display ('rmc$magnetic_tape_device');
    = rmc$mass_storage_device =
      display ('rmc$mass_storage_device');
    = rmc$memory_resident_device =
      display ('rmc$memory_resident_device');
    = rmc$network_device =
      display ('rmc$network_device');
    = rmc$null_device =
      display ('rmc$null_device');
    = rmc$pipeline_device =
      display ('rmc$pipeline_device');
    = rmc$rhfam_device =
      display ('rmc$rhfam_device');
    = rmc$terminal_device =
      display ('rmc$terminal_device');
    ELSE
      display ('rmc$mass_storage_device');
    CASEND;

    display_line ('');

  PROCEND display_rm_device_class;

?? TITLE := '*** DISPLAY_RETRIEVE_OPTION ***', EJECT ??
{       DISPLAY_RETRIEVE_OPTION
{

  PROCEDURE display_retrieve_option
    (    retrieve_option: pft$retrieve_option;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('Retrieve_option: ');

    CASE retrieve_option OF
    = pfc$always_retrieve =
      display ('pfc$always_retrieve');
    = pfc$explicit_retrieve_only =
      display ('pfc$explicit_retrieve_only');
    = pfc$admin_retrieve_only =
      display ('pfc$admin_retrieve_only');
    CASEND;

    display_line ('');

  PROCEND display_retrieve_option;

?? TITLE := '*** DISPLAY_SHARE ***', EJECT ??
{       DISPLAY_SHARE -
{

  PROCEDURE display_share
    (    share: pft$share_requirements;
         output_column: integer);

    VAR
      first_selection: boolean,
      share_option: pft$share_options;

    display_blanks (output_column - 1);
    display ('Share: ');
    first_selection := TRUE;

  /display_share_options/
    FOR share_option := LOWERVALUE (share_option) TO UPPERVALUE (share_option) DO
      IF (share_option IN share) THEN
        IF NOT first_selection THEN
          display (', ');
        IFEND;
        first_selection := FALSE;
        CASE share_option OF
        = pfc$read =
          display ('Read');
        = pfc$shorten =
          display ('Shorten');
        = pfc$append =
          display ('Append');
        = pfc$modify =
          display ('Modify');
        = pfc$execute =
          display ('Execute');
        ELSE
        CASEND;
      IFEND;
    FOREND /display_share_options/;
    display_line ('');
  PROCEND display_share;
?? TITLE := '*** DISPLAY_USAGE ***', EJECT ??
{       DISPLAY_USAGE -
{

  PROCEDURE display_usage
    (    usage: pft$permit_selections;
         output_column: integer);

    VAR
      first_selection: boolean,
      usage_option: pft$permit_options;

    display_blanks (output_column - 1);
    display ('Usage: ');
    first_selection := TRUE;

  /display_usage_options/
    FOR usage_option := LOWERVALUE (usage_option) TO UPPERVALUE (usage_option) DO
      IF (usage_option IN usage) THEN
        IF NOT first_selection THEN
          display (', ');
        IFEND;
        first_selection := FALSE;
        CASE usage_option OF
        = pfc$read =
          display ('Read');
        = pfc$shorten =
          display ('Shorten');
        = pfc$append =
          display ('Append');
        = pfc$modify =
          display ('Modify');
        = pfc$execute =
          display ('Execute');
        = pfc$cycle =
          display ('Cycle');
        = pfc$control =
          display ('Control');
        ELSE
        CASEND;
      IFEND;
    FOREND /display_usage_options/;
    display_line ('');
  PROCEND display_usage;
?? TITLE := '*** DISPLAY_USER_NAME ***', EJECT ??
{       DISPLAY_USER_NAME -
{

  PROCEDURE display_user_name
    (    user_name: ost$user_name;
         output_column: integer);

    display_blanks (output_column - 1);
    display ('User: ');
    display_name (user_name);
    display_line ('');
  PROCEND display_user_name;
?? SKIP := 4 ??
MODEND pum$display_catalogs;
