?? NEWTITLE := 'NOS/VE Basic Access Method : LRT SS VAR Tape FAP' ??
MODULE bam$lrt_ss_var_tape_fap;

{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 = FALSE,
    record_headers_exist = TRUE;

*if $true(bav$user_fap)
?? TITLE := 'bap#lrt_ss_var_tape_fap', EJECT ??
  VAR
    ttv$layer_number: [XDCL] amt$fap_layer_number := 0;

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

  PROCEND bap#lrt_ss_var_tape_fap;
*ifend

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

  PROCEDURE [XDCL, #GATE] bap$lrt_ss_var_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,
      last_record_header_p: ^bat$record_header,
      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_ss_var_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_ss_var_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);
      state_info := bai$state_info (file_instance);
      static_label := bai$static_label (file_instance);
      rhl := #SIZE(bat$record_header);
      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: SS/V FAP called on CLOSE');
        IF bai$partial_block_exists () THEN
          process_previous_block (file_identifier, status);
        IFEND; { Ignore status.
        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_block_exists()) AND (bai$label_type() = amc$unlabelled) THEN
          process_previous_block (file_identifier, status);
          IF status.normal THEN
            close_volume_req (file_identifier, status);
          IFEND;
        ELSE
          close_volume_req (file_identifier, status);
        IFEND;
        gfi^.positioning_info.record_info.residual_record_length := 0;
        file_instance^.previous_get_at_eoi := FALSE;
      = amc$erase_tape_block =
        IF bai$partial_block_exists () THEN
          process_previous_block (file_identifier, status);
          IF status.normal THEN
            erase_tape_block_req (file_identifier, call_block, status);
          ELSE
            tape_descriptor^.volume_position := amc$after_data_block;
          IFEND;
        ELSE
          erase_tape_block_req (file_identifier, call_block, status);
        IFEND;
        tape_descriptor^.last_data_operation := amc$erase_tape_block;
        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 =
        IF bai$partial_block_exists () THEN
          process_previous_block (file_identifier, status);
          IF status.normal THEN
            flush_req (file_identifier, status);
          IFEND;
        ELSE
          flush_req (file_identifier, status);
        IFEND;
        gfi^.positioning_info.record_info.residual_record_length := 0;
        tape_descriptor^.last_data_operation := amc$flush_req;
      = amc$get_next_req =
        get_next_req (file_identifier, call_block, status);
        tape_descriptor^.last_data_operation := amc$get_next_req;
        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);
        tape_descriptor^.last_data_operation := amc$get_partial_req;
        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: SS/V 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);
        tape_descriptor^.last_data_operation := amc$put_next_req;
        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);
        tape_descriptor^.last_data_operation := amc$put_partial_req;
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := status.normal OR tape_descriptor^.at_eoi;
      = amc$rewind_req =
        IF bai$partial_block_exists () THEN
          process_previous_block (file_identifier, status);
          IF status.normal THEN
            rewind_req (file_identifier, call_block, status);
          IFEND;
        ELSE
          rewind_req (file_identifier, call_block, status);
        IFEND;
        tape_descriptor^.last_data_operation := amc$rewind_req;
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := FALSE;
      = amc$skip_req =
        validate_skip_parameters (file_identifier, call_block, TRUE, FALSE, TRUE, FALSE, status);
        IF NOT status.normal THEN
          EXIT /main_program/;
        IFEND;
        skip_req (file_identifier, call_block, status);
        tape_descriptor^.last_data_operation := amc$skip_req;
        file_instance^.previous_get_at_eoi := FALSE;
      = amc$write_end_partition_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;
        write_end_partition_req (file_identifier, call_block, status);
        tape_descriptor^.last_data_operation := amc$write_end_partition_req;
        file_instance^.previous_get_at_eoi := FALSE;
        tape_descriptor^.at_eoi := status.normal OR tape_descriptor^.at_eoi;
      = 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;
        IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
          last_record_header_p := NIL;
          CASE tape_descriptor^.last_data_operation OF
          = amc$get_next_req, amc$get_partial_req =
            last_record_header_p := #ADDRESS(
              #RING( tape_descriptor^.get_tape_block_buffer),
              #SEGMENT(tape_descriptor^.get_tape_block_buffer),
              gfi^.positioning_info.record_info.record_header_fba);
            CASE last_record_header_p^.header_type OF
            = bac$full_record, bac$end_record =
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
            = bac$start_record =
              last_record_header_p^.header_type := bac$full_record;
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
            = bac$continued_record =
              last_record_header_p^.header_type := bac$end_record;
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
            ELSE
              amp$set_file_instance_abnormal (file_identifier, ame$tape_rcd_mgr_malfunction,
                      operation, 'Incorrect record header in SS/V write_tape_mark', status);
              EXIT /main_program/;
            CASEND;
            block_info^.block_position := bac$middle_of_block;
            gfi^.positioning_info.record_info.file_position := amc$eor;
          ELSE
          CASEND;
        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_block_exists () THEN
          process_previous_block (file_identifier, status);
          IF NOT status.normal THEN
            EXIT /main_program/;
          IFEND;
        IFEND;

        write_tape_mark_req (file_identifier, call_block, status);
        tape_descriptor^.last_data_operation := amc$write_tape_mark_req;
        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_ss_var_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 = FALSE;

    VAR
      data_length : 0 .. amc$maximum_block - 1,
      exit_situation : boolean,
      get_size : 0 .. amc$maximum_block - 1,
      last_record_header_p: ^bat$record_header,
      manually_advance_to_next_block: boolean,
      more_data : boolean,
      no_header_read : boolean,
      residual_data_length : 0 .. amc$maximum_block - 1,
      rh: bat$record_header,
      start_new_block : boolean,
      wsa : ^cell,
      wsl : amt$working_storage_length,
      zero_length_record : boolean;


*copy bai$get_record_header


      status.normal := TRUE;
      call_block.getn.transfer_count^ := 0;
      data_length := 0;
      exit_situation := FALSE;
      last_record_header_p := NIL;
      manually_advance_to_next_block := FALSE;
      more_data := TRUE;
      no_header_read := FALSE;
      residual_data_length := gfi^.positioning_info.record_info.residual_record_length;
      start_new_block := FALSE;
      wsa := call_block.getn.working_storage_area;
      wsl := call_block.getn.working_storage_length;
      zero_length_record := 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;


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

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

  /main_program/
    BEGIN


{
{  Advance forward to the next record boundary if necessary.
{


      IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN

        REPEAT
          block_info^.current_block_byte_address :=
            block_info^.current_block_byte_address + residual_data_length;
          block_info^.residual_block_length :=
            block_info^.residual_block_length - residual_data_length;
          bai$get_record_header;
          IF (NOT status.normal) OR (no_header_read) THEN
            EXIT /main_program/;
          IFEND;
        UNTIL (rh.header_type = bac$start_record) OR
              (rh.header_type = bac$full_record) OR
              (rh.header_type = bac$partition);

        IF (zero_length_record) OR (rh.header_type = bac$partition) THEN
          EXIT /main_program/;
        IFEND;

      IFEND;


      WHILE more_data DO

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

        IF residual_data_length = 0 THEN
          bai$get_record_header;
          IF exit_situation THEN
            EXIT /main_program/;
          IFEND;
        IFEND;

        IF wsl > residual_data_length THEN
          CASE rh.header_type OF
            = bac$start_record, bac$continued_record =
                get_size := residual_data_length;
            = bac$full_record, bac$end_record =
                get_size := residual_data_length;
                more_data := FALSE;
            ELSE
              amp$set_file_instance_abnormal (file_identifier,
                ame$improper_record_header, call_block.operation,
                ' ', status);
              RETURN;
          CASEND;

        ELSE { wsl <= residual_data_length
          get_size := wsl;
          more_data := FALSE;
        IFEND;

        get_data (file_identifier, operation, wsa, get_size, allow_direct_io_transfer,
              start_new_block, {convert_if_ebcdic =} TRUE, status);
        data_length := data_length + gfi^.positioning_info.record_info.transfer_count;
        residual_data_length := residual_data_length - gfi^.positioning_info.record_info.transfer_count;
        IF NOT status.normal THEN
          EXIT /main_program/;
        IFEND;

        IF gfi^.positioning_info.record_info.transfer_count < get_size THEN
          get_size := gfi^.positioning_info.record_info.transfer_count;
        IFEND;


        wsl := wsl - get_size;
        wsa := #address (#ring (wsa), #segment (wsa), (#offset (wsa) + get_size));
      WHILEND;

    END /main_program/;

      IF (tape_descriptor^.volume_position = amc$eov) OR
         (tape_descriptor^.volume_position = amc$after_tapemark) THEN
        CASE bai$label_type() OF
        = amc$unlabelled =
          gfi^.positioning_info.record_info.file_position := amc$eoi;
          file_instance^.previous_get_at_eoi := TRUE;
          tape_descriptor^.at_eoi := TRUE;
        = amc$labelled =
          gfi^.positioning_info.record_info.file_position := amc$eoi;
          file_instance^.previous_get_at_eoi := TRUE;
        = amc$non_standard_labelled =
          gfi^.positioning_info.record_info.file_position := amc$mid_record;
        ELSE
          amp$set_file_instance_abnormal (file_identifier,
            ame$tape_rcd_mgr_malfunction, operation,
            'Unknown file_label_type in get_next_req (SS, V)', status);
        CASEND;
      ELSEIF NOT status.normal THEN
        ;
      ELSEIF zero_length_record THEN
        gfi^.positioning_info.record_info.file_position := amc$eor;
      ELSEIF manually_advance_to_next_block THEN
        ;
      ELSE
        CASE rh.header_type OF
          = bac$start_record, bac$continued_record =
            gfi^.positioning_info.record_info.file_position := amc$mid_record;

          = bac$full_record, bac$end_record =
            IF residual_data_length = 0 THEN
              gfi^.positioning_info.record_info.file_position := amc$eor;
            ELSE
              gfi^.positioning_info.record_info.file_position := amc$mid_record;
            IFEND;

          = bac$partition =
            gfi^.positioning_info.record_info.file_position := amc$eop;

          ELSE
            amp$set_file_instance_abnormal (file_identifier,
              ame$improper_record_header, call_block.operation,
              ' ', status);

        CASEND;
      IFEND;

      IF last_record_header_p <> NIL THEN
        gfi^.positioning_info.record_info.record_header_fba := #OFFSET( last_record_header_p);
      IFEND;

      gfi^.positioning_info.record_info.transfer_count := data_length;
      gfi^.positioning_info.record_info.record_length := data_length;
      gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
      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
      data_length : 0 .. amc$maximum_block - 1,
      exit_situation : boolean,
      get_size : 0 .. amc$maximum_block - 1,
      last_record_header_p: ^bat$record_header,
      manually_advance_to_next_block: boolean,
      more_data : boolean,
      no_header_read : boolean,
      residual_data_length : 0 .. amc$maximum_block - 1,
      rh: bat$record_header,
      start_new_block : boolean,
      wsa : ^cell,
      wsl : amt$working_storage_length,
      zero_length_record : boolean;


*copy bai$get_record_header


      status.normal := TRUE;
      call_block.getn.transfer_count^ := 0;
      data_length := 0;
      exit_situation := FALSE;
      last_record_header_p := NIL;
      manually_advance_to_next_block := FALSE;
      more_data := TRUE;
      no_header_read := FALSE;
      residual_data_length := gfi^.positioning_info.record_info.residual_record_length;
      start_new_block := FALSE;
      wsa := call_block.getp.working_storage_area;
      wsl := call_block.getp.working_storage_length;
      zero_length_record := 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 (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, call_block.operation, ' ', status);
        RETURN;
      IFEND;

      IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
        CASE tape_descriptor^.last_data_operation OF
        = amc$get_next_req, amc$get_partial_req =
          last_record_header_p := #ADDRESS(
            #RING( tape_descriptor^.get_tape_block_buffer),
            #SEGMENT(tape_descriptor^.get_tape_block_buffer),
            gfi^.positioning_info.record_info.record_header_fba);
          rh := last_record_header_p^;

        ELSE
        CASEND;
      IFEND;

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

      IF bai$partial_block_exists () THEN
        process_previous_block (file_identifier, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        gfi^.positioning_info.record_info.record_length := 0;
      IFEND;

  /main_program/
    BEGIN


{
{  Advance forward to the next record boundary if necessary.
{


      IF call_block.getp.skip_option = amc$skip_to_eor THEN
        IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN

          REPEAT
            block_info^.current_block_byte_address :=
              block_info^.current_block_byte_address + residual_data_length;
            block_info^.residual_block_length :=
              block_info^.residual_block_length - residual_data_length;
            bai$get_record_header;
            IF NOT status.normal THEN
              EXIT /main_program/;
            ELSEIF no_header_read THEN
              gfi^.positioning_info.record_info.record_length := 0;
              EXIT /main_program/;
            IFEND;
          UNTIL (rh.header_type = bac$start_record) OR
                (rh.header_type = bac$full_record) OR
                (rh.header_type = bac$partition);

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

          IF (zero_length_record) OR (rh.header_type = bac$partition) THEN
            EXIT /main_program/;
          IFEND;

        IFEND;
      IFEND;

      IF gfi^.positioning_info.record_info.file_position <> amc$mid_record THEN
        gfi^.positioning_info.record_info.record_length := 0;
      IFEND;


      WHILE more_data DO

        gfi^.positioning_info.record_info.transfer_count := 0;
{ ! If prior operation = put_next or put_partial, residual_data_length = 0.    }
        IF residual_data_length = 0 THEN
          bai$get_record_header;
          IF exit_situation THEN
            EXIT /main_program/;
          IFEND;
        IFEND;

        IF wsl > residual_data_length THEN
          CASE rh.header_type OF
            = bac$start_record, bac$continued_record =
                get_size := residual_data_length;
            = bac$full_record, bac$end_record =
                get_size := residual_data_length;
                more_data := FALSE;
            ELSE
              amp$set_file_instance_abnormal (file_identifier,
                ame$improper_record_header, call_block.operation,
                ' ', status);
              RETURN;
          CASEND;

        ELSE { wsl <= residual_data_length
          get_size := wsl;
          more_data := FALSE;
        IFEND;

        get_data (file_identifier, operation, wsa, get_size, allow_direct_io_transfer,
              start_new_block, {convert_if_ebcdic =} TRUE, status);
        data_length := data_length + gfi^.positioning_info.record_info.transfer_count;
        residual_data_length := residual_data_length - gfi^.positioning_info.record_info.transfer_count;
        IF NOT status.normal THEN
          EXIT /main_program/;
        IFEND;

        IF gfi^.positioning_info.record_info.transfer_count < get_size THEN
          get_size := gfi^.positioning_info.record_info.transfer_count;
        IFEND;


        wsl := wsl - get_size;
        wsa := #address (#ring (wsa), #segment (wsa), (#offset (wsa) + get_size));
      WHILEND;

    END /main_program/;

    IF (tape_descriptor^.volume_position = amc$eov) OR
       (tape_descriptor^.volume_position = amc$after_tapemark) THEN
      CASE bai$label_type() OF
      = amc$unlabelled =
        gfi^.positioning_info.record_info.file_position := amc$eoi;
        file_instance^.previous_get_at_eoi := TRUE;
        tape_descriptor^.at_eoi := TRUE;
      = amc$labelled =
        gfi^.positioning_info.record_info.file_position := amc$eoi;
        file_instance^.previous_get_at_eoi := TRUE;
      = amc$non_standard_labelled =
        gfi^.positioning_info.record_info.file_position := amc$mid_record;
      ELSE
        amp$set_file_instance_abnormal (file_identifier,
          ame$tape_rcd_mgr_malfunction, operation,
          'Unknown file_label_type in get_next_req (SS, V)', status);
      CASEND;
    ELSEIF NOT status.normal THEN
      ;
    ELSEIF zero_length_record THEN
      gfi^.positioning_info.record_info.file_position := amc$eor;
    ELSEIF manually_advance_to_next_block THEN
      ;
    ELSE
      CASE rh.header_type OF
        = bac$start_record, bac$continued_record =
          gfi^.positioning_info.record_info.file_position := amc$mid_record;

        = bac$full_record, bac$end_record =
          IF residual_data_length = 0 THEN
            gfi^.positioning_info.record_info.file_position := amc$eor;
          ELSE
            gfi^.positioning_info.record_info.file_position := amc$mid_record;
          IFEND;

        = bac$partition =
          gfi^.positioning_info.record_info.file_position := amc$eop;

        ELSE
          amp$set_file_instance_abnormal (file_identifier,
            ame$improper_record_header, call_block.operation,
            ' ', status);

      CASEND;
    IFEND;

    IF last_record_header_p <> NIL THEN
      gfi^.positioning_info.record_info.record_header_fba := #OFFSET( last_record_header_p);
    IFEND;

    gfi^.positioning_info.record_info.transfer_count := data_length;
    gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.
          record_info.record_length + data_length;
    gfi^.positioning_info.record_info.residual_record_length := residual_data_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;
    call_block.getp.record_length^ := gfi^.positioning_info.record_info.record_length;

  PROCEND get_partial_req;

?? TITLE := 'process_previous_block', EJECT ??

  PROCEDURE process_previous_block (file_identifier: amt$file_identifier;
    VAR status: ost$status);

    VAR
      file_position: amt$file_position,
      last_record_header_p : ^bat$record_header;

      status.normal := TRUE;
      file_position := gfi^.positioning_info.record_info.file_position;
      last_record_header_p := NIL;

      IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
        last_record_header_p := #ADDRESS(
          #RING( tape_descriptor^.put_tape_block_buffer),
          #SEGMENT(tape_descriptor^.put_tape_block_buffer),
          gfi^.positioning_info.record_info.record_header_fba);
        CASE last_record_header_p^.header_type OF
        = bac$start_record =
          last_record_header_p^.header_type := bac$full_record;
          file_position := amc$eor;
        = bac$continued_record =
          last_record_header_p^.header_type := bac$end_record;
          file_position := amc$eor;
        ELSE
        CASEND;
      IFEND;

      bai$write_previous_block (file_identifier, status);
{ !   gfi^.positioning_info.record_info.file_position returned from bai$write_previous_block will always
{     = amc$eor due to oversight of ss/v environment.
{     All instances of calls in all of the tape faps should be changed to
{     set the appropriate file_position after returning from the call.
      IF status.normal THEN
        gfi^.positioning_info.record_info.file_position := file_position;
{       file_position = amc$eor or amc$eop.
      IFEND;


  PROCEND process_previous_block;


?? 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
      data_length : 0 .. amc$maximum_block - 1,
      end_of_data : boolean,
      last_record_header_p: ^bat$record_header,
      max_data_size : 0 .. amc$maximum_block - 1,
      more_data : boolean,
      put_size : 0 .. amc$maximum_block - 1,
      rh : bat$record_header,
      start_of_data : boolean,
      term_option : amt$term_option,
      terminate_previous_block : boolean,
      wsa : ^cell,
      wsl : amt$working_storage_length;


*copy bai$put_record_header_for_putn


  /main_program/
    BEGIN

      status.normal := TRUE;
      data_length := 0;
      end_of_data := FALSE;
      last_record_header_p := NIL;
      max_data_size := gfi^.max_data_size;
      more_data := TRUE;
      start_of_data := TRUE;
      wsa := call_block.putn.working_storage_area;
      wsl := call_block.putn.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 gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
         CASE tape_descriptor^.last_data_operation OF
         = amc$get_next_req, amc$get_partial_req =
           last_record_header_p := #ADDRESS(
             #RING( tape_descriptor^.get_tape_block_buffer),
             #SEGMENT(tape_descriptor^.get_tape_block_buffer),
             gfi^.positioning_info.record_info.record_header_fba);
           CASE last_record_header_p^.header_type OF
           = bac$full_record, bac$end_record =
             last_record_header_p^.length := last_record_header_p^.length -
               gfi^.positioning_info.record_info.residual_record_length;
           = bac$start_record =
             last_record_header_p^.header_type := bac$full_record;
             last_record_header_p^.length := last_record_header_p^.length -
               gfi^.positioning_info.record_info.residual_record_length;
           = bac$continued_record =
             last_record_header_p^.header_type := bac$end_record;
             last_record_header_p^.length := last_record_header_p^.length -
               gfi^.positioning_info.record_info.residual_record_length;
           ELSE
             amp$set_file_instance_abnormal (file_identifier, ame$tape_rcd_mgr_malfunction,
                     operation, 'Incorrect record header in SS/V put_next_req', status);
             RETURN;
           CASEND;
           block_info^.block_position := bac$middle_of_block;

         = amc$put_partial_req =
           last_record_header_p := #ADDRESS(
             #RING( tape_descriptor^.put_tape_block_buffer),
             #SEGMENT(tape_descriptor^.put_tape_block_buffer),
             gfi^.positioning_info.record_info.record_header_fba);
           CASE last_record_header_p^.header_type OF
           = bac$start_record =
             last_record_header_p^.header_type := bac$full_record;
           = bac$continued_record =
             last_record_header_p^.header_type := bac$end_record;
           ELSE
           CASEND;
         ELSE
         CASEND;
       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;

        WHILE more_data DO
          IF (bai$partial_block_exists ()) AND
            (rhl <= block_info^.residual_block_length) THEN
            terminate_previous_block := FALSE;

            IF rhl + wsl <= block_info^.residual_block_length THEN
              put_size := wsl;
              end_of_data := TRUE;
{ ! Never attempt to flush the current block in case the next request needs    }
{   to examine the last record header.                                         }
              term_option := amc$continue;
              bai$put_record_header_for_putn;
              IF (wsl = 0) OR (NOT status.normal) THEN
                EXIT /main_program/;
              IFEND;
{ ! Never attempt to flush the current block in case the next request needs    }
{   to examine the last record header.                                         }
              term_option := amc$continue;
              more_data := FALSE;

            ELSE { rhl + wsl > block_info^.residual_block_length
              IF rhl = block_info^.residual_block_length THEN
{ ! Don't put header only in block when wsl <> 0.                             }
                term_option := amc$terminate;
                put_size := 0;
              ELSE
                put_size := block_info^.residual_block_length - rhl;
{               end_of_data := FALSE;
                term_option := amc$continue;
                bai$put_record_header_for_putn;
                IF NOT status.normal THEN
                  EXIT /main_program/;
                IFEND;
{ ! Never attempt to flush the current block in case the next request          }
{   hits EOT. (labelled tapes)                                                 }
                term_option := amc$continue;

              IFEND;
            IFEND;
          ELSE
            terminate_previous_block := TRUE;

            IF rhl + wsl <= max_data_size THEN
              put_size := wsl;
              end_of_data := TRUE;
              term_option := amc$start;
              bai$put_record_header_for_putn;
              IF (wsl = 0) OR (NOT status.normal) THEN
                EXIT /main_program/;
              IFEND;
              terminate_previous_block := FALSE;
              term_option := amc$continue;
              more_data := FALSE;

            ELSE { rhl + wsl > max_data_size
              put_size := max_data_size - rhl;
{             end_of_data := FALSE;
              term_option := amc$start;
              bai$put_record_header_for_putn;
              IF NOT status.normal THEN
                EXIT /main_program/;
              IFEND;
              terminate_previous_block := FALSE;
{ ! Never attempt to flush the current block in case the next request          }
{   hits EOT. (labelled tapes)                                                 }
              term_option := amc$continue;

            IFEND;
          IFEND;

          put_data (file_identifier, operation, wsa, put_size, term_option,
                terminate_previous_block, {convert_if_ebcdic =} TRUE, status);

          IF NOT status.normal THEN
            IF (status.condition = ame$end_of_tape_op_completed) THEN
              data_length := data_length + put_size;
            IFEND;
            EXIT /main_program/;
          IFEND;

          data_length := data_length + put_size;
          wsl := wsl - put_size;
          wsa := #address (#ring (wsa), #segment (wsa), (#offset (wsa) + put_size));
        WHILEND;

    END /main_program/;

    state_info^.put_op := TRUE;

{ The following check will set file_position to mid_record if an abnormal condition
{ occurred (such as unrecovered write error).  End of tape errors will never happen
{ for labelled or unlabelled operations.  If label type is non_standard, the file is
{ really at EOR if the error is ame$end_of_tape_op_completed and end_of_data = TRUE.

    IF NOT status.normal THEN
      IF (status.condition = ame$end_of_tape_op_completed) AND (end_of_data) THEN
        gfi^.positioning_info.record_info.file_position := amc$eor;
      ELSE
        gfi^.positioning_info.record_info.file_position := amc$mid_record;
      IFEND;
    ELSE
      gfi^.positioning_info.record_info.file_position := amc$eor;
    IFEND;

    IF last_record_header_p <> NIL THEN
      gfi^.positioning_info.record_info.record_header_fba := #OFFSET( last_record_header_p);
    IFEND;

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

  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
      data_length : 0 .. amc$maximum_block - 1,
      end_of_data : boolean,
      last_record_header_p: ^bat$record_header,
      max_data_size : 0 .. amc$maximum_block - 1,
      more_data : boolean,
      put_size : 0 .. amc$maximum_block - 1,
      rh: bat$record_header,
      start_of_data : boolean,
      term_option : amt$term_option,
      terminate_previous_block : boolean,
      wsa : ^cell,
      wsl : amt$working_storage_length;


*copy bai$put_record_header_for_putp


  /main_program/
      BEGIN

        status.normal := TRUE;
        data_length := 0;
        end_of_data := FALSE;
        last_record_header_p := NIL;
        max_data_size := gfi^.max_data_size;
        more_data := TRUE;
        start_of_data := TRUE;
        wsa := call_block.putp.working_storage_area;
        wsl := call_block.putp.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.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, call_block.operation, ' ',
            status);
          RETURN;
        IFEND;

        CASE call_block.putp.term_option OF

        = amc$start =
          CASE tape_descriptor^.last_data_operation OF
          = amc$get_next_req, amc$get_partial_req =
            last_record_header_p := #ADDRESS(
              #RING( tape_descriptor^.get_tape_block_buffer),
              #SEGMENT(tape_descriptor^.get_tape_block_buffer),
              gfi^.positioning_info.record_info.record_header_fba);
            CASE last_record_header_p^.header_type OF
            = bac$full_record, bac$end_record =
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
              block_info^.block_position := bac$middle_of_block;
            = bac$start_record =
              last_record_header_p^.header_type := bac$full_record;
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
              block_info^.block_position := bac$middle_of_block;
            = bac$continued_record =
              last_record_header_p^.header_type := bac$end_record;
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
              block_info^.block_position := bac$middle_of_block;
            ELSE
            CASEND;
          = amc$put_next_req, amc$put_partial_req =
            last_record_header_p := #ADDRESS(
              #RING( tape_descriptor^.put_tape_block_buffer),
              #SEGMENT(tape_descriptor^.put_tape_block_buffer),
              gfi^.positioning_info.record_info.record_header_fba);
            CASE last_record_header_p^.header_type OF
{           = bac$full_record, bac$end_record =
            = bac$start_record =
              last_record_header_p^.header_type := bac$full_record;
            = bac$continued_record =
              last_record_header_p^.header_type := bac$end_record;
            ELSE
            CASEND;
          ELSE
          CASEND;

        = amc$continue =
          IF gfi^.positioning_info.record_info.file_position <> amc$mid_record THEN
            amp$set_file_instance_abnormal (file_identifier, ame$improper_continue,
              operation, ' ', status);
            RETURN;
          IFEND;
          CASE tape_descriptor^.last_data_operation OF
          = amc$get_next_req, amc$get_partial_req =
            last_record_header_p := #ADDRESS(
              #RING( tape_descriptor^.get_tape_block_buffer),
              #SEGMENT(tape_descriptor^.get_tape_block_buffer),
              gfi^.positioning_info.record_info.record_header_fba);
            CASE last_record_header_p^.header_type OF
            = bac$full_record =
              last_record_header_p^.header_type := bac$start_record;
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
            = bac$start_record, bac$continued_record =
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
            = bac$end_record =
              last_record_header_p^.header_type := bac$continued_record;
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
            ELSE
              amp$set_file_instance_abnormal (file_identifier, ame$tape_rcd_mgr_malfunction,
                      operation, 'Incorrect record header in SS/V put_partial_req', status);
              RETURN;
            CASEND;
            block_info^.block_position := bac$middle_of_block;
{         = amc$put_next_req, amc$put_partial_req =
{           last_record_header_p := #ADDRESS(
{             #RING( tape_descriptor^.put_tape_block_buffer),
{             #SEGMENT(tape_descriptor^.put_tape_block_buffer),
{             gfi^.positioning_info.record_info.record_header_fba);
{           CASE last_record_header_p^.header_type OF
{           = bac$full_record =
{           = bac$start_record =
{           = bac$continued_record =
{           = bac$end_record =
{           ELSE
{           CASEND;
          ELSE
          CASEND;

        = amc$terminate =
          CASE tape_descriptor^.last_data_operation OF
          = amc$get_next_req, amc$get_partial_req =
            last_record_header_p := #ADDRESS(
              #RING( tape_descriptor^.get_tape_block_buffer),
              #SEGMENT(tape_descriptor^.get_tape_block_buffer),
              gfi^.positioning_info.record_info.record_header_fba);
            CASE last_record_header_p^.header_type OF
            = bac$full_record =
              IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
                last_record_header_p^.header_type := bac$start_record;
                last_record_header_p^.length := last_record_header_p^.length -
                  gfi^.positioning_info.record_info.residual_record_length;
                block_info^.block_position := bac$middle_of_block;
              IFEND;
            = bac$start_record, bac$continued_record =
              last_record_header_p^.length := last_record_header_p^.length -
                gfi^.positioning_info.record_info.residual_record_length;
              block_info^.block_position := bac$middle_of_block;
            = bac$end_record =
              IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
                last_record_header_p^.header_type := bac$continued_record;
                last_record_header_p^.length := last_record_header_p^.length -
                  gfi^.positioning_info.record_info.residual_record_length;
                block_info^.block_position := bac$middle_of_block;
              IFEND;
            ELSE
            CASEND;
{         = amc$put_next_req, amc$put_partial_req =
{           last_record_header_p := #ADDRESS(
{             #RING( tape_descriptor^.put_tape_block_buffer),
{             #SEGMENT(tape_descriptor^.put_tape_block_buffer),
{             gfi^.positioning_info.record_info.record_header_fba);
{           CASE last_record_header_p^.header_type OF
{           = bac$full_record =
{           = bac$start_record =
{           = bac$continued_record =
{           = bac$end_record =
{           ELSE
{           CASEND;
          ELSE
          CASEND;
        ELSE
        CASEND;

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

        WHILE more_data DO
          IF (bai$partial_block_exists ()) AND
            (rhl <= block_info^.residual_block_length) THEN
            terminate_previous_block := FALSE;

            IF rhl + wsl <= block_info^.residual_block_length THEN
              put_size := wsl;
              end_of_data := TRUE;
{ ! Never attempt to flush the current block in case the next request needs    }
{   to alter the last record header.                                           }
              term_option := amc$continue;
              bai$put_record_header_for_putp;
              IF (wsl = 0) OR (NOT status.normal) THEN
                EXIT /main_program/;
              IFEND;
{ ! Never attempt to flush the current block in case the next request needs    }
{   to alter the last record header.                                           }
              term_option := amc$continue;
              more_data := FALSE;

            ELSE { rhl + wsl > block_info^.residual_block_length
              IF rhl = block_info^.residual_block_length THEN
{ ! Don't put header only in block when wsl <> 0.                             }
                term_option := amc$terminate;
                put_size := 0;
              ELSE
                put_size := block_info^.residual_block_length - rhl;
{               end_of_data := FALSE;
                term_option := amc$continue;
                bai$put_record_header_for_putp;
                IF NOT status.normal THEN
                  EXIT /main_program/;
                IFEND;
{ ! Never attempt to flush the current block in case the next request          }
{   hits EOT. (labelled tapes)                                                 }
                term_option := amc$continue;

              IFEND;
            IFEND;
          ELSE
            terminate_previous_block := TRUE;

            IF rhl + wsl <= max_data_size THEN
              put_size := wsl;
              end_of_data := TRUE;
              term_option := amc$start;
              bai$put_record_header_for_putp;
              IF (wsl = 0) OR (NOT status.normal) THEN
                EXIT /main_program/;
              IFEND;
              terminate_previous_block := FALSE;
              term_option := amc$continue;
              more_data := FALSE;

            ELSE { rhl + wsl > max_data_size
              put_size := max_data_size - rhl;
{             end_of_data := FALSE;
              term_option := amc$start;
              bai$put_record_header_for_putp;
              IF NOT status.normal THEN
                EXIT /main_program/;
              IFEND;
              terminate_previous_block := FALSE;
{ ! Never attempt to flush the current block in case the next request          }
{   hits EOT. (labelled tapes)                                                 }
              term_option := amc$continue;

            IFEND;
          IFEND;

          put_data (file_identifier, operation, wsa, put_size, term_option,
                terminate_previous_block, {convert_if_ebcdic =} TRUE, status);

          IF NOT status.normal THEN
            IF (status.condition = ame$end_of_tape_op_completed) THEN
              data_length := data_length + put_size;
            IFEND;
            EXIT /main_program/;
          IFEND;

          data_length := data_length + put_size;
          wsl := wsl - put_size;
          wsa := #address (#ring (wsa), #segment (wsa), (#offset (wsa) + put_size));
        WHILEND;


      END /main_program/;

      state_info^.put_op := TRUE;

      IF call_block.putp.term_option = amc$start THEN
        gfi^.positioning_info.record_info.file_position := amc$mid_record;
        gfi^.positioning_info.record_info.record_length := data_length;
      ELSEIF call_block.putp.term_option = amc$continue THEN
        gfi^.positioning_info.record_info.file_position := amc$mid_record;
        gfi^.positioning_info.record_info.record_length := gfi^.positioning_info.
              record_info.record_length + data_length;
      ELSE {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 + data_length;
        ELSE
          gfi^.positioning_info.record_info.record_length := data_length;
        IFEND;
        gfi^.positioning_info.record_info.file_position := amc$eor;
      IFEND;

{ The following check will set file_position to mid_record if an abnormal condition
{ occurred (such as unrecovered write error).  End of tape errors will never happen
{ for labelled or unlabelled operations.  If label type is non_standard, the file
{ position is as computed above if the error is ame$end_of_tape_op_completed and
{ end_of_data = TRUE.

      IF NOT status.normal THEN
        IF NOT ((status.condition = ame$end_of_tape_op_completed) AND (end_of_data)) THEN
          gfi^.positioning_info.record_info.file_position := amc$mid_record;
        IFEND;
      IFEND;

      IF last_record_header_p <> NIL THEN
        gfi^.positioning_info.record_info.record_header_fba := #OFFSET( last_record_header_p);
      IFEND;

      gfi^.positioning_info.record_info.transfer_count := data_length;
      gfi^.positioning_info.record_info.residual_record_length := 0;

  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,
      direction: amt$skip_direction,
      error_action: bat$error_actions,
      file_position: amt$file_position,
      last_record_header_p: ^bat$record_header,
      manually_advance_to_next_block: boolean,
      next_record_header_p: ^bat$record_header,
      no_header_read: boolean,
      records_remaining: amt$skip_count,
      request_status: ost$status,
      residual_data_length: 0 .. amc$maximum_block -1,
      residual_skip_count: amt$skip_count,
      rh: bat$record_header,
      skip_zero_completed: boolean,
      tape_failure_modes: amt$tape_failure_modes,
      units_to_skip: amt$skip_count,
      volume_position: amt$volume_position;


*copy bai$skip_to_next_record_header


  /main_program/
    BEGIN

      status.normal := TRUE;
      block_number := block_info^.block_number;
      direction := call_block.skp.direction;
      units_to_skip := call_block.skp.count;
      volume_position := tape_descriptor^.volume_position;

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

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


      CASE call_block.skp.unit OF

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

      = amc$skip_partition =

        last_record_header_p := NIL;
        no_header_read := FALSE;
        residual_data_length := gfi^.positioning_info.record_info.residual_record_length;
        residual_skip_count := units_to_skip;

        CASE tape_descriptor^.last_data_operation OF
        = amc$get_next_req, amc$get_partial_req =
          last_record_header_p := #ADDRESS(
            #RING( tape_descriptor^.get_tape_block_buffer),
            #SEGMENT(tape_descriptor^.get_tape_block_buffer),
            gfi^.positioning_info.record_info.record_header_fba);

        ELSE
        CASEND;

        CASE direction OF
        = amc$forward =

/skip_partition_forward/
  BEGIN
          skip_zero_completed := FALSE;
          CASE gfi^.positioning_info.record_info.file_position OF
          = amc$bop, amc$eop, amc$boi, amc$eoi =
            ;
          ELSE
            REPEAT
              IF residual_data_length = 0 THEN
                bai$skip_to_next_record_header;
                IF (no_header_read) OR (NOT status.normal) THEN
                  EXIT /skip_partition_forward/;
                IFEND;
              IFEND;
              block_info^.current_block_byte_address :=
                block_info^.current_block_byte_address + residual_data_length;
              block_info^.residual_block_length :=
                block_info^.residual_block_length - residual_data_length;
              residual_data_length := 0;
            UNTIL (last_record_header_p^.header_type = bac$partition);
            gfi^.positioning_info.record_info.file_position := amc$bop;
          CASEND;
          skip_zero_completed := TRUE;

          IF units_to_skip = 0 THEN
            call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
            file_instance^.residual_skip_count := residual_skip_count;
            gfi^.positioning_info.record_info.record_length := 0;
            gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
            gfi^.positioning_info.record_info.transfer_count := 0;
            RETURN;
          IFEND;

          IF gfi^.positioning_info.record_info.file_position = amc$eoi THEN
            call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
            file_instance^.residual_skip_count := residual_skip_count;
            gfi^.positioning_info.record_info.record_length := 0;
            gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
            gfi^.positioning_info.record_info.transfer_count := 0;
            amp$set_file_instance_abnormal (file_identifier,
              ame$skip_encountered_eoi, operation, 'PARTITIONS', status);
            RETURN;
          IFEND;

          WHILE residual_skip_count > 0 DO
            REPEAT
              bai$skip_to_next_record_header;
              IF (no_header_read) OR (NOT status.normal) THEN
                EXIT /skip_partition_forward/;
              IFEND;
              block_info^.current_block_byte_address :=
                block_info^.current_block_byte_address + residual_data_length;
              block_info^.residual_block_length :=
                block_info^.residual_block_length - residual_data_length;
              residual_data_length := 0;
            UNTIL (last_record_header_p^.header_type = bac$partition);
            residual_skip_count := residual_skip_count - 1;
          WHILEND;
          gfi^.positioning_info.record_info.file_position := amc$bop;

          call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
          file_instance^.residual_skip_count := residual_skip_count;
          gfi^.positioning_info.record_info.record_length := 0;
          gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
          gfi^.positioning_info.record_info.transfer_count := 0;
          RETURN;

END /skip_partition_forward/;

{ If this point is reached, an error condition (such as unrecovered read error or
{ tapemark encountered) has occurred.

          IF (units_to_skip = 0) AND status.normal THEN
            IF (tape_descriptor^.volume_position = amc$eov) OR
               (tape_descriptor^.volume_position = amc$after_tapemark) THEN
              IF bai$label_type () = amc$unlabelled THEN
                gfi^.positioning_info.record_info.file_position := amc$eoi;
              ELSEIF bai$label_type () = amc$labelled THEN
                gfi^.positioning_info.record_info.file_position := amc$eoi;
                amp$set_file_instance_abnormal (file_identifier,
                  ame$skip_encountered_eoi, operation, 'PARTITIONS', status);
              ELSE  { label_type = amc$non_standard_labelled
                gfi^.positioning_info.record_info.file_position := amc$mid_record;
                amp$set_file_instance_abnormal (file_identifier,
                  ame$skip_encountered_eoi, operation, 'PARTITIONS', status);
              IFEND;
            IFEND;
          IFEND;

          IF (residual_skip_count > 0) AND status.normal THEN
            IF (tape_descriptor^.volume_position = amc$eov) OR
               (tape_descriptor^.volume_position = amc$after_tapemark) THEN
              IF bai$label_type () = amc$unlabelled THEN
{ If skip_zero_completed, decrement 1 from residual skip count since eoi =
{ logical eop.
                IF skip_zero_completed THEN
                  residual_skip_count := residual_skip_count - 1;
                IFEND;
                gfi^.positioning_info.record_info.file_position := amc$eoi;
                IF residual_skip_count > 0 THEN
                  amp$set_file_instance_abnormal (file_identifier,
                    ame$skip_encountered_eoi, operation, 'PARTITIONS', status);
                IFEND;

              ELSEIF bai$label_type () = amc$labelled THEN
{ If skip_zero_completed, decrement 1 from residual skip count since eoi =
{ logical eop.
                IF skip_zero_completed THEN
                  residual_skip_count := residual_skip_count - 1;
                IFEND;
                gfi^.positioning_info.record_info.file_position := amc$eoi;
                IF residual_skip_count > 0 THEN
                  amp$set_file_instance_abnormal (file_identifier,
                        ame$skip_encountered_eoi, operation, 'PARTITIONS', status);
                IFEND;
              ELSE  { amc$non_standard_labelled
                IF skip_zero_completed THEN
                  gfi^.positioning_info.record_info.file_position := amc$eop;
                ELSE
                  gfi^.positioning_info.record_info.file_position := amc$mid_record;
                IFEND;
              IFEND;
            IFEND;
          IFEND;

          call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
          file_instance^.residual_skip_count := residual_skip_count;
          gfi^.positioning_info.record_info.record_length := 0;
          gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
          gfi^.positioning_info.record_info.transfer_count := 0;
          RETURN;

        ELSE

        CASEND;

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

      = amc$skip_record =

        last_record_header_p := NIL;
        no_header_read := FALSE;
        residual_data_length := gfi^.positioning_info.record_info.residual_record_length;
        residual_skip_count := units_to_skip;

        CASE tape_descriptor^.last_data_operation OF
        = amc$get_next_req, amc$get_partial_req =
          last_record_header_p := #ADDRESS(
            #RING( tape_descriptor^.get_tape_block_buffer),
            #SEGMENT(tape_descriptor^.get_tape_block_buffer),
            gfi^.positioning_info.record_info.record_header_fba);

        ELSE
        CASEND;

        CASE direction OF
        = amc$forward =

/skip_record_forward/
  BEGIN
          skip_zero_completed := FALSE;

          IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
            REPEAT
              IF residual_data_length = 0 THEN
                bai$skip_to_next_record_header;
                IF (no_header_read) OR (NOT status.normal) THEN
                  EXIT /skip_record_forward/;
                IFEND;
              IFEND;
              block_info^.current_block_byte_address :=
                block_info^.current_block_byte_address + residual_data_length;
              block_info^.residual_block_length :=
                block_info^.residual_block_length - residual_data_length;
              residual_data_length := 0;
            UNTIL (last_record_header_p^.header_type = bac$full_record) OR
                  (last_record_header_p^.header_type = bac$end_record);
            gfi^.positioning_info.record_info.file_position := amc$eor;
          IFEND;

          skip_zero_completed := TRUE;

          IF units_to_skip = 0 THEN
            call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
            file_instance^.residual_skip_count := residual_skip_count;
            gfi^.positioning_info.record_info.record_length := 0;
            gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
            gfi^.positioning_info.record_info.transfer_count := 0;
            RETURN;
          IFEND;


          WHILE residual_skip_count > 0 DO
            REPEAT
              bai$skip_to_next_record_header;
              IF (no_header_read) OR (NOT status.normal) THEN
                EXIT /skip_record_forward/;
              IFEND;
              block_info^.current_block_byte_address :=
                block_info^.current_block_byte_address + residual_data_length;
              block_info^.residual_block_length :=
                block_info^.residual_block_length - residual_data_length;
              residual_data_length := 0;
            UNTIL (last_record_header_p^.header_type = bac$full_record) OR
                  (last_record_header_p^.header_type = bac$end_record) OR
                  (last_record_header_p^.header_type = bac$partition);

            IF last_record_header_p^.header_type = bac$partition THEN
              gfi^.positioning_info.record_info.file_position := amc$bop;
              amp$set_file_instance_abnormal (file_identifier,
                ame$skip_encountered_eop, operation, 'RECORDS', status);
              EXIT /skip_record_forward/;
            IFEND;

            residual_skip_count := residual_skip_count - 1;
          WHILEND;
          gfi^.positioning_info.record_info.file_position := amc$eor;

          call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
          file_instance^.residual_skip_count := residual_skip_count;
          gfi^.positioning_info.record_info.record_length := 0;
          gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
          gfi^.positioning_info.record_info.transfer_count := 0;
          RETURN;

END /skip_record_forward/;

{ If this point is reached, an error condition (such as unrecovered read error or
{ tapemark encountered) has occurred.

          IF NOT status.normal THEN
            ;
          ELSEIF (units_to_skip = 0) OR (residual_skip_count > 0) THEN
            IF (tape_descriptor^.volume_position = amc$eov) OR
               (tape_descriptor^.volume_position = amc$after_tapemark) THEN
              IF bai$label_type () = amc$unlabelled THEN
{ ! This should never happen. In case it does, set file_position to eoi and
{   set status abnormal.
                gfi^.positioning_info.record_info.file_position := amc$eoi;
              ELSEIF bai$label_type () = amc$labelled THEN
                gfi^.positioning_info.record_info.file_position := amc$eoi;
              ELSE { label_type = amc$non_standard_labelled
                IF skip_zero_completed THEN
                  gfi^.positioning_info.record_info.file_position := amc$eor;
                ELSE
                  gfi^.positioning_info.record_info.file_position := amc$mid_record;
                IFEND;
              IFEND;
              amp$set_file_instance_abnormal (file_identifier,
                ame$skip_encountered_eoi, operation, 'RECORDS', status);
            IFEND;
          IFEND;

          call_block.skp.file_position^ := gfi^.positioning_info.record_info.file_position;
          file_instance^.residual_skip_count := residual_skip_count;
          gfi^.positioning_info.record_info.record_length := 0;
          gfi^.positioning_info.record_info.residual_record_length := residual_data_length;
          gfi^.positioning_info.record_info.transfer_count := 0;

          RETURN;

        ELSE

        CASEND;


?? 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^ := gfi^.positioning_info.record_info.file_position;
          RETURN;
        IFEND;

        residual_skip_count := units_to_skip;
        file_position := gfi^.positioning_info.record_info.file_position;

/skip_tapemark_main/
BEGIN

        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 /skip_tapemark_main/;
              IFEND;
              IF error_action = bac$exit_procedure THEN
                EXIT /skip_tapemark_main/;
              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 /skip_tapemark_main/;
              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 /skip_tapemark_main/;
                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 /skip_tapemark_main/;
                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;

END /skip_tapemark_main/;

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



?? OLDTITLE ??
      ELSE
      CASEND;

    END /main_program/;


  PROCEND skip_req;

?? TITLE := 'write_end_partition_req', EJECT ??

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

    VAR
      last_record_header_p: ^bat$record_header,
      rh : bat$record_header,
      term_option : amt$term_option,
      terminate_previous_block : boolean;

  /main_program/
    BEGIN

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


       IF gfi^.positioning_info.record_info.file_position = amc$mid_record THEN
         CASE tape_descriptor^.last_data_operation OF
         = amc$get_next_req, amc$get_partial_req =
           last_record_header_p := #ADDRESS(
             #RING( tape_descriptor^.get_tape_block_buffer),
             #SEGMENT(tape_descriptor^.get_tape_block_buffer),
             gfi^.positioning_info.record_info.record_header_fba);
           CASE last_record_header_p^.header_type OF
           = bac$full_record, bac$end_record =
             last_record_header_p^.length := last_record_header_p^.length -
               gfi^.positioning_info.record_info.residual_record_length;
           = bac$start_record =
             last_record_header_p^.header_type := bac$full_record;
             last_record_header_p^.length := last_record_header_p^.length -
               gfi^.positioning_info.record_info.residual_record_length;
           = bac$continued_record =
             last_record_header_p^.header_type := bac$end_record;
             last_record_header_p^.length := last_record_header_p^.length -
               gfi^.positioning_info.record_info.residual_record_length;
           ELSE
             amp$set_file_instance_abnormal (file_identifier, ame$tape_rcd_mgr_malfunction,
                     operation, 'Incorrect record header in SS/V write_end_partition', status);
             RETURN;
           CASEND;
           block_info^.block_position := bac$middle_of_block;
           gfi^.positioning_info.record_info.file_position := amc$eor;

         = amc$put_partial_req =
           last_record_header_p := #ADDRESS(
             #RING( tape_descriptor^.put_tape_block_buffer),
             #SEGMENT(tape_descriptor^.put_tape_block_buffer),
             gfi^.positioning_info.record_info.record_header_fba);
           CASE last_record_header_p^.header_type OF
           = bac$start_record =
             last_record_header_p^.header_type := bac$full_record;
           = bac$continued_record =
             last_record_header_p^.header_type := bac$end_record;
           ELSE
           CASEND;
           gfi^.positioning_info.record_info.file_position := amc$eor;

         ELSE
         CASEND;
       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;

      rh.header_type := bac$partition;
      rh.length := 0;
      rh.previous_header_fba := 0;
      rh.unique_id := bac$record_header_unique_id;

      IF (bai$partial_block_exists ()) AND
        (rhl <= block_info^.residual_block_length) THEN
        terminate_previous_block := FALSE;
        term_option := amc$continue;
      ELSE
        terminate_previous_block := TRUE;
        term_option := amc$start;
      IFEND;

      put_data (file_identifier, operation, #LOC(rh), rhl, term_option,
        terminate_previous_block, {convert_if_ebcdic =} FALSE, status);

      IF NOT status.normal THEN
        EXIT /main_program/;
      IFEND;

      last_record_header_p := ^tape_descriptor^.put_tape_block_buffer^
        [block_info^.current_block_byte_address +1 -rhl ];
      gfi^.positioning_info.record_info.record_header_fba := #OFFSET( last_record_header_p);
      gfi^.positioning_info.record_info.file_position := amc$eop;
      gfi^.positioning_info.record_info.transfer_count := 0;
      gfi^.positioning_info.record_info.record_length := 0;
      gfi^.positioning_info.record_info.residual_record_length := 0;

    END /main_program/;

    state_info^.put_op := TRUE;

  PROCEND write_end_partition_req;

*copy bai$lrt_common_procedures
MODEND bam$lrt_ss_var_tape_fap;
