?? RIGHT := 110 ??
?? NEWTITLE := '  NOS/VE Display Volume Classification.' ??
MODULE ram$display_vol_classification;

{ PURPOSE:
{   This module contains the command processor for displaying a volume's
{   classification.

?? NEWTITLE := 'Global Declarations Referenced by This Module.', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$label_validation_errors
*copyc fst$tape_label_block_descriptor
*copyc fst$tape_label_sequence_header
?? POP ??
*copyc clp$convert_string_to_file
*copyc clp$close_display
*copyc clp$evaluate_file_reference
*copyc clp$evaluate_parameters
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$put_display
*copyc clp$reset_for_next_display_page
*copyc fsp$get_tape_label_attributes
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc rmp$disvc_r3_helper
*copyc rmp$format_vol_classification

*copyc amv$nil_file_identifier
*copyc clv$nil_display_control

?? NEWTITLE := 'rap$display_vol_classification', EJECT ??

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

{ PROCEDURE (ram$disvc) display_volume_classification, disvc (
{   file, f: file = $required
{   output, o: file = $output
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 6, 28, 1, 31, 24, 416],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'RAM$DISVC'], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

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

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

?? NEWTITLE := '  abort_handler', EJECT ??

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

      VAR
        ignore_status: ost$status;

      IF file_id <> amv$nil_file_identifier THEN
        fsp$close_file (file_id, ignore_status);
      IFEND;

      IF display_control.file_id <> amv$nil_file_identifier THEN
        clp$close_display (display_control, ignore_status);
      IFEND;

    PROCEND abort_handler;
?? OLDTITLE ??
?? NEWTITLE := '  construct_message_line_array', EJECT ??

    PROCEDURE construct_message_line_array
      (    formatted_message: ost$status_message;
       VAR line_array: array [1 .. * ] of ^string ( * <= osc$status_message_width));

      VAR
        line_count_p: ^ost$status_message_line_count,
        line_number: ost$status_message_line_count,
        line_size_p: ^ost$status_message_line_size,
        message_p: ^ost$status_message;

      message_p := ^formatted_message;
      RESET message_p;

      NEXT line_count_p IN message_p;
      IF line_count_p <> NIL THEN
        FOR line_number := 1 TO line_count_p^ DO
          NEXT line_size_p IN message_p;
          NEXT line_array [line_number]: [line_size_p^] IN message_p;
        FOREND;
      IFEND;

    PROCEND construct_message_line_array;
?? OLDTITLE ??
?? NEWTITLE := '  get_line_count', EJECT ??

    PROCEDURE get_line_count
      (    formatted_message: ost$status_message;
       VAR line_count: ost$status_message_line_count);

      VAR
        line_count_p: ^ost$status_message_line_count,
        message_p: ^ost$status_message;

      message_p := ^formatted_message;
      RESET message_p;

      NEXT line_count_p IN message_p;
      IF line_count_p <> NIL THEN
        line_count := line_count_p^;
      ELSE
        line_count := 0;
      IFEND;
    PROCEND get_line_count;
?? OLDTITLE ??
?? NEWTITLE := '  new_page_procedure', EJECT ??

    PROCEDURE new_page_procedure
      (VAR display_control: clt$display_control;
           new_page_number: integer;
       VAR status: ost$status);

      clp$reset_for_next_display_page (display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$put_display (display_control, 'Display_volume_classification ', clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$new_display_line (display_control, 1, status);

    PROCEND new_page_procedure;
?? OLDTITLE, EJECT ??

    CONST
      aasm = 1,
      adc = 2,
      fsp = 3;

    VAR
      attachment_options: array [aasm .. fsp] of fst$attachment_option,
      display_control: clt$display_control,
      evaluated_file_reference: fst$evaluated_file_reference,
      file_id: amt$file_identifier,
      formatted_classification: ost$status_message,
      formatted_message: ^array [1 .. * ] of ^string ( * <= osc$status_message_width),
      i: ost$status_message_line_count,
      line: ost$status_message_line_count,
      line_count: ost$status_message_line_count,
      local_status: ost$status,
      output_file: clt$file,
      volume_classification: rmt$tape_volume_classification;

    status.normal := TRUE;

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

    attachment_options [aasm].selector := fsc$access_and_share_modes;
    attachment_options [aasm].access_modes.selector := fsc$specific_access_modes;
    attachment_options [aasm].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_options [aasm].share_modes.selector := fsc$determine_from_access_modes;
    attachment_options [adc].selector := fsc$allowed_device_classes;
    attachment_options [adc].allowed_device_classes := $fst$device_classes [fsc$magnetic_tape_device];
    attachment_options [fsp].selector := fsc$tape_attachment;
    attachment_options [fsp].tape_attachment.selector := fsc$tape_file_set_position;
    attachment_options [fsp].tape_attachment.tape_file_set_position.position := fsc$tape_beginning_of_set;

    file_id := amv$nil_file_identifier;
    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    osp$establish_block_exit_hndlr (^abort_handler);

  /classify_volume/
    BEGIN
      clp$evaluate_file_reference (pvt [p$file].value^.file_value^, $clt$file_ref_parsing_options [],
            {resolve_cycle_number} FALSE, evaluated_file_reference, status);

      IF status.normal THEN
        fsp$open_file (pvt [p$file].value^.file_value^, amc$record, ^attachment_options, NIL, NIL, NIL, NIL,
              file_id, local_status);
        IF local_status.normal THEN
          fsp$close_file (file_id, status);
          IF NOT status.normal THEN
            EXIT /classify_volume/;
          IFEND;
        ELSE
          CASE local_status.condition OF
          = ame$excessive_tape_labels, ame$invalid_tape_label, ame$unexpected_tapemark,
            ame$unexpected_tape_label, ame$tape_label_read_error, ame$ansi_file_unexpired, ame$unknown_volume,
            ame$volume_access_restricted, ame$improper_security_change, ame$insufficient_volume_access,
            ame$unlabeled_privilege_needed, ame$rma_privilege_required, ame$label_not_in_sequence,
            ame$blank_volume_read =
            ;
          ELSE
            status := local_status;
            EXIT /classify_volume/;
          CASEND;
        IFEND;

        rmp$disvc_r3_helper (evaluated_file_reference, volume_classification, status);

        IF status.normal THEN
          clp$convert_string_to_file (pvt [p$output].value^.file_value^, output_file, status);
          IF NOT status.normal THEN
            EXIT /classify_volume/;
          IFEND;

          clp$open_display (output_file, ^new_page_procedure, display_control, status);
          IF NOT status.normal THEN
            EXIT /classify_volume/;
          IFEND;

          rmp$format_vol_classification (display_control.page_width, volume_classification,
                formatted_classification, status);

          IF status.normal THEN

            get_line_count (formatted_classification, line_count);

            IF line_count > 0 THEN
              push formatted_message: [1 .. line_count];
              construct_message_line_array (formatted_classification, formatted_message^);

            /non_blank_line/
              FOR i := line_count DOWNTO 1 DO
                IF formatted_message^ [i]^ <> ' ' THEN
                  EXIT /non_blank_line/;
                IFEND;
              FOREND /non_blank_line/;

              FOR line := 1 TO i DO
                clp$put_display (display_control, formatted_message^ [line]^, clc$trim, status);
              FOREND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    END /classify_volume/;

    IF display_control.file_id <> amv$nil_file_identifier THEN
      clp$close_display (display_control, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    IFEND;
    osp$disestablish_cond_handler;

  PROCEND rap$display_vol_classification;
MODEND ram$display_vol_classification;
