?? RIGHT := 110 ??
??
NEWTITLE := ' NOS/VE Backup/Restore Utilities:  pf_debugging_aides ', EJECT ??
MODULE pum$pf_debugging_aides;
{
{  This module contains those subcommands, associated with debugging or
{ displaying information about the permanent file catalog.
{
?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$display_control
*copyc fmd$volume_info
*copyc ost$caller_identifier
*copyc pfc$null_shared_queue
*copyc pue$error_condition_codes
*copyc rmc$unspecified_allocation_size
*copyc rmc$unspecified_file_class
*copyc rmc$unspecified_file_size
*copyc rmc$unspecified_vsn
?? POP ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$set_segment_eoi
*copyc clp$convert_cyc_ref_to_cyc_sel
*copyc clp$evaluate_parameters
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc fmp$get_files_volume_info
*copyc fsp$close_file
*copyc fsp$convert_fs_structure_to_pf
*copyc fsp$evaluate_file_reference
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pfp$define_catalog
*copyc pfp$define_mass_storage_catalog
*copyc pfp$define_master_catalog
*copyc pfp$detach_jobs_catalogs
*copyc pfp$get_attached_pf_table
*copyc pfp$get_catalog_alarm_table
*copyc pfp$get_catalog_segment
*copyc pfp$get_family_set
*copyc pfp$get_queued_catalog_table
*copyc pfp$get_stored_fmd
*copyc pfp$get_stored_fmd_size
*copyc pfp$purge_master_catalog
*copyc pfp$purge_object
*copyc pfp$put_catalog_segment
*copyc pup$convert_gfn_to_string
*copyc pup$crack_boolean
*copyc pup$crack_catalog
*copyc pup$crack_file
*copyc pup$crack_permanent_file
*copyc pup$crack_pf_file_reference
*copyc pup$display_boolean
*copyc pup$display_fmd
*copyc pup$display_integer
*copyc pup$display_line
*copyc pup$write_os_status
*copyc pup$write_path
*copyc puv$listing_display_control
*copyc rmp$build_mass_storage_info
*copyc stp$display_all_sets
*copyc stp$display_volume
?? TITLE := '  [XDCL] pup$create_ms_catalog_cmnd ', EJECT ??

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


{ PDT create_ms_cat_pdt (
{ catalog, c                   : file = $required
{ catalog_type, ct             :   key external, internal = external
{ allocation_size, as          : integer 16384..16777215 = $optional
{ file_class, fc               : name 1 = $optional
{ initial_volume, iv           : name 1..6 = $optional
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      create_ms_cat_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^create_ms_cat_pdt_names, ^create_ms_cat_pdt_params];

    VAR
      create_ms_cat_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 11] of
            clt$parameter_name_descriptor := [['CATALOG', 1], ['C', 1], ['CATALOG_TYPE', 2], ['CT', 2],
            ['ALLOCATION_SIZE', 3], ['AS', 3], ['FILE_CLASS', 4], ['FC', 4], ['INITIAL_VOLUME', 5], ['IV', 5],
            ['STATUS', 6]];

    VAR
      create_ms_cat_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 6] of
            clt$parameter_descriptor := [

{ CATALOG C }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ CATALOG_TYPE CT }
      [[clc$optional_with_default, ^create_ms_cat_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^create_ms_cat_pdt_kv2, clc$keyword_value]],

{ ALLOCATION_SIZE AS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 16384, 16777215]],

{ FILE_CLASS FC }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, 1]],

{ INITIAL_VOLUME IV }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, 6]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

    VAR
      create_ms_cat_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of
            ost$name := ['EXTERNAL', 'INTERNAL'];

    VAR
      create_ms_cat_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (8) := 'external';

?? POP ??

    VAR
      allocation_size: rmt$allocation_size,
      caller_id: ost$caller_identifier,
      catalog_type: pft$catalog_types,
      initial_volume: rmt$recorded_vsn,
      mass_storage_class: rmt$mass_storage_class,
      p_mass_storage_info: ^fmt$mass_storage_request_info,
      p_path: ^pft$path,
      path_container: clt$path_container,
      value: clt$value;

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

    pup$crack_catalog ('CATALOG', path_container, p_path, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CATALOG_TYPE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.name.value = 'INTERNAL' THEN
      catalog_type := pfc$internal_catalog;
    ELSE
      catalog_type := pfc$external_catalog;

      clp$get_value ('ALLOCATION_SIZE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.kind = clc$integer_value THEN
        allocation_size := value.int.value;
      ELSE
        allocation_size := rmc$unspecified_allocation_size;
      IFEND;

      clp$get_value ('FILE_CLASS', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.kind = clc$name_value THEN
        mass_storage_class := value.name.value (1);
      ELSE
        mass_storage_class := rmc$unspecified_file_class;
      IFEND;

      clp$get_value ('INITIAL_VOLUME', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.kind = clc$name_value THEN
        initial_volume := value.name.value (1, 6);
      ELSE
        initial_volume := rmc$unspecified_vsn;
      IFEND;
    IFEND;

    #CALLER_ID (caller_id);
    PUSH p_mass_storage_info;
    rmp$build_mass_storage_info (allocation_size, rmc$unspecified_file_size, initial_volume,
          mass_storage_class, {shared_queue} pfc$null_shared_queue, rmc$unspecified_transfer_size,
          {volume_overflow_allowed} FALSE, caller_id.ring,
          p_mass_storage_info, status);
    IF status.normal THEN
      pfp$define_mass_storage_catalog (p_path^, catalog_type, p_mass_storage_info, status);
    IFEND;
  PROCEND pup$create_ms_catalog_cmnd;

?? TITLE := ' [XDCL] pup$defmc_command ', EJECT ??

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

    VAR
      charge_id: pft$charge_id,
      local_status: ost$status,
      p_path: ^pft$path,
      path_container: clt$path_container,
      set_name: stt$set_name;


    crack_master_catalog (parameter_list, path_container, p_path, status);
    IF status.normal THEN
      pup$display_line (' Define master catalog', local_status);
      pup$write_path (p_path^, local_status);
      charge_id.account := '  ';
      charge_id.project := ' ';

      pfp$get_family_set (p_path^ [pfc$family_name_index], set_name, status);
      IF status.normal THEN
        pfp$define_master_catalog (set_name, p_path^ [pfc$family_name_index], p_path^
              [pfc$master_catalog_name_index], charge_id, status);
      IFEND;
      pup$write_os_status (status, local_status);
    IFEND;
  PROCEND pup$defmc_command;

?? TITLE := ' [XDCL] pup$detach_all_catalogs ', EJECT ??
  PROCEDURE [XDCL] pup$detach_all_catalogs
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt detach_all_cats_pdt

?? PUSH (LISTEXT := ON) ??

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

?? POP ??

    clp$scan_parameter_list (parameter_list, detach_all_cats_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pfp$detach_jobs_catalogs;
  PROCEND pup$detach_all_catalogs;
?? TITLE := ' [XDCL] pup$display_ast ', EJECT ??

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

{ pdt display_ast (status)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_ast: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^display_ast_names, ^display_ast_params];

    VAR
      display_ast_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
            clt$parameter_name_descriptor := [['STATUS', 1]];

    VAR
      display_ast_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1] of clt$parameter_descriptor := [

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

?? POP ??
    clp$scan_parameter_list (parameter_list, display_ast, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    stp$display_all_sets (puv$listing_display_control, status);
  PROCEND pup$display_ast;
?? TITLE := ' [XDCL] pup$display_vst ', EJECT ??

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


{  pdt display_vst (recorded_vsn, rvsn: name 1..6=$required
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_vst: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^display_vst_names, ^display_vst_params];

    VAR
      display_vst_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['RECORDED_VSN', 1], ['RVSN', 1], ['STATUS', 2]];

    VAR
      display_vst_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ RECORDED_VSN RVSN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, 6]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      recorded_vsn: rmt$recorded_vsn,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, display_vst, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('RECORDED_VSN', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    recorded_vsn := value.name.value (1, 6);
    stp$display_volume (recorded_vsn, puv$listing_display_control, status);
  PROCEND pup$display_vst;

?? TITLE := '    [XDCL] pup$get_attached_pf_table_cm ', EJECT ??

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


{  pdt get_attached_pf_table (
{    output, o: file = $required
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      get_attached_pf_table: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^get_attached_pf_table_names, ^get_attached_pf_table_params];

    VAR
      get_attached_pf_table_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

    VAR
      get_attached_pf_table_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of
        clt$parameter_descriptor := [

{ OUTPUT O }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      file_id: amt$file_identifier,
      local_status: ost$status,
      output_file: amt$local_file_name,
      segment_pointer: amt$segment_pointer;

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

    pup$crack_file ('OUTPUT', output_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (output_file, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET segment_pointer.sequence_pointer;

    pfp$get_attached_pf_table (segment_pointer.sequence_pointer, status);
    IF NOT status.normal THEN
      amp$close (file_id, local_status);
      RETURN;
    IFEND;

    amp$set_segment_eoi (file_id, segment_pointer, status);

    amp$close (file_id, local_status);
  PROCEND pup$get_attached_pf_table_cm;


?? TITLE := '    [XDCL] pup$get_catalog_alarm_table_cm ', EJECT ??

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



{   pdt get_catalog_alarm_table (
{     output, o: file = $required
{     status)

?? PUSH (LISTEXT := ON) ??

    VAR
      get_catalog_alarm_table: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^get_catalog_alarm_table_names, ^get_catalog_alarm_table_params];

    VAR
      get_catalog_alarm_table_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

    VAR
      get_catalog_alarm_table_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of
        clt$parameter_descriptor := [

{ OUTPUT O }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      file_id: amt$file_identifier,
      local_status: ost$status,
      output_file: amt$local_file_name,
      segment_pointer: amt$segment_pointer;

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

    pup$crack_file ('OUTPUT', output_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (output_file, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET segment_pointer.sequence_pointer;

    pfp$get_catalog_alarm_table (segment_pointer.sequence_pointer, status);
    IF NOT status.normal THEN
      amp$close (file_id, local_status);
      RETURN;
    IFEND;

    amp$set_segment_eoi (file_id, segment_pointer, status);

    amp$close (file_id, local_status);
  PROCEND pup$get_catalog_alarm_table_cm;



?? TITLE := '    [XDCL] pup$get_catalog_segment_cm ', EJECT ??

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

?? RIGHT := 110 ??
{ pdt get_catalog_segment_pdt (
{  catalog, c: file = $required
{  output, o: file = $required
{  status)

?? PUSH (LISTEXT := ON) ??

    VAR
      get_catalog_segment_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^get_catalog_segment_pdt_names, ^get_catalog_segment_pdt_params];

    VAR
      get_catalog_segment_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
        clt$parameter_name_descriptor := [['CATALOG', 1], ['C', 1], ['OUTPUT', 2], ['O', 2], ['STATUS', 3]];

    VAR
      get_catalog_segment_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of
        clt$parameter_descriptor := [

{ CATALOG C }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ OUTPUT O }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      file_id: amt$file_identifier,
      local_status: ost$status,
      output_file: amt$local_file_name,
      p_path: ^pft$path,
      path_container: clt$path_container,
      segment_pointer: amt$segment_pointer;

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

    pup$crack_catalog ('CATALOG', path_container, p_path, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pup$crack_file ('OUTPUT', output_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (output_file, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET segment_pointer.sequence_pointer;

    pfp$get_catalog_segment (p_path^, segment_pointer.sequence_pointer, status);
    IF NOT status.normal THEN
      amp$close (file_id, local_status);
      RETURN;
    IFEND;

    amp$set_segment_eoi (file_id, segment_pointer, status);
    amp$close (file_id, local_status);
  PROCEND pup$get_catalog_segment_cm;

?? TITLE := '    [XDCL] pup$get_file_fmd_cm ', EJECT ??

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

?? RIGHT := 110 ??



{ pdt get_file_fmd_pdt (
{  file, f, catalog, c: file = $required
{  output, o: file = $required
{  format: boolean = true
{  status)

?? PUSH (LISTEXT := ON) ??

  VAR
    get_file_fmd_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^get_file_fmd_pdt_names,
      ^get_file_fmd_pdt_params];

  VAR
    get_file_fmd_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
      clt$parameter_name_descriptor := [['FILE', 1], ['F', 1], ['CATALOG', 1], ['C', 1], ['OUTPUT', 2], ['O',
      2], ['FORMAT', 3], ['STATUS', 4]];

  VAR
    get_file_fmd_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor
      := [

{ FILE F CATALOG C }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ OUTPUT O }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ FORMAT }
    [[clc$optional_with_default, ^get_file_fmd_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$boolean_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    get_file_fmd_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

?? POP ??
     VAR
      catalog: boolean,
      catalog_recreated: boolean,
      cycle_selector: pft$cycle_selector,
      cycle_specified: boolean,
      device_class: rmt$device_class,
      file_gfn: ost$binary_unique_name,
      file_gfn_string: string (60),
      file_id: amt$file_identifier,
      fmd_size: dmt$stored_fmd_size,
      format: boolean,
      local_status: ost$status,
      output_file: amt$local_file_name,
      p_path: ^pft$path,
      p_table_info: pft$p_table_info,
      path_container: clt$path_container,
      segment_pointer: amt$segment_pointer;

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

    pup$crack_permanent_file ('FILE', - $put$cycle_reference_selections [], path_container,
          p_path, cycle_specified, cycle_selector, status);
    IF NOT status.normal THEN
      IF status.condition = pue$path_too_short THEN
        cycle_specified := FALSE;
        pup$crack_catalog ('FILE', path_container, p_path, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        RETURN;
      IFEND;
    IFEND;

    IF NOT cycle_specified THEN
      cycle_selector.cycle_option := pfc$highest_cycle;
    IFEND;

    pup$crack_file ('OUTPUT', output_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pup$crack_boolean ('FORMAT', format, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (output_file, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET segment_pointer.sequence_pointer;

    pfp$get_stored_fmd_size (p_path^, cycle_selector, device_class, file_gfn, fmd_size, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pup$convert_gfn_to_string (file_gfn, file_gfn_string);
    pup$display_line (' Global file name', status);
    pup$display_line (file_gfn_string, status);

    NEXT p_table_info: [[REP fmd_size OF cell]] IN segment_pointer.sequence_pointer;
    IF p_table_info = NIL THEN
      osp$set_status_abnormal ('GS', 333000, ' Nil p info ', status);
      RETURN;
    IFEND;

    pfp$get_stored_fmd (p_path^, cycle_selector, catalog, catalog_recreated, file_gfn,
        p_table_info^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF catalog THEN
      pup$display_boolean (' CATALOG recreated ', catalog_recreated, status);
    IFEND;

    IF format THEN
      pup$display_fmd (device_class, p_table_info^, 3, status);
    IFEND;

    amp$set_segment_eoi (file_id, segment_pointer, status);

    amp$close (file_id, local_status);
  PROCEND pup$get_file_fmd_cm;


?? TITLE := '    [XDCL] pup$get_file_info ', EJECT ??

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


{ PDT get_file_info_pdt (
{   file, f: file = $required
{   output, o: file = $output
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    get_file_info_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^get_file_info_pdt_names,
      ^get_file_info_pdt_params];

  VAR
    get_file_info_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['FILE', 1], ['F', 1], ['OUTPUT', 2], ['O', 2], ['STATUS', 3]];

  VAR
    get_file_info_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor
      := [

{ FILE F }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ OUTPUT O }
    [[clc$optional_with_default, ^get_file_info_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    get_file_info_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$output';

?? POP ??
    VAR
      current_volume: amt$volume_number,
      file_reference: amt$local_file_name,
      ignore_status: ost$status,
      output_lfn: amt$local_file_name,
      output_line: string(21),
      value: clt$value,
      volume_count: amt$volume_number,
      volume_info: array [1 .. 1] of fmt$volume_info;

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

    clp$get_value ('FILE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    file_reference := value.file.local_file_name;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_lfn := value.file.local_file_name;

    output_line := ' Recorded_vsn:       ';
    volume_info [1].key := fmc$number_of_volumes;

    fmp$get_files_volume_info (file_reference, volume_info, status);

    IF status.normal AND volume_info[1].item_returned THEN
      volume_count := volume_info[1].number_of_volumes;
      FOR current_volume := 1 to volume_count DO
        volume_info[1].key := fmc$volume;
        volume_info[1].requested_volume_number := current_volume;

        fmp$get_files_volume_info (file_reference, volume_info, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        output_line(16,6) := volume_info[1].volume.recorded_vsn;
        pup$display_line (output_line, ignore_status);
      FOREND;
    IFEND;
  PROCEND pup$get_file_info;

?? TITLE := '    [XDCL] pup$get_queued_catalog_table_cm ', EJECT ??

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


{  pdt get_queued_catalog_table (
{    output, o: file = $required
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      get_queued_catalog_table: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^get_queued_catalog_table_names, ^get_queued_catalog_table_params];

    VAR
      get_queued_catalog_table_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

    VAR
      get_queued_catalog_table_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of
        clt$parameter_descriptor := [

{ OUTPUT O }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      file_id: amt$file_identifier,
      local_status: ost$status,
      output_file: amt$local_file_name,
      segment_pointer: amt$segment_pointer;

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

    pup$crack_file ('OUTPUT', output_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (output_file, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET segment_pointer.sequence_pointer;

    pfp$get_queued_catalog_table (segment_pointer.sequence_pointer, status);
    IF NOT status.normal THEN
      amp$close (file_id, local_status);
      RETURN;
    IFEND;

    amp$set_segment_eoi (file_id, segment_pointer, status);

    amp$close (file_id, local_status);
  PROCEND pup$get_queued_catalog_table_cm;

?? TITLE := '    [XDCL] pup$display_fmd_cmd ', EJECT ??

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

{   PROCEDURE display_fmd (
{     file, f, catalog, c: file = $required
{     status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 3, 5, 14, 50, 25, 252],
    clc$command, 5, 2, 1, 0, 0, 0, 2, ''], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['CATALOG                        ',clc$alias_entry, 1],
    ['F                              ',clc$alias_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [4, 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
    [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$status_type]]];

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

    CONST
      p$file = 1,
      p$status = 2;

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

    VAR
      catalog: boolean,
      catalog_recreated: boolean,
      cl_cycle_selector: clt$cycle_selector,
      device_class: rmt$device_class,
      evaluated_file_reference: fst$evaluated_file_reference,
      file_gfn: ost$binary_unique_name,
      file_gfn_string: string (60),
      fmd_seq_p: ^SEQ ( * ),
      fmd_size: dmt$stored_fmd_size,
      p_path: ^pft$path,
      p_table_info: pft$p_table_info;

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


    fsp$evaluate_file_reference (pvt [p$file].value^.file_value^, FALSE
          {NOT command_file_reference_allowed} , evaluated_file_reference, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH p_path: [1 .. evaluated_file_reference.number_of_path_elements];
    fsp$convert_fs_structure_to_pf (evaluated_file_reference, p_path);

    clp$convert_cyc_ref_to_cyc_sel (evaluated_file_reference.cycle_reference, cl_cycle_selector);

    pfp$get_stored_fmd_size (p_path^, cl_cycle_selector.value, device_class, file_gfn, fmd_size, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH fmd_seq_p: [[REP fmd_size OF cell]];
    RESET fmd_seq_p;

    pup$convert_gfn_to_string (file_gfn, file_gfn_string);
    pup$display_line (' Global file name', status);
    pup$display_line (file_gfn_string, status);

    NEXT p_table_info: [[REP fmd_size OF cell]] IN fmd_seq_p;
    IF p_table_info = NIL THEN
      osp$set_status_abnormal ('GS', 333000, ' Nil p info ', status);
      RETURN;
    IFEND;

    pfp$get_stored_fmd (p_path^, cl_cycle_selector.value, catalog, catalog_recreated, file_gfn, p_table_info^,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF catalog THEN
      pup$display_boolean (' CATALOG recreated ', catalog_recreated, status);
    IFEND;

    pup$display_fmd (device_class, p_table_info^, 3, status);

  PROCEND pup$display_fmd_cmd;


?? TITLE := '    [XDCL] pup$purge_object_cm ', EJECT ??

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

{  PROCEDURE purge_object (
{    object, o: file = $required
{    status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 4, 4, 10, 6, 25, 78],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['O                              ',clc$abbreviation_entry, 1],
    ['OBJECT                         ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_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
    [3, 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$status_type]]];

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

    CONST
      p$object = 1,
      p$status = 2;

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

    VAR
      cycle_selector_specified: boolean,
      cycle_selector: pft$cycle_selector,
      p_path: ^pft$path,
      path_container: clt$path_container;

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

    pup$crack_pf_file_reference (pvt [p$object].value^.file_value^,
          $put$cycle_reference_selections [puc$cycle_omitted], 'OBJECT', path_container, p_path,
          cycle_selector_specified, cycle_selector, status);

    pfp$purge_object (p_path^, status);

  PROCEND pup$purge_object_cm;

?? TITLE := '   [XDCL] pup$purmc_command ', EJECT ??

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

    VAR
      local_status: ost$status,
      p_path: ^pft$path,
      path_container: clt$path_container,
      set_name: stt$set_name;

    crack_master_catalog (parameter_list, path_container, p_path, status);
    IF status.normal THEN
      pup$display_line (' Purge master catalog', local_status);
      pup$write_path (p_path^, local_status);

      pfp$get_family_set (p_path^ [pfc$family_name_index], set_name, status);
      IF status.normal THEN
        pfp$purge_master_catalog (set_name, p_path^ [pfc$family_name_index], p_path^
              [pfc$master_catalog_name_index], status);
      IFEND;
      pup$write_os_status (status, local_status);
    IFEND;

  PROCEND pup$purmc_command;

?? TITLE := '    [XDCL] pup$put_catalog_segment_cm ', EJECT ??

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

{  PROCEDURE put_catalog_segment (
{    catalog_segment, cs: file = $required
{    catalog, c: file = $required
{    status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 3, 29, 15, 58, 40, 425],
    clc$command, 5, 3, 2, 0, 0, 0, 3, ''], [
    ['C                              ',clc$abbreviation_entry, 2],
    ['CATALOG                        ',clc$nominal_entry, 2],
    ['CATALOG_SEGMENT                ',clc$nominal_entry, 1],
    ['CS                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [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, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [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 3
    [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$file_type]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$catalog_segment = 1,
      p$catalog = 2,
      p$status = 3;

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

    VAR
      p_attachment_options: ^fst$attachment_options,
      cycle_selector_specified: boolean,
      cycle_selector: pft$cycle_selector,
      file_id: amt$file_identifier,
      local_status: ost$status,
      output_file: amt$local_file_name,
      p_path: ^pft$path,
      path_container: clt$path_container,
      segment_pointer: amt$segment_pointer;

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

    PUSH p_attachment_options: [1..2];
    p_attachment_options^[1].selector := fsc$access_and_share_modes;
    p_attachment_options^[1].access_modes.selector := fsc$specific_access_modes;
    p_attachment_options^[1].access_modes.value := $fst$file_access_options[fsc$read];
    p_attachment_options^[1].share_modes.selector := fsc$specific_share_modes;
    p_attachment_options^[1].share_modes.value := $fst$file_access_options[];
    p_attachment_options^[2].selector := fsc$create_file;
    p_attachment_options^[2].create_file := FALSE;

    fsp$open_file (pvt [p$catalog_segment].value^.file_value^, amc$segment, p_attachment_options, NIL, NIL,
          NIL, NIL, file_id, status);

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET segment_pointer.sequence_pointer;

    pup$crack_pf_file_reference (pvt [p$catalog].value^.file_value^,
          $put$cycle_reference_selections [puc$cycle_omitted], 'CATALOG', path_container, p_path,
          cycle_selector_specified, cycle_selector, status);

    pfp$define_catalog (p_path^, local_status);

    pfp$put_catalog_segment (p_path^, segment_pointer.sequence_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (file_id, local_status);
      RETURN;
    IFEND;

    fsp$close_file (file_id, local_status);
  PROCEND pup$put_catalog_segment_cm;

?? TITLE := '    crack_master_catalog ', EJECT ??

  PROCEDURE crack_master_catalog (parameter_list: clt$parameter_list;
    VAR path_container: clt$path_container;
    VAR p_path: ^pft$path;
    VAR status: ost$status);

{ pdt purge_master_catalog (
{ user,u:file=$required
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      purge_master_catalog: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^purge_master_catalog_names, ^purge_master_catalog_params];

    VAR
      purge_master_catalog_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['USER', 1], ['U', 1], ['STATUS', 2]];

    VAR
      purge_master_catalog_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of
        clt$parameter_descriptor := [

{ USER U }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??

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

    pup$crack_catalog ('USER', path_container, p_path, status);
    IF status.normal AND (UPPERBOUND (p_path^) < pfc$master_catalog_name_index) THEN
      osp$set_status_abnormal (puc$pf_utility_id, pue$path_too_short, 'PURGE/DEFINE_MASTER_CATALOG',
            status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_path^[1], status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
           ' Specify both FAMILY and USER as a path ', status);
    IFEND;
  PROCEND crack_master_catalog;

MODEND pum$pf_debugging_aides;
