?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Device Mangement' ??
MODULE dmm$analyze_device_file;
?? RIGHT := 110 ??

{ This module is a command processor which can view user files as device management
{ tables and display information from them.
{ Most of the code in this and associated modules was stolen from the existing
{ device management utility.
{
?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dmt$device_file_list_index
*copyc dmt$device_position
*copyc dmt$directory_index
*copyc dmt$minimum_allocation_unit
*copyc dmt$ms_device_allocation_table
*copyc dmt$ms_device_file_list_entry
*copyc dmt$ms_volume_directory
*copyc dmt$stored_ms_fmd_header
*copyc iot$disk_type_table
?? POP ??
*copyc amp$get_segment_pointer
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$end_scan_command_file
*copyc clp$get_path_description
*copyc clp$get_value
*copyc clp$new_display_line
*copyc clp$new_display_page
*copyc clp$open_display
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$put_display
*copyc clp$put_job_output
*copyc clp$put_partial_display
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$set_status_abnormal
*copyc pmp$convert_binary_unique_name
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

  TYPE
    t$device_type = (c$844, c$885, c$834, c$836, c$9836, c$895, c$887, c$9853, c$5832, c$5832_2, c$5833,
          c$5833_2, c$5833_3, c$5833_4, c$5838, c$5838_2, c$5838_3, c$5838_4, c$47444, c$47444_2,
          c$47444_3, c$47444_4, c$5837, c$5837_2, c$5837_3, c$5837_4, c$ntdd_1, c$ntdd_2, c$ntdd_3,
          c$ntdd_4, c$ntdd_5, c$ntdd_6),

    t$physical_characteristics = record
      bytes_per_mau: dmt$bytes_per_mau,
      cylinders_per_device: dmt$device_position,
      maus_per_cylinder: dmt$maus_per_position,
      maus_per_dau: dmt$maus_per_dau,
      sectors_per_mau: iot$sectors_per_mau,
      sectors_per_track: iot$sectors_per_track,
    recend;

  VAR
    display_control: clt$display_control,
    utility_name: [READ] ost$name := 'analyze_device_file            ';

  VAR
    global_p_dat: ^dmt$ms_device_allocation_table := NIL,
    global_p_dfl: ^dmt$ms_device_file_list_table := NIL,
    global_p_directory: ^dmt$ms_volume_directory := NIL;

  VAR
    global_dat_path: clt$file_reference,
    global_dfl_path: clt$file_reference,
    global_directory_path: clt$file_reference;

  VAR
    global_dat_file_id: amt$file_identifier,
    global_dfl_file_id: amt$file_identifier,
    global_directory_file_id: amt$file_identifier;

  VAR
    device_type_string: [STATIC] array [t$device_type] of string (12) := ['844         ', '885         ',
          '834         ', '836         ', '9836        ', '895         ', '887 (HYDRA) ', '9853 (XMD3) ',
          '5832 (SSD)  ', '5832_2 (SSD)', '5833 (DAS)  ', '5833_2 (DAS)', '5833_3 (DAS)', '5833_4 (DAS)',
          '5838 (DAS)  ', '5838_2 (DAS)', '5838_3 (DAS)', '5838_4 (DAS)', '47444(DAS)  ', '47444_2(DAS)',
          '47444_3(DAS)', '47444_4(DAS)', '5837 (DAS)  ', '5837_2 (DAS)', '5837_3 (DAS)', '5837_4 (DAS)',
          'NTDD_1 (NT) ', 'NTDD_2 (NT) ', 'NTDD_3 (NT) ', 'NTDD_4 (NT) ', 'NTDD_5 (NT) ', 'NTDD_6 (NT) '];
  VAR
    physical_characteristics: [STATIC, READ] array [t$device_type] of t$physical_characteristics := [
          [2048,  823,   88, 2, 5, 24],    {844
          [2048,  843,  320, 2, 4, 32],    {885
          [2048,  817,   80, 8, 4, 32],    {834
          [2048,  701,  280, 8, 4, 47],    {836
          [2048,  703,  288, 8, 1, 12],    {9836
          [4096,  886,  148, 4, 1, 10],    {895
          [4096,  884,  152, 4, 1, 38],    {887
          [2048, 1412,  392, 8, 1, 21],    {9853
          [4096,  844,   48, 4, 1, 12],    {5832
          [4096,  835,   96, 4, 1, 24],    {5832_2
          [4096, 1629,  152, 4, 1, 22],    {5833
          [4096, 1629,  292, 4, 1, 42],    {5833_2
          [8192, 1629,  228, 2, 1, 33],    {5833_3
          [8192, 1629,  292, 2, 1, 42],    {5833_4
          [4096, 2620,  156, 4, 1, 18],    {5838
          [4096, 2620,  308, 4, 1, 35],    {5838_2
          [8192, 2620,  238, 2, 1, 27],    {5838_3
          [8192, 2620,  310, 2, 1, 35],    {5838_4
          [4096, 2290,  188, 4, 1, 13],    {47444
          [4096, 2290,  368, 4, 1, 25],    {47444_2
          [8192, 2290,  278, 2, 1, 19],    {47444_3
          [8192, 2290,  368, 2, 1, 25],    {47444_4
          [4096, 2095,  116, 4, 1,  7],    {5837
          [4096, 2095,  252, 4, 1, 15],    {5837_2
          [8192, 2095,  184, 2, 1, 11],    {5837_3
          [8192, 2095,  252, 2, 1, 15],    {5837_4
          [4096, 1629,  176, 4, 1, 22],    {NTDD_1
          [8192, 6512,  336, 2, 1, 42],    {NTDD_2
          [4096, 3224,  336, 4, 1, 42],    {NTDD_3
          [8192, 6512,  336, 2, 1, 42],    {NTDD_4
          [8192, 6828, 1408, 2, 1, 64],    {NTDD_5
          [8192, 6828, 2400, 2, 1, 60]     {NTDD_6
          ];

?? OLDTITLE ??
?? NEWTITLE := 'Command Table', EJECT ??
{ table command_table t=c s=local
{ command (convert_cts_to_dau, concts       ) convert_cts_to_dau_command      cm=local
{ command (display_allocation_chain, disac  ) display_alloc_chain_command     cm=local
{ command (display_cylinders, discyl        ) display_cylinders_command       cm=local
{ command (display_dat, disdat              ) display_dat_command             cm=local
{ command (display_dat_header, disdath      ) display_dat_header_command      cm=local
{ command (display_dau_entry, disdaue       ) display_dau_entry_command       cm=local
{ command (display_device_type, disdt       ) display_device_type_command     cm=local
{ command (display_dfl, disdfl              ) display_dfl_command             cm=local
{ command (display_dfl_entry, disdfle       ) display_dfl_entry_command       cm=local
{ command (display_directory, disdir        ) display_directory_command       cm=local
{ command (display_directory_entry, disdire ) display_directory_entry_command cm=local
{ command (sum_allocated_space, sumas       ) sum_allocated_space_command     cm=local
{ command (quit                             ) quit_command                    cm=local

?? PUSH (LISTEXT := ON) ??

VAR
  command_table: [STATIC, READ] ^clt$command_table := ^command_table_entries,

  command_table_entries: [STATIC, READ] array [1 .. 25] of clt$command_table_entry := [
  {} ['CONCTS                         ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^convert_cts_to_dau_command],
  {} ['CONVERT_CTS_TO_DAU             ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^convert_cts_to_dau_command],
  {} ['DISAC                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^display_alloc_chain_command],
  {} ['DISCYL                         ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^display_cylinders_command],
  {} ['DISDAT                         ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_dat_command],
  {} ['DISDATH                        ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^display_dat_header_command],
  {} ['DISDAUE                        ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^display_dau_entry_command],
  {} ['DISDFL                         ', clc$abbreviation_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^display_dfl_command],
  {} ['DISDFLE                        ', clc$abbreviation_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^display_dfl_entry_command],
  {} ['DISDIR                         ', clc$abbreviation_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^display_directory_command],
  {} ['DISDIRE                        ', clc$abbreviation_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^display_directory_entry_command],
  {} ['DISDT                          ', clc$abbreviation_entry, clc$normal_usage_entry, 7,
        clc$automatically_log, clc$linked_call, ^display_device_type_command],
  {} ['DISPLAY_ALLOCATION_CHAIN       ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^display_alloc_chain_command],
  {} ['DISPLAY_CYLINDERS              ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^display_cylinders_command],
  {} ['DISPLAY_DAT                    ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_dat_command],
  {} ['DISPLAY_DAT_HEADER             ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^display_dat_header_command],
  {} ['DISPLAY_DAU_ENTRY              ', clc$nominal_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^display_dau_entry_command],
  {} ['DISPLAY_DEVICE_TYPE            ', clc$nominal_entry, clc$normal_usage_entry, 7,
        clc$automatically_log, clc$linked_call, ^display_device_type_command],
  {} ['DISPLAY_DFL                    ', clc$nominal_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^display_dfl_command],
  {} ['DISPLAY_DFL_ENTRY              ', clc$nominal_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^display_dfl_entry_command],
  {} ['DISPLAY_DIRECTORY              ', clc$nominal_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^display_directory_command],
  {} ['DISPLAY_DIRECTORY_ENTRY        ', clc$nominal_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^display_directory_entry_command],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['SUMAS                          ', clc$abbreviation_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^sum_allocated_space_command],
  {} ['SUM_ALLOCATED_SPACE            ', clc$nominal_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^sum_allocated_space_command]];

?? POP ??
?? OLDTITLE ??
?? NEWTITLE := '  dmp$analyze_device_file', EJECT ??

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

{   PDT adf_pdt (
{     input, i : FILE = $COMMAND
{     output, o : FILE = $OUTPUT
{     device_allocation_table, dat : FILE = $OPTIONAL
{     device_file_list, dfl : FILE = $OPTIONAL
{     directory, d : FILE = $OPTIONAL
{     status)

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

  VAR
    adf_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^adf_pdt_names, ^adf_pdt_params];

  VAR
    adf_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 11] of
  clt$parameter_name_descriptor := [['INPUT', 1], ['I', 1], ['OUTPUT', 2], ['O', 2], [
  'DEVICE_ALLOCATION_TABLE', 3], ['DAT', 3], ['DEVICE_FILE_LIST', 4], ['DFL', 4], ['DIRECTORY', 5], ['D', 5],
  ['STATUS', 6]];

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

{ INPUT I }
    [[clc$optional_with_default, ^adf_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value
  ]],

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

{ DEVICE_ALLOCATION_TABLE DAT }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ DEVICE_FILE_LIST DFL }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ DIRECTORY D }
    [[clc$optional], 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
    adf_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (8) := '$COMMAND';

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

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

    VAR
      l: integer,
      str: string (80),
      command_file: clt$value,
      output_file: clt$value,
      ignore: ost$status,
      specified: boolean,
      file: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, adf_pdt, status);
    IF status.normal THEN
      clp$get_value ('INPUT', 1, 1, clc$low, command_file, status);
      IF status.normal THEN
        clp$get_value ('OUTPUT', 1, 1, clc$low, output_file, status);
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$test_parameter ('DEVICE_ALLOCATION_TABLE', specified, status);
      IF status.normal AND specified THEN
        clp$get_value ('DEVICE_ALLOCATION_TABLE', 1, 1, clc$low, file, status);
        IF status.normal THEN
          open_file_as_dat (file, status);
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$test_parameter ('DEVICE_FILE_LIST', specified, status);
      IF status.normal AND specified THEN
        clp$get_value ('DEVICE_FILE_LIST', 1, 1, clc$low, file, status);
        IF status.normal THEN
          open_file_as_dfl (file, status);
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$test_parameter ('DIRECTORY', specified, status);
      IF status.normal AND specified THEN
        clp$get_value ('DIRECTORY', 1, 1, clc$low, file, status);
        IF status.normal THEN
          open_file_as_directory (file, status);
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$push_utility (utility_name, clc$global_command_search, command_table, NIL, status);
      IF status.normal THEN
        clp$open_display (output_file.file, NIL, display_control, status);
        IF status.normal THEN
          IF global_p_dat <> NIL THEN
            STRINGREP (str, l, ' Using ', global_dat_path.path_name (1, global_dat_path.path_name_size),
                      ' as DEVICE ALLOCATION TABLE');
            clp$put_display (display_control, str (1, l), clc$trim, status);
          IFEND;
          IF global_p_dfl <> NIL THEN
            STRINGREP (str, l, ' Using ', global_dfl_path.path_name (1, global_dfl_path.path_name_size),
                      ' as DEVICE FILE LIST');
            clp$put_display (display_control, str (1, l), clc$trim, status);
          IFEND;
          IF global_p_directory <> NIL THEN
            STRINGREP (str, l, ' Using ', global_directory_path.path_name (1,
                       global_directory_path.path_name_size), ' as DIRECTORY');
            clp$put_display (display_control, str (1, l), clc$trim, status);
          IFEND;
          clp$scan_command_file (command_file.file.local_file_name, utility_name, 'adf', status);
          clp$close_display (display_control, status);
        IFEND;
        clp$pop_utility (status);
      IFEND;
    IFEND;

    IF global_p_dat <> NIL THEN
      fsp$close_file (global_dat_file_id, ignore);
    IFEND;

    IF global_p_dfl <> NIL THEN
      fsp$close_file (global_dfl_file_id, ignore);
    IFEND;

    IF global_p_directory <> NIL THEN
      fsp$close_file (global_directory_file_id, ignore);
    IFEND;

  PROCEND dmp$analyze_device_file;
?? TITLE := '  convert_cts_to_dau', EJECT ??

  PROCEDURE convert_cts_to_dau
    (    cylinder: integer;
         track: integer;
         sector: integer;
         device_type: t$device_type;
     VAR dau_address: dmt$dau_address;
     VAR status: ost$status);

{   PURPOSE: convert cylinder/track/sector to dau address
{     this is essentially dmp$convert_to_dau_address from dmm$flaw_management

    VAR
      characteristics: t$physical_characteristics,
      sector_address: integer;

    status.normal := TRUE;
    get_device_characteristics (device_type, characteristics, status);

{ Check the parameters given in the flaw command to see if they are in the
{ physical range of the device.

    IF status.normal THEN
      IF cylinder >= characteristics.cylinders_per_device THEN
        osp$set_status_abnormal ('DM', 1, 'dme$cylinder_limit_exceeded convert_cts_to_dau', status);
      ELSEIF (track * characteristics.sectors_per_track DIV characteristics.sectors_per_mau >=
            characteristics.maus_per_cylinder) THEN
        osp$set_status_abnormal ('DM', 1, 'dme$track_limit_exceeded convert_cts_to_dau', status);
      ELSEIF (sector >= characteristics.sectors_per_track) THEN
        osp$set_status_abnormal ('DM', 1, 'dme$sector_limit_exceeded convert_cts_to_dau', status);
{          If the last track in a cylinder is selected, check to insure the space is used.
{          On some devices, the number of sectors per DAU does not come out evenly.  The
{          remaining sectors are not used as a DAU can not cross cylinder boundaries.
      ELSEIF ((track + 1) * characteristics.sectors_per_track DIV characteristics.sectors_per_mau >=
            characteristics.maus_per_cylinder) THEN
        IF (sector >= characteristics.sectors_per_track - (((track + 1) *
              characteristics.sectors_per_track) - (characteristics.sectors_per_mau *
              characteristics.maus_per_cylinder))) THEN
          osp$set_status_abnormal ('DM', 1, 'dme$unaddressable_sector convert_cts_to_dau', status);
        IFEND;
      IFEND;
    IFEND;

{ Since all parameters are in range, calculate the DAU address.

    IF status.normal THEN
      sector_address := cylinder * characteristics.sectors_per_mau * characteristics.maus_per_cylinder;
      sector_address := sector_address + (track * characteristics.sectors_per_track);
      sector_address := sector_address + sector;
      dau_address := sector_address DIV (characteristics.sectors_per_mau * characteristics.maus_per_dau);
    IFEND;

  PROCEND convert_cts_to_dau;
?? TITLE := '  convert_cts_to_dau_command', EJECT ??

  PROCEDURE convert_cts_to_dau_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PDT concts_pdt (
{     cylinder, c: integer 0..10000 = $required
{     track, t: integer 0..10000 = $required
{     sector, s : integer 0..10000 = $required
{     status)

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

  VAR
    concts_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^concts_pdt_names,
  ^concts_pdt_params];

  VAR
    concts_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
  clt$parameter_name_descriptor := [['CYLINDER', 1], ['C', 1], ['TRACK', 2], ['T', 2], ['SECTOR', 3], ['S', 3]
  , ['STATUS', 4]];

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

{ CYLINDER C }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 10000]],

{ TRACK T }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 10000]],

{ SECTOR S }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 10000]],

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

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

    VAR
      cylinder: clt$value,
      track: clt$value,
      sector: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, concts_pdt, status);
    IF status.normal THEN
      clp$get_value ('CYLINDER', 1, 1, clc$low, cylinder, status);
      IF status.normal THEN
        clp$get_value ('TRACK', 1, 1, clc$low, track, status);
        IF status.normal THEN
          clp$get_value ('SECTOR', 1, 1, clc$low, sector, status);
          IF status.normal THEN

            IF global_p_dat = NIL THEN
              osp$set_status_abnormal ('DM', 1, ' dat not open', status);
            IFEND;

          IFEND;
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'CONVERT_CTS_TO_DAU', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_dau_from_cts (global_p_dat, cylinder.int.value, track.int.value, sector.int.value,
            display_control, status);
    IFEND;

  PROCEND convert_cts_to_dau_command;
?? TITLE := '  deter_style_assigned_to_pos', EJECT ??

  PROCEDURE deter_style_assigned_to_pos (position: dmt$device_position;
        daus_per_position: dmt$daus_per_position;
        p_dat: ^dmt$ms_device_allocation_table;
    VAR assigned_pos_alloc_style: dmt$allocation_styles;
    VAR allocation_style_available: boolean;
    VAR skip_position: boolean;
    VAR status: ost$status);

    VAR
      number_of_daus_in_au: dmt$daus_per_allocation,
      p_status: ^ost$status,
      dau_state: dmt$dau_status,
      position_dau_states: dmt$dau_states,
      dau_offset_within_position: dmt$daus_per_position,
      position_dau_address: dmt$dau_address,
      au_dau_address: dmt$dau_address;

    p_status := NIL;
    position_dau_address := position * daus_per_position;
    position_dau_states := $dmt$dau_states [];
    assigned_pos_alloc_style := dmc$acyl;
    allocation_style_available := FALSE;
    skip_position := FALSE;

  /determine_dau_states/
    FOR dau_offset_within_position := 0 TO daus_per_position - 1 DO

      dau_state := p_dat^.body [position_dau_address + dau_offset_within_position].dau_status;

      CASE dau_state OF
      = dmc$dau_usable, dmc$dau_hardware_flawed, dmc$dau_software_flawed =
        position_dau_states := position_dau_states + $dmt$dau_states [dau_state];
        CYCLE /determine_dau_states/;

      = dmc$dau_assigned_to_mainframe, dmc$dau_ass_to_mf_swr_flawed =
        position_dau_states := position_dau_states + $dmt$dau_states [dau_state];
        CYCLE /determine_dau_states/;

      = dmc$dau_assigned_to_file, dmc$dau_ass_to_file_swr_flawed =
        au_dau_address := position_dau_address + dau_offset_within_position;
        number_of_daus_in_au := 0;

        REPEAT
          number_of_daus_in_au := number_of_daus_in_au + 1;
          au_dau_address := au_dau_address + 1;
        UNTIL ((p_dat^.body [au_dau_address].dau_status <> dmc$dau_assigned_to_file) AND
              (p_dat^.body [au_dau_address].dau_status <> dmc$dau_ass_to_file_swr_flawed)) OR
              (p_dat^.body [au_dau_address].allocation_chain_position <> dmc$part_of_allocation_unit);

        FOR assigned_pos_alloc_style := LOWERVALUE (dmt$allocation_styles) TO UPPERVALUE
              (dmt$allocation_styles) DO
          IF p_dat^.header.daus_per_allocation_style [assigned_pos_alloc_style] = number_of_daus_in_au THEN
            allocation_style_available := (number_of_daus_in_au <> daus_per_position);
            RETURN;
          IFEND;
        FOREND;

        osp$set_status_abnormal ('DM', 1, 'could not determine allocation style - DMMSMAN', status);

      ELSE
        osp$set_status_abnormal ('DM', 1,  'invalid dau status - DMMSMAN', status);
      CASEND;

    FOREND /determine_dau_states/;

    IF ((dmc$dau_hardware_flawed IN position_dau_states) OR (dmc$dau_software_flawed IN position_dau_states)
          OR (dmc$dau_ass_to_mf_swr_flawed IN position_dau_states)) AND (dmc$dau_usable IN
          position_dau_states) THEN
      IF p_dat^.header.bytes_per_dau > 4096 THEN     {this is not an 885 or 844
        assigned_pos_alloc_style := dmc$a0;
      ELSE
        assigned_pos_alloc_style := dmc$default_allocation_style;
      IFEND;
      allocation_style_available := TRUE;
      RETURN;
    IFEND;

    IF $dmt$dau_states [dmc$dau_assigned_to_mainframe] = position_dau_states THEN
      allocation_style_available := FALSE;
      RETURN;
    IFEND;

    IF $dmt$dau_states [dmc$dau_usable] = position_dau_states THEN
      assigned_pos_alloc_style := dmc$acyl;
      allocation_style_available := TRUE;
      RETURN;
    IFEND;

    allocation_style_available := FALSE;

  PROCEND deter_style_assigned_to_pos;
?? TITLE := ' determine_device_type', EJECT ??

  PROCEDURE determine_device_type
    (    p_dat: ^dmt$ms_device_allocation_table;
     VAR device_type: t$device_type;
     VAR status: ost$status);

    VAR
      bytes_per_mau: dmt$bytes_per_mau,
      cylinders_per_device: dmt$device_position,
      maus_per_cylinder: dmt$maus_per_position,
      maus_per_dau: dmt$maus_per_dau;

    status.normal := TRUE;

    bytes_per_mau := p_dat^.header.bytes_per_mau;
    cylinders_per_device := p_dat^.header.positions_per_device;
    maus_per_cylinder := p_dat^.header.maus_per_dau * p_dat^.header.daus_per_position;
    maus_per_dau := p_dat^.header.maus_per_dau;

    FOR device_type := LOWERVALUE (device_type) TO UPPERVALUE (device_type) DO
      IF (bytes_per_mau = physical_characteristics [device_type].bytes_per_mau) AND
         (cylinders_per_device = physical_characteristics [device_type].cylinders_per_device) AND
         (maus_per_cylinder = physical_characteristics [device_type].maus_per_cylinder) AND
         (maus_per_dau = physical_characteristics [device_type].maus_per_dau) THEN
        RETURN;
      IFEND;
    FOREND;

    osp$set_status_abnormal ('DM', 1, ' unknown device type', status);

  PROCEND determine_device_type;
?? TITLE := '  display_alloc_chain_command', EJECT ??

  PROCEDURE display_alloc_chain_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT dau_index_pdt (
{     dau_index, di: integer 0..1000000 = $required
{     status)

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

  VAR
    dau_index_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^dau_index_pdt_names,
  ^dau_index_pdt_params];

  VAR
    dau_index_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
  clt$parameter_name_descriptor := [['DAU_INDEX', 1], ['DI', 1], ['STATUS', 2]];

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

{ DAU_INDEX DI }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 1000000]],

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

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

    VAR
      dau: clt$value;

    clp$scan_parameter_list (parameter_list, dau_index_pdt, status);
    IF status.normal THEN
      clp$get_value ('DAU_INDEX', 1, 1, clc$low, dau, status);
      IF status.normal THEN

        IF global_p_dat = NIL THEN
          osp$set_status_abnormal ('DM', 1, ' dat not open', status);
        IFEND;

      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'DISPLAY_ALLOCATION_CHAIN', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_alloc_chain (global_p_dat, dau.int.value, display_control, status);
    IFEND;

  PROCEND display_alloc_chain_command;
?? TITLE := '  display_binary_unique_name', EJECT ??

  PROCEDURE display_binary_unique_name
    (VAR display_control: clt$display_control;
         binary_unique_name: ost$binary_unique_name;
     VAR status: ost$status);

    VAR
      unique_name: ost$name;

    status.normal := TRUE;
    pmp$convert_binary_unique_name (binary_unique_name, unique_name, status);
    IF status.normal THEN
      clp$put_partial_display (display_control, unique_name, clc$trim, amc$terminate, status);
    IFEND;

  PROCEND display_binary_unique_name;
?? TITLE := '  display_cylinders_command', EJECT ??

  PROCEDURE display_cylinders_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{   PDT display_cylinders_pdt (
{     display_option, do: KEY cylinder, cylinders, c, dau, daus, d = cylinder
{     status)

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

  VAR
    display_cylinders_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
  ^display_cylinders_pdt_names, ^display_cylinders_pdt_params];

  VAR
    display_cylinders_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
  clt$parameter_name_descriptor := [['DISPLAY_OPTION', 1], ['DO', 1], ['STATUS', 2]];

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

{ DISPLAY_OPTION DO }
    [[clc$optional_with_default, ^display_cylinders_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [^
  display_cylinders_pdt_kv1, clc$keyword_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
    display_cylinders_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := [
  'CYLINDER','CYLINDERS','C','DAU','DAUS','D'];

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

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

     VAR
       dov: clt$value;

    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, display_cylinders_pdt, status);
    IF status.normal THEN
      IF global_p_dat = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dat not open', status);
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, dov, status);
      IF status.normal THEN
        clp$new_display_page (display_control, status);
        clp$put_display (display_control, 'DISPLAY_CYLINDERS', clc$trim, status);
        clp$new_display_line (display_control, 1, status);
        IF (dov.name.value = 'CYLINDER') OR (dov.name.value = 'CYLINDERS') OR (dov.name.value = 'C') THEN
          display_user_cylinders (global_p_dat, global_dat_path.
            path_name (1, global_dat_path.path_name_size), display_control, status);
        ELSEIF (dov.name.value = 'DAU') OR (dov.name.value = 'DAUS') OR (dov.name.value = 'D') THEN
          display_user_device_type (global_p_dat, global_dat_path.
                path_name (1, global_dat_path.path_name_size), display_control, status);
          display_user_cylinders_daus (global_p_dat, display_control, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND display_cylinders_command;
?? TITLE := '  display_dat_command', EJECT ??

  PROCEDURE display_dat_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, status_pdt, status);
    IF status.normal THEN
      IF global_p_dat = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dat not open', status);
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_page (display_control, status);
      clp$put_display (display_control, 'DISPLAY_DAT', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_dat (global_p_dat, global_dat_path.path_name (1, global_dat_path.path_name_size),
            display_control, status);
    IFEND;
  PROCEND display_dat_command;
?? TITLE := '  display_dat_entry', EJECT ??

  PROCEDURE display_dat_entry
    (VAR display_control: clt$display_control;
         dat_index: integer;
         p_dat_entry: ^dmt$ms_device_allocation_unit;
     VAR status: ost$status);

    VAR
      aux_integer_length: integer,
      dfl_index: dmt$device_file_list_index,
      display_string: string (80),
      file_string: string (63),
      flaw_string: string (7),
      integer_string: string (80),
      integer_length: integer,
      mat_flaw_string: string (27),
      mat_string: string (38);

    status.normal := TRUE;

    STRINGREP (integer_string, integer_length, dat_index);

    CASE p_dat_entry^.dau_status OF

    = dmc$dau_usable =
      display_string := '        Usable                                                                  ';

      display_string (1, integer_length) := integer_string;

    = dmc$dau_hardware_flawed =
      display_string := '        Hardware Flawed                                                         ';

      display_string (1, integer_length) := integer_string;

    = dmc$dau_software_flawed =
      display_string := '        Software Flawed                                                         ';

      display_string (1, integer_length) := integer_string;

    = dmc$dau_assigned_to_mainframe, dmc$dau_ass_to_mf_swr_flawed =
      IF p_dat_entry^.dau_status = dmc$dau_ass_to_mf_swr_flawed THEN
        mat_flaw_string := '                     Flawed';
      ELSE
        mat_flaw_string := '                           ';
      IFEND;

      mat_string (1, * ) := '        Mfid(login seq, login index) -';

      mat_string (1, integer_length) := integer_string;

      STRINGREP (display_string, integer_length, mat_string: 38,
            p_dat_entry^.mainframe_id.log_in_sequence: 10, p_dat_entry^.mainframe_id.log_in_index: 3,
            mat_flaw_string: 29);

    = dmc$dau_assigned_to_file, dmc$dau_ass_to_file_swr_flawed =
      IF p_dat_entry^.dau_status = dmc$dau_ass_to_file_swr_flawed THEN
        flaw_string := ' Flawed';
      ELSE
        flaw_string := '       ';
      IFEND;

      file_string (1, * ) := '        Hash-    Status-';

      file_string (1, integer_length) := integer_string;

      STRINGREP (integer_string, integer_length, p_dat_entry^.file_hash);
      file_string (14, integer_length) := integer_string;

      IF p_dat_entry^.data_status = dmc$dau_data_initialized THEN
        file_string (25, 8) := 'Init    ';
      ELSE
        file_string (25, 8) := 'Not Init';
      IFEND;

      CASE p_dat_entry^.allocation_chain_position OF

      = dmc$first_and_last_allocation =
        file_string (35, 28) := 'First+Last Alloc(Dfl Index)-';

        dfl_index := p_dat_entry^.high_dfl_index * dmc$dfl_index_converter + p_dat_entry^.low_dfl_index;
        STRINGREP (display_string, integer_length, file_string: 63, dfl_index: 8, flaw_string: 9);

      = dmc$first_allocation =
        file_string (35, 28) := 'First Alloc(Next Dau Adrs) -';
        STRINGREP (display_string, integer_length, file_string: 63,

        p_dat_entry^.next_allocation_unit_dau: 8, flaw_string: 9);

      = dmc$middle_allocation =
        file_string (35, 28) := 'Middle Alloc(Next Dau Adrs) -';
        STRINGREP (display_string, integer_length, file_string: 63, p_dat_entry^.next_allocation_unit_dau: 8,
              flaw_string: 9);

      = dmc$last_allocation =
        file_string (35, 28) := 'Last Allocation(Dfl Index) -';
        dfl_index := p_dat_entry^.high_dfl_index * dmc$dfl_index_converter + p_dat_entry^.low_dfl_index;
        STRINGREP (display_string, integer_length, file_string: 63, dfl_index: 8, flaw_string: 9);

      = dmc$part_of_allocation_unit =
        file_string (35, 28) := 'Part of Allocation Unit     ';
        STRINGREP (display_string, integer_length, file_string: 71, flaw_string: 9);

      CASEND;
    CASEND;

    clp$put_display (display_control, display_string, clc$trim, status);

  PROCEND display_dat_entry;
?? TITLE := '  display_dat_header', EJECT ??

  PROCEDURE display_dat_header
    (VAR display_control: clt$display_control;
         dat_header: dmt$ms_device_alloc_table_head;
     VAR status: ost$status);

    VAR
      aux_string,
      integer_string: ost$string;

    status.normal := TRUE;

    clp$new_display_line (display_control, 1, status);

    clp$put_display (display_control, 'Device Allocation Table Header', clc$trim, status);

    clp$put_partial_display (display_control, '  Bytes/Dau         - ', clc$no_trim, amc$start, status);

    clp$convert_integer_to_string (dat_header.bytes_per_dau, 10, FALSE, integer_string, status);

    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Bytes/Mau         - ', clc$no_trim, amc$start, status);

    clp$convert_integer_to_string (dat_header.bytes_per_mau, 10, FALSE, integer_string, status);

    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Daus/Position     - ', clc$no_trim, amc$start, status);

    clp$convert_integer_to_string (dat_header.daus_per_position, 10, FALSE, integer_string, status);

    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Maus/Dau          - ', clc$no_trim, amc$start, status);

    clp$convert_integer_to_string (dat_header.maus_per_dau, 10, FALSE, integer_string, status);

    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Number Of Entries - ', clc$no_trim, amc$start, status);

    clp$convert_integer_to_string (dat_header.number_of_entries, 10, FALSE, integer_string, status);

    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Positions/Device  - ', clc$no_trim, amc$start, status);

    clp$convert_integer_to_string (dat_header.positions_per_device, 10, FALSE, integer_string, status);

    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Version Number    - ', clc$no_trim, amc$start, status);

    CASE dat_header.version_number OF
    = dmc$dat_0_0 =
      clp$put_partial_display (display_control, 'dmc$dat_0_0', clc$trim, amc$terminate, status);

      clp$new_display_line (display_control, 1, status);

      clp$put_display (display_control, '    Daus/Allocation Style', clc$trim, status);

      clp$put_partial_display (display_control, '      A0   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a0], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A1   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a1], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A2   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a2], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A3   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a3], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A4   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a4], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A5   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a5], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A6   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a6], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A7   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a7], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      A8   - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$a8], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '      Acyl - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.daus_per_allocation_style [dmc$acyl], 10, FALSE, ' ',
            integer_string.value (1, 6), status);

      clp$put_partial_display (display_control, integer_string.value (1, 6), clc$trim, amc$terminate, status);

      clp$new_display_line (display_control, 1, status);

      clp$put_partial_display (display_control, '    Daus available     - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.available, 10, FALSE, ' ', integer_string.value (1, 8),
            status);

      clp$put_partial_display (display_control, integer_string.value (1, 8), clc$no_trim, amc$terminate,
            status);

      clp$put_partial_display (display_control, '    Recovery threshold - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.recovery_threshold, 10, FALSE, ' ', integer_string.
            value (1, 8), status);

      clp$put_partial_display (display_control, integer_string.value (1, 8), clc$no_trim, amc$terminate,
            status);

      clp$put_partial_display (display_control, '    Warning threshold  - ', clc$no_trim, amc$start, status);

      clp$convert_integer_to_rjstring (dat_header.warning_threshold, 10, FALSE, ' ', integer_string.
            value (1, 8), status);

      clp$put_partial_display (display_control, integer_string.value (1, 8), clc$no_trim, amc$terminate,
            status);

    = dmc$dat_1_0 =
      clp$put_partial_display (display_control, 'dmc$dat_1_0', clc$trim, amc$terminate, status);
    CASEND;
  PROCEND display_dat_header;
?? TITLE := '  display_dat_header_command', EJECT ??

  PROCEDURE display_dat_header_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, status_pdt, status);
    IF status.normal THEN

      IF global_p_dat = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dat not open', status);
      IFEND;

    IFEND;

    IF status.normal THEN
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'DISPLAY_DAT_HEADER', clc$trim, status);
      display_user_dat_header (global_p_dat, global_dat_path.
            path_name (1, global_dat_path.path_name_size), display_control, status);
    IFEND;

  PROCEND display_dat_header_command;
?? TITLE := '  display_dau_entry_command', EJECT ??

  PROCEDURE display_dau_entry_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT dau_index_pdt (
{     dau_index, di: integer 0..1000000 = $required
{     status)

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

  VAR
    dau_index_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^dau_index_pdt_names,
  ^dau_index_pdt_params];

  VAR
    dau_index_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
  clt$parameter_name_descriptor := [['DAU_INDEX', 1], ['DI', 1], ['STATUS', 2]];

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

{ DAU_INDEX DI }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 1000000]],

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

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

    VAR
      dau: clt$value;

    clp$scan_parameter_list (parameter_list, dau_index_pdt, status);
    IF status.normal THEN
      clp$get_value ('DAU_INDEX', 1, 1, clc$low, dau, status);
      IF status.normal THEN

        IF global_p_dat = NIL THEN
          osp$set_status_abnormal ('DM', 1, ' dat not open', status);
        IFEND;

      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'DISPLAY_DAU_ENTRY', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_dat_entry (global_p_dat, dau.int.value, display_control, status);
    IFEND;

  PROCEND display_dau_entry_command;
?? TITLE := ' display_dau_from_cts', EJECT ??

  PROCEDURE display_dau_from_cts
    (    p_dat: ^dmt$ms_device_allocation_table;
         cylinder: integer;
         track: integer;
         sector: integer;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      dau: dmt$dau_address,
      device_type: t$device_type,
      str: string (80),
      l: integer;

    determine_device_type (p_dat, device_type, status);
    IF status.normal THEN
      convert_cts_to_dau (cylinder, track, sector, device_type, dau, status);
      IF status.normal THEN
        STRINGREP (str, l, ' For device type ', device_type_string [device_type], '  C', cylinder, '  T',
              track, '  S', sector, ' maps to dau address ', dau);
        clp$put_display (display_control, str (1, l), clc$trim, status);
      IFEND;
    IFEND;

  PROCEND display_dau_from_cts;
?? TITLE := '  display_device_type_command', EJECT ??

  PROCEDURE display_device_type_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, status_pdt, status);
    IF status.normal THEN
      IF global_p_dat = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dat not open', status);
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'DISPLAY_DEVICE_TYPE', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_device_type (global_p_dat, global_dat_path.
            path_name (1, global_dat_path.path_name_size), display_control, status);
    IFEND;

  PROCEND display_device_type_command;
?? TITLE := '  display_dfl_command', EJECT ??

  PROCEDURE display_dfl_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, status_pdt, status);
    IF status.normal THEN

      IF global_p_dfl = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dfl not open', status);
      ELSE
        clp$new_display_page (display_control, status);
        clp$put_display (display_control, 'DISPLAY_DFL', clc$trim, status);
        display_user_dfl (global_p_dfl, global_dfl_path.path_name (1, global_dfl_path.path_name_size),
                              display_control, status);
      IFEND;

    IFEND;

  PROCEND display_dfl_command;
?? TITLE := '  display_dfl_entry', EJECT ??

  PROCEDURE display_dfl_entry
    (VAR display_control: clt$display_control;
         dfl_index: dmt$device_file_list_index;
         p_dfl_entry: ^dmt$ms_device_file_list_entry;
     VAR status: ost$status);

    VAR
      integer_string: string (osc$max_string_size),
      integer_length: integer,
      display_string: string (osc$max_string_size),
      aux_integer_length: integer,
      login_index: dmt$login_table_entry_index,
      first: boolean;

    status.normal := TRUE;

    STRINGREP (integer_string, integer_length, dfl_index);

    CASE p_dfl_entry^.flags OF
    = dmc$dfle_available =
      display_string := '       Dfle Available                                                ';
      display_string (1, integer_length) := integer_string;
    = dmc$dfle_assigned_to_mainframe =
      display_string := '       Mainframe Assigned(Login Seq, Login Index)-                     ';
      display_string (1, integer_length) := integer_string;
      STRINGREP (integer_string, integer_length, p_dfl_entry^.mainframe_assigned.log_in_sequence);
      display_string (51, integer_length) := integer_string;
      display_string (51 + integer_length, 2) := ', ';
      STRINGREP (integer_string, aux_integer_length, p_dfl_entry^.mainframe_assigned.log_in_index);
      display_string (51 + integer_length + 2, aux_integer_length) := integer_string;
    = dmc$dfle_assigned_to_file =
      display_string := '       File Type-             File Hash-     Fba-                       ';
      display_string (1, integer_length) := integer_string;
      CASE p_dfl_entry^.file_kind OF
      = gfc$fk_job_permanent_file =
        display_string (18, 12) := 'Permanent   ';
      = gfc$fk_device_file =
        display_string (18, 12) := 'Device      ';
      = gfc$fk_job_local_file =
        display_string (18, 12) := 'Temp Named  ';
      = gfc$fk_unnamed_file =
        display_string (18, 12) := 'Temp Unnamed';
      = gfc$fk_global_unnamed =
        display_string (18, 12) := 'Temp Global ';
      = gfc$fk_catalog =
        display_string (18, 12) := 'Catalog     ';
      ELSE
        ;
      CASEND;
      STRINGREP (integer_string, integer_length, p_dfl_entry^.file_hash);
      display_string (41, integer_length) := integer_string;
      STRINGREP (integer_string, integer_length, p_dfl_entry^.file_byte_address);
      display_string (49, integer_length) := integer_string;

      clp$put_display (display_control, display_string, clc$trim, status);

      clp$put_partial_display (display_control, '       GFN - ', clc$no_trim, amc$start, status);

      display_binary_unique_name (display_control, p_dfl_entry^.global_file_name, status);

      display_string := '       Daus/Alloc Unit-    Dau Chain Status-                           ';
      STRINGREP (integer_string, integer_length, p_dfl_entry^.daus_per_allocation_unit);
      display_string (24, integer_length) := integer_string;
      IF p_dfl_entry^.dau_chain_status = dmc$dau_chain_linked THEN
        display_string (45, 12) := 'Chain Linked';
      ELSE
        display_string (45, 16) := 'Chain Not Linked';
      IFEND;

      clp$put_display (display_control, display_string, clc$trim, status);

      display_string := '       First Dau Address-           Subfile Length-                    ';
      STRINGREP (integer_string, integer_length, p_dfl_entry^.first_dau_address);
      display_string (26, integer_length) := integer_string;
      STRINGREP (integer_string, integer_length, p_dfl_entry^.fmd_length);
      display_string (52, integer_length) := integer_string;

      clp$put_display (display_control, display_string, clc$trim, status);

      display_string := '       Logical Length-           End Of Information-                   ';
      STRINGREP (integer_string, integer_length, p_dfl_entry^.logical_length);
      display_string (23, integer_length) := integer_string;
      STRINGREP (integer_string, integer_length, p_dfl_entry^.end_of_information);
      display_string (53, integer_length) := integer_string;

      clp$put_display (display_control, display_string, clc$trim, status);

      display_string := '       End Of File-           Login Set-(                              ';
      STRINGREP (integer_string, integer_length, p_dfl_entry^.end_of_file);
      display_string (20, integer_length) := integer_string;
      first := TRUE;
      aux_integer_length := 43;
      FOR login_index := LOWERVALUE (dmt$login_table_entry_index)
            TO UPPERVALUE (dmt$login_table_entry_index) DO
        IF login_index IN p_dfl_entry^.login_set THEN
          IF NOT first THEN
            display_string (aux_integer_length, 2) := ', ';
            aux_integer_length := aux_integer_length + 2;
          IFEND;

          STRINGREP (integer_string, integer_length, login_index);
          display_string (aux_integer_length, integer_length) := integer_string;
          aux_integer_length := aux_integer_length + integer_length;
          first := FALSE;
        IFEND;
      FOREND;

      display_string (aux_integer_length, 1) := ')';

      clp$put_display (display_control, display_string, clc$trim, status);

      first := TRUE;
      display_string := '       Abnormalities: None.';
      aux_integer_length := 23;

      IF dmc$eoi_modified_by_recovery IN p_dfl_entry^.damage THEN
        first := FALSE;
        display_string (aux_integer_length, 25) := 'Eoi modified by recovery.';
        aux_integer_length := aux_integer_length + 24;
      IFEND;

      IF dmc$media_image_inconsistent IN p_dfl_entry^.damage THEN
        IF NOT first THEN
          display_string (aux_integer_length, 2) := ', ';
          aux_integer_length := aux_integer_length + 3;
        IFEND;
        first := FALSE;
        display_string (aux_integer_length, 19) := 'Media inconsistent.';
        aux_integer_length := aux_integer_length + 18;
      IFEND;

      IF dmc$allocation_chain_broken IN p_dfl_entry^.damage THEN
        IF NOT first THEN
          display_string (aux_integer_length, 2) := ', ';
          aux_integer_length := aux_integer_length + 3;
        IFEND;
        first := FALSE;
        display_string (aux_integer_length, 24) := 'Allocation chain broken.';
      IFEND;
    CASEND;

    clp$put_display (display_control, display_string, clc$trim, status);

    clp$new_display_line (display_control, 1, status);

  PROCEND display_dfl_entry;
?? TITLE := '  display_dfl_entry_command', EJECT ??

  PROCEDURE display_dfl_entry_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT disdfle_pdt (
{ index, i: integer 1..1000000 = $required
{ allocation_chain, ac: boolean = FALSE
{ status)

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

  VAR
    disdfle_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^disdfle_pdt_names,
  ^disdfle_pdt_params];

  VAR
    disdfle_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
  clt$parameter_name_descriptor := [['INDEX', 1], ['I', 1], ['ALLOCATION_CHAIN', 2], ['AC', 2], ['STATUS', 3]
  ];

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

{ INDEX I }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1, 1000000]],

{ ALLOCATION_CHAIN AC }
    [[clc$optional_with_default, ^disdfle_pdt_dv2], 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
    disdfle_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'FALSE';

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

    VAR
      allocation_chain_desired: boolean,
      dau: dmt$dau_address,
      dfl_index: dmt$device_file_list_index,
      specified: boolean,
      allocation_chain: clt$value,
      index: clt$value;

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

    clp$scan_parameter_list (parameter_list, disdfle_pdt, status);
    IF status.normal THEN

      IF global_p_dfl = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dfl not open', status);
      IFEND;

      IF status.normal THEN
        clp$get_value ('INDEX', 1, 1, clc$low, index, status);
        IF status.normal THEN
          clp$test_parameter ('ALLOCATION_CHAIN', specified, status);
          IF status.normal AND specified THEN
            clp$get_value ('ALLOCATION_CHAIN', 1, 1, clc$low, allocation_chain, status);
            IF status.normal THEN
              allocation_chain_desired := allocation_chain.bool.value;
              IF allocation_chain_desired AND (global_p_dat = NIL) THEN
                osp$set_status_abnormal ('DM', 1, ' dat not open', status);
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      dfl_index := index.int.value;
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'DISPLAY_DFL_ENTRY', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_dfl_entry (global_p_dfl, dfl_index, display_control, status);
    IFEND;

    IF status.normal AND allocation_chain_desired THEN
      IF (global_p_dfl^.entries [dfl_index].flags = dmc$dfle_assigned_to_file) AND
            (global_p_dfl^.entries [dfl_index].dau_chain_status = dmc$dau_chain_linked) THEN
        dau := global_p_dfl^.entries [dfl_index].first_dau_address;
        clp$new_display_line (display_control, 1, status);
        clp$put_display (display_control, 'DISPLAY_ALLOCATION_CHAIN', clc$trim, status);
        clp$new_display_line (display_control, 1, status);
        display_user_alloc_chain (global_p_dat, dau, display_control, status);
      IFEND;
    IFEND;

  PROCEND display_dfl_entry_command;
?? TITLE := '  display_dfl_header', EJECT ??

  PROCEDURE display_dfl_header
    (VAR display_control: clt$display_control;
         p_dfl_header: ^dmt$ms_device_file_list_header;
     VAR status: ost$status);

    VAR
      aux_string,
      integer_string: ost$string;

    status.normal := TRUE;

    clp$new_display_line (display_control, 1, status);
    clp$put_partial_display (display_control, '  Number Of Entries - ', clc$no_trim, amc$start, status);
    clp$convert_integer_to_string (p_dfl_header^.number_of_entries, 10, FALSE, integer_string,
          status);
    clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
          amc$terminate, status);

    clp$put_partial_display (display_control, '  Version Number    - ', clc$no_trim, amc$start, status);

    CASE p_dfl_header^.version_number OF
    = dmc$dflt_0_0 =
      aux_string.value := 'dmc$dflt_0_0';
      aux_string.size := 12;
    = dmc$dflt_1_0 =
      aux_string.value := 'dmc$dflt_1_0';
      aux_string.size := 12;
    ELSE
      ;
    CASEND;

    clp$put_partial_display (display_control, aux_string.value (1, aux_string.size), clc$trim, amc$terminate,
          status);

    clp$new_display_line (display_control, 1, status);

  PROCEND display_dfl_header;
?? TITLE := '  display_directory_entry', EJECT ??

  PROCEDURE display_directory_entry
    (VAR display_control: clt$display_control;
         directory_entry: dmt$ms_volume_directory_entry;
     VAR status: ost$status);

    VAR
      aux_string: ost$string;

    status.normal := TRUE;

    clp$put_partial_display (display_control, '  Entry Available    - ', clc$no_trim, amc$start, status);
    IF directory_entry.entry_available THEN
      aux_string.value := 'True';
      aux_string.size := 4;
    ELSE
      aux_string.value := 'False';
      aux_string.size := 5;
    IFEND;
    clp$put_partial_display (display_control, aux_string.value (1, aux_string.size), clc$no_trim,
          amc$terminate, status);

    IF NOT directory_entry.entry_available THEN
      clp$put_partial_display (display_control, '  User Supplied Name - ', clc$no_trim, amc$start, status);
      clp$put_partial_display (display_control, directory_entry.user_supplied_name, clc$trim, amc$terminate,
            status);

      clp$put_partial_display (display_control, '  Global File Name   - ', clc$no_trim, amc$start, status);

      display_binary_unique_name (display_control, directory_entry.global_file_name, status);

      display_stored_fmd (display_control, ^directory_entry.stored_df_fmd, status);
    IFEND;

  PROCEND display_directory_entry;
?? TITLE := '   display_directory_entry_command', EJECT ??

  PROCEDURE display_directory_entry_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{   PDT display_dir_pdt (
{   index,i:integer 1..100 = $required
{   status)

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

  VAR
    display_dir_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^display_dir_pdt_names,
  ^display_dir_pdt_params];

  VAR
    display_dir_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
  clt$parameter_name_descriptor := [['INDEX', 1], ['I', 1], ['STATUS', 2]];

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

{ INDEX I }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1, 100]],

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

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

    VAR
      index: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, display_dir_pdt, status);
    IF status.normal THEN

      IF global_p_directory = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' directory not open', status);
      IFEND;

      IF status.normal THEN
        clp$get_value ('INDEX', 1, 1, clc$low, index, status);
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_line (display_control, 1, status);
      clp$put_display (display_control, 'DISPLAY_DIRECTORY_ENTRY', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_dir_entry (global_p_directory, index.int.value, display_control, status);
    IFEND;
  PROCEND display_directory_entry_command;
?? TITLE := '  display_directory_command', EJECT ??

  PROCEDURE display_directory_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, status_pdt, status);
    IF status.normal THEN
      IF global_p_directory = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' directory not open', status);
      IFEND;
    IFEND;

    IF status.normal THEN
      clp$new_display_page (display_control, status);
      clp$put_display (display_control, 'DISPLAY_DIRECTORY', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      display_user_directory (global_p_directory, global_directory_path.
            path_name (1, global_directory_path.path_name_size), display_control, status);
    IFEND;
  PROCEND display_directory_command;
?? TITLE := '  display_line', EJECT ??

  PROCEDURE display_line
    (    output_line: string ( * );
         number: integer;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

{
{   The purpose of this procedure is to output a line with the number converted to a string
{ appended to the line.
{

    VAR
      integer_length: integer,
      integer_string: string (osc$max_string_size),
      line: string (osc$max_string_size);

    STRINGREP (integer_string, integer_length, number);
    line := output_line;
    line (STRLENGTH (output_line) + 1, integer_length) := integer_string;
    clp$put_display (display_control, line, clc$trim, status);

  PROCEND display_line;
?? TITLE := '  display_stored_fmd', EJECT ??

  PROCEDURE display_stored_fmd
    (VAR display_control: clt$display_control;
         p_stored_df_fmd: ^dmt$device_file_stored_fmd;
     VAR status: ost$status);

    VAR
      stored_df_fmd: ^dmt$device_file_stored_fmd,
      aux_string,
      integer_string: ost$string,
      fmd_version: ^dmt$stored_ms_version_number,
      stored_fmd_header: ^dmt$stored_ms_fmd_header,
      stored_fmd_subfile: ^dmt$stored_ms_fmd_subfile;

    status.normal := TRUE;
    stored_df_fmd := p_stored_df_fmd;

    RESET stored_df_fmd;
    NEXT fmd_version IN stored_df_fmd;
    IF fmd_version = NIL THEN
      osp$set_status_abnormal ('DM', 1, ' dme$invalid_fmd, No FMD version number.', status);
      RETURN;
    IFEND;

    NEXT stored_fmd_header: [fmd_version^] IN stored_df_fmd;
    IF stored_fmd_header = NIL THEN
      osp$set_status_abnormal ('DM', 1, ' dme$invalid_fmd, No FMD header.', status);
      RETURN;
    IFEND;

    clp$put_display (display_control, 'Stored Fmd Header', clc$trim, status);

    CASE fmd_version^ OF
    = 0 =
      clp$put_display (display_control, '  Version                   - 0', clc$trim, status);

      clp$put_partial_display (display_control, '  Clear Space               - ', clc$no_trim, amc$start,
            status);

      IF stored_fmd_header^.version_0_0.clear_space THEN
        aux_string.value := 'True';
        aux_string.size := 4;
      ELSE
        aux_string.value := 'False';
        aux_string.size := 5;
      IFEND;

      clp$put_partial_display (display_control, aux_string.value (1, aux_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  File Hash                 - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.file_hash, 10, FALSE, integer_string,
            status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  File Limit                - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.file_limit, 10, FALSE, integer_string,
            status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  File Type                 - ', clc$no_trim, amc$start,
            status);

      CASE stored_fmd_header^.version_0_0.file_kind OF
      = gfc$fk_job_permanent_file =
        aux_string.value := 'gfc$fk_job_permanent_file';
        aux_string.size := 25;
      = gfc$fk_device_file =
        aux_string.value := 'gfc$fk_device_file';
        aux_string.size := 18;
      = gfc$fk_job_local_file =
        aux_string.value := 'gfc$fk_job_local_file';
        aux_string.size := 21;
      = gfc$fk_unnamed_file =
        aux_string.value := 'gfc$fk_unnamed_file';
        aux_string.size := 19;
      = gfc$fk_catalog =
        aux_string.value := 'gfc$fk_catalog';
        aux_string.size := 14;
      ELSE
        ;
      CASEND;

      clp$put_partial_display (display_control, aux_string.value (1, aux_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Locked File               - ', clc$no_trim, amc$start,
            status);

      clp$put_partial_display (display_control, '(', clc$trim, amc$continue, status);

      IF stored_fmd_header^.version_0_0.locked_file.required THEN
        clp$put_partial_display (display_control, 'True, ', clc$trim, amc$terminate, status);
      ELSE
        clp$put_partial_display (display_control, 'False)', clc$trim, amc$terminate, status);
      IFEND;

      clp$put_partial_display (display_control, '  Number Subfiles           - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.number_fmds, 10, FALSE, integer_string,
            status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Overflow Allowed          - ', clc$no_trim, amc$start,
            status);

      IF stored_fmd_header^.version_0_0.overflow_allowed THEN
        aux_string.value := 'True';
        aux_string.size := 4;
      ELSE
        aux_string.value := 'False';
        aux_string.size := 5;
      IFEND;

      clp$put_partial_display (display_control, aux_string.value (1, aux_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Preset Value              - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.preset_value, 10, FALSE, integer_string,
            status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Requested Allocation Size - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.requested_allocation_size, 10, FALSE,
            integer_string, status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Requested Class           - ', clc$no_trim, amc$start,
            status);

      aux_string.value (1) := stored_fmd_header^.version_0_0.requested_class;
      aux_string.size := 1;

      clp$put_partial_display (display_control, aux_string.value (1, aux_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Requested Class Ordinal   - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.requested_class_ordinal, 10, FALSE,
            integer_string, status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Requested Transfer Size   - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_0_0.requested_transfer_size, 10, FALSE,
            integer_string, status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Requested Volume.Rec_Vsn  - ', clc$no_trim, amc$start,
            status);

      clp$put_partial_display (display_control, stored_fmd_header^.version_0_0.requested_volume.recorded_vsn,
            clc$trim, amc$terminate, status);

      clp$put_partial_display (display_control, '  Requested Volume.Set_Name - ', clc$no_trim, amc$start,
            status);

      clp$put_partial_display (display_control, stored_fmd_header^.version_0_0.requested_volume.setname,
            clc$trim, amc$terminate, status);

    = 1 =
      clp$put_partial_display (display_control, '  Version                  - 1', clc$trim, amc$terminate,
            status);

      clp$put_partial_display (display_control, '  Number Subfiles           - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_header^.version_1_0.number_fmds, 10, FALSE, integer_string,
            status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);
    ELSE
      ;
    CASEND;

    NEXT stored_fmd_subfile: [fmd_version^] IN stored_df_fmd;
    IF stored_fmd_subfile = NIL THEN
      osp$set_status_abnormal ('DM', 1, ' dme$invalid_fmd, FMD too small to hold subfiles.', status);
      RETURN;
    IFEND;

    clp$put_display (display_control, 'Stored Fmd Subfile', clc$trim, status);

    CASE fmd_version^ OF
    = 0 =
      clp$put_partial_display (display_control, '  Version                   - 0', clc$trim, amc$terminate,
            status);

      clp$put_partial_display (display_control, '  Byte Address              - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_subfile^.version_0_0.stored_byte_address *
            dmc$byte_address_converter, 10, FALSE, integer_string, status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Device File List Index    - ', clc$no_trim, amc$start,
            status);

      clp$convert_integer_to_string (stored_fmd_subfile^.version_0_0.device_file_list_index, 10, FALSE,
            integer_string, status);

      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      clp$put_partial_display (display_control, '  Interval Vsn              - ', clc$no_trim, amc$start,
            status);

      display_binary_unique_name (display_control, stored_fmd_subfile^.version_0_0.internal_vsn, status);

      clp$put_partial_display (display_control, '  Recorded Vsn              - ', clc$no_trim, amc$start,
            status);

      clp$put_partial_display (display_control, stored_fmd_subfile^.version_0_0.recorded_vsn, clc$trim,
            amc$terminate, status);

    = 1 =
      clp$put_display (display_control, '  Version                   - 1', clc$trim, status);

      clp$put_partial_display (display_control, '  Recorded Vsn              - ', clc$no_trim, amc$start,
            status);

      clp$put_partial_display (display_control, stored_fmd_subfile^.version_1_0.recorded_vsn, clc$trim,
            amc$terminate, status);
    ELSE
      ;
    CASEND;

  PROCEND display_stored_fmd;
?? TITLE := '  display_user_alloc_chain', EJECT ??

  PROCEDURE display_user_alloc_chain
    (    p_dat: ^dmt$ms_device_allocation_table;
         dau_index: dmt$dau_address;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      stop: boolean,
      part_dau: dmt$dau_address,
      dau: dmt$dau_address,
      end_of_chain: boolean;

    status.normal := TRUE;
    IF (dau_index < 0) OR (dau_index >= p_dat^.header.number_of_entries) THEN
      osp$set_status_abnormal ('DM', 1, ' dau index out of range for device type', status);
    ELSE
      end_of_chain := FALSE;
      dau := dau_index;

      WHILE NOT end_of_chain DO

        display_dat_entry (display_control, dau, ^p_dat^.body [dau], status);

        CASE p_dat^.body [dau].dau_status OF
        = dmc$dau_usable, dmc$dau_hardware_flawed, dmc$dau_software_flawed,
              dmc$dau_assigned_to_mainframe, dmc$dau_ass_to_mf_swr_flawed =
          end_of_chain := TRUE;
        = dmc$dau_assigned_to_file, dmc$dau_ass_to_file_swr_flawed =

          CASE p_dat^.body [dau].allocation_chain_position OF
          = dmc$first_and_last_allocation, dmc$last_allocation =
            end_of_chain := TRUE;
          = dmc$part_of_allocation_unit =
            clp$put_display (display_control, '      is part of an allocation unit which begins with dau :',
                             clc$trim, status);
            part_dau := dau;
            stop := FALSE;
            REPEAT
              part_dau := part_dau - 1;
              IF part_dau < 0 THEN       {  something wrong, we've run off the end without finding start
                stop := TRUE;
                end_of_chain := TRUE;
              ELSE
                CASE p_dat^.body [part_dau].dau_status OF
                = dmc$dau_assigned_to_file, dmc$dau_ass_to_file_swr_flawed =
                  CASE p_dat^.body [part_dau].allocation_chain_position OF
                  = dmc$part_of_allocation_unit =
                    { keep going
                  ELSE
                    stop := TRUE;
                    dau := part_dau;
                  CASEND;
                ELSE
                  stop := TRUE;
                  end_of_chain := TRUE;
                CASEND;
              IFEND;
            UNTIL stop;

          = dmc$first_allocation, dmc$middle_allocation =
            dau := p_dat^.body [dau].next_allocation_unit_dau;
          ELSE
            end_of_chain := TRUE;
          CASEND;

        ELSE
          end_of_chain := TRUE;
        CASEND;
      WHILEND;
    IFEND;

  PROCEND display_user_alloc_chain;
?? TITLE := '  display_user_cylinders', EJECT ??

  PROCEDURE display_user_cylinders
    (    p_dat: ^dmt$ms_device_allocation_table;
         path: string ( * );
     VAR display_control: clt$display_control;
     VAR status: ost$status);

{
{  This procedure produces a display of the current state of cylinder
{ allocation on a volume.
{  Information provided is:
{          . some header information (date, time, cylinders per device, etc.)
{          . one line for each cylinder on the device stating the number of
{ the cylinder, the
{              allocation style assigned to the cylinder, whether or not the
{ cylinder is
{              'full', and how the daus are assigned within the cylinder
{ (assigned to file or
{              assigned to mainframe, or flawed)
{          . some summary information indicating the total numbers of daus by
{ assignment, and
{              numbers of cylinders assigned to each allocation style
{

    VAR
      device_type: t$device_type,
      line: string (80),
      l: integer,
      dau_index: dmt$dau_address,
      num_usable: integer,
      num_assigned_file: integer,
      num_assigned_mf: integer,
      num_flawed: integer,
      total_usable: integer,
      total_assigned_file: integer,
      total_assigned_mf: integer,
      total_flawed: integer,
      style_index: dmt$allocation_styles,
      styles_per_device: array [dmt$allocation_styles] of integer,
      cylinder_dau_address: dmt$dau_address,
      cylinder_index: dmt$device_position,
      assigned_style: dmt$allocation_styles,
      skip_position,
      style_available: boolean;

    status.normal := TRUE;

    determine_device_type (p_dat, device_type, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR style_index := LOWERVALUE (dmt$allocation_styles)
          TO UPPERVALUE (dmt$allocation_styles) DO
      styles_per_device [style_index] := 0;
    FOREND;

    total_usable := 0;
    total_assigned_file := 0;
    total_assigned_mf := 0;
    total_flawed := 0;

    line (1, * ) := ' CYLINDERS: ';
    line (13, * ) := path;

    clp$new_display_page (display_control, status);
    clp$put_display (display_control, line, clc$trim, status);
    clp$new_display_line (display_control, 1, status);

    clp$put_partial_display (display_control, ' daus/cyl = ', clc$no_trim,
          amc$start, status);
    STRINGREP (line (1, 10), l, p_dat^.header.daus_per_position);
    clp$put_partial_display (display_control, line (1, l), clc$no_trim,
          amc$continue, status);
    clp$put_partial_display (display_control, '  cyl/device = ', clc$no_trim,
          amc$continue, status);
    STRINGREP (line (1, 10), l, p_dat^.header.positions_per_device);
    clp$put_partial_display (display_control, line (1, l), clc$trim,
          amc$terminate, status);
    clp$new_display_line (display_control, 1, status);

    line (1, * ) := ' CYLINDER ALLOCATION  DAUs  ASSGND ASSGND';
    clp$put_display (display_control, line, clc$trim, status);
    line (1, * ) := '  NUMBER    STYLE    USABLE  FILE    MF   FLAWED';
    clp$put_display (display_control, line, clc$trim, status);
    clp$new_display_line (display_control, 1, status);

{
{  For each cylinder, write a line describing the cylinder's style and how the
{ daus within the
{  cylinder are assigned.
{

  /display_cylinders/
    FOR cylinder_index := 0 TO p_dat^.header.positions_per_device - 1 DO
      line (1, * ) := ' ';
      STRINGREP (line (3, 5), l, cylinder_index);
      deter_style_assigned_to_pos (cylinder_index,
            p_dat^.header.daus_per_position, p_dat, assigned_style,
            style_available, skip_position, status);

      IF status.normal THEN
        IF NOT skip_position THEN
          CASE assigned_style OF
          = dmc$a0 =
            line (9, * ) := 'a0';
          = dmc$a1 =
            line (9, * ) := 'a1';
            line (12, * ) := '*';
          = dmc$a2 =
            line (9, * ) := 'a2';
            line (12, * ) := '**';
          = dmc$a3 =
            line (9, * ) := 'a3';
            line (12, * ) := '***';
          = dmc$a4 =
            line (9, * ) := 'a4';
            line (12, * ) := '****';
          = dmc$a5 =
            line (9, * ) := 'a5';
            line (12, * ) := '*****';
          = dmc$a6 =
            line (9, * ) := 'a6';
            line (12, * ) := '******';
          = dmc$a7 =
            line (9, * ) := 'a7';
            line (12, * ) := '*******';
          = dmc$a8 =
            line (9, * ) := 'a8';
            line (12, * ) := '********';
          = dmc$acyl =
            line (9, * ) := 'cy';
            line (12, * ) := '**********';
          ELSE
            line (12, * ) := 'NO STYLE';
          CASEND;

          styles_per_device [assigned_style] :=
                styles_per_device [assigned_style] + 1;

        ELSE {skip position}
          line (12, * ) := 'NO STYLE';
        IFEND;

        num_usable := 0;
        num_assigned_file := 0;
        num_assigned_mf := 0;
        num_flawed := 0;

        cylinder_dau_address := cylinder_index *
              p_dat^.header.daus_per_position;

        FOR dau_index := 0 TO p_dat^.header.daus_per_position - 1 DO
          CASE p_dat^.body [cylinder_dau_address + dau_index].dau_status OF
          = dmc$dau_usable =
            num_usable := num_usable + 1;
          = dmc$dau_assigned_to_file =
            num_assigned_file := num_assigned_file + 1;
          = dmc$dau_assigned_to_mainframe =
            num_assigned_mf := num_assigned_mf + 1;
          = dmc$dau_hardware_flawed, dmc$dau_software_flawed,
                dmc$dau_ass_to_mf_swr_flawed, dmc$dau_ass_to_file_swr_flawed =
            num_flawed := num_flawed + 1;
          ELSE
          CASEND;
        FOREND;

        total_usable := total_usable + num_usable;
        total_assigned_file := total_assigned_file + num_assigned_file;
        total_assigned_mf := total_assigned_mf + num_assigned_mf;
        total_flawed := total_flawed + num_flawed;

        STRINGREP (line (23, 6), l, num_usable);
        STRINGREP (line (30, 6), l, num_assigned_file);
        STRINGREP (line (37, 6), l, num_assigned_mf);
        STRINGREP (line (44, 6), l, num_flawed);

        IF NOT style_available THEN
          IF num_assigned_file = p_dat^.header.daus_per_position THEN
            line (50, * ) := 'FULL CYLINDER';
          ELSEIF num_assigned_mf = p_dat^.header.daus_per_position THEN
            line (50, * ) := 'FULL, ASSIGNED TO MAINFRAME';
          ELSEIF num_flawed = p_dat^.header.daus_per_position THEN
            line (50, * ) := 'FULL AND FLAWED';
          ELSE
            line (50, * ) := 'STYLE UNAVAILABLE';
          IFEND;
        IFEND;

      ELSE {bad status}
        line (12, * ) := status.text.value;
      IFEND;

      clp$put_display (display_control, line, clc$trim, status);

    FOREND /display_cylinders/;

{
{  Write summary (totals) information
{

    clp$new_display_line (display_control, 2, status);

    clp$put_display (display_control, '  TOTAL DAUS ON DEVICE :', clc$trim,
          status);
    clp$new_display_line (display_control, 1, status);
    line (1, * ) := ' ';
    STRINGREP (line, l, '   usable daus =', total_usable);
    clp$put_display (display_control, line, clc$trim, status);
    line (1, * ) := ' ';
    STRINGREP (line, l, '   daus assigned to file =', total_assigned_file);
    clp$put_display (display_control, line, clc$trim, status);
    line (1, * ) := ' ';
    STRINGREP (line, l, '   daus assigned to mainframe =', total_assigned_mf);
    clp$put_display (display_control, line, clc$trim, status);
    line (1, * ) := ' ';
    STRINGREP (line, l, '   flawed daus =', total_flawed);
    clp$put_display (display_control, line, clc$trim, status);

    clp$new_display_line (display_control, 1, status);
    clp$put_display (display_control, '  TOTAL CYLINDERS BY STYLE :', clc$trim,
          status);
    clp$new_display_line (display_control, 1, status);

    line (1, * ) := ' ';
    STRINGREP (line, l, '   a0=', styles_per_device [dmc$a0], ' a1=',
          styles_per_device [dmc$a1], ' a2=', styles_per_device [dmc$a2],
          ' a3=', styles_per_device [dmc$a3],
          ' a4=', styles_per_device [dmc$a4]);
    clp$put_display (display_control, line, clc$trim, status);

    line (1, * ) := ' ';
    STRINGREP (line, l, '   a5=', styles_per_device [dmc$a5], ' a6=',
          styles_per_device [dmc$a6], ' a7=', styles_per_device [dmc$a7],
          ' a8=', styles_per_device [dmc$a8],
          ' cyl=', styles_per_device [dmc$acyl]);
    clp$put_display (display_control, line, clc$trim, status);
    clp$new_display_line (display_control, 1, status);

    clp$put_display (display_control, ' END CYLINDERS', clc$trim, status);
    clp$new_display_line (display_control, 1, status);

  PROCEND display_user_cylinders;
?? TITLE := '  display_user_cylinders_daus', EJECT ??

  PROCEDURE display_user_cylinders_daus
    (    p_dat: ^dmt$ms_device_allocation_table;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    CONST
      columns = 'A123456789B123456789C123456789D123456789E123456789F123456789G123456789H123456789';

    VAR
      char_array: [STATIC] array [dmt$dau_status] of string (1) := [' ', 'h', 's', 'M', 'F', 'm', 'f'],
      device_type: t$device_type,
      step: 0 .. 4,
      line: string (80),
      l: integer,
      dau_index: dmt$dau_address,
      cylinder_dau_address: dmt$dau_address,
      cylinder_index: dmt$device_position;

    status.normal := TRUE;

    determine_device_type (p_dat, device_type, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    line (1, * ) := ' CYLINDERS: ';
    line (13, * ) := device_type_string [device_type];
    IF (device_type = c$844) OR (device_type = c$885) THEN
      line (25, * ) := ' in 16K allocation units.';
      step := 4;
    ELSE
      line (25, * ) := ' in 16K device allocation units.';
      step := 1;
    IFEND;
    clp$put_display (display_control, line, clc$trim, status);

    line (1, *) := ' KEY:  F = assigned to file  M = assigned to mainframe  <blank> = usable';
    clp$put_display (display_control, line, clc$trim, status);
    line (1, *) := '       s = software flawed   h = hardware flawed  f = assigned to file flawed';
    clp$put_display (display_control, line, clc$trim, status);
    line (1, *) := '       m = assigned to mainframe software flawed';
    clp$put_display (display_control, line, clc$trim, status);
    line (1, *) := ' NOTE: cannot distinguish between assigned to mainframe and';
    clp$put_display (display_control, line, clc$trim, status);
    line (1, *) := '       assigned to temporary file.';
    clp$put_display (display_control, line, clc$trim, status);

    clp$new_display_line (display_control, 1, status);
    clp$put_display (display_control, columns, clc$trim, status);

  /display_cylinders/
    FOR cylinder_index := 0 TO p_dat^.header.positions_per_device - 1 DO
      dau_index := 0;
      line (1, * ) := ' ';

      IF (cylinder_index MOD 25) = 0 THEN
        STRINGREP (line, l, ' next cylinder is number ', cylinder_index);
        clp$put_display (display_control, line, clc$trim,status);
        line (1, *) := ' ';
      IFEND;

      cylinder_dau_address := cylinder_index * p_dat^.header.daus_per_position;

      WHILE dau_index < p_dat^.header.daus_per_position DO
        IF (dau_index MOD step) = 0 THEN
          line ((dau_index DIV step) + 1, 1) :=
            char_array [p_dat^.body [cylinder_dau_address + dau_index].dau_status];
        IFEND;
        dau_index := dau_index + 1;
      WHILEND;

      clp$put_display (display_control, line, clc$trim, status);

    FOREND /display_cylinders/;

    clp$new_display_line (display_control, 1, status);

    clp$put_display (display_control, ' END CYLINDERS', clc$trim, status);
    clp$new_display_line (display_control, 1, status);

  PROCEND display_user_cylinders_daus;
?? TITLE := '  display_user_dat', EJECT ??

  PROCEDURE display_user_dat
    (    p_dat: ^dmt$ms_device_allocation_table;
         path: string (*);
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      p_dat_entry: ^dmt$ms_device_allocation_unit,
      previous_status: dmt$dau_status,
      previous_count: integer,
      integer_string: string (osc$max_string_size),
      integer_length: integer,
      duplicate_entry_string: string (32),
      dat_index: dmt$dau_address,
      title_string: string (80),
      mainframe_id: dmt$mainframe_assigned;

    status.normal := TRUE;

  /display_dat/
    BEGIN

      title_string (1, * ) := 'DEVICE ALLOCATION TABLE : ';
      title_string (27, *) := path;

      clp$put_display (display_control, title_string, clc$trim, status);

      display_dat_header (display_control, p_dat^.header, status);
      IF NOT status.normal THEN
        EXIT /display_dat/;
      IFEND;

      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        EXIT /display_dat/;
      IFEND;

      clp$put_display (display_control, 'Device Allocation Table', clc$trim, status);

      IF p_dat^.body [0].dau_status = dmc$dau_usable THEN
        previous_status := dmc$dau_hardware_flawed;
      ELSE
        previous_status := dmc$dau_usable;
      IFEND;
      previous_count := 0;
      duplicate_entry_string := '              Duplicate Entry(s)';

    /display_dat_entries/
      FOR dat_index := 0 TO p_dat^.header.number_of_entries - 1 DO

        p_dat_entry := ^p_dat^.body [dat_index];

        CASE p_dat_entry^.dau_status OF
        = dmc$dau_usable =
          IF previous_status = dmc$dau_usable THEN
            previous_count := previous_count + 1;
            CYCLE /display_dat_entries/;
          IFEND;

          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_usable;
          previous_count := 0;
        = dmc$dau_hardware_flawed =
          IF previous_status = dmc$dau_hardware_flawed THEN
            previous_count := previous_count + 1;
            CYCLE /display_dat_entries/;
          IFEND;

          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_hardware_flawed;
          previous_count := 0;
        = dmc$dau_software_flawed =
          IF previous_status = dmc$dau_software_flawed THEN
            previous_count := previous_count + 1;
            CYCLE /display_dat_entries/;
          IFEND;

          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_software_flawed;
          previous_count := 0;
        = dmc$dau_assigned_to_mainframe =
          IF previous_status = dmc$dau_assigned_to_mainframe THEN
            IF mainframe_id = p_dat_entry^.mainframe_id THEN
              previous_count := previous_count + 1;
              CYCLE /display_dat_entries/;
            IFEND;
          IFEND;

          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_assigned_to_mainframe;
          previous_count := 0;
          mainframe_id := p_dat_entry^.mainframe_id;
        = dmc$dau_assigned_to_file =
          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_assigned_to_file;
          previous_count := 0;
        = dmc$dau_ass_to_mf_swr_flawed =
          IF previous_status = dmc$dau_ass_to_mf_swr_flawed THEN
            IF mainframe_id = p_dat_entry^.mainframe_id THEN
              previous_count := previous_count + 1;
              CYCLE /display_dat_entries/;
            IFEND;
          IFEND;

          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_ass_to_mf_swr_flawed;
          previous_count := 0;
          mainframe_id := p_dat_entry^.mainframe_id;
        = dmc$dau_ass_to_file_swr_flawed =
          IF previous_count <> 0 THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
          IFEND;

          previous_status := dmc$dau_ass_to_file_swr_flawed;
          previous_count := 0;

        CASEND;

        display_dat_entry (display_control, dat_index, p_dat_entry, status);
        IF NOT status.normal THEN
          EXIT /display_dat/;
        IFEND;
      FOREND /display_dat_entries/;

      IF previous_count <> 0 THEN
        STRINGREP (integer_string, integer_length, previous_count);
        duplicate_entry_string (8, 6) := '      ';
        duplicate_entry_string (8, integer_length) := integer_string;

        clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
        IF NOT status.normal THEN
          EXIT /display_dat/;
        IFEND;
      IFEND;

    END /display_dat/;

  PROCEND display_user_dat;
?? TITLE := '  display_user_dat_entry', EJECT ??

  PROCEDURE display_user_dat_entry
    (    p_dat: ^dmt$ms_device_allocation_table;
         dau_index: dmt$dau_address;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    status.normal := TRUE;

    IF (dau_index < 0) OR (dau_index >= p_dat^.header.number_of_entries) THEN
      osp$set_status_abnormal ('DM', 1, ' dau index out of range for device', status);
    ELSE
      display_dat_entry (display_control, dau_index, ^p_dat^.body[dau_index], status);
    IFEND;

  PROCEND display_user_dat_entry;
?? TITLE := '  display_user_dat_header', EJECT ??

  PROCEDURE display_user_dat_header
    (    p_dat: ^dmt$ms_device_allocation_table;
         path: string ( * );
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      title_string: string (132);

    status.normal := TRUE;

    title_string (1, * ) := 'DEVICE ALLOCATION TABLE : ';
    title_string (27, * ) := path;
    clp$put_display (display_control, title_string, clc$trim, status);

    display_dat_header (display_control, p_dat^.header, status);

  PROCEND display_user_dat_header;
?? TITLE := ' display_user_device_type', EJECT ??

  PROCEDURE display_user_device_type
    (    p_dat: ^dmt$ms_device_allocation_table;
         path: string ( * );
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      str: string (80),
      l: integer,
      device_type: t$device_type;

    status.normal := TRUE;

    clp$put_display (display_control, path, clc$trim, status);

    determine_device_type (p_dat, device_type, status);

    IF status.normal THEN
      STRINGREP (str, l, ' Device type is ', device_type_string [device_type]);
      clp$put_display (display_control, str (1, l), clc$trim, status);
    ELSE
      clp$put_display (display_control, ' Device type is unknown ...', clc$trim, status);
    IFEND;

  PROCEND display_user_device_type;
?? TITLE := '  display_user_dfl', EJECT ??

  PROCEDURE display_user_dfl
    (    p_dfl: ^dmt$ms_device_file_list_table;
         path: string (*);
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
         summary_listing: boolean,
         full_listing: boolean,
         file_index: dmt$device_file_list_index,
      p_dfl_entry: ^dmt$ms_device_file_list_entry,
      previous_status: dmt$dfl_entry_flags,
      previous_count: integer,
      integer_string: string (osc$max_string_size),
      type_index: gft$file_kind,
      flag_index: dmt$dfl_entry_flags,
      integer_length: integer,
      duplicate_entry_string: string (32),
      summary_string: string (80),
      dfl_index: dmt$device_file_list_index,
      file_type_count: array [gft$file_kind] of integer,
      file_flag_count: array [dmt$dfl_entry_flags] of integer,
      mainframe_assigned: dmt$mainframe_assigned;

    status.normal := TRUE;
    full_listing := true;
    summary_listing := true;

  /display_device_file/
    BEGIN

      clp$new_display_page (display_control, status);
      summary_string (1, *) := 'DEVICE FILE LIST : ';
      summary_string (20, *) := path;
      clp$put_display (display_control, summary_string, clc$trim, status);

      display_dfl_header (display_control, ^p_dfl^.header, status);
      IF NOT status.normal THEN
        EXIT /display_device_file/;
      IFEND;

      IF p_dfl^.entries [1].flags = dmc$dfle_available THEN
        previous_status := dmc$dfle_assigned_to_mainframe;
      ELSE
        previous_status := dmc$dfle_available
      IFEND;
      previous_count := 0;
      duplicate_entry_string := '              Duplicate Entry(s)';

      FOR type_index := LOWERVALUE (gft$file_kind) TO UPPERVALUE (gft$file_kind) DO
        file_type_count [type_index] := 0;
      FOREND;

      FOR flag_index := LOWERVALUE (dmt$dfl_entry_flags) TO UPPERVALUE (dmt$dfl_entry_flags) DO
        file_flag_count [flag_index] := 0;
      FOREND;

    /display_dfl_entries/
      FOR dfl_index := 1 TO p_dfl^.header.number_of_entries DO

        p_dfl_entry := ^p_dfl^.entries [dfl_index];
        file_flag_count [p_dfl_entry^.flags] := file_flag_count [p_dfl_entry^.flags] + 1;

        CASE p_dfl_entry^.flags OF

        = dmc$dfle_available =

          IF previous_status = dmc$dfle_available THEN
            previous_count := previous_count + 1;
            IF (NOT full_listing) AND (file_index = dfl_index) THEN
              display_dfl_entry (display_control, dfl_index, p_dfl_entry, status);
              CYCLE /display_dfl_entries/;
            ELSE
              CYCLE /display_dfl_entries/;
            IFEND;
          IFEND;

          IF (previous_count <> 0) AND (full_listing) THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
            clp$new_display_line (display_control, 1, status);
          IFEND;

          previous_status := dmc$dfle_available;
          previous_count := 0;

        = dmc$dfle_assigned_to_mainframe =

          IF previous_status = dmc$dfle_assigned_to_mainframe THEN
            IF mainframe_assigned = p_dfl_entry^.mainframe_assigned THEN
              previous_count := previous_count + 1;
              IF (NOT full_listing) AND (file_index = dfl_index) THEN
                display_dfl_entry (display_control, dfl_index, p_dfl_entry, status);
                CYCLE /display_dfl_entries/;
              ELSE
                CYCLE /display_dfl_entries/;
              IFEND;
            IFEND;
          IFEND;

          IF (previous_count <> 0) AND (full_listing) THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
            clp$new_display_line (display_control, 1, status);
          IFEND;

          previous_status := dmc$dfle_assigned_to_mainframe;
          previous_count := 0;

          mainframe_assigned := p_dfl_entry^.mainframe_assigned;

        = dmc$dfle_assigned_to_file =

          IF (previous_count <> 0) AND (full_listing) THEN
            STRINGREP (integer_string, integer_length, previous_count);
            duplicate_entry_string (8, 6) := '      ';
            duplicate_entry_string (8, integer_length) := integer_string;

            clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
            clp$new_display_line (display_control, 1, status);
          IFEND;

          file_type_count [p_dfl_entry^.file_kind] := file_type_count [p_dfl_entry^.file_kind] + 1;
          previous_status := dmc$dfle_assigned_to_file;
          previous_count := 0;
        ELSE;
        CASEND;

        IF (NOT full_listing) AND (file_index = dfl_index) THEN
          display_dfl_entry (display_control, dfl_index, p_dfl_entry, status);
          IF NOT status.normal THEN
            EXIT /display_device_file/;
          IFEND;
        ELSEIF (full_listing) THEN
          display_dfl_entry (display_control, dfl_index, p_dfl_entry, status);
          IF NOT status.normal THEN
            EXIT /display_device_file/;
          IFEND;
        IFEND;

      FOREND /display_dfl_entries/;

      IF (previous_count <> 0) AND (full_listing) THEN
        STRINGREP (integer_string, integer_length, previous_count);
        duplicate_entry_string (8, 6) := '      ';
        duplicate_entry_string (8, integer_length) := integer_string;

        clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
      IFEND;

      IF summary_listing THEN

        clp$new_display_line (display_control, 1, status);
        clp$put_display (display_control, ' Summary:', clc$trim, status);
        clp$new_display_line (display_control, 1, status);

      /file_flag_summary/
        FOR flag_index := LOWERVALUE (dmt$dfl_entry_flags) TO UPPERVALUE (dmt$dfl_entry_flags) DO
          CASE flag_index OF
          = dmc$dfle_available =
            summary_string := '  Number of available entries             -       ';

          = dmc$dfle_assigned_to_mainframe =
            summary_string := '  Number of assigned to mainframe entries -       ';

          = dmc$dfle_assigned_to_file =
            summary_string := '  Number of assigned to file entries      -       ';
          ELSE;
          CASEND;

          STRINGREP (integer_string, integer_length, file_flag_count [flag_index]);
          summary_string (44, integer_length) := integer_string;
          clp$put_display (display_control, summary_string, clc$trim, status);
        FOREND /file_flag_summary/;

        summary_string := '     File Type -                   Number of Entries -             ';

      /assigned_file_summary/
        FOR type_index := LOWERVALUE (gft$file_kind) TO UPPERVALUE (gft$file_kind) DO
          summary_string (55, * ) := ' ';
          CASE type_index OF
          = gfc$fk_job_permanent_file =
            summary_string (18, 12) := 'Permanent   ';
          = gfc$fk_device_file =
            summary_string (18, 12) := 'Device      ';
          = gfc$fk_job_local_file =
            summary_string (18, 12) := 'Temp Named  ';
          = gfc$fk_unnamed_file =
            summary_string (18, 12) := 'Temp Unnamed';
          = gfc$fk_global_unnamed =
            summary_string (18, 12) := 'Temp Global ';
          = gfc$fk_catalog =
            summary_string (18, 12) := 'Catalog     ';
          ELSE;
          CASEND;

          STRINGREP (integer_string, integer_length, file_type_count [type_index]);
          summary_string (55, integer_length) := integer_string;
          clp$put_display (display_control, summary_string, clc$trim, status);
        FOREND /assigned_file_summary/;
      IFEND;

    END /display_device_file/;

  PROCEND display_user_dfl;
?? TITLE := ' display_user_dfl_entry', EJECT ??

  PROCEDURE display_user_dfl_entry
    (    p_dfl: ^dmt$ms_device_file_list_table;
         dfl_index: dmt$device_file_list_index;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    status.normal := TRUE;

    IF (dfl_index < 1) OR (dfl_index > p_dfl^.header.number_of_entries) THEN
      osp$set_status_abnormal ('DM', 1,
            ' dfl index out of range for device type', status);
    ELSE
      display_dfl_entry (display_control, dfl_index, ^p_dfl^.
            entries [dfl_index], status);
    IFEND;

  PROCEND display_user_dfl_entry;
?? TITLE := ' display_user_dir_entry', EJECT ??

  PROCEDURE display_user_dir_entry
    (    p_directory: ^dmt$ms_volume_directory;
         entry_index: dmt$directory_index;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    status.normal := TRUE;
    IF (entry_index < 1) OR (entry_index > p_directory^.header.number_of_entries) THEN
      osp$set_status_abnormal ('DM', 1, ' entry index out of range for device', status);
    ELSE
      display_directory_entry (display_control, p_directory^.entries [entry_index], status);
    IFEND;

  PROCEND display_user_dir_entry;
?? TITLE := '  display_user_directory', EJECT ??

  PROCEDURE display_user_directory
    (    p_directory: ^dmt$ms_volume_directory;
         path: string ( * );

     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      dir_entry: dmt$ms_volume_directory_entry,
      integer_string: ost$string,
      title_string: string (80),
      previous_count: integer,
      integer_length: integer,
      duplicate_entry_string: string (32),
      previous_status: boolean,
      directory_index: dmt$directory_index;

    status.normal := TRUE;

  /display_directory/
    BEGIN

      title_string (1, * ) := 'DIRECTORY : ';
      title_string (13, * ) := path;

      clp$put_display (display_control, title_string, clc$trim, status);

      clp$put_partial_display (display_control, '  Number Of Entries - ', clc$no_trim, amc$start, status);
      clp$convert_integer_to_string (p_directory^.header.number_of_entries, 10, FALSE, integer_string,
            status);
      clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
            amc$terminate, status);

      previous_count := 0;
      previous_status := FALSE;
      duplicate_entry_string := '             Duplicate Entrie(s)';

    /display_directory_entries/
      FOR directory_index := 1 TO p_directory^.header.number_of_entries DO

        dir_entry := p_directory^.entries [directory_index];

        IF dir_entry.entry_available THEN
          IF previous_status = TRUE THEN
            ;
            previous_count := previous_count + 1;
            CYCLE /display_directory_entries/;
          IFEND;
          previous_status := TRUE;
        IFEND;

        IF previous_count <> 0 THEN
          STRINGREP (integer_string.value, integer_length, previous_count);
          duplicate_entry_string (8, 6) := '      ';
          duplicate_entry_string (8, integer_length) := integer_string.value;

          clp$new_display_line (display_control, 1, status);
          clp$put_display (display_control, duplicate_entry_string, clc$trim, status);

          previous_count := 0;
          previous_status := FALSE;
        IFEND;

        clp$convert_integer_to_string (directory_index, 10, FALSE, integer_string, status);
        clp$new_display_line (display_control, 1, status);
        clp$put_partial_display (display_control, integer_string.value (1, integer_string.size), clc$trim,
              amc$start, status);
        clp$put_partial_display (display_control, '. Directory Entry', clc$trim, amc$terminate, status);

        display_directory_entry (display_control, dir_entry, status);
        IF NOT status.normal THEN
          EXIT /display_directory_entries/;
        IFEND;
      FOREND /display_directory_entries/;

      IF previous_count <> 0 THEN
        STRINGREP (integer_string.value, integer_length, previous_count);
        duplicate_entry_string (8, 6) := '      ';
        duplicate_entry_string (8, integer_length) := integer_string.value;

        clp$new_display_line (display_control, 1, status);
        clp$put_display (display_control, duplicate_entry_string, clc$trim, status);
      IFEND;
    END /display_directory/;

  PROCEND display_user_directory;
?? TITLE := '  get_device_characteristics', EJECT ??

  PROCEDURE get_device_characteristics
    (    device_type: t$device_type;
     VAR device_characteristics: t$physical_characteristics;
     VAR status: ost$status);

    status.normal := TRUE;

    IF (device_type < LOWERVALUE (t$device_type)) OR (device_type > UPPERVALUE (t$device_type)) THEN
      osp$set_status_abnormal ('DM', 1, ' unknown device type - get_device_characteristics', status);
    ELSE
      device_characteristics := physical_characteristics [device_type];
    IFEND;

  PROCEND get_device_characteristics;
?? TITLE := '  open', EJECT ??

  PROCEDURE open
    (    file: clt$value;
     VAR file_id: amt$file_identifier;
     VAR segp: amt$segment_pointer;
     VAR status: ost$status);

    VAR
      ao: [STATIC] array [1 .. 2] of fst$attachment_option := [[fsc$create_file, FALSE],
            [fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read]],
            [fsc$specific_share_modes, [fsc$read, fsc$execute]]]],
      ignore: ost$status;

    status.normal := TRUE;

    fsp$open_file (file.file.local_file_name, amc$segment, ^ao, NIL, NIL, NIL, NIL, file_id, status);
    IF status.normal THEN
      amp$get_segment_pointer (file_id, amc$sequence_pointer, segp, status);
      IF NOT status.normal THEN
        fsp$close_file (file_id, ignore);
      IFEND;
    IFEND;

  PROCEND open;
?? TITLE := '  open_file_as_dat', EJECT ??

  PROCEDURE open_file_as_dat
    (    file: clt$value;
     VAR status: ost$status);

    VAR
      container: clt$path_container,
      path: ^pft$path,
      selector: clt$cycle_selector,
      op: clt$open_position,
      segp: amt$segment_pointer,
      p_seq: ^SEQ ( * ),
      p_dat_header: ^dmt$ms_device_alloc_table_head,
      entries: dmt$dau_address;

    status.normal := TRUE;

    open (file, global_dat_file_id, segp, status);
    IF status.normal THEN
      p_seq := segp.sequence_pointer;
      RESET p_seq;
      NEXT p_dat_header IN p_seq;
      IF p_dat_header <> NIL THEN
        entries := p_dat_header^.number_of_entries;
        RESET p_seq;
        NEXT global_p_dat: [0 .. entries - 1] IN p_seq;
      IFEND;
      clp$get_path_description (file.file, global_dat_path, container, path, selector, op, status);
    IFEND;

  PROCEND open_file_as_dat;
?? TITLE := '  open_file_as_dfl', EJECT ??

  PROCEDURE open_file_as_dfl
    (    file: clt$value;
     VAR status: ost$status);

    VAR
      container: clt$path_container,
      path: ^pft$path,
      selector: clt$cycle_selector,
      op: clt$open_position,
      segp: amt$segment_pointer,
      p_seq: ^SEQ ( * ),
      p_dfl_header: ^dmt$ms_device_file_list_header,
      entries: dmt$device_file_list_index;

    status.normal := TRUE;

    open (file, global_dfl_file_id, segp, status);
    IF status.normal THEN
      p_seq := segp.sequence_pointer;
      RESET p_seq;
      NEXT p_dfl_header IN p_seq;
      IF p_dfl_header <> NIL THEN
        entries := p_dfl_header^.number_of_entries;
        RESET p_seq;
        NEXT global_p_dfl: [1 .. entries] IN p_seq;
      IFEND;
      clp$get_path_description (file.file, global_dfl_path, container, path, selector, op, status);
    IFEND;

  PROCEND open_file_as_dfl;
?? TITLE := '  open_file_as_directory', EJECT ??

  PROCEDURE open_file_as_directory
    (    file: clt$value;
     VAR status: ost$status);

    VAR
      container: clt$path_container,
      path: ^pft$path,
      selector: clt$cycle_selector,
      op: clt$open_position,
      segp: amt$segment_pointer,
      p_seq: ^SEQ ( * ),
      p_directory_header: ^dmt$ms_volume_directory_head,
      entries: dmt$directory_index;

    status.normal := TRUE;

    open (file, global_directory_file_id, segp, status);
    IF status.normal THEN
      p_seq := segp.sequence_pointer;
      RESET p_seq;
      NEXT p_directory_header IN p_seq;
      IF p_directory_header <> NIL THEN
        entries := p_directory_header^.number_of_entries;
        RESET p_seq;
        NEXT global_p_directory: [1 .. entries] IN p_seq;
      IFEND;
      clp$get_path_description (file.file, global_directory_path, container, path, selector, op, status);
    IFEND;

  PROCEND open_file_as_directory;
?? TITLE := '  quit_command', EJECT ??

  PROCEDURE quit_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, status_pdt, status);

    clp$end_scan_command_file (utility_name, status);

  PROCEND quit_command;
?? TITLE := '  sum_allocated_space_command', EJECT ??

  PROCEDURE sum_allocated_space_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PDT status_pdt (status)

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

  VAR
    status_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^status_pdt_names,
  ^status_pdt_params];

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

  VAR
    status_pdt_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]]];

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

    VAR
      status2: ost$status;

    status2.normal := TRUE;
    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, status_pdt, status);
    IF status.normal THEN
      clp$new_display_page (display_control, status);
      clp$put_display (display_control, 'SUM_ALLOCATED_SPACE', clc$trim, status);
      clp$new_display_line (display_control, 1, status);
      IF global_p_dfl = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dfl not open - info unavailable', status);
      ELSE
        sum_dfl_space (global_p_dfl, display_control, status);
      IFEND;
      status2 := status;
      clp$new_display_line (display_control, 1, status);
      IF global_p_dat = NIL THEN
        osp$set_status_abnormal ('DM', 1, ' dat not open - info unavailable', status);
      ELSE
        sum_dat_space (global_p_dat, display_control, status);
      IFEND;
    IFEND;
    IF status.normal AND (NOT status2.normal) THEN
      status := status2;
    IFEND;

  PROCEND sum_allocated_space_command;
?? TITLE := '  sum_dat_space', EJECT ??

  PROCEDURE sum_dat_space
    (    p_dat: ^dmt$ms_device_allocation_table;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      p_dat_entry: ^dmt$ms_device_allocation_unit,
      str: string (80),
      l: integer,
      device_type: t$device_type,
      total_bytes: integer,
      total_daus: integer,
      num_usable: integer,
      num_hardware_flawed: integer,
      num_software_flawed: integer,
      num_assigned_to_mainframe: integer,
      num_assigned_to_file: integer,
      num_ass_to_mf_swr_flawed: integer,
      num_ass_to_file_swr_flawed: integer,
      bytes_usable: integer,
      bytes_hardware_flawed: integer,
      bytes_software_flawed: integer,
      bytes_assigned_to_mainframe: integer,
      bytes_assigned_to_file: integer,
      bytes_ass_to_mf_swr_flawed: integer,
      bytes_ass_to_file_swr_flawed: integer,
      bytes_per_dau: dmt$dau_address,
      dat_index: dmt$dau_address;

    status.normal := TRUE;
    bytes_per_dau := p_dat^.header.bytes_per_dau;
    num_usable := 0;
    num_hardware_flawed := 0;
    num_software_flawed := 0;
    num_assigned_to_mainframe := 0;
    num_assigned_to_file := 0;
    num_ass_to_mf_swr_flawed := 0;
    num_ass_to_file_swr_flawed := 0;
    bytes_usable := 0;
    bytes_hardware_flawed := 0;
    bytes_software_flawed := 0;
    bytes_assigned_to_mainframe := 0;
    bytes_assigned_to_file := 0;
    bytes_ass_to_mf_swr_flawed := 0;
    bytes_ass_to_file_swr_flawed := 0;

    determine_device_type (p_dat, device_type, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    str (1, * ) := ' From device allocation table:';
    clp$put_display (display_control, str, clc$trim, status);

    FOR dat_index := 0 TO p_dat^.header.number_of_entries - 1 DO
      p_dat_entry := ^p_dat^.body [dat_index];
      CASE p_dat_entry^.dau_status OF
      = dmc$dau_usable =
        num_usable := num_usable + 1;
        bytes_usable := bytes_usable + bytes_per_dau;
      = dmc$dau_hardware_flawed =
        num_hardware_flawed := num_hardware_flawed + 1;
        bytes_hardware_flawed := bytes_hardware_flawed + bytes_per_dau;
      = dmc$dau_software_flawed =
        num_software_flawed := num_software_flawed + 1;
        bytes_software_flawed := bytes_software_flawed + bytes_per_dau;
      = dmc$dau_assigned_to_mainframe =
        num_assigned_to_mainframe := num_assigned_to_mainframe + 1;
        bytes_assigned_to_mainframe := bytes_assigned_to_mainframe + bytes_per_dau;
      = dmc$dau_assigned_to_file =
        num_assigned_to_file := num_assigned_to_file + 1;
        bytes_assigned_to_file := bytes_assigned_to_file + bytes_per_dau;
      = dmc$dau_ass_to_mf_swr_flawed =
        num_ass_to_mf_swr_flawed := num_ass_to_mf_swr_flawed + 1;
        bytes_ass_to_mf_swr_flawed := bytes_ass_to_mf_swr_flawed + bytes_per_dau;
      = dmc$dau_ass_to_file_swr_flawed =
        num_ass_to_file_swr_flawed := num_ass_to_file_swr_flawed + 1;
        bytes_ass_to_file_swr_flawed := bytes_ass_to_file_swr_flawed + bytes_per_dau;
      ELSE
      CASEND;
    FOREND;
    total_bytes := bytes_assigned_to_file + bytes_usable + bytes_hardware_flawed + bytes_software_flawed +
                   bytes_assigned_to_mainframe + bytes_ass_to_file_swr_flawed + bytes_ass_to_mf_swr_flawed;
    total_daus  := num_assigned_to_file + num_usable + num_hardware_flawed + num_software_flawed +
                   num_assigned_to_mainframe + num_ass_to_file_swr_flawed + num_ass_to_mf_swr_flawed;
    clp$put_display (display_control, '     # daus      bytes         assigned to', clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_assigned_to_file);
    stringrep (str (17, *), l, bytes_assigned_to_file);
    str (32, *) := 'file';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_ass_to_file_swr_flawed);
    stringrep (str (17, *), l, bytes_ass_to_file_swr_flawed);
    str (32, *) := 'file (flawed)';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_assigned_to_mainframe);
    stringrep (str (17, *), l, bytes_assigned_to_mainframe);
    str (32, *) := 'mainframe table (MAT) or temp files';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_ass_to_mf_swr_flawed);
    stringrep (str (17, *), l, bytes_ass_to_mf_swr_flawed);
    str (32, *) := 'mainframe table (MAT) or temp files (flawed)';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_software_flawed);
    stringrep (str (17, *), l, bytes_software_flawed);
    str (32, *) := 'software flawed';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_hardware_flawed);
    stringrep (str (17, *), l, bytes_hardware_flawed);
    str (32, *) := 'hardware flawed';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, num_usable);
    stringrep (str (17, *), l, bytes_usable);
    str (32, *) := 'usable';
    clp$put_display (display_control, str, clc$trim, status);
    clp$put_display (display_control, '    ----------  ------------', clc$trim, status);
    str (1, *) := ' ';
    stringrep (str (5, *), l, total_daus);
    stringrep (str (17, *), l, total_bytes);
    clp$put_display (display_control, str, clc$trim, status);

  PROCEND sum_dat_space;
?? TITLE := '  sum_dfl_space', EJECT ??

  PROCEDURE sum_dfl_space
    (    p_dfl: ^dmt$ms_device_file_list_table;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      p_dfl_entry: ^dmt$ms_device_file_list_entry,
      l: integer,
      str: string (80),
      total_files: integer,
      total_bytes: integer,
      num_perm: integer,
      bytes_perm: integer,
      num_catalog: integer,
      bytes_catalog: integer,
      num_device: integer,
      bytes_device: integer,
      dfl_index: dmt$device_file_list_index;

    status.normal := TRUE;
    num_perm := 0;
    bytes_perm := 0;
    num_catalog := 0;
    bytes_catalog := 0;
    num_device := 0;
    bytes_device := 0;

    clp$put_display (display_control, ' From device file list:', clc$trim, status);

    FOR dfl_index := 1 TO p_dfl^.header.number_of_entries DO
      p_dfl_entry := ^p_dfl^.entries [dfl_index];
      CASE p_dfl_entry^.flags OF
      = dmc$dfle_available =
      = dmc$dfle_assigned_to_mainframe =
      = dmc$dfle_assigned_to_file =
        CASE p_dfl_entry^.file_kind OF
        = gfc$fk_job_permanent_file =
          num_perm := num_perm + 1;
          bytes_perm := bytes_perm + p_dfl_entry^.fmd_length;
        = gfc$fk_catalog =
          num_catalog := num_catalog + 1;
          bytes_catalog := bytes_catalog + p_dfl_entry^.fmd_length;
        = gfc$fk_device_file =
          num_device := num_device + 1;
          bytes_device := bytes_device + p_dfl_entry^.fmd_length;
        = gfc$fk_global_unnamed =
        = gfc$fk_job_local_file =
        = gfc$fk_unnamed_file =
        ELSE
        CASEND;
      ELSE;
      CASEND;
    FOREND;

    total_files := num_device + num_catalog + num_perm;
    total_bytes := bytes_device + bytes_catalog + bytes_perm;

    clp$put_display (display_control, '     # files   bytes         file type', clc$trim, status);
    str (1, *) := ' ';
    stringrep (str(5, *), l, num_device);
    stringrep (str(15, *), l, bytes_device);
    str (30, *) := 'device';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str(5, *), l, num_catalog);
    stringrep (str(15, *), l, bytes_catalog);
    str (30, *) := 'catalog';
    clp$put_display (display_control, str, clc$trim, status);
    str (1, *) := ' ';
    stringrep (str(5, *), l, num_perm);
    stringrep (str(15, *), l, bytes_perm);
    str (30, *) := 'permanent';
    clp$put_display (display_control, str, clc$trim, status);

    clp$put_display (display_control, '    -----     ------------', clc$trim, status);
    str (1, *) := ' ';
    stringrep (str(5, *), l, total_files);
    stringrep (str(15, *), l, total_bytes);
    clp$put_display (display_control, str, clc$trim, status);

  PROCEND sum_dfl_space;
MODEND dmm$analyze_device_file;
