?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File System : Tape Label Classification' ??
MODULE fsm$tape_label_interfaces_2dd;

{ PURPOSE:
{   This module contains 2DD interfaces for accessing raw tape labels.
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$internal_code
*copyc fsc$min_tape_label_length
*copyc fst$ansi_label_number
*copyc fst$ansi_label_identifier
*copyc fst$ansi_label_kinds
*copyc fst$tape_label_block_descriptor
*copyc fst$tape_label_classification
*copyc fst$tape_label_count
*copyc fst$tape_label_identifier
*copyc fst$tape_label_location_method
*copyc fst$tape_label_locator
*copyc fst$tape_label_sequence_header
*copyc oss$job_paged_literal
?? POP ??
*copyc clp$convert_string_to_date_time
*copyc clp$date_time_compare
*copyc osp$translate_bytes
*copyc pmp$get_compact_date_time

?? TITLE := 'fsp$analyze_file_expiration', EJECT ??
  PROCEDURE [XDCL, #GATE] fsp$analyze_file_expiration
    (    expiration_date: string (6);
     VAR file_is_expired: boolean;
     VAR status: ost$status);

    VAR
      current_date_time: clt$date_time,
      expiration_date_time: clt$date_time,
      expiration_string: string (7);

    IF expiration_date (2, 5) = '00000' THEN
      file_is_expired := TRUE;
      status.normal := TRUE;
    ELSE
      IF expiration_date (1, 1) = ' ' THEN
        expiration_string (1, 2) := '19';
        expiration_string (3, 5) := expiration_date (2, 5);
      ELSE
        expiration_string (1, 1):= '2';
        expiration_string (2, 6) := expiration_date (1, 6);
      IFEND;
      clp$convert_string_to_date_time (expiration_string, 'Y4J3',
            expiration_date_time, status);
      IF status.normal THEN
        expiration_date_time.date_specified := TRUE;
        expiration_date_time.time_specified := FALSE;
        pmp$get_compact_date_time (current_date_time.value, status);
        IF status.normal THEN
          current_date_time.date_specified := TRUE;
          current_date_time.time_specified := FALSE;
          CASE clp$date_time_compare (expiration_date_time,
                current_date_time) OF
          = clc$equal, clc$right_is_greater =
            file_is_expired := TRUE;
          ELSE
            file_is_expired := FALSE;
          CASEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND fsp$analyze_file_expiration;

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

  PROCEDURE [XDCL, #GATE] fsp$classify_tape_label
    (    label_string: string ( * );
     VAR label_classification: fst$tape_label_classification);

    CONST
      max_label_identifiers = 7;

    VAR
      valid_label_identifiers: [oss$job_paged_literal, READ] array [1 .. max_label_identifiers] of
            fst$ansi_label_identifier := ['EOF', 'EOV', 'HDR', 'UHL', 'UTL', 'UVL', 'VOL'];

    VAR
      character_set: amt$internal_code,
      label_identifier: fst$ansi_label_identifier,
      label_identifier_index: 1 .. max_label_identifiers,
      label_number: fst$ansi_label_number,
      os_error: ost$error,
      translated_identifier_number: string (4),
      untranslated_identifier_number: string (4),
      valid_label_identifier: boolean,
      valid_label_number: boolean;

    label_classification.valid_label := FALSE;

    IF #SIZE (label_string) < fsc$min_tape_label_length THEN
      RETURN;
    IFEND;

    untranslated_identifier_number := label_string (1, 4);
    osp$translate_bytes (#LOC (untranslated_identifier_number), 4,
          #LOC (translated_identifier_number), 4, ^osv$ebcdic_to_ascii, os_error);

  /match_label_identifier_number/
    FOR label_identifier_index := LOWERBOUND (valid_label_identifiers)
          TO UPPERBOUND (valid_label_identifiers) DO
      valid_label_identifier := FALSE;
      IF untranslated_identifier_number (1, 3) = valid_label_identifiers [label_identifier_index] THEN
        valid_label_identifier := TRUE;
        character_set := amc$ascii;
        label_identifier := untranslated_identifier_number (1, 3);
        label_number := untranslated_identifier_number (4, 1);
      ELSEIF translated_identifier_number (1, 3) = valid_label_identifiers [label_identifier_index] THEN
        valid_label_identifier := TRUE;
        character_set := amc$ebcdic;
        label_identifier := translated_identifier_number (1, 3);
        label_number := translated_identifier_number (4, 1);
      IFEND;
      IF valid_label_identifier THEN
        IF (label_identifier = 'UHL') OR (label_identifier = 'UTL') THEN
          valid_label_number := ((label_number >= '1') AND (label_number <= '9')) OR
                ((label_number >= 'A') AND (label_number <= 'Z'));
        ELSE
          valid_label_number := (label_number >= '1') AND (label_number <= '9');
        IFEND;
        IF valid_label_number THEN
          label_classification.valid_label := TRUE;
          label_classification.character_set := character_set;
          label_classification.label_number := label_number;
          label_classification.label_identifier := label_identifier;
          IF label_identifier = 'EOF' THEN
            IF label_number = '1' THEN
              label_classification.label_kind := fsc$ansi_eof1_label_kind;
            ELSEIF label_number = '2' THEN
              label_classification.label_kind := fsc$ansi_eof2_label_kind;
            ELSE
              label_classification.label_kind := fsc$ansi_eofn_label_kind;
            IFEND;
          ELSEIF label_identifier = 'EOV' THEN
            IF label_number = '1' THEN
              label_classification.label_kind := fsc$ansi_eov1_label_kind;
            ELSEIF label_number = '2' THEN
              label_classification.label_kind := fsc$ansi_eov2_label_kind;
            ELSE
              label_classification.label_kind := fsc$ansi_eovn_label_kind;
            IFEND;
          ELSEIF label_identifier = 'HDR' THEN
            IF label_number = '1' THEN
              label_classification.label_kind := fsc$ansi_hdr1_label_kind;
            ELSEIF label_number = '2' THEN
              label_classification.label_kind := fsc$ansi_hdr2_label_kind;
            ELSE
              label_classification.label_kind := fsc$ansi_hdrn_label_kind;
            IFEND;
          ELSEIF label_identifier = 'VOL' THEN
            IF label_number = '1' THEN
              label_classification.label_kind := fsc$ansi_vol1_label_kind;
            ELSE
              label_classification.label_kind := fsc$ansi_voln_label_kind;
            IFEND;
          ELSEIF label_identifier = 'UHL' THEN
            label_classification.label_kind := fsc$ansi_uhla_label_kind;
          ELSEIF label_identifier = 'UTL' THEN
            label_classification.label_kind := fsc$ansi_utla_label_kind;
          ELSEIF label_identifier = 'UVL' THEN
            label_classification.label_kind := fsc$ansi_uvln_label_kind;
          IFEND;
        IFEND;
        EXIT /match_label_identifier_number/;
      IFEND;
    FOREND /match_label_identifier_number/;

  PROCEND fsp$classify_tape_label;

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

  PROCEDURE [XDCL, #GATE] fsp$locate_tape_label
    (    label_sequence: ^SEQ ( * );
         label_identifier: fst$tape_label_identifier;
     VAR label_locator: fst$tape_label_locator);

    VAR
      label_index: fst$tape_label_count,
      p_label_block: ^SEQ ( * ),
      p_label_sequence: ^SEQ ( * ),
      p_label_sequence_header: ^fst$tape_label_sequence_header,
      p_label_string: ^string ( * ),
      p_tape_label_block_descriptor: ^fst$tape_label_block_descriptor,
      search_index: fst$tape_label_count;

    p_label_sequence := label_sequence;
    label_locator.label_found := FALSE;
    label_index := 0;

    IF p_label_sequence = NIL THEN
      RETURN;
    IFEND;

    RESET p_label_sequence;
    NEXT p_label_sequence_header IN p_label_sequence;
    IF p_label_sequence_header = NIL THEN
      RETURN;
    IFEND;

    IF p_label_sequence_header^.label_count = 0 THEN
      RETURN;
    IFEND;

    IF (label_identifier.location_method = fsc$tape_label_locate_by_index) AND
          ((label_identifier.label_index = 0) OR
          (label_identifier.label_index > p_label_sequence_header^.label_count)) THEN
      RETURN;
    IFEND;

  /scan_label_sequence/
    FOR search_index := 1 TO p_label_sequence_header^.label_count DO
      NEXT p_tape_label_block_descriptor IN p_label_sequence;
      IF p_tape_label_block_descriptor = NIL THEN
        EXIT /scan_label_sequence/;
      IFEND;

    /locate_label_block/
      BEGIN
        p_label_block := NIL;
        CASE p_tape_label_block_descriptor^.label_block_type OF
          = fsc$erroneous_tape_label_block =
            label_index := label_index + 1;
            IF p_tape_label_block_descriptor^.erroneous_label_transfer_length > 0 THEN
              NEXT p_label_block:
                    [[REP p_tape_label_block_descriptor^.erroneous_label_transfer_length OF CELL]]
                    IN p_label_sequence;
              IF p_label_sequence = NIL THEN
                EXIT /scan_label_sequence/;
              IFEND;
            IFEND;

          = fsc$non_tape_label_block =
            label_index := label_index + 1;
            IF p_tape_label_block_descriptor^.non_label_transfer_length > 0 THEN
              NEXT p_label_block:
                    [[REP p_tape_label_block_descriptor^.non_label_transfer_length OF CELL]]
                    IN p_label_sequence;
              IF p_label_sequence = NIL THEN
                EXIT /scan_label_sequence/;
              IFEND;
            IFEND;

          = fsc$normal_tape_label_block =
            label_index := label_index + 1;
            IF p_tape_label_block_descriptor^.normal_label_transfer_length > 0 THEN
              NEXT p_label_block:
                    [[REP p_tape_label_block_descriptor^.normal_label_transfer_length OF CELL]]
                    IN p_label_sequence;
              IF p_label_sequence = NIL THEN
                EXIT /scan_label_sequence/;
              IFEND;
            IFEND;

            IF label_identifier.location_method = fsc$tape_label_locate_by_kind THEN
              IF p_tape_label_block_descriptor^.normal_label_kind = label_identifier.label_kind THEN
                label_locator.label_found := TRUE;
                label_locator.label_block_descriptor := p_tape_label_block_descriptor;
                RESET p_label_block;
                label_locator.label_block := p_label_block;
                label_locator.label_index := label_index;
                EXIT /scan_label_sequence/;
              IFEND;
            ELSEIF label_identifier.location_method = fsc$tape_label_locate_by_ident THEN
              IF p_label_block <> NIL THEN
                NEXT p_label_string: [p_tape_label_block_descriptor^.normal_label_transfer_length]
                      IN p_label_block;
                IF p_label_string = NIL THEN
                  EXIT /scan_label_sequence/;
                IFEND;
                IF (p_label_string^ (1,3) = label_identifier.label_identifier) AND
                      (p_label_string^ (4,1) = label_identifier.label_number) THEN
                  label_locator.label_found := TRUE;
                  label_locator.label_block_descriptor := p_tape_label_block_descriptor;
                  RESET p_label_block;
                  label_locator.label_block := p_label_block;
                  label_locator.label_index := label_index;
                  EXIT /scan_label_sequence/;
                ELSE
                  CYCLE /scan_label_sequence/;
                IFEND;
              IFEND;
            IFEND;

          = fsc$null_tape_label_block =
            IF p_tape_label_block_descriptor^.null_label_transfer_length > 0 THEN
              NEXT p_label_block: [[REP p_tape_label_block_descriptor^.null_label_transfer_length OF CELL]] IN
                    p_label_sequence;
              IF p_label_block = NIL THEN
                EXIT /scan_label_sequence/;
              IFEND;
            IFEND;
            CYCLE /scan_label_sequence/;

          = fsc$tapemark_tape_label_block =
            label_index := label_index + 1;

        CASEND;

        IF (label_identifier.location_method = fsc$tape_label_locate_by_index) AND
              (label_index = label_identifier.label_index) THEN
          label_locator.label_found := TRUE;
          label_locator.label_block_descriptor := p_tape_label_block_descriptor;
          RESET p_label_block;
          label_locator.label_block := p_label_block;
          label_locator.label_index := label_index;
          EXIT /scan_label_sequence/;
        IFEND;

      END /locate_label_block/;

    FOREND /scan_label_sequence/;

  PROCEND fsp$locate_tape_label;

MODEND fsm$tape_label_interfaces_2dd;
