?? TITLE := 'NOS/VE : Basic Access Methods: System Tape Label FAP' ??
MODULE bam$system_tape_label_fap;
?? RIGHT := 110 ??

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc fsc$max_tape_label_length
*copyc fsc$min_tape_label_length
*copyc rmc$incorrect_recorded_vsn
*copyc rmc$wrong_label_type
*copyc ame$access_validation_errors
*copyc ame$get_program_actions
*copyc ame$get_validation_errors
*copyc ame$improper_file_id
*copyc ame$open_validation_errors
*copyc ame$put_program_actions
*copyc ame$put_validation_errors
*copyc ame$ring_validation_errors
*copyc ame$skip_program_actions
*copyc ame$skip_validation_errors
*copyc ame$tape_program_actions
*copyc ame$unimplemented_request
*copyc ame$wtmk_validation_errors
*copyc bae$tape_bm_error_codes
*copyc dme$tape_errors
*copyc bat$task_file_table
*copyc fst$ansi_vol1_label
*copyc fst$tape_label_block_descriptor
*copyc fst$tape_label_sequence_header
*copyc ost$status
?? POP ??
*copyc amp$set_file_instance_abnormal
*copyc bap$dismount_tape_volume
*copyc bap$fap_control
*copyc bap$get_tape_element_name
*copyc bap$store_unsecured_tape_labels
*copyc bap$tape_bm_read_label
*copyc bap$tape_bm_rewind
*copyc bap$tape_bm_skip_label_mark
*copyc bap$tape_bm_write_label
*copyc bap$tape_bm_write_label_mark
*copyc bap$volume_robotically_mounted
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_integer
*copyc dmp$advance_tape_volume
*copyc dmp$assign_tape_volume
*copyc dmp$reset_tape_volume
*copyc dmp$unload_remount_tape_volume
*copyc dmp$update_tape_vsn_list
*copyc fmp$get_files_volume_info
*copyc fmp$get_system_file_id
*copyc fsp$classify_tape_label
*copyc fsp$header_labels
*copyc fsp$locate_tape_label
*copyc fsp$trailer_labels
*copyc ofp$format_operator_menu
*copyc osp$append_status_integer
*copyc osp$generate_error_message
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$translate_bytes
*copyc pmp$log_ascii
*copyc rmp$log_debug_message
*copyc rmp$log_debug_status
*copyc bav$task_file_table
*copyc dmv$initialize_tape_volume
*copyc osv$task_shared_heap
*copyc bai$append_tape_error
*copyc bai$label_type
*copyc bai$tape_descriptor
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    bat$error_actions = (bac$continue, bac$exit_procedure, bac$retry_last_request),
    tape_attach_info_sources = set of fst$tape_attach_info_source;

  VAR
    blank_tape_volume: [STATIC, READ, oss$job_paged_literal] rmt$volume_descriptor :=
          [rmc$unspecified_vsn, rmc$unspecified_vsn],
    tape_label_sources: [STATIC, READ, oss$job_paged_literal] tape_attach_info_sources :=
          [fsc$tape_label_attr_command, fsc$tape_open_tape_attachment, fsc$tape_hdr1_label,
          fsc$tape_hdr2_label],
    valid_file_header_labels: [STATIC, READ, oss$job_paged_literal] fst$ansi_label_kinds :=
          [fsc$ansi_hdr1_label_kind, fsc$ansi_hdr2_label_kind, fsc$ansi_hdrn_label_kind,
          fsc$ansi_uhla_label_kind],
    valid_file_trailer_labels: [STATIC, READ, oss$job_paged_literal] fst$ansi_label_kinds :=
          [fsc$ansi_eof1_label_kind, fsc$ansi_eof2_label_kind, fsc$ansi_eofn_label_kind,
          fsc$ansi_utla_label_kind],
    valid_volume_header_labels: [STATIC, READ, oss$job_paged_literal] fst$ansi_label_kinds :=
          [fsc$ansi_hdr1_label_kind, fsc$ansi_hdr2_label_kind, fsc$ansi_hdrn_label_kind,
          fsc$ansi_uhla_label_kind, fsc$ansi_uvln_label_kind, fsc$ansi_vol1_label_kind,
          fsc$ansi_voln_label_kind],
    valid_volume_trailer_labels: [STATIC, READ, oss$job_paged_literal] fst$ansi_label_kinds :=
          [fsc$ansi_eov1_label_kind, fsc$ansi_eov2_label_kind, fsc$ansi_eovn_label_kind,
          fsc$ansi_uvln_label_kind];

{ GLOBAL_TAPE_FAP_VARIABLES.

  VAR
    block_info: [XDCL] ^bat$block_info,
    file_instance: [XDCL] ^bat$task_file_entry,
    gfi: [XDCL] ^bat$global_file_information,
    close_file_on_exit: [XDCL] boolean,
    global_layer_number: [XDCL] amt$fap_layer_number,
    operation: [XDCL] amt$fap_operation,
    rhl: [XDCL] 0 .. amc$maximum_block - 1,
    state_info: [XDCL] ^bat$labeled_tape_state_info,
    tape_descriptor: [XDCL] ^bat$tape_descriptor,
    tai: [XDCL] ^fst$tape_attachment_information;

?? OLDTITLE ??
?? NEWTITLE := '[xdcl] BAP$SYSTEM_TAPE_LABEL_FAP', EJECT ??

  PROCEDURE [XDCL] bap$system_tape_label_fap
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    status.normal := TRUE;
    CASE call_block.operation OF
    = amc$dismount_current_volume =
      dismount_tape_volume (status);

    = amc$open_tape_volume =
      open_tape_volume (file_identifier, call_block, layer_number, status);

    = amc$read_tape_labels =
      read_tape_labels (file_identifier, call_block, layer_number, status);

    = amc$write_tape_labels =
      write_tape_labels (file_identifier, call_block, layer_number, status);

    = amc$skip_req =
      IF call_block.skp.unit <> amc$skip_tape_mark THEN
        amp$set_file_instance_abnormal (file_identifier, ame$tape_rcd_mgr_malfunction, operation,
              'The tape label fap received a skip request with unit not equal to tape mark.', status);
        RETURN; {----->
      IFEND;
      skip_tape_mark (file_identifier, call_block, status);

    = amc$terminate_tape_volume =
      terminate_tape_volume (call_block, status);

    ELSE
      bap$fap_control (file_identifier, call_block, layer_number, status);
    CASEND;

  PROCEND bap$system_tape_label_fap;
?? OLDTITLE ??
?? NEWTITLE := 'DISMOUNT_TAPE_VOLUME', EJECT ??

  PROCEDURE dismount_tape_volume
    (VAR status: ost$status);

    VAR
      log_status: ost$status,
      sfid: gft$system_file_identifier;

    fmp$get_system_file_id (file_instance^.local_file_name, sfid, status);

    IF status.normal THEN
      bap$dismount_tape_volume (sfid, status);
    IFEND;

    IF NOT status.normal THEN
      pmp$log_ascii (' The following error occurred while dismounting a tape volume: ',
            $pmt$ascii_logset [pmc$job_log, pmc$system_log], pmc$msg_origin_program, log_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], status, log_status);
    IFEND;

  PROCEND dismount_tape_volume;
?? OLDTITLE ??
?? NEWTITLE := 'GET_VOLUME_DESCRIPTOR', EJECT ??

  PROCEDURE get_volume_descriptor
    (    file_identifier: amt$file_identifier;
         layer_number: amt$fap_layer_number;
     VAR volume_descriptor: rmt$volume_descriptor);

    VAR
      fai_call_block: amt$call_block,
      local_status: ost$status,
      p_access_information: ^amt$access_information,
      volume_number: amt$volume_number;

    volume_descriptor.external_vsn := rmc$unspecified_vsn;
    volume_descriptor.recorded_vsn := rmc$unspecified_vsn;
    PUSH p_access_information: [1 .. 1];
    p_access_information^ [1].key := amc$volume_number;
    fai_call_block.operation := amc$fetch_access_information_rq;
    fai_call_block.fai.access_information := p_access_information;
    bap$fap_control (file_identifier, fai_call_block, layer_number, local_status);
    IF local_status.normal THEN
      volume_number := p_access_information^ [1].volume_number;
      p_access_information^ [1].key := amc$volume_description;
      p_access_information^ [1].volume_index := volume_number;
      fai_call_block.operation := amc$fetch_access_information_rq;
      fai_call_block.fai.access_information := p_access_information;
      bap$fap_control (file_identifier, fai_call_block, layer_number, local_status);
      IF local_status.normal THEN
        volume_descriptor.external_vsn := p_access_information^ [1].volume_description.external_vsn;
        volume_descriptor.recorded_vsn := p_access_information^ [1].volume_description.recorded_vsn;
      IFEND;
    IFEND;

  PROCEND get_volume_descriptor;
?? OLDTITLE ??
?? NEWTITLE := 'GET_VOLUME_NUMBER', EJECT ??

  PROCEDURE get_volume_number
    (    file_identifier: amt$file_identifier;
         layer_number: amt$fap_layer_number;
     VAR volume_number: amt$volume_number);

    VAR
      fai_call_block: amt$call_block,
      local_status: ost$status,
      p_access_information: ^amt$access_information;

    PUSH p_access_information: [1 .. 1];
    p_access_information^ [1].key := amc$volume_number;
    fai_call_block.operation := amc$fetch_access_information_rq;
    fai_call_block.fai.access_information := p_access_information;
    bap$fap_control (file_identifier, fai_call_block, layer_number, local_status);
    IF local_status.normal THEN
      volume_number := p_access_information^ [1].volume_number;
    ELSE
      volume_number := 1;
    IFEND;

  PROCEND get_volume_number;
?? OLDTITLE ??
?? NEWTITLE := 'GET_VOLUME_POSITION', EJECT ??

  PROCEDURE get_volume_position
    (    file_identifier: amt$file_identifier;
         layer_number: amt$fap_layer_number;
     VAR volume_position: amt$volume_position);

    VAR
      fai_call_block: amt$call_block,
      local_status: ost$status,
      log_status: ost$status,
      p_access_information: ^amt$access_information;

    PUSH p_access_information: [1 .. 1];
    p_access_information^ [1].key := amc$volume_position;
    fai_call_block.operation := amc$fetch_access_information_rq;
    fai_call_block.fai.access_information := p_access_information;

    bap$fap_control (file_identifier, fai_call_block, layer_number, local_status);
    IF local_status.normal THEN
      volume_position := p_access_information^ [1].volume_position;
    ELSE
      pmp$log_ascii (' The following error occurred on fetch of tape volume position: ',
            $pmt$ascii_logset [pmc$job_log, pmc$system_log], pmc$msg_origin_program, log_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], local_status, log_status);
    IFEND;

  PROCEND get_volume_position;
?? OLDTITLE ??
?? NEWTITLE := 'OPEN_TAPE_VOLUME', EJECT ??

  PROCEDURE open_tape_volume
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      assignment_operation: dmt$tape_assignment_operation,
      current_volume: amt$volume_number,
      number_of_volumes: amt$volume_number,
      sfid: gft$system_file_identifier,
      requested_volume_attributes: iot$requested_volume_attributes,
      volume_information: array [1 .. 1] of fmt$volume_info;

    get_volume_number (file_identifier, layer_number, current_volume);

    volume_information [1].key := fmc$number_of_volumes;
    fmp$get_files_volume_info (file_instance^.local_file_name, volume_information, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF volume_information [1].item_returned THEN
      number_of_volumes := volume_information [1].number_of_volumes;
    ELSE
      number_of_volumes := 1;
    IFEND;

    fmp$get_system_file_id (file_instance^.local_file_name, sfid, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF call_block.open_tape_volume^.initial_assignment THEN
      assignment_operation := dmc$assign_initial_tape_volume;
    ELSEIF call_block.open_tape_volume^.opening_volume_number = 1 THEN
      assignment_operation := dmc$reset_tape_volume_list;
    ELSEIF call_block.open_tape_volume^.opening_volume_number <= number_of_volumes THEN
      IF call_block.open_tape_volume^.opening_volume_number = (current_volume + 1) THEN
        assignment_operation := dmc$advance_to_next_tape_volume;
      ELSE
        amp$set_file_instance_abnormal (file_identifier, dme$unimp_tape_assignment,
              LOWERVALUE (amt$last_operation), 'non sequential assignment not implemented', status);
        RETURN; {----->
      IFEND;
    ELSEIF call_block.open_tape_volume^.opening_volume_number = (number_of_volumes + 1) THEN
      assignment_operation := dmc$extend_tape_volume_list;
    ELSE
      amp$set_file_instance_abnormal (file_identifier, dme$invalid_tape_assignment,
            LOWERVALUE (amt$last_operation), 'non sequential extension of volume list not allowed', status);
      RETURN; {----->
    IFEND;

    IF call_block.open_tape_volume^.opening_volume <> blank_tape_volume THEN
      requested_volume_attributes.account := call_block.open_tape_volume^.account;
      requested_volume_attributes.family := call_block.open_tape_volume^.family;
      requested_volume_attributes.project := call_block.open_tape_volume^.project;
      requested_volume_attributes.removable_media_group := call_block.open_tape_volume^.removable_media_group;
      requested_volume_attributes.removable_media_location :=
            call_block.open_tape_volume^.removable_media_location;
      requested_volume_attributes.slot := call_block.open_tape_volume^.slot;
      requested_volume_attributes.user := call_block.open_tape_volume^.user;
      dmp$update_tape_vsn_list (sfid, file_instance^.local_file_name,
            call_block.open_tape_volume^.opening_volume, requested_volume_attributes,
            call_block.open_tape_volume^.source_pool, call_block.open_tape_volume^.source_pool_location,
            assignment_operation, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    CASE assignment_operation OF
    = dmc$assign_initial_tape_volume =
      dmp$assign_tape_volume (sfid, file_instance^.local_file_name, tape_descriptor^.file_label_type,
            file_instance^.instance_attributes.dynamic_label.access_mode, status);
    = dmc$advance_to_next_tape_volume =
      dmp$advance_tape_volume (sfid, { extend_volume_list = } FALSE, tape_descriptor^.file_label_type,
            file_instance^.instance_attributes.dynamic_label.access_mode, status);
    = dmc$extend_tape_volume_list =
      dmp$advance_tape_volume (sfid, { extend_volume_list = } TRUE, tape_descriptor^.file_label_type,
            file_instance^.instance_attributes.dynamic_label.access_mode, status);
    = dmc$reset_tape_volume_list =
      dmp$reset_tape_volume (sfid, tape_descriptor^.file_label_type,
            file_instance^.instance_attributes.dynamic_label.access_mode, status);
    ELSE
    CASEND;

  PROCEND open_tape_volume;
?? OLDTITLE ??
?? NEWTITLE := 'OPERATOR_MENU_FOR_INCORRECT_VSN', EJECT ??

  PROCEDURE operator_menu_for_incorrect_vsn
    (    actual_rvsn: rmt$recorded_vsn;
         element_name: cmt$element_name;
         requested_evsn: rmt$external_vsn;
         requested_rvsn: rmt$recorded_vsn;
     VAR status: ost$status);

    CONST
      default_terminate_reason = 'the requested tape volume is not available',
      number_of_choices = 2;

    VAR
      message_parameters: array [1 .. 4] of ^ost$message_parameter,
      parameter_names: ^ost$parameter_help_names,
      response: oft$number_of_choices,
      response_string: ost$string,
      string_size: ost$name_size,
      terminate_reason: string (osc$max_string_size);

    message_parameters [1] := ^requested_rvsn;
    message_parameters [2] := ^requested_evsn;
    message_parameters [3] := ^actual_rvsn;
    message_parameters [4] := ^element_name;

    PUSH parameter_names: [1 .. number_of_choices];
    parameter_names^ [1] := 'CONTINUE_REQUEST';
    parameter_names^ [2] := 'TERMINATE_REQUEST';

    ofp$format_operator_menu (rmc$incorrect_recorded_vsn, parameter_names, ^message_parameters,
          number_of_choices, ofc$removable_media_operator, response, response_string, status);
    IF status.normal THEN
      CASE response OF
      = 1 = {reassign the correct volume. }
        osp$set_status_condition (dme$operator_reassign, status);
      = 2 = {terminate the assignment. }
        IF response_string.size > 0 THEN
          terminate_reason := response_string.value (1, response_string.size);
        ELSE
          terminate_reason := default_terminate_reason;
        IFEND;
        osp$set_status_abnormal (rmc$resource_management_id, dme$operator_stop, terminate_reason, status);
      ELSE
      CASEND;
    IFEND;

  PROCEND operator_menu_for_incorrect_vsn;
?? OLDTITLE ??
?? NEWTITLE := 'OPERATOR_MENU_FOR_UNLABELED', EJECT ??

  PROCEDURE operator_menu_for_unlabeled
    (    element_name: cmt$element_name;
         requested_evsn: rmt$external_vsn;
         requested_rvsn: rmt$recorded_vsn;
     VAR status: ost$status);

    CONST
      default_terminate_reason = 'the requested tape volume is not available',
      number_of_choices = 2;

    VAR
      message_parameters: array [1 .. 3] of ^ost$message_parameter,
      parameter_names: ^ost$parameter_help_names,
      response_string: ost$string,
      response: oft$number_of_choices,
      string_size: ost$name_size,
      terminate_reason: string (osc$max_string_size);

    message_parameters [1] := ^requested_rvsn;
    message_parameters [2] := ^requested_evsn;
    message_parameters [3] := ^element_name;

    PUSH parameter_names: [1 .. number_of_choices];
    parameter_names^ [1] := 'ASSIGN_LABELED_VOLUME';
    parameter_names^ [2] := 'TERMINATE_REQUEST';

    ofp$format_operator_menu (rmc$wrong_label_type, parameter_names, ^message_parameters, number_of_choices,
          ofc$removable_media_operator, response, response_string, status);
    IF status.normal THEN
      CASE response OF
      = 1 = { reassign the correct volume. }
        osp$set_status_condition (dme$operator_reassign, status);
      = 2 = { terminate the assignment. }
        IF response_string.size > 0 THEN
          terminate_reason := response_string.value (1, response_string.size);
        ELSE
          terminate_reason := default_terminate_reason;
        IFEND;
        osp$set_status_abnormal (rmc$resource_management_id, dme$operator_stop, terminate_reason, status);
      ELSE
      CASEND;
    IFEND;

  PROCEND operator_menu_for_unlabeled;
?? OLDTITLE ??
?? NEWTITLE := 'PROCESS_REQUEST_STATUS', EJECT ??

{ The purpose of this request is to take a request status and failure modes
{ returned by the tape_block_manager and do the following:
{
{   1) Store the tape_failure_modes in the tape_descriptor,
{   2) Change any internal errors into either appropriate external errors.

  PROCEDURE process_request_status
    (    file_identifier: amt$file_identifier;
         operation: amt$fap_operation;
         request_status: ost$status;
         tape_failure_modes: amt$tape_failure_modes;
     VAR status: ost$status);

    status.normal := TRUE;
    tape_descriptor^.failure_isolation.failure_modes := tape_failure_modes;
    tape_descriptor^.failure_isolation.failed_at_current_position := TRUE;
    IF request_status.normal THEN
      RETURN; {----->
    IFEND;

{ Process abnormal request_status.

    IF request_status.condition = bae$cannot_lock_tape_pages THEN
      amp$set_file_instance_abnormal (file_identifier, ame$cannot_lock_tape_pages, operation, '', status);

    ELSEIF request_status.condition = bae$improper_access_attempt THEN
      CASE operation OF
      = amc$write_tape_labels =
        amp$set_file_instance_abnormal (file_identifier, ame$improper_access_attempt, operation, 'WRITE',
              status);
      ELSE
        amp$set_file_instance_abnormal (file_identifier, ame$improper_access_attempt, operation, 'READ',
              status);
      CASEND;

    ELSEIF request_status.condition = bae$improper_file_id THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_file_id, operation, '', status);

    ELSEIF request_status.condition = bae$improper_input_attempt THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_input_attempt, operation, '', status);

    ELSEIF request_status.condition = bae$no_tape_write_ring THEN
      amp$set_file_instance_abnormal (file_identifier, ame$no_write_ring, operation, '', status);

    ELSEIF request_status.condition = bae$ring_validation_error THEN
      amp$set_file_instance_abnormal (file_identifier, ame$ring_validation_error, operation, '', status);

    ELSEIF request_status.condition = bae$skip_encountered_bov THEN
      amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_bov, operation, '', status);

    ELSEIF request_status.condition = bae$tape_block_mgr_malfunction THEN
      amp$set_file_instance_abnormal (file_identifier, ame$tape_block_mgr_malfunction, operation,
            request_status.text.value (2, request_status.text.size - 1), status);
      bai$append_tape_error (file_identifier, tape_failure_modes, status);

    ELSEIF request_status.condition = bae$tape_driver_not_capable THEN
      amp$set_file_instance_abnormal (file_identifier, ame$tape_driver_not_capable, operation, '', status);

    ELSEIF request_status.condition = bae$uncertain_tape_position THEN
      amp$set_file_instance_abnormal (file_identifier, ame$uncertain_tape_position, operation, '', status);
      bai$append_tape_error (file_identifier, tape_failure_modes, status);

    ELSEIF request_status.condition = bae$write_error_previous_block THEN
      tape_descriptor^.failure_isolation.failed_at_current_position := FALSE;
      amp$set_file_instance_abnormal (file_identifier, ame$unrecovered_write_error, operation, '', status);
      bai$append_tape_error (file_identifier, tape_failure_modes, status);

    ELSEIF request_status.condition = bae$read_error_this_block THEN
      amp$set_file_instance_abnormal (file_identifier, ame$unrecovered_read_error, operation, '', status);
      bai$append_tape_error (file_identifier, tape_failure_modes, status);

    ELSEIF request_status.condition = bae$density_mismatch THEN
      amp$set_file_instance_abnormal (file_identifier, ame$tape_density_mismatch, operation, '', status);

    ELSEIF request_status.condition = bae$motion_past_phys_eot THEN
      amp$set_file_instance_abnormal (file_identifier, ame$motion_past_phys_eot, operation, '', status);

    ELSEIF request_status.condition = bae$write_error_this_block THEN
      amp$set_file_instance_abnormal (file_identifier, ame$unrecovered_write_error, operation, '', status);
      bai$append_tape_error (file_identifier, tape_failure_modes, status);

    ELSE
      status := request_status;
    IFEND;

  PROCEND process_request_status;
?? OLDTITLE ??
?? NEWTITLE := 'READ_TAPE_LABELS', EJECT ??

  PROCEDURE read_tape_labels
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    TYPE
      bat$read_label_list_entry = record
        link: ^bat$read_label_list_entry,
        tape_label_block_descriptor: fst$tape_label_block_descriptor,
        label: SEQ ( * ),
      recend;

    VAR
      block_length: amt$transfer_count,
      character_set: amt$internal_code,
      element_name: cmt$element_name,
      file_instance: ^bat$task_file_entry,
      first_label_kind: fst$ansi_label_kind,
      ignore_status: ost$status,
      initial_volume_position: amt$volume_position,
      label_classification: fst$tape_label_classification,
      label_count: integer,
      label_kinds: fst$ansi_label_kinds,
      label_sequence_size: ost$positive_integers,
      local_status: ost$status,
      os_error: ost$error,
      p_ansi_vol1_label: ^fst$ansi_vol1_label,
      p_area: ^string ( * ),
      p_area_request: ^array [1 .. * ] of cell,
      p_current_list_entry: ^bat$read_label_list_entry,
      p_initial_list_entry: ^bat$read_label_list_entry,
      p_label: ^SEQ ( * ),
      p_label_sequence: ^SEQ ( * ),
      p_label_sequence_header: ^fst$tape_label_sequence_header,
      p_label_string: ^string ( * ),
      p_next_list_entry: ^bat$read_label_list_entry,
      p_read_label_sequence: ^SEQ ( * ),
      p_tape_descriptor: ^bat$tape_descriptor,
      p_tape_label_block_descriptor: ^fst$tape_label_block_descriptor,
      request_status: ost$status,
      sfid: gft$system_file_identifier,
      tape_failure_modes: amt$tape_failure_modes,
      transfer_length: amt$transfer_count,
      valid_label: boolean,
      volume_descriptor: rmt$volume_descriptor,
      volume_number: amt$volume_number,
      volume_position: amt$volume_position;

    status.normal := TRUE;
    label_count := 0;
    label_sequence_size := #SIZE (fst$tape_label_sequence_header);
    file_instance := ^bav$task_file_table^ [file_identifier.ordinal];
    p_tape_descriptor := bai$tape_descriptor (file_instance);
    label_kinds := $fst$ansi_label_kinds [];

    get_volume_position (file_identifier, layer_number, initial_volume_position);

{The first list entry is initialized to a tapemark but it will only be put into the trailer label sequence.
    PUSH p_initial_list_entry: [[REP 1 OF cell]];
    p_initial_list_entry^.link := NIL;
    p_initial_list_entry^.tape_label_block_descriptor.label_block_type := fsc$tapemark_tape_label_block;
    p_current_list_entry := p_initial_list_entry;

    PUSH p_read_label_sequence: [[REP fsc$max_tape_label_length OF cell]];
    NEXT p_area_request: [1 .. fsc$max_tape_label_length] IN p_read_label_sequence;

  /read_labels/
    REPEAT
      block_length := 0;
      transfer_length := 0;
      tape_failure_modes := $amt$tape_failure_modes [];
      valid_label := FALSE;

      bap$tape_bm_read_label (file_identifier, p_area_request, fsc$max_tape_label_length,
            {system_media_recovery} TRUE, block_length, volume_position, tape_failure_modes, request_status);
      process_request_status (file_identifier, operation, request_status, tape_failure_modes, status);

      IF block_length > 0 THEN
        IF block_length > fsc$max_tape_label_length THEN
          transfer_length := fsc$max_tape_label_length;
        ELSE
          transfer_length := block_length;
        IFEND;
        PUSH p_next_list_entry: [[REP transfer_length OF cell]];
        label_sequence_size := label_sequence_size + #SIZE (fst$tape_label_block_descriptor) +
              transfer_length;
        RESET p_read_label_sequence;
        NEXT p_area: [transfer_length] IN p_read_label_sequence;
      ELSE
        transfer_length := 0;
        PUSH p_next_list_entry: [[REP 1 OF cell]];
        label_sequence_size := label_sequence_size + #SIZE (fst$tape_label_block_descriptor);
      IFEND;

      p_current_list_entry^.link := p_next_list_entry;
      p_next_list_entry^.link := NIL;

      IF status.normal THEN
        tape_descriptor^.volume_position := volume_position;
        IF volume_position = amc$after_tapemark THEN
          IF label_count = 0 THEN
            get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
            IF dmv$initialize_tape_volume.in_progress OR (initial_volume_position <> amc$bov) OR
                  (tape_descriptor^.file_label_type <> amc$labeled) THEN
              amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tapemark, operation,
                    volume_descriptor.external_vsn, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                    status);
            ELSE
              fmp$get_system_file_id (file_instance^.local_file_name, sfid, status);
              IF NOT status.normal THEN
                EXIT /read_labels/; {----->
              IFEND;
              IF bap$volume_robotically_mounted (sfid) THEN
                amp$set_file_instance_abnormal (file_identifier, ame$improper_file_label_type, operation,
                      volume_descriptor.external_vsn, status);
                dismount_tape_volume (ignore_status);
              ELSE
                bap$get_tape_element_name (sfid, element_name, status);
                IF NOT status.normal THEN
                  EXIT /read_labels/; {----->
                IFEND;
                operator_menu_for_unlabeled (element_name, volume_descriptor.external_vsn,
                      volume_descriptor.recorded_vsn, status);
                IF status.condition = dme$operator_reassign THEN
                  remount_tape_volume (status);
                  IF status.normal THEN
                    CYCLE /read_labels/; {----->
                  IFEND;
                ELSE
                  dismount_tape_volume (ignore_status);
                IFEND;
              IFEND;
            IFEND;
            EXIT /read_labels/; {----->
          ELSE
            p_next_list_entry^.tape_label_block_descriptor.label_block_type := fsc$tapemark_tape_label_block;
            label_count := label_count + 1;
          IFEND;
        ELSE
          IF (volume_position = amc$after_data_block) AND (block_length >= fsc$min_tape_label_length) THEN
            fsp$classify_tape_label (p_area^, label_classification);
            valid_label := label_classification.valid_label;
            IF valid_label THEN
              IF label_classification.character_set = amc$ebcdic THEN
                osp$translate_bytes (#LOC (p_area^), transfer_length, #LOC (p_area^), transfer_length,
                      ^osv$ebcdic_to_ascii, os_error);
              IFEND;
              IF label_count = 0 THEN
                character_set := label_classification.character_set;
                first_label_kind := label_classification.label_kind;
                IF initial_volume_position = amc$bov THEN
                  IF label_classification.label_kind = fsc$ansi_vol1_label_kind THEN
                    RESET p_read_label_sequence;
                    NEXT p_ansi_vol1_label IN p_read_label_sequence;
                    get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                    IF (tape_descriptor^.file_label_type = amc$labeled) AND
                          (NOT dmv$initialize_tape_volume.in_progress) AND
                          (p_ansi_vol1_label^.volume_identifier <> volume_descriptor.recorded_vsn) THEN
                      fmp$get_system_file_id (file_instance^.local_file_name, sfid, status);
                      IF NOT status.normal THEN
                        EXIT /read_labels/; {----->
                      IFEND;
                      IF bap$volume_robotically_mounted (sfid) THEN
                        osp$set_status_abnormal (amc$access_method_id, ame$unknown_volume,
                              volume_descriptor.external_vsn, status);
                        osp$append_status_parameter (osc$status_parameter_delimiter,
                              volume_descriptor.recorded_vsn, status);
                        dismount_tape_volume (ignore_status);
                      ELSE
                        bap$get_tape_element_name (sfid, element_name, status);
                        IF NOT status.normal THEN
                          EXIT /read_labels/; {----->
                        IFEND;
                        operator_menu_for_incorrect_vsn (p_ansi_vol1_label^.volume_identifier, element_name,
                              volume_descriptor.external_vsn, volume_descriptor.recorded_vsn, status);
                        IF status.condition = dme$operator_reassign THEN
                          remount_tape_volume (status);
                          IF status.normal THEN
                            CYCLE /read_labels/; {----->
                          IFEND;
                        ELSE
                          dismount_tape_volume (ignore_status);
                        IFEND;
                      IFEND;
                      EXIT /read_labels/; {----->
                    IFEND;
                  ELSE {at BOV and first label is not VOL1}
                    IF NOT dmv$initialize_tape_volume.in_progress THEN
                      get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                      amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tape_label, operation,
                            volume_descriptor.external_vsn, status);
                      osp$append_status_parameter (osc$status_parameter_delimiter,
                            volume_descriptor.recorded_vsn, status);
                      osp$append_status_parameter (osc$status_parameter_delimiter,
                            label_classification.label_identifier, status);
                      osp$append_status_parameter (osc$status_parameter_delimiter, 'VOL1', status);
                      EXIT /read_labels/; {----->
                    IFEND;
                  IFEND;
                ELSE
                  IF NOT ((label_classification.label_kind = fsc$ansi_hdr1_label_kind) OR
                        (label_classification.label_kind = fsc$ansi_eof1_label_kind) OR
                        (label_classification.label_kind = fsc$ansi_eov1_label_kind)) THEN
                    get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                    amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tape_label, operation,
                          volume_descriptor.external_vsn, status);
                    osp$append_status_parameter (osc$status_parameter_delimiter,
                          volume_descriptor.recorded_vsn, status);
                    osp$append_status_parameter (osc$status_parameter_delimiter,
                          label_classification.label_identifier, status);
                    osp$append_status_parameter (osc$status_parameter_delimiter, 'HDR1 or EOF1 or EOV1',
                          status);
                    EXIT /read_labels/; {----->
                  IFEND;
                IFEND;

              ELSE { label_count > 0 }
                IF (first_label_kind = fsc$ansi_vol1_label_kind) AND
                      (NOT (label_classification.label_kind IN valid_volume_header_labels)) THEN
                  get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                  amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tape_label, operation,
                        volume_descriptor.external_vsn, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                        local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter,
                        label_classification.label_identifier, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, 'VOLN or UVNL or HDRN or UHLA',
                        local_status);
                  rmp$log_debug_message (' The following error occurred while reading tape labels: ');
                  rmp$log_debug_status (local_status);
                ELSEIF (first_label_kind = fsc$ansi_eov1_label_kind) AND
                      (NOT (label_classification.label_kind IN valid_volume_trailer_labels)) THEN
                  get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                  amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tape_label, operation,
                        volume_descriptor.external_vsn, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                        local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter,
                        label_classification.label_identifier, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, 'VOLN or UVLN', local_status);
                  rmp$log_debug_message (' The following error occurred while reading tape labels: ');
                  rmp$log_debug_status (local_status);
                ELSEIF (first_label_kind = fsc$ansi_hdr1_label_kind) AND
                      (NOT (label_classification.label_kind IN valid_file_header_labels)) THEN
                  get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                  amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tape_label, operation,
                        volume_descriptor.external_vsn, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                        local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter,
                        label_classification.label_identifier, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, 'HDRN or UHLA', local_status);
                  rmp$log_debug_message (' The following error occurred while reading tape labels: ');
                  rmp$log_debug_status (local_status);
                ELSEIF (first_label_kind = fsc$ansi_eof1_label_kind) AND
                      (NOT (label_classification.label_kind IN valid_file_trailer_labels)) THEN
                  get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                  amp$set_file_instance_abnormal (file_identifier, ame$unexpected_tape_label, operation,
                        volume_descriptor.external_vsn, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                        local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter,
                        label_classification.label_identifier, local_status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, 'EOFN or UTLA', local_status);
                  rmp$log_debug_message (' The following error occurred while reading tape labels: ');
                  rmp$log_debug_status (local_status);
                IFEND;
              IFEND;

              label_kinds := label_kinds + $fst$ansi_label_kinds [label_classification.label_kind];
              p_next_list_entry^.tape_label_block_descriptor.label_block_type := fsc$normal_tape_label_block;
              p_next_list_entry^.tape_label_block_descriptor.normal_label_actual_length := block_length;
              p_next_list_entry^.tape_label_block_descriptor.normal_label_transfer_length := transfer_length;
              p_next_list_entry^.tape_label_block_descriptor.normal_label_character_set :=
                    label_classification.character_set;
              p_next_list_entry^.tape_label_block_descriptor.normal_label_kind :=
                    label_classification.label_kind;
              label_count := label_count + 1;
            IFEND;
          IFEND;

          IF NOT valid_label THEN
            IF label_count = 0 THEN
              IF initial_volume_position = amc$bov THEN
                IF dmv$initialize_tape_volume.in_progress OR (tape_descriptor^.file_label_type <> amc$labeled)
                      THEN
                  get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                  amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label, operation,
                        volume_descriptor.external_vsn, status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                        status);
                  EXIT /read_labels/; {----->
                ELSE
                  get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                  fmp$get_system_file_id (file_instance^.local_file_name, sfid, status);
                  IF NOT status.normal THEN
                    EXIT /read_labels/; {----->
                  IFEND;
                  IF bap$volume_robotically_mounted (sfid) THEN
                    amp$set_file_instance_abnormal (file_identifier, ame$improper_file_label_type, operation,
                          volume_descriptor.external_vsn, status);
                    dismount_tape_volume (ignore_status);
                  ELSE
                    bap$get_tape_element_name (sfid, element_name, status);
                    IF NOT status.normal THEN
                      EXIT /read_labels/; {----->
                    IFEND;
                    operator_menu_for_unlabeled (element_name, volume_descriptor.external_vsn,
                          volume_descriptor.recorded_vsn, status);
                    IF status.condition = dme$operator_reassign THEN
                      remount_tape_volume (status);
                      IF status.normal THEN
                        CYCLE /read_labels/; {----->
                      IFEND;
                    ELSE
                      dismount_tape_volume (ignore_status);
                    IFEND;
                  IFEND;
                  EXIT /read_labels/; {----->
                IFEND;
              ELSE
                get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
                amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label, operation,
                      volume_descriptor.external_vsn, status);
                osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                      status);
                EXIT /read_labels/; {----->
              IFEND;
            ELSE
              p_next_list_entry^.tape_label_block_descriptor.label_block_type := fsc$non_tape_label_block;
              p_next_list_entry^.tape_label_block_descriptor.non_label_actual_length := block_length;
              p_next_list_entry^.tape_label_block_descriptor.non_label_transfer_length := transfer_length;
              label_count := label_count + 1;
            IFEND;
          IFEND;
        IFEND;
      ELSE
        IF (status.condition = ame$unrecovered_read_error) OR
              (dmv$initialize_tape_volume.in_progress AND (status.condition = ame$tape_density_mismatch)) THEN
          get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
          amp$set_file_instance_abnormal (file_identifier, ame$tape_label_read_error, operation,
                volume_descriptor.external_vsn, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                status);
          osp$append_status_integer (osc$status_parameter_delimiter, label_count + 1, {radix} 10,
                {include_radix_specifier} FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, '', status);
          bai$append_tape_error (file_identifier, tape_failure_modes, status);
          IF (amc$tfm_blank_tape_read IN tape_failure_modes) THEN
            EXIT /read_labels/; {----->
          IFEND;
        IFEND;
{
{ A new or degaussed tape gets a density error at loadpoint.  If the tape is requested as
{ unlabeled for write purposes (not initialization), set an error condition which allows
{ the request to continue without processing tape labels
{
        IF (status.condition = ame$tape_density_mismatch) AND
              (tape_descriptor^.file_label_type <> amc$labeled) AND
              (pfc$append IN file_instance^.instance_attributes.dynamic_label.access_mode) THEN
          get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
          amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label, operation,
                volume_descriptor.external_vsn, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                status);
          EXIT /read_labels/; {----->
        IFEND;
        IF label_count = 0 THEN
          EXIT /read_labels/; {----->
        ELSE
          rmp$log_debug_message (' The following error occurred while reading tape labels: ');
          rmp$log_debug_status (status);
          p_next_list_entry^.tape_label_block_descriptor.label_block_type := fsc$erroneous_tape_label_block;
          p_next_list_entry^.tape_label_block_descriptor.erroneous_label_actual_length := block_length;
          p_next_list_entry^.tape_label_block_descriptor.erroneous_label_transfer_length := transfer_length;
          p_next_list_entry^.tape_label_block_descriptor.erroneous_label_failure_modes := tape_failure_modes;
          label_count := label_count + 1;
        IFEND;
      IFEND;

      IF transfer_length > 0 THEN
        p_label := ^p_next_list_entry^.label;
        NEXT p_label_string: [transfer_length] IN p_label;
        p_label_string^ (1, transfer_length) := p_area^ (1, transfer_length);
      IFEND;
      p_current_list_entry := p_next_list_entry;

      IF label_count >= (fsc$max_tape_labels - 1) THEN
        PUSH p_next_list_entry: [[REP 1 OF cell]];
        label_sequence_size := label_sequence_size + #SIZE (fst$tape_label_block_descriptor);
        p_current_list_entry^.link := p_next_list_entry;
        p_next_list_entry^.link := NIL;
        p_next_list_entry^.tape_label_block_descriptor.label_block_type := fsc$tapemark_tape_label_block;
        label_count := label_count + 1;

        get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
        amp$set_file_instance_abnormal (file_identifier, ame$excessive_tape_labels, operation,
              volume_descriptor.external_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn, status);
        osp$append_status_integer (osc$status_parameter_delimiter, fsc$max_tape_labels, {radix} 10,
              {include_radix_specifier} FALSE, status);
        EXIT /read_labels/; {----->
      IFEND;

    UNTIL volume_position = amc$after_tapemark;

    IF NOT status.normal THEN
      rmp$log_debug_message (' The following error occurred while reading tape labels: ');
      rmp$log_debug_status (status);
    IFEND;

    IF (label_count > 0) AND (status.normal OR (status.condition = ame$excessive_tape_labels)) THEN
      call_block.read_tape_labels^.label_kinds := label_kinds;

{     A trailer label sequence (but not a header label sequence) begins with a tapemark if the volume position
{     before reading labels is 'after tapemark'.

      IF (initial_volume_position = amc$after_tapemark) AND
            ((first_label_kind = fsc$ansi_eov1_label_kind) OR (first_label_kind = fsc$ansi_eof1_label_kind))
            THEN
        p_next_list_entry := p_initial_list_entry;
        label_count := label_count + 1;
        label_sequence_size := label_sequence_size + #SIZE (fst$tape_label_block_descriptor);
      ELSE
        p_next_list_entry := p_initial_list_entry^.link;
      IFEND;

      PUSH p_label_sequence: [[REP label_sequence_size OF cell]];
      NEXT p_label_sequence_header IN p_label_sequence;
      p_label_sequence_header^.character_set := character_set;
      p_label_sequence_header^.label_kinds := label_kinds;
      p_label_sequence_header^.sequence_size := label_sequence_size;
      p_label_sequence_header^.label_count := label_count;

      REPEAT
        NEXT p_tape_label_block_descriptor IN p_label_sequence;
        p_tape_label_block_descriptor^ := p_next_list_entry^.tape_label_block_descriptor;
        p_label := NIL;

        CASE p_next_list_entry^.tape_label_block_descriptor.label_block_type OF

        = fsc$erroneous_tape_label_block =
          IF p_next_list_entry^.tape_label_block_descriptor.erroneous_label_transfer_length > 0 THEN
            NEXT p_label: [[REP p_next_list_entry^.tape_label_block_descriptor.
                  erroneous_label_transfer_length OF cell]] IN p_label_sequence;
          IFEND;

        = fsc$non_tape_label_block =
          IF p_next_list_entry^.tape_label_block_descriptor.non_label_transfer_length > 0 THEN
            NEXT p_label: [[REP p_next_list_entry^.tape_label_block_descriptor.non_label_transfer_length OF
                  cell]] IN p_label_sequence;
          IFEND;

        = fsc$normal_tape_label_block =
          IF p_next_list_entry^.tape_label_block_descriptor.normal_label_transfer_length > 0 THEN
            NEXT p_label: [[REP p_next_list_entry^.tape_label_block_descriptor.normal_label_transfer_length OF
                  cell]] IN p_label_sequence;
          IFEND;

        = fsc$tapemark_tape_label_block =
          ;

        CASEND;

        IF p_label <> NIL THEN
          p_label^ := p_next_list_entry^.label;
        IFEND;
        p_current_list_entry := p_next_list_entry;
        p_next_list_entry := p_next_list_entry^.link;
      UNTIL p_next_list_entry = NIL;

      get_volume_number (file_identifier, layer_number, volume_number);
      IF (volume_number = 1) AND (initial_volume_position = amc$bov) THEN
        bap$store_unsecured_tape_labels (p_label_sequence, p_tape_descriptor^.initial_volume.header_labels);
      IFEND;

      IF fsp$header_labels (label_kinds) THEN
        bap$store_unsecured_tape_labels (p_label_sequence, p_tape_descriptor^.last_accessed.
              unsecured_header_labels);
        store_secured_tape_labels (p_label_sequence, p_tape_descriptor^.last_accessed.secured_header_labels);
      ELSEIF fsp$trailer_labels (label_kinds) THEN
        bap$store_unsecured_tape_labels (p_label_sequence, p_tape_descriptor^.last_accessed.
              unsecured_trailer_labels);
        store_secured_tape_labels (p_label_sequence, p_tape_descriptor^.last_accessed.secured_trailer_labels);
      IFEND;
    IFEND;

  PROCEND read_tape_labels;
?? OLDTITLE ??
?? NEWTITLE := 'REMOUNT_TAPE_VOLUME', EJECT ??

  PROCEDURE remount_tape_volume
    (VAR status: ost$status);

    VAR
      log_status: ost$status,
      sfid: gft$system_file_identifier;

    fmp$get_system_file_id (file_instance^.local_file_name, sfid, status);

    IF status.normal THEN
      dmp$unload_remount_tape_volume (sfid, file_instance^.instance_attributes.dynamic_label.access_mode,
            {recovery_remount} FALSE, status);
    IFEND;

    IF NOT status.normal THEN
      pmp$log_ascii (' The following error occurred while remounting a tape volume: ',
            $pmt$ascii_logset [pmc$job_log, pmc$system_log], pmc$msg_origin_program, log_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], status, log_status);
    IFEND;

  PROCEND remount_tape_volume;
?? OLDTITLE ??
?? NEWTITLE := 'SKIP_TAPE_MARK', EJECT ??

  PROCEDURE skip_tape_mark
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
     VAR status: ost$status);

{ This procedure is used to skip a user defined number of tape marks in the
{ user defined direction. Tape mark skipping will stop when the number of
{ tape marks are reached or when the tape reached the beginning of volume.

    VAR
      request_status: ost$status,
      skip_count: amt$skip_count,
      tape_failure_modes: amt$tape_failure_modes;

    status.normal := TRUE;
    skip_count := call_block.skp.count;

    WHILE skip_count > 0 DO
      bap$tape_bm_skip_label_mark (file_identifier, call_block.skp.direction, tape_failure_modes,
            request_status);
      process_request_status (file_identifier, operation, request_status, tape_failure_modes, status);
      IF NOT status.normal THEN
        IF (status.condition = ame$skip_encountered_bov) AND (call_block.skp.direction = amc$backward) THEN
          tape_descriptor^.volume_position := amc$bov;
        IFEND;
        RETURN; {----->
      IFEND;
      skip_count := skip_count - 1;
    WHILEND;

    IF call_block.skp.direction = amc$forward THEN
      tape_descriptor^.volume_position := amc$after_tapemark;
    ELSE {call_block.skp.direction = amc$backward THEN
      tape_descriptor^.volume_position := amc$before_tapemark;
    IFEND;

  PROCEND skip_tape_mark;
?? OLDTITLE ??
?? NEWTITLE := 'STORE_SECURED_TAPE_LABELS', EJECT ??

  PROCEDURE store_secured_tape_labels
    (    p_label_sequence: ^SEQ ( * );
     VAR p_stored_label_sequence: ^SEQ ( * ));

    IF p_stored_label_sequence <> NIL THEN
      FREE p_stored_label_sequence IN osv$task_shared_heap^;
    IFEND;

    ALLOCATE p_stored_label_sequence: [[REP #SIZE (p_label_sequence^) OF cell]] IN osv$task_shared_heap^;

    p_stored_label_sequence^ := p_label_sequence^;

    RESET p_stored_label_sequence;

  PROCEND store_secured_tape_labels;
?? OLDTITLE ??
?? NEWTITLE := 'TERMINATE_TAPE_VOLUME', EJECT ??

  PROCEDURE terminate_tape_volume
    (    call_block: amt$call_block;
     VAR status: ost$status);

    status.normal := TRUE;

{ The purpose of this fap operation is to let the RMS fap, if installed, get control
{ when a file is being terminated because the last operation was a write to tape and
{ the current operation is either to close the file, to rewind the file or to
{ skip backwards. The process is to first call the RMS fap which will then call the
{ site modifiable validation fap which finally calls this fap. At present this fap
{ is a no-op for this operation and control is returned to the caller.

  PROCEND terminate_tape_volume;
?? OLDTITLE ??
?? NEWTITLE := 'WRITE_TAPE_LABELS', EJECT ??

  PROCEDURE write_tape_labels
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      file_instance: ^bat$task_file_entry,
      first_label_kind: fst$ansi_label_kind,
      ignore_status: ost$status,
      initial_volume_position: amt$volume_position,
      label_count: ost$non_negative_integers,
      labels_written: boolean,
      log_status: ost$status,
      normal_label_blocks_written: ost$non_negative_integers,
      os_error: ost$error,
      p_area: ^string ( * ),
      p_area_request: ^array [1 .. * ] of cell,
      p_label_sequence: ^SEQ ( * ),
      p_label_sequence_header: ^fst$tape_label_sequence_header,
      p_label_string: ^string ( * ),
      p_tape_descriptor: ^bat$tape_descriptor,
      p_tape_label_block_descriptor: ^fst$tape_label_block_descriptor,
      request_status: ost$status,
      tape_failure_modes: amt$tape_failure_modes,
      transfer_length: amt$transfer_count,
      volume_descriptor: rmt$volume_descriptor,
      volume_number: amt$volume_number;

?? NEWTITLE := 'WRITE_BLOCK', EJECT ??

    PROCEDURE write_block;

      VAR
        block_pointer: ^cell,
        ebcdic_block: ^string ( * );

      IF (p_label_sequence_header^.character_set = amc$ascii) THEN
        rmp$log_debug_message (p_label_string^);
        block_pointer := p_label_string;
        bap$tape_bm_write_label (file_identifier, block_pointer, transfer_length,
              {system_media_recovery} TRUE, tape_failure_modes, request_status);
        process_request_status (file_identifier, operation, request_status, tape_failure_modes, status);
      ELSEIF p_label_sequence_header^.character_set = amc$ebcdic THEN
        PUSH ebcdic_block: [transfer_length];
        ebcdic_block^ (1, transfer_length) := p_label_string^ (1, transfer_length);
        osp$translate_bytes (#LOC (ebcdic_block^), transfer_length, #LOC (ebcdic_block^), transfer_length,
              ^osv$ascii_to_ebcdic, os_error);
        block_pointer := ebcdic_block;
        bap$tape_bm_write_label (file_identifier, block_pointer, transfer_length,
              {system_media_recovery} TRUE, tape_failure_modes, request_status);
        process_request_status (file_identifier, operation, request_status, tape_failure_modes, status);
      ELSE
        get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
        amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
              volume_descriptor.external_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              'invalid character_set in fst$tape_label_sequence_header', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
      IFEND;

    PROCEND write_block;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;

  /write_labels_block/
    BEGIN

      file_instance := ^bav$task_file_table^ [file_identifier.ordinal];
      p_tape_descriptor := bai$tape_descriptor (file_instance);
      normal_label_blocks_written := 0;

      get_volume_position (file_identifier, layer_number, initial_volume_position);

      p_label_sequence := call_block.write_tape_labels;
      IF p_label_sequence = NIL THEN
        get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
        amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
              volume_descriptor.external_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              'NIL label sequence pointer in amc$write_tape_labels call block', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
        EXIT /write_labels_block/; {----->
      IFEND;

      RESET p_label_sequence;
      NEXT p_label_sequence_header IN p_label_sequence;

      IF p_label_sequence_header = NIL THEN
        get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
        amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
              volume_descriptor.external_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              'sequence too short for fst$tape_label_sequence_header', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
        EXIT /write_labels_block/; {----->
      IFEND;

      IF p_label_sequence_header^.label_count <= 0 THEN
        get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
        amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
              volume_descriptor.external_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              'label_count in fst$tape_label_sequence_header <= 0', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
        EXIT /write_labels_block/; {----->
      IFEND;

      IF p_label_sequence_header^.label_count > fsc$max_tape_labels THEN
        get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
        amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
              volume_descriptor.external_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              'label_count in fst$tape_label_sequence_header > fsc$max_tape_labels', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
        EXIT /write_labels_block/; {----->
      IFEND;

    /write_labels/
      FOR label_count := 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
          get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
          amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                volume_descriptor.external_vsn, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                'sequence too short for fst$tape_label_block_descriptor', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
          EXIT /write_labels_block/; {----->
        IFEND;

        CASE p_tape_label_block_descriptor^.label_block_type OF

        = fsc$erroneous_tape_label_block =
          NEXT p_label_string: [p_tape_label_block_descriptor^.erroneous_label_transfer_length] IN
                p_label_sequence;
          IF p_label_string = NIL THEN
            get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
            amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                  volume_descriptor.external_vsn, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  'sequence too short for fsc$erroneous_tape_label_block', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
            EXIT /write_labels_block/; {----->
          IFEND;

        = fsc$non_tape_label_block =
          transfer_length := p_tape_label_block_descriptor^.non_label_transfer_length;
          NEXT p_label_string: [transfer_length] IN p_label_sequence;
          IF p_label_string = NIL THEN
            get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
            amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                  volume_descriptor.external_vsn, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  'sequence too short for fsc$non_tape_label_block', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
            EXIT /write_labels_block/; {----->
          IFEND;
          write_block;

        = fsc$normal_tape_label_block =
          transfer_length := p_tape_label_block_descriptor^.normal_label_transfer_length;
          NEXT p_label_string: [transfer_length] IN p_label_sequence;
          IF p_label_string = NIL THEN
            get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
            amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                  volume_descriptor.external_vsn, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  'sequence too short for fsc$normal_tape_label_block', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
            EXIT /write_labels_block/; {----->
          IFEND;
          IF normal_label_blocks_written = 0 THEN
            IF p_label_string^ (1, 4) = 'VOL1' THEN
              first_label_kind := fsc$ansi_vol1_label_kind;
            ELSEIF p_label_string^ (1, 4) = 'HDR1' THEN
              first_label_kind := fsc$ansi_hdr1_label_kind;
            ELSEIF p_label_string^ (1, 4) = 'EOF1' THEN
              first_label_kind := fsc$ansi_eof1_label_kind;
            ELSEIF p_label_string^ (1, 4) = 'EOV1' THEN
              first_label_kind := fsc$ansi_eov1_label_kind;
            ELSE
              get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
              amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                    volume_descriptor.external_vsn, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                    status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    'first normal label not VOL1, HDR1, EOF1 or EOV1', status);
              osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
              EXIT /write_labels_block/; {----->
            IFEND;
          IFEND;
          write_block;
          IF status.normal THEN
            tape_descriptor^.volume_position := amc$after_data_block;
            normal_label_blocks_written := normal_label_blocks_written + 1;
          IFEND;

        = fsc$null_tape_label_block =
          NEXT p_label_string: [p_tape_label_block_descriptor^.null_label_transfer_length] IN
                p_label_sequence;
          IF p_label_string = NIL THEN
            get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
            amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                  volume_descriptor.external_vsn, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  'sequence too short for fsc$null_tape_label_block', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
            EXIT /write_labels_block/; {----->
          IFEND;

        = fsc$tapemark_tape_label_block =
          rmp$log_debug_message ('*');
          bap$tape_bm_write_label_mark (file_identifier, {system_media_recovery} TRUE, tape_failure_modes,
                request_status);
          process_request_status (file_identifier, operation, request_status, tape_failure_modes, status);

          IF status.normal THEN
            tape_descriptor^.volume_position := amc$after_tapemark;
          IFEND;

        ELSE
          get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
          amp$set_file_instance_abnormal (file_identifier, ame$invalid_tape_label_sequence, operation,
                volume_descriptor.external_vsn, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                'invalid label_block_type in fst$tape_label_block_descriptor', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'write', status);
        CASEND;

        IF NOT status.normal THEN
          IF status.condition = ame$unrecovered_write_error THEN
            get_volume_descriptor (file_identifier, layer_number, volume_descriptor);
            amp$set_file_instance_abnormal (file_identifier, ame$tape_label_write_error, operation,
                  volume_descriptor.external_vsn, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, volume_descriptor.recorded_vsn,
                  status);
            osp$append_status_integer (osc$status_parameter_delimiter, label_count + 1, {radix} 10,
                  {include_radix_specifier} FALSE, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, '', status);
            bai$append_tape_error (file_identifier, tape_failure_modes, status);
          IFEND;
          EXIT /write_labels/; {----->
        IFEND;

      FOREND /write_labels/;

      IF status.normal AND (normal_label_blocks_written > 0) THEN
        get_volume_number (file_identifier, layer_number, volume_number);
        IF (first_label_kind = fsc$ansi_vol1_label_kind) AND (volume_number = 1) AND
              (initial_volume_position = amc$bov) THEN
          bap$store_unsecured_tape_labels (p_label_sequence, p_tape_descriptor^.initial_volume.header_labels);
        IFEND;

        IF (first_label_kind = fsc$ansi_vol1_label_kind) OR (first_label_kind = fsc$ansi_hdr1_label_kind) THEN
          bap$store_unsecured_tape_labels (p_label_sequence,
                p_tape_descriptor^.last_accessed.unsecured_header_labels);
          store_secured_tape_labels (p_label_sequence, p_tape_descriptor^.last_accessed.
                secured_header_labels);
        ELSEIF (first_label_kind = fsc$ansi_eov1_label_kind) OR
              (first_label_kind = fsc$ansi_eof1_label_kind) THEN
          bap$store_unsecured_tape_labels (p_label_sequence,
                p_tape_descriptor^.last_accessed.unsecured_trailer_labels);
          store_secured_tape_labels (p_label_sequence, p_tape_descriptor^.last_accessed.
                secured_trailer_labels);
        IFEND;
      IFEND;

    END /write_labels_block/;

    IF NOT status.normal THEN
      pmp$log_ascii (' The following error occurred while writing tape labels: ',
            $pmt$ascii_logset [pmc$job_log, pmc$system_log], pmc$msg_origin_program, log_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], status, log_status);
      osp$generate_error_message (status, ignore_status);
    IFEND;

  PROCEND write_tape_labels;
?? OLDTITLE ??
MODEND bam$system_tape_label_fap;

