*copyc osd$default_pragmats
{
{
{ DECK: IOI$TAPE_QUEUE_MANAGER
{
{
{ This deck contains all of the source code for the modules IOM$TAPE_QUEUE_MANAGER_RING2
{ and IOM$TAPE_BOOT_MANAGER.  The version which gets compiled depends on the compile
{ time variable system_version.  If system_version := TRUE, the IOM$TAPE_QUEUE_MANAGER_RING2
{ version of the code is compiled.  If system_version := FALSE, then the
{ IOM$TAPE_BOOT_MANAGER version of the code is compiled.  The boot version of the code
{ differs from the system version in the following respects:
{
{ 1.  All ALLOCATE's and FREE's must be done in mainframe_pageable instead of job_pageable.
{
{ 2.  The procedures iop$establish_tape_statistics, iop$tape_error_logging,
{     iop$tape_usage_logging, iop$write_tape and iop$write_tapemark will contain no
{     code.  The procedures are retained but do nothing if called.
{
{ 3.  The beginning of procedure iop$initialize_tape_ud differs from the system version.
{
{ NOTE - because of the above, tape error and usage logging is disabled during deadstart.
{
{ The compile time variable system_version is assumed to be defined by the calling module.

?? OLDTITLE ??
?? NEWTITLE := ' global definitions ' ??
?? EJECT ??

*copyc bav$max_bytes_per_tape_io
*copyc cmv$logical_pp_table_p
*copyc cmv$logical_unit_table
*copyc iov$establish_tape_statistics
*copyc iov$number_of_tape_units
*copyc iov$tape_completion_q_table
*copyc iov$tusl_p
*copyc oss$job_paged_literal
*copyc osv$job_pageable_heap
*copyc osv$mainframe_pageable_heap
*copyc osv$mainframe_wired_heap
*copyc osv$page_size
? IF NOT system_version THEN
*copyc osv$deadstart_device_lun
? IFEND
?? PUSH (LISTEXT := ON) ??

*copyc bat$process_pt_results
*copyc dme$tape_errors
*copyc gft$system_file_identifier
*copyc dmt$tape_initialization_record
*copyc clt$path_handle
*copyc fmp$process_pt_request
*copyc fmt$cycle_description
*copyc fmt$detachment_options
*copyc fst$evaluated_file_reference
*copyc fst$path
*copyc fst$path_size
*copyc fsv$evaluated_file_reference
*copyc ioc$max_num_tape_units
*copyc ioe$tape_io_conditions
*copyc iot$io_id
*copyc iot$io_request
*copyc iot$logical_unit
*copyc iot$no_of_tape_units
*copyc iot$pp_interface_table
*copyc iot$pp_number
*copyc iot$pp_response
*copyc iot$read_tape_description
*copyc iot$tape_block_count
*copyc iot$tape_block_id_area
*copyc iot$tape_collected_pp_response
*copyc iot$tape_command_table_entry
*copyc iot$tape_completion_packet
*copyc iot$tape_device_status
*copyc iot$tape_failure_statistic_data
*copyc iot$tape_job_statistic_data
*copyc iot$tape_job_unit_descriptor
*copyc iot$tape_position
*copyc iot$tape_request_types
*copyc iot$tape_usage_statistic_data
*copyc iot$tape_user_mesg_index
*copyc iot$unit_type
*copyc osd$integer_limits
*copyc oss$job_pageable
*copyc ost$page_size
*copyc ost$signature_lock
*copyc ost$status
*copyc ost$wait
?? POP ??

?? OLDTITLE ??
?? NEWTITLE := ' tape failure data format ' ??
?? EJECT ??
*copyc iot$tape_statistics

?? OLDTITLE ??
?? NEWTITLE := ' xref definitions ' ??
?? EJECT ??
*copyc cmp$get_element_name_via_lun
*copyc cmh$return_descriptor_data
*copyc cmp$return_descriptor_data
? IF system_version THEN
*copyc dmp$convert_sfid_to_lun
? IFEND
*copyc iop$allocate_wired_tape_tables
*copyc iop$access_tusl_entry
*copyc iop$free_wired_tape_tables
*copyc iop$tape_clear_activate_stats
*copyc iop$tape_enable_ready_task
*copyc iop$tape_enable_taskid_check
*copyc iop$tape_queue_request_setup
*copyc iop$tape_request_not_processed
*copyc iop$tape_return_wired_request
*copyc i#move
*copyc i#fill
*copyc osp$append_status_integer
*copyc osp$clear_job_signature_lock
*copyc osp$establish_condition_handler
*copyc osp$disestablish_cond_handler
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc pmp$continue_to_cause
*copyc pmp$delay
*copyc pmp$wait
*copyc sfp$activate_system_statistic
*copyc sfp$emit_statistic

?? OLDTITLE ??
?? NEWTITLE := ' module level VARS ' ??
?? EJECT ??
{The following VARS are placed at the module level to place the structures in the appropriate STATIC area.}
{The structures are also referenced by IOM$TAPE_BOOT_MANAGER and will be in WIRED for that module.}

  CONST
    max_store_unit_ready_attempts = 10,
    one_second = 1000 {milliseconds};

? IF system_version THEN

       VAR
         iov$p_statistic_data_p_array: [XDCL, STATIC]
               ^iot$statistic_data_p_array := NIL;

       VAR
         statistic_data_lock: [XDCL, STATIC] ost$signature_lock := [0];

? ELSE { do not XDCL boot version

       VAR
         iov$p_statistic_data_p_array: [STATIC]
               ^iot$statistic_data_p_array := NIL;

       VAR
         statistic_data_lock: [STATIC] ost$signature_lock := [0];

? IFEND

       VAR
? IF system_version THEN
         iov$67x_command_table: [STATIC, READ, oss$job_paged_literal] array [1 .. ioc$no_of_67x_commands]
? ELSE
         iov$67x_command_table: [STATIC] array [1 .. ioc$no_of_67x_commands]
? IFEND
           of tape_command_table_entry :=
           [[ioc$67x_cmd_pos_clear, ioc$tape_pkt_lng_clear, ioc$67x_func_clear],
           [ioc$67x_cmd_pos_rewind, ioc$tape_pkt_lng_rewind, ioc$67x_func_rewind],
           [ioc$67x_cmd_pos_unload, ioc$tape_pkt_lng_unload, ioc$67x_func_unload],
           [ioc$67x_cmd_pos_forspace, ioc$tape_pkt_lng_forspace, ioc$67x_func_forspace],
           [ioc$67x_cmd_pos_backspace, ioc$tape_pkt_lng_backspace, ioc$67x_func_backspace],
           [ioc$67x_cmd_pos_cont_backspace, ioc$tape_pkt_lng_cont_backspace, ioc$67x_func_cont_backspace],
           [ioc$67x_cmd_pos_read, ioc$tape_pkt_lng_read, ioc$67x_func_read],
           [ioc$67x_cmd_pos_read_backwards, ioc$tape_pkt_lng_read_backwards, ioc$67x_func_read_backwards],
           [ioc$67x_cmd_pos_write, ioc$tape_pkt_lng_write, ioc$67x_func_write],
           [ioc$67x_cmd_pos_loop1, ioc$tape_pkt_lng_loop1, ioc$67x_cmd_pos_loop1],
           [ioc$67x_cmd_pos_loop2, ioc$tape_pkt_lng_loop2, ioc$67x_func_loop2],
           [ioc$67x_cmd_pos_loop3, ioc$tape_pkt_lng_loop3, ioc$67x_func_loop3],
           [ioc$67x_cmd_pos_write_tapemark, ioc$tape_pkt_lng_write_tapemark, ioc$67x_func_write_tapemark],
           [ioc$67x_cmd_pos_erase, ioc$tape_pkt_lng_erase, ioc$67x_func_erase],
           [ioc$67x_cmd_pos_security_erase, ioc$tape_pkt_lng_security_erase, ioc$67x_func_security_erase],
           [ioc$67x_cmd_pos_master_clear, ioc$tape_pkt_lng_master_clear, ioc$67x_func_master_clear],
           [ioc$67x_cmd_pos_get_status, ioc$tape_pkt_lng_get_status, ioc$67x_func_get_status],
           [ioc$67x_cmd_pos_skip_tm_f, ioc$tape_pkt_lng_skip_tm_f, ioc$67x_func_skip_tm_f],
           [ioc$67x_cmd_pos_skip_tm_b, ioc$tape_pkt_lng_skip_tm_b, ioc$67x_func_skip_tm_b]],

? IF system_version THEN
         zero_ccc_cart_bid: [STATIC, READ, oss$job_paged_literal] iot$cartridge_tape_bid := [0, 0];
? ELSE
         zero_ccc_cart_bid: [STATIC] iot$cartridge_tape_bid := [0, 0];
? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' convert_sfid_to_lun ' ??
?? EJECT ??

  PROCEDURE [INLINE] convert_sfid_to_lun (
        system_file_id: gft$system_file_identifier;
    VAR logical_unit_number: iot$logical_unit;
    VAR status: ost$status);

? IF system_version THEN
    dmp$convert_sfid_to_lun (system_file_id, logical_unit_number, status);
? ELSE
    logical_unit_number := osv$deadstart_device_lun;
? IFEND

  PROCEND convert_sfid_to_lun;

?? OLDTITLE ??
?? NEWTITLE := ' iop$set_current_heap ' ??
?? EJECT ??

  PROCEDURE [INLINE] iop$set_current_heap (VAR current_heap: ^ost$heap);

? IF system_version THEN
    current_heap := osv$job_pageable_heap;
? ELSE
    current_heap := osv$mainframe_pageable_heap;
? IFEND

  PROCEND iop$set_current_heap;

?? OLDTITLE ??
?? NEWTITLE := ' iop$67x_non_data_trans_setup ' ??
?? EJECT ??

  PROCEDURE iop$67x_non_data_trans_setup (tape_unit_number: iot$logical_unit;
        tape_request_type: iot$tape_request_types;
        repeat_count: iot$tape_block_count;
        pp_unit_disable: boolean;
        physical_unload: boolean;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    VAR
      i: 0 .. ioc$max_tape_blocks_to_process,
      j: iot$tape_command_index,
      current_heap: ^ost$heap,
      p_tape_request: ^iot$tape_request,
      pkt_length: iot$tape_request_length;

    BEGIN
      status.normal := TRUE;
      io_id := 1;
      iop$set_current_heap (current_heap);

      pkt_length := iov$67x_command_table [tape_request_type].length + (repeat_count - 1) * 8;
      iop$tape_build_pp_req_header (tape_unit_number, pkt_length, p_tape_request, status);
      IF status.normal THEN
        io_id := p_tape_request^.io_id;
        j := iov$67x_command_table [tape_request_type].index;
        FOR i := 0 TO repeat_count - 1 DO
          p_tape_request^.request.tape_command [j + i].command_code := ioc$cc_function;
          p_tape_request^.request.tape_command [j + i].flags.store_response := FALSE;
          p_tape_request^.request.tape_command [j + i].flags.indirect_address := FALSE;
          p_tape_request^.request.tape_command [j + i].flags.fill := 0;
          p_tape_request^.request.tape_command [j + i].length := ioc$tape_function_code_length;
          p_tape_request^.request.tape_command [j + i].address := iov$67x_command_table [tape_request_type].
                hardware_command;
        FOREND;
        p_tape_request^.request_type := tape_request_type;

        IF (tape_request_type = ioc$tape_unload) AND (NOT physical_unload) THEN
          p_tape_request^.request.tape_command [2].address := ioc$67x_func_rewind;
        IFEND;

        IF NOT (tape_request_type = ioc$tape_erase) THEN
          p_tape_request^.ud^.consecutive_erases := 0;
        ELSE
          p_tape_request^.ud^.consecutive_erases := p_tape_request^.ud^.consecutive_erases + repeat_count;
        IFEND;

        p_tape_request^.io_type := ioc$no_io;
        p_tape_request^.initial_block_count := repeat_count;
        p_tape_request^.no_of_non_data_commands := repeat_count;
        IF (tape_request_type = ioc$tape_forspace) OR (tape_request_type = ioc$tape_backspace) THEN
          p_tape_request^.request.alert_mask.logical_delimiter := TRUE;
        IFEND;
        p_tape_request^.request.alert_mask.disabled_unit := pp_unit_disable;
        iop$tape_queue_request_setup (p_tape_request, status);
      IFEND;
      IF (p_tape_request <> NIL) AND NOT status.normal THEN
        IF NOT p_tape_request^.must_free_pageable_request THEN
          p_tape_request^.ud^.pageable_tape_requests [p_tape_request^.pageable_tape_request_index].
                slot_in_use := FALSE;
        ELSE
          FREE p_tape_request^.pp_response_p IN current_heap^;
          FREE p_tape_request IN current_heap^;
        IFEND;
      IFEND;
    END
  PROCEND iop$67x_non_data_trans_setup;

?? OLDTITLE ??
?? NEWTITLE := ' iop$67x_read_setup ' ??
?? EJECT ??

  PROCEDURE iop$67x_read_setup (tape_unit_number: iot$logical_unit;
        tape_request_type: iot$tape_request_types;
        inhibit_error_recovery: boolean;
        max_byte_count: iot$tape_block_length;
        block_description: ^iot$read_tape_description;
        no_of_blocks_to_read: iot$tape_block_count;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    VAR
      address_pair_count: 0 .. mmc$max_rma_list_length,
      current_heap: ^ost$heap,
      i: 0 .. 2 * (ioc$max_tape_blocks_to_process + 1),
      j: iot$tape_command_index,
      l: iot$tape_block_count,
      length: iot$transfer_count,
      offset: ost$segment_offset,
      page_offset: 0 .. 65536,
      p_tape_request: ^iot$tape_request,
      p_ud: ^iot$tape_job_unit_descriptor,
      pkt_length: iot$tape_request_length;

    BEGIN
      status.normal := TRUE;
      io_id := 1;
      iop$set_current_heap (current_heap);

      pkt_length := iov$67x_command_table [tape_request_type].length + (ioc$read_cmd_per_block * 8) *
            no_of_blocks_to_read;
      iop$tape_build_pp_req_header (tape_unit_number, pkt_length, p_tape_request, status);
    /build_request/
      BEGIN
        IF status.normal THEN
          io_id := p_tape_request^.io_id;
          p_ud := p_tape_request^.ud;
          IF max_byte_count > p_ud^.max_block_length THEN
             osp$set_status_abnormal ('IO', ioe$block_size_too_large, 'Block size is too large.', status);
             EXIT /build_request/
          IFEND;
          IF max_byte_count < p_ud^.min_block_length THEN
             osp$set_status_abnormal ('IO', ioe$block_size_too_small, 'Block size too small.', status);
             EXIT /build_request/
          IFEND;
          address_pair_count := 0;
          length := max_byte_count;
          j := iov$67x_command_table [tape_request_type].index;
          i := 0;
          FOR l := 1 to no_of_blocks_to_read DO
            offset := #OFFSET (block_description^[l].buffer_area);
            IF ((offset MOD 8) <> 0) THEN
              osp$set_status_abnormal ('IO', ioe$improper_data_address, 'Data buffer not word aligned.',
                   status);
              EXIT /build_request/
            IFEND;
            page_offset := offset MOD osv$page_size;
            address_pair_count := address_pair_count + (((page_offset + length - 1) DIV osv$page_size) + 1);
            p_tape_request^.request.tape_command [j + i].command_code := ioc$cc_read_record;
            p_tape_request^.request.tape_command [j + i].flags.store_response := FALSE;
            p_tape_request^.request.tape_command [j + i].flags.indirect_address := TRUE;
            p_tape_request^.request.tape_command [j + i].flags.fill := 0;
            p_tape_request^.request.tape_command [j + i + 1].command_code := ioc$cc_store_transfer_count;
            p_tape_request^.request.tape_command [j + i + 1].flags.store_response := FALSE;
            p_tape_request^.request.tape_command [j + i + 1].flags.indirect_address := FALSE;
            p_tape_request^.request.tape_command [j + i + 1].flags.fill := 0;
            p_tape_request^.request.tape_command [j + i + 1].length := 8;
            i := i + ioc$read_cmd_per_block;
          FOREND;
          IF address_pair_count > (osv$page_size DIV 8) THEN
            osp$set_status_abnormal ('IO', ioe$tape_rma_list_overflow,
                 'Page size will not accommodate RMA list', status);
            EXIT /build_request/
          IFEND;

{ If IPI, store max byte count for read into request.

          IF (p_ud^.controller_type = cmc$mt5698_xx) THEN
            p_tape_request^.request.mode.read_max_byte_count := max_byte_count;
          IFEND;

          p_ud^.consecutive_erases := 0;
          p_tape_request^.estimated_address_pair_count := address_pair_count + 1;
          p_tape_request^.read_block_description := block_description;
          p_tape_request^.no_of_data_commands := no_of_blocks_to_read;
          p_tape_request^.max_input_count := max_byte_count;
          p_tape_request^.first_data_command := j + 1;
          p_tape_request^.request_type := tape_request_type;
          p_tape_request^.io_type := ioc$explicit_read;
          p_tape_request^.request.alert_mask.logical_delimiter := TRUE;
          p_tape_request^.request.alert_mask.long_input_block := TRUE;
          p_tape_request^.inhibit_error_recovery := inhibit_error_recovery;
          IF inhibit_error_recovery THEN
            p_tape_request^.request.recovery := ioc$terminate_at_error;
          IFEND;
          p_tape_request^.initial_block_count := no_of_blocks_to_read;
          iop$tape_queue_request_setup (p_tape_request, status);
        IFEND;
      END /build_request/;
      IF (p_tape_request <> NIL) AND NOT status.normal THEN
        IF NOT p_tape_request^.must_free_pageable_request THEN
          p_tape_request^.ud^.pageable_tape_requests [p_tape_request^.pageable_tape_request_index].
                slot_in_use := FALSE;
        ELSE
          FREE p_tape_request^.pp_response_p IN current_heap^;
          FREE p_tape_request IN current_heap^;
        IFEND;
      IFEND;
    END
  PROCEND iop$67x_read_setup;

?? OLDTITLE ??
?? NEWTITLE := ' iop$backspace_tape ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$backspace_tape (
        system_file_id: gft$system_file_identifier;
        block_count: iot$tape_block_count;
        use_locate_block: boolean;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

    CONST
      disable_unit = TRUE,
      physical_unload = FALSE;

    VAR
      block_id: iot$cartridge_tape_bid,
      found: boolean,
      i: iot$no_of_tape_units,
      io_id: iot$io_id,
      logical_unit_number: iot$logical_unit,
      p_ud: ^iot$tape_job_unit_descriptor;

    status.normal := TRUE;

    convert_sfid_to_lun (system_file_id, logical_unit_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (block_count > ioc$max_tape_blocks_to_process) OR (block_count <= 0) THEN
      osp$set_status_abnormal ('IO', ioe$improper_block_count,
            'Bad block count in iop$backspace_tape, block_count = ', status);
      osp$append_status_integer (' ', block_count, 10, FALSE, status);
      RETURN;
    IFEND;

{ Obtain pointer to tape job unit descriptor.

    i := 1;
    found := FALSE;
    WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
      IF logical_unit_number = iov$p_statistic_data_p_array^ [i]. logical_unit THEN
        found := TRUE;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;

    IF NOT found THEN
      osp$set_status_abnormal ('io', ioc$os_failure,
            'unable to find unit in iop$backspace_tape', status);
      RETURN;
    IFEND;

    p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

    IF (p_ud^.controller_type = cmc$mt5680_xx) AND use_locate_block THEN
      block_id := p_ud^.cartridge_tape_last_good_bid;
      block_id.logical_position := (block_id.logical_position - block_count -
            p_ud^.error_block_forespace_count);
      iop$locate_block (logical_unit_number, block_id, {bid_recovery} FALSE,
            0, ioc$lbg, io_status, status);
    ELSE
      iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_backspace, block_count,
            disable_unit, physical_unload, io_id, status);

      IF status.normal THEN
        iop$tape_internal_request_stat (logical_unit_number, io_id, {buf_release =} TRUE,
              {bid_recovery =} FALSE, {bid_update =} TRUE, osc$wait, io_status, status);
      IFEND;
    IFEND;

    IF NOT status.normal OR (NOT io_status.normal_completion) THEN
      io_status.position_uncertain := TRUE;
    IFEND;

  PROCEND iop$backspace_tape;

?? OLDTITLE ??
?? NEWTITLE := ' iop$backspace_tape_to_tapemark ' ??
?? EJECT ??
?  IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$backspace_tape_to_tapemark (system_file_id: gft$system_file_identifier;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

    CONST
      disable_unit = true,
      physical_unload = FALSE;

    VAR
      found: boolean,
      i: iot$no_of_tape_units,
      io_id: iot$io_id,
      logical_unit_number: iot$logical_unit,
      ud_p: ^iot$tape_job_unit_descriptor;

      status.normal := TRUE;
      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Obtain pointer to tape job unit descriptor.

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF logical_unit_number = iov$p_statistic_data_p_array^ [i]. logical_unit THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$backspace_tape_to_tapemark', status);
        RETURN;
      IFEND;

      ud_p := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

      IF ud_p^.controller_type = cmc$mt5680_xx THEN { use skip tapemark for cartridge
        iop$skip_tapemark_backward (system_file_id, io_status, status);
        RETURN;
      IFEND;

{ Set indicator in job unit descriptor that we are backspacing to a tapemark.

      ud_p^.positioning_to_tapemark := TRUE;

{ Backspace 30 decimal blocks with each request while looking for status of tapemark read.
{ Also discontinue the backspacing operation if abnormal io_status is received.

    /backspace_loop_to_tapemark/
      REPEAT
        iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_backspace,
                 ioc$max_tape_blocks_to_process, disable_unit, physical_unload, io_id, status);
        IF NOT status.normal THEN
          EXIT /backspace_loop_to_tapemark/
        IFEND;

{ Note that in the normal search for a tapemark, all parity errors are bypassed and the status
{ of tapemark read is the only block that will cause us to stop unless a fatal hardware error occurs.
{ In using a backspace to reach a tapemark, we are setting the passing boolean parameters of
{ bid_recovery and bid_update to TRUE and TRUE respectivly. These passing boolean parameters to
{ the procedure iop$tape_internal_request_stat are passed through to the status checking
{ procedure named iop$tape_status_check. The bid_recovery boolean set to TRUE will allow the
{ backspacing to continue while disregarding non-fatal errors and their entry into the engineering
{ log. The bid_update set to TRUE, will place a block identification of ioc$unavail_bid
{ in the block_id_window for that position, and continue to backspace down the tape looking for
{ a tapemark.

        iop$tape_internal_request_stat (logical_unit_number, io_id, {buf_release =} TRUE,
              {bid_recovery =} TRUE, {bid_update =} TRUE, osc$wait, io_status, status);
        IF NOT status.normal THEN
          EXIT /backspace_loop_to_tapemark/
        IFEND;

        IF (NOT io_status.normal_completion) AND (io_status.completion_code = ioc$tapemark_read) THEN
          io_status.normal_completion := TRUE;
          EXIT /backspace_loop_to_tapemark/
        IFEND;
      UNTIL NOT io_status.normal_completion; { /backspace_loop_to_tapemark/

      ud_p^.positioning_to_tapemark := FALSE;

  PROCEND iop$backspace_tape_to_tapemark;

?  IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$erase_tape ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$erase_tape (system_file_id: gft$system_file_identifier;
        block_length: amt$max_block_length;
        number_of_erases: integer;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

    CONST
      disable_unit = true,
      physical_unload = FALSE;

    VAR
      count: 0 .. 0ffff(16),
      found: boolean,
      i: iot$no_of_tape_units,
      io_id: iot$io_id,
      logical_unit_number: iot$logical_unit,
      loop: boolean,
      p_ud: ^iot$tape_job_unit_descriptor,
      repeat_count: iot$tape_block_count;

    BEGIN
      status.normal := TRUE;
      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF status.normal THEN
        i := 1;
        found := FALSE;
        WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
          IF logical_unit_number = iov$p_statistic_data_p_array^ [i].logical_unit THEN
            found := TRUE;
          ELSE
            i := i + 1;
          IFEND;
        WHILEND;
        IF NOT found THEN
          osp$set_status_abnormal ('io', ioc$os_failure,
                'unable to find unit in iop$erase_tape', status);
          RETURN;
        IFEND;
        p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

        IF (number_of_erases <> 0) AND (p_ud^.controller_type = cmc$mt5680_xx) THEN

{ Do not erase at EOT for cartridge tape.

          io_status.normal_completion := TRUE;
          RETURN;
        IFEND;

        IF number_of_erases = 0 THEN {uses block_length to compute erase length}
          IF (p_ud^.tape_unit_density = 3) THEN
            count := (block_length DIV 6250) DIV 3 + 1;
          ELSEIF (p_ud^.tape_unit_density = 4) THEN
            count := block_length DIV 14700 + 1;
          ELSE
            count := (block_length DIV 1600) DIV 3 + 1;
          IFEND;
        ELSE {use number_of_erases}
          count := number_of_erases;
        IFEND;

        IF (p_ud^.controller_type = cmc$mt5680_xx) AND (count + p_ud^.consecutive_erases > 32) THEN
          io_status.normal_completion := FALSE;
          io_status.completion_code := ioc$erase_limit_exceeded;
          RETURN;
        IFEND;

        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;
            loop := FALSE;
          IFEND;
          iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_erase, repeat_count,
                 disable_unit, physical_unload, io_id, status);
          IF NOT status.normal THEN
            RETURN;
          ELSE
            iop$tape_internal_request_stat (logical_unit_number, io_id, {buf_release =} TRUE,
                  {bid_recovery =} FALSE, {bid_update =} TRUE, osc$wait, io_status, status);
          IFEND;

          IF NOT io_status.normal_completion THEN
            io_status.position_uncertain := TRUE;
            RETURN;
          IFEND;
        WHILEND;
      IFEND;
    END
  PROCEND iop$erase_tape;

?? OLDTITLE ??
?? NEWTITLE := ' iop$establish_tape_statistics ' ??
?? EJECT ??

  PROCEDURE iop$establish_tape_statistics (VAR status: ost$status);

? IF system_version THEN

    CONST
      number_of_statistics = 6;

    VAR

      i: integer,
      statistics: array [1 .. number_of_statistics] of sft$statistic_code;

    status.normal := TRUE;

    statistics [1] := cml$7021_3x_failure_data;
    statistics [2] := cml$7221_1_failure_data;
    statistics [3] := cml$698_1x_failure_data;
    statistics [4] := cml$5698_1x_failure_data;
    statistics [5] := cml$5680_11_failure_data;
    statistics [6] := cml$tape_subsystem_usage_data;

    FOR i := 1 TO number_of_statistics DO
      sfp$activate_system_statistic (statistics [i], $sft$binary_logset [pmc$engineering_log], status);
      IF status.normal = FALSE THEN
        RETURN;
      IFEND;
    FOREND;

{ Set flag to false that causes the activation of tape statistics for the first tape assignment.

    iop$tape_clear_activate_stats (status);
? ELSE
    status.normal := TRUE;
? IFEND

  PROCEND iop$establish_tape_statistics;

?? OLDTITLE ??
?? NEWTITLE := ' iop$fetch_tape_capabilities ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$fetch_tape_capabilities (system_file_id: gft$system_file_identifier;
    VAR maximum_block_length: amt$max_block_length;
    VAR max_blocks_per_physical_call: iot$tape_block_count;
    VAR status: ost$status);

    VAR
      found: boolean,
      i: iot$no_of_tape_units,
      logical_unit_number: iot$logical_unit,
      p_ud: ^iot$tape_job_unit_descriptor;

    BEGIN
      status.normal := TRUE;
      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF status.normal THEN
        i := 1;
        found := FALSE;
        WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
          IF logical_unit_number = iov$p_statistic_data_p_array^ [i].logical_unit THEN
            found := TRUE;
          ELSE
            i := i + 1;
          IFEND;
        WHILEND;
        IF NOT found THEN
          osp$set_status_abnormal ('io', ioc$os_failure,
                'unable to find unit in iop$fetch_tape_capabilities', status);
          RETURN;
        IFEND;
        p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

        maximum_block_length := p_ud^.max_block_length;
        max_blocks_per_physical_call := ioc$max_tape_blocks_to_process;
      IFEND;

    END
  PROCEND iop$fetch_tape_capabilities;

?? OLDTITLE ??
?? NEWTITLE := ' iop$forspace_tape ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$forspace_tape (system_file_id: gft$system_file_identifier;
        block_count: iot$tape_block_count;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = true,
      physical_unload = FALSE;

    VAR
      logical_unit_number: iot$logical_unit;

    BEGIN
      status.normal := TRUE;

      IF (block_count <= ioc$max_tape_blocks_to_process) AND (block_count > 0) THEN
        convert_sfid_to_lun (system_file_id, logical_unit_number, status);
        IF status.normal THEN
          iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_forspace, block_count,
                 disable_unit, physical_unload, io_id, status);
        IFEND;
      ELSE
        osp$set_status_abnormal ('IO', ioe$improper_block_count,
              'Bad block count in iop$forspace_tape, block_count = ', status);
        osp$append_status_integer (' ', block_count, 10, FALSE, status);
      IFEND;

    END
  PROCEND iop$forspace_tape;

?? OLDTITLE ??
?? NEWTITLE := ' iop$forspace_tape_to_tapemark ' ??
?? EJECT ??
?  IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$forspace_tape_to_tapemark (system_file_id: gft$system_file_identifier;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

? ELSE

  PROCEDURE [XDCL] iop$forspace_tape_to_tapemark (system_file_id: gft$system_file_identifier;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

? IFEND

    CONST
      disable_unit = true,
      physical_unload = FALSE;

    VAR
      found: boolean,
      i: iot$no_of_tape_units,
      io_id: iot$io_id,
      logical_unit_number: iot$logical_unit,
      ud_p: ^iot$tape_job_unit_descriptor;

      status.normal := TRUE;
      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Obtain pointer to tape job unit descriptor.

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF logical_unit_number = iov$p_statistic_data_p_array^ [i]. logical_unit THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$forspace_tape_to_tapemark', status);
        RETURN;
      IFEND;

      ud_p := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

      IF ud_p^.controller_type = cmc$mt5680_xx THEN { use skip tapemark for cartridge
        iop$skip_tapemark_forward (system_file_id, io_status, status);
        RETURN;
      IFEND;

{ Set indicator in job unit descriptor that we are forespacing to a tapemark.

      ud_p^.positioning_to_tapemark := TRUE;

{ Forspace 30 decimal blocks with each request while looking for status of tapemark read.
{ Also discontinue the forspacing operation if abnormal io_status is received.

    /forespace_loop_to_tapemark/
      REPEAT
        iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_forspace,
                 ioc$max_tape_blocks_to_process, disable_unit, physical_unload, io_id, status);
        IF NOT status.normal THEN
          EXIT /forespace_loop_to_tapemark/
        IFEND;

{ Note that in the normal search for a tapemark, all parity errors are bypassed and the status
{ of tapemark read is the only block that will cause us to stop unless a fatal hardware error occurs.
{ In using a forspace to reach a tapemark, we are setting the passing boolean parameters of
{ bid_recovery and bid_update to TRUE and FALSE respectivly. These boolean passing parameters to
{ to the procedure iop$tape_internal_request_stat are passed through to the status check procedure
{ iop$tape_status_check.  The bid_recovery set to TRUE will inhibit logging any parity errors along
{ the way to reaching a tapemark. The bid_update of FALSE will inhibit any recovery attempt in the
{ status checking routine (iop$tape_status_check) due to a parity error on the forspace,
{ place a block identification of ioc$error_block_bid in the block_id_window for that position,
{ and continue to forespace down the tape looking for a tapemark.

        iop$tape_internal_request_stat (logical_unit_number, io_id, {buf_release =} TRUE,
              {bid_recovery =} TRUE, {bid_update =} FALSE, osc$wait, io_status, status);
        IF NOT status.normal THEN
          EXIT /forespace_loop_to_tapemark/
        IFEND;

        IF (NOT io_status.normal_completion) AND (io_status.completion_code = ioc$tapemark_read) THEN
          io_status.normal_completion := TRUE;
          EXIT /forespace_loop_to_tapemark/
        IFEND;
      UNTIL NOT io_status.normal_completion; { /forespace_loop_to_tapemark/

      ud_p^.positioning_to_tapemark := FALSE;

  PROCEND iop$forspace_tape_to_tapemark;

?? OLDTITLE ??
?? NEWTITLE := ' iop$free_boot_tape_tables ' ??
?? EJECT ??
?  IF NOT system_version THEN

  PROCEDURE [XDCL] iop$free_boot_tape_tables;

    IF iov$p_statistic_data_p_array <> NIL THEN
      IF iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor <> NIL THEN
        iop$free_pageable_tape_requests (iov$p_statistic_data_p_array^ [1].
              p_tape_job_unit_descriptor);
        iop$free_wired_tape_tables (iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor^.
              completion_q_index);
        FREE iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor IN
              osv$mainframe_pageable_heap^;
      IFEND;
      FREE iov$p_statistic_data_p_array IN osv$mainframe_pageable_heap^;
    IFEND;

  PROCEND iop$free_boot_tape_tables;
? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$free_pageable_tape_reqeusts ' ??
?? EJECT ??

  PROCEDURE iop$free_pageable_tape_requests (
    p_ud: ^iot$tape_job_unit_descriptor);

    VAR
      current_heap: ^ost$heap,
      index: 1 .. ioc$max_multiple_tape_requests + 1;

    iop$set_current_heap (current_heap);

    FOR index := 1 TO (ioc$max_multiple_tape_requests + 1) DO
      IF p_ud^.pageable_tape_requests [index].tape_request_p <> NIL THEN
        FREE p_ud^.pageable_tape_requests [index].tape_request_p IN current_heap^;
        FREE p_ud^.pageable_tape_requests [index].pp_response_p IN current_heap^;
      IFEND;
    FOREND;

  PROCEND iop$free_pageable_tape_requests;

?? OLDTITLE ??
?? NEWTITLE := ' iop$get_position_of_tape_file ' ??
?? EJECT ??
? IF system_version THEN

?? TITLE := 'PROCEDURE iop$get_position_of_tape_file' ??

PROCEDURE [XDCL, #GATE] iop$get_position_of_tape_file (lun: iot$logical_unit;
           VAR position: iot$tape_position;
           VAR status: ost$status);

  VAR
    found: boolean,
    i: iot$no_of_tape_units,
    ud_p: ^iot$tape_job_unit_descriptor;

    status.normal := TRUE;

{ Obtain pointer to tape_job_unit_descriptor that contains current BID Window.

    i := 1;
    found := FALSE;
    WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
      IF lun = iov$p_statistic_data_p_array^ [i].logical_unit THEN
        found := TRUE;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;
    IF NOT found THEN
      osp$set_status_abnormal ('io', ioc$os_failure,
            'unable to find unit in iop$get_position_of_tape_file', status);
      RETURN;
    IFEND;
    ud_p := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

{ Investigate if tape position indicates tape located at Loadpoint.
{ Note that bid_index points to next entry to be updated in BID_WINDOW.

    IF ud_p^.controller_type <> cmc$mt5680_xx THEN
      position.unit_type := ioc$reel_to_reel;
      IF (ud_p^.historical_bid_index = LOWERVALUE(iot$bid_index) + 1) AND
            (ud_p^.historical_bid_window [LOWERBOUND(iot$bid_window)] = ioc$loadpoint_bid) THEN
        position.tape_position := ioc$tape_at_loadpoint_position;
      ELSE
        position.tape_position := ioc$tape_not_loadpoint_position;
      IFEND;
      position.historical_bid_index := ud_p^.historical_bid_index;
      position.historical_bid_window := ud_p^.historical_bid_window;
    ELSE {cartridge tape
      position.unit_type := ioc$cartridge;
      position.last_good_bid := ud_p^.cartridge_tape_last_good_bid;
      IF ud_p^.cartridge_tape_last_good_bid.logical_position = 0 THEN
        position.tape_position := ioc$tape_at_loadpoint_position;
      ELSE
        position.tape_position := ioc$tape_not_loadpoint_position;
      IFEND;
    IFEND;
    position.blocks_from_loadpoint := ud_p^.block_count;
    position.tapemarks_from_loadpoint := ud_p^.tapemark_count;

  PROCEND iop$get_position_of_tape_file;

? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$get_tape_usage_data ' ??
?? EJECT ??
? IF system_version THEN

?? TITLE := 'PROCEDURE iop$get_tape_usage_data' ??

  PROCEDURE [XDCL, #GATE] iop$get_tape_usage_data (
        system_file_id: gft$system_file_identifier;
    VAR block_count: ost$non_negative_integers;
    VAR tapemark_count: ost$non_negative_integers;
    VAR status: ost$status);

  VAR
    found: boolean,
    i: iot$no_of_tape_units,
    lun: iot$logical_unit,
    p_ud: ^iot$tape_job_unit_descriptor;

    status.normal := TRUE;

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

{ Obtain pointer to tape_job_unit_descriptor that contains current usage data.

    i := 1;
    found := FALSE;
    WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
      IF lun = iov$p_statistic_data_p_array^ [i].logical_unit THEN
        found := TRUE;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;
    IF NOT found THEN
      osp$set_status_abnormal ('io', ioc$os_failure,
            'unable to find unit in iop$get_tape_usage_data', status);
      RETURN;
    IFEND;
    p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

    block_count := p_ud^.block_count;
    tapemark_count := p_ud^.tapemark_count;

  PROCEND iop$get_tape_usage_data;

? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$initialize_tape_ud ' ??
?? EJECT ??

? IF system_version THEN
  PROCEDURE [XDCL, #GATE] iop$initialize_tape_ud (
      tape_initial: dmt$tape_initialization_record;
      multiple_requests_possible: boolean;
    VAR status: ost$status);
? ELSE
  PROCEDURE [XDCL] iop$initialize_tape_ud (
      tape_initial: dmt$tape_initialization_record;
      multiple_requests_possible: boolean;
    VAR status: ost$status);
? IFEND

    VAR
      controller_type : cmt$controller_type,
      current_heap : ^ost$heap,
      ad_mode : 1 .. 2,
      dummy_iou : cmt$element_name,
      element_name : cmt$element_name,
      found: boolean,
      i: 1 .. ioc$max_multiple_tape_requests,
      index: 1 .. ioc$max_multiple_tape_requests + 1,
      logical_pp_number: iot$pp_number,
      number_of_pageable_requests: 1 .. ioc$max_multiple_tape_requests + 1,
      offset: iot$no_of_tape_units,
      p_ud: ^iot$tape_job_unit_descriptor;

?? NEWTITLE := 'p$clean_up' ??

    PROCEDURE p$clean_up
      (    return_requests: boolean;
       VAR ud_p: ^iot$tape_job_unit_descriptor);

      VAR
        i: 1 .. ioc$max_multiple_tape_requests + 1;

      IF return_requests THEN
        FOR i := 1 TO ioc$max_multiple_tape_requests + 1 DO
          IF ud_p^.pageable_tape_requests [i].tape_request_p <> NIL THEN
            FREE ud_p^.pageable_tape_requests [i].tape_request_p IN current_heap^;
            FREE ud_p^.pageable_tape_requests [i].pp_response_p IN current_heap^;
          IFEND;
        FOREND;

        iop$free_wired_tape_tables (ud_p^.completion_q_index);
      IFEND;

      FREE ud_p IN current_heap^;

    PROCEND p$clean_up;
?? OLDTITLE ??
?? EJECT ??
      status.normal := TRUE;
      iop$set_current_heap (current_heap);

{ The following code initializes IOV$P_STATISTIC_DATA_P_ARRAY to a NIL pointer only for
{ the module IOM$TAPE_BOOT_MANAGER.  The boot_manager module does not log any statistic data and
{ must have this pointer initialized to assure a unit connect is possible.
{ If the pointer is not NIL upon entry, the structures are FREE'ed so the boot size does not grow.

? IF NOT system_version THEN
      IF iov$p_statistic_data_p_array <> NIL THEN
        IF iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor <> NIL THEN
          iop$free_wired_tape_tables (iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor^.
                completion_q_index);
          iop$free_pageable_tape_requests (iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor);
          FREE iov$p_statistic_data_p_array^ [1].p_tape_job_unit_descriptor IN current_heap^;
        IFEND;
        FREE iov$p_statistic_data_p_array IN current_heap^;
      IFEND;
? IFEND

{     If establish_tape_statistics is TRUE a call has to be made to
{     iop$establish_tape_statistics in order to allow error logging.
{     Establish_tape_statistics is set to FALSE after activation of statistics.

? IF system_version THEN
      IF iov$establish_tape_statistics = TRUE THEN
        iop$establish_tape_statistics (status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
? IFEND

{     Allocate space in the job_pageable_heap for the package that is going to contain the
{     tape_job_unit_descriptor and store the pointer in a slot in iov$p_statistic_data_p_array
{     based on the logical unit number of the involved tape unit.

      p_ud := NIL;

      ALLOCATE p_ud IN current_heap^;

      found := false;
      offset := 1;
      WHILE (offset <= iov$number_of_tape_units) AND (NOT found) DO
        IF (iov$tape_completion_q_table^ [offset].lun =
              tape_initial.logical_unit_number) THEN
          p_ud^.completion_q_index := offset;
          found := TRUE;
        ELSE
          offset := offset + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
              'unable to find unit in iop$tape_initialize_ud', status);

        p$clean_up (FALSE {= requests not allocated}, p_ud);
        RETURN;
      IFEND;

{ Allocate slots to hold pageable tape requests.  This memory is in job pageable and is released
{ when the job is completed with the tape.  The number of slots allocated is one greater than
{ ioc$max_multiple_tape_requests because we have to have a spare slot for error recovery requests.

      IF multiple_requests_possible THEN
        number_of_pageable_requests := ioc$max_multiple_tape_requests + 1;
      ELSE { do not need more that 2 slots
        number_of_pageable_requests := 2;
        FOR index := 3 TO ioc$max_multiple_tape_requests + 1 DO
          p_ud^.pageable_tape_requests [index].slot_in_use := TRUE;
          p_ud^.pageable_tape_requests [index].tape_request_p := NIL;
        FOREND;
      IFEND;

      FOR index := 1 TO number_of_pageable_requests DO
        p_ud^.pageable_tape_requests [index].slot_in_use := FALSE;
        ALLOCATE p_ud^.pageable_tape_requests [index].tape_request_p IN current_heap^;
        ALLOCATE p_ud^.pageable_tape_requests [index].pp_response_p IN current_heap^;
      FOREND;

{ Allocate mainframe wired slots for the wired tape requests.  This memory is released
{ when the job is completed with the tape.

      iop$allocate_wired_tape_tables (p_ud^.completion_q_index, multiple_requests_possible);

      cmp$get_element_name_via_lun (tape_initial.logical_unit_number , element_name, status);
      IF NOT status.normal THEN
        p$clean_up (TRUE {= requests allocated}, p_ud);
        RETURN;
      IFEND;

      found := FALSE;

    /get_controller_type/
      FOR offset := LOWERBOUND (iov$tusl_p^) TO UPPERBOUND (iov$tusl_p^) DO
        IF element_name = iov$tusl_p^ [offset].element_name THEN
          logical_pp_number := iov$tusl_p^ [offset].logical_pp [1];
          controller_type := cmv$logical_pp_table_p^ [logical_pp_number].controller_info.controller_type;
          found := TRUE;
          EXIT /get_controller_type/;
        IFEND;
      FOREND /get_controller_type/;

      IF NOT found THEN
        p$clean_up (TRUE {= requests allocated}, p_ud);
        osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
              'unable to find controller_type in iop$tape_initialize_ud', status);
        RETURN;
      IFEND;

      p_ud^.controller_type := controller_type;

      IF controller_type =  cmc$mt7221_2_s0 THEN
        ad_mode := 2;
      ELSE
        ad_mode := 1;
      IFEND;

      osp$set_job_signature_lock (statistic_data_lock);

{     Check whether array statistic_package_p_array has been established; if not allocate space
{     in the job_pageable_heap, initialize each entry by setting bit 'slot_in_use' to FALSE and
{     save pointer iov$p_statistic_package_p_array in job pageable.

      IF iov$p_statistic_data_p_array = NIL THEN

        ALLOCATE iov$p_statistic_data_p_array: [1 .. iov$number_of_tape_units] IN
              current_heap^;

        FOR offset :=1 TO UPPERBOUND (iov$p_statistic_data_p_array^) DO
          iov$p_statistic_data_p_array^ [offset].slot_in_use := FALSE;
          iov$p_statistic_data_p_array^ [offset].logical_unit := 0;
          iov$p_statistic_data_p_array^ [offset].p_tape_job_unit_descriptor := NIL;
          iov$p_statistic_data_p_array^ [offset].unit_type := ioc$non_ipi_reel;
          iov$p_statistic_data_p_array^ [offset].p_failure_data := NIL;
        FOREND;
      IFEND;

      found := FALSE;
      offset := 1;

      WHILE (offset <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF (iov$p_statistic_data_p_array^ [offset].slot_in_use = FALSE ) THEN
          iov$p_statistic_data_p_array^ [offset].logical_unit := tape_initial.logical_unit_number;
          iov$p_statistic_data_p_array^ [offset].p_tape_job_unit_descriptor := p_ud;
          IF controller_type = cmc$mt5698_xx THEN
            iov$p_statistic_data_p_array^ [offset].unit_type := ioc$ipi_reel;
            iov$p_statistic_data_p_array^ [offset].p_ipi_failure_data := NIL;
          ELSEIF controller_type = cmc$mt5680_xx THEN
            iov$p_statistic_data_p_array^ [offset].unit_type := ioc$ccc_cart;
            iov$p_statistic_data_p_array^ [offset].p_ccc_cart_failure_data := NIL;
          ELSE
            iov$p_statistic_data_p_array^ [offset].unit_type := ioc$non_ipi_reel;
            iov$p_statistic_data_p_array^ [offset].p_failure_data := NIL;
          IFEND;
          iov$p_statistic_data_p_array^ [offset].slot_in_use := TRUE;
          osp$clear_job_signature_lock (statistic_data_lock);
          found := TRUE;
        ELSE
          offset := offset + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
              'unable to find unit in iop$initialize_tape_ud', status);
        osp$clear_job_signature_lock (statistic_data_lock);
        RETURN;
      IFEND;

{     Initialize the tape_job_unit_descriptor for this tape unit

      p_ud^.io_id := 2;

      p_ud^.blocks_read := 0;
      p_ud^.blocks_read_for_accounting := 0;
      p_ud^.blocks_read_for_byte_count := 0;
      p_ud^.bytes_read := 0;
      p_ud^.blocks_written := 0;
      p_ud^.blocks_written_for_accounting := 0;
      p_ud^.blocks_written_for_byte_count := 0;
      p_ud^.bytes_written := 0;
      p_ud^.blocks_skipped := 0;
      p_ud^.block_count := 0;
      p_ud^.tapemark_count := 0;
      p_ud^.tape_unit_density := 0;
      p_ud^.io_requests_count := 0;
      p_ud^.tape_error_log_entry := FALSE;
      p_ud^.task_terminated_during_recovery := FALSE;
      p_ud^.block_in_error := -1;
      p_ud^.last_request := ioc$tape_unload;
      p_ud^.free_running_clock := #free_running_clock (0);
      p_ud^.positioning_to_tapemark := FALSE;
      p_ud^.min_block_length := ioc$min_tape_block_length;
      IF (p_ud^.controller_type = cmc$mt7221_2_s0) OR (p_ud^.controller_type = cmc$mt5698_xx) OR
            (p_ud^.controller_type = cmc$mt5680_xx) OR
            (cmv$logical_pp_table_p^ [logical_pp_number].pp_info.logical_partner_pp_index > 0) THEN
        p_ud^.max_block_length := amc$maximum_block;
      ELSE
        p_ud^.max_block_length := ioc$max_tape_not_long_blk_lgth;
      IFEND;
      p_ud^.position_uncertain := FALSE;

      FOR i := 1 TO ioc$max_multiple_tape_requests DO
         p_ud^.pending_pageable_requests [i] := NIL;
      FOREND;

{ Set the format parameters for this tape unit.  Do not initialize the
{ format parameters for cartridge tape, since the PP driver will not use them.

      IF controller_type <> cmc$mt5680_xx THEN
        p_ud^.format_parameters.define_code_translation := 1;
        p_ud^.format_parameters.code_translation := 0;

        p_ud^.format_parameters.define_ad := 1;
        p_ud^.format_parameters.ad_mode := ad_mode;

{ The unit number is set to zero here, but will be filled out by the PP to its proper value.

        p_ud^.format_parameters.define_unit_no := TRUE;
        p_ud^.format_parameters.hardware_unit_number := 0;

        p_ud^.format_parameters.define_vertical_parity := 1;
        p_ud^.format_parameters.vertical_parity := 0;

        p_ud^.format_parameters.define_density := 1;
        CASE tape_initial.density OF

        = rmc$200 =
          osp$set_status_abnormal ('IO', ioc$improper_density, '200 FPI density not valid for this unit.',
                status);

        = rmc$556 =
          osp$set_status_abnormal ('IO', ioc$improper_density, '556 FPI density not valid for this unit.',
                status);

        = rmc$800 =
          p_ud^.format_parameters.density := 1;

        = rmc$1600 =
          p_ud^.format_parameters.density := 0;

        = rmc$6250 =
          p_ud^.format_parameters.density := 1;

        ELSE
          osp$set_status_abnormal ('io', ioc$improper_density, 'density requested not recognized.', status);

        CASEND;

        p_ud^.format_parameters.define_min_block_length := 1;
        p_ud^.format_parameters.min_block_length := 1;

        p_ud^.format_parameters.define_disable_error_correction := 1;
        p_ud^.format_parameters.disable_hardware_correction := 0;

        p_ud^.format_parameters.fill := 0;
        p_ud^.format_parameters.fill1 := 0;
        p_ud^.format_parameters.read_max_byte_count := 0;
      IFEND;

{ Initialize the Single/Double Track Hardware Correction counter.

      p_ud^.single_double_track_corrections := 0;

{Initialize the Block_Id index and the Block_id Window at assign time.
{For future recovery across deadstarts, this initialization may require investigation.

      p_ud^.bid_index := LOWERVALUE(iot$bid_index);

{The following code works only for ioc$empty_bid = 0, as a bid window is a 2 byte value!
      i#fill ($CHAR (ioc$empty_bid), ^p_ud^.bid_window, #SIZE (p_ud^.bid_window));

      p_ud^.cartridge_tape_last_good_bid := zero_ccc_cart_bid;
      p_ud^.error_block_forespace_count := 0;
      p_ud^.ccc_cart_buffer_underruns := 0;

  PROCEND iop$initialize_tape_ud;

?? OLDTITLE ??
?? NEWTITLE := ' iop$locate_block ' ??
?? EJECT ??

? IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$locate_block (
        logical_unit: iot$logical_unit;
        block_id: iot$cartridge_tape_bid;
        bid_recovery: boolean;
        tape_mark_reset: integer;
        locate_block_option: iot$locate_block_option;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

? ELSE { do not xdcl in boot version

  PROCEDURE iop$locate_block (
        logical_unit: iot$logical_unit;
        block_id: iot$cartridge_tape_bid;
        bid_recovery: boolean;
        tape_mark_reset: integer;
        locate_block_option: iot$locate_block_option;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

? IFEND

    CONST
      disable_unit = FALSE,
      physical_unload = FALSE;

    VAR
      current_heap: ^ost$heap,
      forespace_count: 0 .. 0ffff(16),
      forespace_count_for_request: 0 .. 0ffff(16),
      io_id: iot$io_id,
      p_tape_request: ^iot$tape_request,
      p_ud: ^iot$tape_job_unit_descriptor;

    status.normal := TRUE;
    iop$tape_build_pp_req_header (logical_unit, {length} 48, p_tape_request, status);
    IF status.normal THEN
      io_id := p_tape_request^.io_id;
      p_ud := p_tape_request^.ud;
      p_ud^.cartridge_tape_last_good_bid := block_id;
      p_tape_request^.request.tape_command [2].command_code := ioc$cc_locate_block;
      p_tape_request^.request.tape_command [2].flags.store_response := FALSE;
      p_tape_request^.request.tape_command [2].flags.indirect_address := FALSE;
      p_tape_request^.request.tape_command [2].flags.fill := 0;
      p_tape_request^.request.tape_command [2].length := 0;
      p_tape_request^.request.tape_command [2].address := (block_id.physical_position * 1000000(16)) +
            block_id.logical_position;

      p_tape_request^.request_type := ioc$locate_block;
      p_tape_request^.io_type := ioc$no_io;
      p_tape_request^.initial_block_count := 1;
      p_tape_request^.no_of_non_data_commands := 1;
      p_tape_request^.request.alert_mask.disabled_unit := TRUE;
      iop$tape_queue_request_setup (p_tape_request, status);
    IFEND;

    IF NOT status.normal THEN
      IF p_tape_request <> NIL THEN
        IF NOT p_tape_request^.must_free_pageable_request THEN
          p_tape_request^.ud^.pageable_tape_requests [p_tape_request^.pageable_tape_request_index].
                slot_in_use := FALSE;
        ELSE
          iop$set_current_heap (current_heap);
          FREE p_tape_request^.pp_response_p IN current_heap^;
          FREE p_tape_request IN current_heap^;
        IFEND;
      IFEND;
      RETURN;
    IFEND;

    iop$tape_internal_request_stat (logical_unit, io_id, {buf_release} TRUE, bid_recovery,
          {bid_update} FALSE, osc$wait, io_status, status);

{ Reset the tapemark count in the unit descriptor if it is non-zero.  This is used for fatal
{ tape error recovery to maintain the correct count.

    IF status.normal AND io_status.normal_completion AND (tape_mark_reset <> 0) THEN
      p_ud^.tapemark_count := tape_mark_reset;
    IFEND;

{ If requested on the call, forespace the number of error blocks in the counter
{ p_ud^.error_block_forespace_count.  This is used since locate_block to a block with
{ an unrecovered parity error does not work.
{ Note - additional forespaces are not performed if the count is zero or if the
{ locate_block status or io_status are not normal.

    IF (p_ud^.error_block_forespace_count = 0) OR NOT status.normal OR
          NOT io_status.normal_completion THEN
      RETURN;
    IFEND;

    CASE locate_block_option OF

    = ioc$lbg =

      RETURN; { No additional positioning

    = ioc$lbg_plus_count =

      forespace_count := p_ud^.error_block_forespace_count;

    = ioc$lbg_plus_count_minus_1 =

      forespace_count := p_ud^.error_block_forespace_count - 1;
      IF forespace_count = 0 THEN
        RETURN;
      IFEND;
    ELSE
    CASEND;

    REPEAT
      IF forespace_count <= ioc$max_tape_blocks_to_process THEN
        forespace_count_for_request := forespace_count;
        forespace_count := 0;
      ELSE
        forespace_count_for_request := ioc$max_tape_blocks_to_process;
        forespace_count := forespace_count - ioc$max_tape_blocks_to_process;
      IFEND;

      iop$67x_non_data_trans_setup (logical_unit, ioc$tape_forspace, forespace_count_for_request,
            disable_unit, physical_unload, io_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      iop$tape_internal_request_stat (logical_unit, io_id, {buf_release} TRUE, {bid_recovery} TRUE,
            {bid_update} FALSE, osc$wait, io_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF io_status.io_complete AND (NOT io_status.normal_completion) AND
            NOT (io_status.completion_code = ioc$tapemark_read) THEN
        RETURN;  { return error
      ELSEIF NOT io_status.normal_completion AND (io_status.completion_code = ioc$tapemark_read) THEN
        forespace_count := forespace_count + io_status.residual_block_count - 1;
      IFEND;

    UNTIL forespace_count = 0;

  PROCEND iop$locate_block;

?? OLDTITLE ??
?? NEWTITLE := ' iop$read_tape ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$read_tape (system_file_id: gft$system_file_identifier;
        inhibit_error_recovery: boolean;
        max_byte_count: iot$tape_block_length;
        block_description: ^iot$read_tape_description;
        no_of_blocks_to_read: iot$tape_block_count;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    VAR
      logical_unit_number: iot$logical_unit;

    BEGIN
      status.normal := TRUE;

      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF status.normal THEN
        iop$67x_read_setup (logical_unit_number, ioc$tape_read, inhibit_error_recovery, max_byte_count,
              block_description, no_of_blocks_to_read, io_id, status);
      IFEND;
    END
  PROCEND iop$read_tape;

?? OLDTITLE ??
?? NEWTITLE := ' iop$read_tape_scan ' ??
?? EJECT ??
? IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$read_tape_scan (logical_unit_number: iot$logical_unit;
        inhibit_error_recovery: boolean;
        max_byte_count: iot$tape_block_length;
        block_description: ^iot$read_tape_description;
        no_of_blocks_to_read: iot$tape_block_count;
    VAR io_id: iot$io_id;
    VAR status: ost$status);


    BEGIN
      status.normal := TRUE;

      iop$67x_read_setup (logical_unit_number, ioc$tape_read, inhibit_error_recovery, max_byte_count,
            block_description, no_of_blocks_to_read, io_id, status);
    END
  PROCEND iop$read_tape_scan;
? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$rewind_tape ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$rewind_tape (system_file_id: gft$system_file_identifier;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = TRUE,
      physical_unload = FALSE,
      repeat_count = 1;

    VAR
      logical_unit_number: iot$logical_unit;

    BEGIN
      status.normal := TRUE;

      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF status.normal THEN
        iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_rewind, repeat_count,
               disable_unit, physical_unload, io_id, status);
      IFEND;

    END
  PROCEND iop$rewind_tape;

?? OLDTITLE ??
?? NEWTITLE := ' iop$rewind_tape_scan ' ??
?? EJECT ??
? IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$rewind_tape_scan (logical_unit_number: iot$logical_unit;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = TRUE,
      physical_unload = FALSE,
      repeat_count = 1;


    BEGIN
      status.normal := TRUE;

        iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_rewind, repeat_count,
               disable_unit, physical_unload, io_id, status);

    END
  PROCEND iop$rewind_tape_scan;
? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$skip_tapemark_backward ' ??
?? EJECT ??

  PROCEDURE iop$skip_tapemark_backward (
        system_file_id: gft$system_file_identifier;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

    CONST
      disable_unit = true,
      physical_unload = FALSE;

    VAR
      io_id: iot$io_id,
      logical_unit_number: iot$logical_unit;

{ NOTE - This procedure should be used for cartridge tape only.

    status.normal := TRUE;

    convert_sfid_to_lun (system_file_id, logical_unit_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    iop$67x_non_data_trans_setup (logical_unit_number, ioc$skip_tapemark_backward, {count} 1,
           disable_unit, physical_unload, io_id, status);

    IF status.normal THEN
      iop$tape_internal_request_stat (logical_unit_number, io_id, {buf_release =} TRUE,
            {bid_recovery =} FALSE,  {bid_update =} TRUE, osc$wait, io_status, status);
     IFEND;

    IF NOT status.normal OR (NOT io_status.normal_completion) THEN
      io_status.position_uncertain := TRUE;
    IFEND;

  PROCEND iop$skip_tapemark_backward;

?? OLDTITLE ??
?? NEWTITLE := ' iop$skip_tapemark_forward ' ??
?? EJECT ??

  PROCEDURE iop$skip_tapemark_forward (
        system_file_id: gft$system_file_identifier;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

    CONST
      disable_unit = true,
      physical_unload = FALSE;

    VAR
      io_id: iot$io_id,
      logical_unit_number: iot$logical_unit;

{ NOTE - This procedure should be used for cartridge tape only.

    status.normal := TRUE;

    convert_sfid_to_lun (system_file_id, logical_unit_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    iop$67x_non_data_trans_setup (logical_unit_number, ioc$skip_tapemark_forward, {count} 1,
           disable_unit, physical_unload, io_id, status);

    IF status.normal THEN
      iop$tape_internal_request_stat (logical_unit_number, io_id, {buf_release =} TRUE,
            {bid_recovery =} FALSE, {bid_update =} TRUE, osc$wait, io_status, status);
    IFEND;

    IF NOT status.normal OR (NOT io_status.normal_completion) THEN
      io_status.position_uncertain := TRUE;
    IFEND;

  PROCEND iop$skip_tapemark_forward;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_build_pp_req_header ' ??
?? EJECT ??

  PROCEDURE iop$tape_build_pp_req_header (unit_number: iot$logical_unit;
        length: iot$request_length;
    VAR pp_req: ^iot$tape_request;
    VAR status: ost$status);

    VAR
      current_heap: ^ost$heap,
      found: boolean,
      i: iot$no_of_tape_units,
      index: 1 .. ioc$max_multiple_tape_requests + 1,
      p_ud: ^iot$tape_job_unit_descriptor;

    CONST
      m1 = ioc$tape_mode_command_index;

      status.normal := TRUE;
      iop$set_current_heap (current_heap);
      pp_req := NIL;

      i := 1;
      found := FALSE;

      IF iov$p_statistic_data_p_array <> NIL THEN
        WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
          IF unit_number = iov$p_statistic_data_p_array^ [i].logical_unit THEN
            found := TRUE;
          ELSE
            i := i + 1;
          IFEND;
        WHILEND;
      IFEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$tape_build_pp_req_header', status);
        RETURN;
      IFEND;

      p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

{ Find empty slot for request.

      found := FALSE;
    /search_for_request_slot/
      FOR index := 1 to ioc$max_multiple_tape_requests + 1 DO
        IF NOT p_ud^.pageable_tape_requests [index].slot_in_use THEN
          p_ud^.pageable_tape_requests [index].slot_in_use := TRUE;
          pp_req := p_ud^.pageable_tape_requests [index].tape_request_p;
          pp_req^.pp_response_p := p_ud^.pageable_tape_requests [index].pp_response_p;
          pp_req^.pageable_tape_request_index := index;
          pp_req^.must_free_pageable_request := FALSE;
          found := TRUE;
          EXIT /search_for_request_slot/;
        IFEND;
      FOREND /search_for_request_slot/;

      IF NOT found THEN

{ Must allocate new request.  This can occur if recurrsive error recovery is in
{ progress.  The request and response are FREE'ed in iop$tape_internal_request_stat.

        ALLOCATE pp_req IN current_heap^;
        pp_req^.pp_response_p := NIL;
        ALLOCATE pp_req^.pp_response_p IN current_heap^;
        pp_req^.must_free_pageable_request := TRUE;
      IFEND;


{ Initialize the PP request header.

      pp_req^.request.fill1 := 0;
      pp_req^.request.next_pp_request := NIL;
      pp_req^.request.fill2 := 0;
      pp_req^.request.next_pp_request_rma := 0;
      pp_req^.request.request_length := length;
      pp_req^.request.logical_unit := unit_number;
      pp_req^.request.recovery := ioc$attempt_recovery;
      pp_req^.request.interrupt.value := FALSE;
      pp_req^.request.interrupt.port_number := 0;
      pp_req^.request.priority := 0;
      pp_req^.request.alert_mask.compare_not_satisfied := FALSE;
      pp_req^.request.alert_mask.long_input_block := FALSE;
      pp_req^.request.alert_mask.physical_delimiter := FALSE;
      pp_req^.request.alert_mask.logical_delimiter := FALSE;
      pp_req^.request.alert_mask.character_fill := FALSE;
      pp_req^.request.alert_mask.disabled_unit := TRUE;
      pp_req^.request.alert_mask.fill := 0;
      pp_req^.tcu_parity_retry_count := 0;
      pp_req^.parity_retry_count := 0;
      pp_req^.lost_data_retry_count := 0;
      pp_req^.busy_retry_count := 0;
      pp_req^.lateack_retry_count := 0;
      pp_req^.misc_retry_count := 0;
      pp_req^.ipi_retry_count := 0;
      pp_req^.blocks_accessed := 0;
      pp_req^.transfer_count := 0;
      pp_req^.initial_block_count := 0;
      pp_req^.io_status.io_complete := FALSE;
      pp_req^.io_status.normal_completion := FALSE;
      pp_req^.io_status.wait_selected := FALSE;
      pp_req^.io_status.write_ring := FALSE;
      pp_req^.io_status.end_of_tape := FALSE;
      pp_req^.io_status.beginning_of_tape := FALSE;
      pp_req^.io_status.unit_busy := FALSE;
      pp_req^.io_status.unit_ready := FALSE;
      pp_req^.io_status.long_input_block := FALSE;
      pp_req^.io_status.position_uncertain := FALSE;
      pp_req^.io_status.completion_code := ioc$indeterminate;
      pp_req^.io_status.residual_block_count := 0;
      pp_req^.write_block_description := NIL;
      pp_req^.read_block_description := NIL;
      pp_req^.inhibit_error_recovery := FALSE;
      pp_req^.no_of_data_commands := 0;
      pp_req^.no_of_non_data_commands := 0;
      pp_req^.error := FALSE;
      pp_req^.max_input_count := 0;
      pp_req^.last_command_processed := 0;
      pp_req^.first_data_command := 0;
      pp_req^.estimated_address_pair_count := 2;
      pp_req^.recovery_requeue := FALSE;
      pp_req^.ccc_cart_buf_underrun_recovery := FALSE;

      pp_req^.request.mode := p_ud^.format_parameters;
      pp_req^.ud := p_ud;
      pp_req^.io_id := p_ud^.io_id;
      pp_req^.pp_response_p^.controller_type := p_ud^.controller_type;

      p_ud^.io_id := p_ud^.io_id + 1;

      pp_req^.request.tape_command [m1].command_code := ioc$cc_function;
      pp_req^.request.tape_command [m1].flags.store_response := FALSE;
      pp_req^.request.tape_command [m1].flags.indirect_address := FALSE;
      pp_req^.request.tape_command [m1].flags.fill := 0;
      pp_req^.request.tape_command [m1].length := ioc$tape_function_code_length;
      pp_req^.request.tape_command [m1].address := ioc$67x_func_format;

  PROCEND iop$tape_build_pp_req_header;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_error_logging ' ??
?? EJECT ??

  PROCEDURE iop$tape_error_logging (p_tape_request: ^iot$tape_request;
        tape_failure_type: iot$tape_failure_type;
        on_the_fly_correction_logging: boolean;
    VAR status: ost$status);

? IF system_version THEN

{ Procedure iop$tape_error_logging  services as a routine that logs
{ recovered and unrecovered tape errors.  The procedure is  entered
{ from iop$tape_status_check as soon as an error has been detected.
{ Initial  information  is  collected and temporarily stored. After
{ the error has been determined the initial  entry is finalized and
{ transmitted to the engineering log.
{ This  procedure  uses the failure log entry lay out as documented
{ in Design Action Paper ARH6715.
{ On The Fly Correction Logging is treated as a recovered error log
{ entry with the string *IM* replacing the string *RF*.

    CONST
      eliminate_bits = 16,
      format_bytes = 0ffffffffff(16),
      novalue = -1;

    VAR
      bid_area_p: ^iot$unit_communication_buffer,
      channel: cmt$physical_channel,
      concurrent: 0 .. 1,
      found: boolean,
      i: integer,
      iou_number: dst$iou_number,
      logical_unit: iot$logical_unit,
      offset: iot$no_of_tape_units,
      p_counters: sft$counters,
      p_counters_seq: ^SEQ (*),
      p_hardware_status: ^array [1 .. ioc$extended_status_length] of 0 .. 0ffff(16),
      p_tape_failure_data: ^iot$tape_failure_data,
      p_tape_format: ^0 .. format_bytes,
      p_ud: ^iot$tape_job_unit_descriptor,
      path: ost$string,
      pp: 0 .. 0ff(16),
      pp_interface_table_p: ^iot$pp_interface_table,
      statistic_code: sft$statistic_code;

    status.normal := TRUE;

    logical_unit := p_tape_request^.request.logical_unit;
    pp := p_tape_request^.pp_response_p^.pp_no;
    iou_number := cmv$logical_pp_table_p^ [pp].pp_info.channel.iou_number;
    pp_interface_table_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;
    channel.number := pp_interface_table_p^.unit_descriptors [logical_unit].
          physical_path.channel_number;
    IF cmv$logical_pp_table_p^ [pp].pp_info.channel_interlock_p^.
          channel_characteristics [channel.number].concurrent_channel THEN
      concurrent := 1;
    ELSE
      concurrent := 0;
    IFEND;

    CASE tape_failure_type OF

    = ioc$undetermined =

{     Allocate space in the job_pageable_heap for the package that is going to contain
{     the tape_failure_statistic_data.

      p_tape_failure_data := NIL;

      ALLOCATE p_tape_failure_data IN osv$job_pageable_heap^;

{     Save pointer p_tape_failure_data in statistic_data_p_array in a slot that has been
{     reserved for the involved tape unit based on its logical unit number.

      found := FALSE;
      offset := 1;
      WHILE (offset <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF (iov$p_statistic_data_p_array^ [offset].logical_unit = logical_unit) THEN
          iov$p_statistic_data_p_array^ [offset].p_failure_data := p_tape_failure_data;
          found := TRUE;
        ELSE
          offset := offset + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
              'unable to find unit in iop$tape_error_logging', status);
        RETURN;
      IFEND;

{     Obtain the address of the tape job unit descriptor.

      p_ud := iov$p_statistic_data_p_array^ [offset].p_tape_job_unit_descriptor;

{     Collect tape_failure_statistic_data.

      p_tape_failure_data^.package.pp_number.initial_error_status_register := 0;
      p_tape_failure_data^.package.pp_number.final_error_status_register := 0;
      p_tape_failure_data^.package.pp_number.fill1 := 0;
      p_tape_failure_data^.package.pp_number.iou := iou_number;
      p_tape_failure_data^.package.pp_number.fill2 := 0;
      p_tape_failure_data^.package.pp_number.i4_port_a := 0;
      p_tape_failure_data^.package.pp_number.i4_port_b := 0;
      p_tape_failure_data^.package.pp_number.concurrent := concurrent;

      p_tape_failure_data^.package.channel_number.initial_error_status_register :=
            p_tape_request^.pp_response_p^.pp_response.interface_error_code;
      p_tape_failure_data^.package.channel_number.fill1 := 0;
      p_tape_failure_data^.package.channel_number.iou := iou_number;
      p_tape_failure_data^.package.channel_number.fill2 := 0;
      p_tape_failure_data^.package.channel_number.i4_port_a := 0;
      p_tape_failure_data^.package.channel_number.i4_port_b := 0;
      p_tape_failure_data^.package.channel_number.concurrent := concurrent;
      p_tape_failure_data^.package.channel_number.resource_number := channel.number;

      p_tape_failure_data^.package.equipment_number := pp_interface_table_p^.unit_descriptors
                        [logical_unit].physical_path.controller_number;
      p_tape_failure_data^.package.physical_unit_number := pp_interface_table_p^.
                        unit_descriptors [logical_unit].physical_path.physical_unit_number;

      CASE pp_interface_table_p^.unit_descriptors [logical_unit].unit_interface_table^.unit_type OF

      = ioc$dt_mt679_2 =
        p_tape_failure_data^.package.unit_type := 1;

      = ioc$dt_mt679_3 =
        p_tape_failure_data^.package.unit_type := 2;

      = ioc$dt_mt679_4 =
        p_tape_failure_data^.package.unit_type := 3;

      = ioc$dt_mt679_5 =
        p_tape_failure_data^.package.unit_type := 4;

      = ioc$dt_mt679_6 =
        p_tape_failure_data^.package.unit_type := 5;

      = ioc$dt_mt679_7 =
        p_tape_failure_data^.package.unit_type := 6;

      = ioc$dt_mt639_1 =
        p_tape_failure_data^.package.unit_type := 7;

      = ioc$dt_mt698_3x =
        p_tape_failure_data^.package.unit_type := 8;

      ELSE

      CASEND;

      CASE p_tape_request^.request_type OF

      = ioc$tape_clear =
        p_tape_failure_data^.package.operation_code := 5;

      = ioc$tape_rewind =
        p_tape_failure_data^.package.operation_code := 3;

      = ioc$tape_unload =
        p_tape_failure_data^.package.operation_code := 4;

      = ioc$tape_forspace =
        p_tape_failure_data^.package.operation_code := 8;

      = ioc$tape_backspace =
        p_tape_failure_data^.package.operation_code := 9;

      = ioc$tape_cont_backspace =
        p_tape_failure_data^.package.operation_code := 11;

      = ioc$tape_read =
        p_tape_failure_data^.package.operation_code := 1;

      = ioc$tape_write =
        p_tape_failure_data^.package.operation_code := 2;

      = ioc$tape_loop1 =
        p_tape_failure_data^.package.operation_code := 13;

      = ioc$tape_loop2 =
        p_tape_failure_data^.package.operation_code := 14;

      = ioc$tape_loop3 =
        p_tape_failure_data^.package.operation_code := 15;

      = ioc$tape_write_tapemark =
        p_tape_failure_data^.package.operation_code := 6;

      = ioc$tape_erase =
        p_tape_failure_data^.package.operation_code := 7;

      = ioc$tape_data_security_erase =
        p_tape_failure_data^.package.operation_code := 7;

      = ioc$tape_get_status =
        p_tape_failure_data^.package.operation_code := 12;

      = ioc$skip_tapemark_forward =
        p_tape_failure_data^.package.operation_code := 10;

      = ioc$skip_tapemark_backward =
        p_tape_failure_data^.package.operation_code := 11;

      = ioc$tape_master_clear =
        p_tape_failure_data^.package.operation_code := 16;

      ELSE

      CASEND;

      p_tape_failure_data^.package.blocks_written := p_ud^.blocks_written;
      p_tape_failure_data^.package.blocks_read := p_ud^.blocks_read;
      p_tape_failure_data^.package.single_double_track_corrections := p_ud^.single_double_track_corrections;
      p_tape_failure_data^.package.unused_fill1 := novalue;
      p_tape_failure_data^.package.block_count := p_ud^.block_count;
      p_tape_failure_data^.package.tapemark_count := p_ud^.tapemark_count;
      p_tape_format := #LOC (p_tape_request^.request.mode);
      p_tape_failure_data^.package.tape_format_parameters := p_tape_format^ DIV eliminate_bits;

      CASE p_ud^.tape_unit_density OF

      = 0, 1 =
        p_tape_failure_data^.package.density := 1600;

      = 2 =
        p_tape_failure_data^.package.density := 800;

      = 3 =
        p_tape_failure_data^.package.density := 6250;

      ELSE

      CASEND;

      p_hardware_status := #LOC (p_tape_request^.pp_response_p^.device_status);
      FOR i := 1 TO ioc$device_status_length DO
        p_tape_failure_data^.package.initial_hardware_status [i] := p_hardware_status^ [i];
      FOREND;

      CASE pp_interface_table_p^.unit_descriptors [logical_unit].unit_interface_table^.unit_type OF

      = ioc$dt_mt679_5 .. ioc$dt_mt677_4 =

{       Clear the extended device status area for 67x units.
        i#fill ($CHAR (0), ^p_tape_failure_data^.package.initial_extended_status,
              #SIZE (p_tape_failure_data^.package.initial_extended_status));

      = ioc$dt_mt639_1, ioc$dt_mt698_3x =

{       Fill out the extended device status.

        IF p_tape_request^.pp_response_p^.pp_response.response_length >
              (ioc$min_response_length + ioc$bid_area_size + ioc$device_status_size) THEN
          p_hardware_status := #LOC (p_tape_request^.pp_response_p^.extended_device_status);
          FOR i := 1 TO ioc$extended_status_length DO
            p_tape_failure_data^.package.initial_extended_status [i] := p_hardware_status^ [i];
          FOREND;
        ELSE {extended status was not returned, so zero the fields}
          i#fill ($CHAR (0), ^p_tape_failure_data^.package.initial_extended_status,
                #SIZE (p_tape_failure_data^.package.initial_extended_status));
        IFEND;

      ELSE

      CASEND;

{     Read the Block_Id Window for the active tape unit.

      p_tape_failure_data^.package.historical_bid_index := p_ud^.bid_index;
      p_tape_failure_data^.package.historical_limit := UPPERVALUE(iot$bid_index);
      p_tape_failure_data^.package.historical_reserved_area := 0;
      FOR i := 1 TO ioc$bid_window_length DO
        p_tape_failure_data^.package.historical_bid_window [i] := p_ud^.bid_window [i];
      FOREND;

    = ioc$recovered, ioc$unrecovered =

{     Restore the pointer to the statistic package.

      found := FALSE;
      offset := 1;
      WHILE (offset <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF (iov$p_statistic_data_p_array^ [offset].logical_unit = logical_unit) THEN
          p_tape_failure_data := iov$p_statistic_data_p_array^ [offset].p_failure_data;
          found := TRUE;
        ELSE
          offset := offset + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
              'unable to find unit in iop$tape_error_logging', status);
        RETURN;
      IFEND;

{     Obtain the address of the tape job unit descriptor.

      p_ud := iov$p_statistic_data_p_array^ [offset].p_tape_job_unit_descriptor;

{     Use channel, equipment and IOU number from first occurrence of failure.

      IF (p_tape_failure_data^.package.channel_number.concurrent = 0) THEN
        channel.concurrent := FALSE;
      ELSE
        channel.concurrent := TRUE;
      IFEND;
      iou_number := p_tape_failure_data^.package.channel_number.iou;
      channel.number := p_tape_failure_data^.package.channel_number.resource_number;
      channel.port := cmc$unspecified_port;

      cmp$return_descriptor_data (channel, iou_number, p_tape_failure_data^.package.equipment_number,
            logical_unit, path, pp);

      IF path.size > 226 THEN
        path.size := 226;
      IFEND;
      path.size := path.size + 1;

{     Fill out the pp number in tape_failure_statistic_data.

      p_tape_failure_data^.package.pp_number.resource_number := pp;

      CASE tape_failure_type OF

      = ioc$recovered =
        IF on_the_fly_correction_logging THEN
          p_tape_failure_data^.package.failure_severity := 3;
          p_tape_failure_data^.package.failure_symptom_code := ioc$hardware_correction_logging;
          path.value (path.size, * ) := '*IM*ON THE FLY HARDWARE CORRECTIONS';
        ELSE
          p_tape_failure_data^.package.failure_severity := 0;
          p_tape_failure_data^.package.failure_symptom_code := 0;
          path.value (path.size, * ) := '*RF*';
        IFEND;

{ Clear the device status.
        i#fill ($CHAR (0), ^p_tape_failure_data^.package.final_hardware_status,
                #SIZE (p_tape_failure_data^.package.final_hardware_status));

{ Clear the BLOCK_ID window.
        p_tape_failure_data^.package.current_bid_index := 0;
        p_tape_failure_data^.package.current_limit := 0;
        p_tape_failure_data^.package.current_reserved_area := 0;
        i#fill ($CHAR (0), ^p_tape_failure_data^.package.current_bid_window,
                #SIZE (p_tape_failure_data^.package.current_bid_window));

        p_tape_failure_data^.package.channel_number.final_error_status_register := 0;

      = ioc$unrecovered =
        p_tape_failure_data^.package.failure_severity := 1;
        CASE p_tape_request^.io_status.completion_code  OF

        = ioc$indeterminate =
          path.value (path.size, * ) := '*UF*INDETERMINATE*';
          p_tape_failure_data^.package.failure_symptom_code := 1;

        = ioc$input_channel_parity =
          path.value (path.size, * ) := '*UF*INPUT_CHANNEL_PARITY*';
          p_tape_failure_data^.package.failure_symptom_code := 2;

        = ioc$output_channel_parity =
          path.value (path.size, * ) := '*UF*OUTPUT_CHANNEL_PARITY*';
          p_tape_failure_data^.package.failure_symptom_code := 3;

        = ioc$controller_failure =
          path.value (path.size, * ) := '*UF*CONTROLLER_FAILURE*';
          p_tape_failure_data^.package.failure_symptom_code := 4;

        = ioc$unit_failure =
          path.value (path.size, * ) := '*UF*UNIT_FAILURE*';
          p_tape_failure_data^.package.failure_symptom_code := 5;

        = ioc$function_timeout =
          path.value (path.size, * ) := '*UF*FUNCTION_TIMEOUT*';
          p_tape_failure_data^.package.failure_symptom_code := 6;

        = ioc$tape_medium_failure =
          path.value (path.size, * ) := '*UF*TAPE_MEDIUM_FAILURE*';
          p_tape_failure_data^.package.failure_symptom_code := 7;

        = ioc$erase_limit_exceeded =
          path.value (path.size, * ) := '*UF*ERASE_LIMIT_EXCEEDED*';
          p_tape_failure_data^.package.failure_symptom_code := 8;

        = ioc$unit_reserved =
          path.value (path.size, * ) := '*UF*UNIT_RESERVED*';
          p_tape_failure_data^.package.failure_symptom_code := 9;

        = ioc$iou_output_parity =
          path.value (path.size, * ) := '*UF*IOU_OUTPUT_PARITY*';
          p_tape_failure_data^.package.failure_symptom_code := 10;

        = ioc$indeterminate_output_parity =
          path.value (path.size, * ) := '*UF*INDETERMINATE_OUTPUT_PARITY*';
          p_tape_failure_data^.package.failure_symptom_code := 11;

        = ioc$unable_to_write_id_burst =
          path.value (path.size, * ) := '*UF*UNABLE_TO_WRITE_ID_BURST*';
          p_tape_failure_data^.package.failure_symptom_code := 12;

        = ioc$unable_to_set_agc =
          path.value (path.size, * ) := '*UF*UNABLE_TO_SET_AGC*';
          p_tape_failure_data^.package.failure_symptom_code := 13;
        ELSE
          path.value (path.size, * ) := '*UF*UNDEFINED_FAILURE_CODE*';
          p_tape_failure_data^.package.failure_symptom_code := p_tape_request^.io_status.
                completion_code;
        CASEND;

{       Fill out the device status.

        p_hardware_status := #LOC (p_tape_request^.pp_response_p^.device_status);
        FOR i := 1 TO ioc$device_status_length DO
          p_tape_failure_data^.package.final_hardware_status [i] := p_hardware_status^ [i];
        FOREND;

{       Fill out the final BLOCK_ID window.

        p_tape_failure_data^.package.current_bid_index := p_ud^.bid_index;
        p_tape_failure_data^.package.current_limit := UPPERVALUE(iot$bid_index);
        p_tape_failure_data^.package.current_reserved_area := 0;
        FOR i := 1 TO ioc$bid_window_length DO
          p_tape_failure_data^.package.current_bid_window [i] := p_ud^.bid_window [i];
        FOREND;

        p_tape_failure_data^.package.channel_number.final_error_status_register :=
              p_tape_request^.pp_response_p^.pp_response.interface_error_code;

      CASEND;

      p_tape_failure_data^.package.recovery_type := novalue;
      p_tape_failure_data^.package.recovery_retry_count := p_tape_request^.tcu_parity_retry_count +
                                                             p_tape_request^.parity_retry_count +
                                                             p_tape_request^.lost_data_retry_count +
                                                             p_tape_request^.lateack_retry_count +
                                                             p_tape_request^.misc_retry_count;

      CASE p_tape_request^.request_type OF

      = ioc$tape_clear =
        p_tape_failure_data^.package.last_requested_function := 5;

      = ioc$tape_rewind =
        p_tape_failure_data^.package.last_requested_function := 3;

      = ioc$tape_unload =
        p_tape_failure_data^.package.last_requested_function := 4;

      = ioc$tape_forspace =
        p_tape_failure_data^.package.last_requested_function := 8;

      = ioc$tape_backspace =
        p_tape_failure_data^.package.last_requested_function := 9;

      = ioc$tape_cont_backspace =
        p_tape_failure_data^.package.last_requested_function := 11;

      = ioc$tape_read =
        p_tape_failure_data^.package.last_requested_function := 1;

      = ioc$tape_write =
        p_tape_failure_data^.package.last_requested_function := 2;

      = ioc$tape_loop1 =
        p_tape_failure_data^.package.last_requested_function := 13;

      = ioc$tape_loop2 =
        p_tape_failure_data^.package.last_requested_function := 14;

      = ioc$tape_loop3 =
        p_tape_failure_data^.package.last_requested_function := 15;

      = ioc$tape_write_tapemark =
        p_tape_failure_data^.package.last_requested_function := 6;

      = ioc$tape_erase =
        p_tape_failure_data^.package.last_requested_function := 7;

      = ioc$tape_data_security_erase =
        p_tape_failure_data^.package.last_requested_function := 7;

      = ioc$tape_get_status =
        p_tape_failure_data^.package.last_requested_function := 12;

      = ioc$skip_tapemark_forward =
        p_tape_failure_data^.package.last_requested_function := 10;

      = ioc$skip_tapemark_backward =
        p_tape_failure_data^.package.last_requested_function := 11;

      = ioc$tape_master_clear =
        p_tape_failure_data^.package.last_requested_function := 16;

      ELSE

      CASEND;


      CASE pp_interface_table_p^.unit_descriptors [logical_unit].unit_interface_table^.unit_type OF

      = ioc$dt_mt679_5 .. ioc$dt_mt677_4 =

{ Clear the extended status area for 67x units.
        i#fill ($CHAR (0), ^p_tape_failure_data^.package.final_extended_status,
              #SIZE (p_tape_failure_data^.package.final_extended_status));

        statistic_code := cml$7021_3x_failure_data;

      = ioc$dt_mt639_1, ioc$dt_mt698_3x =

        CASE tape_failure_type OF

        = ioc$recovered =

{ Clear the extended device status.
          i#fill ($CHAR (0), ^p_tape_failure_data^.package.final_extended_status,
                #SIZE (p_tape_failure_data^.package.final_extended_status));

        = ioc$unrecovered =

{ Fill out the extended device status.
          IF p_tape_request^.pp_response_p^.pp_response.response_length >
                (ioc$min_response_length + ioc$bid_area_size + ioc$device_status_size) THEN
            p_hardware_status := #LOC (p_tape_request^.pp_response_p^.extended_device_status);
            FOR i := 1 TO ioc$extended_status_length DO
              p_tape_failure_data^.package.final_extended_status [i] := p_hardware_status^ [i];
            FOREND;
          ELSE {extended status was not returned, so zero the fields}
            i#fill ($CHAR (0), ^p_tape_failure_data^.package.final_extended_status,
                  #SIZE (p_tape_failure_data^.package.final_extended_status));
          IFEND;

        CASEND;

        IF pp_interface_table_p^.unit_descriptors [logical_unit].unit_interface_table^.unit_type =
              ioc$dt_mt639_1 THEN
          statistic_code := cml$7221_1_failure_data;
        ELSE { = ioc$dt_mt698_3x }
          statistic_code := cml$698_1x_failure_data;
        IFEND;

      ELSE

      CASEND;

{     Clear the remaining unused words of tape_failure_statistic_data.

      FOR i := ((#SIZE (p_tape_failure_data^.package) DIV 8) + 1) TO ioc$max_failure_counters DO
        p_tape_failure_data^.counters_array [i] := novalue;
      FOREND;

      path.size := 252;
      /establish_eol/
        FOR i := path.size DOWNTO 1 DO
          IF path.value (i) <> ' ' THEN
            path.size := i + 1;
            EXIT /establish_eol/;
          IFEND;
        FOREND /establish_eol/;

      p_counters_seq := ^p_tape_failure_data^.counters;

      RESET p_counters_seq;
      NEXT p_counters: [1 .. ioc$max_failure_counters] IN p_counters_seq;

      sfp$emit_statistic (statistic_code, path.value (1, path.size), p_counters, status);
{     IF NOT status.normal THEN
{       osp$system_error ('emit error', ^status);
{     IFEND;

{     Return the space allocated to the statistic package in the task private heap and
{     set the pointer to that area to NIL.

      FREE p_tape_failure_data IN osv$job_pageable_heap^;

      iov$p_statistic_data_p_array^ [offset].p_failure_data := NIL;

    ELSE

    CASEND;

? ELSE
    status.normal := TRUE;
? IFEND

  PROCEND iop$tape_error_logging;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_error_logging_ccc_cart ' ??
?? EJECT ??

  PROCEDURE iop$tape_error_logging_ccc_cart (p_tape_request: ^iot$tape_request;
        tape_failure_type: iot$tape_failure_type;
    VAR status: ost$status);

? IF system_version THEN

{ Procedure iop$tape_error_logging_ipi serves as a routine that logs
{ all engineering log entries for CCC Cartridge tape errors.

    CONST
      eliminate_bits = 16,
      format_bytes = 0ffffffffff(16);

    VAR
      channel: cmt$physical_channel,
      concurrent: 0 .. 1,
      found: boolean,
      iou_number: dst$iou_number,
      logical_unit: iot$logical_unit,
      offset: iot$no_of_tape_units,
      p_tape_failure_data: ^iot$ccc_cart_tape_failure_data,
      p_ud: ^iot$tape_job_unit_descriptor,
      pp: 0 .. 0ff(16),
      pp_interface_table_p: ^iot$pp_interface_table;
??EJECT??

      PROCEDURE build_log_entry (failure_type: iot$tape_failure_type);

        VAR
          i: integer,
          p_status: ^array [1 .. 8] of 0 .. 0ff(16),
          p_sense: ^array [1 .. 40] of 0 .. 0ff(16);

        CASE failure_type OF

        = ioc$intermediate =

          p_tape_failure_data^.package.pp_number.initial_error_status_register := 0;
          p_tape_failure_data^.package.pp_number.final_error_status_register := 0;
          p_tape_failure_data^.package.pp_number.fill1 := 0;
          p_tape_failure_data^.package.pp_number.iou := iou_number;
          p_tape_failure_data^.package.pp_number.fill2 := 0;
          p_tape_failure_data^.package.pp_number.i4_port_a := 0;
          p_tape_failure_data^.package.pp_number.i4_port_b := 0;
          p_tape_failure_data^.package.pp_number.concurrent := concurrent;

          p_tape_failure_data^.package.channel_number.initial_error_status_register := 0;
          p_tape_failure_data^.package.channel_number.final_error_status_register := 0;
          p_tape_failure_data^.package.channel_number.fill1 := 0;
          p_tape_failure_data^.package.channel_number.iou := iou_number;
          p_tape_failure_data^.package.channel_number.fill2 := 0;
          p_tape_failure_data^.package.channel_number.i4_port_a := 0;
          p_tape_failure_data^.package.channel_number.i4_port_b := 0;
          p_tape_failure_data^.package.channel_number.concurrent := concurrent;
          p_tape_failure_data^.package.channel_number.resource_number := channel.number;

          p_tape_failure_data^.package.equipment_number := pp_interface_table_p^.unit_descriptors
                [logical_unit].physical_path.controller_number;
          p_tape_failure_data^.package.physical_unit_number := pp_interface_table_p^.
                unit_descriptors [logical_unit].physical_path.physical_unit_number;

          p_tape_failure_data^.package.unit_type := 10;

          CASE p_tape_request^.request_type OF

          = ioc$tape_read =
            p_tape_failure_data^.package.operation_code := 1;

          = ioc$tape_write =
            p_tape_failure_data^.package.operation_code := 2;

          = ioc$tape_rewind =
            p_tape_failure_data^.package.operation_code := 3;

          = ioc$tape_unload =
            p_tape_failure_data^.package.operation_code := 4;

          = ioc$locate_block =
            p_tape_failure_data^.package.operation_code := 5;

          = ioc$tape_write_tapemark =
            p_tape_failure_data^.package.operation_code := 6;

          = ioc$tape_erase =
            p_tape_failure_data^.package.operation_code := 7;

          = ioc$tape_forspace =
            p_tape_failure_data^.package.operation_code := 8;

          = ioc$tape_backspace =
            p_tape_failure_data^.package.operation_code := 9;

          = ioc$skip_tapemark_forward =
            p_tape_failure_data^.package.operation_code := 10;

          = ioc$skip_tapemark_backward =
            p_tape_failure_data^.package.operation_code := 11;

          = ioc$tape_get_status =
            p_tape_failure_data^.package.operation_code := 12;

          ELSE

          CASEND;

          p_tape_failure_data^.package.failure_symptom_code := p_tape_request^.pp_response_p^.
                ccc_cart_device_status.error_id;
          p_tape_failure_data^.package.blocks_written := p_ud^.blocks_written;
          p_tape_failure_data^.package.blocks_read := p_ud^.blocks_read;
          p_tape_failure_data^.package.block_count := p_ud^.block_count;
          p_tape_failure_data^.package.tapemark_count := p_ud^.tapemark_count;
          p_tape_failure_data^.package.last_function.last_not_status := p_tape_request^.
                pp_response_p^.ccc_cart_device_status.last_non_status_function;
          p_tape_failure_data^.package.last_function.last := p_tape_request^.
                pp_response_p^.ccc_cart_device_status.last_function;
          p_tape_failure_data^.package.last_function.fill := 0;
          p_tape_failure_data^.package.first_error_status_register := p_tape_request^.
                pp_response_p^.ccc_cart_device_status.channel_error_register;
          p_tape_failure_data^.package.density := 38000;

          p_status := #LOC (p_tape_request^.pp_response_p^.ccc_cart_device_status);
          FOR i := 1 TO 8 DO
            p_tape_failure_data^.package.initial_status [i] := p_status^ [i];
          FOREND;

          IF p_tape_request^.pp_response_p^.pp_response.response_length >
                ioc$min_ccc_cart_resp_size THEN
            p_sense := #LOC (p_tape_request^.pp_response_p^.ccc_cart_sense_bytes);
            FOR i := 1 TO 40 DO
              p_tape_failure_data^.package.initial_sense_bytes [i] := p_sense^ [i];
            FOREND;
          ELSE { no sense bytes
            i#fill ($CHAR (0), ^p_tape_failure_data^.package.initial_sense_bytes,
                  #SIZE (p_tape_failure_data^.package.initial_sense_bytes));
          IFEND;

          p_tape_failure_data^.package.res2 := 0;
          p_tape_failure_data^.package.last_failure_info.fill := 0;
          p_tape_failure_data^.package.last_failure_info.error_id := 0;
          p_tape_failure_data^.package.last_failure_info.last_non_status_function := 0;
          p_tape_failure_data^.package.last_failure_info.last_function := 0;

          IF p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id = ioc$ccc_cart_hardware_corr THEN
            FOR i := 1 TO 8 DO
              p_tape_failure_data^.package.initial_status [i] := 0;
            FOREND;
            i#fill ($CHAR (0), ^p_tape_failure_data^.package.initial_sense_bytes,
                  #SIZE (p_tape_failure_data^.package.initial_sense_bytes));
            p_tape_failure_data^.package.on_the_fly_read_corrections := p_tape_request^.
                  pp_response_p^.ccc_cart_error_log.on_the_fly_read_errors;
            p_tape_failure_data^.package.on_the_fly_write_corrections := p_tape_request^.
                  pp_response_p^.ccc_cart_error_log.on_the_fly_write_errors;
            p_tape_failure_data^.package.read_recovery_count := p_tape_request^.
                  pp_response_p^.ccc_cart_error_log.recovered_read_errors;
            p_tape_failure_data^.package.write_recovery_count := p_tape_request^.
                  pp_response_p^.ccc_cart_error_log.recovered_write_errors;
            p_tape_failure_data^.package.buffer_underruns := p_ud^.ccc_cart_buffer_underruns;
          ELSE
            p_tape_failure_data^.package.on_the_fly_read_corrections := 0;
            p_tape_failure_data^.package.on_the_fly_write_corrections := 0;
            p_tape_failure_data^.package.read_recovery_count := 0;
            p_tape_failure_data^.package.write_recovery_count := 0;
            p_tape_failure_data^.package.buffer_underruns := 0;
          IFEND;

        = ioc$recovered =

          p_tape_failure_data^.package.failure_severity := 0;
          p_tape_failure_data^.package.recovery_retry_count := p_tape_request^.parity_retry_count +
                                                               p_tape_request^.misc_retry_count;

          p_status := #LOC (p_tape_request^.pp_response_p^.ccc_cart_device_status);
          FOR i := 1 TO 8 DO
            p_tape_failure_data^.package.final_status [i] := p_status^ [i];
          FOREND;

          i#fill ($CHAR (0), ^p_tape_failure_data^.package.initial_sense_bytes,
                #SIZE (p_tape_failure_data^.package.initial_sense_bytes));

          p_tape_failure_data^.package.final_error_status_register := p_tape_request^.
                pp_response_p^.ccc_cart_device_status.channel_error_register;

        = ioc$unrecovered =

          p_tape_failure_data^.package.failure_severity := 1;
          p_tape_failure_data^.package.recovery_retry_count := p_tape_request^.parity_retry_count +
                                                               p_tape_request^.misc_retry_count;

          p_tape_failure_data^.package.last_failure_info.last_non_status_function :=
                p_tape_request^.pp_response_p^.ccc_cart_device_status.last_non_status_function;
          p_tape_failure_data^.package.last_failure_info.last_function :=
                p_tape_request^.pp_response_p^.ccc_cart_device_status.last_function;
          p_tape_failure_data^.package.last_failure_info.error_id :=
                p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id;

          p_status := #LOC (p_tape_request^.pp_response_p^.ccc_cart_device_status);
          FOR i := 1 TO 8 DO
            p_tape_failure_data^.package.final_status [i] := p_status^ [i];
          FOREND;

          IF p_tape_request^.pp_response_p^.pp_response.response_length >
                ioc$min_ccc_cart_resp_size THEN
            p_sense := #LOC (p_tape_request^.pp_response_p^.ccc_cart_sense_bytes);
            FOR i := 1 TO 40 DO
              p_tape_failure_data^.package.final_sense_bytes [i] := p_sense^ [i];
            FOREND;
          ELSE { no sense bytes
            i#fill ($CHAR (0), ^p_tape_failure_data^.package.final_sense_bytes,
                  #SIZE (p_tape_failure_data^.package.final_sense_bytes));
          IFEND;

          p_tape_failure_data^.package.final_error_status_register := p_tape_request^.
                pp_response_p^.ccc_cart_device_status.channel_error_register;

        ELSE

        CASEND;

      PROCEND build_log_entry;
?? EJECT ??
    status.normal := TRUE;

    logical_unit := p_tape_request^.request.logical_unit;
    pp := p_tape_request^.pp_response_p^.pp_no;
    iou_number := cmv$logical_pp_table_p^ [pp].pp_info.channel.iou_number;
    pp_interface_table_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;
    channel.number := pp_interface_table_p^.unit_descriptors [logical_unit].
          physical_path.channel_number;
    IF cmv$logical_pp_table_p^ [pp].pp_info.channel_interlock_p^.
          channel_characteristics [channel.number].concurrent_channel THEN
      concurrent := 1;
    ELSE
      concurrent := 0;
    IFEND;

    found := FALSE;
    offset := 1;
    WHILE (offset <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
      IF (iov$p_statistic_data_p_array^ [offset].logical_unit = logical_unit) THEN
        p_tape_failure_data := iov$p_statistic_data_p_array^ [offset].p_ccc_cart_failure_data;
        found := TRUE;
      ELSE
        offset := offset + 1;
      IFEND;
    WHILEND;

    IF NOT found THEN
      osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
            'unable to find unit in iop$tape_error_logging_ipi', status);
      RETURN;
    IFEND;

{ Obtain the address of the tape job unit descriptor.

    p_ud := iov$p_statistic_data_p_array^ [offset].p_tape_job_unit_descriptor;

    IF p_tape_failure_data = NIL THEN  { no pending entry

{     Allocate space in the job_pageable_heap for the package that is going to contain
{     the tape_failure_statistic_data.

      ALLOCATE p_tape_failure_data IN osv$job_pageable_heap^;

      IF tape_failure_type = ioc$intermediate THEN
        build_log_entry (tape_failure_type);
        iov$p_statistic_data_p_array^ [offset].p_ccc_cart_failure_data := p_tape_failure_data;
        RETURN;
      ELSE  {unrecovered or recovered
        build_log_entry (ioc$intermediate);
        build_log_entry (tape_failure_type);
        iop$issue_ccc_cart_log_entry (p_tape_failure_data, logical_unit, status);
        FREE p_tape_failure_data IN osv$job_pageable_heap^;
        iov$p_statistic_data_p_array^ [offset].p_ccc_cart_failure_data := NIL;
        RETURN;
      IFEND;

    ELSE  { there is a pending error log entry

      IF (tape_failure_type = ioc$unrecovered) OR (tape_failure_type = ioc$recovered) THEN
        IF (tape_failure_type = ioc$recovered) AND p_tape_request^.ccc_cart_buf_underrun_recovery THEN
          p_ud^.ccc_cart_buffer_underruns := p_ud^.ccc_cart_buffer_underruns + 1;
          p_tape_request^.ccc_cart_buf_underrun_recovery := FALSE;
        ELSE
          build_log_entry (tape_failure_type);
          iop$issue_ccc_cart_log_entry (p_tape_failure_data, logical_unit, status);
        IFEND;
        FREE p_tape_failure_data IN osv$job_pageable_heap^;
        iov$p_statistic_data_p_array^ [offset].p_ccc_cart_failure_data := NIL;

      ELSE { ioc$intermediate or ioc$informative are illegal
        osp$set_status_abnormal ('io', ioc$os_failure,
              'Incorrect tape_failure_type in iop$tape_error_logging_ccc_cart', status);

      IFEND;

    IFEND;

? ELSE
    status.normal := TRUE;
? IFEND

  PROCEND iop$tape_error_logging_ccc_cart;
?? OLDTITLE ??
?? NEWTITLE := ' iop$issue_ccc_cart_log_entry ' ??
?? EJECT ??
? IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$issue_ccc_cart_log_entry (
        p_tape_failure_data: ^iot$ccc_cart_tape_failure_data;
        logical_unit: iot$logical_unit;
    VAR status: ost$status);

    VAR
      bytes_last_word: 0 .. 8,
      channel: cmt$physical_channel,
      iou_number: dst$iou_number,
      p_counters: sft$counters,
      p_counters_seq: ^SEQ ( * ),
      path: ost$string,
      pp: 0 .. 0ff(16),
      statistic_code: sft$statistic_code,
      text: string (ioc$max_ccc_cart_error_text);

    status.normal := TRUE;

    IF iov$establish_tape_statistics THEN
      iop$establish_tape_statistics (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Use channel, equipment and IOU number from first occurrence of failure.

    IF (p_tape_failure_data^.package.channel_number.concurrent = 0) THEN
      channel.concurrent := FALSE;
    ELSE
      channel.concurrent := TRUE;
    IFEND;
    iou_number := p_tape_failure_data^.package.channel_number.iou;
    channel.number := p_tape_failure_data^.package.channel_number.resource_number;
    channel.port := cmc$unspecified_port;

    cmp$return_descriptor_data (channel, iou_number, p_tape_failure_data^.package.equipment_number,
          logical_unit, path, pp);

    IF path.size > 226 THEN
      path.size := 226;
    IFEND;
    path.size := path.size + 1;

{ Fill out the pp number in tape_failure_statistic_data.

    p_tape_failure_data^.package.pp_number.resource_number := pp;

    IF p_tape_failure_data^.package.failure_severity = 0 THEN  { recovered
      path.value (path.size, * ) := '*RF*';
    ELSEIF p_tape_failure_data^.package.failure_severity = 1 THEN  { unrecovered
      path.value (path.size, * ) := '*UF*';
    ELSEIF p_tape_failure_data^.package.failure_severity = 2 THEN  { intermediate
      path.value (path.size, * ) := '*IF*';
    ELSEIF p_tape_failure_data^.package.failure_severity = 3 THEN  { informative
      path.value (path.size, * ) := '*IM*';
    IFEND;

    path.size := path.size + 4;

    iop$determine_err_text_ccc_cart  (p_tape_failure_data^.package.failure_symptom_code, text);
    path.value (path.size, *) := text;
    path.size := path.size + ioc$max_ccc_cart_error_text;

    p_counters_seq := ^p_tape_failure_data^.counters;

    RESET p_counters_seq;
    NEXT p_counters: [1 .. ioc$max_ccc_cart_counters] IN p_counters_seq;
    statistic_code := cml$5680_11_failure_data;

    sfp$emit_statistic (statistic_code, path.value (1, path.size), p_counters, status);

  PROCEND iop$issue_ccc_cart_log_entry;

? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$determine_err_text_ccc_cart ' ??
?? EJECT ??
? IF system_version THEN

  PROCEDURE iop$determine_err_text_ccc_cart (
        error_id: 0 .. ioc$max_ccc_cart_error_id;
    VAR text: string (ioc$max_ccc_cart_error_text));

    CASE error_id OF

    = ioc$ccc_cart_no_pp_eid, ioc$ccc_cart_indeterminate =
      text := 'INDETERMINATE';

    = ioc$ccc_cart_input_chan_parity =
      text := 'INPUT CHANNEL PARITY';

    = ioc$ccc_cart_output_chan_par =
      text := 'OUTPUT CHANNEL PARITY';

    = ioc$ccc_cart_coupler_failure =
      text := 'COUPLER FAILURE';

    = ioc$ccc_cart_cu_failure =
      text := 'CONTROL UNIT FAILURE';

    = ioc$ccc_cart_unit_failure =
      text := 'UNIT FAILURE';

    = ioc$ccc_cart_unit_not_ready =
      text := 'UNIT NOT READY';

    = ioc$ccc_cart_function_timeout =
      text := 'FUNCTION TIMEOUT';

    = ioc$ccc_cart_tape_medium =
      text := 'TAPE MEDIUM FAILURE';

    = ioc$ccc_cart_iou_parity =
      text := 'IOU OUTPUT PARITY';

    = ioc$ccc_cart_indeterminate_par =
      text := 'INDETERMINATE OUTPUT PARITY';

    = ioc$ccc_cart_write_id_mark =
      text := 'UNABLE TO WRITE ID MARK';

    = ioc$ccc_cart_read_id_mark =
      text := 'UNABLE TO READ ID MARK';

    = ioc$ccc_cart_hardware_corr =
      text := 'HARDWARE CORRECTIONS';

    = ioc$ccc_cart_microcode_load =
      text := 'MICROCODE LOAD ERROR';

    = ioc$ccc_cart_invalid_bid =
      text := 'BLOCK ID INVALID';

    = ioc$ccc_cart_inc_trans_in =
      text := 'INCOMPLETE TRANSFER ON INPUT';

    = ioc$ccc_cart_inc_trans_out =
      text := 'INCOMPLETE TRANSFER ON OUTPUT';

    = ioc$ccc_cart_pp_chan_flag =
      text := 'CHANNEL ERROR FLAG';

    = ioc$ccc_cart_single_pp,
      ioc$ccc_cart_unit_type,
      ioc$ccc_cart_ill_command,
      ioc$ccc_cart_ill_comm_buf_lng,
      ioc$ccc_cart_ill_write_sequence,
      ioc$ccc_cart_reserved_1,
      ioc$ccc_cart_ill_abn_status,
      ioc$ccc_cart_no_alert,
      ioc$ccc_cart_no_abn_status =
      text := 'SOFTWARE FAILURE';

    ELSE

      text := 'UNKNOWN ERROR ID';

    CASEND;

  PROCEND iop$determine_err_text_ccc_cart;

? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_error_logging_ipi ' ??
?? EJECT ??

  PROCEDURE iop$tape_error_logging_ipi (p_tape_request: ^iot$tape_request;
        tape_failure_type: iot$tape_failure_type;
    VAR status: ost$status);

? IF system_version THEN

{ Procedure iop$tape_error_logging_ipi serves as a routine that logs
{ all engineering log entries for IPI tape errors.

    CONST
      eliminate_bits = 16,
      format_bytes = 0ffffffffff(16);

    VAR
      channel: cmt$physical_channel,
      concurrent: 0 .. 1,
      found: boolean,
      iou_number: dst$iou_number,
      logical_unit: iot$logical_unit,
      offset: iot$no_of_tape_units,
      p_tape_failure_data: ^iot$ipi_tape_failure_data,
      p_ud: ^iot$tape_job_unit_descriptor,
      port_a: 0 .. 1,
      port_b: 0 .. 1,
      pp: 0 .. 0ff(16),
      pp_interface_table_p: ^iot$pp_interface_table;
??EJECT??

      PROCEDURE build_log_entry;

        VAR
          i: integer,
          p_major_status: ^array [1 .. ioc$ipi_max_status_size] of 0 .. 0ff(16),
          p_tape_format: ^0 .. format_bytes,
          status_length: 1 .. ioc$ipi_max_status_size;


        p_tape_failure_data^.package.pp_number.initial_error_status_register := 0;
        p_tape_failure_data^.package.pp_number.final_error_status_register := 0;
        p_tape_failure_data^.package.pp_number.fill1 := 0;
        p_tape_failure_data^.package.pp_number.iou := iou_number;
        p_tape_failure_data^.package.pp_number.fill2 := 0;
        p_tape_failure_data^.package.pp_number.i4_port_a := 0;
        p_tape_failure_data^.package.pp_number.i4_port_b := 0;
        p_tape_failure_data^.package.pp_number.concurrent := concurrent;

        p_tape_failure_data^.package.channel_number.initial_error_status_register := 0;
        p_tape_failure_data^.package.channel_number.final_error_status_register := 0;
        p_tape_failure_data^.package.channel_number.fill1 := 0;
        p_tape_failure_data^.package.channel_number.iou := iou_number;
        p_tape_failure_data^.package.channel_number.fill2 := 0;
        p_tape_failure_data^.package.channel_number.i4_port_a := port_a;
        p_tape_failure_data^.package.channel_number.i4_port_b := port_b;
        p_tape_failure_data^.package.channel_number.concurrent := concurrent;
        p_tape_failure_data^.package.channel_number.resource_number := channel.number;

        p_tape_failure_data^.package.equipment_number := pp_interface_table_p^.unit_descriptors
              [logical_unit].physical_path.controller_number;
        p_tape_failure_data^.package.physical_unit_number := pp_interface_table_p^.
              unit_descriptors [logical_unit].physical_path.physical_unit_number;

        p_tape_failure_data^.package.unit_type := 9;

        CASE p_tape_request^.request_type OF

        = ioc$tape_read =
          p_tape_failure_data^.package.operation_code := 1;

        = ioc$tape_write =
          p_tape_failure_data^.package.operation_code := 2;

        = ioc$tape_rewind =
          p_tape_failure_data^.package.operation_code := 3;

        = ioc$tape_unload =
          p_tape_failure_data^.package.operation_code := 4;

        = ioc$tape_write_tapemark =
          p_tape_failure_data^.package.operation_code := 6;

        = ioc$tape_erase =
          p_tape_failure_data^.package.operation_code := 7;

        = ioc$tape_data_security_erase =
          p_tape_failure_data^.package.operation_code := 7;

        = ioc$tape_forspace =
          p_tape_failure_data^.package.operation_code := 8;

        = ioc$tape_backspace =
          p_tape_failure_data^.package.operation_code := 9;

        = ioc$skip_tapemark_forward =
          p_tape_failure_data^.package.operation_code := 10;

        = ioc$skip_tapemark_backward =
          p_tape_failure_data^.package.operation_code := 11;

        = ioc$tape_get_status =
          p_tape_failure_data^.package.operation_code := 12;

        ELSE

        CASEND;

        CASE tape_failure_type OF

        = ioc$recovered =
          p_tape_failure_data^.package.failure_severity := 0;

        = ioc$unrecovered =
          p_tape_failure_data^.package.failure_severity := 1;

        = ioc$intermediate =
          p_tape_failure_data^.package.failure_severity := 2;

        = ioc$informative =
          p_tape_failure_data^.package.failure_severity := 3;

        ELSE
        CASEND;
        p_tape_failure_data^.package.failure_symptom_code := p_tape_request^.pp_response_p^.
              ipi_tape_status.error_id;
        p_tape_failure_data^.package.blocks_written := p_ud^.blocks_written;
        p_tape_failure_data^.package.blocks_read := p_ud^.blocks_read;
        p_tape_failure_data^.package.single_double_track_corrections := p_ud^.single_double_track_corrections;
        p_tape_failure_data^.package.unused_fill1 := 0;
        p_tape_failure_data^.package.block_count := p_ud^.block_count;
        p_tape_failure_data^.package.tapemark_count := p_ud^.tapemark_count;
        p_tape_format := #LOC (p_tape_request^.request.mode);
        p_tape_failure_data^.package.tape_format_parameters := p_tape_format^ DIV eliminate_bits;

        CASE p_ud^.tape_unit_density OF

        = 0, 1 =
          p_tape_failure_data^.package.density := 1600;

        = 2 =
          p_tape_failure_data^.package.density := 800;

        = 3 =
          p_tape_failure_data^.package.density := 6250;

        ELSE

        CASEND;

        p_tape_failure_data^.package.unused_fill2 := 0;
        p_tape_failure_data^.package.recovery_retry_count := p_tape_request^.parity_retry_count +
                                                             p_tape_request^.ipi_retry_count +
                                                             p_tape_request^.misc_retry_count;
        p_tape_failure_data^.package.last_requested_function := p_tape_request^.pp_response_p^.
              ipi_tape_status.function_with_timeout;
        p_tape_failure_data^.package.ipi_status_register := p_tape_request^.pp_response_p^.
              ipi_tape_status.ipi_status_register;
        p_tape_failure_data^.package.ipi_error_register := p_tape_request^.pp_response_p^.
              ipi_tape_status.ipi_error_register;
        p_tape_failure_data^.package.i4_error_register := p_tape_request^.pp_response_p^.
              ipi_tape_status.i4_dma_error_register;
        p_tape_failure_data^.package.i4_operation_register := p_tape_request^.pp_response_p^.
              ipi_tape_status.i4_dma_operational_status_reg;
        p_tape_failure_data^.package.i4_control_register := p_tape_request^.pp_response_p^.
              ipi_tape_status.i4_dma_control_register;
        p_tape_failure_data^.package.interface_error_code :=
              p_tape_request^.pp_response_p^.pp_response.interface_error_code;
        p_tape_failure_data^.package.unused_fill3 := 0;
        p_tape_failure_data^.package.unused_fill4 := 0;
        p_tape_failure_data^.package.unused_fill5 := 0;
        p_tape_failure_data^.package.unused_fill6 := 0;
        p_tape_failure_data^.package.unused_fill7 := 0;
        p_major_status := #LOC (p_tape_request^.pp_response_p^.ipi_tape_status.major_status_header);

        IF (p_tape_request^.pp_response_p^.pp_response.response_length <=
              ioc$min_ipi_total_resp_size) THEN
          FOR i := 1 to 8 DO {loop is faster than i#fill
            p_tape_failure_data^.package.ipi_status [i] := 0;
          FOREND;
        ELSE
          status_length := p_tape_request^.pp_response_p^.ipi_tape_status.major_status_header.length + 2;
          FOR i := 1 TO status_length DO
            p_tape_failure_data^.package.ipi_status [i] := p_major_status^ [i];
          FOREND;
        IFEND;

      PROCEND build_log_entry;
?? EJECT ??
    status.normal := TRUE;

    logical_unit := p_tape_request^.request.logical_unit;
    pp := p_tape_request^.pp_response_p^.pp_no;
    iou_number := cmv$logical_pp_table_p^ [pp].pp_info.channel.iou_number;
    pp_interface_table_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;
    channel.number := pp_interface_table_p^.unit_descriptors [logical_unit].
          physical_path.channel_number;
    port_a := 0;
    port_b := 0;
    IF cmv$logical_pp_table_p^ [pp].pp_info.channel_interlock_p^.
          channel_characteristics [channel.number].concurrent_channel THEN
      concurrent := 1;
      IF pp_interface_table_p^.unit_descriptors [logical_unit].physical_path.port = 0 THEN
        port_a := 1;
      ELSE
        port_b := 1;
      IFEND;
    ELSE
      concurrent := 0;
    IFEND;

    found := FALSE;
    offset := 1;
    WHILE (offset <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
      IF (iov$p_statistic_data_p_array^ [offset].logical_unit = logical_unit) THEN
        p_tape_failure_data := iov$p_statistic_data_p_array^ [offset].p_ipi_failure_data;
        found := TRUE;
      ELSE
        offset := offset + 1;
      IFEND;
    WHILEND;

    IF NOT found THEN
      osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
            'unable to find unit in iop$tape_error_logging_ipi', status);
      RETURN;
    IFEND;

{ Obtain the address of the tape job unit descriptor.

    p_ud := iov$p_statistic_data_p_array^ [offset].p_tape_job_unit_descriptor;

    IF p_tape_failure_data = NIL THEN  { no pending entry

{     Allocate space in the job_pageable_heap for the package that is going to contain
{     the tape_failure_statistic_data.

      ALLOCATE p_tape_failure_data IN osv$job_pageable_heap^;

      build_log_entry;

      IF tape_failure_type = ioc$intermediate THEN
        iov$p_statistic_data_p_array^ [offset].p_ipi_failure_data := p_tape_failure_data;
        RETURN;
      ELSE  {unrecovered, informative or recovered
        iop$issue_ipi_log_entry (p_tape_failure_data, logical_unit, status);
        FREE p_tape_failure_data IN osv$job_pageable_heap^;
        iov$p_statistic_data_p_array^ [offset].p_ipi_failure_data := NIL;
        RETURN;
      IFEND;

    ELSE  { there is a pending error log entry

      IF (tape_failure_type = ioc$unrecovered) OR (tape_failure_type = ioc$informative) THEN
        iop$issue_ipi_log_entry (p_tape_failure_data, logical_unit, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        build_log_entry;
        iop$issue_ipi_log_entry (p_tape_failure_data, logical_unit, status);
        FREE p_tape_failure_data IN osv$job_pageable_heap^;
        iov$p_statistic_data_p_array^ [offset].p_ipi_failure_data := NIL;
        RETURN;

      ELSEIF (tape_failure_type = ioc$intermediate) THEN
        iop$issue_ipi_log_entry (p_tape_failure_data, logical_unit, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        build_log_entry;
        RETURN;

      ELSE  { ioc$recovered
        p_tape_failure_data^.package.failure_severity := 0;

        p_tape_failure_data^.package.recovery_retry_count := p_tape_request^.parity_retry_count +
                                                             p_tape_request^.ipi_retry_count +
                                                             p_tape_request^.misc_retry_count;
        iop$issue_ipi_log_entry (p_tape_failure_data, logical_unit, status);
        FREE p_tape_failure_data IN osv$job_pageable_heap^;
        iov$p_statistic_data_p_array^ [offset].p_ipi_failure_data := NIL;
        RETURN;

      IFEND;

    IFEND;

? ELSE
    status.normal := TRUE;
? IFEND

  PROCEND iop$tape_error_logging_ipi;
?? OLDTITLE ??
?? NEWTITLE := ' iop$issue_ipi_log_entry ' ??
?? EJECT ??
? IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$issue_ipi_log_entry (
        p_tape_failure_data: ^iot$ipi_tape_failure_data;
        logical_unit: iot$logical_unit;
    VAR status: ost$status);

    VAR
      bytes_last_word: 0 .. 8,
      channel: cmt$physical_channel,
      i: integer,
      iou_number: dst$iou_number,
      number_of_counters : 1 .. ioc$max_failure_counters,
      p_counters: sft$counters,
      p_counters_seq: ^SEQ ( * ),
      path: ost$string,
      pp: 0 .. 0ff(16),
      residual: 0 .. 8,
      statistic_code: sft$statistic_code,
      status_length: 0 .. ioc$ipi_max_status_size,
      text: string (ioc$max_ipi_error_text);

    status.normal := TRUE;

    IF iov$establish_tape_statistics THEN
      iop$establish_tape_statistics (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Use channel, equipment and IOU number from first occurrence of failure.

    IF (p_tape_failure_data^.package.channel_number.concurrent = 0) THEN
      channel.concurrent := FALSE;
    ELSE
      channel.concurrent := TRUE;
    IFEND;
    iou_number := p_tape_failure_data^.package.channel_number.iou;
    channel.number := p_tape_failure_data^.package.channel_number.resource_number;
    IF p_tape_failure_data^.package.channel_number.i4_port_a = 1 THEN
      channel.port := cmc$port_a;
    ELSEIF p_tape_failure_data^.package.channel_number.i4_port_b = 1 THEN
      channel.port := cmc$port_b;
    ELSE
      channel.port := cmc$unspecified_port;
    IFEND;

    cmp$return_descriptor_data (channel, iou_number, p_tape_failure_data^.package.equipment_number,
          logical_unit, path, pp);

    IF path.size > 226 THEN
      path.size := 226;
    IFEND;
    path.size := path.size + 1;

{ Fill out the pp number in tape_failure_statistic_data.

    p_tape_failure_data^.package.pp_number.resource_number := pp;

    IF p_tape_failure_data^.package.failure_severity = 0 THEN  { recovered
      path.value (path.size, * ) := '*RF*';
    ELSEIF p_tape_failure_data^.package.failure_severity = 1 THEN  { unrecovered
      path.value (path.size, * ) := '*UF*';
    ELSEIF p_tape_failure_data^.package.failure_severity = 2 THEN  { intermediate
      path.value (path.size, * ) := '*IF*';
    ELSEIF p_tape_failure_data^.package.failure_severity = 3 THEN  { informative
      path.value (path.size, * ) := '*IM*';
    IFEND;

    path.size := path.size + 4;

    iop$determine_error_text (p_tape_failure_data^.package.failure_symptom_code, text);
    path.value (path.size, *) := text;
    path.size := path.size + ioc$max_ipi_error_text;

    status_length := p_tape_failure_data^.package.ipi_status [2];
    IF status_length = 0 THEN
      number_of_counters := ioc$min_ipi_counters;
    ELSE
      status_length := status_length + 2;
      bytes_last_word := status_length MOD 8;
      IF bytes_last_word = 0 THEN
        number_of_counters := (status_length DIV 8) + ioc$min_ipi_counters - 1;
      ELSE
        number_of_counters := (status_length DIV 8) + ioc$min_ipi_counters;
        residual := 8 - bytes_last_word;
        FOR i := 1 TO residual DO
          p_tape_failure_data^.package.ipi_status [status_length + i] := 0;
        FOREND;
      IFEND;
    IFEND;

    p_counters_seq := ^p_tape_failure_data^.counters;

    RESET p_counters_seq;
    NEXT p_counters: [1 .. number_of_counters] IN p_counters_seq;
    statistic_code := cml$5698_1x_failure_data;

    sfp$emit_statistic (statistic_code, path.value (1, path.size), p_counters, status);

  PROCEND iop$issue_ipi_log_entry;

? IFEND
?? OLDTITLE ??
?? NEWTITLE := ' iop$determine_error_text ' ??
?? EJECT ??
? IF system_version THEN

  PROCEDURE iop$determine_error_text (
        error_id: 0 .. ioc$max_ipi_error_id;
    VAR text: string (ioc$max_ipi_error_text));

    CASE error_id OF

    = ioc$ipi_indeterminate_error =
      text := 'INDETERMINATE';

    = ioc$ipi_function_timeout =
      text := 'FUNCTION TIMEOUT';

    = ioc$chan_empty_when_act =
      text := 'CHANNEL EMPTY WHEN ACTIVATED';

    = ioc$period_counter_error =
      text := 'PERIOD COUNTER ERROR';

    = ioc$upper_ici_parity =
      text := 'UPPER ICI PARITY';

    = ioc$lower_ici_parity =
      text := 'LOWER ICI PARITY';

    = ioc$iou_error =
      text := 'IOU ERROR';

    = ioc$incomplete_i4_transfer =
      text := 'INCOMPLETE I4 TRANSFER';

    = ioc$channel_not_empty =
      text := 'CHANNEL NOT EMPTY';

    = ioc$central_memory_error =
      text := 'CENTRAL MEMORY ERROR';

    = ioc$invalid_cm_resp_code =
      text := 'INVALID CM RESPONSE CODE';

    = ioc$cm_resp_code_parity =
      text := 'CM RESPONSE CODE PARITY ERROR';

    = ioc$cmi_read_data_parity =
      text := 'CMI READ DATA PARITY ERROR';

    = ioc$jy_data_error =
      text := 'JY DATA ERROR';

    = ioc$bas_parity_error =
      text := 'BAS PARITY ERROR';

    = ioc$lz_error =
      text := 'LZ ERROR';

    = ioc$yj_error =
      text := 'JY ERROR';

    = ioc$lx_error =
      text := 'LX ERROR';

    = ioc$dma_test_mode_failure =
      text := 'DMA TEST MODE FAILURE';

    = ioc$illegal_operation =
      text := 'ILLEGAL OPERATION';

    = ioc$can_not_select_controller =
      text := 'CANNOT SELECT CONTROLLER';

    = ioc$bit_sign_response_error =
      text := 'BIT SIGNIFICANT RESPONSE ERROR';

    = ioc$no_sync_in =
      text := 'NO SYNC IN';

    = ioc$sync_in_did_not_drop =
      text := 'SYNC IN DID NOT DROP';

    = ioc$ipi_sequence_error =
      text := 'IPI SEQUENCE ERROR';

    = ioc$upper_ipi_chan_parity =
      text := 'UPPER ICI CHANNEL PARITY';

    = ioc$lower_ipi_chan_parity =
      text := 'LOWER ICI CHANNEL PARITY';

    = ioc$slave_in_not_set =
      text := 'SLAVE IN NOT SET';

    = ioc$slave_in_did_not_drop =
      text := 'SLAVE IN DID NOT DROP';

    = ioc$incomplete_transfer =
      text := 'INCOMPLETE TRANSFER';

    = ioc$channel_stayed_active =
      text := 'CHANNEL STAYED ACTIVE';

    = ioc$buffer_counter_error =
      text := 'BUFFER COUNTER ERROR';

    = ioc$sync_counter_error =
      text := 'SYNC COUNTER ERROR';

    = ioc$lost_data =
      text := 'LOST DATA';

    = ioc$bus_parity =
      text := 'BUS PARITY';

    = ioc$command_reject =
      text := 'COMMAND REJECT';

    = ioc$sync_outs_ne_sync_ins =
      text := 'SYNC OUTS NOT EQUAL SYNC INS';

    = ioc$bus_b_ack_incorrect =
      text := 'BUS B ACKNOWLEDGE INCORRECT';

    = ioc$no_controller_interrupt =
      text := 'NO CONTROLLER INTERRUPT';

    = ioc$ending_status_wrong =
      text := 'ENDING STATUS WRONG';

    = ioc$slave_encoded_end_status =
      text := 'SLAVE ENCODED ENDING STATUS WRONG';

    = ioc$executing_controller_diag =
      text := 'EXECUTING CONTROLLER DIAGNOSTICS';

    = ioc$controller_diag_passed =
      text := 'CONTROLLER DIAGNOSTICS PASSED';

    = ioc$hdw_corrected_errors =
      text := 'ON THE FLY HARDWARE CORRECTIONS';

    = ioc$ipi_controller_failure =
      text := 'CONTROLLER FAILURE';

    = ioc$drive_failure =
      text := 'DRIVE FAILURE';

    = ioc$internal_controller_error =
      text := 'INTERNAL CONTROLLER ERROR';

    = ioc$controller_intervention_req =
      text := 'CONTROLLER INTERVENTION REQUIRED';

    = ioc$controller_mach_excep =
      text := 'CONTROLLER MACHINE EXCEPTION';

    = ioc$command_exception =
      text := 'COMMAND EXCEPTION';

    = ioc$microcode_execution_error =
      text := 'MICROCODE EXECUTION ERROR';

    = ioc$alternate_port_exception =
      text := 'ALTERNATE PORT EXCEPTION';

    = ioc$unexpected_response =
      text := 'UNEXPECTED RESPONSE';

    = ioc$drive_reserved =
      text := 'DRIVE RESERVED TO OTHER CONTROLLER PORT';

    = ioc$no_block_id_returned =
      text := 'NO BLOCK ID PARAMETER RETURNED';

    = ioc$unexpected_class_2 =
      text := 'UNEXPECTED CLASS 2 INTERRUPT';

    = ioc$drive_not_operational =
      text := 'DRIVE NOT OPERATIONAL';

    = ioc$drive_not_ready =
      text := 'DRIVE NOT READY';

    = ioc$drive_intervention_req =
      text := 'DRIVE INTERVENTION REQUIRED';

    = ioc$physical_interface_check =
      text := 'PHYSICAL INTERFACE CHECK';

    = ioc$operation_timeout =
      text := 'OPERATION TIMEOUT';

    = ioc$drive_machine_exception =
      text := 'DRIVE MACHINE EXCEPTION';

    = ioc$fatal_error =
      text := 'FATAL ERROR';

    = ioc$drive_conditional_success =
      text := 'DRIVE CONDITIONAL SUCCESS';

    = ioc$position_lost =
      text := 'POSITION LOST';

    = ioc$drive_res_to_other_cont =
      text := 'DRIVE RESERVED TO OTHER CONTROLLER';

    = ioc$no_end_of_extent =
      text := 'NO END OF EXTENT DETECTED';

    = ioc$data_length_difference =
      text := 'DATA LENGTH DIFFERENCE';

    = ioc$ipi_tape_medium_failure =
      text := 'TAPE MEDIUM FAILURE';

    = ioc$ipi_id_burst_error =
      text := 'UNABLE TO WRITE ID BURST';

    = ioc$ipi_unable_to_set_agc =
      text := 'UNABLE TO SET AGC';

    = ioc$master_slave_data_integrity =
      text := 'MASTER-SLAVE DATA INTEGRITY';

    = ioc$slave_fac_data_integrity =
      text := 'SLAVE-FACILITY DATA INTEGRITY';

    = ioc$pp_detect_software_failure,
      ioc$illegal_abnormal_status,
      ioc$interface_error_wo_eid,
      ioc$invalid_response_type,
      ioc$no_alert_cond_set,
      ioc$no_bits_in_abnormal_status =
      text := 'SOFTWARE FAILURE';


    ELSE

      text := 'UNKNOWN ERROR ID';

    CASEND;

  PROCEND iop$determine_error_text;

? IFEND
?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_initialize_unit ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$tape_initialize_unit (system_file_id: gft$system_file_identifier;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = FALSE,
      physical_unload = FALSE,
      repeat_count = 1;

    VAR
      logical_unit_number: iot$logical_unit;

    status.normal := TRUE;

    convert_sfid_to_lun (system_file_id, logical_unit_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_get_status,
          repeat_count, disable_unit, physical_unload, io_id, status);

  PROCEND iop$tape_initialize_unit;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_initialize_unit_scan ' ??
?? EJECT ??
? IF system_version THEN
  PROCEDURE [XDCL, #GATE] iop$tape_initialize_unit_scan (logical_unit_number: iot$logical_unit;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = FALSE,
      physical_unload = FALSE,
      repeat_count = 1;

    status.normal := TRUE;

    iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_get_status,
          repeat_count, disable_unit, physical_unload, io_id, status);

  PROCEND iop$tape_initialize_unit_scan;
? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_internal_request_stat ' ??
?? EJECT ??

? IF NOT system_version THEN
  PROCEDURE [XDCL] iop$tape_internal_request_stat (logical_unit: iot$logical_unit;
        io_id: iot$io_id;
        buf_release: boolean;
        bid_recovery: boolean;
        bid_update: boolean;
        wait: ost$wait;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);
? ELSE
  PROCEDURE [XDCL, #GATE] iop$tape_internal_request_stat (logical_unit: iot$logical_unit;
        io_id: iot$io_id;
        buf_release: boolean;
        bid_recovery: boolean;
        bid_update: boolean;
        wait: ost$wait;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);


  PROCEDURE internal_stat_cond_handler (
        condition: pmt$condition;
        p_condition_info: ^pmt$condition_information;
        p_stack: ^ost$stack_frame_save_area;
    VAR condition_status: ost$status);

    CASE condition.selector OF

    = pmc$block_exit_processing =

      IF NOT iov$tape_completion_q_table^ [j].req [k].check_task_id THEN
        iop$tape_enable_taskid_check (j, k);
      IFEND;

      p_ud^.task_terminated_during_recovery := TRUE;
      p_ud^.pending_pageable_requests [1] := NIL;
      p_ud^.tape_error_log_entry := FALSE;

    = pmc$user_defined_condition =
      IF condition.user_condition_name = osc$job_recovery_condition_name THEN
        job_recovery := TRUE;
        #SPOIL (job_recovery);
      IFEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);

    ELSE
      pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
    CASEND;

  PROCEND internal_stat_cond_handler;
? IFEND

    VAR
      current_heap: ^ost$heap,
      found: boolean,
      i: iot$no_of_tape_units,
      io_request_p: ^iot$io_request,
      j: iot$no_of_tape_units,
      job_recovery: boolean,
      k: 1 .. ioc$max_multiple_tape_requests,
      p_tape_request: ^iot$tape_request,
      p_ud: ^iot$tape_job_unit_descriptor,
      ready_task_triggered: boolean;

    BEGIN

      status.normal := TRUE;
      io_status.io_complete := FALSE;
      ready_task_triggered := FALSE;
      job_recovery := FALSE;
      iop$set_current_heap (current_heap);

{Find the Unit_index to the completion_q_table.

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF logical_unit = iov$p_statistic_data_p_array^ [i].logical_unit THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$internal_request_stat', status);
        RETURN;
      IFEND;

      p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;
      j := p_ud^.completion_q_index;
      #SPOIL (j, p_ud);

{Find the io_id for the correct completion_packet index and test for a waiting response.

      k := 1;
      WHILE k <= ioc$max_multiple_tape_requests DO
        #SPOIL (k);
        IF iov$tape_completion_q_table^ [j].req [k].io_id = io_id THEN

          WHILE TRUE DO
            IF iov$tape_completion_q_table^ [j].req [k].waiting_response THEN
              IF ready_task_triggered THEN
                osp$disestablish_cond_handler;
              IFEND;
              iop$tape_return_wired_request (j, k, p_tape_request, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

              iop$tape_status_check (bid_recovery, bid_update, p_tape_request, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

              io_status := p_tape_request^.io_status;

              IF buf_release THEN

{ Update the usage counters in the tape job unit descriptor.

                iop$tape_terminate_io (p_tape_request, bid_recovery, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                io_status.residual_block_count := p_tape_request^.io_status.residual_block_count;

                IF NOT p_tape_request^.must_free_pageable_request THEN
                  p_ud^.pageable_tape_requests [p_tape_request^.pageable_tape_request_index].
                        slot_in_use := FALSE;
                ELSE

{ Must Free the pageable tape request since the pageable_request_table in the unit
{ descriptor was full when the request was queued.  This can only happen if error
{ recovery is performed on an error recovery request (i.e. recursive error recovery).

                  FREE p_tape_request^.pp_response_p IN current_heap^;
                  FREE p_tape_request IN current_heap^;
                IFEND;
              IFEND;
              io_status.io_complete := TRUE;

              RETURN; {<---------

            ELSE {request not complete yet

? IF system_version THEN

              IF NOT ready_task_triggered THEN
                osp$establish_condition_handler (^internal_stat_cond_handler, TRUE);
                iop$tape_enable_ready_task (j, k);
                ready_task_triggered := TRUE;
              ELSE { If second or subsequent time thru loop, check task_id on completion
                IF NOT iov$tape_completion_q_table^ [j].req [k].check_task_id THEN
                  iop$tape_enable_taskid_check (j, k);
                IFEND;
              IFEND;

              IF NOT iov$tape_completion_q_table^ [j].req [k].waiting_response THEN
                IF wait = osc$nowait THEN
                  RETURN;
                IFEND;

                pmp$wait (20000, 750);

                IF job_recovery THEN
                  osp$disestablish_cond_handler;
                  osp$set_status_abnormal ('IO', ioe$tape_job_recovery, ' ', status);
                  RETURN;
                IFEND;
              IFEND;

? ELSE {For boot environment, to not use ready task mechanism

              pmp$delay (100, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
? IFEND
            IFEND;
          WHILEND;
        IFEND;
        k := k + 1;
      WHILEND;

{ Report system failure to job if an io_id cannot be found.  Each request will have the assigned
{ io_id placed in a tape_completion_q_packet entry at time request is posted.

      osp$set_status_abnormal ('io', ioc$os_failure,
            'unable to find io_id in iop$internal_request_stat', status);

    END
  PROCEND iop$tape_internal_request_stat;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_pp_error ' ??
?? EJECT ??

  PROCEDURE iop$tape_pp_error (p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

    status.normal := TRUE;


    p_tape_request^.io_status.io_complete := TRUE;
    p_tape_request^.io_status.normal_completion := FALSE;
    p_tape_request^.io_status.completion_code := ioc$system_software_failure;
    p_tape_request^.io_status.position_uncertain := TRUE;

  PROCEND iop$tape_pp_error;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_reposition_b ' ??
?? EJECT ??

  PROCEDURE iop$tape_reposition_b (p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

    CONST
      block_count = 1,
      buf_release = TRUE,
      disable_unit = FALSE,
      physical_unload = FALSE;

    VAR
      bid_offset: iot$bid_index,
      bid_realign_buf: iot$bid_window,
      bid_realign_buf_index: 1 .. ioc$bid_window_length + 1,
      bid_realign_buf_index_plus: 4 .. ioc$bid_window_length,
      bid_recovery: boolean,
      bid_update: boolean,
      bksp_adjust: 0 .. 3,
      bksp_count: 0 .. ioc$bid_window_length,
      bksp_reposition: 0 .. 3,
      count: 0 .. ioc$bid_window_length,
      historical_bid_window: iot$bid_window,
      historical_bid_index: iot$bid_index,
      io_id: iot$io_id,
      io_status: iot$tape_io_status,
      logical_unit_no: iot$logical_unit,
      retry_loop: boolean,
      temp_bid_index: iot$bid_index,
      temp_bid_index_historical: iot$bid_index,
      ud_p: ^iot$tape_job_unit_descriptor,
      unique: boolean,
      unrecoverable_retry: boolean;

    BEGIN

      status.normal := TRUE;

{     Obtain pointer to iot$tape_job_unit_descriptor.
{     Read the current block_id_window and block_id_index for the assigned tape unit.

      logical_unit_no := p_tape_request^.request.logical_unit;
      ud_p := p_tape_request^.ud;
      historical_bid_window := ud_p^.bid_window;
      historical_bid_index := ud_p^.bid_index;
      unique := FALSE;
      bid_realign_buf_index := LOWERVALUE(iot$bid_index);

{ Realign block_id's from the last good BID to the oldest BID in the window.
{ Remember, the index into the bid_window points to the last good block (last entry) plus 1.
{ This realignment simplifies investigation for uniqueness in BID window.

      IF historical_bid_index <> LOWERVALUE(historical_bid_index) THEN
        FOR bid_offset := (historical_bid_index - 1) DOWNTO LOWERVALUE(iot$bid_index) DO
          bid_realign_buf [bid_realign_buf_index] := historical_bid_window [bid_offset];
          bid_realign_buf_index := bid_realign_buf_index + 1;
        FOREND;
      IFEND;

      FOR bid_offset := UPPERVALUE(iot$bid_index) DOWNTO (historical_bid_index) DO
        bid_realign_buf [bid_realign_buf_index] := historical_bid_window [bid_offset];
        bid_realign_buf_index := bid_realign_buf_index + 1;
      FOREND;

    /bksp_calculation/
      BEGIN
? IF system_version THEN
        IF ud_p^.max_block_length < bav$max_bytes_per_tape_io THEN
? IFEND
          FOR bid_realign_buf_index := LOWERVALUE(iot$bid_index) to UPPERVALUE(iot$bid_index) DO
            IF (bid_realign_buf [bid_realign_buf_index] = ioc$loadpoint_bid) THEN
              bid_recovery := true;
              bid_update := true;
              iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_rewind, block_count,
                     disable_unit, physical_unload, io_id, status);
              IF NOT status.normal THEN
                RETURN;
              ELSE
                iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery,
                      bid_update, osc$wait, io_status, status);
                p_tape_request^.io_status := io_status;
                IF NOT p_tape_request^.io_status.normal_completion THEN
                  RETURN;
                IFEND;
              IFEND;
              IF  bid_realign_buf_index = 1 THEN;
                RETURN;
              IFEND;
              count := bid_realign_buf_index - 1;
              REPEAT
              IF bid_realign_buf [count] = ioc$error_block_bid THEN
                 bid_update := FALSE
              IFEND;
              count := count - 1;
              iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_forspace, block_count,
                     disable_unit, physical_unload, io_id, status);
              IF status.normal THEN
                iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery,
                      bid_update, osc$wait, io_status, status);
                bid_update := TRUE;
                p_tape_request^.io_status := io_status;
                IF NOT (p_tape_request^.io_status.normal_completion) AND NOT (p_tape_request^.io_status.
                      completion_code = ioc$tapemark_read) THEN
                  RETURN;
                IFEND;
              ELSE
                RETURN;
              IFEND;
            UNTIL count = 0;
            IF historical_bid_index <> ud_p^.bid_index THEN
              p_tape_request^.io_status.normal_completion := FALSE;
              p_tape_request^.io_status.position_uncertain := TRUE;
              p_tape_request^.io_status.completion_code := ioc$indeterminate;
            ELSE
              FOR bid_offset := LOWERBOUND(historical_bid_window) TO historical_bid_index - 1 DO
                IF (historical_bid_window [bid_offset] <> ud_p^.bid_window [bid_offset]) AND
                   NOT (historical_bid_window [bid_offset] = ioc$error_block_bid) THEN
                  p_tape_request^.io_status.normal_completion := FALSE;
                  p_tape_request^.io_status.position_uncertain := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$indeterminate;
                  RETURN;
                IFEND;
              FOREND;
            IFEND;
            RETURN;
           IFEND;
          FOREND;
? IF system_version THEN
        IFEND;
? IFEND

        FOR bid_realign_buf_index := 1 TO ioc$min_bksp_count - 1 DO
          IF (bid_realign_buf [bid_realign_buf_index] = ioc$tapemark_bid) THEN
            bksp_count := bid_realign_buf_index;
            unique := TRUE;
            EXIT /bksp_calculation/
          IFEND;
        FOREND;

        FOR bid_realign_buf_index := 1 TO ioc$min_bksp_count - 1 DO
          IF (bid_realign_buf [bid_realign_buf_index] = ioc$unavail_bid) THEN
            EXIT /bksp_calculation/
          IFEND;
        FOREND;

        bksp_count := ioc$min_bksp_count - 1;

        FOR bid_realign_buf_index := ioc$min_bksp_count  TO ioc$bid_window_length DO
          bid_realign_buf_index_plus := bid_realign_buf_index + 1;
          bksp_count := bksp_count + 1;
          IF (bid_realign_buf [bid_realign_buf_index_plus] = ioc$unavail_bid) THEN
            EXIT /bksp_calculation/
          ELSEIF bid_realign_buf [bid_realign_buf_index] <> bid_realign_buf [bid_realign_buf_index_plus] THEN
            unique := TRUE;
            EXIT /bksp_calculation/
          IFEND;
        FOREND;

      END /bksp_calculation/;

      IF NOT unique THEN
        bksp_count := 1;
      IFEND;

      bid_recovery := TRUE;
      bid_update := FALSE;

{ Backspace over bad record.

      iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_backspace, block_count,
               disable_unit, physical_unload, io_id, status);
      IF status.normal THEN
        iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery, bid_update,
             osc$wait, io_status, status);
        p_tape_request^.io_status := io_status;
        IF NOT (p_tape_request^.io_status.normal_completion) AND NOT (p_tape_request^.io_status.
              completion_code = ioc$tapemark_read) THEN
          RETURN;
        IFEND;
      ELSE
        RETURN;
      IFEND;

      count := bksp_count;
      bid_update := TRUE;
      retry_loop := TRUE;
      unrecoverable_retry := TRUE;

{ Start of reposition to Last Good Block (Backspace/Forspace the uniquely determined count).

    /unrecoverable_retry_loop/
      WHILE retry_loop DO

        REPEAT
          count := count - 1;
          iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_backspace, block_count,
                 disable_unit, physical_unload, io_id, status);
          IF status.normal THEN
            iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery,
                  bid_update, osc$wait, io_status, status);
            p_tape_request^.io_status := io_status;
            IF NOT (p_tape_request^.io_status.normal_completion) AND NOT (p_tape_request^.io_status.
                  completion_code = ioc$tapemark_read) THEN
              RETURN;
            IFEND;
          ELSE
            RETURN;
          IFEND;
        UNTIL count = 0;

        bksp_reposition := 0;
        count := bksp_count;
        REPEAT
          IF bid_realign_buf [count] = ioc$error_block_bid THEN
            bid_update := FALSE;
          IFEND;
          count := count - 1;
          iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_forspace, block_count,
                 disable_unit, physical_unload, io_id, status);
          IF status.normal THEN
            iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery,
                  bid_update, osc$wait, io_status, status);
            bid_update := TRUE;
            p_tape_request^.io_status := io_status;
            IF NOT (p_tape_request^.io_status.normal_completion) AND NOT (p_tape_request^.io_status.
                  completion_code = ioc$tapemark_read) THEN
              RETURN;
            IFEND;
          ELSE
            RETURN;
          IFEND;

{ Investigate if this is the 1st forspace in the repositioning attempt.  It is assumed the 1st
{ forspace will be over good data and we will not run into a fragmented record. The variable
{ bksp_reposition will be non-zero if we already tried repositioning on the very 1st forspace.

        IF ((count = bksp_count - 1) AND (bksp_reposition = 0)) THEN

{ Set bid_offset index to point to the block_id that was just obtained with the forspace which is
{ the present window index - 1.  Also adjust for the circular aspects of the bid_window and index.

          IF (ud_p^.bid_index = 1) THEN
            bid_offset := ioc$bid_window_length;
          ELSE
            bid_offset := ud_p^.bid_index - 1;
          IFEND;

{ The block_id's of the current and historical window should be the same at this index.

          IF (ud_p^.bid_window [bid_offset] <> historical_bid_window [bid_offset]) THEN

{ Investigate where the current_window block_id is in the historical_window.
{ If the current bid is found at index + 1 in historical, this means we backspaced one record
{ less than physically expected.
{ Must assure that we observe the circular window limits for looking at the historical window.

            IF (bid_offset = ioc$bid_window_length) THEN
              temp_bid_index := 1;
            ELSE
              temp_bid_index := bid_offset + 1;
            IFEND;
            bksp_adjust := 0;

{ Check for tape having 1 less backspace than expected.

            IF (ud_p^.bid_window [bid_offset] = historical_bid_window [temp_bid_index]) THEN
              bksp_adjust := 2;
              count := bksp_count;
            IFEND;

{ Look ahead 2 records.

            IF (temp_bid_index = ioc$bid_window_length) THEN
              temp_bid_index := 1;
            ELSE
              temp_bid_index := temp_bid_index + 1;
            IFEND;

{ Check for tape having 2 less backspaces than expected.

            IF (ud_p^.bid_window [bid_offset] = historical_bid_window [temp_bid_index]) THEN
              bksp_adjust := 3;
              count := bksp_count;
            IFEND;

{ Issue the determined number of backspaces if bksp_adjust is non-zero.

            FOR bksp_reposition := 1 to bksp_adjust DO
              iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_backspace, block_count,
                     disable_unit, physical_unload, io_id, status);
              IF status.normal THEN
                iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery,
                      bid_update, osc$wait, io_status, status);
                bid_update := FALSE;
                p_tape_request^.io_status := io_status;
                IF NOT (p_tape_request^.io_status.normal_completion) AND NOT (p_tape_request^.io_status.
                      completion_code = ioc$tapemark_read) THEN
                  RETURN;
                IFEND;
              ELSE
                RETURN;
              IFEND;
            FOREND;

{ The index in the current window should now be correct and equal the historical bid window index and
{ updating of the block_id index and window must be initiated again.

            bid_update := TRUE;
          IFEND;
        IFEND;
        UNTIL count = 0;

{ Verify that Current and Historical bid_indexes into the bid_windows are equal.

        IF historical_bid_index <> ud_p^.bid_index THEN
          p_tape_request^.io_status.normal_completion := FALSE;
          p_tape_request^.io_status.position_uncertain := TRUE;
          p_tape_request^.io_status.completion_code := ioc$indeterminate;
        ELSE

{ Verify that the elemets/bid's in the Current/Historical Block_id Windows are equal.

        /bid_verify/
          FOR bid_offset := LOWERBOUND(historical_bid_window) TO UPPERBOUND(historical_bid_window) DO
            IF (historical_bid_window [bid_offset] <> ud_p^.bid_window [bid_offset]) AND
               NOT (historical_bid_window [bid_offset] = ioc$error_block_bid) THEN

{ Investigate if current bid_window may be mispositioned due to the hardware not backspacing correctly.
{ We are talking here about the tape having backspaced 1 more record than was physically expected.
{ This mispositioning could also occur if the block in error is not recognized as a legitimate block
{ when attempting to backspace over that bad block.  We are at an unrecoverable position at this
{ point in time, and we may be able to recognize a physical positioning error and correct the situation.

              IF unrecoverable_retry THEN
                count := bksp_count;
                unrecoverable_retry := FALSE;

{ Note that the current and historical bid indexes are identical or we would not try repositioning.
{ If the current window shows the tape position as off 1 block, then tape is moved to correct
{ current window and the original index to the current window is restored.

{ A BID Index always points to next entry in BID Window.
{ Set temp_bid_index to point to actual Last_Good_Block (LGB) in current window (current index - 1).
{ Must allow for wrap_around of circular bid window/index that increments circular from 1 to 32 decimal.

                IF historical_bid_index = LOWERVALUE(iot$bid_index) THEN
                  temp_bid_index := UPPERVALUE(iot$bid_index);
                ELSE
                  temp_bid_index := historical_bid_index  - 1;
                IFEND;

{ Set temp_bid_index_historical as the index used to look at BID entries in the Historical Window.
{ Look at  LGB minus one in the Historical Window.

                IF temp_bid_index = LOWERVALUE(iot$bid_index) THEN
                  temp_bid_index_historical := UPPERVALUE(iot$bid_index);
                ELSE
                  temp_bid_index_historical := temp_bid_index - 1;
                IFEND;

{ Investigate if LGB in Current Window = LGB - 1 in Historical Window.
{ If BID's are identical, forspace tape 1 block, restore current index, and loop to reposition algorithm.

                IF ud_p^.bid_window [temp_bid_index] = historical_bid_window [temp_bid_index_historical] THEN
                  IF historical_bid_window [temp_bid_index] = ioc$error_block_bid THEN
                    bid_update := FALSE;
                  IFEND;

{ Must decrement index into current window so we don't destroy oldest BID in current window with the forspace
{  that is issued to correct 1 block mispositioning by the hardware.

                  ud_p^.bid_index := temp_bid_index;
                  iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_forspace, block_count,
                         disable_unit, physical_unload, io_id, status);
                  IF status.normal THEN
                    iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery,
                          bid_update, osc$wait, io_status, status);
                    bid_update := TRUE;
                    p_tape_request^.io_status := io_status;
                    IF NOT p_tape_request^.io_status.normal_completion AND NOT (p_tape_request^.io_status.
                          completion_code = ioc$tapemark_read) THEN
                      RETURN;
                    IFEND;
                  ELSE
                    RETURN;
                  IFEND;

                  ud_p^.bid_index := historical_bid_index;
                  CYCLE /unrecoverable_retry_loop/;
                IFEND;
              IFEND;
              p_tape_request^.io_status.normal_completion := FALSE;
              p_tape_request^.io_status.position_uncertain := TRUE;
              p_tape_request^.io_status.completion_code := ioc$indeterminate;
              EXIT /bid_verify/
            IFEND;
          FOREND /bid_verify/;
        IFEND;

        retry_loop := FALSE;
      WHILEND /unrecoverable_retry_loop/;


    END
  PROCEND iop$tape_reposition_b;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_reposition_f ' ??
?? EJECT ??

  PROCEDURE iop$tape_reposition_f (VAR p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

    CONST
      bid_recovery = FALSE,
      bid_update = TRUE,
      block_count = 1,
      buf_release = TRUE,
      disable_unit = FALSE,
      physical_unload = FALSE;

    VAR
      io_id: iot$io_id,
      io_status: iot$tape_io_status,
      logical_unit_no: iot$logical_unit;

    status.normal := TRUE;
    logical_unit_no := p_tape_request^.request.logical_unit;
    iop$67x_non_data_trans_setup (logical_unit_no, ioc$tape_forspace, block_count,
           disable_unit, physical_unload, io_id, status);
    IF status.normal THEN
      iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery, bid_update,
            osc$wait, io_status, status);
      p_tape_request^.io_status := io_status;
    IFEND;

  PROCEND iop$tape_reposition_f;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_request_status ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$tape_request_status (file_id: gft$system_file_identifier;
        io_id: iot$io_id;
        wait_for_completion: boolean;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);


? IF system_version THEN
  PROCEDURE request_status_cond_handler (
        condition: pmt$condition;
        p_condition_info: ^pmt$condition_information;
        p_stack: ^ost$stack_frame_save_area;
    VAR condition_status: ost$status);

    CASE condition.selector OF

    = pmc$block_exit_processing =

      IF NOT iov$tape_completion_q_table^ [j].req [k].check_task_id THEN
        iop$tape_enable_taskid_check (j, k);
      IFEND;

    = pmc$user_defined_condition =
      IF condition.user_condition_name = osc$job_recovery_condition_name THEN
        job_recovery := TRUE;
        #SPOIL (job_recovery);
      IFEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);

    ELSE
      pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
    CASEND;

  PROCEND request_status_cond_handler;
? IFEND

    CONST
      bid_recovery = FALSE,
      bid_update = TRUE;

    VAR
      found: boolean,
      h: 1 .. ioc$max_multiple_tape_requests,
      i: iot$no_of_tape_units,
      io_request_p: ^iot$io_request,
      j: iot$no_of_tape_units,
      job_recovery: boolean,
      k: 1 .. ioc$max_multiple_tape_requests,
      local_status: ost$status,
      logical_unit: iot$logical_unit,
      p_tape_request: ^iot$tape_request,
      p_ud: ^iot$tape_job_unit_descriptor,
      q: 1 .. ioc$max_multiple_tape_requests,
      ready_task_triggered: boolean,
      store_unit_ready_attempt: integer,
      tusl_entry_access: iot$tusl_entry_access,
      unload_request: boolean,
      update_tusl_entry: boolean;

    BEGIN
      status.normal := TRUE;
      io_status.io_complete := FALSE;
      ready_task_triggered := FALSE;
      job_recovery := FALSE;


{     Get unit number using file name.

      convert_sfid_to_lun (file_id, logical_unit, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{Find the Unit_index to the completion_q_table.

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF logical_unit = iov$p_statistic_data_p_array^ [i]. logical_unit THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$tape_request_status', status);
        RETURN;
      IFEND;

      p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;
      j := p_ud^.completion_q_index; {This index is also the correct index into the tusl structure.
      #SPOIL (j);

{ Find the io_id for the correct completion_packet index and test for a waiting response.

      FOR k := 1 TO ioc$max_multiple_tape_requests DO
        IF iov$tape_completion_q_table^ [j].req [k].io_id = io_id THEN

          WHILE TRUE DO
            IF iov$tape_completion_q_table^ [j].req [k].waiting_response THEN
              IF ready_task_triggered THEN
                osp$disestablish_cond_handler;
              IFEND;
              IF iov$tape_completion_q_table^ [j].req [k].request_not_processed THEN
                 io_status.completion_code := ioc$request_not_processed;
                 io_status.normal_completion := FALSE;
                 iop$tape_request_not_processed(0, j, k, status);
                 io_status.io_complete := TRUE;
                 RETURN; {<---------
              IFEND;
              iop$tape_return_wired_request (j, k, p_tape_request, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

              iop$tape_status_check (bid_recovery, bid_update, p_tape_request, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

{ Investigate if any pending_requests to be queued.

              IF p_ud^.pending_pageable_requests [1] <> NIL THEN

{ Check if Fatal Error or 'EOT on write'.
{ Note: When EOT is encountered on a write, normal_completion is set to TRUE.  The
{ block_manager uses the io_status.end_of_tape flag to determine when EOT occurred.
{ Also note that multiple requests are only on Writes and Reads at this time.

                IF p_tape_request^.io_status.normal_completion = FALSE OR
                   ((p_tape_request^.io_status.end_of_tape) AND
                    (p_tape_request^.request_type = ioc$tape_write)) THEN

{Return pending pageable requests.
                /loop_1/
                  FOR h := 1 TO ioc$max_multiple_tape_requests DO
                    IF p_ud^.pending_pageable_requests [h] = NIL THEN
                      EXIT /loop_1/
                    IFEND;
                  /loop_2/
                    FOR q := 1 TO ioc$max_multiple_tape_requests DO
                      IF iov$tape_completion_q_table^ [j].req [q].io_id = 0 THEN
                        iop$tape_request_not_processed(p_ud^.pending_pageable_requests [h]^.io_id,j,q,status);
                        EXIT /loop_2/
                      IFEND;
                    FOREND /loop_2/;
                    IF NOT p_ud^.pending_pageable_requests [h]^.must_free_pageable_request THEN
                      p_ud^.pageable_tape_requests [p_ud^.pending_pageable_requests [h]^.
                            pageable_tape_request_index].slot_in_use := FALSE;
                    ELSE  { this should never occur for user initiated requests
                      osp$system_error ('Internal error 1 - iop$tape_request_status', ^status);
                    IFEND;
                    p_ud^.pending_pageable_requests [h] := NIL;
                  FOREND /loop_1/;
                ELSE

{Recovered error - requeue pending_pageable_requests.

                /loop_3/
                  FOR h := 1 TO ioc$max_multiple_tape_requests DO
                    IF p_ud^.pending_pageable_requests [h] = NIL THEN
                      EXIT /loop_3/
                    IFEND;

{ If requeueing more than 1 request, allow the second and subsequent requests
{ to be queued even if unit is disabled.

                    IF h > 1 THEN
                      p_ud^.pending_pageable_requests [h]^.recovery_requeue := TRUE;
                    IFEND;

                    iop$tape_queue_request_setup (p_ud^.pending_pageable_requests [h], status);
                    p_ud^.pending_pageable_requests [h]^.recovery_requeue := FALSE;
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;
                    p_ud^.pending_pageable_requests [h] := NIL;
                  FOREND /loop_3/;
                IFEND;
              IFEND;

{ Update the usage counters in the tape job unit descriptor.
{ If the request is an unload, the io_status from the pageable request must
{ be saved first since the pageable request is FREE'ed in iop$tape_terminate_io.

              unload_request := FALSE;
              IF p_tape_request^.request_type = ioc$tape_unload THEN
                io_status := p_tape_request^.io_status;
                unload_request := TRUE;
              IFEND;

              iop$tape_terminate_io (p_tape_request, bid_recovery, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

              IF NOT unload_request THEN
                io_status := p_tape_request^.io_status;
                IF NOT p_tape_request^.must_free_pageable_request THEN
                  p_ud^.pageable_tape_requests [p_tape_request^.pageable_tape_request_index].
                        slot_in_use := FALSE;
                ELSE  { this should never occur for user initiated requests
                  osp$system_error ('Internal error 2 - iop$tape_request_status', ^status);
                IFEND;
              IFEND;

              io_status.io_complete := TRUE;

? IF system_version THEN
{ Update the tusl entry for correct ready status on an assigned unit.
{ This update, of course, requires the functioning of the tape unit by the user.

              tusl_entry_access.operation := ioc$store_unit_ready;
              update_tusl_entry := FALSE;
              IF unload_request OR
                    ((NOT io_status.normal_completion) AND (io_status.completion_code <> ioc$tapemark_read)
                    AND (NOT io_status.long_input_block)) THEN
                IF unload_request THEN
                  tusl_entry_access.store_unit_ready := FALSE;
                ELSE
                  tusl_entry_access.store_unit_ready := io_status.unit_ready;
                IFEND;
                update_tusl_entry := TRUE;
              ELSEIF NOT iov$tusl_p^[j].unit_ready THEN
                tusl_entry_access.store_unit_ready := io_status.unit_ready;
                update_tusl_entry := TRUE;
              IFEND;

              IF update_tusl_entry AND (tusl_entry_access.store_unit_ready <> iov$tusl_p^[j].unit_ready) THEN
              /store_unit_ready_in_tusl/
                FOR store_unit_ready_attempt := 1 TO max_store_unit_ready_attempts DO
                  iop$access_tusl_entry (j, tusl_entry_access, local_status);
                  IF NOT local_status.normal AND (local_status.condition = dme$unable_to_lock_tape_table) THEN
                    pmp$wait (one_second, one_second);
                    CYCLE /store_unit_ready_in_tusl/;
                  ELSE
                    EXIT /store_unit_ready_in_tusl/;
                  IFEND;
                FOREND /store_unit_ready_in_tusl/;
              IFEND;
? IFEND
              RETURN; {<---------

            ELSE {request not complete yet

              IF NOT wait_for_completion THEN
                RETURN; {<---------
              ELSE

? IF system_version THEN

                IF NOT ready_task_triggered THEN
                  osp$establish_condition_handler (^request_status_cond_handler, TRUE);
                  iop$tape_enable_ready_task (j, k);
                  ready_task_triggered := TRUE;
                ELSE { If second or subsequent time thru loop, check task_id on completion
                  IF NOT iov$tape_completion_q_table^ [j].req [k].check_task_id THEN
                    iop$tape_enable_taskid_check (j, k);
                  IFEND;
                IFEND;

                IF NOT iov$tape_completion_q_table^ [j].req [k].waiting_response THEN

                  pmp$wait (20000, 750);

                  IF job_recovery THEN
                    osp$disestablish_cond_handler;
                    osp$set_status_abnormal ('IO', ioe$tape_job_recovery, ' ', status);
                    RETURN;
                  IFEND;
                IFEND;

? ELSE {For boot environment, to not use ready task mechanism

                pmp$delay (100, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
? IFEND
              IFEND;
            IFEND;
          WHILEND;
        IFEND;
      FOREND;

{ Report system failure to job if an io_id cannot be found.  Each request will have the assigned
{ io_id placed in a tape_completion_q_packet entry at time request is posted.
{ If the task was terminated during error recovery, return a unique error status, since
{ in this case not finding the io_id can be expected.

      IF NOT p_ud^.task_terminated_during_recovery THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find io_id in iop$tape_request_status', status);
      ELSE
        osp$set_status_abnormal ('IO', ioe$task_terminated_during_rec, ' ', status);
      IFEND;

    END
  PROCEND iop$tape_request_status;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_retry_io ' ??
?? EJECT ??

  PROCEDURE iop$tape_retry_io (p_tape_request: ^iot$tape_request;
    bid_recovery: boolean;
    bid_update: boolean;
    VAR status: ost$status);

    CONST
      buf_release = FALSE;

    VAR
      commands_executed: iot$tape_request_length,
      data_transfer_commands_executed: iot$tape_request_length,
      i: iot$tape_request_length,
      io_id: iot$io_id,
      io_status: iot$tape_io_status,
      j: iot$tape_request_length,
      logical_unit_no: iot$logical_unit;

    status.normal := TRUE;

    commands_executed := (p_tape_request^.last_command_processed - ioc$min_request_length) DIV 8 + 1;
    IF commands_executed > 0 THEN
      CASE p_tape_request^.request_type OF
      = ioc$tape_read =
        data_transfer_commands_executed := (commands_executed - ioc$67x_cmd_pos_read +1) DIV
              ioc$read_cmd_per_block;
        IF ((commands_executed - ioc$67x_cmd_pos_read) MOD ioc$read_cmd_per_block) = 0 THEN
{Error on store transfer count.}
          p_tape_request^.io_status.io_complete := TRUE;
          p_tape_request^.io_status.normal_completion := FALSE;
          p_tape_request^.io_status.completion_code := ioc$system_software_failure;
          RETURN;
        IFEND;
        p_tape_request^.no_of_data_commands := p_tape_request^.no_of_data_commands -
              data_transfer_commands_executed;
        FOR i := 1 TO p_tape_request^.no_of_data_commands DO
          p_tape_request^.read_block_description^ [i] := p_tape_request^.read_block_description^
                [data_transfer_commands_executed + i];
        FOREND;
        j := (data_transfer_commands_executed) * ioc$read_cmd_per_block + ioc$67x_cmd_pos_read - 1;
        FOR i := 1 TO p_tape_request^.no_of_data_commands * ioc$read_cmd_per_block DO
          p_tape_request^.request.tape_command [ioc$67x_cmd_pos_read - 1 + i] := p_tape_request^.request.
                tape_command [j + i];
        FOREND;
        p_tape_request^.request.request_length := p_tape_request^.no_of_data_commands * ioc$read_cmd_per_block
              * 8 + iov$67x_command_table [p_tape_request^.request_type].length;
      = ioc$tape_write =
        data_transfer_commands_executed := (commands_executed - ioc$67x_cmd_pos_write) DIV
              ioc$write_cmd_per_block;
        p_tape_request^.no_of_data_commands := p_tape_request^.no_of_data_commands -
              data_transfer_commands_executed;
        FOR i := 1 TO p_tape_request^.no_of_data_commands DO
          p_tape_request^.write_block_description^ [i] := p_tape_request^.write_block_description^
                [data_transfer_commands_executed + i];
        FOREND;
        j := (data_transfer_commands_executed) * ioc$write_cmd_per_block + ioc$67x_cmd_pos_write - 1;
        FOR i := 1 TO p_tape_request^.no_of_data_commands * ioc$write_cmd_per_block DO
          p_tape_request^.request.tape_command [ioc$67x_cmd_pos_write - 1 + i] := p_tape_request^.request.
                tape_command [j + i];
        FOREND;
        p_tape_request^.request.request_length := p_tape_request^.no_of_data_commands *
              ioc$write_cmd_per_block * 8 + iov$67x_command_table [p_tape_request^.request_type].length;

      = ioc$tape_forspace, ioc$tape_backspace, ioc$tape_write_tapemark =
        p_tape_request^.no_of_non_data_commands := p_tape_request^.no_of_non_data_commands -
              commands_executed +1;
        p_tape_request^.request.request_length := (p_tape_request^.no_of_non_data_commands - 1) * 8 +
              iov$67x_command_table [p_tape_request^.request_type].length;
      ELSE
        p_tape_request^.io_status.io_complete := TRUE;
        p_tape_request^.io_status.normal_completion := FALSE;
        p_tape_request^.io_status.completion_code := ioc$system_software_failure;
        RETURN;
      CASEND;
    IFEND;
    iop$tape_queue_request_setup (p_tape_request, status);
    IF status.normal THEN
      io_id := p_tape_request^.io_id;
      logical_unit_no := p_tape_request^.request.logical_unit;
        iop$tape_internal_request_stat (logical_unit_no, io_id, buf_release, bid_recovery, bid_update,
              osc$wait, io_status, status);
      p_tape_request^.io_status := io_status;
    IFEND;

  PROCEND iop$tape_retry_io;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_status_check ' ??
?? EJECT ??

  PROCEDURE iop$tape_status_check (bid_recovery: boolean;
        bid_update: boolean;
    VAR p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

    CONST
      disable_unit = FALSE,
      physical_unload = FALSE,
      repeat_count = 1;

    VAR
      block_id_status_area: iot$tape_bid_status_response,
      commands_executed: iot$tape_request_length,
      data_transfers: iot$tape_request_length,
      device_status: iot$tape_device_status,
      erasures: 1 .. ioc$tape_max_tape_parity_retry,
      i: integer,
      inhibit_recovery_occurred: boolean,
      ipi_tape_status: iot$ipi_tape_status,
      logical_unit: iot$logical_unit,
      p_ud: ^iot$tape_job_unit_descriptor,
      pp_response: iot$pp_response,
      previous_last_good_bid: iot$cartridge_tape_bid,
      rio_id: iot$io_id,
      rio_status: iot$tape_io_status,
      rstatus: ost$status,
      status_word_3: boolean,
      tape_failure_type: iot$tape_failure_type,
      update_count: 0 .. 0ffff(16);
??EJECT??
{ The following procedure was created because there are numerous places in iop$tape_status_check
{ that require that the block id window be updated after a backspace, forespace, and special cases
{ such as a read if and AGC error code is received for device status on an abnormal response.

      PROCEDURE iop$update_bid_window;

        IF p_tape_request^.request_type = ioc$tape_backspace THEN
          IF p_ud^.bid_index <> LOWERVALUE(iot$bid_index) THEN
            p_ud^.bid_index := p_ud^.bid_index - 1;
          ELSE
            p_ud^.bid_index := UPPERVALUE(iot$bid_index);
          IFEND;
          p_ud^.bid_window [p_ud^.bid_index] := ioc$unavail_bid;
        ELSE
          p_ud^.bid_window [p_ud^.bid_index] := ioc$error_block_bid;
          IF p_ud^.bid_index <> UPPERVALUE(iot$bid_index) THEN
            p_ud^.bid_index := p_ud^.bid_index + 1;
          ELSE
            p_ud^.bid_index := LOWERVALUE(iot$bid_index);
          IFEND;
        IFEND;

      PROCEND iop$update_bid_window;
?? EJECT ??
    BEGIN
      status.normal := TRUE;


      data_transfers := 0;
      logical_unit:= p_tape_request^.request.logical_unit;

{     Get the pointer to the unit descriptor entry for this logical unit.

      p_ud := p_tape_request^.ud;

{     The BLOCK_ID_STATUS_AREA is part of the response returned by the PP and consists of 8 CM words.
{     The 8 CM words are defined as an ARRAY [1 .. 32] OF 0 .. 0ffff(16).
{     The first 30 elements of the array are the possible Block_Id area elements.
{     The 31st element is the Single/Double Track Hardware Correction Count for the last Request.
{     The 32nd element is the count of legitimate Block_Id's in 30 element Block_id area.
{     The Correction Count and the update_count were not defined separately for performance reasons.

      IF p_ud^.controller_type <> cmc$mt5680_xx THEN
        IF p_ud^.controller_type = cmc$mt5698_xx THEN
          p_ud^.single_double_track_corrections := p_ud^.single_double_track_corrections +
                p_tape_request^.pp_response_p^.ipi_block_id_status_area[31];
          update_count := p_tape_request^.pp_response_p^.ipi_block_id_status_area[32];
          block_id_status_area := p_tape_request^.pp_response_p^.ipi_block_id_status_area;
        ELSE { ats, ismt, or 698
          p_ud^.single_double_track_corrections := p_ud^.single_double_track_corrections +
                p_tape_request^.pp_response_p^.block_id_status_area[31];
          update_count := p_tape_request^.pp_response_p^.block_id_status_area[32];
          block_id_status_area := p_tape_request^.pp_response_p^.block_id_status_area;
        IFEND;
      ELSE

      IFEND;

{ Fetch pp_response and device_status for investigation and status updates.
{ If controller type = IPI, set fields in device_status from ipi_tape_status.
{ IF controller type = CTS/CCC, set fields in device_status from ccc_cart_device_status.
{ Device_status is used for the normal completion case.

      pp_response := p_tape_request^.pp_response_p^.pp_response;

      IF (p_ud^.controller_type <> cmc$mt5698_xx) AND (p_ud^.controller_type <> cmc$mt5680_xx) THEN
        device_status := p_tape_request^.pp_response_p^.device_status;

{ Update the tape_job_unit_descriptor with the last density at which the tape unit was operating.

        p_ud^.tape_unit_density := device_status.density;

      ELSEIF p_ud^.controller_type = cmc$mt5698_xx THEN

        ipi_tape_status := p_tape_request^.pp_response_p^.ipi_tape_status;
        device_status.write_ring := NOT ipi_tape_status.special_status.write_protect;
        IF p_tape_request^.request_type = ioc$tape_write THEN
          device_status.end_of_tape := FALSE;  { Assume False on normal write completion }
        ELSE
          device_status.end_of_tape := ipi_tape_status.special_status.end_of_media;
        IFEND;
        device_status.beginning_of_tape := ipi_tape_status.special_status.beginning_of_media;
        device_status.unit_ready := ipi_tape_status.special_status.media_present;
        device_status.unit_busy := FALSE;  { Assume False on normal completion }
        IF ipi_tape_status.special_status.density THEN  { 6250
          p_ud^.tape_unit_density := 3;
        ELSE { 1600
          p_ud^.tape_unit_density := 1;
        IFEND;

      ELSE { cmc$mt5680_xx

        device_status.write_ring := p_tape_request^.pp_response_p^.ccc_cart_device_status.write_enabled;
        IF p_tape_request^.request_type = ioc$tape_write THEN
          device_status.end_of_tape := FALSE;  { Assume False on normal write completion }
        ELSE
          device_status.end_of_tape := p_tape_request^.pp_response_p^.ccc_cart_device_status.end_of_tape;
        IFEND;
        device_status.beginning_of_tape := p_tape_request^.pp_response_p^.ccc_cart_device_status.
              beginning_of_tape;
        device_status.unit_ready := p_tape_request^.pp_response_p^.ccc_cart_device_status.ready;
        device_status.unit_busy := p_tape_request^.pp_response_p^.ccc_cart_device_status.busy;
        p_ud^.tape_unit_density := 4;

      IFEND;


      CASE pp_response.response_code.primary_response OF
        = ioc$unsolicited_response =
          { This should have already been handled and never get here. }
          iop$tape_pp_error (p_tape_request, status);
          RETURN;

        = ioc$intermediate_response =
          { Error since this is not used by the tape handler. }
          iop$tape_pp_error (p_tape_request, status);
          RETURN;

        = ioc$normal_response =

          commands_executed := (p_tape_request^.last_command_processed - ioc$min_request_length) DIV 8 + 1;

{ Update the Block_id current window located in tape job unit descriptor.
{ Presently update on count from PP for all write, read, forspace, and write_tapemark functions.

          IF ((p_tape_request^.request_type = ioc$tape_write) OR
                (p_tape_request^.request_type = ioc$tape_read) OR
                (p_tape_request^.request_type = ioc$tape_write_tapemark) OR
                (p_tape_request^.request_type = ioc$tape_forspace)) AND
                (p_ud^.controller_type <> cmc$mt5680_xx) THEN
            IF update_count > 0 THEN
              FOR i := 1 to update_count DO
                p_ud^.bid_window [p_ud^.bid_index] := block_id_status_area [i];
                IF p_ud^.bid_index = UPPERVALUE(iot$bid_index) THEN
                  p_ud^.bid_index := LOWERVALUE(iot$bid_index);
                ELSE
                  p_ud^.bid_index := p_ud^.bid_index + 1;
                IFEND;
              FOREND;
            IFEND;

          ELSEIF p_ud^.controller_type = cmc$mt5680_xx THEN

            previous_last_good_bid := p_ud^.cartridge_tape_last_good_bid;
            IF (p_tape_request^.request_type = ioc$locate_block) AND (p_ud^.cartridge_tape_last_good_bid.
                  logical_position <> p_tape_request^.pp_response_p^.ccc_cart_device_status.last_good_bid.
                  logical_position) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_invalid_bid;
              p_tape_request^.io_status.normal_completion := FALSE;
              p_tape_request^.io_status.completion_code := ioc$controller_failure;
              p_tape_request^.io_status.position_uncertain := TRUE;
              iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
              RETURN;
            IFEND;

{ Do not update the last_good_bid if a forespace is being done with bid_update = FALSE.  This is
{ done to reposition tape after a fatal parity error in buffered mode.  We cannot update the
{ block_id since we need it for potential global error recovery if error recovery is enabled.

            IF NOT ((p_tape_request^.request_type = ioc$tape_forspace) AND (NOT bid_update)) THEN
              p_ud^.cartridge_tape_last_good_bid := p_tape_request^.pp_response_p^.
                    ccc_cart_device_status.last_good_bid;
              IF p_tape_request^.request_type <> ioc$locate_block THEN
                IF (p_tape_request^.request_type = ioc$tape_backspace) AND
                      (p_ud^.error_block_forespace_count > 0) THEN
                  IF commands_executed < p_ud^.error_block_forespace_count THEN
                    p_ud^.cartridge_tape_last_good_bid := previous_last_good_bid;
                    p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count -
                          commands_executed;
                  ELSE
                    p_ud^.error_block_forespace_count := 0;
                  IFEND;
                ELSE
                  p_ud^.error_block_forespace_count := 0;
                IFEND;
              IFEND;
            IFEND;

          IFEND;

{         Update the tape request for the number of blocks_accessed.

          IF commands_executed > 0 THEN
            CASE p_tape_request^.request_type OF

            = ioc$tape_read =
              data_transfers := (commands_executed) DIV ioc$read_cmd_per_block;

            = ioc$tape_write =
              data_transfers := (commands_executed) DIV ioc$write_cmd_per_block;

            = ioc$tape_forspace, ioc$tape_backspace =
              data_transfers := commands_executed;

            = ioc$tape_write_tapemark =
              data_transfers := commands_executed - ioc$67x_cmd_pos_write_tapemark + 1;

            = ioc$skip_tapemark_forward, ioc$skip_tapemark_backward =
              data_transfers := commands_executed - ioc$67x_cmd_pos_skip_tm_f + 1;

            ELSE
              data_transfers := 0;

            CASEND;
            p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + data_transfers;
          IFEND;

          p_tape_request^.io_status.normal_completion := TRUE;
          p_tape_request^.io_status.write_ring := device_status.write_ring;
          p_tape_request^.io_status.end_of_tape := device_status.end_of_tape;
          p_tape_request^.io_status.beginning_of_tape := device_status.beginning_of_tape;
          p_tape_request^.io_status.unit_busy := device_status.unit_busy;
          p_tape_request^.io_status.unit_ready := device_status.unit_ready;

{         IF this is the exit path for a recovered failure at the end of a group of tape
{         operations, log the original failure information, set tape_error_log_entry to
{         FALSE and initialize the block_in_error entry in the unit descriptor.

          IF NOT bid_recovery AND (p_ud^.tape_error_log_entry = TRUE) THEN
            tape_failure_type := ioc$recovered;
            IF p_ud^.controller_type = cmc$mt5698_xx THEN
              iop$tape_error_logging_ipi (p_tape_request, tape_failure_type, status);
            ELSEIF p_ud^.controller_type = cmc$mt5680_xx THEN
              iop$tape_error_logging_ccc_cart (p_tape_request, tape_failure_type, status);
            ELSE  { ats, ismt or 698
              iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} FALSE, status);
            IFEND;
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            p_ud^.tape_error_log_entry := FALSE;

          IFEND;

          CASE p_tape_request^.request_type OF
          = ioc$tape_backspace, ioc$tape_read_backwards =
            IF p_ud^.controller_type <> cmc$mt5680_xx THEN
              IF bid_update THEN
                FOR i := 1 TO data_transfers DO
                  iop$update_bid_window;
                FOREND;
              IFEND;
            IFEND;

          = ioc$tape_rewind, ioc$tape_unload, ioc$tape_get_status =

            IF ((p_ud^.tape_unit_density = 0) OR (p_ud^.tape_unit_density = 1)) THEN
              p_tape_request^.io_status.unit_density := rmc$1600;
            ELSEIF p_ud^.tape_unit_density = 2 THEN
              p_tape_request^.io_status.unit_density := rmc$800;
            ELSEIF p_ud^.tape_unit_density = 3 THEN
              p_tape_request^.io_status.unit_density := rmc$6250;
            ELSEIF p_ud^.tape_unit_density = 4 THEN
              p_tape_request^.io_status.unit_density := rmc$38000;
            IFEND;

            IF p_ud^.controller_type <> cmc$mt5680_xx THEN
              p_ud^.bid_index := LOWERVALUE(iot$bid_index) + 1;
              p_ud^.bid_window [LOWERVALUE(iot$bid_index)] := ioc$loadpoint_bid;

{The following code works only for ioc$empty_bid = 0, as a bid window is a 2 byte value!
              i#fill ($CHAR (ioc$empty_bid), ^p_ud^.bid_window [2],
                    #SIZE (p_ud^.bid_window) - #SIZE (p_ud^.bid_window [1]));
            ELSE { cartridge tape
              p_ud^.cartridge_tape_last_good_bid := zero_ccc_cart_bid;
              p_ud^.error_block_forespace_count := 0;
            IFEND;

          = ioc$skip_tapemark_backward =
            IF p_ud^.controller_type <> cmc$mt5680_xx THEN
              p_ud^.bid_index := LOWERVALUE(iot$bid_index);
              p_ud^.bid_window [LOWERVALUE(iot$bid_index)] := ioc$tapemark_bid;
{The following code works only for ioc$empty_bid = 0, as a bid window is a 2 byte value!
              i#fill ($CHAR (ioc$empty_bid), ^p_ud^.bid_window [2],
                    #SIZE (p_ud^.bid_window) - #SIZE (p_ud^.bid_window [1]));
            IFEND;

          = ioc$skip_tapemark_forward =
            IF p_ud^.controller_type <> cmc$mt5680_xx THEN
              p_ud^.bid_index := LOWERVALUE(iot$bid_index) + 1;
              p_ud^.bid_window [LOWERVALUE(iot$bid_index)] := ioc$tapemark_bid;
{The following code works only for ioc$empty_bid = 0, as a bid window is a 2 byte value!
              i#fill ($CHAR (ioc$empty_bid), ^p_ud^.bid_window [2],
                    #SIZE (p_ud^.bid_window) - #SIZE (p_ud^.bid_window [1]));
            IFEND;

          ELSE
          CASEND;

{ The following copy of the present bid_window is to save the last correct bid_index and bid_window in the
{ unit job descriptor as the historical index/window to use in Tape_Fatal_Error_Recovery when we are
{ positioning to the Last_Good_Block.  We have to save this image as it reflects the block_count from
{ loadpoint that indexes to the physical_position of the buffer_group being used at the time of the
{ fatal error.  The recovery algorithm will continue writing from that point in the buffer_group and
{ assumes that we are positioned after the last good block that was written/read  prior to the fatal error.
{ Copying the unit descriptor's index and window in this normal case let's the historical_index and
{ historical_bid_window indicate the actual position of the tape while ignoring recovery positioning. This
{ lets us provide the tape position (current without recovery) in iop$get_position_of_tape_file and not have
{ to ask specifically for the contents of p_ud^.bid_index and p_ud^.bid_window. Using the same algorithm for
{ always getting the position of the tape file has better maintainability.

          IF p_ud^.controller_type <> cmc$mt5680_xx THEN
            IF NOT bid_recovery OR (p_ud^.positioning_to_tapemark) THEN
              p_ud^.historical_bid_index := p_ud^.bid_index;
              p_ud^.historical_bid_window := p_ud^.bid_window;
            IFEND;
          IFEND;

        = ioc$abnormal_response =

{ Update the Block_id current window located in tape job unit descriptor.
{ Presently update on count from PP for all write, read, forspace, and write_tapemark functions.

          IF ((p_tape_request^.request_type = ioc$tape_write) OR
                (p_tape_request^.request_type = ioc$tape_read) OR
                (p_tape_request^.request_type = ioc$tape_write_tapemark) OR
                (p_tape_request^.request_type = ioc$tape_forspace)) AND
                (p_ud^.controller_type <> cmc$mt5680_xx) THEN
            IF update_count > 0 THEN
              FOR i := 1 to update_count DO
                p_ud^.bid_window [p_ud^.bid_index] := block_id_status_area [i];
                IF p_ud^.bid_index = UPPERVALUE(iot$bid_index) THEN
                  p_ud^.bid_index := LOWERVALUE(iot$bid_index);
                ELSE
                  p_ud^.bid_index := p_ud^.bid_index + 1;
                IFEND;
              FOREND;
            IFEND;
          ELSEIF p_ud^.controller_type = cmc$mt5680_xx THEN
            previous_last_good_bid := p_ud^.cartridge_tape_last_good_bid;
            IF (p_tape_request^.pp_response_p^.ccc_cart_device_status.last_good_bid <> zero_ccc_cart_bid) AND
                  NOT (p_tape_request^.request_type = ioc$locate_block) AND
                  NOT ((p_tape_request^.request_type = ioc$tape_write) AND
                  (p_tape_request^.pp_response_p^.pp_response.abnormal_status.hardware_malfunction)) THEN
              IF (p_tape_request^.pp_response_p^.ccc_cart_device_status.last_good_bid.
                    physical_position = 0) THEN
                p_ud^.cartridge_tape_last_good_bid.logical_position := p_tape_request^.pp_response_p^.
                      ccc_cart_device_status.last_good_bid.logical_position;
              ELSE
                p_ud^.cartridge_tape_last_good_bid := p_tape_request^.pp_response_p^.
                      ccc_cart_device_status.last_good_bid;
              IFEND;

            ELSE { determine if detailed status bid present
              commands_executed := (p_tape_request^.last_command_processed - ioc$min_request_length)
                    DIV 8 + 1;
              IF NOT p_tape_request^.pp_response_p^.ccc_cart_device_status.adapter_check AND
                    (p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id = 0) AND
                    (p_tape_request^.pp_response_p^.ccc_cart_device_status.unit_check) AND
                    (p_tape_request^.pp_response_p^.pp_response.response_length >
                          ioc$min_ccc_cart_resp_size) AND
                    (p_tape_request^.pp_response_p^.ccc_cart_sense_bytes.erpa_code <> 41(16)) AND
                    (commands_executed > 0) THEN

                CASE p_tape_request^.request_type OF

                = ioc$tape_read, ioc$tape_forspace, ioc$skip_tapemark_forward =


                  IF NOT ((p_tape_request^.request_type = ioc$tape_forspace) AND (NOT bid_update)) THEN
                    IF p_tape_request^.pp_response_p^.ccc_cart_sense_bytes.block_id_pos_indicator THEN
                      p_ud^.cartridge_tape_last_good_bid.logical_position := p_tape_request^.pp_response_p^.
                            ccc_cart_sense_bytes.logical_error_bid - 1;
                    ELSE
                      p_ud^.cartridge_tape_last_good_bid.logical_position := p_tape_request^.pp_response_p^.
                            ccc_cart_sense_bytes.logical_error_bid;
                    IFEND;
                  IFEND;

                = ioc$tape_write =

                  IF (p_tape_request^.pp_response_p^.ccc_cart_device_status.last_good_bid <>
                        zero_ccc_cart_bid) THEN
                    p_ud^.cartridge_tape_last_good_bid := p_tape_request^.pp_response_p^.
                          ccc_cart_device_status.last_good_bid;
                  ELSE
                    osp$system_error ('Non catastrophic write did not return LGBID', ^status);
                  IFEND;

                = ioc$tape_backspace, ioc$skip_tapemark_backward, ioc$tape_write_tapemark =

                  p_ud^.cartridge_tape_last_good_bid.logical_position := p_tape_request^.pp_response_p^.
                        ccc_cart_sense_bytes.logical_error_bid;

                ELSE { rewind or unload or locate_block

                  ; { DO NOT store block id in unit descriptor!!

                CASEND;

              ELSE { bid not known, must resend entire request
                p_tape_request^.last_command_processed := ioc$min_request_length - 8;
              IFEND;
            IFEND;
          IFEND;

{ The following copy of the present bid_window is to save the last correct bid_index and bid_window in the
{ unit job descriptor as the historical index/window to use in Tape_Fatal_Error_Recovery when we are
{ positioning to the Last_Good_Block.  We have to save this image as it reflects the block_count from
{ loadpoint that corresponds to the physical_position of the buffer_group being used at the time of the
{ fatal error.  The recovery algorithm will continue writing from the that point in the buffer_group and
{ assumes that we are positioned after the last good block that was written/read prior to the fatal error.

          IF p_ud^.controller_type <> cmc$mt5680_xx THEN
            IF NOT bid_recovery OR (p_ud^.positioning_to_tapemark) THEN
              p_ud^.historical_bid_index := p_ud^.bid_index;
              p_ud^.historical_bid_window := p_ud^.bid_window;
            IFEND;
          IFEND;

          /response_code_case/
          BEGIN
          p_tape_request^.io_status.normal_completion := FALSE;
          inhibit_recovery_occurred := FALSE;

{ Update the tape request for the number of blocks_accessed.

          commands_executed := (p_tape_request^.last_command_processed - ioc$min_request_length) DIV 8 + 1;

          IF commands_executed > 0 THEN
            CASE p_tape_request^.request_type OF

            = ioc$tape_read =
              data_transfers := (commands_executed - ioc$67x_cmd_pos_read + 1) DIV
                    ioc$read_cmd_per_block;
              p_ud^.blocks_read := p_ud^.blocks_read + 1;

            = ioc$tape_write =
              data_transfers := (commands_executed - ioc$67x_cmd_pos_write + 1) DIV
                    ioc$write_cmd_per_block;
              p_ud^.blocks_written := p_ud^.blocks_written + 1;

            = ioc$tape_forspace, ioc$tape_backspace =
              data_transfers := commands_executed - ioc$67x_cmd_pos_forspace + 1;
              p_ud^.blocks_read := p_ud^.blocks_read + 1;

            = ioc$tape_write_tapemark =
              data_transfers := commands_executed - ioc$67x_cmd_pos_write_tapemark + 1;
              p_ud^.blocks_written := p_ud^.blocks_written + 1;

            = ioc$skip_tapemark_forward, ioc$skip_tapemark_backward =
              data_transfers := commands_executed - ioc$67x_cmd_pos_skip_tm_f + 1;

            ELSE
              data_transfers := 0;

            CASEND;
            p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + data_transfers;
          IFEND;

{ Process abnormal status for 5698_1x and 5680_11 in separate routines.

          IF p_ud^.controller_type = cmc$mt5698_xx THEN   { process 5698_1x abnormal status
            iop$tape_status_check_ipi (bid_recovery, bid_update, commands_executed,
                  data_transfers, inhibit_recovery_occurred, p_tape_request, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            EXIT /response_code_case/;
          ELSEIF p_ud^.controller_type = cmc$mt5680_xx THEN { process 5680_11 abnormal status
            iop$tape_status_check_ccc_cart (bid_recovery, bid_update, commands_executed,
                  data_transfers, previous_last_good_bid, p_tape_request, status);
            RETURN; {<----------
          IFEND;

{ Process non 5698_1x or 5680_11 controller abnormal status.

          p_tape_request^.io_status.write_ring := device_status.write_ring;
          p_tape_request^.io_status.end_of_tape := device_status.end_of_tape;
          p_tape_request^.io_status.beginning_of_tape := device_status.beginning_of_tape;
          p_tape_request^.io_status.unit_busy := device_status.unit_busy;
          p_tape_request^.io_status.unit_ready := device_status.unit_ready;
          IF (pp_response.abnormal_status.abnormal_alert) AND
             (pp_response.alert_conditions.long_input_block) THEN
                p_tape_request^.io_status.long_input_block := TRUE;
                p_tape_request^.io_status.completion_code := ioc$alert_condition_encountered;
          IFEND;
          IF pp_response.abnormal_status.forced_termination THEN
            { Error, since forced termination not used by the tape handler. }
            iop$tape_pp_error (p_tape_request, status);
            EXIT /response_code_case/
          IFEND;
          IF pp_response.abnormal_status.recording_medium_error THEN
            { Error, since pp never should set this. }
            iop$tape_pp_error (p_tape_request, status);
            EXIT /response_code_case/
          IFEND;
          IF pp_response.abnormal_status.intervention_required THEN
            { Error, since pp should never set this. }
            iop$tape_pp_error (p_tape_request, status);
            EXIT /response_code_case/
          IFEND;
          IF pp_response.abnormal_status.interface_error THEN
            { Recovery if any here needs more definition. ***** }
            p_tape_request^.io_status.completion_code := ioc$system_software_failure;
            EXIT /response_code_case/
          IFEND;

{         Check whether an abnormal termination is an unrecovered  error and
{         whether it is the first log entry to be made for this group of tape
{         operations. Save the block number on which the error occurred and
{         make an initial call to iop$tape_error_logging.
{         If this is an abnormal termination on a different block then complete
{         the log entry for the previous block in error, which must have been
{         recovered. After this clear the retry counters and make an initial
{         call to iop$tape_error_logging for the current block in error.

          status_word_3 := device_status.tape_parity_error OR device_status.lost_data OR
                           device_status.unit_check OR device_status.channel_parity_error OR
                           device_status.tcu_parity_error OR (device_status.error_code > 0);
          IF NOT bid_recovery AND
             NOT (pp_response.alert_conditions.long_input_block AND NOT status_word_3) AND
             NOT (pp_response.alert_conditions.logical_delimiter) AND
             NOT (pp_response.alert_conditions.physical_delimiter AND NOT status_word_3) AND
             NOT ((p_tape_request^.request_type = ioc$tape_erase) AND NOT (device_status.unit_check)) AND
             (pp_response.abnormal_status.hardware_malfunction OR
              pp_response.abnormal_status.channel_error OR
              pp_response.abnormal_status.output_channel_parity OR
              pp_response.abnormal_status.function_timeout OR
              pp_response.abnormal_status.data_overrun) AND
             NOT (((p_tape_request^.request_type = ioc$tape_get_status) OR
                   (p_tape_request^.request_type = ioc$tape_unload)) AND
                   (device_status.error_code = 4)) AND
             NOT ((device_status.error_code = 6) OR
                  (device_status.error_code = 7) OR
                  (device_status.error_code = 10(8)) OR
                  (device_status.error_code = 30(8)) OR
                  (device_status.error_code = 32(8))) THEN

{           Check whether a log entry is outstanding.

            IF NOT p_ud^.tape_error_log_entry THEN
              tape_failure_type := ioc$undetermined;
              iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} FALSE, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;

{             Set tape_error_log_entry to TRUE and save the block number for the block_in_error.

              p_ud^.tape_error_log_entry := TRUE;
              p_ud^.block_in_error := p_tape_request^.blocks_accessed;

            ELSE
              IF p_tape_request^.blocks_accessed <> p_ud^.block_in_error THEN

{               Finalize the outstanding error log entry, which has been recovered.

                tape_failure_type := ioc$recovered;
                iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} FALSE, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

{               Clear the retry counters before attempting to recover the next failure.

                p_tape_request^.tcu_parity_retry_count := 0;
                p_tape_request^.parity_retry_count := 0;
                p_tape_request^.lost_data_retry_count := 0;
                p_tape_request^.busy_retry_count := 0;
                p_tape_request^.lateack_retry_count := 0;
                p_tape_request^.misc_retry_count := 0;

{               Make an initial log entry for the next failure.

                tape_failure_type := ioc$undetermined;
                iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} FALSE, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

{               Save the block_in _error, tape_error_log_entry is already set to TRUE.

                p_ud^.block_in_error := p_tape_request^.blocks_accessed;

              IFEND;
            IFEND;
          IFEND;

          IF NOT pp_response.abnormal_status.hardware_malfunction THEN
            IF (pp_response.abnormal_status.channel_error) OR
               (pp_response.abnormal_status.output_channel_parity) THEN

            /input_output_parity/
            BEGIN
              IF p_tape_request^.parity_retry_count < ioc$tape_max_chan_parity_retry THEN
                p_tape_request^.parity_retry_count := p_tape_request^.parity_retry_count + 1;
               IF commands_executed > 0 THEN
                CASE p_tape_request^.request_type OF
                = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
                  iop$tape_reposition_b (p_tape_request, status);
                = ioc$tape_forspace =
                  IF bid_update THEN
                    iop$tape_reposition_b (p_tape_request, status);
                  ELSE
                    iop$update_bid_window;
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.normal_completion := TRUE;
                    EXIT /response_code_case/
                  IFEND;
                = ioc$tape_read_backwards, ioc$tape_backspace =
                  IF bid_update THEN
                    FOR i := 1 TO data_transfers + 1 DO
                      iop$update_bid_window;
                    FOREND;
                  IFEND;
                  IF NOT bid_recovery THEN
                    iop$tape_reposition_f (p_tape_request, status);
                  ELSE
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.normal_completion := TRUE;
                    EXIT /response_code_case/
                  IFEND;
                ELSE
                  EXIT /input_output_parity/
                CASEND;
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                IF (p_tape_request^.io_status.io_complete) AND
                   NOT (p_tape_request^.io_status.normal_completion) AND
                   NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                 Reposition failed.
{                 Exit with io_status returned from reposition.
                  EXIT /response_code_case/
                IFEND;
               IFEND;
                  iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                  EXIT /response_code_case/
              IFEND;
            END /input_output_parity/;
              p_tape_request^.io_status.io_complete := TRUE;
              IF pp_response.abnormal_status.channel_error THEN
                p_tape_request^.io_status.completion_code := ioc$input_channel_parity;
              ELSE
                IF device_status.channel_parity_error THEN
                  p_tape_request^.io_status.completion_code := ioc$iou_output_parity;
                ELSE
                  p_tape_request^.io_status.completion_code := ioc$indeterminate_output_parity;
                IFEND;
              IFEND;
              EXIT /response_code_case/
            IFEND;

            IF pp_response.abnormal_status.function_timeout THEN
              p_tape_request^.io_status.completion_code := ioc$function_timeout;
              p_tape_request^.io_status.io_complete := TRUE;
              EXIT /response_code_case/
            IFEND;

            IF pp_response.abnormal_status.data_overrun THEN

            /overrun_loop/
              BEGIN

                IF p_tape_request^.lateack_retry_count < ioc$tape_max_lateack_retry THEN
                  p_tape_request^.lateack_retry_count := p_tape_request^.lateack_retry_count + 1;
                  CASE p_tape_request^.request_type OF
                  = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
                    iop$tape_reposition_b (p_tape_request, status);
                  = ioc$tape_forspace =
                    IF bid_update THEN
                      iop$tape_reposition_b (p_tape_request, status);
                    ELSE
                      iop$update_bid_window;
                      p_tape_request^.io_status.io_complete := TRUE;
                      p_tape_request^.io_status.normal_completion := TRUE;
                      EXIT /response_code_case/
                    IFEND;
                  = ioc$tape_read_backwards, ioc$tape_backspace =
                    IF bid_update THEN
                      FOR i := 1 TO data_transfers + 1 DO
                        iop$update_bid_window;
                      FOREND;
                    IFEND;
                    IF NOT bid_recovery THEN
                      iop$tape_reposition_f (p_tape_request, status);
                    ELSE
                      p_tape_request^.io_status.io_complete := TRUE;
                      p_tape_request^.io_status.normal_completion := TRUE;
                      EXIT /response_code_case/
                    IFEND;
                  ELSE
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.completion_code := ioc$unit_failure;
                    EXIT /overrun_loop/
                  CASEND;
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  IF p_tape_request^.io_status.io_complete AND
                     NOT p_tape_request^.io_status.normal_completion AND
                     NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                   Reposition failed.
{                   Exit with io_status returned from reposition.
                    EXIT /response_code_case/
                  ELSE
                    iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                    EXIT /response_code_case/
                  IFEND;
                IFEND;
                p_tape_request^.io_status.io_complete := TRUE;
                p_tape_request^.io_status.completion_code := ioc$unit_failure;
              END /overrun_loop/;
            IFEND;
            IF pp_response.abnormal_status.abnormal_alert THEN
              IF pp_response.alert_conditions.compare_not_satisfied THEN
                { This should never be set for tape. }
                iop$tape_pp_error (p_tape_request, status);
                EXIT /response_code_case/
              IFEND;

{             Investigate whether a tapemark has been encountered.

              IF pp_response.alert_conditions.logical_delimiter THEN
                p_tape_request^.io_status.completion_code := ioc$tapemark_read;

{               Update the block id window index after a tapemark has been encountered
{               during a backward motion operation. Set the block id to ioc$unavail_bid.

                CASE p_tape_request^.request_type OF
                = ioc$tape_backspace, ioc$tape_read_backwards =
                  IF bid_update THEN
                    FOR i := 1 TO data_transfers + 1 DO
                      iop$update_bid_window;
                    FOREND;
                  IFEND;

                ELSE
                CASEND;
                EXIT /response_code_case/
              IFEND;

{             Investigate whether end of tape has been encountered.  IF so, increment
{             blocks_accessed to indicate block is written to tape.

              IF pp_response.alert_conditions.physical_delimiter THEN
                p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + 1;
                p_tape_request^.io_status.normal_completion := TRUE;
                p_tape_request^.io_status.io_complete := TRUE;
                EXIT /response_code_case/
              IFEND;

            IFEND;

          ELSE {pp_response.abnormal_status.hardware_malfunction = TRUE}

            IF device_status.tcu_parity_error OR ((device_status.unit_check) AND
                  ((p_ud^.controller_type = cmc$mt7221_1) OR (p_ud^.controller_type = cmc$mt7221_2_s0)) AND
                  (device_status.error_code = 0)) THEN
              IF p_tape_request^.tcu_parity_retry_count < ioc$tape_max_tcu_parity_retry THEN
                p_tape_request^.tcu_parity_retry_count := p_tape_request^.tcu_parity_retry_count + 1;
                CASE p_tape_request^.request_type OF
                = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
                  iop$tape_reposition_b (p_tape_request, status);
                = ioc$tape_forspace =
                  IF bid_update THEN
                    iop$tape_reposition_b (p_tape_request, status);
                  ELSE
                    iop$update_bid_window;
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.normal_completion := TRUE;
                    EXIT /response_code_case/
                  IFEND;
                = ioc$tape_read_backwards, ioc$tape_backspace =
                  IF bid_update THEN
                    FOR i := 1 TO data_transfers + 1 DO
                      iop$update_bid_window;
                    FOREND;
                  IFEND;
                  IF NOT bid_recovery THEN
                    iop$tape_reposition_f (p_tape_request, status);
                  ELSE
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.normal_completion := TRUE;
                    EXIT /response_code_case/
                  IFEND;
                ELSE
                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$unit_failure;
                  EXIT /response_code_case/
                CASEND;
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                IF p_tape_request^.io_status.io_complete AND
                   NOT p_tape_request^.io_status.normal_completion AND
                   NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                 Reposition failed.
{                 Exit with io_status returned from reposition.
                  EXIT /response_code_case/
                IFEND;
                iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                EXIT /response_code_case/
              IFEND;
              p_tape_request^.io_status.io_complete := TRUE;
              p_tape_request^.io_status.completion_code := ioc$unit_failure;
            ELSE
              IF device_status.unit_check THEN
                p_tape_request^.io_status.normal_completion := FALSE;
                p_tape_request^.io_status.completion_code := ioc$unit_failure;
                p_tape_request^.io_status.position_uncertain := TRUE;
              IFEND;
                IF (device_status.error_code = 8 {blank tape}) AND
                      (p_tape_request^.request_type = ioc$tape_write) THEN

{ Attempt recovery in case a 698 CCC drive detected "blank tape" instead of "data parity error".

                  device_status.error_code := 0;
                  device_status.tape_parity_error := TRUE;
                IFEND;

                CASE device_status.error_code OF
                = 0 =
                  { No error condition. }
                  IF device_status.channel_parity_error THEN

                  /chan_parity_loop_1/
                    BEGIN

                      IF p_tape_request^.parity_retry_count < ioc$tape_max_chan_parity_retry THEN
                        p_tape_request^.parity_retry_count := p_tape_request^.parity_retry_count + 1;
                        IF commands_executed <> 0 THEN
                          CASE p_tape_request^.request_type OF
                          = ioc$tape_write =
                            iop$tape_reposition_b (p_tape_request, status);
                            IF NOT status.normal THEN
                              RETURN;
                            IFEND;
                            IF p_tape_request^.io_status.io_complete AND
                               NOT p_tape_request^.io_status.normal_completion AND
                               NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                             Reposition failed.
{                             Exit with io_status returned from reposition.
                              EXIT /response_code_case/
                            IFEND;
                          ELSE
                            p_tape_request^.io_status.io_complete := TRUE;
                            p_tape_request^.io_status.completion_code := ioc$unit_failure;
                            EXIT /chan_parity_loop_1/
                          CASEND;
                        IFEND;
                          iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                          EXIT /response_code_case/
                      IFEND;
                      p_tape_request^.io_status.io_complete := TRUE;
                      p_tape_request^.io_status.completion_code := ioc$output_channel_parity;
                    END /chan_parity_loop_1/;

                  ELSE
                    IF device_status.tape_parity_error THEN

                    /tape_parity_error_loop/
                      BEGIN

                        IF p_tape_request^.inhibit_error_recovery AND NOT bid_recovery THEN
                           IF p_tape_request^.request_type = ioc$tape_write THEN
                             p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + 1;
                           IFEND;
                           inhibit_recovery_occurred := TRUE;
                           p_tape_request^.io_status.io_complete := TRUE;
                           p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;
                           iop$update_bid_window;
                           EXIT /tape_parity_error_loop/
                        IFEND;

                      /tape_parity_error_loop_2/
                      BEGIN
                        IF p_tape_request^.parity_retry_count < ioc$tape_max_tape_parity_retry THEN
                          p_tape_request^.parity_retry_count := p_tape_request^.parity_retry_count + 1;
                          CASE p_tape_request^.request_type OF
                          = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
                            iop$tape_reposition_b (p_tape_request, status);
                          = ioc$tape_forspace =
                            IF bid_update THEN
                              iop$tape_reposition_b (p_tape_request, status);
                            ELSE
                              iop$update_bid_window;
                              p_tape_request^.io_status.io_complete := TRUE;
                              p_tape_request^.io_status.normal_completion := TRUE;
                              EXIT /response_code_case/
                            IFEND;

                            {the following case selection presently resolves some recovery problems
                            {when parity error is received while backspacing in BID_RECOVERY mode.
                            {We accept backspace errors during BID_RECOVERY because we will check the
                            {BID windows and correct for mispositioning.
                            {When not in recovery we accept backspaces if only a parity error status is
                            {present and not status bits to indicate possible mispositioning.

                          = ioc$tape_backspace, ioc$tape_read_backwards =
                            IF bid_update THEN
                              FOR i := 1 TO data_transfers + 1 DO
                                iop$update_bid_window;
                              FOREND;
                            IFEND;
                            IF ((device_status.false_eop) OR (device_status.false_gap_bypassed) OR
                                  (device_status.noise_bypassed)) AND NOT (bid_recovery) THEN
                              iop$tape_reposition_f (p_tape_request, status);
                            ELSE
                              p_tape_request^.io_status.normal_completion := TRUE;
                              p_tape_request^.io_status.io_complete := TRUE;
                              IF (p_tape_request^.no_of_non_data_commands = 1) OR
                                    (commands_executed = p_tape_request^.no_of_non_data_commands) THEN

{ Do not attempt iop$tape_retry_io if the number of original backspaces has been completed.

                                EXIT /tape_parity_error_loop/;
                              ELSE

{ Decrement number of original commands by 1 to account for the block which encountered the parity
{ error.  iop$tape_retry_io must be called to complete the original number of backspaces.

                                p_tape_request^.no_of_non_data_commands :=
                                      p_tape_request^.no_of_non_data_commands - 1;
                              IFEND;
                            IFEND;
                          = ioc$tape_erase =
                            IF device_status.erase_current_failure THEN
                              p_tape_request^.io_status.completion_code := ioc$unit_failure;
                            ELSE
                              p_tape_request^.io_status.normal_completion := TRUE;
                            IFEND;
                            p_tape_request^.io_status.io_complete := TRUE;
                            EXIT /tape_parity_error_loop/
                          ELSE
                            p_tape_request^.io_status.io_complete := TRUE;
                            p_tape_request^.io_status.completion_code := ioc$unit_failure;
                            EXIT /tape_parity_error_loop/
                          CASEND;
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;

                          IF p_tape_request^.io_status.io_complete AND
                             NOT p_tape_request^.io_status.normal_completion AND
                             NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                           Reposition failed.
{                           Exit with io_status returned from reposition.
                            EXIT /response_code_case/
                          ELSE
                            IF (p_tape_request^.request_type = ioc$tape_write) OR
                               (p_tape_request^.request_type = ioc$tape_write_tapemark) THEN

                              erasures := p_tape_request^.parity_retry_count;

                              FOR i := 1 TO erasures DO
                                logical_unit := p_tape_request^.request.logical_unit;
                                iop$67x_non_data_trans_setup (logical_unit, ioc$tape_erase, repeat_count,
                                      disable_unit, physical_unload, rio_id, rstatus);
                                IF NOT rstatus.normal THEN

{                                 Set position_uncertain to TRUE.

                                  p_tape_request^.io_status.position_uncertain := TRUE;

                                  EXIT /tape_parity_error_loop_2/
                                ELSE
                                  iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release}
                                        TRUE, {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);
                                  IF (NOT rstatus.normal) OR (NOT rio_status.normal_completion) THEN

{                                   Set position_uncertain to TRUE.

                                    rio_status.position_uncertain := TRUE;
                                    p_tape_request^.io_status := rio_status;

                                    EXIT /tape_parity_error_loop_2/
                                  IFEND;
                                IFEND;
                              FOREND;
                            IFEND;
                            iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                            EXIT /response_code_case/
                          IFEND;
                        IFEND;
                      END /tape_parity_error_loop_2/;
                        IF (p_tape_request^.request_type = ioc$tape_read) OR
                            (p_tape_request^.request_type = ioc$tape_forspace) THEN
                          iop$update_bid_window;
                        IFEND;
                        p_tape_request^.io_status.io_complete := TRUE;
                        p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;
                      END /tape_parity_error_loop/;

                    ELSE

                      p_tape_request^.io_status.io_complete := TRUE;
                      p_tape_request^.io_status.completion_code := ioc$unit_failure;

                    IFEND;
                  IFEND;

                = 1, 3 =
{                 1 - Tape unit off_line, powered off or not cabled to controller.
{                 3 - Tape unit access switch in off position for this controller.
{                     Display a 'UNIT OFF-LINE' message on the operator console.

                  p_tape_request^.io_status.normal_completion := FALSE;
                  p_tape_request^.io_status.completion_code := ioc$unit_failure;
                  p_tape_request^.io_status.position_uncertain := TRUE;

                = 2 =
{                 2 - Tape unit already connected to another controller.

                  p_tape_request^.io_status.completion_code := ioc$unit_reserved;

                = 4, 5 =
{                 4 - Tape unit not ready.
{                 5 - Tape unit declared not ready during last operation.
{                     Display a 'UNIT NOT READY' message on the operator console.

                  IF (p_tape_request^.request_type = ioc$tape_get_status) OR
                        (p_tape_request^.request_type = ioc$tape_unload) THEN
                    p_tape_request^.io_status.normal_completion := TRUE;
                    p_tape_request^.io_status.unit_ready := FALSE;
                  ELSE
                    p_tape_request^.io_status.normal_completion := FALSE;
                    p_tape_request^.io_status.completion_code := ioc$unit_failure;
                    p_tape_request^.io_status.position_uncertain := TRUE;
                  IFEND;

                = 6 =
{                 6 - Missing write ring.
{                     Return an error status to the requestor.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$no_write_ring;

                = 7 =
{                 7 - Unit not capable of reading density in which the tape is recorded.
{                     Send an error status to the requestor.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$not_capable_of_density;

                = 8 =
{                 10(8) - More than 25 feet of blank tape.
{                         Send an error status to the requestor.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$blank_tape;

                = 10, 11, 14 =
{                 12(8) - Unable to detect ID burst immediately after writing it.
{                 13(8) - Tape unit AGC could not be set properly on this tape.
{                 16(8) - The tape unit AGC cound not be set in all tracks.
{                 These errors will be retried 2 more times and if it still occurs,
{                 bad status will be returned to the caller, except for an error
{                 code of 14 when write_ring status is FALSE (allow reading).

                    logical_unit := p_tape_request^.request.logical_unit;

                  /bad_id_burst_recovery_loop/
                  BEGIN
                    IF p_tape_request^.misc_retry_count < ioc$tape_max_misc_retry THEN
                      p_tape_request^.misc_retry_count := p_tape_request^.misc_retry_count + 1;
                      rstatus.normal := TRUE;
                      iop$67x_non_data_trans_setup (logical_unit, ioc$tape_rewind, repeat_count,
                             disable_unit, physical_unload, rio_id, rstatus);
                      IF NOT rstatus.normal THEN
                        EXIT /bad_id_burst_recovery_loop/
                      ELSE
                        iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} TRUE,
                              {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);
                        IF (NOT rstatus.normal) OR (NOT rio_status.normal_completion) THEN
                          p_tape_request^.io_status := rio_status;
                          EXIT /bad_id_burst_recovery_loop/
                        IFEND;
                      IFEND;
                      iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                      EXIT /response_code_case/
                    IFEND;
                  END /bad_id_burst_recovery_loop/;

{ Allow error code 16(8) to be accepted for normal completion if the write ring status is FALSE.
{ The tape may be readable, but we do not want the file extended by writing to the tape when the
{ tape unit AGC is not set properly in all tracks.

                    IF (device_status.error_code = 14) AND NOT (device_status.write_ring) THEN

{ Place an error bid indicator in the Bid_Window due to the block_id not being updated on a bad read and
{ set completion status to normal in an attempt to read the tape. An Engineering Log entry has been set up.

                      iop$update_bid_window;
                      p_tape_request^.io_status.normal_completion := TRUE;
                      p_tape_request^.io_status.io_complete := TRUE;
                      EXIT /response_code_case/
                    IFEND;

{ Rewind the tape and send error status to the requestor.

                    rstatus.normal := TRUE;
                    iop$67x_non_data_trans_setup (logical_unit, ioc$tape_rewind, repeat_count,
                           disable_unit, physical_unload, rio_id, rstatus);
                    iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} TRUE,
                          {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);

                    p_tape_request^.io_status.io_complete := TRUE;
                    IF device_status.error_code = 10 THEN
                      p_tape_request^.io_status.completion_code := ioc$unable_to_write_id_burst;
                    ELSE

{ Error code at this point is 11 or 14. Case selector only set for 10, 11, 14 in this area.

                      p_tape_request^.io_status.completion_code := ioc$unable_to_set_agc;
                    IFEND;

                = 24 =
{                 30(8) - Backwards motion attempted at load point.
{                         Return load point status to the requestor.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$load_point;

{                 Set BID window back to load point.

                  p_ud^.bid_index := LOWERVALUE(iot$bid_index) + 1;
                  p_ud^.bid_window [LOWERVALUE(iot$bid_index)] := ioc$loadpoint_bid;

{The following code works only for ioc$empty_bid = 0, as a bid window is a 2 byte value!
                  i#fill ($CHAR (ioc$empty_bid), ^p_ud^.bid_window [2],
                        #SIZE (p_ud^.bid_window) - #SIZE (p_ud^.bid_window [1]));

                = 25, 28 .. 30, 40 .. 42 =
{                 31(8) - non-existant tape unit requested.
{                 34(8) - controlled backspace attempted, but last
{                         function was not a write.
{                 35(8) - the controller is not capable of requested density.
{                 36(8) - write attempted at 200 CPI.
{                 50(8) - illegal function code.
{                 51(8) - the unit is not connected.
{                 52(8) - parameters were not issued.
{                 These errors indicate an error in the operating system or
{                 in the tape controller.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$indeterminate;

                = 26 =
{                 32(8) - Unit busy rewinding or doing a data security erase.
{                         Retry the failing request until enough time has expired to
{                         insure that the unit should no longer be busy.

                /busy_loop/
                  BEGIN

                  IF (p_tape_request^.request_type = ioc$tape_rewind) OR
                     (p_tape_request^.request_type = ioc$tape_get_status) THEN
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.normal_completion := TRUE;
                    p_tape_request^.io_status.unit_ready := TRUE;
                    p_tape_request^.io_status.unit_busy := TRUE;
                    EXIT /busy_loop/
                  IFEND;
                    IF p_tape_request^.busy_retry_count < (ioc$tape_max_busy_retry * 4) THEN
                      p_tape_request^.busy_retry_count := p_tape_request^.busy_retry_count + 1;
                      pmp$delay (ioc$tape_long_wait DIV 4, status);
                      IF NOT status.normal THEN
                        EXIT /busy_loop/
                      IFEND;
                      iop$tape_queue_request_setup (p_tape_request, status);
                      IF NOT status.normal THEN
                        EXIT /busy_loop/
                      ELSE
                        logical_unit := p_tape_request^.request.logical_unit;
                        rio_id := p_tape_request^.io_id;
                        iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} FALSE,
                              bid_recovery, bid_update, osc$wait, rio_status, rstatus);
                        p_tape_request^.io_status := rio_status;
                        EXIT /busy_loop/

                      IFEND;
                    IFEND;
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.completion_code := ioc$unit_failure;
                  END /busy_loop/;

                = 32, 35..37, 39, 96, 99, 101 =
{                 40(8)  - if gap control status failed to occur within 270 mills.
{                 43(8)  - if erase or write current failed to occur when a write
{                          was requested.
{                 44(8)  - if stop command failed to work.
{                 45(8)  - if reverse status was still indicated after a forward
{                          signal was sent to the unit.
{                 47(8)  - if the tape unit would not select density on command.
{                 140(8) - if tape unit failed to execute a data security erase.
{                 143(8) - if write current failed to turn off for a read operation.
{                 145(8) - if forward status was still indicated after a reverse
{                          signal was sent to the unit.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$unit_failure;

{                 Set position_uncertain to TRUE.

                  p_tape_request^.io_status.position_uncertain := TRUE;

                = 45 =
{                 55(8) - Channel parity error during function transmission.
{                         Retry 6 times.
{                 Note, if dual controller the odds are that at least one retry
{                 will occur on the other controller because both
{                 controllers share the same unit queues, but this is not
{                 guaranteed.

                    IF p_tape_request^.parity_retry_count < ioc$tape_max_chan_parity_retry THEN
                      p_tape_request^.parity_retry_count := p_tape_request^.parity_retry_count + 1;
                      iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                      EXIT /response_code_case/
                    IFEND;
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.completion_code := ioc$output_channel_parity;

                = 33, 34, 38, 49, 50 =
{                 41(8)  - if velocity failed to reach 95 percent of rated speed
{                          within 270 mills.
{                 42(8)  - if unit failed to move the tape when tape movement was
{                          requested.
{                 46(8)  - if no data was detected in the read_after_write.
{                 61(8) - if late acknowledge.
{                 62(8) - if ppu was not ready to receive data for a read.
{                         Reposition and retry 6 times.
{                 ***** Note check for late ack on 1st word, otherwise block could
{                 be lost by repositioning over previous block and doing retry.

                /late_loop/
                  BEGIN

                    IF p_tape_request^.lateack_retry_count < ioc$tape_max_lateack_retry THEN
                      p_tape_request^.lateack_retry_count := p_tape_request^.lateack_retry_count + 1;
                      CASE p_tape_request^.request_type OF
                      = ioc$tape_read, ioc$tape_write =
                        iop$tape_reposition_b (p_tape_request, status);
                      = ioc$tape_read_backwards, ioc$tape_backspace =
                        IF bid_update THEN
                          FOR i := 1 TO data_transfers + 1 DO
                            iop$update_bid_window;
                          FOREND;
                        IFEND;
                        IF NOT bid_recovery THEN
                          iop$tape_reposition_f (p_tape_request, status);
                        ELSE
                          p_tape_request^.io_status.io_complete := TRUE;
                          p_tape_request^.io_status.normal_completion := TRUE;
                          EXIT /response_code_case/
                        IFEND;
                      ELSE
                        p_tape_request^.io_status.io_complete := TRUE;
                        p_tape_request^.io_status.completion_code := ioc$unit_failure;
                        EXIT /late_loop/
                      CASEND;
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      IF p_tape_request^.io_status.io_complete AND
                         NOT p_tape_request^.io_status.normal_completion AND
                         NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                       Reposition failed.
{                       Exit with io_status returned from reposition.
                        EXIT /response_code_case/
                      ELSE
                        iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                        EXIT /response_code_case/
                      IFEND;
                    IFEND;
                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.completion_code := ioc$unit_failure;
                  END /late_loop/;

                = 52 =
{                 64(8) - The channel was hung active and empty following a
{                         load or copy code table operation.

                    p_tape_request^.io_status.io_complete := TRUE;
                    p_tape_request^.io_status.completion_code := ioc$controller_failure;

                = 53 =
{                 65(8) - The channel was hung active and full during a status function.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$controller_failure;

                = 56 =
{                 70(8) - The control unit detected an internal failure while
{                         executing the internal diagnostics following a master clear.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$controller_failure;

                = 72, 81, 108 .. 114, 116, 117, 120 .. 127 =
{                 110(8), 121(8), 154(8) - 162(8), 164(8), 165(8), 170(8) - 177(8) are error
{                   codes returned only for 698_3x units and indicate a CCC internal error.
{                   The operation will be retried 3 times before declaring a fatal error.

                  IF p_tape_request^.misc_retry_count < ioc$tape_max_misc_retry THEN
                        p_tape_request^.misc_retry_count := p_tape_request^.misc_retry_count + 1;
                    IF commands_executed <> 0 THEN
                      CASE p_tape_request^.request_type OF
                      = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
                        iop$tape_reposition_b (p_tape_request, status);
                      = ioc$tape_forspace =
                        IF bid_update THEN
                          iop$tape_reposition_b (p_tape_request, status);
                        ELSE
                          iop$update_bid_window;
                          p_tape_request^.io_status.io_complete := TRUE;
                          p_tape_request^.io_status.normal_completion := TRUE;
                          EXIT /response_code_case/
                        IFEND;
                      = ioc$tape_read_backwards, ioc$tape_backspace =
                        IF bid_update THEN
                          FOR i := 1 TO data_transfers + 1 DO
                            iop$update_bid_window;
                          FOREND;
                        IFEND;
                        IF NOT bid_recovery THEN
                          iop$tape_reposition_f (p_tape_request, status);
                        ELSE
                          p_tape_request^.io_status.io_complete := TRUE;
                          p_tape_request^.io_status.normal_completion := TRUE;
                          EXIT /response_code_case/
                        IFEND;
                      ELSE
                        p_tape_request^.io_status.io_complete := TRUE;
                        p_tape_request^.io_status.completion_code := ioc$controller_failure;
                        EXIT /response_code_case/
                      CASEND;
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      IF p_tape_request^.io_status.io_complete AND
                         NOT p_tape_request^.io_status.normal_completion AND
                         NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{                     Reposition failed.
{                     Exit with io_status returned from reposition.
                      EXIT /response_code_case/
                      IFEND;
                    IFEND;
                    iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

                    EXIT /response_code_case/
                  IFEND;
                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.completion_code := ioc$controller_failure;

                ELSE

{                 Undefined error code.

                  p_tape_request^.io_status.io_complete := TRUE;
                  p_tape_request^.io_status.normal_completion := FALSE;
                  p_tape_request^.io_status.completion_code := ioc$indeterminate;
                CASEND;

            IFEND;
          IFEND;
        END /response_code_case/;

{       Only the last occurence of an unrecovered error will be logged; the intial logging
{       has been done  before. The  status on  recovered  errors will be logged elsewhere.
{       Some recovery operations although terminated abnormally might have been changed to
{       normal completion during status examination.

        IF (NOT p_tape_request^.io_status.normal_completion) AND
           (p_tape_request^.io_status.completion_code <> ioc$tapemark_read) AND
           p_ud^.tape_error_log_entry THEN

          tape_failure_type := ioc$unrecovered;
          IF p_ud^.controller_type = cmc$mt5698_xx THEN
            iop$tape_error_logging_ipi (p_tape_request, tape_failure_type, status);
          ELSEIF p_ud^.controller_type = cmc$mt5680_xx THEN
            ;
          ELSE { ats, ismt or 698
            iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} FALSE, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{         Set tape_error_log_entry to FALSE and initialize the block_in_error entry in the
{         unit_descriptor.

          p_ud^.tape_error_log_entry := FALSE;
          p_ud^.block_in_error := -1;

{         Position the tape for a write or write_tapemark operation before the last
{         good block:  only if no position uncertain was encountered.

          IF ((p_tape_request^.request_type = ioc$tape_write) OR
             (p_tape_request^.request_type = ioc$tape_write_tapemark)) AND
             (NOT inhibit_recovery_occurred) AND
             (NOT p_tape_request^.io_status.position_uncertain) THEN

{           Save the last (unrecovered) status before executing
{           the backwards reposition operation.

            rio_status := p_tape_request^.io_status;

            iop$tape_reposition_b (p_tape_request, status);
            IF p_tape_request^.io_status.io_complete AND
               (NOT p_tape_request^.io_status.normal_completion) AND NOT
               (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{             Reposition failed.

              rio_status.position_uncertain := TRUE;
            IFEND;

{           Restore the unrecovered status for further examination by the caller,
{           keep the end_of_tape indication current.

            rio_status.end_of_tape := p_tape_request^.io_status.end_of_tape;
            p_tape_request^.io_status := rio_status;
          IFEND;

        ELSEIF (p_ud^.controller_type <> cmc$mt5698_xx) AND p_ud^.tape_error_log_entry AND
              ((p_tape_request^.io_status.completion_code = ioc$tapemark_read) OR
              (p_tape_request^.io_status.completion_code = ioc$alert_condition_encountered) OR
              (p_tape_request^.io_status.normal_completion AND pp_response.alert_conditions.
              physical_delimiter)) AND NOT bid_recovery THEN
          iop$tape_error_logging (p_tape_request, ioc$recovered, {*IM*} FALSE, status);
          p_ud^.tape_error_log_entry := FALSE;

        IFEND;

      CASEND;

    END;

  PROCEND iop$tape_status_check;
?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_status_check_ccc_cart ' ??
?? EJECT ??

  PROCEDURE iop$tape_status_check_ccc_cart (bid_recovery: boolean;
        bid_update: boolean;
        commands_executed: iot$tape_request_length;
        data_transfers: iot$tape_request_length;
        previous_last_good_bid: iot$cartridge_tape_bid;
    VAR p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

    CONST
      disable_unit = FALSE,
      physical_unload = FALSE,
      repeat_count = 1;

    VAR
      device_status: iot$ccc_cart_device_status,
      erasures: 1 .. ioc$tape_max_tape_parity_retry,
      error_id: iot$ccc_cart_error_id,
      i: integer,
      inhibit_recovery_occurred: boolean,
      io_id: iot$io_id,
      logical_unit: iot$logical_unit,
      p_ud: ^iot$tape_job_unit_descriptor,
      pp_response: iot$pp_response,
      rio_id: iot$io_id,
      rio_status: iot$tape_io_status,
      rstatus: ost$status,
      sense_bytes: iot$ccc_cart_sense_bytes;

    status.normal := TRUE;
    inhibit_recovery_occurred := FALSE;

    pp_response := p_tape_request^.pp_response_p^.pp_response;
    logical_unit := p_tape_request^.request.logical_unit;
    p_ud := p_tape_request^.ud;

    device_status := p_tape_request^.pp_response_p^.ccc_cart_device_status;

{ Initialize io_status. Some of the values may be changed as status is analyzed.

    p_tape_request^.io_status.normal_completion := FALSE;
    p_tape_request^.io_status.unit_busy := device_status.busy;
    p_tape_request^.io_status.long_input_block := FALSE;
    p_tape_request^.io_status.position_uncertain := FALSE;
    p_tape_request^.io_status.unit_ready := device_status.ready;
    p_tape_request^.io_status.write_ring := device_status.write_enabled;
    p_tape_request^.io_status.end_of_tape := device_status.end_of_tape;
    p_tape_request^.io_status.beginning_of_tape := device_status.beginning_of_tape;
    p_tape_request^.io_status.unit_density := rmc$38000;

    IF pp_response.abnormal_status.forced_termination OR
          pp_response.abnormal_status.channel_error OR
          pp_response.abnormal_status.data_overrun OR
          pp_response.abnormal_status.recording_medium_error OR
          pp_response.abnormal_status.intervention_required OR
          pp_response.abnormal_status.function_timeout OR
          pp_response.abnormal_status.output_channel_parity THEN

{ Error, since ccc cartridge tape pp driver should never set these conditions.

      iop$tape_pp_error (p_tape_request, status);
      IF device_status.error_id = ioc$ccc_cart_no_pp_eid THEN
        p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_ill_abn_status;
      IFEND;
      iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
      RETURN;
    IFEND;

    IF pp_response.abnormal_status.interface_error THEN
      iop$tape_pp_error (p_tape_request, status);
      iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
      RETURN;
    IFEND;

    IF device_status.error_id = ioc$ccc_cart_no_pp_eid THEN { PP did not diagnose error
      p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_indeterminate;

      IF NOT pp_response.abnormal_status.hardware_malfunction THEN  {must be alert condition only

        IF pp_response.abnormal_status.abnormal_alert THEN
          IF pp_response.alert_conditions.logical_delimiter THEN
            p_tape_request^.io_status.completion_code := ioc$tapemark_read;

          ELSEIF pp_response.alert_conditions.physical_delimiter THEN

{ End of tape has been encountered.  Increment
{ blocks_accessed to indicate block is written to tape.

            p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + 1;
            p_tape_request^.io_status.end_of_tape := TRUE;
            p_tape_request^.io_status.normal_completion := TRUE;

          ELSEIF pp_response.alert_conditions.long_input_block THEN
            p_tape_request^.io_status.long_input_block := TRUE;
            p_tape_request^.io_status.completion_code := ioc$alert_condition_encountered;

          ELSE {no alert condition set
            p_tape_request^.io_status.completion_code := ioc$system_software_failure;
            p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_no_alert;
            iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
            RETURN;
          IFEND;

          IF NOT bid_recovery AND (p_ud^.tape_error_log_entry = TRUE) THEN
            iop$tape_error_logging_ccc_cart (p_tape_request, ioc$recovered, status);
            p_ud^.tape_error_log_entry := FALSE;
          IFEND;

          RETURN; {<----------

        ELSE { software error, no bits set in abnormal_status
          p_tape_request^.io_status.completion_code := ioc$system_software_failure;
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_no_abn_status;
          iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
          RETURN;
        IFEND;

      ELSE {hardware malfunction is set

{ If a hardware or media error occurred and no successful tape motion was done and
{ error_block_forespace_count is not zero, it means that successive error blocks have
{ occurred.  In this case, the last_good_block_id must be reset to what is was prior
{ to the request.  This is done since locate_block to an error block cannot be done.

        IF NOT bid_recovery AND (p_ud^.error_block_forespace_count <> 0) THEN
          IF data_transfers = 0 THEN
            CASE p_tape_request^.request_type OF

            = ioc$tape_read, ioc$tape_forspace, ioc$skip_tapemark_forward, ioc$tape_write,
              ioc$tape_write_tapemark, ioc$tape_backspace, ioc$skip_tapemark_backward =

                p_ud^.cartridge_tape_last_good_bid := previous_last_good_bid;

            ELSE
            CASEND;

          ELSE

            IF (p_tape_request^.request_type = ioc$tape_backspace) THEN
              IF data_transfers < p_ud^.error_block_forespace_count THEN
                p_ud^.cartridge_tape_last_good_bid := previous_last_good_bid;
                p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count - data_transfers;
              ELSE
                p_ud^.error_block_forespace_count := 0;
              IFEND;
            ELSE
              p_ud^.error_block_forespace_count := 0;
            IFEND;
          IFEND;
        IFEND;

{ Handle conditions that do not require logging or recovery.

        IF ((device_status.error_code = 4) OR (device_status.error_code = 5)) AND
              ((p_tape_request^.request_type = ioc$tape_get_status) OR
              (p_tape_request^.request_type = ioc$tape_unload)) THEN
          p_tape_request^.io_status.unit_ready := FALSE;
          p_tape_request^.io_status.normal_completion := TRUE;
          IF p_ud^.tape_error_log_entry THEN { log as recovered
            iop$tape_error_logging_ccc_cart (p_tape_request, ioc$recovered, status);
          IFEND;
          RETURN;
        IFEND;

        IF device_status.error_code = 30(8) THEN
          p_tape_request^.io_status.beginning_of_tape := TRUE;
          p_tape_request^.io_status.completion_code := ioc$load_point;
          p_ud^.cartridge_tape_last_good_bid := zero_ccc_cart_bid;
          p_ud^.error_block_forespace_count := 0;
          RETURN;
        IFEND;

        IF device_status.error_code = 3 THEN
          IF (p_tape_request^.request_type = ioc$tape_write) OR (p_tape_request^.request_type =
                ioc$tape_write_tapemark) OR (p_tape_request^.request_type = ioc$tape_erase) THEN
            p_tape_request^.io_status.completion_code := ioc$write_past_phys_eot;
          ELSE
            p_tape_request^.io_status.completion_code := ioc$read_past_phys_eot;
          IFEND;
          RETURN;
        IFEND;

        IF device_status.error_code = 10(8) THEN
          p_tape_request^.io_status.completion_code := ioc$blank_tape;
          RETURN;
        IFEND;

        IF device_status.error_code = 6 THEN
          p_tape_request^.io_status.completion_code := ioc$no_write_ring;
          RETURN;
        IFEND;

        IF device_status.error_code = 32(8) THEN
          IF (p_tape_request^.request_type = ioc$tape_rewind) OR
                (p_tape_request^.request_type = ioc$tape_get_status) THEN
            p_tape_request^.io_status.normal_completion := TRUE;
            p_tape_request^.io_status.unit_ready := TRUE;
            p_tape_request^.io_status.unit_busy := TRUE;
            RETURN;
          IFEND;
        IFEND;

{ Conditions starting here require logging and most require retry.
{ The purpose of the following code (up to error logging) is to determine
{ and set error_id in ccc_cart_device_status.

      /determine_error_id/
        BEGIN

        IF device_status.error_code = 1 THEN
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
          EXIT /determine_error_id/;
        ELSEIF (device_status.error_code = 4) OR (device_status.error_code = 5) THEN
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_not_ready;
          EXIT /determine_error_id/;
        ELSEIF device_status.error_code = 7 THEN
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_read_id_mark;
          EXIT /determine_error_id/;
        ELSEIF device_status.error_code = 12(8) THEN
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_write_id_mark;
          EXIT /determine_error_id/;
        ELSEIF (device_status.error_code = 32(8)) OR (device_status.error_code = 33(8)) THEN
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
          EXIT /determine_error_id/;
        IFEND;

        IF device_status.adapter_check THEN
          IF device_status.error_code = 172(8) THEN
            p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_output_chan_par;
          ELSE
            p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_coupler_failure;
          IFEND;
          EXIT /determine_error_id/;
        IFEND;

        IF device_status.unit_check THEN  { If get this far, unit_check SHOULD be set
          sense_bytes := p_tape_request^.pp_response_p^.ccc_cart_sense_bytes;
          IF sense_bytes.erpa_code <> 0 THEN  { ERPA code in sense bytes SHOULD be set
            IF sense_bytes.erpa_code = 21(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_coupler_failure;
            ELSEIF sense_bytes.erpa_code = 22(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 23(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_tape_medium;
            ELSEIF sense_bytes.erpa_code = 24(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 25(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_tape_medium;
            ELSEIF sense_bytes.erpa_code = 26(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_tape_medium;
            ELSEIF sense_bytes.erpa_code = 27(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_coupler_failure;
            ELSEIF sense_bytes.erpa_code = 2c(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 2d(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
            ELSEIF sense_bytes.erpa_code = 32(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
            ELSEIF sense_bytes.erpa_code = 33(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
            ELSEIF sense_bytes.erpa_code = 34(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
            ELSEIF sense_bytes.erpa_code = 35(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
            ELSEIF sense_bytes.erpa_code = 36(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 37(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_tape_medium;
            ELSEIF sense_bytes.erpa_code = 3a(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_not_ready;
            ELSEIF sense_bytes.erpa_code = 3b(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_not_ready;
            ELSEIF sense_bytes.erpa_code = 40(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_coupler_failure;
            ELSEIF sense_bytes.erpa_code = 41(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_invalid_bid;
            ELSEIF sense_bytes.erpa_code = 42(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 43(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_not_ready;
            ELSEIF sense_bytes.erpa_code = 44(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_invalid_bid;
            ELSEIF sense_bytes.erpa_code = 45(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 47(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 49(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_output_chan_par;
            ELSEIF sense_bytes.erpa_code = 4a(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            ELSEIF sense_bytes.erpa_code = 4b(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_unit_failure;
            ELSEIF sense_bytes.erpa_code = 4c(16) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_cu_failure;
            IFEND;

          IFEND; { erpa_code <> 0
        IFEND; { device_status.unit_check

        END /determine_error_id/;

      IFEND; { hardware_malfunction check

    IFEND; { error_id = ioc$ccc_cart_no_pp_eid

    IF p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id = ioc$ccc_cart_indeterminate_par THEN
      IF pp_response.response_length > ioc$min_ccc_cart_resp_size THEN
        IF p_tape_request^.pp_response_p^.ccc_cart_sense_bytes.erpa_code = 49(16) THEN
          p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_iou_parity;
        IFEND;
      IFEND;
    IFEND;

{ Log the error in the engineering log.
{ Error_id in p_tape_requests should not be ioc$ccc_cart_indeterminate.  IF it is
{ there is some condition that should be covered in the above /determine_error_id/ block.


    error_id := p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id;

{ Check whether a log entry is outstanding.  Do not log errors if in recovery.

    IF NOT bid_recovery THEN
      IF NOT p_ud^.tape_error_log_entry THEN
        IF (error_id = ioc$ccc_cart_unit_not_ready) OR
              (error_id = ioc$ccc_cart_unit_failure) OR
              (error_id = ioc$ccc_cart_write_id_mark) OR
              (error_id = ioc$ccc_cart_read_id_mark) OR
              (error_id = ioc$ccc_cart_invalid_bid) THEN
          iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          iop$tape_error_logging_ccc_cart (p_tape_request, ioc$intermediate, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{ Set tape_error_log_entry to TRUE and save the block number for the block_in_error.

          p_ud^.tape_error_log_entry := TRUE;
          p_ud^.block_in_error := p_tape_request^.blocks_accessed;
        IFEND;

      ELSE
        IF p_tape_request^.blocks_accessed <> p_ud^.block_in_error THEN

{ Finalize the outstanding error log entry, which has been recovered.

          iop$tape_error_logging_ccc_cart (p_tape_request, ioc$recovered, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{ Clear the retry counters before attempting to recover the next failure.

          p_tape_request^.parity_retry_count := 0;
          p_tape_request^.misc_retry_count := 0;
          p_tape_request^.busy_retry_count := 0;

{ Make an initial log entry for the next failure.

          IF (error_id = ioc$ccc_cart_unit_not_ready) OR
                (error_id = ioc$ccc_cart_unit_failure) OR
                (error_id = ioc$ccc_cart_write_id_mark) OR
                (error_id = ioc$ccc_cart_read_id_mark) OR
                (error_id = ioc$ccc_cart_invalid_bid) THEN
            iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          ELSE
            iop$tape_error_logging_ccc_cart (p_tape_request, ioc$intermediate, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

{ Save the block_in _error, tape_error_log_entry is already set to TRUE.

            p_ud^.block_in_error := p_tape_request^.blocks_accessed;
          IFEND;

        IFEND;
      IFEND;
    IFEND;  { bid_recovery check

{ Attempt retry based on what type of error condition was encountered.
{ Some errors are not retried here because the CU has already attempted recovery.

    CASE error_id OF

    = ioc$ccc_cart_unit_not_ready, ioc$ccc_cart_unit_failure =
      p_tape_request^.io_status.completion_code := ioc$unit_failure;

    = ioc$ccc_cart_write_id_mark, ioc$ccc_cart_read_id_mark =
      IF error_id = ioc$ccc_cart_write_id_mark THEN
        p_tape_request^.io_status.completion_code := ioc$unable_to_write_id_burst;
      ELSE
        p_tape_request^.io_status.completion_code := ioc$unable_to_set_agc;
      IFEND;

{ Currently do not retry erpa codes 41(16) and 44(16).  If the operation was not
{ a read, write or forespace, return ioc$indeterminate along with position_uncertain
{ in io_status.  If the operation is a read, write or forespace attempt to locate
{ to last good block and perform 1 forespace.  If this is successful, return
{ tape_medium_failure, else return ioc$indeterminate.

    = ioc$ccc_cart_invalid_bid =

      IF NOT bid_recovery AND ((p_tape_request^.request_type = ioc$tape_read) OR
            (p_tape_request^.request_type = ioc$tape_write) OR
            (p_tape_request^.request_type = ioc$tape_forspace)) THEN
        p_ud^.cartridge_tape_last_good_bid.logical_position :=
              p_ud^.cartridge_tape_last_good_bid.logical_position + data_transfers;
        p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count + 1;
        iop$locate_block (logical_unit, p_ud^.cartridge_tape_last_good_bid, {bid_recovery} TRUE,
              0, ioc$lbg_plus_count, rio_status, rstatus);
        IF NOT rstatus.normal OR (NOT rio_status.normal_completion AND (rio_status.completion_code <>
              ioc$tapemark_read)) THEN
          p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count - 1;
          p_tape_request^.io_status.position_uncertain := TRUE;
          p_tape_request^.io_status.completion_code := ioc$indeterminate;
        ELSE

{ Reposition was successful, return tape medium failure.

          p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;
          p_tape_request^.io_status.position_uncertain := TRUE;
        IFEND;

      ELSE
        p_tape_request^.io_status.completion_code := ioc$indeterminate;
        p_tape_request^.io_status.position_uncertain := TRUE;
      IFEND;

    = ioc$ccc_cart_tape_medium =

    /tape_parity_error_loop/
      BEGIN

        IF p_tape_request^.inhibit_error_recovery AND NOT bid_recovery THEN
          IF p_tape_request^.request_type = ioc$tape_write THEN
            p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + 1;
          IFEND;
          inhibit_recovery_occurred := TRUE;
          p_tape_request^.io_status.io_complete := TRUE;
          p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;

{ If unrecovered medium error and inhibit error recovery = TRUE, attempt
{ to position after the bad block by first positioning to last good block and then performing a
{ forespace. The forespace count if incremented first to account for the bad block.

          p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count + 1;
          iop$locate_block (logical_unit, p_ud^.cartridge_tape_last_good_bid, {bid_recovery} TRUE,
                0, ioc$lbg_plus_count, rio_status, rstatus);
          IF NOT rstatus.normal OR (NOT rio_status.normal_completion AND (rio_status.completion_code <>
                ioc$tapemark_read)) THEN
            p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count - 1;
            p_tape_request^.io_status.position_uncertain := TRUE;
          IFEND;

          EXIT /tape_parity_error_loop/
        IFEND;

        IF p_tape_request^.pp_response_p^.ccc_cart_sense_bytes.drive_in_sync_mode THEN { attempt recovery
          IF p_tape_request^.parity_retry_count < ioc$tape_max_tape_parity_retry THEN
            p_tape_request^.parity_retry_count := p_tape_request^.parity_retry_count + 1;
            CASE p_tape_request^.request_type OF
            = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark, ioc$tape_forspace,
              ioc$tape_backspace, ioc$locate_block =

              iop$locate_block (logical_unit, p_ud^.cartridge_tape_last_good_bid, {bid_recovery} TRUE,
                    0, ioc$lbg_plus_count, rio_status, status);

            ELSE

              p_tape_request^.io_status.completion_code := ioc$unit_failure;
              EXIT /tape_parity_error_loop/

            CASEND;

            IF NOT status.normal THEN
              RETURN;
            IFEND;

            IF rio_status.io_complete AND
                  NOT rio_status.normal_completion AND
                  NOT (rio_status.completion_code = ioc$tapemark_read) THEN

{ Reposition failed.
{ Exit with io_status returned from reposition.

              p_tape_request^.io_status := rio_status;
              EXIT /tape_parity_error_loop/
            ELSE
              IF (p_tape_request^.request_type = ioc$tape_write) OR
                    (p_tape_request^.request_type = ioc$tape_write_tapemark) THEN

                erasures := p_tape_request^.parity_retry_count;

                FOR i := 1 TO erasures DO
                  iop$67x_non_data_trans_setup (logical_unit, ioc$tape_erase, repeat_count,
                        disable_unit, physical_unload, rio_id, rstatus);
                  IF NOT rstatus.normal THEN

{ Set position_uncertain to TRUE.

                    p_tape_request^.io_status.position_uncertain := TRUE;
                    p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;

                    EXIT /tape_parity_error_loop/;
                  ELSE
                    iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} TRUE,
                          {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);
                    IF (NOT rstatus.normal) OR (NOT rio_status.normal_completion) THEN

{ Set position_uncertain to TRUE.

                      rio_status.position_uncertain := TRUE;
                      p_tape_request^.io_status := rio_status;
                      p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;

                      EXIT /tape_parity_error_loop/;
                    IFEND;
                  IFEND;
                FOREND;
              IFEND;
            IFEND;
            iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

            EXIT /tape_parity_error_loop/;

          IFEND;

        IFEND;

        p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;

{ If unrecovered medium error and the operation is a read or forspace, attempt
{ to position after the bad block by first positioning to last good block and then performing an
{ additional forespace.  The forespace count is incremented to account for the bad block.

        IF ((p_tape_request^.request_type = ioc$tape_read) OR
              (p_tape_request^.request_type = ioc$tape_forspace)) AND
              (NOT p_tape_request^.io_status.position_uncertain) AND
              (NOT bid_recovery) THEN

          p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count + 1;
          iop$locate_block (logical_unit, p_ud^.cartridge_tape_last_good_bid, {bid_recovery} TRUE,
                0, ioc$lbg_plus_count, rio_status, rstatus);
          IF NOT rstatus.normal OR (NOT rio_status.normal_completion AND (rio_status.completion_code <>
                ioc$tapemark_read)) THEN
            p_ud^.error_block_forespace_count := p_ud^.error_block_forespace_count - 1;
            p_tape_request^.io_status.position_uncertain := TRUE;
            EXIT /tape_parity_error_loop/;
          IFEND;

        IFEND;

      END /tape_parity_error_loop/;

    ELSE

{ Retry all other errors three times.

    /misc_retry_block_1/
      BEGIN

        IF p_tape_request^.misc_retry_count < ioc$tape_max_misc_retry THEN
          p_tape_request^.misc_retry_count := p_tape_request^.misc_retry_count + 1;

          IF (device_status.error_code = 79(16)) AND
                (pp_response.response_length > ioc$min_ccc_cart_resp_size) AND
                (p_tape_request^.pp_response_p^.ccc_cart_sense_bytes.fips_di_status = 180(16)) THEN
            p_tape_request^.ccc_cart_buf_underrun_recovery := TRUE;
          IFEND;

        /misc_retry_block_2/
          BEGIN

            CASE p_tape_request^.request_type OF
            = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark, ioc$tape_backspace,
              ioc$tape_forspace =

              iop$locate_block (logical_unit, p_ud^.cartridge_tape_last_good_bid, {bid_recovery} TRUE,
                    0, ioc$lbg_plus_count, rio_status, status);

            = ioc$tape_rewind, ioc$tape_get_status, ioc$locate_block, ioc$tape_unload =

{ Retry the operation without repositioning first.  Only retry ioc$tape_get_status once, since
{ it is most likely the scanner.

              IF (p_tape_request^.request_type = ioc$tape_get_status) AND (p_tape_request^.
                    misc_retry_count > 1) THEN
                EXIT /misc_retry_block_1/;
              ELSE
                rio_status.io_complete := TRUE;
                rio_status.normal_completion := TRUE;
              IFEND;

            ELSE

              EXIT /misc_retry_block_2/;

            CASEND;
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            IF (rio_status.io_complete) AND
                  NOT (rio_status.normal_completion) AND
                  NOT (rio_status.completion_code = ioc$tapemark_read) THEN

{ Reposition failed.
{ Exit with io_status returned from reposition.

              p_tape_request^.io_status := rio_status;
              EXIT /misc_retry_block_1/;
            IFEND;

            iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

            EXIT /misc_retry_block_1/;

          END /misc_retry_block_2/;

        IFEND;

        IF error_id = ioc$ccc_cart_indeterminate THEN
          p_tape_request^.io_status.completion_code := ioc$indeterminate;
        ELSEIF error_id = ioc$ccc_cart_input_chan_parity THEN
          p_tape_request^.io_status.completion_code := ioc$input_channel_parity;
        ELSEIF error_id = ioc$ccc_cart_output_chan_par THEN
          p_tape_request^.io_status.completion_code := ioc$output_channel_parity;
        ELSEIF (error_id = ioc$ccc_cart_coupler_failure) OR
              (error_id = ioc$ccc_cart_cu_failure) OR
              (error_id = ioc$ccc_cart_inc_trans_in) OR
              (error_id = ioc$ccc_cart_inc_trans_out) OR
              (error_id = ioc$ccc_cart_pp_chan_flag) THEN
          p_tape_request^.io_status.completion_code := ioc$controller_failure;
        ELSEIF error_id = ioc$ccc_cart_function_timeout THEN
          p_tape_request^.io_status.completion_code := ioc$function_timeout;
        ELSEIF error_id = ioc$ccc_cart_iou_parity THEN
          p_tape_request^.io_status.completion_code := ioc$iou_output_parity;
        ELSEIF error_id = ioc$ccc_cart_indeterminate_par THEN
          p_tape_request^.io_status.completion_code := ioc$indeterminate_output_parity;
        ELSE
          p_tape_request^.io_status.completion_code := ioc$indeterminate;
        IFEND;

      END /misc_retry_block_1/;

    CASEND;

    IF (NOT p_tape_request^.io_status.normal_completion) AND
          (p_tape_request^.io_status.completion_code <> ioc$tapemark_read) AND
           p_ud^.tape_error_log_entry THEN

      iop$tape_error_logging_ccc_cart (p_tape_request, ioc$unrecovered, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{         Set tape_error_log_entry to FALSE and initialize the block_in_error entry in the
{         unit_descriptor.

      p_ud^.tape_error_log_entry := FALSE;
      p_ud^.block_in_error := -1;

{         Position the tape for a write or write_tapemark operation before the last
{         good block:  only if no position uncertain was encountered.

      IF ((p_tape_request^.request_type = ioc$tape_write) OR
            (p_tape_request^.request_type = ioc$tape_write_tapemark)) AND
            (NOT inhibit_recovery_occurred) AND
            (NOT p_tape_request^.io_status.position_uncertain) THEN

        iop$locate_block (logical_unit, p_ud^.cartridge_tape_last_good_bid, {bid_recovery} TRUE,
              0, ioc$lbg_plus_count, rio_status, rstatus);
        IF rio_status.io_complete AND
              (NOT rio_status.normal_completion) AND NOT
              (rio_status.completion_code = ioc$tapemark_read) THEN

{             Reposition failed.

          p_tape_request^.io_status.position_uncertain := TRUE;

        IFEND;

      IFEND;

    IFEND;

  PROCEND iop$tape_status_check_ccc_cart;
?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_status_check_ipi ' ??
?? EJECT ??

  PROCEDURE iop$tape_status_check_ipi (bid_recovery: boolean;
        bid_update: boolean;
        commands_executed: iot$tape_request_length;
        data_transfers: iot$tape_request_length;
    VAR inhibit_recovery_occurred: boolean;
    VAR p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

    CONST
      disable_unit = FALSE,
      physical_unload = FALSE,
      repeat_count = 1;

    VAR
      ipi_tape_status: iot$ipi_tape_status,
      erasures: 1 .. ioc$tape_max_tape_parity_retry,
      error_id: 0 .. ioc$max_ipi_error_id,
      i: integer,
      logical_unit: iot$logical_unit,
      p_ud: ^iot$tape_job_unit_descriptor,
      pp_response: iot$pp_response,
      response_packet: iot$analyzed_ipi_tape_response,
      rio_id: iot$io_id,
      rio_status: iot$tape_io_status,
      rstatus: ost$status;
??EJECT??
{    The following procedure is used to update the block id window after
{    a backspace or forespace.

      PROCEDURE iop$update_bid_window;

        IF p_tape_request^.request_type = ioc$tape_backspace THEN
          IF p_ud^.bid_index <> LOWERVALUE(iot$bid_index) THEN
            p_ud^.bid_index := p_ud^.bid_index - 1;
          ELSE
            p_ud^.bid_index := UPPERVALUE(iot$bid_index);
          IFEND;
          p_ud^.bid_window [p_ud^.bid_index] := ioc$unavail_bid;
        ELSE
          p_ud^.bid_window [p_ud^.bid_index] := ioc$error_block_bid;
          IF p_ud^.bid_index <> UPPERVALUE(iot$bid_index) THEN
            p_ud^.bid_index := p_ud^.bid_index + 1;
          ELSE
            p_ud^.bid_index := LOWERVALUE(iot$bid_index);
          IFEND;
        IFEND;

      PROCEND iop$update_bid_window;
?? EJECT ??

    status.normal := TRUE;
    inhibit_recovery_occurred := FALSE;

    pp_response := p_tape_request^.pp_response_p^.pp_response;
    logical_unit := p_tape_request^.request.logical_unit;
    p_ud := p_tape_request^.ud;

    ipi_tape_status := p_tape_request^.pp_response_p^.ipi_tape_status;
    iop$analyze_response_packets (^ipi_tape_status, pp_response.response_length, response_packet);

{ Initialize io_status. Some of the values may be changed as status is analyzed.

    p_tape_request^.io_status.normal_completion := FALSE;
    p_tape_request^.io_status.unit_busy := FALSE;
    p_tape_request^.io_status.long_input_block := FALSE;
    p_tape_request^.io_status.position_uncertain := FALSE;
    p_tape_request^.io_status.unit_ready := TRUE;
    IF response_packet.sense_bytes_present THEN
      p_tape_request^.io_status.write_ring := NOT response_packet.sense_bytes.file_protect;
      p_tape_request^.io_status.end_of_tape := response_packet.sense_bytes.end_of_tape;
      p_tape_request^.io_status.beginning_of_tape := response_packet.sense_bytes.beginning_of_tape;
      IF response_packet.sense_bytes.not_1600_bpi THEN
        p_tape_request^.io_status.unit_density := rmc$6250;
        p_ud^.tape_unit_density := 3;
      ELSE  { density is 1600
        p_tape_request^.io_status.unit_density := rmc$1600;
        p_ud^.tape_unit_density := 1;
      IFEND;
    ELSE
      p_tape_request^.io_status.write_ring := FALSE;
      p_tape_request^.io_status.end_of_tape := FALSE;
      p_tape_request^.io_status.beginning_of_tape := FALSE;
    IFEND;

    IF pp_response.abnormal_status.forced_termination OR
          pp_response.abnormal_status.channel_error OR
          pp_response.abnormal_status.data_overrun OR
          pp_response.abnormal_status.recording_medium_error OR
          pp_response.abnormal_status.intervention_required OR
          pp_response.abnormal_status.function_timeout OR
          pp_response.abnormal_status.output_channel_parity THEN

{ Error, since IPI pp driver should never set these conditions.

      iop$tape_pp_error (p_tape_request, status);
      IF ipi_tape_status.error_id = ioc$ipi_indeterminate_error THEN
        p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$illegal_abnormal_status;
      IFEND;
      iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
      RETURN;
    IFEND;

    IF pp_response.abnormal_status.interface_error THEN
      p_tape_request^.io_status.completion_code := ioc$system_software_failure;
      IF ipi_tape_status.error_id = ioc$ipi_indeterminate_error THEN
        p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$interface_error_wo_eid;
      IFEND;
      iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
      RETURN;
    IFEND;

    IF ipi_tape_status.error_id = ioc$ipi_indeterminate_error THEN  { PP did not diagnose error

      IF NOT (ipi_tape_status.major_status.response_type = ioc$standard_command_completion) THEN
        p_tape_request^.io_status.completion_code := ioc$system_software_failure;
        p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$invalid_response_type;
        iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
        RETURN;
      IFEND;

      IF NOT pp_response.abnormal_status.hardware_malfunction THEN  {must be alert condition only

        IF pp_response.abnormal_status.abnormal_alert THEN
          IF pp_response.alert_conditions.logical_delimiter THEN
            p_tape_request^.io_status.completion_code := ioc$tapemark_read;

{ Update the block id window index after a tapemark has been encountered
{ during a backward motion operation. Set the block id to ioc$unavail_bid.

            CASE p_tape_request^.request_type OF
            = ioc$tape_backspace, ioc$tape_read_backwards =
              IF bid_update THEN
                FOR i := 1 TO data_transfers + 1 DO
                  iop$update_bid_window;
                FOREND;
              IFEND;
            ELSE
            CASEND;

          ELSEIF pp_response.alert_conditions.physical_delimiter THEN

{ End of tape has been encountered.  Increment
{ blocks_accessed to indicate block is written to tape.

            p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + 1;
            p_tape_request^.io_status.end_of_tape := TRUE;
            p_tape_request^.io_status.normal_completion := TRUE;

          ELSEIF pp_response.alert_conditions.long_input_block THEN
            p_tape_request^.io_status.long_input_block := TRUE;
            p_tape_request^.io_status.completion_code := ioc$alert_condition_encountered;

          ELSE {no alert condition set
            p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$no_alert_cond_set;
            p_tape_request^.io_status.completion_code := ioc$system_software_failure;
            iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
            RETURN;
          IFEND;

          IF NOT bid_recovery AND (p_ud^.tape_error_log_entry = TRUE) THEN
            iop$tape_error_logging_ipi (p_tape_request, ioc$recovered, status);
            p_ud^.tape_error_log_entry := FALSE;
          IFEND;

          RETURN; {<----------

        ELSE { software error, no bits set in abnormal_status
          p_tape_request^.io_status.completion_code := ioc$system_software_failure;
          p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$no_bits_in_abnormal_status;
          iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
          RETURN;
        IFEND;

      ELSE  {hardware_malfuction is set

{ Handle conditions that do not require logging or recovery.

        IF response_packet.id24_present AND response_packet.id24_byte1.not_ready AND
              ((p_tape_request^.request_type = ioc$tape_get_status) OR
              (p_tape_request^.request_type = ioc$tape_unload)) THEN
          p_tape_request^.io_status.unit_ready := FALSE;
          p_tape_request^.io_status.normal_completion := TRUE;
          RETURN;
        IFEND;

        IF response_packet.id2a_present THEN
          IF response_packet.id2a_byte3.beginning_of_media THEN
            p_tape_request^.io_status.beginning_of_tape := TRUE;
            p_tape_request^.io_status.completion_code := ioc$load_point;

{ Set BID window back to load point.

            p_ud^.bid_index := LOWERVALUE(iot$bid_index) + 1;
            p_ud^.bid_window [LOWERVALUE(iot$bid_index)] := ioc$loadpoint_bid;
            i#fill ($CHAR (ioc$empty_bid), ^p_ud^.bid_window [2],
                  #SIZE (p_ud^.bid_window) - #SIZE (p_ud^.bid_window [1]));
            RETURN;
          IFEND;
          IF response_packet.id2a_byte3.blank_tape THEN
            IF p_tape_request^.request_type = ioc$tape_write THEN

{ There's probably a bad spot on the tape that an ATS drive would normally have detected as a
{ tape medium failure.  Setting the tape status error id to tape_medium_failure forces recovery.

              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$ipi_tape_medium_failure;
            ELSE
              p_tape_request^.io_status.completion_code := ioc$blank_tape;
              RETURN;
            IFEND;
          IFEND;
        IFEND;

        IF response_packet.id26_present THEN
          IF response_packet.id26_byte2.hardware_write_protected THEN
            p_tape_request^.io_status.completion_code := ioc$no_write_ring;
            RETURN;
          IFEND;
          IF response_packet.id26_byte2.fatal_error AND
                response_packet.sense_bytes_present AND
                response_packet.sense_bytes.not_capable_of_density THEN
            p_tape_request^.io_status.completion_code := ioc$not_capable_of_density;
            RETURN;
          IFEND;
        IFEND;

        IF response_packet.id24_present AND response_packet.id24_byte1.addressee_busy THEN

      /busy_loop/
          BEGIN

            IF (p_tape_request^.request_type = ioc$tape_rewind) OR
                  (p_tape_request^.request_type = ioc$tape_get_status) THEN
              p_tape_request^.io_status.normal_completion := TRUE;
              p_tape_request^.io_status.unit_ready := TRUE;
              p_tape_request^.io_status.unit_busy := TRUE;
              EXIT /busy_loop/
            IFEND;
            IF p_tape_request^.busy_retry_count < (ioc$tape_max_busy_retry * 4) THEN
              p_tape_request^.busy_retry_count := p_tape_request^.busy_retry_count + 1;
              pmp$delay (ioc$tape_long_wait DIV 4, status);
              IF NOT status.normal THEN
                EXIT /busy_loop/
              IFEND;
              iop$tape_queue_request_setup (p_tape_request, status);
              IF NOT status.normal THEN
                EXIT /busy_loop/
              ELSE
                logical_unit := p_tape_request^.request.logical_unit;
                rio_id := p_tape_request^.io_id;
                iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} FALSE,
                      bid_recovery, bid_update, osc$wait, rio_status, rstatus);
                p_tape_request^.io_status := rio_status;
                EXIT /busy_loop/
              IFEND;
            IFEND;
            p_tape_request^.io_status.completion_code := ioc$unit_failure;
            p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$drive_res_to_other_cont;
            iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
          END /busy_loop/;

          RETURN;

        IFEND;  { addressee busy check

{
{ Conditions starting here require logging and most require retry.
{ The purpose of the following code (up to error logging) is to determine
{ and set error_id in ipi_tape_status.
{

      /determine_error_id/
        BEGIN

          IF response_packet.id24_present THEN
            IF response_packet.id24_byte1.not_p_available OR
                  response_packet.id24_byte1.not_p_avail_transition THEN
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$drive_not_operational;

            ELSEIF response_packet.id24_byte1.not_ready OR
                  response_packet.id24_byte1.not_ready_transition THEN
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$drive_not_ready;

            ELSE
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$drive_intervention_req;
            IFEND;

            p_tape_request^.io_status.position_uncertain := TRUE;
            p_tape_request^.io_status.unit_ready := FALSE;
            EXIT /determine_error_id/;
          IFEND;

          IF response_packet.id26_present THEN

            IF response_packet.id26_byte1.physical_interface_check THEN
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$physical_interface_check;
              EXIT /determine_error_id/;
            IFEND;

            IF response_packet.id26_byte1.operation_timeout THEN
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$operation_timeout;
              EXIT /determine_error_id/;
            IFEND;

            IF response_packet.id26_byte4.position_lost THEN
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$position_lost;
              EXIT /determine_error_id/;
            IFEND;

            IF response_packet.id26_byte2.data_check OR response_packet.id26_byte2.fatal_error THEN
              IF (p_tape_request^.request_type = ioc$tape_write) OR
                    (p_tape_request^.request_type = ioc$tape_write_tapemark) THEN
                IF response_packet.sense_bytes_present AND response_packet.sense_bytes.id_burst_check THEN
                  p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$ipi_id_burst_error;
                  EXIT /determine_error_id/;
                IFEND;
              IFEND;
              IF response_packet.sense_bytes_present AND response_packet.sense_bytes.control_burst_check THEN
                p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$ipi_unable_to_set_agc;
                EXIT /determine_error_id/;
              IFEND;
              IF response_packet.id26_byte2.data_check THEN
                p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$ipi_tape_medium_failure;
              ELSEIF (response_packet.sense_bytes_present) AND (response_packet.sense_bytes.data_check) THEN
                IF (p_ud^.block_count = 0) AND ((p_tape_request^.request_type = ioc$tape_read) OR
                      (p_tape_request^.request_type = ioc$tape_forspace)) THEN
                  p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$ipi_unable_to_set_agc;
                ELSE
                  p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$ipi_tape_medium_failure;
                IFEND;
              ELSE  { fatal_error
                p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$fatal_error;
              IFEND;
              EXIT /determine_error_id/;
            IFEND;

{ IF id26 is present and an error has not been found yet, set ioc$drive_machine_exception.

            p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$drive_machine_exception;
            EXIT /determine_error_id/;

          IFEND;  { id26_present

          IF response_packet.id2a_present THEN
            IF response_packet.id2a_byte3.block_length_difference OR
                  response_packet.id2a_byte3.data_length_difference THEN
              p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$data_length_difference;
              EXIT /determine_error_id/;
            IFEND;
          IFEND;  { id2a present

          IF response_packet.id29_present OR response_packet.id19_present THEN
            p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$drive_conditional_success;
            EXIT /determine_error_id/;
          IFEND;  { id29_present

        END /determine_error_id/;

      IFEND;  {hardware_malfunction check

    IFEND;  { error_id = ioc$ipi_indeterminate_error

    error_id := p_tape_request^.pp_response_p^.ipi_tape_status.error_id;

{
{ Log the error in the engineering log.
{ Error_id in p_tape_requests should be non-zero.  IF it isn't, there
{ is some condition that should be covered in the above IF statement
{

{ Check whether a log entry is outstanding.  Do not log errors if in recovery.

    IF NOT bid_recovery THEN
      IF NOT p_ud^.tape_error_log_entry THEN
        IF (error_id = ioc$drive_not_operational) OR (error_id = ioc$drive_not_ready) OR
              (error_id = ioc$master_slave_data_integrity) OR
              (error_id = ioc$slave_fac_data_integrity) OR
              (error_id = ioc$pp_detect_software_failure) THEN
          iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          iop$tape_error_logging_ipi (p_tape_request, ioc$intermediate, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{ Set tape_error_log_entry to TRUE and save the block number for the block_in_error.

          p_ud^.tape_error_log_entry := TRUE;
          p_ud^.block_in_error := p_tape_request^.blocks_accessed;
        IFEND;

      ELSE
        IF p_tape_request^.blocks_accessed <> p_ud^.block_in_error THEN

{ Finalize the outstanding error log entry, which has been recovered.

          iop$tape_error_logging_ipi (p_tape_request, ioc$recovered, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{ Clear the retry counters before attempting to recover the next failure.

          p_tape_request^.parity_retry_count := 0;
          p_tape_request^.busy_retry_count := 0;
          p_tape_request^.misc_retry_count := 0;
          p_tape_request^.ipi_retry_count := 0;

{ Make an initial log entry for the next failure.

          IF (error_id = ioc$drive_not_operational) OR (error_id = ioc$drive_not_ready) OR
                (error_id = ioc$master_slave_data_integrity) OR
                (error_id = ioc$slave_fac_data_integrity) OR
                (error_id = ioc$pp_detect_software_failure) THEN
            iop$tape_error_logging_ipi (p_tape_request, ioc$unrecovered, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          ELSE
            iop$tape_error_logging_ipi (p_tape_request, ioc$intermediate, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

{ Save the block_in _error, tape_error_log_entry is already set to TRUE.

            p_ud^.block_in_error := p_tape_request^.blocks_accessed;
          IFEND;

        IFEND;
      IFEND;
    IFEND;  { bid_recovery check

{ Attempt retry based on what type of error condition was encountered.

    CASE error_id OF

{ Retry error_id of 0 - 40, 70 - 79, 82 - 88, 90 and 91 six times.

    = ioc$ipi_indeterminate_error .. ioc$slave_encoded_end_status,
            ioc$internal_controller_error .. ioc$unexpected_class_2,
            ioc$drive_intervention_req .. ioc$position_lost,
            ioc$no_end_of_extent, ioc$data_length_difference =

      IF p_tape_request^.ipi_retry_count < ioc$max_ipi_retry THEN
        p_tape_request^.ipi_retry_count := p_tape_request^.ipi_retry_count + 1;
        IF commands_executed > 0 THEN
          CASE p_tape_request^.request_type OF
          = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
            iop$tape_reposition_b (p_tape_request, status);
          = ioc$tape_forspace =
            IF bid_update THEN
              iop$tape_reposition_b (p_tape_request, status);
            ELSE
              iop$update_bid_window;
              p_tape_request^.io_status.io_complete := TRUE;
              p_tape_request^.io_status.normal_completion := TRUE;
              RETURN;
            IFEND;
          = ioc$tape_read_backwards, ioc$tape_backspace =
            IF bid_update THEN
              FOR i := 1 TO data_transfers + 1 DO
                iop$update_bid_window;
              FOREND;
            IFEND;
            IF NOT bid_recovery THEN
              iop$tape_reposition_f (p_tape_request, status);
            ELSE
              p_tape_request^.io_status.io_complete := TRUE;
              p_tape_request^.io_status.normal_completion := TRUE;
              RETURN;
            IFEND;
          ELSE
            IF error_id = ioc$ipi_indeterminate_error THEN
              p_tape_request^.io_status.completion_code := ioc$indeterminate;
            ELSEIF (error_id <= ioc$unexpected_class_2) THEN
              IF (error_id = ioc$upper_ici_parity) OR (error_id = ioc$lower_ici_parity) OR
                    (error_id = ioc$upper_ipi_chan_parity) OR (error_id = ioc$lower_ipi_chan_parity) OR
                    (error_id = ioc$bus_parity) THEN
                p_tape_request^.io_status.completion_code := ioc$input_channel_parity;
              ELSE
                p_tape_request^.io_status.completion_code := ioc$controller_failure;
              IFEND;
            ELSE
              p_tape_request^.io_status.completion_code := ioc$unit_failure;
            IFEND;
            RETURN;
          CASEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF (p_tape_request^.io_status.io_complete) AND
                NOT (p_tape_request^.io_status.normal_completion) AND
                NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{ Reposition failed.
{ Exit with io_status returned from reposition.
            RETURN;
          IFEND;

{ If commands_executed = 0, only retry a rewind or unload operation two times if
{ the error is ioc$can_not_select_controller or ioc$no_controller_interrupt, since
{ this is most likely a non-existant or broken slave.

        ELSEIF ((p_tape_request^.request_type = ioc$tape_get_status) OR
              (p_tape_request^.request_type = ioc$tape_rewind) OR
              (p_tape_request^.request_type = ioc$tape_unload)) AND
              ((error_id = ioc$can_not_select_controller) OR
              (error_id = ioc$no_controller_interrupt)) AND
              (p_tape_request^.ipi_retry_count > 2) THEN
          p_tape_request^.ipi_retry_count := 2;
          p_tape_request^.io_status.completion_code := ioc$controller_failure;
          RETURN;
        IFEND;

        iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

        RETURN;
      IFEND;

      IF error_id = ioc$ipi_indeterminate_error THEN
        p_tape_request^.io_status.completion_code := ioc$indeterminate;
      ELSEIF (error_id <= ioc$unexpected_class_2) THEN
        IF (error_id = ioc$upper_ici_parity) OR (error_id = ioc$lower_ici_parity) OR
              (error_id = ioc$upper_ipi_chan_parity) OR (error_id = ioc$lower_ipi_chan_parity) OR
              (error_id = ioc$bus_parity) THEN
          IF (p_tape_request^.request_type = ioc$tape_write) OR
                (p_tape_request^.request_type = ioc$tape_write_tapemark) THEN
            p_tape_request^.io_status.completion_code := ioc$output_channel_parity;
          ELSE
            p_tape_request^.io_status.completion_code := ioc$input_channel_parity;
          IFEND;
        ELSE
          p_tape_request^.io_status.completion_code := ioc$controller_failure;
        IFEND;
      ELSE
        p_tape_request^.io_status.completion_code := ioc$unit_failure;
      IFEND;

    = ioc$drive_not_operational, ioc$drive_not_ready =
      p_tape_request^.io_status.completion_code := ioc$unit_failure;
      RETURN;  { no retry on not ready

    = ioc$ipi_tape_medium_failure =

  /tape_parity_error_loop/
      BEGIN

        IF p_tape_request^.inhibit_error_recovery AND NOT bid_recovery THEN
          IF p_tape_request^.request_type = ioc$tape_write THEN
            p_tape_request^.blocks_accessed := p_tape_request^.blocks_accessed + 1;
          IFEND;
          inhibit_recovery_occurred := TRUE;
          p_tape_request^.io_status.io_complete := TRUE;
          p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;
          iop$update_bid_window;
          EXIT /tape_parity_error_loop/
        IFEND;

      /tape_parity_error_loop_2/
        BEGIN
          IF p_tape_request^.parity_retry_count < ioc$tape_max_tape_parity_retry THEN
            p_tape_request^.parity_retry_count := p_tape_request^.parity_retry_count + 1;
            CASE p_tape_request^.request_type OF
            = ioc$tape_read, ioc$tape_write, ioc$tape_write_tapemark =
              iop$tape_reposition_b (p_tape_request, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF p_tape_request^.io_status.completion_code = ioc$load_point THEN
                p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;
                EXIT /tape_parity_error_loop/;
              IFEND;
            = ioc$tape_forspace =
              IF bid_update THEN
                iop$tape_reposition_b (p_tape_request, status);
              ELSE
                iop$update_bid_window;
                p_tape_request^.io_status.io_complete := TRUE;
                p_tape_request^.io_status.normal_completion := TRUE;
                EXIT /tape_parity_error_loop/
              IFEND;

{ The following case selection presently resolves some recovery problems
{ when parity error is received while backspacing in BID_RECOVERY mode.
{ We accept backspace errors during BID_RECOVERY because we will check the
{ BID windows and correct for mispositioning.
{ When not in recovery we accept backspaces if only a parity error status is
{ present and not status bits to indicate possible mispositioning.

            = ioc$tape_backspace, ioc$tape_read_backwards =
              IF bid_update THEN
                FOR i := 1 TO data_transfers + 1 DO
                  iop$update_bid_window;
                FOREND;
              IFEND;
              IF (response_packet.sense_bytes_present) AND (response_packet.sense_bytes.partial_record OR
                    response_packet.sense_bytes.postamble_error) AND NOT (bid_recovery) THEN
                iop$tape_reposition_f (p_tape_request, status);
              ELSE
                p_tape_request^.io_status.normal_completion := TRUE;
                p_tape_request^.io_status.io_complete := TRUE;
                IF (p_tape_request^.no_of_non_data_commands = 1) OR
                      (commands_executed = p_tape_request^.no_of_non_data_commands) THEN

{ Do not attempt iop$tape_retry_io if the number of original backspaces has been completed.

                  EXIT /tape_parity_error_loop/;
                ELSE

{ Decrement number of original commands by 1 to account for the block which encountered the parity
{ error.  iop$tape_retry_io must be called to complete the original number of backspaces.

                  p_tape_request^.no_of_non_data_commands := p_tape_request^.no_of_non_data_commands - 1;
                IFEND;
              IFEND;
            = ioc$tape_erase =
              IF response_packet.sense_bytes_present AND response_packet.sense_bytes.head_failure THEN
                p_tape_request^.io_status.completion_code := ioc$unit_failure;
              ELSE
                p_tape_request^.io_status.normal_completion := TRUE;
              IFEND;
              EXIT /tape_parity_error_loop/
            ELSE
              p_tape_request^.io_status.completion_code := ioc$unit_failure;
              EXIT /tape_parity_error_loop/
            CASEND;
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            IF p_tape_request^.io_status.io_complete AND
                  NOT p_tape_request^.io_status.normal_completion AND
                  NOT (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN

{ Reposition failed.
{ Exit with io_status returned from reposition.

                   EXIT /tape_parity_error_loop/
            ELSE
              IF (p_tape_request^.request_type = ioc$tape_write) OR
                    (p_tape_request^.request_type = ioc$tape_write_tapemark) THEN

                erasures := p_tape_request^.parity_retry_count;

                FOR i := 1 TO erasures DO
                  logical_unit := p_tape_request^.request.logical_unit;
                  iop$67x_non_data_trans_setup (logical_unit, ioc$tape_erase, repeat_count,
                        disable_unit, physical_unload, rio_id, rstatus);
                  IF NOT rstatus.normal THEN

{ Set position_uncertain to TRUE.

                    p_tape_request^.io_status.position_uncertain := TRUE;

                    EXIT /tape_parity_error_loop_2/
                  ELSE
                    iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} TRUE,
                          {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);
                    IF (NOT rstatus.normal) OR (NOT rio_status.normal_completion) THEN

{ Set position_uncertain to TRUE.

                      rio_status.position_uncertain := TRUE;
                      p_tape_request^.io_status := rio_status;

                      EXIT /tape_parity_error_loop_2/
                    IFEND;
                  IFEND;
                FOREND;
              IFEND;
            IFEND;
            iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

            EXIT /tape_parity_error_loop/;
          IFEND;
        END /tape_parity_error_loop_2/;

        IF (p_tape_request^.request_type = ioc$tape_read) OR
              (p_tape_request^.request_type = ioc$tape_forspace) THEN
          iop$update_bid_window;
        IFEND;
        p_tape_request^.io_status.completion_code := ioc$tape_medium_failure;
      END /tape_parity_error_loop/;

    = ioc$ipi_id_burst_error, ioc$ipi_unable_to_set_agc =

    /bad_id_burst_recovery_loop/
      BEGIN
        IF p_tape_request^.misc_retry_count < ioc$tape_max_misc_retry THEN
              p_tape_request^.misc_retry_count := p_tape_request^.misc_retry_count + 1;
        rstatus.normal := TRUE;
        iop$67x_non_data_trans_setup (logical_unit, ioc$tape_rewind, repeat_count,
              disable_unit, physical_unload, rio_id, rstatus);
          IF NOT rstatus.normal THEN
            EXIT /bad_id_burst_recovery_loop/
          ELSE
            iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} TRUE,
                  {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);
            IF (NOT rstatus.normal) OR (NOT rio_status.normal_completion) THEN
              p_tape_request^.io_status := rio_status;
              EXIT /bad_id_burst_recovery_loop/
            IFEND;
          IFEND;
          iop$tape_retry_io (p_tape_request, bid_recovery, bid_update, status);

{ Exit with io_status returned from retrying the io operation.

          RETURN;
        IFEND;
      END /bad_id_burst_recovery_loop/;

{ Allow ioc$ipi_unable_to_set_agc if neither equipment_check or data_check are set
{ in the sense bytes and no write ring is in the tape.  The tape is readable, but
{ extending the file by writing will not be allowed since the tape unit AGC is not
{ set correctly in all tracks.

      IF (error_id = ioc$ipi_unable_to_set_agc) AND (NOT response_packet.sense_bytes.data_check) AND
            (NOT response_packet.sense_bytes.equip_check) AND (NOT p_tape_request^.io_status.write_ring) THEN

{ Place an error bid indicator in the Bid_Window due to the block_id not being updated on a bad read and
{ set completion status to normal in an attempt to read the tape. An Engineering Log entry has been set up.

        iop$update_bid_window;
        p_tape_request^.io_status.normal_completion := TRUE;
        RETURN;
      IFEND;

{ Rewind the tape and send error status to the requestor.

      rstatus.normal := TRUE;
      iop$67x_non_data_trans_setup (logical_unit, ioc$tape_rewind, repeat_count,
            disable_unit, physical_unload, rio_id, rstatus);
      iop$tape_internal_request_stat (logical_unit, rio_id, {buf_release} TRUE,
            {bid_recovery} TRUE, bid_update, osc$wait, rio_status, rstatus);

      p_tape_request^.io_status.io_complete := TRUE;
      IF error_id = ioc$ipi_id_burst_error THEN
        p_tape_request^.io_status.completion_code := ioc$unable_to_write_id_burst;
      ELSE  { error_id = ioc$ipi_unable_to_set_agc
      p_tape_request^.io_status.completion_code := ioc$unable_to_set_agc;
      IFEND;

    = ioc$master_slave_data_integrity =
      p_tape_request^.io_status.completion_code := ioc$controller_failure;
      RETURN;  { no retry

    = ioc$slave_fac_data_integrity =
      p_tape_request^.io_status.completion_code := ioc$unit_failure;
      RETURN;  { no retry

    = ioc$pp_detect_software_failure =
      p_tape_request^.io_status.completion_code := ioc$system_software_failure;
      RETURN;  { no retry on software failure

    ELSE  {  unrecognized error_id

      p_tape_request^.io_status.completion_code := ioc$indeterminate;
      RETURN;  { no retry on unrecognized error_id

    CASEND;

  PROCEND iop$tape_status_check_ipi;
?? OLDTITLE ??
?? NEWTITLE := ' iop$analyze_response_packets ' ??
?? EJECT ??
  PROCEDURE iop$analyze_response_packets (
        status_p: ^iot$ipi_tape_status;
        response_length: iot$response_length;
    VAR response_packet: iot$analyzed_ipi_tape_response);

    VAR
      base_index: integer,
      dest_p: ^cell,
      next_length: integer,
      next_response_code: integer,
      response_packet_length: integer,
      source_p: ^cell;

    response_packet.id24_present := FALSE;
    response_packet.id26_present := FALSE;
    response_packet.id19_present := FALSE;
    response_packet.id29_present := FALSE;
    response_packet.id2a_present := FALSE;
    response_packet.sense_bytes_present := FALSE;

    IF response_length <= ioc$min_ipi_total_resp_size THEN
      RETURN;  { no ipi major status present
    IFEND;

    response_packet_length := status_p^.major_status_header.length + 2;
    IF response_packet_length <= ioc$major_status_size THEN
      RETURN;  { no parameters present
    IFEND;
    base_index := 11;

  /search_response_codes/
    WHILE base_index < response_packet_length DO
      next_length := status_p^.ipi_status [base_index] + 1;
      next_response_code := status_p^.ipi_status [base_index + 1];
      IF (base_index - 1 + next_length) > response_packet_length THEN
        EXIT /search_response_codes/;
      IFEND;
    /process_response_code/
      BEGIN
        CASE next_response_code OF
        = 24(16) =
          IF response_packet.id24_present THEN
            EXIT /process_response_code/;
          IFEND;
          IF next_length < 3 THEN
            EXIT /process_response_code/;
          IFEND;
          response_packet.id24_present := TRUE;
          source_p := ^status_p^.ipi_status [base_index + 1 + 1];
          dest_p := ^response_packet.id24_byte1;
          i#move (source_p, dest_p, 1);
          IF ((next_length - 1) >= 2f(16)) AND
                (status_p^.ipi_status [base_index + 1 + 5] = 80(16)) AND
                (status_p^.ipi_status [base_index + 1 + 6] = 0) AND
                (NOT response_packet.sense_bytes_present) THEN
            response_packet.sense_bytes_present := TRUE;
            source_p := ^status_p^.ipi_status [base_index + 1 + 19];
            dest_p := ^response_packet.sense_bytes;
            i#move (source_p, dest_p, 10);
          IFEND;
        = 26(16) =
          IF response_packet.id26_present THEN
            EXIT /process_response_code/;
          IFEND;
          IF next_length < 4 THEN
            EXIT /process_response_code/;
          IFEND;
          response_packet.id26_present := TRUE;
          source_p := ^status_p^.ipi_status [base_index + 1 + 1];
          dest_p := ^response_packet.id26_byte1;
          i#move (source_p, dest_p, 1);
          source_p := ^status_p^.ipi_status [base_index + 1 + 2];
          dest_p := ^response_packet.id26_byte2;
          i#move (source_p, dest_p, 1);
          source_p := ^status_p^.ipi_status [base_index + 1 + 4];
          dest_p := ^response_packet.id26_byte4;
          i#move (source_p, dest_p, 1);
          IF ((next_length - 1) >= 2f(16)) AND
                (status_p^.ipi_status [base_index + 1 + 5] = 80(16)) AND
                (status_p^.ipi_status [base_index + 1 + 6] = 0) AND
                (NOT response_packet.sense_bytes_present) THEN
            response_packet.sense_bytes_present := TRUE;
            source_p := ^status_p^.ipi_status [base_index + 1 + 19];
            dest_p := ^response_packet.sense_bytes;
            i#move (source_p, dest_p, 10);
          IFEND;
        = 19(16) =
          IF response_packet.id19_present THEN
            EXIT /process_response_code/;
          IFEND;
          response_packet.id19_present := TRUE;
        = 29(16) =
          IF response_packet.id29_present THEN
            EXIT /process_response_code/;
          IFEND;
          response_packet.id29_present := TRUE;
        = 2a(16) =
          IF response_packet.id2a_present THEN
            EXIT /process_response_code/;
          IFEND;
          IF next_length < 5 THEN
            EXIT /process_response_code/;
          IFEND;
          response_packet.id2a_present := TRUE;
          source_p := ^status_p^.ipi_status [base_index + 1 + 3];
          dest_p := ^response_packet.id2a_byte3;
          i#move (source_p, dest_p, 1);
          IF ((next_length - 1) >= 2f(16)) AND
                (status_p^.ipi_status [base_index + 1 + 5] = 80(16)) AND
                (status_p^.ipi_status [base_index + 1 + 6] = 0) AND
                (NOT response_packet.sense_bytes_present) THEN
            response_packet.sense_bytes_present := TRUE;
            source_p := ^status_p^.ipi_status [base_index + 1 + 19];
            dest_p := ^response_packet.sense_bytes;
            i#move (source_p, dest_p, 10);
          IFEND;
        ELSE
        CASEND;
      END /process_response_code/;
      IF next_length MOD 2 <> 0 THEN
        next_length := next_length + 1;
      IFEND;
      base_index := base_index + next_length;
    WHILEND /search_response_codes/;

  PROCEND iop$analyze_response_packets;
?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_terminate_io ' ??
?? EJECT ??

  PROCEDURE iop$tape_terminate_io (VAR p_tape_request: ^iot$tape_request;
    bid_recovery: boolean;
    VAR status: ost$status);

    VAR
      current_heap: ^ost$heap,
      found: boolean,
      i: iot$no_of_tape_units,
      ignore_status: ost$status,
      p_ud: ^iot$tape_job_unit_descriptor,
      requests_executed: integer,
      tape_failure_type : iot$tape_failure_type,
      tapemark_count: integer;

    status.normal := TRUE;
    iop$set_current_heap (current_heap);

{ Obtain the address for the tape job unit descriptor.

    p_ud := p_tape_request^.ud;

{ Increment usage counts.

    requests_executed := (p_tape_request^.last_command_processed - ioc$request_header_length) DIV 8 + 1;
    p_ud^.io_requests_count := p_ud^.io_requests_count + requests_executed;

    CASE p_tape_request^.request_type OF

    = ioc$tape_read =
      p_ud^.blocks_read := p_ud^.blocks_read + p_tape_request^.blocks_accessed;

{ Residual_block_count is initialized to 0 for normal_completion = TRUE.

      IF NOT p_tape_request^.io_status.normal_completion THEN
        p_tape_request^.io_status.residual_block_count := p_tape_request^.
              initial_block_count - p_tape_request^.blocks_accessed;
      IFEND;

{ Blocks_read for accounting and IRG location (block_count) includes any blocks that were read
{ and not involved in recovery.

      IF NOT bid_recovery THEN
        p_ud^.block_count := p_ud^.block_count + p_tape_request^.blocks_accessed;
        p_ud^.blocks_read_for_byte_count := p_ud^.blocks_read_for_byte_count + p_tape_request^.
               blocks_accessed;
        IF (NOT p_tape_request^.io_status.normal_completion) THEN
          IF (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN
            p_ud^.tapemark_count := p_ud^.tapemark_count + 1;
            p_ud^.block_count := p_ud^.block_count + 1;
            p_ud^.blocks_read_for_byte_count := p_ud^.blocks_read_for_byte_count + 1;
          ELSEIF (p_tape_request^.io_status.completion_code = ioc$alert_condition_encountered) OR
                ((p_tape_request^.io_status.completion_code = ioc$tape_medium_failure) AND
                (p_tape_request^.inhibit_error_recovery)) THEN
            p_ud^.block_count := p_ud^.block_count + 1;
            p_ud^.blocks_read_for_byte_count := p_ud^.blocks_read_for_byte_count + 1;
          IFEND;
        IFEND;
      IFEND;

? IF system_version THEN
{     IF p_ud^.controller_type = cmc$mt5680_xx THEN
{       IF (p_ud^.block_count <> p_ud^.cartridge_tape_last_good_bid.logical_position) AND
{          (p_ud^.block_count <> p_ud^.cartridge_tape_last_good_bid.logical_position +
{           p_ud^.error_block_forespace_count) THEN
{         osp$system_error ('Block Count incorrect after read', ^status);
{       IFEND;
{     IFEND;
? IFEND

    = ioc$tape_forspace =
      p_ud^.blocks_read := p_ud^.blocks_read + p_tape_request^.blocks_accessed;

{ Residual_block_count is initialized to 0 for normal_completion = TRUE.

      IF NOT p_tape_request^.io_status.normal_completion THEN
        p_tape_request^.io_status.residual_block_count := p_tape_request^.
              initial_block_count - p_tape_request^.blocks_accessed;
      IFEND;

{ Blocks_skipped for accounting and IRG location (block_count) includes any blocks that were
{ forespaced over that were not involved in recovery.

      IF (NOT bid_recovery) OR (p_ud^.positioning_to_tapemark) THEN
        p_ud^.block_count := p_ud^.block_count + p_tape_request^.blocks_accessed;
        p_ud^.blocks_skipped := p_ud^.blocks_skipped + p_tape_request^.
               blocks_accessed;
        IF (NOT p_tape_request^.io_status.normal_completion) THEN
          IF (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN
            p_ud^.tapemark_count := p_ud^.tapemark_count + 1;
            p_ud^.block_count := p_ud^.block_count + 1;
            p_ud^.blocks_skipped := p_ud^.blocks_skipped + 1;
          ELSEIF ((p_tape_request^.io_status.completion_code = ioc$tape_medium_failure) AND
                (p_tape_request^.inhibit_error_recovery)) THEN
            p_ud^.block_count := p_ud^.block_count + 1;
            p_ud^.blocks_read_for_byte_count := p_ud^.blocks_read_for_byte_count + 1;
          IFEND;
        IFEND;
      IFEND;

    = ioc$tape_backspace =
      p_ud^.blocks_read := p_ud^.blocks_read + p_tape_request^.blocks_accessed;
      IF NOT p_tape_request^.io_status.normal_completion THEN
        p_tape_request^.io_status.residual_block_count := p_tape_request^.
              initial_block_count - p_tape_request^.blocks_accessed;
      IFEND;

{ Blocks skipped for accounting includes any blocks that were backspaced over and not involved
{ in recovery.

      IF (NOT bid_recovery) OR (p_ud^.positioning_to_tapemark) THEN
        p_ud^.block_count := p_ud^.block_count - p_tape_request^.blocks_accessed;
        p_ud^.blocks_skipped := p_ud^.blocks_skipped + p_tape_request^.
               blocks_accessed;
        IF (NOT p_tape_request^.io_status.normal_completion) AND
           (p_tape_request^.io_status.completion_code = ioc$tapemark_read) THEN
          p_ud^.tapemark_count := p_ud^.tapemark_count - 1;
          p_ud^.block_count := p_ud^.block_count - 1;
          p_ud^.blocks_skipped := p_ud^.blocks_skipped + 1;
        IFEND;
      IFEND;

    = ioc$tape_write =
      p_ud^.blocks_written := p_ud^.blocks_written +  p_tape_request^.blocks_accessed;
      p_ud^.block_count := p_ud^.block_count + p_tape_request^.blocks_accessed;
      p_ud^.blocks_written_for_byte_count := p_ud^.blocks_written_for_byte_count +  p_tape_request^.
             blocks_accessed;

      p_tape_request^.io_status.residual_block_count := p_tape_request^.
            initial_block_count - p_tape_request^.blocks_accessed;

? IF system_version THEN
{     IF p_ud^.controller_type = cmc$mt5680_xx THEN
{       IF (p_ud^.block_count <> p_ud^.cartridge_tape_last_good_bid.logical_position) AND
{          (p_ud^.block_count <> p_ud^.cartridge_tape_last_good_bid.logical_position +
{           p_ud^.error_block_forespace_count) THEN
{         osp$system_error ('Block Count incorrect after write', ^status);
{       IFEND;
{     IFEND;
? IFEND

    = ioc$tape_write_tapemark =

{ Presently only 1 write_tapemark command allowed per request, but this code will allow for
{ future implementation of multiple TM writes in one request and the counts will be correct.

      IF p_tape_request^.io_status.normal_completion THEN
        tapemark_count := requests_executed - ioc$format_cmd_length;
      ELSE
        p_tape_request^.io_status.residual_block_count := p_tape_request^.
              initial_block_count - p_tape_request^.blocks_accessed;
        tapemark_count := requests_executed - ioc$format_cmd_length - ioc$non_data_cmd_length;
      IFEND;

      p_ud^.tapemark_count := p_ud^.tapemark_count + tapemark_count;
      p_ud^.block_count := p_ud^.block_count + tapemark_count;
      p_ud^.blocks_written := p_ud^.blocks_written +  tapemark_count;
      p_ud^.blocks_written_for_byte_count := p_ud^.blocks_written_for_byte_count +  tapemark_count;

    = ioc$tape_unload =

      IF (iov$p_statistic_data_p_array = NIL) THEN
        RETURN;
      IFEND;

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF (p_ud = iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor) AND
              (iov$p_statistic_data_p_array^ [i].slot_in_use) THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF found THEN
        IF (p_ud^.single_double_track_corrections <> 0) AND (p_ud^.controller_type <> cmc$mt5680_xx) THEN
          IF p_ud^.controller_type = cmc$mt5698_xx THEN
            p_tape_request^.pp_response_p^.ipi_tape_status.error_id := ioc$hdw_corrected_errors;
            iop$tape_error_logging_ipi (p_tape_request, ioc$informative, status);
          ELSE
            tape_failure_type := ioc$undetermined;
            iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} FALSE, status);
            tape_failure_type := ioc$recovered;
            iop$tape_error_logging (p_tape_request, tape_failure_type, {*IM*} TRUE, status);
          IFEND;
        ELSEIF p_ud^.controller_type = cmc$mt5680_xx THEN
          IF (p_tape_request^.request.tape_command [2].address = ioc$67x_func_unload) AND
                (p_tape_request^.pp_response_p^.pp_response.response_length = ioc$max_ccc_cart_resp_size) AND
                ((p_tape_request^.pp_response_p^.ccc_cart_error_log.on_the_fly_read_errors > 0) OR
                (p_tape_request^.pp_response_p^.ccc_cart_error_log.on_the_fly_write_errors > 0) OR
                (p_tape_request^.pp_response_p^.ccc_cart_error_log.recovered_read_errors > 0) OR
                (p_tape_request^.pp_response_p^.ccc_cart_error_log.recovered_write_errors > 0) OR
                (p_ud^.ccc_cart_buffer_underruns > 0)) THEN
              p_tape_request^.pp_response_p^.ccc_cart_device_status.error_id := ioc$ccc_cart_hardware_corr;
            iop$tape_error_logging_ccc_cart (p_tape_request, ioc$recovered, status);
          IFEND;
        IFEND;

        iop$tape_usage_logging (p_tape_request, ignore_status);

        iop$free_wired_tape_tables (p_ud^.completion_q_index);
        iop$free_pageable_tape_requests (p_ud);
        FREE p_ud IN current_heap^;

        osp$set_job_signature_lock (statistic_data_lock);

        iov$p_statistic_data_p_array^ [i].logical_unit := 0;
        iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor := NIL;
        iov$p_statistic_data_p_array^ [i].slot_in_use := FALSE;

        found := FALSE;
        /unit_assignment/
          FOR i := 1 TO UPPERBOUND (iov$p_statistic_data_p_array^) DO
            IF iov$p_statistic_data_p_array^ [i].slot_in_use = TRUE THEN
              found := TRUE;
              EXIT /unit_assignment/;
            IFEND;
          FOREND /unit_assignment/;

        IF NOT found THEN
          FREE iov$p_statistic_data_p_array IN current_heap^;
          iov$p_statistic_data_p_array := NIL;
        IFEND;

        osp$clear_job_signature_lock (statistic_data_lock);

      IFEND;

    = ioc$skip_tapemark_forward =

      IF p_tape_request^.io_status.normal_completion THEN
        tapemark_count := requests_executed - ioc$format_cmd_length;
      ELSE
        p_tape_request^.io_status.residual_block_count := p_tape_request^.
              initial_block_count - p_tape_request^.blocks_accessed;
        tapemark_count := requests_executed - ioc$format_cmd_length - ioc$non_data_cmd_length;
      IFEND;
      p_ud^.blocks_read := p_ud^.blocks_read + tapemark_count;
      p_ud^.tapemark_count := p_ud^.tapemark_count + tapemark_count;
      p_ud^.block_count := p_ud^.cartridge_tape_last_good_bid.logical_position;

    = ioc$skip_tapemark_backward =

      IF p_tape_request^.io_status.normal_completion THEN
        tapemark_count := requests_executed - ioc$format_cmd_length;
      ELSE
        p_tape_request^.io_status.residual_block_count := p_tape_request^.
              initial_block_count - p_tape_request^.blocks_accessed;
        tapemark_count := requests_executed - ioc$format_cmd_length - ioc$non_data_cmd_length;
      IFEND;
      p_ud^.blocks_read := p_ud^.blocks_read + tapemark_count;
      p_ud^.tapemark_count := p_ud^.tapemark_count - tapemark_count;
      p_ud^.block_count := p_ud^.cartridge_tape_last_good_bid.logical_position;

    = ioc$tape_rewind =

      IF NOT bid_recovery THEN
        p_ud^.block_count := 0;
        p_ud^.tapemark_count := 0;
      IFEND;

    = ioc$locate_block =

      IF NOT bid_recovery AND p_tape_request^.io_status.normal_completion THEN
        p_ud^.block_count := p_ud^.cartridge_tape_last_good_bid.logical_position;
      IFEND;

    = ioc$tape_data_security_erase, ioc$tape_get_status, ioc$tape_erase =

{ No action, exit.

    ELSE
      osp$set_status_abnormal ('io', ioc$os_failure, 'improper request type in iop$tape_terminate_io',
            status);
    CASEND;

  PROCEND iop$tape_terminate_io;

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_terminate_io_scan ' ??
?? EJECT ??

? IF system_version THEN
  PROCEDURE [XDCL, #GATE] iop$tape_terminate_io_scan (logical_unit_number: iot$logical_unit);

    VAR
      current_heap: ^ost$heap,
      found: boolean,
      i: iot$no_of_tape_units;

    iop$set_current_heap (current_heap);

{   find unit descriptor for unit that was scanned

    i := 1;
    found := FALSE;

    osp$set_job_signature_lock (statistic_data_lock);

    WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
      IF logical_unit_number = iov$p_statistic_data_p_array^ [i].logical_unit THEN
        found := TRUE;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;

    IF found THEN

{   Free the space occupied by the tape unit descriptor and set bit slot_in_use
{   in statistic_data_p_array to FALSE.

      iop$free_wired_tape_tables (iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor^.
            completion_q_index);
      iop$free_pageable_tape_requests (iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor);
      FREE iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor IN current_heap^;
      iov$p_statistic_data_p_array^ [i].logical_unit := 0;
      iov$p_statistic_data_p_array^ [i].slot_in_use := FALSE;
    IFEND;

{ Currently do not FREE iov$p_statistic_data_p_array for the system job since the
{ scanner runs there and there would be excessive allocates and frees if the structure
{ was released after every unit scan.
{
{   found := FALSE;
{   /unit_assignment/
{     FOR i := 1 TO UPPERBOUND (iov$p_statistic_data_p_array^) DO
{       IF iov$p_statistic_data_p_array^ [i].slot_in_use = TRUE THEN
{         found := TRUE;
{         EXIT /unit_assignment/;
{       IFEND;
{     FOREND /unit_assignment/;
{
{   IF NOT found THEN
{     FREE iov$p_statistic_data_p_array IN current_heap^;
{     iov$p_statistic_data_p_array := NIL;
{   IFEND;

    osp$clear_job_signature_lock (statistic_data_lock);

  PROCEND iop$tape_terminate_io_scan;
? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_update_byte_counts ' ??
?? EJECT ??
?  IF system_version THEN

  PROCEDURE [XDCL, #GATE] iop$tape_update_byte_counts (system_file_id: gft$system_file_identifier;
    max_block_length: amt$max_block_length;
    VAR status: ost$status);

    VAR
      found: boolean,
      i: iot$no_of_tape_units,
      logical_unit: iot$logical_unit,
      ud_p: ^iot$tape_job_unit_descriptor;

      status.normal := TRUE;

{     Get unit number using file name.

      convert_sfid_to_lun (system_file_id, logical_unit, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Obtain pointer to tape job unit descriptor.

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF logical_unit = iov$p_statistic_data_p_array^ [i]. logical_unit THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$tape_update_byte_counts', status);
        RETURN;
      IFEND;

      ud_p := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

      ud_p^.blocks_read_for_accounting := ud_p^.blocks_read_for_accounting +
              ud_p^.blocks_read_for_byte_count;
      ud_p^.blocks_written_for_accounting := ud_p^.blocks_written_for_accounting +
              ud_p^.blocks_written_for_byte_count;
      ud_p^.bytes_read := ud_p^.bytes_read + (ud_p^.blocks_read_for_byte_count * max_block_length);
      ud_p^.bytes_written := ud_p^.bytes_written + (ud_p^.blocks_written_for_byte_count * max_block_length);
      ud_p^.blocks_read_for_byte_count := 0;
      ud_p^.blocks_written_for_byte_count := 0;

  PROCEND iop$tape_update_byte_counts;

?  IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$tape_usage_logging ' ??
?? EJECT ??

  PROCEDURE iop$tape_usage_logging (p_tape_request: ^iot$tape_request;
    VAR status: ost$status);

? IF system_version THEN
*copyc fsp$path_element
*copyc clp$check_name_for_path_handle

    PROCEDURE [INLINE] append_string_data (string_data: string ( * <= 31));

      path.value (i, * ) := string_data;

      WHILE (path.value (i, 1) <> ' ') DO
        i := i + 1;
      WHILEND;

    PROCEND append_string_data;

    CONST
      gcr = 3,
      novalue = -1,
      nrzi = 1,
      pe = 2,
      cart = 4;

    VAR
      channel: cmt$physical_channel,
      cyc_descr: ^fmt$cycle_description,
      efr: fst$evaluated_file_reference,
      equipment_number: cmt$physical_equipment_number,
      element_name: cmt$element_name,
      found: boolean,
      file_name: ost$name,
      file_path_handle: clt$path_handle,
      i: integer,
      iou_number: dst$iou_number,
      logical_unit: iot$logical_unit,
      p_counters: sft$counters,
      p_counters_seq: ^SEQ (*),
      p_pp_interface_table: ^iot$pp_interface_table,
      p_tape_usage_data: ^iot$tape_usage_data,
      p_ud: ^iot$tape_job_unit_descriptor,
      path: ost$string,
      pp: 0 .. 0ff(16),
      results: bat$process_pt_results,
      statistic_code: sft$statistic_code,
      tusl_offset: iot$no_of_tape_units;

    status.normal := TRUE;
    p_ud := p_tape_request^.ud;

{   Push the package that is going to contain the usage statistics onto the stack.

    PUSH p_tape_usage_data;

{   Fill out the last used density for the tape unit in the usage statistic.

    CASE p_ud^.tape_unit_density OF

    = 0, 1 =
      p_tape_usage_data^.package.last_density := pe;

    = 2 =
      p_tape_usage_data^.package.last_density := nrzi;

    = 3 =
      p_tape_usage_data^.package.last_density := gcr;

    = 4 =
      p_tape_usage_data^.package.last_density := cart;

    ELSE

    CASEND;

{   Fill the counters for the usage statistic.

    p_tape_usage_data^.package.total_blocks_written := p_ud^.blocks_written;
    p_tape_usage_data^.package.total_blocks_read := p_ud^.blocks_read;
    p_tape_usage_data^.package.total_io_requests := p_ud^.io_requests_count;
    p_tape_usage_data^.package.accounting_blocks_skipped := p_ud^.blocks_skipped;
    p_tape_usage_data^.package.accounting_blocks_written := p_ud^.blocks_written_for_accounting;
    p_tape_usage_data^.package.accounting_blocks_read := p_ud^.blocks_read_for_accounting;
    p_tape_usage_data^.package.accounting_bytes_written := p_ud^.bytes_written;
    p_tape_usage_data^.package.accounting_bytes_read := p_ud^.bytes_read;

{ Free running clock time was saved at assign time in job unit descriptor.
    i := #free_running_clock (0);
    p_tape_usage_data^.package.seconds_tape_mounted := ((i - p_ud^.free_running_clock) DIV (1000000));

{   The following code was used to clear unused counters that no longer exist.
{   Clear the remaining unused words of tape_usage_statistic_data.
{
{   FOR i := ((#SIZE (p_tape_usage_data^.package) DIV 8) + 1) TO ioc$max_usage_counters DO
{     p_tape_usage_data^.counters_array [i] := novalue;
{   FOREND;

{   Set up the descriptive data for the usage statistic.

    logical_unit := p_tape_request^.request.logical_unit;
    pp := p_tape_request^.pp_response_p^.pp_no;
    iou_number := cmv$logical_pp_table_p^ [pp].pp_info.channel.iou_number;
    p_pp_interface_table := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;
    channel.number := p_pp_interface_table^.unit_descriptors [logical_unit].
          physical_path.channel_number;
    channel.port := cmc$unspecified_port;
    IF cmv$logical_pp_table_p^ [pp].pp_info.channel_interlock_p^.
          channel_characteristics [channel.number].concurrent_channel THEN
      channel.concurrent := TRUE;
      IF p_ud^.controller_type = cmc$mt5698_xx THEN
        IF p_pp_interface_table^.unit_descriptors [logical_unit].
              physical_path.port = 0 THEN
          channel.port := cmc$port_a;
        ELSE
          channel.port := cmc$port_b;
        IFEND;
      IFEND;
    ELSE
      channel.concurrent := FALSE;
    IFEND;

    equipment_number := p_pp_interface_table^.unit_descriptors
          [logical_unit].physical_path.controller_number;

    cmp$get_element_name_via_lun (logical_unit , element_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    found := FALSE;

  /get_tusl_offset/
    FOR tusl_offset := LOWERBOUND (iov$tusl_p^) TO UPPERBOUND (iov$tusl_p^) DO
      IF element_name = iov$tusl_p^ [tusl_offset].element_name THEN
        found := TRUE;
        EXIT /get_tusl_offset/;
      IFEND;
    FOREND /get_tusl_offset/;

    IF NOT found THEN
      osp$set_status_abnormal ('io', ioc$unrecognized_unit_id,
            'unable to find tusl_entry in iop$tape_usage_logging', status);
      RETURN;
    IFEND;

    clp$check_name_for_path_handle (iov$tusl_p^ [tusl_offset].path_handle_name, file_path_handle);
    efr := fsv$evaluated_file_reference;
    efr.path_handle_info.path_handle := file_path_handle.regular_handle;
    efr.path_handle_info.path_handle_present := TRUE;
    fmp$process_pt_request ($bat$process_pt_work_list [bac$inhibit_locking_pt],
             osc$null_name, efr, cyc_descr, results, status);
    file_name := fsp$path_element (^efr, efr.number_of_path_elements) ^;

    cmp$return_descriptor_data (channel, iou_number, equipment_number, logical_unit, path, pp);

  /asterisk_loop/
    FOR i := path.size DOWNTO LOWERVALUE(path.size) DO
      IF (path.value (i, 1) = '*') THEN
        EXIT /asterisk_loop/
      IFEND;
    FOREND /asterisk_loop/;
    append_string_data (', ');
    append_string_data (iov$tusl_p^ [tusl_offset].evsn);
    append_string_data (', ');
    append_string_data (iov$tusl_p^ [tusl_offset].rvsn);
    append_string_data (', ');
    append_string_data (file_name);

    path.size := i - 1;

    p_counters_seq := ^p_tape_usage_data^.counters;

    RESET p_counters_seq;
    NEXT p_counters: [1 .. ioc$max_usage_counters] IN p_counters_seq;

    statistic_code := cml$tape_subsystem_usage_data;

    sfp$emit_statistic (statistic_code, path.value (1, path.size), p_counters, status);
{   IF NOT status.normal THEN
{     osp$system_error ('tape usage log emit error', ^status);
{   IFEND;

? ELSE
    status.normal := TRUE;
? IFEND

  PROCEND iop$tape_usage_logging;

?? OLDTITLE ??
?? NEWTITLE := ' iop$unload_tape ' ??
?? EJECT ??

  PROCEDURE [XDCL] iop$unload_tape (
        system_file_id: gft$system_file_identifier;
        detachment_options: fmt$detachment_options;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = FALSE,
      repeat_count = 1;

    VAR
      logical_unit: iot$logical_unit,
      physical_unload: boolean;

    BEGIN
      status.normal := TRUE;

      convert_sfid_to_lun (system_file_id, logical_unit, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF detachment_options.device_class = rmc$magnetic_tape_device THEN
        physical_unload := detachment_options.physical_unload;
      ELSE
        physical_unload := TRUE;
      IFEND;

      iop$67x_non_data_trans_setup (logical_unit, ioc$tape_unload, repeat_count, disable_unit,
            physical_unload, io_id, status);

    END
  PROCEND iop$unload_tape;

?? OLDTITLE ??
?? NEWTITLE := ' iop$update_block_count ' ??
?? EJECT ??
?  IF system_version THEN

{ The purpose of this procedure is to update the block count from loadpoint
{ after a fatal read parity error in which global error recovery is not attempted.
{ The call is made from bam$tape_block_manager_ring3 if option 2 (no recovery) is
{ made in response to the menu.
{ Note - For reel to reel tape, the block_id window is also updated to account for
{ the bad block.  It is assumed that the tape is positioned after the bad block.

  PROCEDURE [XDCL, #GATE] iop$update_block_count (
    sfid: gft$system_file_identifier;
    VAR status: ost$status);

    VAR
      found: boolean,
      i: iot$no_of_tape_units,
      logical_unit: iot$logical_unit,
      p_ud: ^iot$tape_job_unit_descriptor;

      status.normal := TRUE;

      convert_sfid_to_lun (sfid, logical_unit, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Obtain pointer to tape job unit descriptor.

      i := 1;
      found := FALSE;
      WHILE (i <= UPPERBOUND (iov$p_statistic_data_p_array^)) AND (NOT found) DO
        IF logical_unit = iov$p_statistic_data_p_array^ [i]. logical_unit THEN
          found := TRUE;
        ELSE
          i := i + 1;
        IFEND;
      WHILEND;

      IF NOT found THEN
        osp$set_status_abnormal ('io', ioc$os_failure,
              'unable to find unit in iop$update_block_count', status);
        RETURN;
      IFEND;

      p_ud := iov$p_statistic_data_p_array^ [i].p_tape_job_unit_descriptor;

      p_ud^.block_count := p_ud^.block_count + 1;

      IF p_ud^.controller_type <> cmc$mt5680_xx THEN { update bid window for reel to reel tape
        p_ud^.bid_window [p_ud^.bid_index] := ioc$error_block_bid;
        IF p_ud^.bid_index <> UPPERVALUE(iot$bid_index) THEN
          p_ud^.bid_index := p_ud^.bid_index + 1;
        ELSE
          p_ud^.bid_index := LOWERVALUE(iot$bid_index);
        IFEND;
      IFEND;

  PROCEND iop$update_block_count;

?  IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$write_tape ' ??
?? EJECT ??

? IF system_version THEN

  PROCEDURE [XDCL] iop$write_tape (system_file_id: gft$system_file_identifier;
        inhibit_error_recovery: boolean;
        block_description: ^iot$write_tape_description;
        no_of_blocks_to_write: iot$tape_block_count;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      write_request = TRUE;

    VAR
      address_pair_count: 0 .. mmc$max_rma_list_length,
      i: 0 .. 2 * ioc$max_tape_blocks_to_process,
      j: iot$tape_command_index,
      l: iot$tape_block_count,
      length: iot$transfer_count,
      offset: ost$segment_offset,
      p_tape_request: ^iot$tape_request,
      p_ud: ^iot$tape_job_unit_descriptor,
      page_offset: 0 .. 65536,
      pkt_length: iot$tape_request_length,
      tape_request_type: iot$tape_request_types,
      tape_unit_number: iot$logical_unit;

    BEGIN
      status.normal := TRUE;
      p_tape_request := NIL;
      io_id := 1;

      tape_request_type := ioc$tape_write;
      convert_sfid_to_lun (system_file_id, tape_unit_number, status);
      IF status.normal THEN
        pkt_length := iov$67x_command_table [tape_request_type].length + (ioc$write_cmd_per_block * 8) *
              no_of_blocks_to_write;
        iop$tape_build_pp_req_header (tape_unit_number, pkt_length, p_tape_request, status);
      /build_request/
        BEGIN
          IF status.normal THEN

            io_id := p_tape_request^.io_id;
            address_pair_count := 0;
            p_ud := p_tape_request^.ud;
            j := iov$67x_command_table [tape_request_type].index;
            i := 0;
            FOR l := 1 TO no_of_blocks_to_write DO
              length := block_description^ [l].transfer_length;
              IF length > p_ud^.max_block_length THEN
                osp$set_status_abnormal ('IO', ioe$block_size_too_large, 'Block size is too large.', status);
                EXIT /build_request/
              IFEND;
              IF length < p_ud^.min_block_length THEN
                osp$set_status_abnormal ('IO', ioe$block_size_too_small, 'Block size too small.', status);
                EXIT /build_request/
              IFEND;
              offset := #OFFSET (block_description^[l].buffer_area);
              IF ((offset MOD 8) <> 0) THEN
                osp$set_status_abnormal ('IO', ioe$improper_data_address, 'Data buffer not word aligned.',
                     status);
                EXIT /build_request/
              IFEND;
              page_offset := offset MOD osv$page_size;
              address_pair_count := address_pair_count + (((page_offset + length - 1) DIV osv$page_size) + 1);
              p_tape_request^.request.tape_command [j + i].flags.store_response := FALSE;
              p_tape_request^.request.tape_command [j + i].flags.indirect_address := FALSE;
              p_tape_request^.request.tape_command [j + i].flags.fill := 0;
              IF p_ud^.controller_type = cmc$mt5698_xx THEN
                p_tape_request^.request.tape_command [j + i].command_code := ioc$cc_write_record;
                p_tape_request^.request.tape_command [j + i].length := 0;
                p_tape_request^.request.tape_command [j + i].address := length;
              ELSE
                p_tape_request^.request.tape_command [j + i].command_code := ioc$cc_function;
                p_tape_request^.request.tape_command [j + i].length := ioc$tape_function_code_length;
                p_tape_request^.request.tape_command [j + i].address :=
                      iov$67x_command_table [tape_request_type].hardware_command;
                IF ((length MOD 2) = 1) AND (p_ud^.controller_type = cmc$mt7221_2_s0) THEN
                  p_tape_request^.request.tape_command [j + i].address := ioc$67x_func_short_write;
                ELSEIF ((length MOD 3) = 2) AND NOT (p_ud^.controller_type = cmc$mt7221_2_s0) THEN
                  p_tape_request^.request.tape_command [j + i].address := ioc$67x_func_short_write;
                IFEND;
                IF (length > 65536) AND (p_ud^.controller_type = cmc$mt5680_xx) THEN
                  p_tape_request^.request.tape_command [j + i].address :=
                        p_tape_request^.request.tape_command [j + i].address + 100(8);
                IFEND;
              IFEND;
              p_tape_request^.request.tape_command [j + i + 1].command_code := ioc$cc_output_8_bit_data;
              p_tape_request^.request.tape_command [j + i + 1].flags.fill := 0;
              p_tape_request^.request.tape_command [j + i + 1].flags.store_response := FALSE;
              p_tape_request^.request.tape_command [j + i + 1].flags.indirect_address := TRUE;
              i := i + ioc$write_cmd_per_block;
            FOREND;
            IF address_pair_count > (osv$page_size DIV 8) THEN
              osp$set_status_abnormal ('IO', ioe$tape_rma_list_overflow,
                   'Page size will not accommodate RMA list', status);
              EXIT /build_request/
            IFEND;
            p_ud^.consecutive_erases := 0;
            p_tape_request^.estimated_address_pair_count := address_pair_count;
            p_tape_request^.write_block_description := block_description;
            p_tape_request^.no_of_data_commands := no_of_blocks_to_write;
            p_tape_request^.first_data_command := j + 1;
            p_tape_request^.request_type := ioc$tape_write;
            p_tape_request^.io_type := ioc$explicit_write;
            p_tape_request^.request.alert_mask.physical_delimiter := TRUE;
            p_tape_request^.inhibit_error_recovery := inhibit_error_recovery;
            IF inhibit_error_recovery THEN
              p_tape_request^.request.recovery := ioc$terminate_at_error;
            IFEND;
            p_tape_request^.initial_block_count := no_of_blocks_to_write;
            iop$tape_queue_request_setup (p_tape_request, status);
          IFEND;
        END /build_request/;
        IF (p_tape_request <> NIL) AND NOT status.normal THEN
          IF NOT p_tape_request^.must_free_pageable_request THEN
            p_tape_request^.ud^.pageable_tape_requests [p_tape_request^.pageable_tape_request_index].
                  slot_in_use := FALSE;
          ELSE
            FREE p_tape_request^.pp_response_p IN osv$job_pageable_heap^;
            FREE p_tape_request IN osv$job_pageable_heap^;
          IFEND;
        IFEND;
      IFEND;
    END

  PROCEND iop$write_tape;

? IFEND

?? OLDTITLE ??
?? NEWTITLE := ' iop$write_tapemark ' ??
?? EJECT ??

? IF system_version THEN

  PROCEDURE [XDCL] iop$write_tapemark (system_file_id: gft$system_file_identifier;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    CONST
      disable_unit = TRUE,
      physical_unload = FALSE,
      repeat_count = 1;

    VAR
      logical_unit_number: iot$logical_unit;

    BEGIN
      status.normal := TRUE;

      convert_sfid_to_lun (system_file_id, logical_unit_number, status);
      IF status.normal THEN
        iop$67x_non_data_trans_setup (logical_unit_number, ioc$tape_write_tapemark, repeat_count,
               disable_unit, physical_unload, io_id, status);
      IFEND;

    END

  PROCEND iop$write_tapemark;

? IFEND

