?? LEFT := 1, RIGHT := 110 ??
*copy osd$default_pragmats
MODULE bam$tape_block_manager_ring3;
























  { This module provides buffered access to tape physical I/O for the ring 3 file access }
  { procedures which are the heart of basic access methods.  At  this  level, all I/O     }
  { is done in  units  of  tape blocks.  It is the responsibility of the ring 3 FAP to   }
  { map records into blocks. }

?? TITLE := 'Global constants and variables', EJECT ??

  { Global constants }

  CONST
    bac$max_ansi_label_length = 80, { Maximum length of an ANSI tape label }
    bac$reserved_pages = 20;        { Number of memory pages required in the working set limit beyond those }
                                    { required to contain the tape block buffer. }

  { Global types. }

  TYPE
    tape_block_access_mode = (open_access, read_access, write_access, non_data_transfer_access),

    tape_write_error = (no_write_error, write_error_last_block, write_error_previous_block),

    tape_write_completion = record
      end_of_tape_reflective_spot_hit: boolean,
      error_type: tape_write_error,
      failure_modes: amt$tape_failure_modes,
    recend;

  { Global variables. }

  { The following variable is global to avoid the need to make it a parameter on almost }
  { every procedure in the module.  Note, however, that the value must still be loaded }
  { at every external  entry point via a call to load_block_mgmt_descriptor_ptr to ensure }
  { that the correct pointer is used. }

  VAR
    bmd: [STATIC, oss$task_private] ^bat$tape_block_mgmt_descriptor := NIL;

  { The following variable, which is shared by all tasks in the job, is set to point to the block }
  {  management descriptor for each open of a tape file.  In this way another task in the same job }
  {  can locate the tables for the most recently opened tape and examine them. }

  VAR
    bav$tape_bmd_saved_for_debug: [STATIC, XDCL, oss$task_shared] ^bat$tape_block_mgmt_descriptor := NIL;

  { The following variables control various aspects of the operation of tape block management. }
  { These variables are defined and described in bam$tape_block_manager_ring1. }


*copyc bav$max_allowed_tape_block_size
*copy bav$max_indirect_tape_block
*copy bav$max_bytes_per_tape_io
*copy bav$force_direct_tape_io
*copy bav$use_assign_pages_for_tape

  { The following variable is a constant for initializing write_completion records }

  VAR
    normal_write_completion: [STATIC, READ, oss$job_paged_literal] tape_write_completion := [FALSE,
      no_write_error, $amt$tape_failure_modes []];

  VAR
    blank_tape_volume: [STATIC, READ, oss$job_paged_literal] rmt$volume_descriptor := [rmc$unspecified_vsn,
          rmc$unspecified_vsn];

?? PUSH (LISTEXT := ON) ??
?? TITLE := 'Procedure XREF decks', EJECT ??
*copyc amp$access_method
*copyc avp$configuration_administrator
*copyc avp$removable_media_operator
*copyc avp$system_displays
*copyc bap$await_tape_io_completion
*copyc bap$backspace_tape
*copyc bap$erase_tape
*copyc bap$get_tape_security_state_r1
*copyc bap$fetch_tape_capabilities
*copyc bap$fetch_tape_validation_r1
*copyc bap$forspace_tape
*copyc bap$get_tape_security_state_r1
*copyc bap$put_tape_security_state_r1
*copyc bap$read_tape
*copyc bap$rewind_tape
*copyc bap$store_tape_validation_r1
*copyc bap$write_tape
*copyc bap$write_tapemark
*copyc bap$validate_file_identifier
*copyc clp$convert_integer_to_string
*copyc clp$trimmed_string_size
*copyc cmp$get_element_name_via_lun
*copyc dmp$convert_sfid_to_lun
*copyc dmp$get_tape_volume_information
*copyc dmp$unload_remount_tape_volume
*copyc iop$backspace_tape_to_tapemark
*copyc iop$forspace_tape_to_tapemark
*copyc iop$get_position_of_tape_file
*copyc iop$locate_block
*copyc iop$tape_update_byte_counts
*copyc iop$update_block_count
*copyc ofp$format_operator_menu
*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter
*copyc osp$append_status_integer
*copyc mmp$advise_in
*copyc mmp$assign_pages
*copyc mme$condition_codes
*copyc mmp$check_if_pages_in_memory
*copyc mmp$create_segment
*copyc mmp$delete_segment
*copyc mmp$touch_all_pages
*copyc rmp$complete_tape_assignment
*copyc rmp$validate_tape_assignment
*copyc fmp$get_system_file_id
*copyc fmp$get_files_volume_info
*copyc jmp$get_job_attributes
*copyc i#move
?? TITLE := 'Type and Constant Declaration COPY decks', EJECT ??
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc oss$task_shared
*copyc amc$fap_request_codes
*copyc bac$max_tape_buffer_group_size
*copyc osc$processor_defined_registers
*copyc rmc$generic_error_recovery
*copyc rmc$loadpoint_error_recovery
*copyc rmc$write_error_recovery
*copyc osd$operating_system_exceptions
*copyc bae$tape_bm_error_codes
*copyc dme$tape_errors
*copyc ioe$tape_io_conditions
*copyc ofe$error_codes
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc amt$max_block_length
*copyc amt$skip_count
*copyc amt$skip_direction
*copyc amt$skip_unit
*copyc amt$tape_error_options
*copyc amt$tape_failure_modes
*copyc amt$tape_mark_count
*copyc amt$working_storage_length
*copyc bat$global_file_information
*copyc bat$tape_block
*copyc bat$tape_block_buffer_count
*copyc bat$tape_block_buffer_index
*copyc bat$tape_block_mgmt_descriptor
*copyc bat$tape_block_position
*copyc bat$tape_block_type
*copyc bat$tape_buffer_group_index
*copyc bat$tape_buffer_group_state
*copyc bat$tape_buffer_grp_descriptor
*copyc bat$tape_buffer_information
*copyc bat$tape_fatal_recovery_modes
*copyc bat$tape_io_direction
*copyc bat$tape_read_block_description
*copyc bat$tape_validation_state
*copyc cmt$element_name
*copyc iot$tape_block_id_area
*copyc iot$tape_position
*copyc mmt$rma_list
*copyc ost$caller_identifier
*copyc ost$page_size
*copyc ost$wait
*copyc osp$verify_system_privilege
*copyc cmv$logical_unit_table
*copyc dmv$initialize_tape_volume
*copyc osv$task_shared_heap
*copyc bai$tape_descriptor
?? POP ??
  VAR
    global_layer_number: [XREF] amt$fap_layer_number;


?? OLDTITLE ??
?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_advance_volume', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_advance_volume (
        file_id: amt$file_identifier;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      call_block: amt$call_block,
      caller_id: ost$caller_identifier,
      current_volume: amt$volume_number,
      current_vsns: rmt$volume_descriptor,
      density: rmt$density,
      file_instance: ^bat$task_file_entry,
      label_type: amt$label_type,
      number_of_volumes: amt$volume_number,
      requested_volume_attributes: iot$requested_volume_attributes,
      tape_descriptor: ^bat$tape_descriptor,
      terminate_tape_volume: amt$terminate_tape_volume,
      volume_info: array [1 .. 1] of fmt$volume_info,
      volume_overflow_allowed: boolean,
      write_completion: tape_write_completion,
      write_ring: rmt$write_ring;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];
    write_completion := normal_write_completion;

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_ADVANCE_VOLUME',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    tape_descriptor := bai$tape_descriptor (file_instance);

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_advance_volume', status);
      RETURN;
    IFEND;

    finish_all_outstanding_io (write_completion, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    iop$tape_update_byte_counts (bmd^.sfid, bmd^.max_block_length, status);

    bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
          end_of_tape_reflective_spot_hit;

    IF write_completion.error_type <> no_write_error THEN
      bmd^.fatal_write_error := TRUE;
      bmd^.fatal_write_failure_modes := write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Finishing I/O in bap$tape_bm_advance_volume', status);
      tape_failure_modes := write_completion.failure_modes;
      RETURN;
    IFEND;

  /advance_the_volume/
    BEGIN

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

      CASE bmd^.io_direction OF
      = bac$iod_reading, bac$iod_indeterminate =
        IF tape_descriptor^.volume_number < volume_info[1].number_of_volumes THEN
          validate_tape_assignment (file_id, file_instance, bmd^.sfid,
              tape_descriptor^.file_label_type, {initial_assignment = } FALSE,
              tape_descriptor^.volume_number + 1 , status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal (dmc$device_manager_ident, dme$volume_list_exhausted,
                ' ', status);
          RETURN;
        IFEND;
        { discard any data which has been read-ahead from the previous volume }
        reset_buffer_pointers;
      = bac$iod_writing =
        dmp$get_tape_volume_information (bmd^.sfid, number_of_volumes, current_volume, current_vsns,
              density, write_ring, requested_volume_attributes, volume_overflow_allowed, label_type,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        call_block.operation := amc$terminate_tape_volume;
        call_block.terminate_tape_volume := ^terminate_tape_volume;
        terminate_tape_volume.tape_density := density;
        terminate_tape_volume.terminating_volume_number := current_volume;
        terminate_tape_volume.terminating_volume := current_vsns;
        terminate_tape_volume.removable_media_location := requested_volume_attributes.
              removable_media_location;
        terminate_tape_volume.removable_media_group := requested_volume_attributes.
              removable_media_group;
        amp$access_method (file_id, call_block, global_layer_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF label_type <> amc$labelled THEN
          terminate_volume (write_completion, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR
                write_completion.end_of_tape_reflective_spot_hit;
          IF write_completion.error_type <> no_write_error THEN
            bmd^.fatal_write_error := TRUE;
            bmd^.fatal_write_failure_modes := write_completion.failure_modes;
            tape_failure_modes := write_completion.failure_modes;
            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
              'In bap$tape_bm_advance_volume', status);
            EXIT /advance_the_volume/;
          IFEND;
        IFEND;
        IF volume_overflow_allowed OR
            (tape_descriptor^.volume_number < volume_info[1].number_of_volumes) THEN
          validate_tape_assignment (file_id, file_instance, bmd^.sfid,
              tape_descriptor^.file_label_type, {initial_assignment = } FALSE,
              tape_descriptor^.volume_number + 1 , status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal (dmc$device_manager_ident, dme$volume_list_exhausted,
                ' ', status);
          RETURN;
        IFEND;
        bmd^.write_hit_end_of_tape_reflector := FALSE;
      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'illegal io_direction value in bap$tape_bm_advance_volume', status);
      CASEND;

    END /advance_the_volume/;

  PROCEND bap$tape_bm_advance_volume;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_align_position', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_align_position (file_id: amt$file_identifier;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_ALIGN_POSITION',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_align_position', status);
      RETURN;
    IFEND;

  /perform_align_position/
    BEGIN

      align_physical_logical_position (write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := write_completion.failure_modes;
        RETURN;
      IFEND;

      bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR
            write_completion.end_of_tape_reflective_spot_hit;

      IF write_completion.error_type <> no_write_error THEN
        bmd^.fatal_write_error := TRUE;
        bmd^.fatal_write_failure_modes := write_completion.failure_modes;
        osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
          'Fatal write error in bap$tape_bm_align_position', status);
        tape_failure_modes := write_completion.failure_modes;
        EXIT /perform_align_position/;
      IFEND;

      IF write_completion.end_of_tape_reflective_spot_hit THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
          'End of tape encountered in bap$tape_bm_align_position', status);
        EXIT /perform_align_position/;
      IFEND;

    END /perform_align_position/;

  PROCEND bap$tape_bm_align_position;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_close', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_close (file_id: amt$file_identifier;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      access_status: ost$status,
      caller_id: ost$caller_identifier,
      call_block: amt$call_block,
      current_volume: amt$volume_number,
      current_vsns: rmt$volume_descriptor,
      delete_segment_status: ost$status,
      density: rmt$density,
      file_instance: ^bat$task_file_entry,
      i: bat$tape_buffer_group_index,
      finish_status: ost$status,
      finish_write_completion: tape_write_completion,
      label_type: amt$label_type,
      number_of_volumes: amt$volume_number,
      requested_volume_attributes: iot$requested_volume_attributes,
      terminate_tape_volume: amt$terminate_tape_volume,
      terminate_write_completion: tape_write_completion,
      tape_descriptor: ^bat$tape_descriptor,
      terminate_volume_status: ost$status,
      volume_overflow_allowed: boolean,
      write_ring: rmt$write_ring;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    access_status.normal := TRUE;
    delete_segment_status.normal := TRUE;
    terminate_volume_status.normal := TRUE;
    finish_status.normal := TRUE;
    finish_write_completion := normal_write_completion;
    terminate_write_completion := normal_write_completion;

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_CLOSE',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    tape_descriptor := bai$tape_descriptor (file_instance);

    finish_all_outstanding_io (finish_write_completion, finish_status);

    IF bmd^.io_direction = bac$iod_writing THEN
      IF NOT bmd^.fatal_write_error THEN
        dmp$get_tape_volume_information (bmd^.sfid, number_of_volumes, current_volume, current_vsns,
              density, write_ring, requested_volume_attributes, volume_overflow_allowed, label_type,
              status);
        call_block.operation := amc$terminate_tape_volume;
        call_block.terminate_tape_volume := ^terminate_tape_volume;
        terminate_tape_volume.tape_density := density;
        terminate_tape_volume.terminating_volume_number := current_volume;
        terminate_tape_volume.terminating_volume := current_vsns;
        terminate_tape_volume.removable_media_location := requested_volume_attributes.
              removable_media_location;
        terminate_tape_volume.removable_media_group := requested_volume_attributes.
              removable_media_group;
        amp$access_method (file_id, call_block, global_layer_number, access_status);
        IF label_type <> amc$labelled THEN
          terminate_volume (terminate_write_completion, terminate_volume_status);
        IFEND;
      IFEND;
    IFEND;
    iop$tape_update_byte_counts (bmd^.sfid, bmd^.max_block_length, status);
    mmp$delete_segment (bmd^.buffer_segment, caller_id.ring, delete_segment_status);

    FREE bmd IN osv$task_shared_heap^;

    tape_descriptor^.block_management_descriptor := NIL;

    IF NOT access_status.normal THEN
      status := access_status;
    ELSEIF NOT terminate_volume_status.normal THEN
      IF (terminate_volume_status.condition = ioe$task_terminated_during_rec) THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
          'detected in bap$tape_bm_close', status);
      ELSE
        status := terminate_volume_status;
      IFEND;
    ELSEIF NOT delete_segment_status.normal THEN
      status := delete_segment_status;
    ELSEIF NOT finish_status.normal THEN
      IF (finish_status.condition = ioe$task_terminated_during_rec) THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
          'detected in bap$tape_bm_close', status);
      ELSE
        status := finish_status;
      IFEND;
    ELSEIF finish_write_completion.error_type <> no_write_error THEN
      tape_failure_modes := finish_write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'detected in bap$tape_bm_close', status);
    ELSEIF terminate_write_completion.error_type <> no_write_error THEN
      tape_failure_modes := terminate_write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
        'detected in bap$tape_bm_close', status);
    IFEND;

  PROCEND bap$tape_bm_close;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_erase_block', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_erase_block (file_id: amt$file_identifier;
        block_length: amt$max_block_length;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_ERASE_BLOCK', file_instance, bmd,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_erase_block', status);
      RETURN;
    IFEND;

    align_physical_logical_position (write_completion, status);
    IF NOT status.normal THEN
      tape_failure_modes := write_completion.failure_modes;
      RETURN;
    IFEND;

    bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
          end_of_tape_reflective_spot_hit;

    IF write_completion.error_type <> no_write_error THEN
      bmd^.fatal_write_error := TRUE;
      bmd^.fatal_write_failure_modes := write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Detected in bap$tape_bm_erase_block', status);
      tape_failure_modes := write_completion.failure_modes;
      RETURN;
    IFEND;

    IF write_completion.end_of_tape_reflective_spot_hit THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
        'bap$tape_bm_erase_block', status);
      RETURN;
    IFEND;

    bap$erase_tape (bmd^.sfid, block_length, {number_of_erases =} 0, bmd^.non_data_io_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR bmd^.non_data_io_status.
          end_of_tape;

    IF NOT bmd^.non_data_io_status.normal_completion THEN
      IF bmd^.non_data_io_status.completion_code = ioc$erase_limit_exceeded THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$cartridge_tape_erase_limit,
              'bap$tape_bm_erase_block', status);
      ELSEIF bmd^.non_data_io_status.completion_code = ioc$write_past_phys_eot THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
              'bap$tape_bm_erase_block', status);
        bmd^.io_direction := bac$iod_writing;
      ELSEIF bmd^.non_data_io_status.completion_code = ioc$no_write_ring THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring,
              'bap$tape_bm_erase_block', status);
      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$write_error_this_block, 'bap$tape_bm_erase_block',
              status);
        bmd^.io_direction := bac$iod_writing;
      IFEND;
    ELSE
      bmd^.io_direction := bac$iod_writing;
      IF bmd^.non_data_io_status.end_of_tape THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_completed,
          'bap$tape_bm_erase_block', status);
      IFEND;
    IFEND;

  PROCEND bap$tape_bm_erase_block;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_fetch_tables_ptr', EJECT ??
{  This procedure has been disabled.  It was initially created for debugging
{  and is not longer used.  The contents are retained if it is ever needed
{  in the future.
{
{ PROCEDURE [XDCL, #GATE] bap$tape_bm_fetch_tables_ptr (VAR segment: integer;
{   VAR offset: integer;
{   VAR status: ost$status);
{
{   status.normal := TRUE;
{
{   segment := #segment (bav$tape_bmd_saved_for_debug);
{   offset := #offset (bav$tape_bmd_saved_for_debug);
{
{ PROCEND bap$tape_bm_fetch_tables_ptr;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_flush', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_flush (file_id: amt$file_identifier;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_FLUSH',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_flush', status);
      RETURN;
    IFEND;

    IF bmd^.write_hit_end_of_tape_reflector THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
        'Outstanding EOT in bap$tape_bm_flush', status);
    IFEND;

    IF bmd^.io_direction = bac$iod_writing THEN

    /perform_flush/
      BEGIN

        align_physical_logical_position (write_completion, status);
        IF NOT status.normal THEN
          tape_failure_modes := write_completion.failure_modes;
          RETURN;
        IFEND;

        IF write_completion.error_type <> no_write_error THEN
          bmd^.fatal_write_error := TRUE;
          bmd^.fatal_write_failure_modes := write_completion.failure_modes;
          osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
            'Fatal write error in bap$tape_bm_flush', status);
          tape_failure_modes := write_completion.failure_modes;
          EXIT /perform_flush/;
        IFEND;

        IF write_completion.end_of_tape_reflective_spot_hit THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
            'End of tape encountered in bap$tape_bm_flush', status);
          EXIT /perform_flush/;
        IFEND;

      END /perform_flush/;

    IFEND;

  PROCEND bap$tape_bm_flush;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_read_label', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_read_label (file_id: amt$file_identifier;
        label_ptr: ^bat$tape_block;
        label_area_length: amt$max_block_length;
        system_media_recovery: boolean;
    VAR actual_block_length: amt$transfer_count;
    VAR volume_position: amt$volume_position;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    TYPE
      word_aligned_tape_block = record
        tape_block: ALIGNED [0 MOD 8] array [1 .. * ] of cell,
      recend;

    TYPE
      word_aligned_transfer_count = record
        tape_transfer_count: ALIGNED [0 MOD 8] iot$tape_transfer_count,
      recend;

    CONST
      read_buffer_length = 4128;

    VAR
      aligned_buffer: ^word_aligned_tape_block, { <-- must be aligned on a word boundary }
      aligned_transfer_count: ^word_aligned_transfer_count, { <-- must be aligned on a word boundary }
      attempt_close: boolean,
      attempt_recovery: boolean,
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      io_id: iot$io_id,
      read_description: iot$read_tape_description,
      transfer_count: amt$transfer_count;

    #caller_id (caller_id);
    status.normal := TRUE;
    actual_block_length := 0;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_READ_LABEL',
        file_instance, bmd,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF label_area_length < bac$max_ansi_label_length THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Insuffient label area length passed to bap$tape_bm_read_label', status);
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_read_label', status);
      RETURN;
    IFEND;

    { Read the label into a word aligned buffer. }

    PUSH aligned_buffer: [1 .. read_buffer_length];
    PUSH aligned_transfer_count;

    read_description [1].buffer_area := ^aligned_buffer^.tape_block;
    read_description [1].block_transfer_length := ^aligned_transfer_count^.tape_transfer_count;
    read_description [1].block_transfer_length^.length := 0;

/read_label_recovery/
    WHILE TRUE DO
      bap$read_tape (bmd^.sfid, read_buffer_length, ^read_description, {block_count=} 1,
            {system_media_recovery=} TRUE, io_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      bap$await_tape_io_completion (bmd^.sfid, io_id, bmd^.non_data_io_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF NOT bmd^.non_data_io_status.normal_completion THEN
        IF bmd^.non_data_io_status.completion_code = ioc$tapemark_read THEN
          status.normal := TRUE;
          volume_position := amc$after_tapemark;
        ELSE
          form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF bmd^.non_data_io_status.completion_code = ioc$not_capable_of_density THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$density_mismatch,
                  'Density mismatch in bap$tape_bm_read_label', status);
          ELSEIF bmd^.non_data_io_status.completion_code = ioc$read_past_phys_eot THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                  'Read past physical EOT in bap$tape_bm_read_label', status);
          ELSEIF bmd^.non_data_io_status.completion_code = ioc$blank_tape THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$read_error_this_block,
                  'Blank tape in bap$tape_bm_read_label', status);
          ELSEIF bmd^.non_data_io_status.completion_code = ioc$alert_condition_encountered THEN
            volume_position := amc$after_data_block;
            i#move (aligned_buffer, label_ptr, label_area_length);
          ELSE
            menu_tape_fatal_error_recovery (bac$tfrm_fatal_read, tape_failure_modes, attempt_recovery,
                  attempt_close, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF attempt_recovery THEN
              CYCLE /read_label_recovery/;
            IFEND;
            osp$set_status_abnormal (bac$basic_access_id, bae$read_error_this_block, 'bap$tape_bm_read_label',
                  status);
          IFEND;
          RETURN;
        IFEND;
      ELSE
        actual_block_length := read_description [1].block_transfer_length^.length;
        IF label_area_length < read_description [1].block_transfer_length^.length THEN
          transfer_count := label_area_length;
        ELSE
          transfer_count := read_description [1].block_transfer_length^.length;
        IFEND;
        volume_position := amc$after_data_block;
        i#move (aligned_buffer, label_ptr, transfer_count);
      IFEND;
      tape_failure_modes := $amt$tape_failure_modes [];
      RETURN;
    WHILEND /read_label_recovery/;

  PROCEND bap$tape_bm_read_label;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_open', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_open (file_id: amt$file_identifier;
        max_block_length: amt$max_block_length;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      tape_descriptor: ^bat$tape_descriptor,
      sfid: gft$system_file_identifier,
      write_ring,
      direct_io: boolean,
      i,
      buffer_group_count: bat$tape_buffer_group_index,
      j,
      buffer_group_size: integer,
      segment_attributes: array [1 .. 1] of mmt$attribute_descriptor,
      buffer_segment: mmt$segment_pointer,
      max_supported_block_length: amt$max_block_length,
      max_blocks_per_physical_call: iot$tape_block_count,
      rma_list_entries_required: integer,
      page_size: ost$page_size,
      job_attributes: ^jmt$job_attribute_results,
      bytes_used,
      unused_bytes_in_last_page: integer,
      buffer_allocation_size: integer,
      allocated_block_buffer: ^array [1 .. * ] of cell,
      buffer_group_space: ^array [1 .. bac$max_buffer_group_size] of cell,
      buffer_group_p: ^cell,
      unused_space: ^array [1 .. * ] of cell,
      volume_info: array [1 .. 1] of fmt$volume_info,
      ignore_status: ost$status;

    #caller_id (caller_id);
    status.normal := TRUE;

    validate_call (file_id, caller_id.ring, open_access, 'BAP$TAPE_BM_OPEN', file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    tape_descriptor := bai$tape_descriptor (file_instance);

    IF bmd <> NIL THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$multiple_open_of_tape,
        'multiple calls to bam$tape_bm_open', status);
      RETURN;
    IFEND;

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

    IF max_block_length > bav$max_allowed_tape_block_size THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$cannot_lock_tape_pages,
        'Max_block_length exceeds bav$max_allowed_tape_block_size.  Max value is', status);
      osp$append_status_integer (' ', bav$max_allowed_tape_block_size, 10, TRUE, status);
      RETURN;
    IFEND;

    page_size := 512 * (128 - #read_register (osc$pr_page_size_mask));

    { Keep MAXBL from being larger than the amount of memory we can sucessfully lock down. }
    rma_list_entries_required := ((max_block_length + page_size - 1) DIV page_size) + 1;
    IF rma_list_entries_required > (page_size DIV #SIZE (mmt$rma_list_entry)) THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$cannot_lock_tape_pages,
        'Max_block_length too large for page size in use.  Page size is', status);
      osp$append_status_integer (' ', page_size, 10, TRUE, status);
      RETURN;
    IFEND;

    { Prevent open when maxbl is within 20 pages of the job working set limit }
    PUSH job_attributes: [1..1];
    job_attributes^ [1].key := jmc$maximum_working_set;
    jmp$get_job_attributes (job_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (max_block_length DIV page_size) > (job_attributes^ [1].maximum_working_set - bac$reserved_pages)
          THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$maxbl_exceeds_ws_limit, '', status);
      RETURN;
    IFEND;

    IF NOT tape_descriptor^.initial_volume.assigned THEN
      validate_tape_assignment (file_id, file_instance, sfid,
          tape_descriptor^.file_label_type, {initial_assignment = } TRUE,
          {next_volume = } 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      tape_descriptor^.initial_volume.assigned := TRUE;
    IFEND;

    volume_info [1].key := fmc$write_ring;
    fmp$get_files_volume_info (file_instance^.local_file_name, volume_info, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    write_ring := volume_info [1].write_ring = rmc$write_ring;

    bap$fetch_tape_capabilities (sfid, max_supported_block_length, max_blocks_per_physical_call, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF max_block_length > max_supported_block_length THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_driver_not_capable, ' ', status);
      osp$append_status_integer (osc$status_parameter_delimiter, max_supported_block_length, 10, TRUE,
            status);
      RETURN;
    IFEND;

    IF (max_block_length > bav$max_indirect_tape_block) OR bav$force_direct_tape_io THEN
      direct_io := TRUE;
      buffer_group_count := 1;
      buffer_group_size := 1;
    ELSE
      direct_io := FALSE;
      buffer_group_size := bav$max_bytes_per_tape_io DIV max_block_length;
      buffer_group_count := ioc$max_multiple_tape_requests;
      IF buffer_group_size < 1 THEN
        buffer_group_size := 1;
      IFEND;
      IF buffer_group_size > max_blocks_per_physical_call THEN
        buffer_group_size := max_blocks_per_physical_call;
      IFEND;
    IFEND;

    ALLOCATE bmd IN osv$task_shared_heap^;
    bav$tape_bmd_saved_for_debug := bmd;

    segment_attributes [1].keyword := mmc$kw_segment_access_control;
    segment_attributes [1].access_control.cache_bypass := TRUE;
    segment_attributes [1].access_control.execute_privilege := osc$non_executable;
    segment_attributes [1].access_control.read_privilege := osc$read_uncontrolled;
    segment_attributes [1].access_control.write_privilege := osc$write_uncontrolled;
    mmp$create_segment (^segment_attributes, mmc$sequence_pointer, caller_id.ring, buffer_segment, status);
    IF NOT status.normal THEN
      FREE bmd IN osv$task_shared_heap^;
      RETURN;
    IFEND;

    bmd^.io_direction := bac$iod_indeterminate;
    bmd^.sfid := sfid;
    bmd^.tape_has_write_ring := write_ring;
    bmd^.fatal_write_error := FALSE;
    bmd^.fatal_write_failure_modes := $amt$tape_failure_modes [];
    bmd^.write_hit_end_of_tape_reflector := FALSE;
    bmd^.direct_io := direct_io;
    bmd^.inhibit_read_ahead := FALSE;
    bmd^.max_block_length := max_block_length;
    bmd^.max_blocks_per_physical_call := max_blocks_per_physical_call;
    bmd^.buffer_segment := buffer_segment;
    bmd^.buffer_groups_in_use := buffer_group_count;
    bmd^.buffer_group_size := buffer_group_size;

  /allocate_buffer_groups/
    FOR i := 1 TO buffer_group_count DO
      NEXT buffer_group_space IN buffer_segment.seq_pointer;
      buffer_group_p := buffer_group_space;
      bmd^.buffer_group [i] := buffer_group_p;
      bmd^.buffer_group [i]^.group_state := bac$group_empty;
    FOREND /allocate_buffer_groups/;

    bytes_used := buffer_group_count * bac$max_buffer_group_size;
    unused_bytes_in_last_page := page_size - ((bytes_used - 1) MOD page_size) - 1;
    IF unused_bytes_in_last_page > 0 THEN
      NEXT unused_space: [1 .. unused_bytes_in_last_page] IN buffer_segment.seq_pointer;
    IFEND;

    buffer_allocation_size := ((max_block_length + 7) DIV 8) * 8; { Round up to an even word }

  /initialize_buffer_groups/
    FOR i := 1 TO buffer_group_count DO

    /allocate_block_buffers/
      FOR j := 1 TO buffer_group_size DO
        NEXT allocated_block_buffer: [1 .. buffer_allocation_size] IN buffer_segment.seq_pointer;
        bmd^.buffer_group [i]^.block_buffer [j].block_buffer := allocated_block_buffer;
        bmd^.buffer_group [i]^.read_description [j].buffer_area := allocated_block_buffer;
        bmd^.buffer_group [i]^.read_description [j].block_transfer_length := ^bmd^.buffer_group [i]^.
              block_buffer [j].block_length;
        bmd^.buffer_group [i]^.write_description [j].buffer_area := allocated_block_buffer;
        bmd^.buffer_group [i]^.write_description [j].transfer_length := 0;
      FOREND /allocate_block_buffers/;

      bytes_used := buffer_group_size * buffer_allocation_size;
      unused_bytes_in_last_page := page_size - ((bytes_used - 1) MOD page_size) - 1;
      IF unused_bytes_in_last_page > 0 THEN
        NEXT unused_space: [1 .. unused_bytes_in_last_page] IN buffer_segment.seq_pointer;
      IFEND;

    FOREND /initialize_buffer_groups/;
    reset_buffer_pointers;

    { All set up -- mark file as open (as far as block mangement is concerned) }

    IF tape_descriptor^.block_management_descriptor = NIL THEN
      tape_descriptor^.block_management_descriptor := bmd;
    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Attempt to overstore the block management descriptor pointer', status);
    IFEND;

  PROCEND bap$tape_bm_open;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_read_next_block', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_read_next_block (file_id: amt$file_identifier;
        operation: amt$fap_operation;
        volunteered_buffer_area: ^bat$tape_block;
        volunteered_buffer_length: amt$working_storage_length;
        system_media_recovery: boolean;
    VAR block_ptr: ^bat$tape_block;
    VAR block_type: bat$tape_block_type;
    VAR block_length: amt$max_block_length;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      ignore_write_completion: tape_write_completion,
      buffer_information: ^bat$tape_buffer_information,
      direct_io_length_to_read: amt$working_storage_length,
      byte_to_write_into_buffer: [STATIC, oss$job_paged_literal, READ] 0 .. 0ff(16) := 0;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    IF (operation = amc$get_label_req) OR (operation = amc$skip_req) THEN
      validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_READ_NEXT_BLOCK',
            file_instance, bmd, status);
    ELSE
      validate_call (file_id, caller_id.ring, read_access, 'BAP$TAPE_BM_READ_NEXT_BLOCK', file_instance, bmd,
            status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_writing THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$input_after_output,
        'Call to bap$tape_bm_read while writing tape', status);
      RETURN;
    IFEND;

    bmd^.io_direction := bac$iod_reading;
    bmd^.system_media_recovery := system_media_recovery;

/perform_read/
    BEGIN

      IF bmd^.direct_io THEN

      /direct_io_read_recovery_loop/
        WHILE TRUE DO
          IF bmd^.buffer_group [1]^.group_state = bac$group_empty THEN
            { Ensure buffer is aligned so that the Peripheral Processor can address it }
            IF (volunteered_buffer_area <> NIL) AND ((#OFFSET (volunteered_buffer_area) MOD 8) = 0) AND
                  ((volunteered_buffer_length MOD 8) = 0) THEN
              block_ptr := volunteered_buffer_area;
              IF volunteered_buffer_length <= bmd^.max_block_length THEN
                direct_io_length_to_read := volunteered_buffer_length;
              ELSE
                direct_io_length_to_read := bmd^.max_block_length;
              IFEND;
              { write into the buffer to ensure that ring attributes allow writing }
              i#move (^byte_to_write_into_buffer, block_ptr, 1);
              i#move (^byte_to_write_into_buffer, ^block_ptr^ [direct_io_length_to_read], 1);
              initiate_read (1, block_ptr, direct_io_length_to_read, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            ELSE
              block_ptr := bmd^.buffer_group [1]^.block_buffer [1].block_buffer;
              initiate_read (1, block_ptr, bmd^.max_block_length, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
          ELSE { data already buffered from tapemark check }
            block_ptr := bmd^.buffer_group [1]^.block_buffer [1].block_buffer;
          IFEND;
          await_data_io_completion (bmd^.logical_position, ignore_write_completion, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          bmd^.buffer_group [1]^.group_state := bac$group_empty;
          buffer_information := ^bmd^.buffer_group [1]^.block_buffer [1];
          IF (buffer_information^.block_type <> bac$good_data_block) AND {}
                (buffer_information^.block_type <> bac$tapemark) AND (system_media_recovery) AND
                (buffer_information^.attempt_recovery) THEN
            CYCLE /direct_io_read_recovery_loop/
          ELSE
            tape_failure_modes := $amt$tape_failure_modes [];
            EXIT /direct_io_read_recovery_loop/;
          IFEND;
        WHILEND /direct_io_read_recovery_loop/;

      ELSE { normal, buffered I/O }

      /buffered_io_read_recovery_loop/
        WHILE TRUE DO
          advance_read_position (buffer_information, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF (buffer_information^.block_type <> bac$good_data_block) AND {}
                (buffer_information^.block_type <> bac$tapemark) AND system_media_recovery THEN

            IF (NOT buffer_information^.system_media_recovery_used) AND
                  (amc$tfm_data_parity_error IN buffer_information^.failure_modes) THEN

{ Force a re-read of the block if User Recovery for this block.

              reposition_back_one_block (tape_failure_modes, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              CYCLE /buffered_io_read_recovery_loop/;

            ELSEIF (buffer_information^.system_media_recovery_used) AND
                   (buffer_information^.attempt_recovery) THEN

{ Attempt recovery if operator chose that option.

              CYCLE /buffered_io_read_recovery_loop/;

            IFEND;

            EXIT /buffered_io_read_recovery_loop/;

          IFEND;

          EXIT /buffered_io_read_recovery_loop/;

        WHILEND /buffered_io_read_recovery_loop/;

        block_ptr := buffer_information^.block_buffer;

      IFEND;

      block_type := buffer_information^.block_type;
      CASE block_type OF
      = bac$good_data_block =
        block_length := buffer_information^.block_length.length;
        tape_failure_modes := $amt$tape_failure_modes [];
      = bac$error_data_block =
        block_length := buffer_information^.block_length.length;
        tape_failure_modes := buffer_information^.failure_modes;
      = bac$error_without_data, bac$density_mismatch, bac$read_past_phys_eot =
        tape_failure_modes := buffer_information^.failure_modes;
        block_ptr := NIL;
      = bac$tapemark =
        tape_failure_modes := $amt$tape_failure_modes [];
        block_ptr := NIL;
      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
              'Illegal block type in bap$tape_bm_read_next_block', status);
        RETURN;
      CASEND;

      IF buffer_information^.block_truncated THEN
        IF buffer_information^.block_length.length < bmd^.max_block_length THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$block_truncated,
            'block truncated in bam$tape_bm_read_next_block', status);
        ELSE
          osp$set_status_abnormal (bac$basic_access_id, bae$block_larger_than_maxbl,
            'block exceeds MAXBL in bam$tape_bm_read_next_block', status);
        IFEND;
      IFEND;

    END /perform_read/;

  PROCEND bap$tape_bm_read_next_block;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_read_to_write', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_read_to_write (file_id: amt$file_identifier;
        read_block_buffer: ^bat$tape_block;
    VAR write_block_buffer: ^bat$tape_block;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      ignore_write_completion: tape_write_completion,
      position: bat$tape_block_position;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];
    write_block_buffer := NIL;

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_READ_TO_WRITE',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.buffer_reserved THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Write_buffer_reserved in bap$tape_bm_read_to_write', status);
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_reading THEN

{   Save block_position of last block taken by FAP.

      IF NOT bmd^.direct_io THEN
        IF (bmd^.logical_position.buffer_index = 1) THEN
          IF bmd^.logical_position.buffer_group = 1 THEN
            form_tape_block_position (position, bmd^.buffer_groups_in_use,
                  bmd^.buffer_group_size);
          ELSE
            form_tape_block_position (position, bmd^.logical_position.buffer_group - 1,
                  bmd^.buffer_group_size);
          IFEND;
        ELSE
          form_tape_block_position (position, bmd^.logical_position.buffer_group,
                bmd^.logical_position.buffer_index - 1);
        IFEND;
      ELSE
        form_tape_block_position (position, 1, 1);
      IFEND;

      IF bmd^.buffer_group [position.buffer_group]^.block_buffer [position.
            buffer_index].block_type <> bac$good_data_block THEN
        RETURN;
      IFEND;

      align_physical_logical_position (ignore_write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := ignore_write_completion.failure_modes;
        RETURN;
      IFEND;
      reset_buffer_pointers;
    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'bap$tape_bm_read_to_write called and io direction is not read', status);
      RETURN;
    IFEND;

    bap$backspace_tape (bmd^.sfid, 1, {use_locate_block} FALSE, bmd^.non_data_io_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT bmd^.non_data_io_status.normal_completion THEN
      form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
            'bam$tape_block_manager_ring3 - bap$tape_bm_read_to_write', status);
      RETURN;
    IFEND;

    IF bmd^.direct_io THEN
      IF (read_block_buffer <> bmd^.buffer_group [1]^.block_buffer [1].block_buffer) THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
              'Invalid read_block_buffer for direct io in bap$tape_bm_read_to_write', status);
        RETURN;
      IFEND;
      write_block_buffer := read_block_buffer;

    ELSE {buffered I/O}

{   Verify last read buffer address

      IF (read_block_buffer <> bmd^.buffer_group [position.buffer_group]^.
            block_buffer [position.buffer_index].block_buffer) THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
              'Incorrect read_block_buffer in bap$tape_bm_read_to_write', status);
        RETURN;
      IFEND;

      write_block_buffer := bmd^.buffer_group [bmd^.logical_position.buffer_group]^.
            block_buffer [bmd^.logical_position.buffer_index].block_buffer;

      IF NOT (read_block_buffer = write_block_buffer) THEN
        i#move (read_block_buffer, write_block_buffer, bmd^.buffer_group [position.
              buffer_group]^.block_buffer [position.buffer_index].block_length.length);
      IFEND;

    IFEND;

    bmd^.io_direction := bac$iod_writing;

    bmd^.buffer_reserved := TRUE;

  PROCEND bap$tape_bm_read_to_write;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_reserve_blk_buffer', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_reserve_blk_buffer (file_id: amt$file_identifier;
    VAR block_buffer_ptr: ^bat$tape_block;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      ignore_write_completion: tape_write_completion,
      reserved_position: bat$tape_block_position,
      write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_RESERVE_BLK_BUFFER',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_reserve_blk_buffer', status);
      RETURN;
    IFEND;

    IF bmd^.buffer_reserved THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$too_many_reserved_buffers, ' ', status);
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_reading THEN
      align_physical_logical_position (ignore_write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := ignore_write_completion.failure_modes;
        RETURN;
      IFEND;
      reset_buffer_pointers;
    IFEND;
    bmd^.io_direction := bac$iod_writing;

    ensure_write_buffer_available (write_completion, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
          end_of_tape_reflective_spot_hit;

    IF write_completion.error_type <> no_write_error THEN
      bmd^.fatal_write_error := TRUE;
      bmd^.fatal_write_failure_modes := write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Write error in bap$tape_bm_reserve_block_buffer', status);
      tape_failure_modes := write_completion.failure_modes;
      RETURN;
    IFEND;
    IF write_completion.end_of_tape_reflective_spot_hit THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
        'End of tape in bap$tape_bm_reserve_block_buffer', status);
      RETURN;
    IFEND;

    block_buffer_ptr := bmd^.buffer_group [bmd^.logical_position.buffer_group]^.block_buffer [bmd^.
          logical_position.buffer_index].block_buffer;

    bmd^.buffer_reserved := TRUE;

  PROCEND bap$tape_bm_reserve_blk_buffer;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_rewind', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_rewind (file_id: amt$file_identifier;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      caller_id: ost$caller_identifier,
      call_block: amt$call_block,
      current_volume: amt$volume_number,
      current_vsns: rmt$volume_descriptor,
      density: rmt$density,
      file_instance: ^bat$task_file_entry,
      label_type: amt$label_type,
      number_of_volumes: amt$volume_number,
      requested_volume_attributes: iot$requested_volume_attributes,
      tape_descriptor: ^bat$tape_descriptor,
      terminate_tape_volume: amt$terminate_tape_volume,
      write_completion: tape_write_completion,
      write_ring: rmt$write_ring,
      volume_overflow_allowed: boolean,
      ignore_write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_REWIND', file_instance,
          bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    tape_descriptor := bai$tape_descriptor (file_instance);

  /rewind_tape/
    BEGIN

      IF bmd^.io_direction = bac$iod_writing THEN
        IF NOT bmd^.fatal_write_error THEN
          align_physical_logical_position (write_completion, status);
          IF NOT status.normal THEN
            tape_failure_modes := write_completion.failure_modes;
            RETURN;
          IFEND;
          bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
                end_of_tape_reflective_spot_hit;
          IF write_completion.error_type <> no_write_error THEN
            bmd^.fatal_write_error := TRUE;
            bmd^.fatal_write_failure_modes := write_completion.failure_modes;
            osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
              'Fatal write error in bap$tape_bm_rewind', status);
            tape_failure_modes := write_completion.failure_modes;
            EXIT /rewind_tape/;
          IFEND;
          IF write_completion.end_of_tape_reflective_spot_hit THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
              'End of reel in BAP$TAPE_BM_REWIND', status);
            EXIT /rewind_tape/;
          IFEND;
          dmp$get_tape_volume_information (bmd^.sfid, number_of_volumes, current_volume, current_vsns,
                density, write_ring, requested_volume_attributes, volume_overflow_allowed, label_type,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          call_block.operation := amc$terminate_tape_volume;
          call_block.terminate_tape_volume := ^terminate_tape_volume;
          terminate_tape_volume.tape_density := density;
          terminate_tape_volume.terminating_volume_number := current_volume;
          terminate_tape_volume.terminating_volume := current_vsns;
          terminate_tape_volume.removable_media_location := requested_volume_attributes.
                removable_media_location;
          terminate_tape_volume.removable_media_group := requested_volume_attributes.
                removable_media_group;
          amp$access_method (file_id, call_block, global_layer_number, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF label_type <> amc$labelled THEN
            terminate_volume (write_completion, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF write_completion.error_type <> no_write_error THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                'In bap$tape_bm_rewind', status);
              bmd^.fatal_write_error := TRUE;
              bmd^.fatal_write_failure_modes := write_completion.failure_modes;
              tape_failure_modes := write_completion.failure_modes;
              EXIT /rewind_tape/;
            IFEND;
          IFEND;
        IFEND; { fatal write error }
        bmd^.fatal_write_error := FALSE;
        bmd^.write_hit_end_of_tape_reflector := FALSE;
      ELSE { reading or indeterminate I/O    direction }
        finish_all_outstanding_io (ignore_write_completion, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

{ Do not issue rewind if volume_number is not 1.  This is done since the
{ tape is going to be unloaded anyway when dmp$reset_tape_volume is called.

      IF tape_descriptor^.volume_number = 1 THEN

      /fatal_rewind_loop/
        WHILE TRUE DO
          bap$rewind_tape (bmd^.sfid, bmd^.non_data_io_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF NOT bmd^.non_data_io_status.normal_completion THEN
            form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            menu_tape_fatal_error_recovery (bac$tfrm_fatal_rewind, tape_failure_modes,
                  attempt_recovery, attempt_close, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

{ Cycle to retry rewind if operator chose response of 1 (attempt_recovery).

            IF attempt_recovery THEN
              CYCLE /fatal_rewind_loop/;
            IFEND;

            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                  'Uncertain tape position in bap$tape_bm_rewind', status);
            EXIT /rewind_tape/;
          IFEND;
          tape_failure_modes := $amt$tape_failure_modes [];
          EXIT /fatal_rewind_loop/;
        WHILEND /fatal_rewind_loop/;

      IFEND;

      IF tape_descriptor^.volume_number > 1 THEN
        iop$tape_update_byte_counts (bmd^.sfid, bmd^.max_block_length, status);
        validate_tape_assignment (file_id, file_instance, bmd^.sfid,
            tape_descriptor^.file_label_type, {initial_assignment = } FALSE,
            {next_volume = } 1, status);
        IF NOT status.normal THEN
          IF (status.condition = dme$operator_stop) OR (status.condition = dme$termination_condition) THEN
            tape_descriptor^.volume_number := 1;
            tape_descriptor^.initial_volume.assigned := FALSE;
          IFEND;
          RETURN;
        IFEND;
      IFEND;

      reset_buffer_pointers;

      bmd^.io_direction := bac$iod_indeterminate;

    END /rewind_tape/;

  PROCEND bap$tape_bm_rewind;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_skip_blocks', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_skip_blocks (file_id: amt$file_identifier;
        direction: amt$skip_direction;
        count: amt$skip_count;
    VAR residual_skip_count: amt$skip_count;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      block_found: boolean,
      buffer_information: ^bat$tape_buffer_information,
      blocks_in_this_skip: amt$skip_count,
      blocks_remaining_to_skip: amt$skip_count,
      caller_id: ost$caller_identifier,
      call_block: amt$call_block,
      current_volume: amt$volume_number,
      current_vsns: rmt$volume_descriptor,
      density: rmt$density,
      file_instance: ^bat$task_file_entry,
      label_type: amt$label_type,
      number_of_volumes: amt$volume_number,
      requested_volume_attributes: iot$requested_volume_attributes,
      terminate_tape_volume: amt$terminate_tape_volume,
      volume_overflow_allowed: boolean,
      write_completion: tape_write_completion,
      write_ring: rmt$write_ring;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_SKIP_BLOCKS',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    blocks_remaining_to_skip := count;

    CASE direction OF
    = amc$forward =

    /skip_forward/
      BEGIN
        IF count > 0 THEN
          IF bmd^.io_direction = bac$iod_writing THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$input_after_output,
              'Skip forward after write in bap$tape_bm_skip_blocks', status);
            RETURN;
          IFEND;
          bmd^.io_direction := bac$iod_reading;
          find_buffered_read_data_block (block_found, buffer_information, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        /consume_buffered_data/
          WHILE block_found DO
            IF buffer_information^.block_type = bac$tapemark THEN
              EXIT /skip_forward/;
            IFEND;
            blocks_remaining_to_skip := blocks_remaining_to_skip - 1;
            IF blocks_remaining_to_skip = 0 THEN
              EXIT /skip_forward/;
            IFEND;
            find_buffered_read_data_block (block_found, buffer_information, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          WHILEND /consume_buffered_data/;
          reset_buffer_pointers;

        /skip_remaining_blocks/
          WHILE blocks_remaining_to_skip > 0 DO
            IF blocks_remaining_to_skip <= bmd^.max_blocks_per_physical_call THEN
              blocks_in_this_skip := blocks_remaining_to_skip;
            ELSE
              blocks_in_this_skip := bmd^.max_blocks_per_physical_call;
            IFEND;
            bap$forspace_tape (bmd^.sfid, blocks_in_this_skip, bmd^.non_data_io_status, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF bmd^.non_data_io_status.normal_completion THEN
              blocks_remaining_to_skip := blocks_remaining_to_skip - blocks_in_this_skip;
            ELSE
              blocks_remaining_to_skip := blocks_remaining_to_skip - (blocks_in_this_skip - bmd^.
                    non_data_io_status.residual_block_count);
              IF bmd^.non_data_io_status.completion_code = ioc$tapemark_read THEN
                EXIT /skip_remaining_blocks/;
              ELSE
                form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                IF bmd^.non_data_io_status.completion_code = ioc$not_capable_of_density THEN
                  osp$set_status_abnormal (bac$basic_access_id, bae$density_mismatch,
                    'Density mismatch in bap$tape_bm_skip_blocks', status);
                ELSEIF bmd^.non_data_io_status.completion_code = ioc$read_past_phys_eot THEN
                  osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                        'Read past physical EOT in bap$tape_bm_skip_blocks', status);
                ELSEIF bmd^.non_data_io_status.completion_code = ioc$blank_tape THEN
                  osp$set_status_abnormal (bac$basic_access_id, bae$read_error_this_block,
                        'Blank tape in bap$tape_bm_skip_blocks', status);
                ELSE
                  menu_tape_fatal_error_recovery (bac$tfrm_fatal_read, tape_failure_modes, attempt_recovery,
                        attempt_close, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;
                  IF attempt_recovery THEN
                    CYCLE /skip_remaining_blocks/;
                  IFEND;
                  osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                    'Bad tape status in bap$tape_bm_skip_blocks', status);
                IFEND;
                EXIT /skip_remaining_blocks/;
              IFEND;
            IFEND;
          WHILEND /skip_remaining_blocks/;
        IFEND;
      END /skip_forward/;

    = amc$backward =

    /skip_backward/
      BEGIN
        IF NOT bmd^.fatal_write_error THEN
          align_physical_logical_position (write_completion, status);
          IF NOT status.normal THEN
            tape_failure_modes := write_completion.failure_modes;
            RETURN;
          IFEND;
          bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
                end_of_tape_reflective_spot_hit;
          IF write_completion.error_type <> no_write_error THEN
            bmd^.fatal_write_error := TRUE;
            bmd^.fatal_write_failure_modes := write_completion.failure_modes;
            osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
              'Fatal write error in bap$tape_bm_skip_blocks   (backward)', status);
            tape_failure_modes := write_completion.failure_modes;
            EXIT /skip_backward/;
          IFEND;
          IF write_completion.end_of_tape_reflective_spot_hit THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
              'End of reel in bap$tape_bm_skip_blocks   (backward)', status);
            EXIT /skip_backward/;
          IFEND;
          IF bmd^.io_direction = bac$iod_writing THEN
            dmp$get_tape_volume_information (bmd^.sfid, number_of_volumes, current_volume, current_vsns,
                  density, write_ring, requested_volume_attributes, volume_overflow_allowed, label_type,
                  status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            call_block.operation := amc$terminate_tape_volume;
            call_block.terminate_tape_volume := ^terminate_tape_volume;
            terminate_tape_volume.tape_density := density;
            terminate_tape_volume.terminating_volume_number := current_volume;
            terminate_tape_volume.terminating_volume := current_vsns;
            terminate_tape_volume.removable_media_location := requested_volume_attributes.
                  removable_media_location;
            terminate_tape_volume.removable_media_group := requested_volume_attributes.
                  removable_media_group;
            amp$access_method (file_id, call_block, global_layer_number, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF label_type <> amc$labelled THEN
              terminate_volume (write_completion, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF write_completion.error_type <> no_write_error THEN
                osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                  'Position uncertain in bap$tape_bm_skip_blocks   (backwards)', status);
                bmd^.fatal_write_error := TRUE;
                bmd^.fatal_write_failure_modes := write_completion.failure_modes;
                tape_failure_modes := write_completion.failure_modes;
                EXIT /skip_backward/;
              IFEND;
            IFEND;
          IFEND;
        IFEND;

        bmd^.fatal_write_error := FALSE;
        bmd^.write_hit_end_of_tape_reflector := FALSE;
        bmd^.io_direction := bac$iod_indeterminate;
        reset_buffer_pointers;

      /backspace_the_tape/
        WHILE blocks_remaining_to_skip > 0 DO
          IF blocks_remaining_to_skip <= bmd^.max_blocks_per_physical_call THEN
            blocks_in_this_skip := blocks_remaining_to_skip;
          ELSE
            blocks_in_this_skip := bmd^.max_blocks_per_physical_call;
          IFEND;
          bap$backspace_tape (bmd^.sfid, blocks_in_this_skip, {use_locate_block} FALSE,
                bmd^.non_data_io_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF bmd^.non_data_io_status.normal_completion THEN
            blocks_remaining_to_skip := blocks_remaining_to_skip - blocks_in_this_skip;
          ELSE
            IF bmd^.non_data_io_status.completion_code = ioc$tapemark_read THEN
              blocks_remaining_to_skip := blocks_remaining_to_skip - (blocks_in_this_skip - bmd^.
                    non_data_io_status.residual_block_count);
              tape_failure_modes := $amt$tape_failure_modes [];
              EXIT /backspace_the_tape/;
            ELSEIF (bmd^.non_data_io_status.completion_code = ioc$load_point) OR
            {} (bmd^.non_data_io_status.completion_code = ioc$load_point_block_count_ne_0) THEN
              blocks_remaining_to_skip := blocks_remaining_to_skip - (blocks_in_this_skip - bmd^.
                    non_data_io_status.residual_block_count);
              osp$set_status_abnormal (bac$basic_access_id, bae$skip_encountered_bov,
                'Skip hit BOV in bap$tape_bm_skip_blocks', status);
              tape_failure_modes := $amt$tape_failure_modes [];
              EXIT /skip_backward/;
            ELSE
              form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                'Bad tape status in bap$tape_bm_skip_blocks', status);
              RETURN;
            IFEND;
          IFEND;
        WHILEND /backspace_the_tape/;
      END /skip_backward/;
    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'illegal skip direction in bap$tape_bm_skip_blocks', status);
      RETURN;
    CASEND;

    residual_skip_count := blocks_remaining_to_skip;

  PROCEND bap$tape_bm_skip_blocks;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_skip_label_mark', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_skip_label_mark (file_id: amt$file_identifier;
        direction: amt$skip_direction;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_SKIP_LABEL_MARK',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE direction OF
    = amc$forward =

    /fatal_forspace_to_tapemark/
      WHILE TRUE DO
        iop$forspace_tape_to_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF NOT bmd^.non_data_io_status.normal_completion THEN
          form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF bmd^.non_data_io_status.completion_code = ioc$not_capable_of_density THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$density_mismatch,
                  'Density mismatch in bap$tape_bm_skip_label_mark', status);
          ELSEIF bmd^.non_data_io_status.completion_code = ioc$read_past_phys_eot THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                  'Read past physical EOT in bap$tape_bm_skip_label_mark', status);
          ELSEIF bmd^.non_data_io_status.completion_code = ioc$blank_tape THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                  'Blank tape in bap$tape_bm_skip_label_mark', status);
          ELSE
            menu_tape_fatal_error_recovery (bac$tfrm_fatal_read, tape_failure_modes,
                  attempt_recovery, attempt_close, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

{ Cycle to continue skipping to tapemark if operator chooses attempt_recovery option.

            IF attempt_recovery THEN
              CYCLE /fatal_forspace_to_tapemark/;
            IFEND;
            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                'Bad tape status in bap$tape_bm_skip_label_mark (forward)', status);
          IFEND;
            RETURN;
        IFEND;

        tape_failure_modes := $amt$tape_failure_modes [];
        EXIT /fatal_forspace_to_tapemark/;

      WHILEND /fatal_forspace_to_tapemark/;

    = amc$backward =

    /skip_backward/
      BEGIN
        iop$backspace_tape_to_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF NOT bmd^.non_data_io_status.normal_completion THEN
          IF (bmd^.non_data_io_status.completion_code = ioc$load_point) OR
          {} (bmd^.non_data_io_status.completion_code = ioc$load_point_block_count_ne_0) THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$skip_encountered_bov,
              'Skip hit BOV in bap$tape_bm_skip_label_mark', status);
            tape_failure_modes := $amt$tape_failure_modes [];
            EXIT /skip_backward/;
          ELSE
            form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
              'Bad tape status in bap$tape_bm_skip_label_mark', status);
            RETURN;
          IFEND;
        IFEND;
      END /skip_backward/;

    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'illegal skip direction in bap$tape_bm_skip_label_mark', status);
    CASEND;

  PROCEND bap$tape_bm_skip_label_mark;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_skip_tapemark', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_skip_tapemark (file_id: amt$file_identifier;
        direction: amt$skip_direction;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      block_found: boolean,
      buffer_information: ^bat$tape_buffer_information,
      caller_id: ost$caller_identifier,
      call_block: amt$call_block,
      current_vsns: rmt$volume_descriptor,
      current_volume: amt$volume_number,
      density: rmt$density,
      file_instance: ^bat$task_file_entry,
      label_type: amt$label_type,
      number_of_volumes: amt$volume_number,
      requested_volume_attributes: iot$requested_volume_attributes,
      terminate_tape_volume: amt$terminate_tape_volume,
      volume_overflow_allowed: boolean,
      write_completion: tape_write_completion,
      write_ring: rmt$write_ring;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_SKIP_TAPEMARK',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE direction OF
    = amc$forward =

    /skip_forward/
      BEGIN
        IF bmd^.io_direction = bac$iod_writing THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$input_after_output,
            'Skip forward after write in bap$tape_bm_skip_tapemark', status);
          RETURN;
        IFEND;
        bmd^.io_direction := bac$iod_reading;
        find_buffered_read_data_block (block_found, buffer_information, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      /consume_buffered_data/
        WHILE block_found DO
          IF buffer_information^.block_type = bac$tapemark THEN
            EXIT /skip_forward/;
          IFEND;
          find_buffered_read_data_block (block_found, buffer_information, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        WHILEND /consume_buffered_data/;
        reset_buffer_pointers;

      /fatal_forspace_to_tapemark/
        WHILE TRUE DO
          iop$forspace_tape_to_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF NOT bmd^.non_data_io_status.normal_completion THEN
            form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF bmd^.non_data_io_status.completion_code = ioc$not_capable_of_density THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$density_mismatch,
                    'Density mismatch in bap$tape_bm_skip_tapemark', status);
            ELSEIF bmd^.non_data_io_status.completion_code = ioc$read_past_phys_eot THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                    'Read past physical EOT in bap$tape_bm_skip_tapemark', status);
            ELSEIF bmd^.non_data_io_status.completion_code = ioc$blank_tape THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                    'Blank tape in bap$tape_bm_skip_tapemark', status);
            ELSE
              menu_tape_fatal_error_recovery (bac$tfrm_fatal_read, tape_failure_modes,
                    attempt_recovery, attempt_close, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

{ Cycle to continue skipping to tapemark if operator chooses attempt_recovery option.

              IF attempt_recovery THEN
                CYCLE /fatal_forspace_to_tapemark/;
              IFEND;
              osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                  'Bad tape status in bap$tape_bm_skip_tapemark (forward)', status);
            IFEND;
            RETURN;
          IFEND;

          tape_failure_modes := $amt$tape_failure_modes [];
          EXIT /fatal_forspace_to_tapemark/;

        WHILEND /fatal_forspace_to_tapemark/;
      END /skip_forward/;

    = amc$backward =

    /skip_backward/
      BEGIN
        IF NOT bmd^.fatal_write_error THEN
          align_physical_logical_position (write_completion, status);
          IF NOT status.normal THEN
            tape_failure_modes := write_completion.failure_modes;
            RETURN;
          IFEND;
          bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
                end_of_tape_reflective_spot_hit;
          IF write_completion.error_type <> no_write_error THEN
            bmd^.fatal_write_error := TRUE;
            bmd^.fatal_write_failure_modes := write_completion.failure_modes;
            osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
              'Fatal write error in bap$tape_bm_skip_tapemark (backward)', status);
            tape_failure_modes := write_completion.failure_modes;
            EXIT /skip_backward/;
          IFEND;
          IF write_completion.end_of_tape_reflective_spot_hit THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
              'End of reel in bap$tape_bm_skip_tapemark (backward)', status);
            EXIT /skip_backward/;
          IFEND;
          IF bmd^.io_direction = bac$iod_writing THEN
            dmp$get_tape_volume_information (bmd^.sfid, number_of_volumes, current_volume, current_vsns,
                  density, write_ring, requested_volume_attributes, volume_overflow_allowed, label_type,
                  status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            call_block.operation := amc$terminate_tape_volume;
            call_block.terminate_tape_volume := ^terminate_tape_volume;
            terminate_tape_volume.tape_density := density;
            terminate_tape_volume.terminating_volume_number := current_volume;
            terminate_tape_volume.terminating_volume := current_vsns;
            terminate_tape_volume.removable_media_location := requested_volume_attributes.
                  removable_media_location;
            terminate_tape_volume.removable_media_group := requested_volume_attributes.
                  removable_media_group;
            amp$access_method (file_id, call_block, global_layer_number, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF label_type <> amc$labelled THEN
              terminate_volume (write_completion, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF write_completion.error_type <> no_write_error THEN
                osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                  'Position uncertain in bap$tape_bm_skip_tapemark (backwards)', status);
                bmd^.fatal_write_error := TRUE;
                bmd^.fatal_write_failure_modes := write_completion.failure_modes;
                tape_failure_modes := write_completion.failure_modes;
                EXIT /skip_backward/;
              IFEND;
            IFEND;
          IFEND;
        IFEND;

        bmd^.fatal_write_error := FALSE;
        bmd^.write_hit_end_of_tape_reflector := FALSE;
        bmd^.io_direction := bac$iod_indeterminate;
        reset_buffer_pointers;

        iop$backspace_tape_to_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF NOT bmd^.non_data_io_status.normal_completion THEN
          IF (bmd^.non_data_io_status.completion_code = ioc$load_point) OR
          {} (bmd^.non_data_io_status.completion_code = ioc$load_point_block_count_ne_0) THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$skip_encountered_bov,
              'Skip hit BOV in bap$tape_bm_skip_tapemark', status);
            tape_failure_modes := $amt$tape_failure_modes [];
            EXIT /skip_backward/;
          ELSE
            form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
              'Bad tape status in bap$tape_bm_skip_tapemark', status);
            RETURN;
          IFEND;
        IFEND;
      END /skip_backward/;

    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'illegal skip direction in bap$tape_bm_skip_tapemark', status);
    CASEND;

  PROCEND bap$tape_bm_skip_tapemark;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_tapemark_check', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_tapemark_check (file_id: amt$file_identifier;
    VAR tapemark_is_next: boolean;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      next_position: bat$tape_block_position,
      ignore_write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_TAPEMARK_CHECK',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.io_direction <> bac$iod_reading THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Call to bap$tape_bm_tapemark_check while not reading.', status);
      RETURN;
    IFEND;

    IF bmd^.direct_io THEN
      CASE bmd^.buffer_group [1]^.group_state OF
      = bac$group_io_pending =
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'group_io_pending in bap$tape_bm_tapemark_check (direct_io)', status);
        RETURN;
      = bac$group_contains_data =
        ;
      = bac$group_empty =
        initiate_read (1, bmd^.buffer_group [1]^.block_buffer [1].block_buffer, bmd^.max_block_length,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        await_data_io_completion (bmd^.logical_position, ignore_write_completion, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Unrecognized group state in bap$tape_bm_tapemark_check', status);
        RETURN;
      CASEND;
      tapemark_is_next := bmd^.buffer_group [1]^.block_buffer [1].block_type = bac$tapemark;

    ELSE { normal, buffered I/O }

      advance_read_ahead (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      next_position := bmd^.logical_position;
      IF bmd^.buffer_group [next_position.buffer_group]^.group_state = bac$group_empty THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Empty group in bap$tape_bm_tapemark_check', status);
        RETURN;
      IFEND;
      await_data_io_completion (next_position, ignore_write_completion, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      tapemark_is_next := bmd^.buffer_group [next_position.buffer_group]^.block_buffer [next_position.
            buffer_index].block_type = bac$tapemark;

    IFEND;

  PROCEND bap$tape_bm_tapemark_check;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_write_label', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_write_label (file_id: amt$file_identifier;
        label_ptr: ^bat$tape_block;
        label_length: amt$max_block_length;
        system_media_recovery: boolean;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    TYPE
      word_aligned_tape_block = record
        tape_block: ALIGNED [0 MOD 8] array [1 .. * ] of cell,
      recend;

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      aligned_buffer_p: ^word_aligned_tape_block,
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      ignore_write_completion: tape_write_completion,
      io_id: iot$io_id,
      write_completion: tape_write_completion,
      write_description: iot$write_tape_description;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_WRITE_LABEL', file_instance, bmd,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF label_length <= 0 THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Zero length label passed to bap$tape_bm_write_label', status);
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_write_label', status);
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_reading THEN
      align_physical_logical_position (ignore_write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := ignore_write_completion.failure_modes;
        RETURN;
      IFEND;
      reset_buffer_pointers;
    IFEND;

    bmd^.io_direction := bac$iod_writing;

    finish_all_outstanding_io (write_completion, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
          end_of_tape_reflective_spot_hit;

    IF write_completion.error_type <> no_write_error THEN
      bmd^.fatal_write_error := TRUE;
      bmd^.fatal_write_failure_modes := write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Finishing I/O in bap$tape_bm_write_label', status);
      tape_failure_modes := write_completion.failure_modes;
      RETURN;
    IFEND;

    IF (label_length > bac$max_ansi_label_length) AND (label_length > bmd^.max_block_length) THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$block_larger_than_maxbl,
        'Label longer than MAXBL in bap$tape_bm_write_label', status);
      RETURN;
    IFEND;

    { Copy the label into a word aligned buffer for writing }

    PUSH aligned_buffer_p: [1 .. label_length];
    i#move (label_ptr, ^aligned_buffer_p^.tape_block, label_length);

    write_description [1].buffer_area := ^aligned_buffer_p^.tape_block;
    write_description [1].transfer_length := label_length;

{ The following WHILE TRUE loop is used to cycle back to retry write if operator chooses fatal error recovery.

  /write_label_recovery/
    WHILE TRUE DO
      bap$write_tape (bmd^.sfid, ^write_description, {block_count=} 1, {system_media_recovery=} TRUE, io_id,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      bap$await_tape_io_completion (bmd^.sfid, io_id, bmd^.non_data_io_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (NOT bmd^.non_data_io_status.normal_completion) THEN
        form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF bmd^.non_data_io_status.completion_code = ioc$no_write_ring THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring,
                ' ', status);
        ELSEIF bmd^.non_data_io_status.completion_code = ioc$write_past_phys_eot THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                'Write past physical EOT in bap$tape_bm_write_label', status);
        ELSE
          menu_tape_fatal_error_recovery (bac$tfrm_fatal_write, tape_failure_modes, attempt_recovery,
                attempt_close, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{ Cycle to retry write label if operator chose response of 1 (attempt_recovery).

          IF attempt_recovery THEN
            CYCLE /write_label_recovery/;
          IFEND;
          osp$set_status_abnormal (bac$basic_access_id, bae$write_error_this_block, 'bap$tape_bm_write_label',
                status);
        IFEND;

        bmd^.fatal_write_error := TRUE;
        bmd^.fatal_write_failure_modes := tape_failure_modes;
        RETURN;
      IFEND;
      tape_failure_modes := $amt$tape_failure_modes [];
      RETURN;
    WHILEND /write_label_recovery/;

  PROCEND bap$tape_bm_write_label;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_write_label_mark', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_write_label_mark (file_id: amt$file_identifier;
        system_media_recovery: boolean;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      write_completion: tape_write_completion,
      ignore_write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_WRITE_LABEL_MARK', file_instance, bmd,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_write_label_mark', status);
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_reading THEN
      align_physical_logical_position (ignore_write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := ignore_write_completion.failure_modes;
        RETURN;
      IFEND;
      reset_buffer_pointers;
    IFEND;

    bmd^.io_direction := bac$iod_writing;

    finish_all_outstanding_io (write_completion, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
          end_of_tape_reflective_spot_hit;

    IF write_completion.error_type <> no_write_error THEN
      bmd^.fatal_write_error := TRUE;
      bmd^.fatal_write_failure_modes := write_completion.failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Finishing I/O in bap$tape_bm_advance_volume', status);
      tape_failure_modes := write_completion.failure_modes;
      RETURN;
    IFEND;

  /write_label_mark_recovery/
    WHILE TRUE DO
      bap$write_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF NOT bmd^.non_data_io_status.normal_completion THEN
        form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF bmd^.non_data_io_status.completion_code = ioc$no_write_ring THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring,
                ' ', status);
        ELSEIF bmd^.non_data_io_status.completion_code = ioc$write_past_phys_eot THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                'Write past physical EOT in bap$tape_bm_write_label_mark', status);
        ELSE
          menu_tape_fatal_error_recovery (bac$tfrm_fatal_write_tapemark , tape_failure_modes,
                attempt_recovery, attempt_close, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF attempt_recovery THEN
            CYCLE /write_label_mark_recovery/
          IFEND;
          osp$set_status_abnormal (bac$basic_access_id, bae$write_error_this_block,
                'bap$tape_bm_write_label_mark', status);
        IFEND;
        bmd^.fatal_write_error := TRUE;
        bmd^.fatal_write_failure_modes := tape_failure_modes;
        RETURN;
      IFEND;
      tape_failure_modes := $amt$tape_failure_modes [];
      RETURN;
    WHILEND /write_label_mark_recovery/;

  PROCEND bap$tape_bm_write_label_mark;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_write_next_block', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_write_next_block (file_id: amt$file_identifier;
        block_ptr: ^bat$tape_block;
        block_length: amt$max_block_length;
        system_media_recovery: boolean;
        forced_write: boolean;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      ignore_write_completion: tape_write_completion,
      initial_buffer_reserved_value: boolean,
      write_completion: tape_write_completion,
      block_to_write: ^bat$tape_block,
      byte_read_from_buffer: cell,
      end_of_volume_status: ost$status;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_WRITE_NEXT_BLOCK', file_instance, bmd,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_write_next_block', status);
      RETURN;
    IFEND;

    IF block_length > bmd^.max_block_length THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$block_larger_than_maxbl,
        'block exceeds MAXBL in bam$tape_bm_write_next_block', status);
      RETURN;
    IFEND;

    IF block_length <= 0 THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Zero length block passed to bap$tape_bm_write_next_block', status);
      RETURN;
    IFEND;

    IF #segment (bmd^.buffer_segment.seq_pointer) = #segment (block_ptr) THEN
      IF NOT bmd^.buffer_reserved THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$unreserved_buffer_used,
          'unreserved buffer in bap$tape_bm_write_next_block', status);
        RETURN;
      IFEND;
    IFEND;

    IF block_ptr = NIL THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'NIL buffer pointer in bap$tape_bm_write_next_block.', status);
      RETURN;
    IFEND;

    IF bmd^.write_hit_end_of_tape_reflector THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
        'Call to bap$tape_bm_write_next_block while end of volume is pending.', status);
      RETURN;
    IFEND;

    initial_buffer_reserved_value := bmd^.buffer_reserved;
    bmd^.buffer_reserved := FALSE;
    bmd^.system_media_recovery := system_media_recovery;

    IF bmd^.io_direction = bac$iod_reading THEN
      align_physical_logical_position (ignore_write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := ignore_write_completion.failure_modes;
        RETURN;
      IFEND;
      reset_buffer_pointers;
    IFEND;
    bmd^.io_direction := bac$iod_writing;

    end_of_volume_status.normal := TRUE;
    IF bmd^.direct_io THEN

      IF (#offset (block_ptr) MOD 8) = 0 THEN
        { Buffer is aligned to a word boundary -- we can write direct from the buffer
        block_to_write := block_ptr;
        byte_read_from_buffer := block_to_write^ [1];
        #SPOIL (byte_read_from_buffer);
        byte_read_from_buffer := block_to_write^ [block_length];
      ELSE
        { Unaligned buffer -- copy into the allocated buffer
        block_to_write := bmd^.buffer_group [1]^.block_buffer [1].block_buffer;
        i#move (block_ptr, block_to_write, block_length);
      IFEND;
      bmd^.buffer_group [1]^.group_state := bac$group_contains_data;
      bmd^.buffer_group [1]^.last_buffer_with_data := 1;
      initiate_write ( {buffer_group =} 1, block_to_write, block_length, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      await_data_io_completion (bmd^.logical_position, write_completion, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF write_completion.error_type <> no_write_error THEN
        write_completion.error_type := write_error_last_block;
      IFEND;
      bmd^.buffer_group [1]^.group_state := bac$group_empty;
      IF write_completion.end_of_tape_reflective_spot_hit THEN
        bmd^.write_hit_end_of_tape_reflector := TRUE;
        osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_completed,
          'Volume end in bap$tape_bm_write_next_block (direct io)', end_of_volume_status);
      IFEND;

    ELSE { normal, buffered I/O }

    /buffered_write/
      BEGIN
        perform_buffered_write (block_ptr, block_length, write_completion, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
              end_of_tape_reflective_spot_hit;
        IF write_completion.error_type <> no_write_error THEN
          EXIT /buffered_write/;
        IFEND;
        IF write_completion.end_of_tape_reflective_spot_hit THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited, 'Buffered write',
                end_of_volume_status);
          bmd^.buffer_reserved := initial_buffer_reserved_value;
          EXIT /buffered_write/;
        IFEND;
        IF forced_write THEN
          align_physical_logical_position (write_completion, status);
          IF write_completion.error_type <> no_write_error THEN
            write_completion.error_type := write_error_last_block;
          IFEND;
          IF write_completion.end_of_tape_reflective_spot_hit THEN
            bmd^.write_hit_end_of_tape_reflector := TRUE;
            osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_completed,
              'Buffered write - While advancing write-behind', end_of_volume_status);
            EXIT /buffered_write/;
          IFEND;
        ELSE
          advance_write_behind (status);
        IFEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      END /buffered_write/;

    IFEND;

    tape_failure_modes := write_completion.failure_modes;

    { Set status appropriately.  Note that a write error overrides an end-of-volume indication. }
    { (The EOV will be returned on  the next block management call.) }

    CASE write_completion.error_type OF
    = write_error_previous_block =
      bmd^.fatal_write_error := TRUE;
      bmd^.fatal_write_failure_modes := tape_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'In bap$tape_bm_write_next_block', status);
    = write_error_last_block =
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_this_block,
        'In bap$tape_bm_write_next_block', status);
    = no_write_error =
      status := end_of_volume_status;
    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Illegal value of write_error in bap$tape_bm_write_next_block', status);
      RETURN;
    CASEND;

  PROCEND bap$tape_bm_write_next_block;

?? TITLE := 'PROCEDURE [XDCL, #GATE] bap$tape_bm_write_tapemark', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_write_tapemark (file_id: amt$file_identifier;
        system_media_recovery: boolean;
        force_write: boolean;
    VAR tape_failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      write_completion: tape_write_completion;

    #caller_id (caller_id);
    status.normal := TRUE;
    tape_failure_modes := $amt$tape_failure_modes [];

    validate_call (file_id, caller_id.ring, write_access, 'BAP$TAPE_BM_WRITE_TAPEMARK', file_instance, bmd,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.fatal_write_error THEN
      tape_failure_modes := bmd^.fatal_write_failure_modes;
      osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
        'Outstanding fatal write error in bap$tape_bm_write_tapemark', status);
      RETURN;
    IFEND;

    IF bmd^.write_hit_end_of_tape_reflector THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
        'Call to bap$tape_bm_write_tapemark after end of volume has been returned.', status);
      RETURN;
    IFEND;

  /write_tapemark/
    BEGIN
      align_physical_logical_position (write_completion, status);
      IF NOT status.normal THEN
        tape_failure_modes := write_completion.failure_modes;
        RETURN;
      IFEND;

      bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR write_completion.
            end_of_tape_reflective_spot_hit;
      IF write_completion.error_type <> no_write_error THEN
        bmd^.fatal_write_error := TRUE;
        bmd^.fatal_write_failure_modes := write_completion.failure_modes;
        osp$set_status_abnormal (bac$basic_access_id, bae$write_error_previous_block,
          'Fatal write error in bap$tape_bm_write_tapemark', status);
        tape_failure_modes := write_completion.failure_modes;
        EXIT /write_tapemark/;
      IFEND;
      IF write_completion.end_of_tape_reflective_spot_hit THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_inhibited,
          'End of reel in BAP$TAPE_BM_REWIND', status);
        RETURN;
        EXIT /write_tapemark/;
      IFEND;

      reset_buffer_pointers;
      bmd^.io_direction := bac$iod_writing;

  /write_tapemark_recovery/
      WHILE TRUE DO
        bap$write_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR
              bmd^.non_data_io_status.end_of_tape;
        IF NOT bmd^.non_data_io_status.normal_completion THEN
          form_failure_modes (bmd^.non_data_io_status, tape_failure_modes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF bmd^.non_data_io_status.completion_code = ioc$no_write_ring THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring,
                  ' ', status);
          ELSEIF bmd^.non_data_io_status.completion_code = ioc$write_past_phys_eot THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                  'Write past physical EOT in bap$tape_bm_write_tapemark', status);
          ELSE
            menu_tape_fatal_error_recovery (bac$tfrm_fatal_write_tapemark, tape_failure_modes,
                  attempt_recovery, attempt_close, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF attempt_recovery THEN
              CYCLE /write_tapemark_recovery/
            IFEND;
            osp$set_status_abnormal (bac$basic_access_id, bae$write_error_this_block,
                  'Tape position uncertain in bap$tape_bm_write_tapemark', status);
          IFEND;
          bmd^.fatal_write_error := TRUE;
          bmd^.fatal_write_failure_modes := tape_failure_modes;
          RETURN;
        IFEND;
        tape_failure_modes := $amt$tape_failure_modes [];
        EXIT /write_tapemark_recovery/;
      WHILEND /write_tapemark_recovery/;

      IF bmd^.non_data_io_status.end_of_tape THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$vol_end_operation_completed,
          'bap$tape_bm_write_tapemark hit end_of_tape', status);
      IFEND;
    END /write_tapemark/;

  PROCEND bap$tape_bm_write_tapemark;

?? TITLE := 'PROCEDURE bap$tape_bm_unwritten_blk_count', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$tape_bm_unwritten_blk_count (file_id: amt$file_identifier;
    VAR blocks_currently_buffered: bat$tape_block_buffer_count;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      buffer_group: bat$tape_buffer_group_index,
      group_descriptor: ^bat$tape_buffer_grp_descriptor;

    #caller_id (caller_id);
    status.normal := TRUE;
    blocks_currently_buffered := 0;

    validate_call (file_id, caller_id.ring, non_data_transfer_access, 'BAP$TAPE_BM_UNWRITTEN_BLK_COUNT',
          file_instance, bmd, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE bmd^.io_direction OF
    = bac$iod_indeterminate, bac$iod_reading =
      ;
    = bac$iod_writing =

    /count_buffers_in_each_group/
      FOR buffer_group := 1 TO bmd^.buffer_groups_in_use DO
        group_descriptor := bmd^.buffer_group[buffer_group];
        IF group_descriptor^.group_state = bac$group_contains_data THEN
          blocks_currently_buffered := blocks_currently_buffered + bmd^.buffer_group_size;
          IF bmd^.physical_position.buffer_group = buffer_group THEN
            blocks_currently_buffered := blocks_currently_buffered -
                  (bmd^.physical_position.buffer_index - 1) - (bmd^.buffer_group_size -
                  group_descriptor^.last_buffer_with_data);
          IFEND;
          IF (bmd^.logical_position.buffer_group = buffer_group) AND NOT
                (bmd^.physical_position.buffer_group = buffer_group) THEN
            blocks_currently_buffered := blocks_currently_buffered -  (bmd^.buffer_group_size -
                  bmd^.logical_position.buffer_index + 1);
          IFEND;
        IFEND;
      FOREND /count_buffers_in_each_group/;

    ELSE

      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Illegal I/O direction in bap$tape_bm_unwritten_blk_count', status);
      RETURN;

    CASEND;

    IF (blocks_currently_buffered < 0) OR (blocks_currently_buffered > (bmd^.buffer_groups_in_use *
          bmd^.buffer_group_size)) THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Out of range unwritten block count.  Count =', status);
      osp$append_status_integer (' ', blocks_currently_buffered, 10, TRUE, status);
      RETURN;
    IFEND;

  PROCEND bap$tape_bm_unwritten_blk_count;

?? TITLE := 'PROCEDURE [INLINE] advance_read_ahead', EJECT ??

  PROCEDURE [INLINE] advance_read_ahead (VAR status: ost$status);

    VAR
      full_groups: integer,
      group: bat$tape_buffer_group_index;

    status.normal := TRUE;

    full_groups := 0;
  /count_full_groups/
    FOR group := 1 TO bmd^.buffer_groups_in_use DO;
      { Note that groups with I/O outstanding are considered "full", since they will become full when }
      { I/O completes }
      IF bmd^.buffer_group [group]^.group_state <> bac$group_empty THEN
        full_groups := full_groups + 1;
      IFEND;
    FOREND /count_full_groups/;

    IF full_groups = 0 THEN
      bmd^.inhibit_read_ahead := FALSE;
    IFEND;

    IF bmd^.inhibit_read_ahead OR (full_groups = bmd^.buffer_groups_in_use) THEN
      RETURN;     {do not attempt to initiate any more reads
    IFEND;

    group := bmd^.logical_position.buffer_group;
  /issue_read_requests/
    REPEAT
      IF bmd^.buffer_group [group]^.group_state = bac$group_empty THEN
        initiate_read (group, {block_pointer =} NIL, 1, status);
        IF NOT status.normal THEN
          IF (status.condition = ioe$tape_unit_disabled) OR
             (status.condition = ioe$tape_pp_q_locked)   THEN
            { TQM couldn't accept our request for some reason.  (Recovery in progress, or some previous)}
            { request encountering an error.)  Just exit and try again next time. }
            status.normal := TRUE;
            EXIT /issue_read_requests/;
          ELSE
            RETURN;
          IFEND;
        IFEND;
      IFEND;
      IF group < bmd^.buffer_groups_in_use THEN
        group := group + 1;
      ELSE
        group := 1;
      IFEND;
    UNTIL group = bmd^.logical_position.buffer_group;

  PROCEND advance_read_ahead;

?? TITLE := 'PROCEDURE [INLINE] advance_read_position', EJECT ??

  PROCEDURE [INLINE] advance_read_position (VAR block_description: ^bat$tape_buffer_information;
    VAR status: ost$status);

    VAR
      ignore_write_completion: tape_write_completion,
      block_found: boolean;

    advance_read_ahead (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    find_buffered_read_data_block (block_found, block_description, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF NOT block_found THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'No block found in advance_read_position', status);
      RETURN;
    IFEND;

  PROCEND advance_read_position;

?? TITLE := 'PROCEDURE [INLINE] advance_write_behind', EJECT ??

  PROCEDURE [INLINE] advance_write_behind (VAR status: ost$status);

    VAR
      group: bat$tape_buffer_group_index;

    status.normal := TRUE;

    group := bmd^.physical_position.buffer_group;

    { Note that this loop stops BEFORE checking the group at the current logical position.  This   }
    { allows the current group to be filled before it is written to tape.   }

  /issue_write_requests/
    REPEAT
      IF (bmd^.buffer_group [group]^.group_state = bac$group_contains_data) THEN
        IF (group <> bmd^.logical_position.buffer_group) OR ((bmd^.physical_position.buffer_group =
              bmd^.logical_position.buffer_group) AND (bmd^.logical_position.buffer_index = 1)) THEN
          initiate_write (group, {block_pointer =} NIL, 1, status);
          IF NOT status.normal THEN
              IF (status.condition = ioe$tape_unit_disabled) OR
                 (status.condition = ioe$tape_pp_q_locked)   THEN
                { TQM couldn't accept our request for some reason.  (Recovery in progress, or some previous)}
                { request encountering an error.)  Just exit and try again next time. }
                status.normal := TRUE;
                EXIT /issue_write_requests/;
              ELSE
                RETURN;
              IFEND;
          IFEND;
        IFEND;
      IFEND;
      IF group < bmd^.buffer_groups_in_use THEN
        group := group + 1;
      ELSE
        group := 1;
      IFEND;
    UNTIL group = bmd^.logical_position.buffer_group;

  PROCEND advance_write_behind;

?? TITLE := 'PROCEDURE align_physical_logical_position', EJECT ??

  PROCEDURE align_physical_logical_position (VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    VAR
      buffer_group: bat$tape_buffer_group_index,
      blocks_to_backspace: 0 .. bac$max_tape_buffer_group_size,
      blocks_used_from_this_group: 0 .. bac$max_tape_buffer_group_size;

    status.normal := TRUE;
    write_completion := normal_write_completion;

    finish_all_outstanding_io (write_completion, status);
    IF (NOT status.normal) OR
    {} write_completion.end_of_tape_reflective_spot_hit OR
    {} (write_completion.error_type <> no_write_error) THEN
      RETURN;
    IFEND;

    IF bmd^.direct_io THEN

      CASE bmd^.io_direction OF
      = bac$iod_reading =
        CASE bmd^.buffer_group [1]^.group_state OF
        = bac$group_empty =
          ;
        = bac$group_contains_data =
          IF bmd^.buffer_group [1]^.block_buffer [1].block_type = bac$tapemark THEN
            iop$backspace_tape_to_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
          ELSE
            bap$backspace_tape (bmd^.sfid, 1, {use_locate_block} FALSE, bmd^.non_data_io_status, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF NOT bmd^.non_data_io_status.normal_completion THEN
            form_failure_modes (bmd^.non_data_io_status, write_completion.failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
              'bam$tape_block_manager_ring3 - align_physical_logical_position', status);
            RETURN;
          IFEND;
          bmd^.buffer_group [1]^.group_state := bac$group_empty;
        = bac$group_io_pending =
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'IO pending in align_physical_logical_position', status);
          RETURN;
        ELSE
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Unrecognized group state in align_physical_logical_position', status);
          RETURN;
        CASEND;
      = bac$iod_writing =
        CASE bmd^.buffer_group [1]^.group_state OF
        = bac$group_empty =
          ;
        = bac$group_contains_data =
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Group contains data during direct I/O writing', status);
        = bac$group_io_pending =
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'IO pending in align_physical_logical_position', status);
          RETURN;
        ELSE
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Unrecognized group state in align_physical_logical_position', status);
          RETURN;
        CASEND;
      ELSE
        ;
      CASEND;

    ELSE { normal, buffered i/o }

      CASE bmd^.io_direction OF
      = bac$iod_indeterminate =

        ; { Nothing to do }

      = bac$iod_reading =

        buffer_group := bmd^.physical_position.buffer_group;

      /back_over_read_ahead_data/
        WHILE bmd^.buffer_group [buffer_group]^.group_state <> bac$group_empty DO
          IF bmd^.buffer_group [buffer_group]^.group_state = bac$group_io_pending THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
              'Outstanding I/O in align_phyiscal_logical_position', status);
            RETURN;
          IFEND;

          blocks_to_backspace := bmd^.buffer_group [buffer_group]^.last_buffer_with_data;

          IF buffer_group = bmd^.physical_position.buffer_group THEN
            IF bmd^.inhibit_read_ahead THEN  { either error or tapemark was the reason
              IF (bmd^.buffer_group [buffer_group]^.block_buffer [blocks_to_backspace].block_type =
                    bac$tapemark) THEN
                bap$backspace_tape (bmd^.sfid, {blocks_to_backspace} 1, {use_locate_block} FALSE,
                  bmd^.non_data_io_status, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                IF NOT bmd^.non_data_io_status.normal_completion THEN
                  IF (bmd^.non_data_io_status.completion_code = ioc$tapemark_read) THEN
                    blocks_to_backspace := blocks_to_backspace - 1;
                  ELSE
                    reset_buffer_pointers;
                    form_failure_modes (bmd^.non_data_io_status, write_completion.failure_modes, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;
                    osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                          'Tape position uncertain in align_physical_logical_position', status);
                    RETURN;
                  IFEND;
                ELSE { must encounter a tapemark
                  osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                        'Tapemark missing during backspace in align_phyiscal_logical_position', status);
                  RETURN;
                IFEND;
              IFEND;
            IFEND;
          IFEND;

          IF buffer_group = bmd^.logical_position.buffer_group THEN
            blocks_used_from_this_group := bmd^.logical_position.buffer_index - 1;
            blocks_to_backspace := blocks_to_backspace - blocks_used_from_this_group;
          IFEND;

        /back_over_one_buffer_group/
          WHILE blocks_to_backspace > 0 DO
            bap$backspace_tape (bmd^.sfid, blocks_to_backspace, {use_locate_block} TRUE,
                  bmd^.non_data_io_status, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            IF NOT bmd^.non_data_io_status.normal_completion THEN
              IF bmd^.non_data_io_status.completion_code = ioc$tapemark_read THEN
                osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                      'Tapemark encountered during backspace in align_phyiscal_logical_position', status);
                RETURN;
              ELSE
                reset_buffer_pointers;
                form_failure_modes (bmd^.non_data_io_status, write_completion.failure_modes, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                  'Tape position uncertain in align_physical_logical_position', status);
                RETURN;
              IFEND;
            ELSE
              blocks_to_backspace := 0;
            IFEND;
          WHILEND /back_over_one_buffer_group/;
          bmd^.buffer_group [buffer_group]^.group_state := bac$group_empty;

          IF buffer_group = 1 THEN
            buffer_group := bmd^.buffer_groups_in_use;
          ELSE
            buffer_group := buffer_group - 1;
          IFEND;

        WHILEND /back_over_read_ahead_data/;

        reset_buffer_pointers;

      = bac$iod_writing =

      /buffered_io_writing_align/
        BEGIN

        /write_each_buffer_group/
          WHILE bmd^.buffer_group [bmd^.physical_position.buffer_group]^.group_state <> bac$group_empty DO

            CASE bmd^.buffer_group [bmd^.physical_position.buffer_group]^.group_state OF
            = bac$group_contains_data =
              initiate_write (bmd^.physical_position.buffer_group, {block_ptr =} NIL, 1, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF (bmd^.physical_position.buffer_group = bmd^.logical_position.buffer_group) THEN
                IF bmd^.logical_position.buffer_group < bmd^.buffer_groups_in_use THEN
                  form_tape_block_position (bmd^.logical_position, bmd^.logical_position.buffer_group + 1, 1);
                ELSE
                  form_tape_block_position (bmd^.logical_position, 1, 1);
                IFEND;
              IFEND;
              await_data_io_completion (bmd^.physical_position, write_completion, status);
            = bac$group_io_pending =
              await_data_io_completion (bmd^.physical_position, write_completion, status);
            ELSE
              osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                'Illegal group state in align_phyiscal_logical_position (buffered write)', status);
              RETURN;
            CASEND;
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF write_completion.error_type <> no_write_error THEN
              EXIT /buffered_io_writing_align/;
            IFEND;

            IF write_completion.end_of_tape_reflective_spot_hit THEN
              EXIT /buffered_io_writing_align/;
            IFEND;

          WHILEND /write_each_buffer_group/;

          reset_buffer_pointers;

        END /buffered_io_writing_align/;

      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Invalid I/O direction in align_physical_logical_position (buffered)', status)
      CASEND;

    IFEND;

  PROCEND align_physical_logical_position;

?? TITLE := 'PROCEDURE await_data_io_completion', EJECT ??

  PROCEDURE await_data_io_completion (position: bat$tape_block_position;
    VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    VAR
      group_description: ^bat$tape_buffer_grp_descriptor,
      tape_status: ^iot$tape_io_status;

    status.normal := TRUE;
    write_completion := normal_write_completion;

    group_description := bmd^.buffer_group [position.buffer_group];

    CASE group_description^.group_state OF
    = bac$group_empty =
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Empty group encountered in await_data_io_completion', status);
      RETURN;
    = bac$group_contains_data =
      ;
    = bac$group_io_pending =
      tape_status := ^group_description^.io_status;
      bap$await_tape_io_completion (bmd^.sfid, group_description^.io_id, tape_status^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      process_data_io_completion (position.buffer_group, tape_status^, write_completion, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Unrecognizable group state in await_data_io_completion', status);
    CASEND;

  PROCEND await_data_io_completion;

?? TITLE := 'PROCEDURE clear_other_pending_requests', EJECT ??

  { This procedure is called after an I/O error has occurred on a read or a write.  It goes through }
  { the buffer groups and fetches the completed status of all pending I/O requests from tape queue manager. }

  PROCEDURE clear_other_pending_requests (current_group: bat$tape_buffer_group_index;
    VAR status: ost$status);

    VAR
      group: bat$tape_buffer_group_index,
      group_description: ^bat$tape_buffer_grp_descriptor,
      tape_status: ^iot$tape_io_status;

    status.normal := TRUE;

  /check_each_buffer_group/
    FOR group := 1 TO bmd^.buffer_groups_in_use DO
      IF bmd^.buffer_group [group]^.group_state = bac$group_io_pending THEN
        IF group <> current_group THEN
          group_description := bmd^.buffer_group [group];

          tape_status := ^group_description^.io_status;
          bap$await_tape_io_completion (bmd^.sfid, bmd^.buffer_group [group]^.io_id, tape_status^, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF tape_status^.normal_completion THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                  'Normal I/O completion in clear_other_pending_requests', status);
            RETURN;
          ELSE
            IF tape_status^.completion_code <> ioc$request_not_processed THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                    'Unexpected I/O completion code in clear_other_pending_requests -- code =', status);
              osp$append_status_integer (' ', tape_status^.completion_code, 10, TRUE, status);
              RETURN;
            IFEND;
          IFEND;

          CASE bmd^.io_direction OF
          = bac$iod_reading =
            group_description^.group_state := bac$group_empty;
          = bac$iod_writing =
            group_description^.group_state := bac$group_contains_data;
          = bac$iod_indeterminate =
              osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                    'Unexpected indeterminate I/O direction in clear_other_pending_requests', status);
              RETURN;
          ELSE
            osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                  'Illegal I/O direction in procedure clear_other_pending_requests', status);
          CASEND;
        IFEND;
      IFEND;
    FOREND /check_each_buffer_group/;

  PROCEND clear_other_pending_requests;

?? TITLE := 'PROCEDURE [INLINE] ensure_write_buffer_available', EJECT ??

  PROCEDURE [INLINE] ensure_write_buffer_available (VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    status.normal := TRUE;
    write_completion := normal_write_completion;

    IF bmd^.logical_position.buffer_index = 1 THEN

      { First block in a buffer group -- ensure that any data previously in this buffer group }
      { has been written to tape. }

    /ensure_the_new_group_is_empty/
      WHILE bmd^.buffer_group [bmd^.logical_position.buffer_group]^.group_state <> bac$group_empty DO
        advance_write_behind (status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF bmd^.buffer_group [bmd^.physical_position.buffer_group]^.group_state = bac$group_contains_data THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Unable to advance write behind in ensure_write_buffer_available', status);
          RETURN;
        IFEND;
        await_data_io_completion (bmd^.physical_position, write_completion, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF write_completion.end_of_tape_reflective_spot_hit OR (write_completion.error_type <> no_write_error)
              THEN
          EXIT /ensure_the_new_group_is_empty/;
        IFEND;
      WHILEND /ensure_the_new_group_is_empty/;

    IFEND;

  PROCEND ensure_write_buffer_available;

?? TITLE := 'PROCEDURE find_buffered_read_data_block', EJECT ??

  PROCEDURE find_buffered_read_data_block (VAR block_found: boolean;
    VAR found_block_information: ^bat$tape_buffer_information;
    VAR status: ost$status);

    VAR
      ignore_write_completion: tape_write_completion;

    status.normal := TRUE;
    found_block_information := NIL;

    IF bmd^.direct_io THEN

      IF bmd^.buffer_group [1]^.group_state = bac$group_contains_data THEN
        block_found := TRUE;
        found_block_information := ^bmd^.buffer_group [1]^.block_buffer [1];
        bmd^.buffer_group [1]^.group_state := bac$group_empty;
      ELSE
        block_found := FALSE;
      IFEND;

    ELSE { normal, buffered I/O }

      IF bmd^.buffer_group [bmd^.logical_position.buffer_group]^.group_state = bac$group_empty THEN
        block_found := FALSE;
      ELSE
        IF bmd^.buffer_group [bmd^.logical_position.buffer_group]^.group_state <>
              bac$group_contains_data THEN
          await_data_io_completion (bmd^.logical_position, ignore_write_completion, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        block_found := TRUE;
        found_block_information := ^bmd^.buffer_group [bmd^.logical_position.buffer_group]^.block_buffer
              [bmd^.logical_position.buffer_index];
        IF bmd^.logical_position.buffer_index < bmd^.buffer_group [bmd^.logical_position.buffer_group]^.
              last_buffer_with_data THEN
          bmd^.logical_position.buffer_index := bmd^.logical_position.buffer_index + 1;
        ELSE
          bmd^.buffer_group [bmd^.logical_position.buffer_group]^.group_state := bac$group_empty;
          IF bmd^.logical_position.buffer_group < bmd^.buffer_groups_in_use THEN
            form_tape_block_position (bmd^.logical_position, bmd^.logical_position.buffer_group + 1, 1);
          ELSE
            form_tape_block_position (bmd^.logical_position, 1, 1);
          IFEND;
        IFEND;
      IFEND;

    IFEND;

  PROCEND find_buffered_read_data_block;

?? TITLE := 'PROCEDURE finish_all_outstanding_io', EJECT ??

  PROCEDURE finish_all_outstanding_io (VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    VAR
      last_group: bat$tape_buffer_group_index,
      position: bat$tape_block_position;

    status.normal := TRUE;
    write_completion := normal_write_completion;

  /complete_io/
    BEGIN
      CASE bmd^.io_direction OF
      = bac$iod_indeterminate =
        EXIT /complete_io/;
      = bac$iod_reading =
        form_tape_block_position (position, bmd^.logical_position.buffer_group, 1);
      = bac$iod_writing =
        form_tape_block_position (position, bmd^.physical_position.buffer_group,
              bmd^.physical_position.buffer_index);
      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Invalid I/O direction in finish_all_outstanding_io', status);
        RETURN;
      CASEND;
      last_group := position.buffer_group;

    /check_each_buffer_group/
      REPEAT
        IF bmd^.buffer_group [position.buffer_group]^.group_state = bac$group_io_pending THEN
          await_data_io_completion (position, write_completion, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF write_completion.end_of_tape_reflective_spot_hit OR
          {} (write_completion.error_type <> no_write_error) THEN
            EXIT /complete_io/;
          IFEND;
        IFEND;

        IF position.buffer_group < bmd^.buffer_groups_in_use THEN
          form_tape_block_position (position, position.buffer_group + 1, 1);
        ELSE
          form_tape_block_position (position, 1, 1);
        IFEND;

      UNTIL position.buffer_group = last_group;

    END /complete_io/;

  PROCEND finish_all_outstanding_io;

?? TITLE := 'PROCEDURE form_failure_modes', EJECT ??

  PROCEDURE form_failure_modes (tape_status: iot$tape_io_status;
    VAR failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    status.normal := TRUE;

    IF tape_status.normal_completion THEN
      failure_modes := $amt$tape_failure_modes [];
    ELSE
      CASE tape_status.completion_code OF
      = ioc$indeterminate, ioc$input_channel_parity, ioc$output_channel_parity, ioc$controller_failure,
            ioc$unit_failure, ioc$function_timeout, ioc$unit_reserved, ioc$iou_output_parity,
              ioc$indeterminate_output_parity, ioc$load_point =
        failure_modes := $amt$tape_failure_modes [amc$tfm_hardware_failure];
        IF (tape_status.completion_code = ioc$function_timeout) OR
              (tape_status.completion_code = ioc$controller_failure) THEN
          RETURN; {skip unit_ready check since status may not have been returned}
        IFEND;
      = ioc$tape_medium_failure, ioc$not_capable_of_density =
        failure_modes := $amt$tape_failure_modes [amc$tfm_data_parity_error];
      = ioc$erase_limit_exceeded =
        failure_modes := $amt$tape_failure_modes [amc$tfm_erase_error];
      = ioc$unable_to_write_id_burst =
        failure_modes := $amt$tape_failure_modes [amc$tfm_bad_id_burst];
      = ioc$unable_to_set_agc =
        failure_modes := $amt$tape_failure_modes [amc$tfm_agc_gains_not_set];
      = ioc$blank_tape =
        failure_modes := $amt$tape_failure_modes [amc$tfm_blank_tape_read];
      = ioc$alert_condition_encountered =
        failure_modes := $amt$tape_failure_modes []; { alert booleans are processed   below }
      = ioc$no_write_ring, ioc$read_past_phys_eot, ioc$write_past_phys_eot =
        failure_modes := $amt$tape_failure_modes [];
      ELSE
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Unanticipated tape I/O status -- completion_code =', status);
        osp$append_status_integer (' ', tape_status.completion_code, 10, TRUE, status);
        RETURN;
      CASEND;
    IFEND;

    IF NOT tape_status.unit_ready THEN
      failure_modes := failure_modes + $amt$tape_failure_modes [amc$tfm_device_not_ready];
    IFEND;

  PROCEND form_failure_modes;

?? TITLE := 'PROCEDURE [INLINE] form_tape_block_position', EJECT ??

  PROCEDURE [INLINE] form_tape_block_position (VAR tape_position: bat$tape_block_position;
        buffer_group: bat$tape_buffer_group_index;
        buffer_index: bat$tape_block_buffer_index);

    tape_position.buffer_group := buffer_group;
    tape_position.buffer_index := buffer_index;

  PROCEND form_tape_block_position;

?? TITLE := 'PROCEDURE initiate_read', EJECT ??

  PROCEDURE initiate_read (buffer_group: bat$tape_buffer_group_index;
        block_ptr: ^bat$tape_block;
        block_length: amt$max_block_length;
    VAR status: ost$status);

    VAR
      bgd: ^bat$tape_buffer_grp_descriptor,
      read_description: ^iot$read_tape_description,
      buffer_index: bat$tape_block_buffer_index,
      block_buffer_length,
      bytes_to_force_into_memory: integer,
      all_pages_in_memory: boolean,
      page_size: ost$page_size,
      io_id: iot$io_id;

    status.normal := TRUE;

    bgd := bmd^.buffer_group [buffer_group];

    IF bgd^.group_state <> bac$group_empty THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Wrong group state in initiate_read', status);
      RETURN;
    IFEND;

    read_description := ^bgd^.read_description;

    IF block_ptr <> NIL THEN

      IF NOT bmd^.direct_io THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Block pointer given for indirect read in initate_read', status);
        RETURN;
      IFEND;
      bgd^.block_buffer [1].system_media_recovery_used := bmd^.system_media_recovery;
      bgd^.block_buffer [1].attempt_recovery := FALSE;
      read_description^ [1].buffer_area := block_ptr;
      read_description^ [1].block_transfer_length := ^bgd^.block_buffer [1].block_length;
      bgd^.block_buffer [1].block_length.length := 0;
      bgd^.requested_read_length := block_length;
      bytes_to_force_into_memory := block_length;

    ELSE

    /set_up_for_the_read/
      FOR buffer_index := 1 TO bmd^.buffer_group_size DO
        bgd^.block_buffer [buffer_index].system_media_recovery_used := bmd^.system_media_recovery;
        bgd^.block_buffer [buffer_index].attempt_recovery := FALSE;
        read_description^ [buffer_index].buffer_area := bgd^.block_buffer [buffer_index].block_buffer;
        read_description^ [buffer_index].block_transfer_length := ^bgd^.block_buffer [buffer_index].
              block_length;
        bgd^.block_buffer [buffer_index].block_length.length := 0;
      FOREND /set_up_for_the_read/;
      bgd^.requested_read_length := bmd^.max_block_length;
      block_buffer_length := ((bmd^.max_block_length + 7) DIV 8) * 8;
      bytes_to_force_into_memory := block_buffer_length * bmd^.buffer_group_size;
      { round up to a full page }
      page_size := 512 * (128 - #read_register (osc$pr_page_size_mask));
      bytes_to_force_into_memory := ((bytes_to_force_into_memory + page_size - 1) DIV page_size) * page_size;

    IFEND;

    IF bav$use_assign_pages_for_tape THEN
      mmp$check_if_pages_in_memory (read_description^ [1].buffer_area, bytes_to_force_into_memory,
            all_pages_in_memory);
      IF NOT all_pages_in_memory THEN
          mmp$assign_pages (read_description^ [1].buffer_area, bytes_to_force_into_memory,
                FALSE, osc$wait, status);
          IF NOT status.normal THEN
            IF status.condition = mme$assign_length_too_long THEN
              { This condition is ignored.  It indicates that the length of our buffer,  }
              { plus the current working set, exceeds the jobs working set limit.  Since }
              { open processing disallows opening with a MAXBL larger than the working   }
              { set limit we can simply ignore this error and allow the page touching    }
              { algorithm in tape queue manager to bring the pages into the working set. }
            ELSE
              RETURN;
            IFEND;
          IFEND;
      IFEND;
    ELSE
      mmp$advise_in (read_description^ [1].buffer_area, bytes_to_force_into_memory, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
    bap$read_tape (bmd^.sfid, bgd^.requested_read_length, read_description, bmd^.buffer_group_size, bmd^.
          system_media_recovery, io_id, status);
    IF status.normal THEN
      bgd^.group_state := bac$group_io_pending;
      bgd^.blks_requested_to_be_transfered := bmd^.buffer_group_size;
      bgd^.io_id := io_id;
    IFEND;

  PROCEND initiate_read;

?? TITLE := 'PROCEDURE initiate_write', EJECT ??

  PROCEDURE initiate_write (buffer_group: bat$tape_buffer_group_index;
        block_ptr: ^bat$tape_block;
        block_length: amt$max_block_length;
    VAR status: ost$status);

    VAR
      group_description: ^bat$tape_buffer_grp_descriptor,
      write_description: ^iot$write_tape_description,
      block_count: iot$tape_block_count,
      i: integer,
      j: integer,
      block_buffer_length: integer,
      bytes_to_force_into_memory: integer,
      all_pages_in_memory: boolean,
      io_id: iot$io_id;

    status.normal := TRUE;

    group_description := bmd^.buffer_group [buffer_group];

    IF group_description^.group_state <> bac$group_contains_data THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Wrong group state in initiate_single_write', status);
      RETURN;
    IFEND;

    write_description := ^bmd^.buffer_group [buffer_group]^.write_description;

    IF block_ptr <> NIL THEN

      IF NOT bmd^.direct_io THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'Block pointer given for indirect write in initate_write', status);
        RETURN;
      IFEND;
      write_description^ [1].buffer_area := block_ptr;
      write_description^ [1].transfer_length := block_length;
      block_count := 1;
      bytes_to_force_into_memory := block_length;

    ELSE

      IF bmd^.direct_io THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
          'NIL block pointer given for direct write in initate_write', status);
        RETURN;
      IFEND;

{     When writing, the only group that can have a buffer_index <> 1 is the group at
{     physical_position.  If initiating write on any other group, start from first buffer.

      IF buffer_group = bmd^.physical_position.buffer_group THEN
        j := bmd^.physical_position.buffer_index;
      ELSE
        j := 1;
      IFEND;

      block_count := group_description^.last_buffer_with_data - j + 1;

    /set_up_for_the_write/
      FOR i := 1 TO block_count DO
        write_description^ [i].buffer_area := group_description^.block_buffer [j].block_buffer;
        write_description^ [i].transfer_length := group_description^.block_buffer [j].block_length.length;
        j := j + 1;
      FOREND /set_up_for_the_write/;
      block_buffer_length := ((bmd^.max_block_length + 7) DIV 8) * 8;
      bytes_to_force_into_memory := block_buffer_length * block_count;

    IFEND;

    IF bav$use_assign_pages_for_tape THEN
      mmp$check_if_pages_in_memory (write_description^ [1].buffer_area, bytes_to_force_into_memory,
            all_pages_in_memory);
      IF NOT all_pages_in_memory THEN
        mmp$advise_in (write_description^ [1].buffer_area, bytes_to_force_into_memory, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        mmp$touch_all_pages (write_description^ [1].buffer_area, bytes_to_force_into_memory);
      IFEND;
    ELSE
      mmp$advise_in (write_description^ [1].buffer_area, bytes_to_force_into_memory, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      mmp$touch_all_pages (write_description^ [1].buffer_area, bytes_to_force_into_memory);
    IFEND;
    bap$write_tape (bmd^.sfid, write_description, block_count, bmd^.system_media_recovery, io_id, status);
    IF status.normal THEN
      group_description^.group_state := bac$group_io_pending;
      group_description^.blks_requested_to_be_transfered := block_count;
      group_description^.io_id := io_id;
    IFEND;

  PROCEND initiate_write;

?? TITLE := 'PROCEDURE menu_tape_fatal_error_recovery', EJECT ??

  PROCEDURE menu_tape_fatal_error_recovery
    (    operation_mode: bat$tape_fatal_recovery_mode;
         tape_failure_modes: amt$tape_failure_modes;
     VAR attempt_recovery: boolean;
     VAR attempt_close: boolean;
     VAR status: ost$status);

{ This procedure performs the following algorithm's to allow recovery from a fatal tape error:
{
{  1. Determines (from the passed operation_mode), what menu to present to the operator.
{  2. Will not present a menu (allows fatal error to be returned to tape operator), if the error
{     occurred while a tape was being labelled. Call for write from the module DMM$INITIALIZE_TAPE_VOLUME.
{  3. Sets the VAR parameter booleans (attempt_recovery and attempt_close), and the boolean in each
{     separate read block buffer (attempt_recovery) according to the response chosen by the operator.
{     The operator responses have the options of 1 (attempt_recovery), 2 (NOT attempt_recovery), and
{     3 (attempt_close). The operator options were mapped to local file booleans so the recovery choice
{     is contained within the local file, thus recovery flags are localized and tape recovery will be able
{     to handle asyncronized tape I/O if it comes to be (do a GET without wait and return later for status)!
{  4. If operator response is 1, attempt recovery is set TRUE, the tape involved is unloaded and a mount
{     request is issued to have the tape remounted. The position of the tape at error time is preserved
{     in the tape job unit descriptor. The tape is then positioned to the block prior to where the fatal
{     error occurred. The current position is then verified against the historical position at error time.
{     The attempt_recovery boolean is set TRUE, and a RETURN or exit from the procedure is completed.
{  5. If the operator response is a 2 (No Recovery), both attempt_recovery and attempt_close are set FALSE,
{     and the procedure exited.
{  6. If the operator response is a 3, the VAR boolean attempt_close is set TRUE and the procedure exited.
{     The attempt_close flag will cause the tape subsystem to emulate END_OF_TAPE status and advance to a new
{     tape volume.
{  7. The reassignment of a tape for fatal error recovery must have the tape placed on the same type equipment
{     that caused the fatal error. This is due to the hardware differences in the polynomial generator of the
{     tape controllers causing different block_id's to be generated for the same data block on different
{     equipment. If the polynomial hardware generation for block_id's is the same between different
{     controllers, then those equipments are compatible and can be interchanged for fatal error recovery.


    CONST
      element_name_max = 10;

    VAR
      access_mode: pft$usage_selections,
      bid_index: iot$bid_index,
      count: integer,
      current_volume: amt$volume_number,
      current_vsns: rmt$volume_descriptor,
      density: rmt$density,
      element_name: cmt$element_name,
      historical_position: iot$tape_position,
      i: integer,
      ignore_status: ost$status,
      integer_string: ost$string,
      labelled: boolean,
      label_type: amt$label_type,
      loop: boolean,
      lun: iot$logical_unit,
      number_of_choices: oft$number_of_choices,
      number_of_volumes: amt$volume_number,
      op_mode: bat$tape_fatal_recovery_mode,
      parameter_names: ^ost$parameter_help_names,
      position: iot$tape_position,
      repeat_count: iot$tape_block_count,
      requested_volume_attributes: iot$requested_volume_attributes,
      response: oft$number_of_choices,
      response_string: ost$string,
      recovery_failure_mode: amt$tape_failure_modes,
      seed_name: pmt$program_name,
      string_size: ost$name_size,
      tape_error: amt$tape_failure_mode,
      menu_parameters: array [1 .. 5] of ^ost$message_parameter,
      terminate_reason: string (osc$max_string_size),
      unique: boolean,
      volume_overflow_allowed: boolean,
      write_ring: rmt$write_ring;

    status.normal := TRUE;

{ Set default operator response to not attempt recovery and allow fatal error to occurr.

    attempt_recovery := FALSE;
    attempt_close := FALSE;
    op_mode := operation_mode;
    recovery_failure_mode := tape_failure_modes;

{ No tape fatal error recovery processing done when an INTITIALIZE_TAPE_VOLUME operation caused
{ the fatal error. We do not want to present recovery option menu's when labeling a tape, but
{ simply let the fatal tape error be returned to the operator.

    IF dmv$initialize_tape_volume.in_progress THEN
      RETURN;
    IFEND;

{ Obtain the logical unit number of the tape device involved in the original fatal error call.

    dmp$convert_sfid_to_lun (bmd^.sfid, lun, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dmp$get_tape_volume_information (bmd^.sfid, number_of_volumes, current_volume, current_vsns, density,
          write_ring, requested_volume_attributes, volume_overflow_allowed, label_type,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (label_type = amc$unlabelled) THEN
      labelled := FALSE;
    ELSE
      labelled := TRUE;
    IFEND;

{ Obtain the position of the tape at the original fatal error time.

    iop$get_position_of_tape_file (lun, position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Save as historical position of the tape at error the original fatal error time for
{ comparison when repositioning is complete.

    historical_position := position;

{ Assure uniqueness in historical_bid_window (there is at least 2 block_id's that are different)
{ This only need be done at the time of the original error.  If errors occur during respoitioning,
{ we do not care if the block_id window is unique at that point.

    IF historical_position.unit_type = ioc$reel_to_reel THEN
      unique := FALSE;
    /uniqueness/
      FOR bid_index := LOWERVALUE (iot$bid_index) TO UPPERVALUE (iot$bid_index) - 1 DO
        IF historical_position.historical_bid_window [bid_index] <>
              historical_position.historical_bid_window [bid_index + 1] THEN
          unique := TRUE;
          EXIT /uniqueness/;
        IFEND;
      FOREND /uniqueness/;
    ELSE
      unique := TRUE;  { cartridge tape block_id is always unique
    IFEND;

{ If 32 decimal block_id window has all entries the same, do not attempt recovery.
{ Return with error that was reported at fatal error time.

    IF NOT unique THEN
      RETURN;
    IFEND;

  /tape_fatal_error_recovery/
    WHILE TRUE DO

      response := 2;
      attempt_recovery := FALSE;

      cmp$get_element_name_via_lun (lun, element_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      string_size := clp$trimmed_string_size (element_name);

{ Check if original tape position was at loadpoint and error was on attempting to write 1st record off
{ loadpoint. This check is meaningless if we are here because of an error in reassignement, rewind, or
{ repositioning. The displays for repositioning errors, rewind_errors, reassignment_errors will present the
{ same menu whether we are at loadpoint or away from loadpoint. So if were here because of an error in
{ repositioning, the menu presented indicates the repositioning problem. The additional check for the
{ blocks_from_loadpoint to be zero on a loadpoint check is only to assure everything is as expected. There
{ should never be an occurence where loadpoint is indicated and blocks_from_loadpoint is non-zero (a system
{ error could be inserted for that condition, but we presently will be unable to recover as the historical
{ and current information will not match.

      IF (historical_position.tape_position = ioc$tape_at_loadpoint_position) AND
                  (historical_position.blocks_from_loadpoint = 0) THEN
        IF (labelled) AND ((op_mode = bac$tfrm_fatal_write) OR
              (op_mode = bac$tfrm_fatal_data_write)) THEN
          seed_name := rmc$loadpoint_error_recovery;
          menu_parameters [4] := ^current_vsns.recorded_vsn;
        ELSE

{ Present generic loadpoint menu.

          seed_name := rmc$generic_error_recovery;
          CASE op_mode OF

          = bac$tfrm_fatal_write, bac$tfrm_fatal_data_write =
            PUSH menu_parameters [4]: [5];
            menu_parameters [4]^ := 'write';
            PUSH menu_parameters [5]: [12];
            menu_parameters [5]^ := 'at loadpoint';

          = bac$tfrm_fatal_read =
            PUSH menu_parameters [4]: [4];
            menu_parameters [4]^ := 'read';
            PUSH menu_parameters [5]: [12];
            menu_parameters [5]^ := 'at loadpoint';

          = bac$tfrm_fatal_write_tapemark =
            PUSH menu_parameters [4]: [5];
            menu_parameters [4]^ := 'write';
            PUSH menu_parameters [5]: [33];
            menu_parameters [5]^ := 'at loadpoint (writing a tapemark)';

          = bac$tfrm_fatal_rewind =
            menu_parameters [4] := NIL;
            PUSH menu_parameters [5]: [13];
            menu_parameters [5]^ := 'during rewind';

          = bac$tfrm_repositioning_error =
            menu_parameters [4] := NIL;
            PUSH menu_parameters [5]: [20];
            menu_parameters [5]^ := 'during repositioning';

          = bac$tfrm_reassignment_error =
            menu_parameters [4] := NIL;
            PUSH menu_parameters [5]: [19];
            menu_parameters [5]^ := 'during reassignment';

          ELSE

{ We should never arrive here, as every tape operation calling this procedure is interrogated
{ in the above CASE statement. If we do arrive here, we return original fatal error to user, and
{ set abnormal status.

          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'illegal operation_mode in menu_tape_fatal_error_recovery', status);

            RETURN;
          CASEND;
        IFEND;
      ELSE

{ Present correct menu for tape fatal error recovery out and away from loadpoint.

        CASE op_mode OF

        = bac$tfrm_fatal_data_write =
          seed_name := rmc$write_error_recovery;
          clp$convert_integer_to_string (position.blocks_from_loadpoint + 1, 10, FALSE, integer_string,
                ignore_status);
          menu_parameters [4] := ^integer_string.value(1, integer_string.size);

        = bac$tfrm_fatal_write =
          seed_name := rmc$generic_error_recovery;
          PUSH menu_parameters [4]: [5];
          menu_parameters [4]^ := 'write';
          clp$convert_integer_to_string (position.blocks_from_loadpoint + 1, 10, FALSE, integer_string,
                ignore_status);
          PUSH menu_parameters [5]: [integer_string.size + 9];
          menu_parameters [5]^ (1, 9) := 'at block ';
          menu_parameters [5]^ (10, integer_string.size) := integer_string.value(1, integer_string.size);

        = bac$tfrm_fatal_write_tapemark =
          seed_name := rmc$generic_error_recovery;
          PUSH menu_parameters [4]: [5];
          menu_parameters [4]^ := 'write';
          clp$convert_integer_to_string (position.blocks_from_loadpoint + 1, 10, FALSE, integer_string,
                ignore_status);
          PUSH menu_parameters [5]: [integer_string.size + 30];
          menu_parameters [5]^ (1, 9) := 'at block ';
          menu_parameters [5]^ (10, integer_string.size) := integer_string.value(1, integer_string.size);
          menu_parameters [5]^ (integer_string.size + 10, 21) := ' (writing a tapemark)';

        = bac$tfrm_fatal_read =
          seed_name := rmc$generic_error_recovery;
          PUSH menu_parameters [4]: [4];
          menu_parameters [4]^ := 'read';
          clp$convert_integer_to_string (position.blocks_from_loadpoint + 1, 10, FALSE, integer_string,
                ignore_status);
          PUSH menu_parameters [5]: [integer_string.size + 9];
          menu_parameters [5]^ (1, 9) := 'at block ';
          menu_parameters [5]^ (10, integer_string.size) := integer_string.value(1, integer_string.size);

        = bac$tfrm_fatal_rewind =
          seed_name := rmc$generic_error_recovery;
          menu_parameters [4] := NIL;
          PUSH menu_parameters [5]: [13];
          menu_parameters [5]^ := 'during rewind';

        = bac$tfrm_repositioning_error =
          seed_name := rmc$generic_error_recovery;
          menu_parameters [4] := NIL;
          PUSH menu_parameters [5]: [20];
          menu_parameters [5]^ := 'during repositioning';

        = bac$tfrm_reassignment_error =
          seed_name := rmc$generic_error_recovery;
          menu_parameters [4] := NIL;
          PUSH menu_parameters [5]: [19];
          menu_parameters [5]^ := 'during reassignment';

        ELSE

{ We should not arrive here, as every tape operation calling this procedure is interrogated
{ in the above CASE statement. If we do arrive here, we return original fatal error to user, and
{ set abnormal status.

          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'illegal operation_mode in menu_tape_fatal_error_recovery', status);

          RETURN;
        CASEND;
      IFEND;

{ Set element name in menu.
{ Use the elipse (..) to indicate element name is longer than presented on menu.


      IF string_size <= element_name_max THEN
        menu_parameters [2] := ^element_name (1, string_size);
      ELSE
        PUSH menu_parameters [2]: [element_name_max + 1];
        menu_parameters [2]^ := element_name (1, string_size);
        menu_parameters [2]^ (element_name_max, 2) := '..';
      IFEND;

{ Set external volume serial number (evsn) in menu.

      menu_parameters [1] := ^current_vsns.external_vsn;

{ Place tape_failure_modes on the menu.

      PUSH menu_parameters [3]: [20];
      IF recovery_failure_mode = $amt$tape_failure_modes [] THEN
        menu_parameters [3]^ := 'unknown failure mode';
      ELSE
       /determine_failure_mode/
        FOR tape_error := LOWERVALUE (amt$tape_failure_mode) TO UPPERVALUE (amt$tape_failure_mode) DO
          IF tape_error IN recovery_failure_mode THEN
            CASE tape_error OF
            = amc$tfm_agc_gains_not_set =
              menu_parameters [3]^ := 'agc_gains_not_set';
            = amc$tfm_bad_id_burst =
              menu_parameters [3]^ := 'bad_id_burst';
            = amc$tfm_blank_tape_read =
              menu_parameters [3]^ := 'blank_tape_read';
            = amc$tfm_data_parity_error =
              menu_parameters [3]^ := 'data_parity_error';
            = amc$tfm_device_not_ready =
              menu_parameters [3]^ := 'device_not_ready';
            = amc$tfm_erase_error =
              menu_parameters [3]^ := 'erase_error';
            = amc$tfm_record_fragment =
              menu_parameters [3]^ := 'record_fragment';
            = amc$tfm_hardware_failure =
              menu_parameters [3]^ := 'hardware_failure';
            ELSE
              menu_parameters [3]^ := 'unknown failure mode';
            CASEND;
            EXIT /determine_failure_mode/;
          IFEND;
        FOREND /determine_failure_mode/;
      IFEND;

{ Present correct menu to operator. Number of options presented is either 2 or 3.

      IF (op_mode = bac$tfrm_fatal_data_write) THEN
        number_of_choices := 3;
        PUSH parameter_names: [1 .. number_of_choices];
        parameter_names^ [1] := 'CONTINUE_SAME_VOLUME';
        parameter_names^ [2] := 'NO_RECOVERY';
        parameter_names^ [3] := 'CONTINUE_NEXT_VOLUME';
        ofp$format_operator_menu (seed_name, parameter_names, ^menu_parameters, number_of_choices,
              ofc$removable_media_operator, response, response_string, status);
      ELSE
        number_of_choices := 2;
        PUSH parameter_names: [1 .. number_of_choices];
        parameter_names^ [1] := 'ATTEMPT_RECOVERY';
        parameter_names^ [2] := 'NO_RECOVERY';
        ofp$format_operator_menu (seed_name, parameter_names, ^menu_parameters, number_of_choices,
              ofc$removable_media_operator, response, response_string, status);
      IFEND;

{ All calls to this procedure (MENU_TAPE_FATAL_ERROR_RECOVERY), will investigate two boolean VAR
{ passed parameters upon return from the menu call to determine the operator option chosen (1, 2, 3).
{ If operator response is to attempt recovery, this procedure (prior to retruning to caller) will unload
{ the tape in error and cause a MOUNT message to be issued for the tape in error. If reposition is necessary,
{ the tape is forspaced the correct number of blocks and the ATTEMPT_RECOVERY VAR boolean is set TRUE.
{ Attempt_recovery maps to the Operator choosing Option 1. Option 2 is No Recovery. Option 3 (when presented)
{ will set the VAR boolean ATTEMPT_CLOSE to TRUE. The calling routine will emulate an END_OF_TAPE condition
{ and if the Close Volume succeeds, the writing of data is continued on the next tape Volume assigned.

      IF (response = 1) THEN

{ Unload the tape in error and cause a mount request to be posted for the tape.
{ Force write access_mode default to eliminate access_mode interrogation for unload.

        access_mode := $pft$usage_selections [pfc$shorten, pfc$append, pfc$modify];
        dmp$unload_remount_tape_volume (bmd^.sfid, access_mode, {recovery_remount} TRUE, status);
        IF NOT status.normal THEN
          IF (status.condition = dme$operator_stop) OR (status.condition = dme$termination_condition) THEN
            status.normal := TRUE;  { Return with attempt_recovery = FALSE, original error is returned to user
            RETURN;
          IFEND;

{ Reset the logical unit number as a different unit may have been assigned.
{ If status is abnormal, ignore status and return attempt_recovery = FALSE.  Status
{ may be abnormal if the new volume was not assigned yet.

          dmp$convert_sfid_to_lun (bmd^.sfid, lun, status);
          IF NOT status.normal THEN
            status.normal := TRUE;
            RETURN;
          IFEND;
          recovery_failure_mode := $amt$tape_failure_modes [];
          op_mode := bac$tfrm_reassignment_error;
          CYCLE /tape_fatal_error_recovery/;
        IFEND;

{ Reset the logical unit number as a different unit may have been assigned.

        dmp$convert_sfid_to_lun (bmd^.sfid, lun, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

{ Rewind the tape and reposition (forespace) to the correct physical block.

        bap$rewind_tape (bmd^.sfid, bmd^.non_data_io_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF NOT bmd^.non_data_io_status.normal_completion THEN
          form_failure_modes (bmd^.non_data_io_status, recovery_failure_mode, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          op_mode := bac$tfrm_reassignment_error;
          CYCLE /tape_fatal_error_recovery/;
        IFEND;

{ The following RETURN is made when the fatal error, presently being processed, was not involved
{ in positioning away from loadpoint. See previous mention in this procedure for the redundant
{ check of blocks_from_loadpoint = zero.

        IF ((historical_position.tape_position = ioc$tape_at_loadpoint_position) AND
              (historical_position.blocks_from_loadpoint = 0)) OR
              (operation_mode = bac$tfrm_fatal_rewind) THEN
          attempt_recovery := TRUE;
          RETURN; {<----------
        IFEND;

        IF historical_position.blocks_from_loadpoint = 0 THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
            'Block number is zero when attempting to position tape during error recovery', status);
          RETURN;
        IFEND;

        IF historical_position.unit_type = ioc$reel_to_reel THEN

{ The following sequence forspaces the tape to the correct physical block on tape that was
{ correctly processed prior to the block that had the fatal error.

          count := historical_position.blocks_from_loadpoint;
          loop := TRUE;
          repeat_count := ioc$max_tape_blocks_to_process;
          WHILE loop DO
            IF (count > ioc$max_tape_blocks_to_process) THEN
              count := count - ioc$max_tape_blocks_to_process;
            ELSE
              repeat_count := count;
              count := 0;
              loop := FALSE;
            IFEND;
            bap$forspace_tape (bmd^.sfid, repeat_count, bmd^.non_data_io_status, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF (NOT bmd^.non_data_io_status.normal_completion) THEN
              IF (bmd^.non_data_io_status.completion_code = ioc$tapemark_read) THEN
                count := count + bmd^.non_data_io_status.residual_block_count - 1;
                IF count > 0 THEN
                  loop := TRUE;
                IFEND;
              ELSE
                form_failure_modes (bmd^.non_data_io_status, recovery_failure_mode, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                op_mode := bac$tfrm_repositioning_error;
                CYCLE /tape_fatal_error_recovery/;
              IFEND;
            IFEND;
          WHILEND;

        ELSE {cartridge tape

          iop$locate_block (lun, historical_position.last_good_bid, {bid_recovery} FALSE,
                historical_position.tapemarks_from_loadpoint, ioc$lbg_plus_count_minus_1,
                bmd^.non_data_io_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF (NOT bmd^.non_data_io_status.normal_completion) THEN
            form_failure_modes (bmd^.non_data_io_status, recovery_failure_mode, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            op_mode := bac$tfrm_repositioning_error;
            CYCLE /tape_fatal_error_recovery/;
          IFEND;
        IFEND;

{ Obtain the present position of the tape. We should be at the same physical block position on the tape
{ that was correctly processed just prior to the tape fatal error occurring.

        iop$get_position_of_tape_file (lun, position, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

{ Compare the present position of the tape against the historical position saved at fatal error time.

        IF (historical_position.tape_position = position.tape_position) AND
              (historical_position.blocks_from_loadpoint = position.blocks_from_loadpoint) AND
              (historical_position.tapemarks_from_loadpoint = position.tapemarks_from_loadpoint) THEN

          IF position.unit_type = ioc$reel_to_reel THEN
            IF (historical_position.historical_bid_index <> position.historical_bid_index) THEN
              RETURN;
            IFEND;
            FOR bid_index := LOWERBOUND (position.historical_bid_window)
                  TO UPPERBOUND (position.historical_bid_window) DO
              IF (historical_position.historical_bid_window [bid_index] <>
                    position.historical_bid_window [bid_index]) AND
                    NOT (historical_position.historical_bid_window [bid_index] = ioc$error_block_bid) THEN
                RETURN;
              IFEND;
            FOREND;
          ELSE {cartridge tape
            IF (historical_position.last_good_bid.logical_position <> position.last_good_bid.
                  logical_position) THEN
              RETURN;
            IFEND;
          IFEND;
          attempt_recovery := TRUE;
          RETURN; {<----------
        ELSE
          RETURN;
        IFEND;

{ If the Operator chose option of No Recovery, he chose the number 2 option.

    ELSEIF (response = 2) THEN

        IF (op_mode = bac$tfrm_reassignment_error) OR
              (op_mode = bac$tfrm_repositioning_error) THEN
          osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
                'Uncertain tape position on reassignment during fatal error recovery', status);
        ELSEIF (op_mode = bac$tfrm_fatal_read) AND (amc$tfm_data_parity_error IN
              recovery_failure_mode) THEN  { update block count from loadpoint
          iop$update_block_count (bmd^.sfid, status);
        IFEND;
        RETURN; {<----------

{ Option 3 of Close Volume only valid when writing a data record (not on write tapemark, read data, etc.).
{ Also, as previously mentioned, the menu with the Close Volume option is not presented if the tape drive
{ fatal error indicated the tape drive is NOT_READY.

      ELSEIF (op_mode = bac$tfrm_fatal_data_write) AND (response = 3) THEN

        attempt_close := TRUE;
        RETURN; {<----------
      IFEND

    WHILEND /tape_fatal_error_recovery/;

  PROCEND menu_tape_fatal_error_recovery;

?? TITLE := 'PROCEDURE [INLINE] perform_buffered_write', EJECT ??

  PROCEDURE [INLINE] perform_buffered_write (block_ptr: ^bat$tape_block;
        block_length: amt$max_block_length;
    VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    VAR
      buffer_info: ^bat$tape_buffer_information,
      block_to_write: ^bat$tape_block;

    status.normal := TRUE;

    ensure_write_buffer_available (write_completion, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF write_completion.end_of_tape_reflective_spot_hit OR
          (write_completion.error_type <> no_write_error) THEN
      RETURN;
    IFEND;

    buffer_info := ^bmd^.buffer_group [bmd^.logical_position.buffer_group]^.block_buffer [bmd^.
          logical_position.buffer_index];
    block_to_write := buffer_info^.block_buffer;
    IF block_ptr <> block_to_write THEN
      i#move (block_ptr, block_to_write, block_length);
    IFEND;
    buffer_info^.block_length.length := block_length;

    IF bmd^.logical_position.buffer_index = 1 THEN
      bmd^.buffer_group [bmd^.logical_position.buffer_group]^.group_state := bac$group_contains_data;
    IFEND;
    bmd^.buffer_group [bmd^.logical_position.buffer_group]^.last_buffer_with_data := bmd^.logical_position.
          buffer_index;

    { Advance logical_position to point to the next block buffer to use }

    IF bmd^.logical_position.buffer_index < bmd^.buffer_group_size THEN
      bmd^.logical_position.buffer_index := bmd^.logical_position.buffer_index + 1;
    ELSE
      IF bmd^.logical_position.buffer_group < bmd^.buffer_groups_in_use THEN
        form_tape_block_position (bmd^.logical_position, bmd^.logical_position.buffer_group + 1, 1);
      ELSE
        form_tape_block_position (bmd^.logical_position, 1, 1);
      IFEND;
    IFEND;

  PROCEND perform_buffered_write;

?? TITLE := 'PROCEDURE process_data_io_completion', EJECT ??

  PROCEDURE process_data_io_completion (buffer_group: bat$tape_buffer_group_index;
        io_status: iot$tape_io_status;
    VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    VAR
      end_of_tape_reflective_spot_hit: boolean,
      access_mode: pft$usage_selections,
      attempt_close: boolean,
      attempt_recovery: boolean,
      no_write_ring: boolean,
      write_error_encountered: boolean,
      write_failure_modes: amt$tape_failure_modes,
      blocks_transfered: iot$tape_block_count,
      current_write_buffer_index: bat$tape_block_buffer_index,
      group_description: ^bat$tape_buffer_grp_descriptor,
      write_description: ^iot$write_tape_description;

    status.normal := TRUE;
    write_completion := normal_write_completion;

    group_description := bmd^.buffer_group [buffer_group];

    process_tape_io_status (io_status, buffer_group, blocks_transfered, end_of_tape_reflective_spot_hit,
          write_error_encountered, write_failure_modes, no_write_ring, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_reading THEN

{ The following statements allow the menu call to be bypassed if the abnormal completion was due to
{ a TAPEMARK being read or the non-fatal ALERT CONDITION ENCOUNTERED error was returned (presently means
{ a block was read that was longer than the input buffer provided). The menu call is also bypassed if the
{ error was a TAPE PARITY ERROR and SYSTEM MEDIA RECOVERY was NOT TO BE USED for reading that block or
{ if some other fatal error occurred that performing fatal tape error recovery would not help.

      IF ((NOT io_status.normal_completion) AND NOT (io_status.completion_code = ioc$tapemark_read)) AND
            NOT (io_status.completion_code = ioc$alert_condition_encountered) AND
            NOT (io_status.completion_code = ioc$blank_tape) AND
            NOT (io_status.completion_code = ioc$not_capable_of_density) AND
            NOT (io_status.completion_code = ioc$read_past_phys_eot) THEN

        bmd^.buffer_group [buffer_group] ^.block_buffer [blocks_transfered].attempt_recovery := FALSE;
        IF ((bmd^.buffer_group [buffer_group] ^.block_buffer [blocks_transfered].
              system_media_recovery_used) OR ((io_status.completion_code <> ioc$tape_medium_failure) AND
              NOT (bmd^.buffer_group [buffer_group] ^.block_buffer [blocks_transfered].
              system_media_recovery_used))) THEN

          menu_tape_fatal_error_recovery (bac$tfrm_fatal_read, {failure_mode =}
                bmd^.buffer_group [buffer_group] ^.block_buffer [blocks_transfered].failure_modes,
                attempt_recovery, attempt_close, status);

          IF attempt_recovery THEN

{ Set attempt_recovery boolean in this bad block buffer to cause reread of the block in the direct_io case
{ or the buffered read case where this is the first block in the group.
{ If the error does not occur on the first block in the buffer, 1 is subtracted from blocks_transfered
{ to cause a new buffer to be initiated when the block to be retried is reached.

            bmd^.buffer_group [buffer_group] ^.block_buffer [blocks_transfered].attempt_recovery := TRUE;

            IF blocks_transfered > 1 THEN
              blocks_transfered := blocks_transfered - 1;
              form_tape_block_position (bmd^.physical_position, buffer_group, blocks_transfered);
              group_description^.group_state := bac$group_contains_data;
            ELSE
              group_description^.group_state := bac$group_empty;
            IFEND;
            group_description^.last_buffer_with_data := blocks_transfered;

          ELSE {continue with read processing, which will have a fatal error}
            form_tape_block_position (bmd^.physical_position, buffer_group, blocks_transfered);
            group_description^.group_state := bac$group_contains_data;
            group_description^.last_buffer_with_data := blocks_transfered;
          IFEND;
        ELSE {continue with read processing, which will have a fatal error}
          form_tape_block_position (bmd^.physical_position, buffer_group, blocks_transfered);
          group_description^.group_state := bac$group_contains_data;
          group_description^.last_buffer_with_data := blocks_transfered;
        IFEND;
      ELSE {continue with normal read processing}
        form_tape_block_position (bmd^.physical_position, buffer_group, blocks_transfered);
        group_description^.group_state := bac$group_contains_data;
        group_description^.last_buffer_with_data := blocks_transfered;
      IFEND;

    ELSE { writing }

      IF buffer_group <> bmd^.physical_position.buffer_group THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
              'Not at physical_position when processing data_io_completion of write', status);
        RETURN;
      IFEND;
      current_write_buffer_index := bmd^.physical_position.buffer_index + blocks_transfered;
      write_completion.end_of_tape_reflective_spot_hit := end_of_tape_reflective_spot_hit;
      IF (current_write_buffer_index = group_description^.last_buffer_with_data + 1) THEN
        IF bmd^.physical_position.buffer_group < bmd^.buffer_groups_in_use THEN
          form_tape_block_position (bmd^.physical_position, bmd^.physical_position.buffer_group + 1, 1);
        ELSE
          form_tape_block_position (bmd^.physical_position, 1, 1);
        IFEND;

        group_description^.group_state := bac$group_empty;

        IF write_error_encountered THEN
          IF bmd^.system_media_recovery THEN
            osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                  'Write error encountered after all write data transferred ', status);
            RETURN;
          ELSE
            write_completion.failure_modes := write_failure_modes;
            write_completion.error_type := write_error_previous_block;
          IFEND;
        IFEND;

      ELSE { not all data was transfered - fatal write error or EOT occurred }

        group_description^.group_state := bac$group_contains_data;

{ Set physical_position.buffer_index to point to the next block to write if I/O is continued.
{ This is the only place physical_position.buffer_index is set <> 1 when writing.

        IF no_write_ring THEN
          bmd^.fatal_write_error := TRUE;
          osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring, ' ', status);
          RETURN;
        IFEND;

        IF io_status.completion_code = ioc$write_past_phys_eot THEN
          bmd^.fatal_write_error := TRUE;
          osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                'Write past physical EOT in process_data_io_completion', status);
          RETURN;
        IFEND;

        IF write_error_encountered THEN
          write_completion.failure_modes := write_failure_modes;
          write_completion.error_type := write_error_previous_block;
        ELSEIF end_of_tape_reflective_spot_hit THEN
          ;
        ELSE
          osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
                'Not all data written in process_data_io_completion -- blocks_transfered =', status);
          osp$append_status_integer (' ', blocks_transfered, 10, TRUE, status);
          RETURN;
        IFEND;

{ The following sequence provides the tape fatal error recovery option to the operator.
{ Tape fatal error recovery will not be attempted if the error occurrs on an INITIALIZE_TAPE_VOLUME command.
{ The direct_io initiate_write call assumes the write_descriptor is intact after processing by the tape_queue_
{ manager subsystem.  Direct_io only processes one block at a time and TQM will not modify the structure.
{ An important fact to note here is the recursive call to 'await_data_io_completion' for processing the tape
{ status of the recovery attempt.

        IF (write_error_encountered) AND (bmd^.system_media_recovery) THEN
          IF (amc$tfm_device_not_ready IN write_failure_modes) THEN
            menu_tape_fatal_error_recovery (bac$tfrm_fatal_write, write_failure_modes, attempt_recovery,
                  attempt_close, status);
          ELSE
            menu_tape_fatal_error_recovery (bac$tfrm_fatal_data_write, write_failure_modes, attempt_recovery,
                  attempt_close, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          form_tape_block_position (bmd^.physical_position, buffer_group, current_write_buffer_index);

          IF attempt_recovery THEN

{ Clear local EOT indicator as EOT processing will be handled by recovery if it occurrs without error.

            end_of_tape_reflective_spot_hit := FALSE;

            IF bmd^.direct_io THEN
              write_description := ^bmd^.buffer_group [buffer_group] ^.write_description;
              initiate_write ({buffer_group =} 1, write_description^ [1].buffer_area,
                    write_description^ [1].transfer_length, status);
            ELSE
              initiate_write (bmd^.physical_position.buffer_group, {block_ptr =} NIL, 1, status);
            IFEND;
            IF NOT status.normal THEN
              RETURN;
            IFEND;

{ Recursive call to await_data_io_completion

{   Remember if hit end of tape reflector before write_completion gets cleared out on recursive call

            bmd^.write_hit_end_of_tape_reflector := bmd^.write_hit_end_of_tape_reflector OR
                  write_completion.end_of_tape_reflective_spot_hit;
            await_data_io_completion (bmd^.physical_position, write_completion, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          ELSEIF attempt_close THEN

{ We will be positioned correctly as we went through reposition to LGB when we decided to abandon
{ recovery. We will be after the LGB of data written/transferred. If the unit status was not ready
{ status, we should not be here because we would not be positioned correctly due to not being able
{ to function the unit to place us prior to the bad block (after LGB) in iop$tape_reposition_b.
{ If the write error occurred on the first physical block of a buffer group, then a backspace is
{ not possible - instead we must set status to attempt to write an end-of-volume trailer label.

            IF (bmd^.physical_position.buffer_index - 1) <> 0 THEN
              bap$backspace_tape (bmd^.sfid, bmd^.physical_position.buffer_index - 1,
                    {use_locate_block} FALSE, bmd^.non_data_io_status, status);
              IF NOT status.normal THEN
                attempt_close := FALSE;
                RETURN;
              IFEND;

              IF NOT (bmd^.non_data_io_status.normal_completion) AND
                    NOT (bmd^.non_data_io_status.completion_code = ioc$tapemark_read) THEN
                attempt_close := FALSE;
                RETURN;
              IFEND;
            IFEND;

{ Set buffer_index to point to first block in buffer group.

            form_tape_block_position (bmd^.physical_position, buffer_group, 1);
            write_completion.end_of_tape_reflective_spot_hit := TRUE;
            write_completion.error_type := no_write_error;
            write_completion.failure_modes := $amt$tape_failure_modes [];
          IFEND;
        ELSE
          form_tape_block_position (bmd^.physical_position, buffer_group, current_write_buffer_index);
        IFEND;

      IFEND; { all data transfered }

      IF end_of_tape_reflective_spot_hit AND NOT bmd^.direct_io AND status.normal AND NOT
            write_error_encountered THEN
        bap$erase_tape (bmd^.sfid, 1, {number_of_erases =} 8, bmd^.non_data_io_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF NOT bmd^.non_data_io_status.normal_completion THEN
          form_failure_modes (bmd^.non_data_io_status, write_completion.failure_modes, status);
          write_completion.error_type := write_error_previous_block;
        IFEND;
      IFEND;
    IFEND; { read or write }

  PROCEND process_data_io_completion;

?? TITLE := 'PROCEDURE process_tape_io_status', EJECT ??

  PROCEDURE process_tape_io_status (tape_status: iot$tape_io_status;
        buffer_group: bat$tape_buffer_group_index;
    VAR blocks_transfered: iot$tape_block_count;
    VAR write_hit_end_of_tape_reflector: boolean;
    VAR write_error_encountered: boolean;
    VAR write_failure_modes: amt$tape_failure_modes;
    VAR no_write_ring: boolean;
    VAR status: ost$status);

    VAR
      i: integer,
      ignore_status: ost$status,
      read_block_type: bat$tape_block_type,
      read_block_truncated: boolean,
      read_failure_modes: amt$tape_failure_modes;

    status.normal := TRUE;
    no_write_ring := FALSE;
    write_hit_end_of_tape_reflector := FALSE;
    write_error_encountered := FALSE;
    write_failure_modes := $amt$tape_failure_modes [];


    blocks_transfered := bmd^.buffer_group [buffer_group]^.blks_requested_to_be_transfered - tape_status.
          residual_block_count;
    IF (tape_status.residual_block_count < 0) OR (tape_status.residual_block_count > bmd^.buffer_group_size)
          THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Out of range tape_status.residual_block_count in process_tape_io_status --', status);
      osp$append_status_integer (' ', tape_status.residual_block_count, 10, TRUE, status);
      RETURN;
    IFEND;

    IF bmd^.io_direction = bac$iod_reading THEN

    /set_initial_block_types/
      FOR i := 1 TO blocks_transfered DO
        bmd^.buffer_group [buffer_group]^.block_buffer [i].block_type := bac$good_data_block;
        bmd^.buffer_group [buffer_group]^.block_buffer [i].block_truncated := FALSE;
        bmd^.buffer_group [buffer_group]^.block_buffer [i].failure_modes := $amt$tape_failure_modes [];
      FOREND /set_initial_block_types/;

      IF NOT tape_status.normal_completion THEN
        { Since the residual block count reflects only those blocks transfered without error, the error }
        { actually occurred on the next block.  Accordingly, we increment the blocks_transfered count here. }
        blocks_transfered := blocks_transfered + 1;
        read_block_truncated := FALSE;

        IF tape_status.completion_code = ioc$tapemark_read THEN
          read_block_type := bac$tapemark;
          read_failure_modes := $amt$tape_failure_modes [];
        ELSE { not a tapemark, must be a genuine read error }
          IF tape_status.completion_code = ioc$alert_condition_encountered THEN
            read_block_type := bac$good_data_block;
            read_block_truncated := tape_status.long_input_block;
          ELSE
            IF bmd^.buffer_group [buffer_group]^.block_buffer [blocks_transfered].block_length.length > 0 THEN
              read_block_type := bac$error_data_block;
            ELSE
              IF tape_status.completion_code = ioc$not_capable_of_density THEN
                read_block_type := bac$density_mismatch;
              ELSEIF tape_status.completion_code = ioc$read_past_phys_eot THEN
                read_block_type := bac$read_past_phys_eot;
              ELSE
                read_block_type := bac$error_without_data;
              IFEND;
            IFEND;
          IFEND;

          IF read_block_truncated OR (bmd^.buffer_group [buffer_group]^.block_buffer [blocks_transfered].
                block_length.length > bmd^.buffer_group [buffer_group]^.requested_read_length) THEN
              { The TAPE PP returns the full  record length, not the length   written to CM, when a   }
              { long_input_block is encountered.  Therefore we must reduce this count to the actual }
              { amount transfered to our buffer. }
            bmd^.buffer_group [buffer_group]^.block_buffer [blocks_transfered].block_length.length := bmd^.
                    buffer_group [buffer_group]^.requested_read_length;
          IFEND;

          form_failure_modes (tape_status, read_failure_modes, status);
          IF NOT status.normal THEN
            clear_other_pending_requests (buffer_group, ignore_status);
            RETURN;
          IFEND;
        IFEND;
        bmd^.buffer_group [buffer_group]^.block_buffer [blocks_transfered].block_type := read_block_type;
        bmd^.buffer_group [buffer_group]^.block_buffer [blocks_transfered].block_truncated :=
              read_block_truncated;
        bmd^.buffer_group [buffer_group]^.block_buffer [blocks_transfered].failure_modes :=
              read_failure_modes;
        bmd^.inhibit_read_ahead := TRUE;

        clear_other_pending_requests (buffer_group, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      IFEND; { normal completion }

    ELSE { writing }

      IF NOT tape_status.normal_completion THEN

        write_error_encountered := TRUE;
        form_failure_modes (tape_status, write_failure_modes, status);
        IF NOT status.normal THEN
          clear_other_pending_requests (buffer_group, ignore_status);
          RETURN;
        IFEND;

        IF (tape_status.completion_code = ioc$no_write_ring) THEN
          no_write_ring := TRUE;
        IFEND;

      IFEND; { normal completion }

      write_hit_end_of_tape_reflector := tape_status.end_of_tape;

      IF (NOT tape_status.normal_completion) OR write_hit_end_of_tape_reflector THEN
        clear_other_pending_requests (buffer_group, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    IFEND;

  PROCEND process_tape_io_status;

?? TITLE := 'PROCEDURE reposition_back_one_block', EJECT ??

  PROCEDURE reposition_back_one_block (VAR failure_modes: amt$tape_failure_modes;
    VAR status: ost$status);

    VAR
      ignore_write_completion: tape_write_completion;

    status.normal := TRUE;
    failure_modes := $amt$tape_failure_modes[];

    align_physical_logical_position (ignore_write_completion, status);
    IF NOT status.normal THEN
      failure_modes := ignore_write_completion.failure_modes;
      RETURN;
    IFEND;
    reset_buffer_pointers;

    bap$backspace_tape (bmd^.sfid, {count =} 1, {use_locate_block} FALSE, bmd^.non_data_io_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT bmd^.non_data_io_status.normal_completion THEN
      IF bmd^.non_data_io_status.completion_code = ioc$tapemark_read THEN
        ; { A tapemark is ok }
      ELSE
        form_failure_modes (bmd^.non_data_io_status, failure_modes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        osp$set_status_abnormal (bac$basic_access_id, bae$uncertain_tape_position,
          'Tape position lost in bam$tape_block_manager - reposition_back_one_block', status);
      IFEND;
    IFEND;

  PROCEND reposition_back_one_block;

?? TITLE := 'PROCEDURE reset_buffer_pointers', EJECT ??

  PROCEDURE reset_buffer_pointers;

    VAR
      initial_position: [READ, STATIC, oss$job_paged_literal] bat$tape_block_position := [1, 1];

    VAR
      i: bat$tape_buffer_group_index;

    FOR i := 1 TO bmd^.buffer_groups_in_use DO
      bmd^.buffer_group [i]^.group_state := bac$group_empty;
    FOREND;
    bmd^.logical_position := initial_position;
    bmd^.physical_position := initial_position;
    bmd^.buffer_reserved := FALSE;

  PROCEND reset_buffer_pointers;

?? TITLE := 'PROCEDURE terminate_volume', EJECT ??

  PROCEDURE terminate_volume (VAR write_completion: tape_write_completion;
    VAR status: ost$status);

    { This procedure writes the two tapemarks which indicate the end of a volume }
    { The tape is left positioned BEFORE the two tapemarks .}

    VAR
      attempt_close: boolean,
      attempt_recovery: boolean,
      tapemark_count: 1 .. 2;

    status.normal := TRUE;
    write_completion := normal_write_completion;

  /terminate_the_volume/
    BEGIN

      FOR tapemark_count := 1 TO 2 DO
       /fatal_write_tapemark_loop/
        WHILE TRUE DO
          bap$write_tapemark (bmd^.sfid, bmd^.non_data_io_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF NOT bmd^.non_data_io_status.normal_completion THEN
            write_completion.error_type := write_error_last_block;
            form_failure_modes (bmd^.non_data_io_status, write_completion.failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            IF bmd^.non_data_io_status.completion_code = ioc$no_write_ring THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring,
                    ' ', status);
              bmd^.fatal_write_error := TRUE;
              EXIT /terminate_the_volume/;
            ELSEIF bmd^.non_data_io_status.completion_code = ioc$write_past_phys_eot THEN
              osp$set_status_abnormal (bac$basic_access_id, bae$motion_past_phys_eot,
                    'Write past physical EOT in bap$tape_bm_write_tapemark', status);
              bmd^.fatal_write_error := TRUE;
              EXIT /terminate_the_volume/;
            ELSE
              menu_tape_fatal_error_recovery (bac$tfrm_fatal_write_tapemark, write_completion.failure_modes,
                    attempt_recovery, attempt_close, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

{ Cycle to retry write tapemark if operator chose response of 1 (attempt_recovery).

              IF attempt_recovery THEN
                CYCLE /fatal_write_tapemark_loop/
              IFEND;
              bmd^.fatal_write_error := TRUE;
              EXIT /terminate_the_volume/;
            IFEND;
          IFEND;
          write_completion := normal_write_completion;
          EXIT /fatal_write_tapemark_loop/;
        WHILEND /fatal_write_tapemark_loop/;
      FOREND;

      write_completion.end_of_tape_reflective_spot_hit := bmd^.non_data_io_status.end_of_tape;

    /reposition_before_the_tapemarks/
      FOR tapemark_count := 1 TO 2 DO
        bap$backspace_tape (bmd^.sfid, {count =} 1, {use_locate_block} FALSE, bmd^.non_data_io_status,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF bmd^.non_data_io_status.normal_completion THEN
          { Shouldn't complete normally -- should have hit a tapemark }
          write_completion.error_type := write_error_last_block;
          write_completion.failure_modes := $amt$tape_failure_modes [];
        ELSE { This is the normal case }
          IF bmd^.non_data_io_status.completion_code <> ioc$tapemark_read THEN
            write_completion.error_type := write_error_last_block;
            form_failure_modes (bmd^.non_data_io_status, write_completion.failure_modes, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            EXIT /terminate_the_volume/;
          IFEND;
        IFEND;
      FOREND /reposition_before_the_tapemarks/;

    END /terminate_the_volume/;

  PROCEND terminate_volume;

?? TITLE := 'PROCEDURE validate_call', EJECT ??

  PROCEDURE validate_call (file_id: amt$file_identifier;
        caller_ring: ost$valid_ring;
        access_mode: tape_block_access_mode;
        procedure_name: string ( * );
    VAR file_instance: ^bat$task_file_entry;
    VAR loaded_bmd: ^bat$tape_block_mgmt_descriptor;
    VAR status: ost$status);

    VAR
      tape_descriptor: ^bat$tape_descriptor,
      valid_file_id: boolean;

    bap$validate_file_identifier (file_id, file_instance, valid_file_id);
    IF NOT valid_file_id THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$improper_file_id, 'Improper file id passed to',
            status);
      osp$append_status_parameter (' ', procedure_name, status);
      RETURN;
    IFEND;
    tape_descriptor := bai$tape_descriptor (file_instance);

    CASE access_mode OF
    = open_access =
      { open access allows the block management descriptor pointer  to be NIL }
      validate_non_data_access (file_id, caller_ring, file_instance, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      loaded_bmd := tape_descriptor^.block_management_descriptor;
    = read_access =
      validate_read_access (file_id, caller_ring, file_instance, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      loaded_bmd := tape_descriptor^.block_management_descriptor;
      IF loaded_bmd = NIL THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$improper_file_id,
          'NIL block management descriptor in ', status);
        osp$append_status_parameter (' ', procedure_name, status);
        RETURN;
      IFEND;
    = write_access =
      validate_write_access (file_id, caller_ring, file_instance, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      loaded_bmd := tape_descriptor^.block_management_descriptor;
      IF loaded_bmd = NIL THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$improper_file_id,
          'NIL block management descriptor in ', status);
        osp$append_status_parameter (' ', procedure_name, status);
        RETURN;
      IFEND;
      IF NOT bmd^.tape_has_write_ring THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$no_tape_write_ring, procedure_name, status);
        RETURN;
      IFEND;
    = non_data_transfer_access =
      validate_non_data_access (file_id, caller_ring, file_instance, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      loaded_bmd := tape_descriptor^.block_management_descriptor;
      IF loaded_bmd = NIL THEN
        osp$set_status_abnormal (bac$basic_access_id, bae$improper_file_id,
          'NIL block management descriptor in ', status);
        osp$append_status_parameter (' ', procedure_name, status);
        RETURN;
      IFEND;
    ELSE
      osp$set_status_abnormal (bac$basic_access_id, bae$tape_block_mgr_malfunction,
        'Illegal access mode in validate_call', status);
      RETURN;
    CASEND;

  PROCEND validate_call;

?? TITLE := 'PROCEDURE [INLINE] validate_non_data_access', EJECT ??

  PROCEDURE [INLINE] validate_non_data_access (file_id: amt$file_identifier;
        ring: ost$valid_ring;
        file_instance: ^bat$task_file_entry;
    VAR status: ost$status);

    status.normal := TRUE;

    IF ring > file_instance^.instance_attributes.static_label.ring_attributes.r2 THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$ring_validation_error,
        'non data transfer ring validation error in bam$tape_block_manager_ring3', status);
    IFEND;

  PROCEND validate_non_data_access;

?? TITLE := 'PROCEDURE [INLINE] validate_read_access', EJECT ??

  PROCEDURE [INLINE] validate_read_access (file_id: amt$file_identifier;
        ring: ost$valid_ring;
        file_instance: ^bat$task_file_entry;
    VAR status: ost$status);

    status.normal := TRUE;

    IF ring > file_instance^.instance_attributes.static_label.ring_attributes.r2 THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$ring_validation_error,
        'read ring validation error in bam$tape_block_manager_ring3', status);

    ELSEIF NOT (pfc$read IN file_instance^.instance_attributes.dynamic_label.access_mode) THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$improper_input_attempt,
        'READ access is required to read a tape', status);
    IFEND;

  PROCEND validate_read_access;
?? TITLE := 'PROCEDURE validate_tape_assignment', EJECT ??

  PROCEDURE validate_tape_assignment (
        file_id: amt$file_identifier;
        file_instance: ^bat$task_file_entry;
        sfid: gft$system_file_identifier;
        label_type: amt$label_type;
        initial_assignment: boolean;
        next_volume: amt$volume_number;
    VAR status: ost$status);

    VAR
      current_volume: amt$volume_number,
      current_vsns: rmt$volume_descriptor,
      density: rmt$density,
      ignore_label_type: amt$label_type,
      number_of_volumes: amt$volume_number,
      operator_terminated_assignment: boolean,
      requested_volume_attributes: iot$requested_volume_attributes,
      tape_validation: boolean,
      validation_state: bat$tape_validation_state,
      volume_descriptor: rmt$volume_descriptor,
      volume_info: array [1 .. 1] of fmt$volume_info,
      volume_overflow_allowed: boolean,
      write_ring: rmt$write_ring;

    volume_descriptor := blank_tape_volume;
    dmp$get_tape_volume_information (sfid, number_of_volumes, current_volume, current_vsns, density,
          write_ring, requested_volume_attributes, volume_overflow_allowed, ignore_label_type,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF next_volume <= number_of_volumes THEN
      volume_info [1].key := fmc$volume;
      volume_info [1].requested_volume_number := next_volume;
      fmp$get_files_volume_info (file_instance^.local_file_name, volume_info, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF volume_info [1].item_returned THEN
        volume_descriptor.recorded_vsn := volume_info [1].volume.recorded_vsn;
        volume_descriptor.external_vsn := volume_info [1].volume.external_vsn;
      IFEND;
    IFEND;

    bap$fetch_tape_validation (validation_state, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF validation_state <> bac$no_tape_validation THEN
      tape_validation := (validation_state = bac$tape_validation_on);
      rmp$validate_tape_assignment (tape_validation, file_id, file_instance^.local_file_name,
            density, write_ring, label_type, file_instance^.instance_attributes.
            dynamic_label.access_mode, initial_assignment, next_volume, volume_descriptor,
            requested_volume_attributes.removable_media_group, requested_volume_attributes.
            removable_media_location, status);
    ELSE
      rmp$complete_tape_assignment (file_id, file_instance^.local_file_name, density, write_ring,
            label_type, file_instance^.instance_attributes.dynamic_label.access_mode,
            initial_assignment, next_volume, volume_descriptor, requested_volume_attributes.
            removable_media_group, requested_volume_attributes.removable_media_location,
            operator_terminated_assignment, status);
    IFEND;

  PROCEND validate_tape_assignment;

?? TITLE := 'PROCEDURE [INLINE] validate_write_access', EJECT ??

  PROCEDURE [INLINE] validate_write_access (file_id: amt$file_identifier;
        ring: ost$valid_ring;
        file_instance: ^bat$task_file_entry;
    VAR status: ost$status);

    status.normal := TRUE;

    IF ring > file_instance^.instance_attributes.static_label.ring_attributes.r1 THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$ring_validation_error,
        'write ring validation error in bam$tape_block_manager_ring3', status);

    ELSEIF ($pft$usage_selections [pfc$append, pfc$shorten, pfc$modify] * file_instance^.instance_attributes.
          dynamic_label.access_mode) = $pft$usage_selections [] THEN
      osp$set_status_abnormal (bac$basic_access_id, bae$improper_access_attempt,
        'APPEND, SHORTEN or MODIFY is required to write on tape', status);

    IFEND;

  PROCEND validate_write_access;

?? EJECT ??

{
{ This procedure calls BAP$FETCH_TAPE_VALIDATION_R1 to obtain the current tape validation state.
{

  PROCEDURE [XDCL, #GATE] bap$fetch_tape_validation (
    VAR tape_validation_state: bat$tape_validation_state;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      validation_state: bat$tape_validation_state;


    #CALLER_ID (caller_id);
    status.normal := TRUE;
    IF caller_id.ring > osc$tsrv_ring THEN
      IF NOT (avp$configuration_administrator () OR avp$system_displays () OR
               avp$removable_media_operator ()) THEN
        osp$set_status_abnormal ('OF', ofe$sou_not_active,
             'configuration_administration, system_displays, removable_media_operation', status);
        RETURN;
      IFEND;
      osp$verify_system_privilege;
    IFEND;

    bap$fetch_tape_validation_r1 (validation_state, status);
    IF status.normal THEN
      tape_validation_state := validation_state;
    IFEND;
  PROCEND bap$fetch_tape_validation;

?? EJECT ??

{
{ This procedure calls BAP$STORE_TAPE_VALIDATION_R1 to change the tape validation state.
{

  PROCEDURE [XDCL, #GATE] bap$store_tape_validation (
        tape_validation_state: bat$tape_validation_state;
    VAR status: ost$status);

    VAR
      validation_state: bat$tape_validation_state;

    status.normal := TRUE;
    IF NOT avp$configuration_administrator () THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active, 'configuration_administration', status);
      RETURN;
    IFEND;

{ Reference input parameter here. If NIL pointer is passed in access violation will be returned to user.

    validation_state := tape_validation_state;
    bap$store_tape_validation_r1 (tape_validation_state, status);

  PROCEND bap$store_tape_validation;

?? EJECT ??

  PROCEDURE [XDCL, #GATE] bap$get_tape_security_state (
    VAR enforce_tape_security: bat$tape_validation_state;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      tape_security_state: bat$tape_validation_state;


    #CALLER_ID (caller_id);
    status.normal := TRUE;
    IF caller_id.ring > osc$tsrv_ring THEN
      IF NOT (avp$configuration_administrator () OR avp$system_displays () OR
               avp$removable_media_operator ()) THEN
        osp$set_status_abnormal ('OF', ofe$sou_not_active,
             'configuration_administration, system_displays, removable_media_operation', status);
        RETURN;
      IFEND;
    IFEND;
    osp$verify_system_privilege;

    bap$get_tape_security_state_r1 (tape_security_state);
    enforce_tape_security := tape_security_state;
  PROCEND bap$get_tape_security_state;
?? EJECT ??


  PROCEDURE [XDCL, #GATE] bap$put_tape_security_state (
        enforce_tape_security: bat$tape_validation_state;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      tape_security_state: bat$tape_validation_state;

    #CALLER_ID (caller_id);
    status.normal := TRUE;
    IF caller_id.ring > osc$tsrv_ring THEN
      IF NOT avp$configuration_administrator () THEN
        osp$set_status_abnormal ('OF', ofe$sou_not_active, 'configuration_administration', status);
        RETURN;
      IFEND;
    IFEND;
    osp$verify_system_privilege;

    tape_security_state := enforce_tape_security;
    bap$put_tape_security_state_r1 (tape_security_state);

  PROCEND bap$put_tape_security_state;
MODEND bam$tape_block_manager_ring3;
