?? NEWTITLE := 'NOS/VE Basic Access Method : LRT US Fixed Tape FAP' ??
MODULE bam$lrt_us_fixed_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$partial_record_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 = TRUE,
    record_headers_exist = FALSE;

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

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

  PROCEDURE [XDCL, #GATE] bap#lrt_us_fixed_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_fixed_tape_fap (file_identifier, call_block, layer_number, status);

  PROCEND bap#lrt_us_fixed_tape_fap;
*ifend

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

  PROCEDURE [XDCL, #GATE] bap$lrt_us_fixed_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_fixed_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_fixed_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/F FAP called on CLOSE');
        IF bai$partial_record_exists () THEN
          pad_record;
        IFEND;
        close_req (file_identifier, status);
        bap$close (file_identifier, local_status);
        IF status.normal THEN
          status := local_status;
        IFEND;
      = amc$close_volume_req =
        IF bai$partial_record_exists () THEN
          pad_record;
        IFEND;
        close_volume_req (file_identifier, status);
        file_instance^.previous_get_at_eoi := FALSE;
      = amc$erase_tape_block =
        IF bai$partial_record_exists () THEN
          pad_record;
        IFEND;
        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/F FAP called on 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 =
        IF bai$partial_record_exists () THEN
          pad_record;
        IFEND;
        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, FALSE, 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;

        IF bai$partial_record_exists () THEN
          pad_record;
        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_inforamtion may be referenced after the call.
{

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

  PROCEND bap$lrt_us_fixed_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);

    VAR
      allow_direct_io_transfer : boolean,
      start_new_block : boolean,
      wsl : amt$working_storage_length;

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

    IF bai$partial_record_exists () THEN
      pad_record;
    IFEND;

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

    wsl := call_block.getn.working_storage_length;
    allow_direct_io_transfer := FALSE;

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

    IF (gfi^.positioning_info.record_info.file_position = amc$mid_record) AND (block_info^.
          residual_block_length >= gfi^.positioning_info.record_info.residual_record_length) THEN
      block_info^.current_block_byte_address := block_info^.current_block_byte_address +
            gfi^.positioning_info.record_info.residual_record_length;
      block_info^.residual_block_length := block_info^.residual_block_length -
            gfi^.positioning_info.record_info.residual_record_length;
    IFEND;

    gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length;
    gfi^.positioning_info.record_info.record_length := 0;
    gfi^.positioning_info.record_info.transfer_count := 0;

    IF (block_info^.current_block_byte_address = 0) OR (block_info^.residual_block_length <
          gfi^.max_record_length) THEN
      start_new_block := TRUE;
    ELSE
      start_new_block := FALSE;
    IFEND;

    IF wsl > gfi^.max_record_length THEN
      wsl := gfi^.max_record_length;
    IFEND;

    IF (gfi^.max_record_length = gfi^.max_data_size) AND (wsl = gfi^.max_record_length) THEN
      allow_direct_io_transfer := TRUE;
    IFEND;

  /read_loop/
    WHILE TRUE DO
      get_data (file_identifier, operation, call_block.getn.working_storage_area, wsl,
            allow_direct_io_transfer, start_new_block, {convert_if_ebcdid =} TRUE, status);
      IF NOT start_new_block THEN
        EXIT /read_loop/;
      ELSE
        IF (block_info^.current_block_length >= gfi^.max_record_length) OR
              (block_info^.current_block_length = 0) OR NOT status.normal THEN
          EXIT /read_loop/;
        IFEND;
      IFEND;
    WHILEND /read_loop/;

    IF gfi^.positioning_info.record_info.transfer_count = gfi^.max_record_length THEN
      gfi^.positioning_info.record_info.file_position := amc$eor;
      gfi^.positioning_info.record_info.residual_record_length := 0;
      gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.record_info.transfer_count;
    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$mid_record;
      gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length -
            gfi^.positioning_info.record_info.transfer_count;
      gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.record_info.transfer_count;
    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;

  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;

    VAR
      start_new_block : boolean,
      wsl : amt$working_storage_length;

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

    IF bai$partial_record_exists () THEN
      pad_record;
    IFEND;

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

    wsl := call_block.getp.working_storage_length;

    IF (wsl <= 0) OR (wsl > 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;

    IF (gfi^.positioning_info.record_info.file_position = amc$mid_record) AND
          (call_block.getp.skip_option = amc$skip_to_eor) THEN
      IF block_info^.residual_block_length >= gfi^.positioning_info.record_info.residual_record_length THEN
        block_info^.current_block_byte_address := block_info^.current_block_byte_address +
              gfi^.positioning_info.record_info.residual_record_length;
        block_info^.residual_block_length := block_info^.residual_block_length -
              gfi^.positioning_info.record_info.residual_record_length;
      IFEND;
      gfi^.positioning_info.record_info.file_position := amc$eor;
    IFEND;

    start_new_block := FALSE;
    gfi^.positioning_info.record_info.transfer_count := 0;

    CASE gfi^.positioning_info.record_info.file_position OF

    = amc$mid_record =

      IF wsl > gfi^.positioning_info.record_info.residual_record_length THEN
        wsl := gfi^.positioning_info.record_info.residual_record_length;
      IFEND;

    = amc$boi, amc$eor, amc$eoi =

      IF block_info^.residual_block_length < gfi^.max_record_length THEN
        start_new_block := TRUE;
      IFEND;

      IF wsl > gfi^.max_record_length THEN
        wsl := gfi^.max_record_length;
      IFEND;
{ Initialize_new_record }
      gfi^.positioning_info.record_info.record_length := 0;
      gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length;
    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$tape_rcd_mgr_malfunction, operation,
            'Unknown file_position in get_partial (US, F)', status);
      RETURN;
    CASEND;

  /read_loop/
    WHILE TRUE DO
      get_data (file_identifier, operation, call_block.getp.working_storage_area, wsl,
            allow_direct_io_transfer, start_new_block, {convert_if_ebcdid =} TRUE, status);
      IF NOT start_new_block THEN
        EXIT /read_loop/;
      ELSE
        IF (block_info^.current_block_length >= gfi^.max_record_length) OR
              (block_info^.current_block_length = 0) OR NOT status.normal THEN
          EXIT /read_loop/;
        IFEND;
      IFEND;
    WHILEND /read_loop/;

    gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.record_info.record_length +
          gfi^.positioning_info.record_info.transfer_count;

    IF gfi^.positioning_info.record_info.record_length = gfi^.max_record_length THEN
      gfi^.positioning_info.record_info.file_position := amc$eor;
      gfi^.positioning_info.record_info.residual_record_length := 0;
    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$mid_record;
      gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length -
            gfi^.positioning_info.record_info.record_length;
    IFEND;
    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 := 'pad_record', EJECT ??

  PROCEDURE pad_record;

    VAR
      i : integer,
      padding_area : ^cell,
      padding_length : 0 .. amc$maximum_block - 1,
      working_storage_area : ^char,
      wsa : ^cell;

    IF gfi^.positioning_info.record_info.residual_record_length > 0 THEN
      i := 1;
      wsa := ^tape_descriptor^.put_tape_block_buffer^ [block_info^.
            current_block_byte_address + 1];
      working_storage_area := wsa;
      working_storage_area^ := state_info^.translated_record_padding_char;
      block_info^.current_block_byte_address := block_info^.current_block_byte_address +
            gfi^.positioning_info.record_info.residual_record_length;
      gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.record_info.record_length +
            gfi^.positioning_info.record_info.residual_record_length;
      gfi^.positioning_info.record_info.transfer_count := gfi^.positioning_info.record_info.transfer_count +
            gfi^.positioning_info.record_info.residual_record_length;
      block_info^.current_block_length := block_info^.current_block_length +
            gfi^.positioning_info.record_info.residual_record_length;
      gfi^.positioning_info.record_info.residual_record_length :=
            gfi^.positioning_info.record_info.residual_record_length - 1;

      WHILE gfi^.positioning_info.record_info.residual_record_length > 0 DO
        padding_area := #address (#ring (wsa), #segment (wsa), (#offset (wsa) + i));
        IF i <= gfi^.positioning_info.record_info.residual_record_length THEN
          padding_length := i;
        ELSE
          padding_length := gfi^.positioning_info.record_info.residual_record_length;
        IFEND;
        i#move (wsa, padding_area, padding_length);
        gfi^.positioning_info.record_info.residual_record_length :=
              gfi^.positioning_info.record_info.residual_record_length - padding_length;
        i := i + padding_length;
      WHILEND;

      gfi^.positioning_info.record_info.file_position := amc$eor;
      block_info^.residual_block_length := gfi^.max_data_size -
            block_info^.current_block_byte_address;

    IFEND;

  PROCEND pad_record;
?? 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);

    VAR
      term_option : amt$term_option,
      terminate_previous_block : boolean,
      wsa : ^cell,
      wsl : amt$working_storage_length;


{   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;

    IF bai$partial_record_exists () THEN
      pad_record;
    IFEND;

    wsa := call_block.putn.working_storage_area;

    IF call_block.putn.working_storage_length <= gfi^.max_record_length THEN
      wsl := call_block.putn.working_storage_length;
    ELSE
      wsl := gfi^.max_record_length;
    IFEND;

    gfi^.positioning_info.record_info.record_length := 0;
    gfi^.positioning_info.record_info.transfer_count := 0;

    IF block_info^.current_block_byte_address = 0 THEN
      term_option := amc$start;
      terminate_previous_block := TRUE;
    ELSEIF block_info^.residual_block_length < gfi^.max_record_length THEN
      term_option := amc$start;
      terminate_previous_block := TRUE;
    ELSE  {record fits into current block}
      term_option := amc$continue;
      terminate_previous_block := FALSE;
    IFEND;

    IF (term_option = amc$start) AND (gfi^.max_record_length = gfi^.max_data_size) AND
          (wsl = gfi^.max_record_length) THEN
      term_option := amc$terminate;
    IFEND;

    state_info^.put_op := TRUE;

    put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
          {convert_if_ebcdid =} TRUE, status);
    IF NOT status.normal AND (status.condition <> ame$end_of_tape_op_completed) THEN
      RETURN;
    IFEND;

    IF (wsl = 0) AND terminate_previous_block THEN
      terminate_previous_block := FALSE;
      put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
            {convert_if_ebcdid =} TRUE, status);
      IF NOT status.normal AND (status.condition <> ame$end_of_tape_op_completed) THEN
        RETURN;
      IFEND;
    IFEND;

    gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length - wsl;
    gfi^.positioning_info.record_info.transfer_count := wsl;
    gfi^.positioning_info.record_info.record_length := wsl;

    IF gfi^.positioning_info.record_info.residual_record_length > 0 THEN
      pad_record;
    IFEND;

    gfi^.positioning_info.record_info.residual_record_length := 0;
    gfi^.positioning_info.record_info.file_position := amc$eor;

  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
      term_option : amt$term_option,
      terminate_previous_block : boolean,
      wsa : ^cell,
      wsl : amt$working_storage_length;

{   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;

    wsl := call_block.putp.working_storage_length;
    wsa := call_block.putp.working_storage_area;
    state_info^.put_op := TRUE;

    CASE call_block.putp.term_option OF

    = amc$start =

      IF bai$partial_record_exists () THEN
        pad_record;
      IFEND;

      IF wsl > gfi^.max_record_length THEN
        wsl := gfi^.max_record_length;
      IFEND;

      gfi^.positioning_info.record_info.record_length := 0;
      gfi^.positioning_info.record_info.transfer_count := 0;

      IF block_info^.current_block_byte_address = 0 THEN
        term_option := amc$start;
        terminate_previous_block := TRUE;
      ELSEIF block_info^.residual_block_length < gfi^.max_record_length THEN
        term_option := amc$start;
        terminate_previous_block := TRUE;
      ELSE  {record fits into current block}
        term_option := amc$continue;
        terminate_previous_block := FALSE;
      IFEND;

      IF (term_option = amc$start) AND (gfi^.max_record_length = gfi^.max_data_size) AND
            (wsl = gfi^.max_record_length) THEN
        term_option := amc$terminate;
      IFEND;

      put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
            {convert_if_ebcdid =} TRUE, status);
      IF NOT status.normal AND (status.condition <> ame$end_of_tape_op_completed) THEN
        RETURN;
      IFEND;

      IF (wsl = 0) AND terminate_previous_block THEN
        terminate_previous_block := FALSE;
        put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
              {convert_if_ebcdid =} TRUE, status);
        IF NOT status.normal AND (status.condition <> ame$end_of_tape_op_completed) THEN
          RETURN;
        IFEND;
      IFEND;

      gfi^.positioning_info.record_info.record_length := wsl;
      gfi^.positioning_info.record_info.transfer_count := wsl;
      gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length - wsl;
      gfi^.positioning_info.record_info.file_position := amc$mid_record;

    = amc$continue =

      IF gfi^.positioning_info.record_info.file_position <> amc$mid_record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$improper_continue,
              call_block.operation, ' ', status);
        RETURN;
      IFEND;

      IF wsl > gfi^.positioning_info.record_info.residual_record_length THEN
        wsl := gfi^.positioning_info.record_info.residual_record_length;
      IFEND;

      terminate_previous_block := FALSE;
      term_option := amc$continue;

      put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
            {convert_if_ebcdid =} TRUE, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      gfi^.positioning_info.record_info.residual_record_length :=
            gfi^.positioning_info.record_info.residual_record_length - wsl;
      gfi^.positioning_info.record_info.transfer_count := wsl;
      gfi^.positioning_info.record_info.record_length := gfi^.max_record_length -
            gfi^.positioning_info.record_info.residual_record_length;
      gfi^.positioning_info.record_info.file_position := amc$mid_record;

    = amc$terminate=

      IF bai$partial_record_exists () THEN
        IF wsl > gfi^.positioning_info.record_info.residual_record_length THEN
          wsl := gfi^.positioning_info.record_info.residual_record_length;
        IFEND;

        term_option := amc$continue;
        terminate_previous_block := FALSE;

        put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
              {convert_if_ebcdid =} TRUE, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        gfi^.positioning_info.record_info.residual_record_length :=
              gfi^.positioning_info.record_info.residual_record_length - wsl;
        gfi^.positioning_info.record_info.transfer_count := wsl;

        IF gfi^.positioning_info.record_info.residual_record_length > 0 THEN
          pad_record;
        IFEND;

      ELSE

        IF wsl > gfi^.max_record_length THEN
          wsl := gfi^.max_record_length;
        IFEND;

        gfi^.positioning_info.record_info.record_length := 0;
        gfi^.positioning_info.record_info.transfer_count := 0;

        IF block_info^.current_block_byte_address = 0 THEN
          term_option := amc$start;
          terminate_previous_block := TRUE;
        ELSEIF block_info^.residual_block_length < gfi^.max_record_length THEN
          term_option := amc$start;
          terminate_previous_block := TRUE;
        ELSE  {record fits into current block}
          term_option := amc$continue;
          terminate_previous_block := FALSE;
        IFEND;

        IF (term_option = amc$start) AND (gfi^.max_record_length = gfi^.max_data_size) AND
              (wsl = gfi^.max_record_length) THEN
          term_option := amc$terminate;
        IFEND;

        put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
              {convert_if_ebcdid =} TRUE, status);
        IF NOT status.normal AND (status.condition <> ame$end_of_tape_op_completed) THEN
          RETURN;
        IFEND;

        IF (wsl = 0) AND terminate_previous_block THEN
          terminate_previous_block := FALSE;
          put_data (file_identifier, operation, wsa, wsl, term_option, terminate_previous_block,
                {convert_if_ebcdid =} TRUE, status);
          IF NOT status.normal AND (status.condition <> ame$end_of_tape_op_completed) THEN
            RETURN;
          IFEND;
        IFEND;

        gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length - wsl;
        gfi^.positioning_info.record_info.transfer_count := wsl;

        IF gfi^.positioning_info.record_info.residual_record_length > 0 THEN
          pad_record;
        IFEND;

      IFEND;

      gfi^.positioning_info.record_info.file_position := amc$eor;
      gfi^.positioning_info.record_info.record_length := gfi^.max_record_length;
      gfi^.positioning_info.record_info.residual_record_length := 0;
    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$improper_term_option,
            operation, ' ', status);
    CASEND;

  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);

    CONST
      allow_direct_io_transfer = FALSE,
      start_new_block = TRUE;

    VAR
      block_number: 0 .. amc$max_block_number,
      dummy_wsa : char,
      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,
      records_remaining: amt$skip_count,
      request_status: ost$status,
      residual_skip_count: amt$skip_count,
      volume_position: amt$volume_position,
      working_storage_area : ^char,
      wsa : ^cell;


  /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 file position to see if any partial blocks need to be written out.
{
      IF bai$partial_record_exists () THEN
        pad_record;
      IFEND;

      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 =

        IF file_position = amc$mid_record THEN
          IF block_info^.residual_block_length >= gfi^.positioning_info.
                record_info.residual_record_length THEN
            block_info^.current_block_byte_address := block_info^.current_block_byte_address +
                  gfi^.positioning_info.record_info.residual_record_length;
            block_info^.residual_block_length := block_info^.residual_block_length -
                  gfi^.positioning_info.record_info.residual_record_length;
          IFEND;
          file_position := amc$eor;
        IFEND;
        gfi^.positioning_info.record_info.residual_record_length := gfi^.max_record_length;
        gfi^.positioning_info.record_info.record_length := 0;

        IF units_to_skip = 0 THEN
          residual_skip_count := 0;
          EXIT /main_program/;
        IFEND;

        working_storage_area := ^dummy_wsa;
        wsa := working_storage_area;

        IF block_info^.current_block_byte_address <> 0 THEN
          records_remaining := block_info^.residual_block_length DIV
                gfi^.max_record_length;
          IF records_remaining >= units_to_skip THEN  {skip can be done within current block}
            residual_skip_count := 0;
            file_position := amc$eor;
            block_info^.current_block_byte_address := block_info^.current_block_byte_address +
                    (units_to_skip * gfi^.max_record_length);
            block_info^.residual_block_length := block_info^.current_block_length -
                    block_info^.current_block_byte_address;
            EXIT /main_program/;

          ELSE
            units_to_skip := units_to_skip - records_remaining;

          IFEND;
        IFEND;

      /read_loop/
        WHILE TRUE DO
          residual_skip_count := units_to_skip;
          get_data (file_identifier, operation, wsa, {wsl=} 1, allow_direct_io_transfer,
                start_new_block, {convert_if_ebcdid =} TRUE, status);

          IF (tape_descriptor^.volume_position = amc$eov) OR
                (tape_descriptor^.volume_position = amc$after_tapemark) THEN
            EXIT /read_loop/;

          ELSE
            IF block_info^.current_block_length = 0 THEN
              EXIT /main_program/;   {fatal error occurred}
            IFEND;

            records_remaining := block_info^.current_block_length DIV
                  gfi^.max_record_length;
            IF records_remaining >= units_to_skip THEN  {skip can complete within this block}
              residual_skip_count := 0;
              gfi^.positioning_info.record_info.transfer_count := 0;
              block_info^.current_block_byte_address := units_to_skip * gfi^.max_record_length;
              block_info^.residual_block_length := block_info^.current_block_length -
                      block_info^.current_block_byte_address;
              IF block_info^.residual_block_length = 0 THEN
                block_info^.block_position := bac$beginning_of_block;
              ELSE
                block_info^.block_position := bac$middle_of_block;
              IFEND;
              EXIT /read_loop/;
            ELSE  {must continue reading}
              units_to_skip := units_to_skip - records_remaining;
            IFEND;
          IFEND;
        WHILEND /read_loop/;


        IF residual_skip_count > 0 THEN

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

          file_position := amc$eoi;
          volume_position := tape_descriptor^.volume_position;
          amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, operation,
            'RECORDS', status);

        ELSE
          file_position := amc$eor; { The normal case. }
          volume_position := amc$after_data_block;
        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;

?? OLDTITLE ??
      ELSE
      CASEND;

    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;
    IF call_block.skp.unit = amc$skip_tape_mark THEN
      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;
      gfi^.positioning_info.record_info.residual_record_length := 0;
      gfi^.positioning_info.record_info.record_length := 0;
      tape_descriptor^.put_tape_block_buffer := NIL;
      tape_descriptor^.get_tape_block_buffer := NIL;
    IFEND;

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