?? RIGHT := 110 ??

MODULE fsm$default_tape_label_attrib;

?? PUSH (LISTEXT := ON) ??
*copyc ame$tape_program_actions
*copyc fst$ansi_eof1_label
*copyc fst$ansi_eof2_label
*copyc fst$ansi_hdr1_label
*copyc fst$ansi_hdr2_label
*copyc fst$ansi_vol1_label
*copyc fst$attachment_options
*copyc fst$tape_label_sequence_header
*copyc fst$tape_label_block_descriptor
*copyc fst$tla_default_source
*copyc fst$tla_returned_attributes
*copyc osd$integer_limits
*copyc ost$status
?? POP ??
*copyc bap$set_file_reference_abnormal
*copyc pmp$get_date
*copyc fmv$tape_attachment_information

  VAR
    attributes_without_defaults: [READ, oss$job_paged_literal] fst$tla_returned_attributes :=
          [fsc$tape_file_identifier, fsc$tape_null_attachment_option, fsc$tape_removable_media_group,
          fsc$tape_label_standard_version, fsc$tape_implementation_id, fsc$tape_file_section_number],

    eof1_label_default: [READ, oss$job_paged_literal] fst$ansi_eof1_label := [
      {label_identifier}          'EOF',
      {label_number}              '1',
      {file_identifier}           ' ',
      {file_set_identifier}       ' ',
      {file_section_number}       '0001',
      {file_sequence_number}      '0001',
      {generation_number}         '0001',
      {generation_version_number} '00',
      {creation_date}             ' ',
      {expiration_date}           ' ',
      {accessibility}             ' ',
      {block_count}               '000000',
      {system_code}               ' ',
      {reserved_to_ansi}          ' '],

    eof2_label_default: [READ, oss$job_paged_literal] fst$ansi_eof2_label := [TRUE,
      {label_identifier}          'EOF',
      {label_number}              '2',
      {record_format}             ' ',
      {block_length}              '00000',
      {record_length}             '00000',
      {ve_block_type}             'SS',
      {ve_record_type}            'V',
      {ve_block_length_ext}       '000',
      {ve_record_length_ext}      '000',
      {ve_padding_character}      ' ',
      {ve_character_set}          'A',
      {ve_character_conversion}   'F',
      {ve_reserved}               ' ',
      {buffer_offset_length}      '00',
      {reserved_to_ansi}          ' '],

    hdr1_label_default: [READ, oss$job_paged_literal] fst$ansi_hdr1_label := [
      {label_identifier}          'HDR',
      {label_number}              '1',
      {file_identifier}           ' ',
      {file_set_identifier}       ' ',
      {file_section_number}       '0001',
      {file_sequence_number}      '0001',
      {generation_number}         '0001',
      {generation_version_number} '00',
      {creation_date}             ' ',
      {expiration_date}           ' ',
      {accessibility}             ' ',
      {block_count}               '000000',
      {system_code}               'NOS/VE V2.0',
      {reserved_to_ansi}          ' '],

    hdr2_label_default: [READ, oss$job_paged_literal] fst$ansi_hdr2_label := [TRUE,
      {label_identifier}          'HDR',
      {label_number}              '2',
      {record_format}             ' ',
      {block_length}              '00000',
      {record_length}             '00000',
      {ve_block_type}             'SS',
      {ve_record_type}            'V',
      {ve_block_length_ext}       '000',
      {ve_record_length_ext}      '000',
      {ve_padding_character}      ' ',
      {ve_character_set}          'A',
      {ve_character_conversion}   'F',
      {ve_reserved}               ' ',
      {buffer_offset_length}      '00',
      {reserved_to_ansi}          ' '],

    vol1_label_default: [READ, oss$job_paged_literal] fst$ansi_vol1_label := [
      {label_identifier}          'VOL',
      {label_number}              '1',
      {volume_identifier}         ' ',
      {accessibility}             'A',
      {reserved_to_ansi1}         ' ',
      {implementation_identifier} 'NOS/VE V2.0',
      {owner_identifier}          ' ',
      {reserved_to_ansi2}         ' ',
      {label_standard_version}    '4'];

?? TITLE := 'PROCEDURE fsp$default_tape_label_attrib', EJECT ??
*copy fsh$default_tape_label_attrib

  PROCEDURE [XDCL, #GATE] fsp$default_tape_label_attrib
    (    source: fst$tla_default_source;
     VAR attributes: fst$attachment_options;
     VAR returned_attributes: fst$tla_returned_attributes;
     VAR status: ost$status);

?? NEWTITLE := 'next_block_descriptor', EJECT ??
    PROCEDURE [INLINE] next_block_descriptor
      (    label_kind: fst$ansi_label_kind);

      CONST
        normal_label_size = 80;

      NEXT label_block_descriptor IN label_sequence;
      label_block_descriptor^.label_block_type := fsc$normal_tape_label_block;
      label_block_descriptor^.normal_label_actual_length := normal_label_size;
      label_block_descriptor^.normal_label_character_set := amc$ascii;
      label_block_descriptor^.normal_label_kind := label_kind;
      label_block_descriptor^.normal_label_transfer_length := normal_label_size;

    PROCEND next_block_descriptor;
?? OLDTITLE, EJECT ??

    VAR
      date: ost$date,
      default_attributes: fst$tape_attachment_information,
      eof1_block: ^fst$ansi_eof1_label,
      eof2_block: ^fst$ansi_eof2_label,
      hdr1_block: ^fst$ansi_hdr1_label,
      hdr2_block: ^fst$ansi_hdr2_label,
      header_labels_sequence_size: ost$positive_integers,
      index: ost$positive_integers,
      label_block_descriptor: ^fst$tape_label_block_descriptor,
      label_sequence: ^SEQ ( * ),
      label_sequence_header: ^fst$tape_label_sequence_header,
      return_attribute: boolean,
      trailer_labels_sequence_size: ost$positive_integers,
      vol1_block: ^fst$ansi_vol1_label;

    status.normal := TRUE;

    returned_attributes := $fst$tla_returned_attributes [];

    IF source = fsc$tla_system_default THEN
      default_attributes := fmv$tape_attachment_information;
    ELSE
      RETURN;
    IFEND;

    FOR index := 1 TO UPPERBOUND (attributes) DO
      IF attributes [index].selector = fsc$tape_attachment THEN
        return_attribute := TRUE;
        CASE attributes [index].tape_attachment.selector OF
        = fsc$tape_block_type =
          attributes [index].tape_attachment.tape_block_type := default_attributes.block_type;

        = fsc$tape_buffer_offset =
          attributes [index].tape_attachment.tape_buffer_offset := default_attributes.buffer_offset;

        = fsc$tape_character_conversion =
          attributes [index].tape_attachment.tape_character_conversion :=
                default_attributes.character_conversion;

        = fsc$tape_character_set =
          attributes [index].tape_attachment.tape_character_set := default_attributes.character_set;

        = fsc$tape_creation_date =
          pmp$get_date (osc$ordinal_date, date, status);
          attributes [index].tape_attachment.tape_creation_date := date.ordinal;

        = fsc$tape_expiration_date =
          pmp$get_date (osc$ordinal_date, date, status);
          attributes [index].tape_attachment.tape_expiration_date := date.ordinal;

        = fsc$tape_file_accessibility =
          attributes [index].tape_attachment.tape_file_accessibility := default_attributes.file_accessibility;

        = fsc$tape_file_sequence_number =
          attributes [index].tape_attachment.tape_file_sequence_number :=
                default_attributes.file_sequence_number;

        = fsc$tape_file_set_identifier =
          attributes [index].tape_attachment.tape_file_set_identifier :=
                default_attributes.file_set_identifier;

        = fsc$tape_file_set_position =
          attributes [index].tape_attachment.tape_file_set_position := default_attributes.file_set_position;

        = fsc$tape_generation_number =
          attributes [index].tape_attachment.tape_generation_number := default_attributes.generation_number;

        = fsc$tape_generation_version_num =
          attributes [index].tape_attachment.tape_generation_version_num :=
                default_attributes.generation_version_number;

        = fsc$tape_header_labels =
          IF attributes [index].tape_attachment.tape_header_labels <> NIL THEN
            label_sequence := attributes [index].tape_attachment.tape_header_labels;
            RESET label_sequence;
            header_labels_sequence_size := #SIZE (fst$tape_label_sequence_header) +
                  (4 * #SIZE (fst$tape_label_block_descriptor)) + #SIZE (fst$ansi_vol1_label) +
                  #SIZE (fst$ansi_hdr1_label) + #SIZE (fst$ansi_hdr2_label);
            IF #SIZE (label_sequence^) >= header_labels_sequence_size THEN
              NEXT label_sequence_header IN label_sequence;
              label_sequence_header^.character_set := amc$ascii;
              label_sequence_header^.label_kinds := $fst$ansi_label_kinds [fsc$ansi_vol1_label_kind,
                    fsc$ansi_hdr1_label_kind, fsc$ansi_hdr2_label_kind];
              label_sequence_header^.sequence_size := header_labels_sequence_size;
              label_sequence_header^.label_count := 4;

              next_block_descriptor (fsc$ansi_vol1_label_kind);
              NEXT vol1_block IN label_sequence;
              vol1_block^ := vol1_label_default;

              next_block_descriptor (fsc$ansi_hdr1_label_kind);
              NEXT hdr1_block IN label_sequence;
              hdr1_block^ := hdr1_label_default;
              pmp$get_date (osc$ordinal_date, date, status);
              IF date.ordinal (1, 2) <> '19' THEN
                hdr1_block^.creation_date (1, 1) := date.ordinal (2, 1);
                hdr1_block^.expiration_date (1, 1) := date.ordinal (2, 1);
              IFEND;
              hdr1_block^.creation_date (2, 5) := date.ordinal (3, 5);
              hdr1_block^.expiration_date (2, 5) := date.ordinal (3, 5);

              next_block_descriptor (fsc$ansi_hdr2_label_kind);
              NEXT hdr2_block IN label_sequence;
              hdr2_block^ := hdr2_label_default;

              NEXT label_block_descriptor IN label_sequence;
              label_block_descriptor^.label_block_type := fsc$tapemark_tape_label_block;
            ELSE
              IF #SIZE (label_sequence^) >= #SIZE (fst$tape_label_sequence_header) THEN
                NEXT label_sequence_header IN label_sequence;
                label_sequence_header^.character_set := amc$ascii;
                label_sequence_header^.label_kinds := $fst$ansi_label_kinds [];
                label_sequence_header^.sequence_size := header_labels_sequence_size;
                label_sequence_header^.label_count := 0;
                bap$set_file_reference_abnormal ('DEFAULTS', ame$only_seq_header_returned,
                      'FSP$DEFAULT_TAPE_LABEL_ATTRIB', 'HEADER', status);
              ELSE
                bap$set_file_reference_abnormal ('DEFAULTS', ame$label_sequence_too_small,
                      'FSP$DEFAULT_TAPE_LABEL_ATTRIB', 'HEADER', status);
                return_attribute := FALSE;
              IFEND;
            IFEND;
          ELSE
            return_attribute := FALSE;
          IFEND;

        = fsc$tape_max_block_length =
          attributes [index].tape_attachment.tape_max_block_length := default_attributes.max_block_length;

        = fsc$tape_max_record_length =
          attributes [index].tape_attachment.tape_max_record_length := default_attributes.max_record_length;

        = fsc$tape_owner_identification =
          attributes [index].tape_attachment.tape_owner_identification := default_attributes.owner_identifier;

        = fsc$tape_padding_character =
          attributes [index].tape_attachment.tape_padding_character := default_attributes.padding_character;

        = fsc$tape_record_type =
          attributes [index].tape_attachment.tape_record_type := default_attributes.record_type;

        = fsc$tape_rewrite_labels =
          attributes [index].tape_attachment.tape_rewrite_labels := default_attributes.rewrite_labels;

        = fsc$tape_trailer_labels =
          IF attributes [index].tape_attachment.tape_trailer_labels <> NIL THEN
            label_sequence := attributes [index].tape_attachment.tape_trailer_labels;
            RESET label_sequence;
            trailer_labels_sequence_size := #SIZE (fst$tape_label_sequence_header) +
                  (4 * #SIZE (fst$tape_label_block_descriptor)) + #SIZE (fst$ansi_eof1_label) +
                  #SIZE (fst$ansi_eof2_label);
            IF #SIZE (label_sequence^) >= trailer_labels_sequence_size THEN
              NEXT label_sequence_header IN label_sequence;
              label_sequence_header^.character_set := amc$ascii;
              label_sequence_header^.label_kinds := $fst$ansi_label_kinds [fsc$ansi_eof1_label_kind,
                    fsc$ansi_eof2_label_kind];
              label_sequence_header^.sequence_size := trailer_labels_sequence_size;
              label_sequence_header^.label_count := 4;

              NEXT label_block_descriptor IN label_sequence;
              label_block_descriptor^.label_block_type := fsc$tapemark_tape_label_block;

              next_block_descriptor (fsc$ansi_eof1_label_kind);
              NEXT eof1_block IN label_sequence;
              eof1_block^ := eof1_label_default;
              pmp$get_date (osc$ordinal_date, date, status);
              IF date.ordinal (1, 2) <> '19' THEN
                eof1_block^.creation_date (1, 1) := date.ordinal (2, 1);
                eof1_block^.expiration_date (1, 1) := date.ordinal (2, 1);
              IFEND;
              eof1_block^.creation_date (2, 5) := date.ordinal (3, 5);
              eof1_block^.expiration_date (2, 5) := date.ordinal (3, 5);

              next_block_descriptor (fsc$ansi_eof2_label_kind);
              NEXT eof2_block IN label_sequence;
              eof2_block^ := eof2_label_default;

              NEXT label_block_descriptor IN label_sequence;
              label_block_descriptor^.label_block_type := fsc$tapemark_tape_label_block;
            ELSE
              IF #SIZE (label_sequence^) >= #SIZE (fst$tape_label_sequence_header) THEN
                NEXT label_sequence_header IN label_sequence;
                label_sequence_header^.character_set := amc$ascii;
                label_sequence_header^.label_kinds := $fst$ansi_label_kinds [];
                label_sequence_header^.sequence_size := trailer_labels_sequence_size;
                label_sequence_header^.label_count := 0;
                bap$set_file_reference_abnormal ('DEFAULTS', ame$only_seq_header_returned,
                      'FSP$DEFAULT_TAPE_LABEL_ATTRIB', 'TRAILER', status);
              ELSE
                bap$set_file_reference_abnormal ('DEFAULTS', ame$label_sequence_too_small,
                      'FSP$DEFAULT_TAPE_LABEL_ATTRIB', 'TRAILER', status);
                return_attribute := FALSE;
              IFEND;
            IFEND;
          ELSE
            return_attribute := FALSE;
          IFEND;

        = fsc$tape_volume_accessibility =
          attributes [index].tape_attachment.tape_volume_accessibility :=
                default_attributes.volume_accessibility;

        ELSE
          return_attribute := FALSE;
        CASEND;

        IF return_attribute THEN
          returned_attributes := returned_attributes + $fst$tla_returned_attributes
                [attributes [index].tape_attachment.selector];
        IFEND;
      IFEND;
    FOREND;

  PROCEND fsp$default_tape_label_attrib;
MODEND fsm$default_tape_label_attrib;

