?? NEWTITLE := 'NOS/VE Basic Access Method : LRT US Undef Tape FAP' ??
MODULE bam$lrt_us_undef_tape_fap;
?? RIGHT := 110 ??

{No, I stop touching those bam$lrt_ss/us tape fap things

?? NEWTITLE := 'Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$get_program_actions
*copyc ame$get_validation_errors
*copyc ame$improper_file_id
*copyc ame$improper_wsl
*copyc ame$put_program_actions
*copyc ame$put_validation_errors
*copyc ame$skip_program_actions
*copyc ame$skip_validation_errors
*copyc bae$tape_bm_error_codes
*copyc dme$tape_errors
*copyc amt$call_block
*copyc amt$fap_layer_number
*copyc amt$file_identifier
*copyc amt$tape_error_options
*copyc bat$put_label_request
*copyc bat$record_header_type
*copyc ost$caller_identifier
?? POP ??
*copyc amp$set_file_instance_abnormal
*copyc baf$task_file_entry_p
*copyc bap$close
*copyc bap$fap_control
*copyc bap$tape_bm_advance_volume
*copyc bap$tape_bm_align_position
*copyc bap$tape_bm_close
*copyc bap$tape_bm_erase_block
*copyc bap$tape_bm_flush
*copyc bap$tape_bm_open
*copyc bap$tape_bm_read_label
*copyc bap$tape_bm_read_next_block
*copyc bap$tape_bm_read_to_write
*copyc bap$tape_bm_reserve_blk_buffer
*copyc bap$tape_bm_rewind
*copyc bap$tape_bm_skip_blocks
*copyc bap$tape_bm_skip_tapemark
*copyc bap$tape_bm_tapemark_check
*copyc bap$tape_bm_write_label
*copyc bap$tape_bm_write_label_mark
*copyc bap$tape_bm_write_next_block
*copyc bap$tape_bm_write_tape_mark
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc bav$global_tape_fap_variables
*copyc osv$task_private_heap
*copyc bai$advance_volume
*copyc bai$append_tape_error
*copyc bai$block_info
*copyc bai$check_caller_id
*copyc bai$check_record_level_access
*copyc bai$check_tapemark
*copyc bai$clear_fail_at_current_pos
*copyc bai$dynamic_label
*copyc bai$fetch_tape_error_options
*copyc bai$forced_write
*copyc bai$gfi
*copyc bai$init_boi_tape_position
*copyc bai$label_type
*copyc bai$partial_block_exists
*copyc bai$partial_read_block_exists
*copyc bai$process_block_information
*copyc bai$process_request_status
*copyc bai$state_info
*copyc bai$static_label
*copyc bai$tape_descriptor
*copyc bai$validate_tape_access
*copyc bai$write_previous_block
*copyc i#move

*if $true(bav$user_fap)
*copyc bap$validate_fap_identifier
*ifend
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by this Module', EJECT ??

  CONST
    pad_blocks = FALSE,
    record_headers_exist = FALSE;

*if $true(bav$user_fap)
?? TITLE := 'bap#lrt_us_undef_tape_fap', EJECT ??

  VAR
    ttv$layer_number: [XDCL] amt$fap_layer_number := 0;

  PROCEDURE [XDCL, #GATE] bap#lrt_us_undef_tape_fap (file_identifier: amt$file_identifier;
        call_block: amt$call_block;
        layer_number: amt$fap_layer_number;
    VAR status: ost$status);

    ttv$layer_number := layer_number;
    bap$lrt_us_undef_tape_fap (file_identifier, call_block, layer_number, status);

  PROCEND bap#lrt_us_undef_tape_fap;
*ifend

?? TITLE := 'bap$lrt_us_undef_tape_fap', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$lrt_us_undef_tape_fap (file_identifier: amt$file_identifier;
        call_block: amt$call_block;
        layer_number: amt$fap_layer_number;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      dynamic_label: ^bat$dynamic_label_attributes,
      i: integer,
      local_status: ost$status,
      static_label: ^bat$instance_static_attributes;

*if $true(bav$user_fap)
    VAR
      validation_ok: boolean;
*ifend
    #caller_id (caller_id);
    operation := call_block.operation;
    status.normal := TRUE;
    global_layer_number := layer_number;
    close_file_on_exit := FALSE;

  /main_program/
    BEGIN

*if $true(bav$user_fap)
      bap$validate_fap_identifier (file_identifier, file_instance, validation_ok);
      IF NOT validation_ok THEN
        osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id,
              'bap$lrt_us_undef_tape_fap', status);
        EXIT /main_program/;
      IFEND;
*else
      file_instance := baf$task_file_entry_p (file_identifier);
      IF file_instance = NIL THEN
        osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id,
              'bap$lrt_us_undef_tape_fap', status);
        EXIT /main_program/;
      IFEND;
*ifend

      block_info := bai$block_info (file_instance);
      gfi := bai$gfi (file_instance);
      tape_descriptor := bai$tape_descriptor (file_instance);
      static_label := bai$static_label (file_instance);
      state_info := bai$state_info (file_instance);
      bai$check_caller_id (file_identifier, static_label^.ring_attributes, operation, caller_id,
            status);
      IF NOT status.normal THEN
        EXIT /main_program/;
      IFEND;

      bai$check_record_level_access (file_identifier, file_instance^.access_level, operation,
            status);
      IF NOT status.normal THEN
        EXIT /main_program/;
      IFEND;

      dynamic_label := bai$dynamic_label (file_instance);
      bai$validate_tape_access (file_identifier, dynamic_label^.access_mode, operation, tape_descriptor,
            status);
      IF NOT status.normal THEN
        EXIT /main_program/;
      IFEND;

      bai$clear_fail_at_current_pos (operation, status);
      IF NOT status.normal THEN
        EXIT /main_program/;
      IFEND;


      tape_descriptor^.error_options := dynamic_label^.error_options;

      CASE operation OF

      = amc$close_req =
        rmp$log_debug_message ('LABELED_TAPE_DEBUG: US/U FAP calling CLOSE');
        close_req (file_identifier, status);
        bap$close (file_identifier, local_status);
        IF status.normal THEN
          status := local_status;
        IFEND;
      = amc$close_volume_req =
        close_volume_req (file_identifier, status);
        file_instance^.previous_get_at_eoi := FALSE;
      = amc$erase_tape_block =
        erase_tape_block_req (file_identifier, call_block, status);
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := status.normal OR tape_descriptor^.at_eoi;
      = amc$fetch_req =
        bap$fap_control (file_identifier, call_block, layer_number, status);
      = amc$flush_req =
        flush_req (file_identifier, status);
      = amc$get_next_req =
        get_next_req (file_identifier, call_block, status);
        IF status.normal AND (call_block.getn.file_position^ <> amc$eoi) THEN
          tape_descriptor^.at_eoi := FALSE;
        IFEND;
      = amc$get_partial_req =
        get_partial_req (file_identifier, call_block, status);
        IF status.normal AND (call_block.getp.file_position^ <> amc$eoi) THEN
          tape_descriptor^.at_eoi := FALSE;
        IFEND;
      = amc$open_req =
        rmp$log_debug_message ('LABELED_TAPE_DEBUG: US/U FAP calling OPEN');
        tape_descriptor^.file_label_type := static_label^.file_label_type;
        open_req (file_identifier, call_block, layer_number, dynamic_label, status);
      = amc$put_next_req =
        IF (bai$label_type () = amc$labelled) THEN
          IF NOT state_info^.ve_wrote_ansi_file THEN
            amp$set_file_instance_abnormal (file_identifier, ame$rewrite_labels_conflict,
                  call_block.operation, ' ', status);
            RETURN;
          IFEND;
          IF bap$after_trailer_labels (tape_descriptor^.labeled_volume_position) THEN
            sl_reposition_for_put_at_eoi (file_identifier, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
        put_next_req (file_identifier, call_block, status);
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := status.normal OR tape_descriptor^.at_eoi;
      = amc$put_partial_req =
        IF (bai$label_type () = amc$labelled) THEN
          IF NOT state_info^.ve_wrote_ansi_file THEN
            amp$set_file_instance_abnormal (file_identifier, ame$rewrite_labels_conflict,
                  call_block.operation, ' ', status);
            RETURN;
          IFEND;
          IF bap$after_trailer_labels (tape_descriptor^.labeled_volume_position) THEN
            sl_reposition_for_put_at_eoi (file_identifier, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
        put_partial_req (file_identifier, call_block, status);
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := status.normal OR tape_descriptor^.at_eoi;
      = amc$rewind_req =
        rewind_req (file_identifier, call_block, status);
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := FALSE;
      = amc$skip_req =
        validate_skip_parameters (file_identifier, call_block, FALSE, FALSE, TRUE, TRUE, status);
        IF NOT status.normal THEN
          EXIT /main_program/;
        IFEND;
        skip_req (file_identifier, call_block, status);
        file_instance^.previous_get_at_eoi := FALSE;
      = amc$write_tape_mark_req =
        IF bai$label_type () = amc$labelled THEN
          amp$set_file_instance_abnormal (file_identifier, ame$improper_labelled_tape_op,
                call_block.operation, 'WRITE OF TAPE MARK', status);
          EXIT /main_program/;
        IFEND;

{   Check if last operation was read type that left tape logically at mid_block

        IF bai$partial_read_block_exists () THEN
          switch_from_read_to_write (file_identifier, status);
          IF NOT status.normal THEN
            EXIT /main_program/;
          IFEND;
        IFEND;
        write_tape_mark_req (file_identifier, call_block, status);
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := status.normal OR tape_descriptor^.at_eoi;
      ELSE

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

      CASEND;

    END /main_program/;

    IF (operation >= amc$last_access_start) AND (operation <= amc$max_operation)
          AND (operation <> amc$fetch_req) AND
          (operation <> amc$fetch_access_information_rq) THEN
      gfi^.last_access_operation := operation;
    IFEND;
    IF status.normal THEN
      gfi^.error_status := 0;
    ELSE
      gfi^.error_status := status.condition;
    IFEND;

{
{   IF the operator terminates a tape assignment that was initiated via bai$advance_volume,
{   the file will be closed at this point.  It cannot be closed in bai$advance_volume since
{   the global_file_information may be referenced after the call.
{

    IF close_file_on_exit THEN
      bap$close (file_identifier, local_status);
    IFEND;

  PROCEND bap$lrt_us_undef_tape_fap;
?? TITLE := 'get_next_req', EJECT ??

{
{ The purpose of this request is to cause the transfer of data from tape to a
{ tape buffer, transfer data from the tape buffer to the users working
{ storage area, and to update all file descriptor fields.
{

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

    CONST
      allow_direct_io_transfer = TRUE,
      start_new_block = TRUE;

    IF bai$partial_block_exists () THEN
      bai$write_previous_block (file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF (call_block.getn.working_storage_length < 0) OR (call_block.getn.
          working_storage_length > UPPERVALUE (amt$working_storage_length)) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_wsl_value,
            operation, ' ', status);
      RETURN;
    IFEND;

    get_data (file_identifier, operation, call_block.getn.working_storage_area, call_block.getn.
          working_storage_length, allow_direct_io_transfer, start_new_block,
          {convert_if_ebcdic =} TRUE, status);

    IF gfi^.positioning_info.block_info.block_position = bac$middle_of_block THEN
      gfi^.positioning_info.record_info.file_position := amc$mid_record;
    ELSEIF (tape_descriptor^.volume_position = amc$eov) OR
    {} (tape_descriptor^.volume_position = amc$after_tapemark) THEN
      gfi^.positioning_info.record_info.file_position := amc$eoi;
      file_instance^.previous_get_at_eoi := TRUE;
      tape_descriptor^.at_eoi := TRUE;
    ELSE
      gfi^.positioning_info.record_info.file_position := amc$eor;
    IFEND;

    call_block.getn.file_position^ := gfi^.positioning_info.record_info.file_position;
    call_block.getn.transfer_count^ := gfi^.positioning_info.record_info.transfer_count;
    gfi^.positioning_info.record_info.record_length := block_info^.current_block_byte_address;

  PROCEND get_next_req;

?? TITLE := 'get_partial_req', EJECT ??

{
{ The purpose of this request is to cause a partial transfer of data from tape to a
{ tape buffer, transfer data from the tape buffer to the users working
{ storage area, and to update all file descriptor fields.
{

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

    CONST
      allow_direct_io_transfer = FALSE;

    IF bai$partial_block_exists () THEN
      bai$write_previous_block (file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF (call_block.getp.working_storage_length < 0) OR (call_block.getp.
          working_storage_length > UPPERVALUE (amt$working_storage_length)) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_wsl_value,
            operation, ' ', status);
      RETURN;
    IFEND;

    IF (call_block.getp.skip_option < LOWERVALUE (amt$skip_option)) OR
          (call_block.getp.skip_option > UPPERVALUE (amt$skip_option)) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_skip_option,
            operation, ' ', status);
      RETURN;
    IFEND;

    get_data (file_identifier, operation, call_block.getp.working_storage_area, call_block.getp.
          working_storage_length, allow_direct_io_transfer,
          { start_new_block = } call_block.getp.skip_option = amc$skip_to_eor,
          {convert_if_ebcdic =} TRUE, status);

    IF gfi^.positioning_info.block_info.block_position = bac$middle_of_block THEN
      gfi^.positioning_info.record_info.file_position := amc$mid_record;
    ELSEIF (tape_descriptor^.volume_position = amc$eov) OR
    {} (tape_descriptor^.volume_position = amc$after_tapemark) THEN
      gfi^.positioning_info.record_info.file_position := amc$eoi;
      file_instance^.previous_get_at_eoi := TRUE;
      tape_descriptor^.at_eoi := TRUE;
    ELSE
      gfi^.positioning_info.record_info.file_position := amc$eor;
    IFEND;

    gfi^.positioning_info.record_info.record_length := block_info^.current_block_byte_address;
    call_block.getp.record_length^ := gfi^.positioning_info.record_info.record_length;
    call_block.getp.file_position^ := gfi^.positioning_info.record_info.file_position;
    call_block.getp.transfer_count^ := gfi^.positioning_info.record_info.transfer_count;

  PROCEND get_partial_req;
?? TITLE := 'put_next_req', EJECT ??

{
{ The purpose of this request is to transfer data from the users
{ working storage area to a tape file, either directly, or through
{ a tape buffer, and to update all file descriptor fields.
{

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

    CONST
      terminate_previous_block = TRUE;

{   Check if last operation was read type that left tape logically at mid_block

    IF bai$partial_read_block_exists () THEN
      switch_from_read_to_write (file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    put_data (file_identifier, operation, call_block.putn.working_storage_area, call_block.putn.
          working_storage_length, amc$terminate, terminate_previous_block,
          {convert_if_ebcdic =} TRUE, status);

    gfi^.positioning_info.record_info.record_length := call_block.putn.working_storage_length;
    gfi^.positioning_info.record_info.transfer_count := call_block.putn.working_storage_length;
    gfi^.positioning_info.record_info.file_position := amc$eor;
    state_info^.put_op := TRUE;

  PROCEND put_next_req;

?? TITLE := 'put_partial_req', EJECT ??

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

    VAR
      terminate_previous_block: boolean;

    IF (call_block.putp.term_option < LOWERVALUE (amt$term_option)) OR
          (call_block.putp.term_option > UPPERVALUE (amt$term_option)) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_term_option,
            operation, ' ', status);
      RETURN;
    IFEND;

{   Check if last operation was read type that left tape logically at mid_block

    IF bai$partial_read_block_exists () THEN
      switch_from_read_to_write (file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    terminate_previous_block := call_block.putp.term_option = amc$start;

    put_data (file_identifier, operation, call_block.putp.working_storage_area, call_block.putp.
          working_storage_length, call_block.putp.term_option, terminate_previous_block,
          {convert_if_ebcdic =} TRUE, status);

    gfi^.positioning_info.record_info.transfer_count := call_block.putp.working_storage_length;

    CASE call_block.putp.term_option OF

    = amc$start =
      gfi^.positioning_info.record_info.record_length := call_block.putp.working_storage_length;

    = amc$continue =
      gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.
            record_info.record_length + call_block.putp.working_storage_length;

    = amc$terminate =
      IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
        gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.
              record_info.record_length + call_block.putp.working_storage_length;
      ELSE
        gfi^.positioning_info.record_info.record_length := call_block.putp.working_storage_length;
      IFEND;
    ELSE
    CASEND;

    IF gfi^.positioning_info.block_info.block_position = bac$middle_of_block THEN
      gfi^.positioning_info.record_info.file_position := amc$mid_record;
    ELSE
      gfi^.positioning_info.record_info.file_position := amc$eor;
    IFEND;

    state_info^.put_op := TRUE;

  PROCEND put_partial_req;
?? TITLE := 'skip_req', EJECT ??

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

    VAR
      block_number: 0 .. amc$max_block_number,
      units_to_skip: amt$skip_count,
      direction: amt$skip_direction,
      error_action: bat$error_actions,
      file_position: amt$file_position,
      tape_failure_modes: amt$tape_failure_modes,
      next_block_is_a_tapemark: boolean,
      label_group: fst$ansi_label_kinds,
      pre_request_volume_position: amt$volume_position,
      request_status: ost$status,
      residual_skip_count: amt$skip_count,
      volume_boundary_encountered: boolean,
      volume_position: amt$volume_position;

  /main_program/
    BEGIN

      file_position := gfi^.positioning_info.record_info.file_position;
      volume_position := tape_descriptor^.volume_position;
      block_number := block_info^.block_number;
      direction := call_block.skp.direction;
      units_to_skip := call_block.skp.count;

{
{ Check block position to see if any partial blocks need to be written out.
{

      IF bai$partial_block_exists () THEN
        bai$write_previous_block (file_identifier, status);
        IF NOT status.normal THEN
          EXIT /main_program/;
        IFEND;
      IFEND;

      CASE call_block.skp.unit OF

?? NEWTITLE := '    skip record', EJECT ??

      = amc$skip_record =

{
{ For undefined record, user specified blocking, this request
{ is asking to skip tape blocks.
{

        IF (units_to_skip = 0) AND (file_position <> amc$mid_record) THEN
          residual_skip_count := 0;
          EXIT /main_program/;
        IFEND;

        volume_boundary_encountered := FALSE;
        pre_request_volume_position := volume_position;

        IF (file_position = amc$mid_record) AND (direction = amc$backward) THEN
          units_to_skip := units_to_skip + 1;
        IFEND;

      /repeat_loop/
        REPEAT

          bap$tape_bm_skip_blocks (file_identifier, direction, units_to_skip, residual_skip_count,
                tape_failure_modes, request_status);

          bai$process_request_status (file_identifier, operation, request_status,
                tape_failure_modes, error_action, status);
          IF NOT status.normal AND (status.condition = ame$input_after_output) THEN
            file_position := amc$eoi;
            volume_position := amc$eov;
            amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, operation,
                    'RECORDS', status);
            EXIT /main_program/;
          IFEND;
          IF error_action = bac$exit_procedure THEN
            EXIT /main_program/;
          IFEND;

          IF (residual_skip_count > 0) AND (direction = amc$forward) THEN
            CASE bai$label_type () OF
            = amc$unlabelled =
              bap$tape_bm_tapemark_check (file_identifier, next_block_is_a_tapemark, request_status);
              bai$process_request_status (file_identifier, operation, request_status,
                    tape_failure_modes, error_action, status);
              IF NOT status.normal OR (error_action = bac$exit_procedure) THEN
                EXIT /main_program/;
              IFEND;
              IF next_block_is_a_tapemark THEN
                bai$advance_volume (file_identifier, volume_position, status);
                IF NOT status.normal THEN
                  EXIT /main_program/;
                IFEND;
                IF volume_position = amc$eov THEN
                  volume_boundary_encountered := TRUE;
                  EXIT /repeat_loop/;
                IFEND;

{ Reset block_number and pre_request_volume_position to account for volume advance.  This
{ needs to be done so the calculation of block_number at the end of the request is correct.

                block_number := block_info^.block_number;
                pre_request_volume_position := volume_position;
                units_to_skip := residual_skip_count;
                error_action := bac$retry_last_request;
              IFEND;
            = amc$labelled =
              sl_read_tape_labels (file_identifier, label_group, status);
              IF status.normal THEN
                IF fsp$volume_trailer_labels (label_group) THEN
                  sl_close_label_volume (file_identifier, status);
                  IF status.normal THEN
                    volume_position := amc$bov;

{ Reset block_number and pre_request_volume_position to account for volume advance.  This
{ needs to be done so the calculation of block_number at the end of the request is correct.

                    block_number := block_info^.block_number;
                    pre_request_volume_position := volume_position;
                    units_to_skip := residual_skip_count;
                    error_action := bac$retry_last_request;
                  IFEND;
                ELSE
                  volume_position := amc$after_tapemark;
                  EXIT /repeat_loop/;
                IFEND;
              ELSE
                CASE status.condition OF
                = ame$invalid_tape_label = {Allow: * data}
                  sl_advance_tapemark (file_identifier, amc$backward, 1, status);
                  IF status.normal THEN
                    sl_advance_tapemark (file_identifier, amc$forward, 1, status);
                    volume_position := amc$after_tapemark;
                    EXIT /repeat_loop/;
                  IFEND;
                = ame$tape_end_of_volume_list =
                  volume_boundary_encountered := TRUE;
                  volume_position := amc$eov;
                  EXIT /repeat_loop/;
                = ame$unexpected_tapemark =
                  sl_advance_tapemark (file_identifier, amc$backward, 2, status);
                  IF status.normal THEN
                    sl_advance_tapemark (file_identifier, amc$forward, 1, status);
                    volume_position := amc$after_tapemark;
                    EXIT /repeat_loop/;
                  IFEND;
                ELSE
                CASEND;
              IFEND;
            = amc$non_standard_labelled =
              bap$tape_bm_tapemark_check (file_identifier, next_block_is_a_tapemark, status);
              IF NOT status.normal THEN
                EXIT /main_program/;
              IFEND;
              IF next_block_is_a_tapemark THEN
                volume_boundary_encountered := TRUE;
              IFEND;
              EXIT /repeat_loop/;
            ELSE
            CASEND;
          IFEND;
        UNTIL error_action <> bac$retry_last_request;

        IF residual_skip_count > 0 THEN

{
{ Must have hit a tape_mark or a volume boundry. }
{

          IF direction = amc$forward THEN
            file_position := amc$eoi;
            IF volume_boundary_encountered THEN
              volume_position := amc$eov;
            ELSE
              volume_position := amc$after_tapemark;
            IFEND;
            amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, operation,
              'RECORDS', status);
          ELSE { direction = amc$backward }
            file_position := amc$boi;
            IF bai$label_type () = amc$labelled THEN
              sl_advance_tapemark (file_identifier, amc$forward, 1, status);
              IF NOT status.normal THEN
                EXIT /main_program/;
              IFEND;
              volume_position := amc$after_tapemark;
              IF tape_descriptor^.next_position.file_section_number = 1 THEN
                amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_boi, operation,
                  'RECORDS', status);
              ELSE
                amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_bot, operation,
                  '', status);
              IFEND;
            ELSE { amc$unlabelled or amc$non_standard_labelled }
              volume_boundary_encountered := NOT request_status.normal AND (request_status.condition =
                    bae$skip_encountered_bov);
              IF volume_boundary_encountered THEN
                volume_position := amc$bov;
              ELSE
                volume_position := amc$before_tapemark;
              IFEND;
              amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_boi, operation,
                'RECORDS', status);
            IFEND;
          IFEND;

        ELSE
          file_position := amc$eor; { The normal case. }
          volume_position := amc$after_data_block;
        IFEND;

        IF direction = amc$forward THEN
          IF pre_request_volume_position <> amc$after_data_block THEN
            block_number := block_number - 1;
          IFEND;
          IF block_number + (units_to_skip - residual_skip_count) <= 0 THEN
            block_number := 1;
          ELSE
            block_number := block_number + (units_to_skip - residual_skip_count);
          IFEND;
        ELSE { direction = amc$backward }
          IF block_number - (call_block.skp.count - residual_skip_count) <= 0 THEN
            block_number := 1;
          ELSE
            block_number := block_number - (call_block.skp.count - residual_skip_count);
          IFEND;
        IFEND;

?? TITLE := '    skip tape marks', EJECT ??

      = amc$skip_tape_mark =

        IF units_to_skip = 0 THEN {no-op.}
          file_instance^.residual_skip_count := 0;
          call_block.skp.file_position^ := file_position;
          RETURN;
        IFEND;

        residual_skip_count := units_to_skip;

        IF direction = amc$forward THEN

        /whileloop/
          WHILE residual_skip_count > 0 DO

            REPEAT
              bap$tape_bm_skip_tapemark (file_identifier, direction, tape_failure_modes, request_status);
              bai$process_request_status (file_identifier, operation, request_status,
                    tape_failure_modes, error_action, status);
              IF NOT status.normal AND (status.condition = ame$input_after_output) THEN
                file_position := amc$eoi;
                volume_position := amc$eov;
                amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, operation,
                        'TAPEMARKS', status);
                EXIT /main_program/;
              IFEND;
              IF error_action = bac$exit_procedure THEN
                EXIT /main_program/;
              IFEND;
            UNTIL error_action <> bac$retry_last_request;

            IF bai$label_type () = amc$unlabelled THEN
              bai$check_tapemark (file_identifier, volume_position, request_status);
              bai$process_request_status (file_identifier, operation, request_status,
                    tape_failure_modes, error_action, status);
              IF NOT status.normal OR (error_action = bac$exit_procedure) THEN
                EXIT /main_program/;
              IFEND;
              CASE volume_position OF
              = amc$after_tapemark =
                residual_skip_count := residual_skip_count - 1;
              = amc$eov =
                bai$advance_volume (file_identifier, volume_position, status);
                IF NOT status.normal THEN
                  EXIT /main_program/;
                IFEND;
                IF volume_position = amc$eov THEN
                  EXIT /whileloop/;
                IFEND;
              ELSE
                ;
              CASEND;
            ELSE { label_type <> amc$unlabelled     }

{
{ Since skipping by tapemarks is illegal on labelled tapes, this call must be for non_standard labels.
{
{ Consecutive tapemarks indicate a null file, not end of volume, and each tapemark needs to be skipped.
{

              residual_skip_count := residual_skip_count - 1;

            IFEND;

          WHILEND /whileloop/;

          IF residual_skip_count > 0 THEN
            amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, operation,
              'TAPEMARKS', status);
          IFEND;
          IF status.normal THEN
            file_position := amc$boi;
            volume_position := amc$after_tapemark;
          ELSE
            file_position := amc$eoi;
            volume_position := amc$eov;
          IFEND;

        ELSE { direction = amc$backward }

          /backloop/
            WHILE residual_skip_count > 0 DO

              REPEAT
                bap$tape_bm_skip_tapemark (file_identifier, direction, tape_failure_modes, request_status);
                bai$process_request_status (file_identifier, operation, request_status,
                      tape_failure_modes, error_action, status);
                IF error_action = bac$exit_procedure THEN
                  EXIT /main_program/;
                IFEND;
                IF NOT status.normal AND (status.condition = ame$skip_encountered_bov) THEN
                  EXIT /backloop/;
                IFEND;
                IF status.normal THEN
                  residual_skip_count := residual_skip_count - 1;
                IFEND;
              UNTIL error_action <> bac$retry_last_request;

            WHILEND /backloop/;

            IF residual_skip_count > 0 THEN
              amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_bov, operation,
                'TAPEMARKS', status);
            IFEND;
            IF status.normal THEN
              file_position := amc$eoi;
              volume_position := amc$before_tapemark;
            ELSE
              file_position := amc$boi;
              volume_position := amc$bov;
            IFEND;
        IFEND;

        block_number := 1;

      ELSE
      CASEND;
?? OLDTITLE ??

    END /main_program/;

    call_block.skp.file_position^ := file_position;
    gfi^.positioning_info.record_info.file_position := file_position;
    file_instance^.residual_skip_count := residual_skip_count;
    tape_descriptor^.volume_position := volume_position;
    block_info^.block_number := block_number;
    block_info^.block_position := bac$beginning_of_block;
    block_info^.current_block_byte_address := 0;
    block_info^.current_block_length := 0;
    block_info^.residual_block_length := 0;
    tape_descriptor^.put_tape_block_buffer := NIL;
    tape_descriptor^.get_tape_block_buffer := NIL;

  PROCEND skip_req;
*copy bai$lrt_common_procedures
MODEND bam$lrt_us_undef_tape_fap;
