?? TITLE := 'NOS/VE:  BASIC ACCESS METHOD, TASK SERVICES' ??
MODULE bam$sys_blk_variable_rec_fap;
?? RIGHT := 110 ??

?? NEWTITLE := '    Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amc$condition_code_limits
*copyc bac$minimum_open_ring
*copyc osd$virtual_address
*copyc ame$access_validation_errors
*copyc ame$conflicting_access_level
*copyc ame$device_class_validation
*copyc ame$fap_validation_errors
*copyc ame$file_organization_errors
*copyc ame$get_program_actions
*copyc ame$get_validation_errors
*copyc ame$improper_file_id
*copyc ame$improper_random_access
*copyc ame$improper_wsl
*copyc ame$open_validation_errors
*copyc ame$put_program_actions
*copyc ame$put_validation_errors
*copyc ame$ring_validation_errors
*copyc ame$skip_program_actions
*copyc ame$skip_validation_errors
*copyc ame$unimplemented_request
*copyc ife$error_codes
*copyc amt$fap_declarations
*copyc bat$global_file_information
*copyc bat$positioning_info
*copyc bat$private_read_information
*copyc bat$record_header_type
*copyc bat$record_info
*copyc bat$task_file_table
*copyc ost$caller_identifier
?? POP ??
*copyc pmf$job_mode
*copyc amp$set_file_instance_abnormal
*copyc baf$task_file_entry_p
*copyc bap$close
*copyc bap$fetch
*copyc bap$fetch_access_information
*copyc bap$get_segment_pointer
*copyc bap$set_segment_eoi
*copyc bap$set_segment_position
*copyc bap$store
*copyc bap$write_modified_pages
*copyc mmp$set_segment_length
*copyc osp$set_status_abnormal
*copyc bav$task_file_table
*copyc fmv$global_file_information
*copyc i#move
?? OLDTITLE ??
?? NEWTITLE := 'BAP$SYS_BLK_VARIABLE_REC_FAP', EJECT ??

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

    CONST
      error_text = 'BAP$SYS_BLK_VARIABLE_REC_FAP - ';

    VAR
      at_eoi: boolean,
      caller_id: ost$caller_identifier,
      data_ptr: ^cell,
      file_byte_address: amt$file_byte_address,
      file_instance: ^bat$task_file_entry,
      previous_record_header: ^bat$record_header,
      record_header: ^bat$record_header,
      record_info: bat$record_info;

?? NEWTITLE := 'ROLLBACK_PROCEDURE', EJECT ??

    PROCEDURE rollback_procedure
      (    condition_status: ost$status);

      status := condition_status;
      file_instance^.rollback_procedure := NIL;

{ Since all positioning info is kept local to the fap until the
{ positioning operation is complete, exiting the fap before the
{ tft of gfi are updated effectively achieves rollback.

      EXIT bap$sys_blk_variable_rec_fap; {----->

    PROCEND rollback_procedure;
?? OLDTITLE ??
?? NEWTITLE := '[inline] GET_NEXT', EJECT ??

    PROCEDURE [INLINE] get_next;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

*copy bai$validate_read_access
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    /main_code_get_next/
      BEGIN
*copy bai$get_record_info

{ Note that wsl is in the same position for get operation call_blocks.
        IF (record_info.file_position = amc$mid_record)
{     } AND (file_instance^.private_read_information = NIL)
{     } AND (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.
          record_info.file_position := amc$eor;
          update_eoi
        IFEND;

        IF (record_info.file_position = amc$mid_record)
{     } AND (record_info.current_byte_address < file_instance^.global_file_information^.eoi_byte_address) THEN
          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.bor_address);
          IF (record_header^.unique_id = bac$record_header_unique_id)
{       } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{       } AND (record_header^.length >= LOWERVALUE (record_header^.length)) THEN
            record_info.current_byte_address := record_info.bor_address + record_header^.length +
                  #SIZE (bat$record_header)
          ELSE
            amp$set_file_instance_abnormal (file_identifier, ame$improper_record_header, call_block.operation,
                  error_text, status);
            RETURN; {----->
          IFEND;
        IFEND;

*copy   bai$get_eoi_check
        IF NOT status.normal THEN
          EXIT /main_code_get_next/; {----->
        IFEND;

        IF NOT at_eoi THEN
*copy     bai$validate_record_header
          IF NOT status.normal THEN
            EXIT /main_code_get_next/; {----->
          IFEND;

          record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header);

          IF call_block.getn.working_storage_length >= record_header^.length THEN
            record_info.record_length := record_header^.length;
            record_info.file_position := amc$eor;
          ELSE
            record_info.record_length := call_block.getn.working_storage_length;
            record_info.file_position := amc$mid_record;
          IFEND;
          IF record_header^.header_type = bac$partition THEN
            record_info.file_position := amc$eop;
          IFEND;

          data_ptr := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.current_byte_address);

          i#move (data_ptr, call_block.getn.working_storage_area, record_info.record_length);

          record_info.current_byte_address := record_info.current_byte_address + record_info.record_length;

        ELSE { at eoi }
          record_info.record_length := 0;
        IFEND; { NOT at eoi }
      END /main_code_get_next/;

*copy bai$save_record_info

      call_block.getn.file_position^ := record_info.file_position;
      call_block.getn.transfer_count^ := record_info.record_length;
      IF call_block.operation = amc$get_next_req THEN
        IF at_eoi THEN
          call_block.getn.byte_address^ := file_instance^.global_file_information^.eoi_byte_address;
        ELSE
          call_block.getn.byte_address^ := record_info.bor_address;
        IFEND;
      IFEND;

    PROCEND get_next;
?? OLDTITLE ??
?? NEWTITLE := '[inline] PUT_NEXT', EJECT ??

    PROCEDURE [INLINE] put_next;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

*copy bai$validate_write_access
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      record_info := file_instance^.global_file_information^.positioning_info.record_info;
      record_info.record_length := call_block.putn.working_storage_length;

{ Check to make sure we do not go over the 2 GB file limit.
      IF file_instance^.global_file_information^.file_limit <
            record_info.current_byte_address + record_info.record_length + #SIZE (bat$record_header) THEN
        amp$set_file_instance_abnormal (file_identifier, ame$put_beyond_file_limit, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

      IF record_info.file_position = amc$mid_record THEN

{ Put correct length in header of record that is about to be truncated.
        record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), record_info.bor_address);
        record_header^.length := record_info.current_byte_address - record_info.bor_address -
              #SIZE (bat$record_header);
      IFEND;

*copy bai$write_record_header
      record_header^.length := record_info.record_length;
      data_ptr := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
            record_info.current_byte_address);
      i#move (call_block.putn.working_storage_area, data_ptr, record_info.record_length);
      record_info.current_byte_address := record_info.current_byte_address + record_info.record_length;

      record_info.file_position := amc$eor;
      file_instance^.instance_of_open_modified := TRUE;

*copy bai$update_eoi
      file_instance^.global_file_information^.positioning_info.record_info := record_info;

      IF call_block.operation = amc$put_next_req THEN
        call_block.putn.byte_address^ := record_info.bor_address;
      IFEND;

    PROCEND put_next;
?? OLDTITLE ??
?? NEWTITLE := '[inline] GET_PARTIAL', EJECT ??

    PROCEDURE [INLINE] get_partial;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

*copy bai$validate_read_access
      IF NOT status.normal THEN
        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,
              error_text, status);
        RETURN; {----->
      IFEND;

    /main_code_get_partial/
      BEGIN
*copy   bai$get_record_info

        IF (record_info.file_position = amc$mid_record)
{     } AND (file_instance^.private_read_information = NIL)
{     } AND (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.

          record_info.file_position := amc$eor;
          update_eoi;
        IFEND;

        IF (record_info.file_position = amc$mid_record)
{     } AND (call_block.getp.skip_option = amc$skip_to_eor) THEN
          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.bor_address);
          IF (record_header^.unique_id = bac$record_header_unique_id)
{       } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{       } AND (record_header^.length >= LOWERVALUE (record_header^.length)) THEN
            record_info.current_byte_address := record_info.bor_address + record_header^.length +
                  #SIZE (bat$record_header);
            record_info.file_position := amc$eor;
          ELSE
            amp$set_file_instance_abnormal (file_identifier, ame$improper_record_header, call_block.operation,
                  error_text, status);
            RETURN; {----->
          IFEND;
        IFEND;

*copy   bai$get_eoi_check

        IF NOT at_eoi THEN
          IF record_info.file_position <> amc$mid_record THEN
*copy       bai$validate_record_header
            IF NOT status.normal THEN
              EXIT /main_code_get_partial/; {----->
            IFEND;
            record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header);
          ELSE

{ Header has already been validated in getting to mid_record.
            record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                  record_info.bor_address);
          IFEND;

          record_info.residual_record_length := record_info.bor_address + #SIZE (bat$record_header) +
                record_header^.length - record_info.current_byte_address;
          IF call_block.getp.working_storage_length >= record_info.residual_record_length THEN
            record_info.record_length := record_info.residual_record_length;
            record_info.file_position := amc$eor;
          ELSE
            record_info.record_length := call_block.getp.working_storage_length;
            record_info.file_position := amc$mid_record;
          IFEND;

          data_ptr := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.current_byte_address);

          i#move (data_ptr, call_block.getp.working_storage_area, record_info.record_length);
          record_info.current_byte_address := record_info.current_byte_address + record_info.record_length;

{ Set transfer_count for this getp before resetting record_length to length
{ of record transferred cumulatively.

          call_block.getp.transfer_count^ := record_info.record_length;
          record_info.record_length := record_info.current_byte_address - record_info.bor_address -
                #SIZE (bat$record_header);

          IF record_header^.header_type = bac$partition THEN
            record_info.file_position := amc$eop;
          IFEND;
        ELSE { at eoi }
          call_block.getp.transfer_count^ := 0;
          record_info.record_length := 0;
        IFEND;
      END /main_code_get_partial/;

*copy bai$save_record_info
      IF at_eoi THEN
        call_block.getp.byte_address^ := file_instance^.global_file_information^.eoi_byte_address;
      ELSE
        call_block.getp.byte_address^ := record_info.bor_address;
      IFEND;
      call_block.getp.file_position^ := record_info.file_position;
      call_block.getp.record_length^ := record_info.record_length;

    PROCEND get_partial;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] PUT_PARTIAL', EJECT ??

    PROCEDURE [INLINE] put_partial;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

*copy bai$validate_write_access
      IF NOT status.normal THEN
        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,
              error_text, status);
        RETURN; {----->
      IFEND;

      record_info := file_instance^.global_file_information^.positioning_info.record_info;
      record_info.record_length := call_block.putp.working_storage_length;

      CASE call_block.putp.term_option OF
      = amc$start =

{ Check to make sure we do not go over the 2 GB file limit.
        IF file_instance^.global_file_information^.file_limit <
              record_info.current_byte_address + record_info.record_length + #SIZE (bat$record_header) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$put_beyond_file_limit, call_block.operation,
                error_text, status);
          RETURN; {----->
        IFEND;

        IF (record_info.file_position = amc$mid_record) AND
              (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.
          record_info.file_position := amc$eor;
          update_eoi;
        IFEND;

        IF record_info.file_position = amc$mid_record THEN

{ Put correct length in header of record that is about to be truncated.
          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.bor_address);

          record_header^.length := record_info.current_byte_address - record_info.bor_address -
                #SIZE (bat$record_header);
        IFEND;

*copy   bai$write_record_header
        record_info.file_position := amc$mid_record;

      = amc$continue =
        IF record_info.file_position <> amc$mid_record THEN
          amp$set_file_instance_abnormal (file_identifier, ame$improper_continue, call_block.operation,
                error_text, status);
          RETURN; {----->
        IFEND;

{ Check to make sure we do not go over the 2 GB file limit.
        IF file_instance^.global_file_information^.file_limit <
              record_info.current_byte_address + record_info.record_length THEN
          amp$set_file_instance_abnormal (file_identifier, ame$put_beyond_file_limit, call_block.operation,
                error_text, status);
          RETURN; {----->
        IFEND;

        record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), record_info.bor_address);
        record_info.file_position := amc$mid_record;

      = amc$terminate =
        IF record_info.file_position = amc$mid_record THEN

{ Check to make sure we do not go over the 2 GB file limit.
          IF file_instance^.global_file_information^.file_limit <
                record_info.current_byte_address + record_info.record_length THEN
            amp$set_file_instance_abnormal (file_identifier, ame$put_beyond_file_limit, call_block.operation,
                  error_text, status);
            RETURN; {----->
          IFEND;

          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.bor_address);

        ELSE { writing a complete record using terminate }

{ Check to make sure we do not go over the 2 GB file limit.
          IF file_instance^.global_file_information^.file_limit <
                record_info.current_byte_address + record_info.record_length + #SIZE (bat$record_header) THEN
            amp$set_file_instance_abnormal (file_identifier, ame$put_beyond_file_limit, call_block.operation,
                  error_text, status);
            RETURN; {----->
          IFEND;

*copy     bai$write_record_header
        IFEND;
        record_info.file_position := amc$eor;
      ELSE
      CASEND;

      data_ptr := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
            record_info.current_byte_address);

      i#move (call_block.putp.working_storage_area, data_ptr, record_info.record_length);

      record_info.current_byte_address := record_info.current_byte_address + record_info.record_length;
      record_info.record_length := record_info.current_byte_address - record_info.bor_address -
            #SIZE (bat$record_header);
      record_header^.length := record_info.record_length;

      IF call_block.putp.term_option = amc$terminate THEN
*copy   bai$update_eoi
      IFEND;

      file_instance^.global_file_information^.positioning_info.record_info := record_info;
      file_instance^.instance_of_open_modified := TRUE;

      call_block.putp.byte_address^ := record_info.bor_address;

    PROCEND put_partial;
?? OLDTITLE ??
?? NEWTITLE := '[inline] WRITE_END_PARTITION', EJECT ??

    PROCEDURE [INLINE] write_end_partition;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

      IF caller_id.ring > file_instance^.instance_attributes.static_label.ring_attributes.r1 THEN
        amp$set_file_instance_abnormal (file_identifier, ame$ring_validation_error, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

      IF (file_instance^.global_file_information^.positioning_info.record_info.current_byte_address <
            file_instance^.global_file_information^.eoi_byte_address) THEN
        IF (file_instance^.instance_attributes.static_label.file_organization = amc$sequential) AND
              NOT (pfc$shorten IN file_instance^.instance_attributes.dynamic_label.access_mode) THEN

{ Note: A put_direct on sequential access will shorten a file.

          amp$set_file_instance_abnormal (file_identifier, ame$improper_access_attempt, call_block.operation,
                ' SHORTEN', status);
          RETURN; {----->
        ELSEIF (file_instance^.instance_attributes.static_label.file_organization = amc$byte_addressable) AND
              NOT ((pfc$modify IN file_instance^.instance_attributes.dynamic_label.access_mode) OR
              (pfc$shorten IN file_instance^.instance_attributes.dynamic_label.access_mode)) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$improper_access_attempt, call_block.operation,
                ' MODIFY OR SHORTEN', status);
          RETURN; {----->
        IFEND;
      ELSE { at eoi }
        IF NOT (pfc$append IN file_instance^.instance_attributes.dynamic_label.access_mode) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$improper_access_attempt, call_block.operation,
                ' APPEND', status);
          RETURN; {----->
        IFEND;
      IFEND;

      record_info := file_instance^.global_file_information^.positioning_info.record_info;

*copy   bai$write_record_header
      record_header^.header_type := bac$partition;
      record_header^.length := 0;

      record_info.file_position := amc$eop;
      record_info.record_length := 0;

      update_eoi;

      file_instance^.global_file_information^.positioning_info.record_info := record_info;
      file_instance^.instance_of_open_modified := TRUE;

    PROCEND write_end_partition;
?? OLDTITLE ??
?? NEWTITLE := '[inline] SEEK_DIRECT', EJECT ??

    PROCEDURE [INLINE] seek_direct;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      IFEND;

*copy bai$seek_validation
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

*copy bai$get_record_info

      IF record_info.current_byte_address = file_byte_address THEN
        IF record_info.file_position = amc$mid_record THEN

{ Seek must position to a record boundary or it is an error.
          amp$set_file_instance_abnormal (file_identifier, ame$improper_seek_address, call_block.operation,
                error_text, status);
        IFEND;

{ IF the seek is to the address the file is already at then it is a no-op.
        RETURN; {----->
      IFEND;

      IF (file_byte_address <= file_instance^.global_file_information^.eoi_byte_address -
            #SIZE (bat$record_header))
{   } AND ((file_instance^.instance_attributes.static_label.file_organization = amc$sequential) OR
            ((file_instance^.instance_attributes.static_label.file_organization = amc$byte_addressable) AND
            (call_block.operation = amc$get_direct_req))) THEN
        record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), file_byte_address);

{ Seek must position to a record boundary or it is an error.
        IF (record_header^.unique_id = bac$record_header_unique_id)
{     } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{     } AND (record_header^.length >= LOWERVALUE (record_header^.length))
{     } AND (record_header^.previous_header_fba <= UPPERVALUE (record_header^.previous_header_fba))
{     } AND (record_header^.previous_header_fba >= LOWERVALUE (record_header^.previous_header_fba))
{     } AND (record_header^.header_type <= UPPERVALUE (record_header^.header_type))
{     } AND (record_header^.header_type >= LOWERVALUE (record_header^.header_type)) THEN

{ Found a good record_header.

        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_seek_address, call_block.operation,
                error_text, status);
          RETURN; {----->
        IFEND;
      IFEND;

      IF (record_info.file_position = amc$mid_record) AND (file_instance^.private_read_information = NIL) AND
            (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.
        record_info.file_position := amc$eor;
        update_eoi;
      IFEND;

      record_info.current_byte_address := file_byte_address;
      record_info.file_position := amc$eor;

      IF (file_byte_address > #SIZE (bat$record_header)) AND (call_block.operation <> amc$get_direct_req) THEN
        file_byte_address := file_byte_address - #SIZE (bat$record_header) + 1;

      /search_loop_rhba/
        WHILE file_byte_address >= 1 DO
          file_byte_address := file_byte_address - 1;
          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), file_byte_address);
          IF (record_header^.unique_id = bac$record_header_unique_id)
{       } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{       } AND (record_header^.length >= LOWERVALUE (record_header^.length))
{       } AND (record_header^.previous_header_fba <= UPPERVALUE (record_header^.previous_header_fba))
{       } AND (record_header^.previous_header_fba >= LOWERVALUE (record_header^.previous_header_fba))
{       } AND (record_header^.header_type <= UPPERVALUE (record_header^.header_type))
{       } AND (record_header^.header_type >= LOWERVALUE (record_header^.header_type)) THEN

            IF file_byte_address + #SIZE (bat$record_header) + record_header^.length =
                  record_info.current_byte_address THEN

{ Validate backward link of record header
              previous_record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                    record_header^.previous_header_fba);
              IF (file_byte_address = 0) OR (record_header^.previous_header_fba + #SIZE (bat$record_header) +
                    previous_record_header^.length = file_byte_address) THEN
                record_info.bor_address := file_byte_address;
                EXIT /search_loop_rhba/; {----->
              IFEND;
            IFEND;
          IFEND;
        WHILEND /search_loop_rhba/;
      IFEND;

*copy bai$save_record_info

    PROCEND seek_direct;
?? OLDTITLE ??
?? NEWTITLE := 'LOCATE_PREVIOUS_HEADER', EJECT ??

    PROCEDURE locate_previous_header;

*copy bai$get_record_info

      IF record_info.bor_address < record_info.current_byte_address THEN
        record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), record_info.bor_address);
        IF (record_header^.unique_id = bac$record_header_unique_id)
{     } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{     } AND (record_header^.length >= LOWERVALUE (record_header^.length))
{     } AND (record_header^.previous_header_fba <= UPPERVALUE (record_header^.previous_header_fba))
{     } AND (record_header^.previous_header_fba >= LOWERVALUE (record_header^.previous_header_fba))
{     } AND (record_header^.header_type <= UPPERVALUE (record_header^.header_type))
{     } AND (record_header^.header_type >= LOWERVALUE (record_header^.header_type)) THEN
          IF record_info.bor_address + #SIZE (bat$record_header) + record_header^.length >=
                record_info.current_byte_address THEN

{ bor_address is correct for previous_record_header
            RETURN; {----->
          IFEND;
        IFEND;
      IFEND;

      IF record_info.current_byte_address >= #SIZE (bat$record_header) THEN

{ Look backward for offset of previous record header.
        file_byte_address := record_info.current_byte_address - #SIZE (bat$record_header) + 1;

      /search_loop/
        WHILE file_byte_address >= 1 DO
          file_byte_address := file_byte_address - 1;
          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), file_byte_address);
          IF (record_header^.unique_id = bac$record_header_unique_id)
{       } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{       } AND (record_header^.length >= LOWERVALUE (record_header^.length))
{       } AND (record_header^.previous_header_fba <= UPPERVALUE (record_header^.previous_header_fba))
{       } AND (record_header^.previous_header_fba >= LOWERVALUE (record_header^.previous_header_fba))
{       } AND (record_header^.header_type <= UPPERVALUE (record_header^.header_type))
{       } AND (record_header^.header_type >= LOWERVALUE (record_header^.header_type)) THEN
            IF file_byte_address + #SIZE (bat$record_header) + record_header^.length =
                  record_info.current_byte_address THEN

{ Validate backward link of record header
              previous_record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                    record_header^.previous_header_fba);
              IF (file_byte_address = 0) OR (record_header^.previous_header_fba + #SIZE (bat$record_header) +
                    previous_record_header^.length = file_byte_address) THEN
                record_info.bor_address := file_byte_address;
*copy           bai$save_record_info
                EXIT /search_loop/; {----->
              IFEND;
            IFEND;
          IFEND;
        WHILEND /search_loop/;
      IFEND;

    PROCEND locate_previous_header;
?? OLDTITLE ??
?? NEWTITLE := '[inline] OPEN_POSITIONING', EJECT ??

    PROCEDURE [INLINE] open_positioning;

      { initialize positioning information }
      CASE file_instance^.instance_attributes.dynamic_label.open_position OF
      = amc$open_at_boi =
        ;
      = amc$open_no_positioning, amc$open_at_eoi, amc$open_at_bop =

{ When opening ASIS, if the open follows a byte_move copy then the
{ previous header must be found.
{ Open will always set bor_address to eoi_byte_address if opening at
{ end_of_information and it is the only instance of open or it is opening for
{ private read.

        locate_previous_header;

      ELSE
      CASEND;

    PROCEND open_positioning;
?? OLDTITLE ??
?? NEWTITLE := 'REPLACE_RECORD', EJECT ??

    PROCEDURE replace_record;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, call_block.operation,
              error_text, status);
        RETURN; {----->
      ELSEIF file_instance^.instance_attributes.static_label.file_organization <> amc$sequential THEN
        amp$set_file_instance_abnormal (file_identifier, ame$file_organization_conflict, call_block.operation,
              error_text, status);
        RETURN; {----->
      ELSEIF NOT ((file_instance^.global_file_information^.positioning_info.record_info.file_position <>
            amc$mid_record) AND (file_instance^.global_file_information^.positioning_info.record_info.
            current_byte_address > 0)) THEN
        amp$set_file_instance_abnormal (file_identifier, ame$improper_file_position, call_block.operation,
              error_text, status);
        RETURN; {----->
      ELSEIF (call_block.putn.working_storage_length < 0) OR
            (call_block.putn.working_storage_length > UPPERVALUE (amt$working_storage_length)) THEN
        amp$set_file_instance_abnormal (file_identifier, ame$improper_wsl_value, call_block.operation,
              error_text, status);
        RETURN; {----->
      ELSEIF caller_id.ring > file_instance^.instance_attributes.static_label.ring_attributes.r1 THEN
        amp$set_file_instance_abnormal (file_identifier, ame$ring_validation_error, call_block.operation,
              error_text, status);
        RETURN; {----->
      ELSEIF NOT (pfc$modify IN file_instance^.instance_attributes.dynamic_label.access_mode) THEN
        amp$set_file_instance_abnormal (file_identifier, ame$improper_access_attempt, call_block.operation,
              ' MODIFY', status);
        RETURN; {----->
      IFEND;

      record_info := file_instance^.global_file_information^.positioning_info.record_info;
      IF record_info.bor_address < file_instance^.global_file_information^.eoi_byte_address THEN
        record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva), record_info.bor_address);
        IF (record_header^.unique_id = bac$record_header_unique_id)
{       } AND (record_header^.length <= UPPERVALUE (record_header^.length))
{       } AND (record_header^.length >= LOWERVALUE (record_header^.length))
{       } AND (record_header^.previous_header_fba <= UPPERVALUE (record_header^.previous_header_fba))
{       } AND (record_header^.previous_header_fba >= LOWERVALUE (record_header^.previous_header_fba))
{       } AND (record_header^.header_type <= UPPERVALUE (record_header^.header_type))
{       } AND (record_header^.header_type >= LOWERVALUE (record_header^.header_type)) THEN
          ;
        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_record_header, call_block.operation,
                error_text, status);
          RETURN; {----->
        IFEND;
      ELSE
{ Locate correct bor_address for current_byte_address.
        RETURN; {----->
      IFEND;

      IF record_header^.length = call_block.replace.working_storage_length THEN
        data_ptr := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
              record_info.bor_address + #SIZE (bat$record_header));

        i#move (call_block.replace.working_storage_area, data_ptr, call_block.replace.working_storage_length);
        file_instance^.instance_of_open_modified := TRUE;
      ELSE
        amp$set_file_instance_abnormal (file_identifier, ame$record_unequal_to_previous, call_block.operation,
              error_text, status);
      IFEND;

    PROCEND replace_record;
?? OLDTITLE ??
?? NEWTITLE := 'VALIDATE_RECORD_HEADER', EJECT ??

    PROCEDURE validate_record_header;

*copy bai$validate_record_header

    PROCEND validate_record_header;
?? OLDTITLE ??
?? NEWTITLE := 'UPDATE_EOI', EJECT ??

    PROCEDURE update_eoi;

*copy bai$update_eoi

    PROCEND update_eoi;
?? OLDTITLE ??
?? NEWTITLE := '[inline] SKIP', EJECT ??

    PROCEDURE [INLINE] skip;

      VAR
        skip_count: amt$skip_count;

      status.normal := TRUE;
      IF NOT (pfc$read IN file_instance^.instance_attributes.dynamic_label.access_mode) THEN
        amp$set_file_instance_abnormal (file_identifier, ame$skip_requires_read_perm, call_block.operation,
              '', status);
        RETURN; {----->
      IFEND;

      IF file_instance^.instance_attributes.static_label.file_organization <> amc$sequential THEN
        amp$set_file_instance_abnormal (file_identifier, ame$file_organization_conflict, amc$skip_req, '',
              status);
        RETURN; {----->
      IFEND;

      IF file_instance^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (file_identifier, ame$conflicting_access_level, amc$skip_req, '',
              status);
        RETURN; {----->
      IFEND;

*copy bai$get_record_info

      IF (record_info.file_position = amc$mid_record) AND (file_instance^.private_read_information = NIL) AND
            (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.
        record_info.file_position := amc$eor;
        update_eoi;
      IFEND;

      CASE call_block.skp.direction OF
      = amc$forward =
        IF record_info.file_position = amc$mid_record THEN
          record_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
                record_info.bor_address);
          record_info.current_byte_address := record_info.bor_address + record_header^.length +
                #SIZE (bat$record_header);
          record_info.file_position := amc$eor;
        IFEND;
        IF record_info.current_byte_address <> file_instance^.global_file_information^.eoi_byte_address THEN
          validate_record_header;
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

        CASE call_block.skp.unit OF
        = amc$skip_record =

        /skip_fwd_record/
          BEGIN
            skip_count := call_block.skp.count;

            IF skip_count > 0 THEN
              WHILE (record_info.current_byte_address < file_instance^.global_file_information^.
                    eoi_byte_address) AND (skip_count <> 0) DO
                record_info.current_byte_address := record_info.current_byte_address +
                      #SIZE (bat$record_header) + record_header^.length;
                IF record_info.current_byte_address > file_instance^.global_file_information^.
                      eoi_byte_address THEN
                  amp$set_file_instance_abnormal (file_identifier, ame$input_after_eoi, amc$skip_req, '',
                        status);
                  RETURN; {----->
                IFEND;
                IF record_header^.header_type = bac$partition THEN
                  record_info.file_position := amc$bop;
                  amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eop, amc$skip_req,
                        ' RECORD', status);
                  EXIT /skip_fwd_record/; {----->
                IFEND;
                IF record_info.current_byte_address < file_instance^.global_file_information^.
                      eoi_byte_address THEN
*copy             bai$validate_record_header
                  IF NOT status.normal THEN
                    RETURN; {----->
                  IFEND;
                IFEND;
                skip_count := skip_count - 1;
              WHILEND;

              IF skip_count <> 0 THEN
                amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, amc$skip_req,
                      ' RECORD', status);
                record_info.file_position := amc$eoi;
              ELSE
                record_info.file_position := amc$eor;
              IFEND;
            IFEND;
          END /skip_fwd_record/;

        = amc$skip_partition =

          skip_count := call_block.skp.count;

{ Do a 0 partition skip.  Find a partition boundary.

          WHILE (record_info.current_byte_address <> file_instance^.global_file_information^.
                eoi_byte_address) AND (record_info.current_byte_address <> 0) AND
                (record_info.file_position <> amc$bop) DO
            IF record_header^.header_type = bac$partition THEN
              record_info.file_position := amc$bop;
            IFEND;
            record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header) +
                  record_header^.length;
            IF record_info.current_byte_address > file_instance^.global_file_information^.
                  eoi_byte_address THEN
              amp$set_file_instance_abnormal (file_identifier, ame$input_after_eoi, amc$skip_req, '', status);
              RETURN; {----->
            IFEND;
            IF record_info.current_byte_address < file_instance^.global_file_information^.
                  eoi_byte_address THEN
              validate_record_header;
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
            IFEND;
          WHILEND;

{ Skip partitions until skip_count exhausted or EOI encountered.

          WHILE (skip_count <> 0) AND (record_info.current_byte_address <
                file_instance^.global_file_information^.eoi_byte_address) DO
            record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header) +
                  record_header^.length;
            IF record_info.current_byte_address > file_instance^.global_file_information^.
                  eoi_byte_address THEN
              amp$set_file_instance_abnormal (file_identifier, ame$input_after_eoi, amc$skip_req, '', status);
              RETURN; {----->
            IFEND;
            IF record_info.current_byte_address < file_instance^.global_file_information^.
                  eoi_byte_address THEN
              validate_record_header;
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
            IFEND;
            IF (record_info.current_byte_address < file_instance^.global_file_information^.
                  eoi_byte_address) AND (record_header^.header_type = bac$partition) THEN
              skip_count := skip_count - 1;
            IFEND;
          WHILEND;

          IF ((record_info.current_byte_address + #SIZE (bat$record_header)) <=
                file_instance^.global_file_information^.eoi_byte_address) AND
                (record_header^.header_type = bac$partition) THEN
            record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header);
          IFEND;

          IF skip_count = 0 THEN
            record_info.file_position := amc$bop;
          ELSE
            amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_eoi, amc$skip_req,
                  ' PARTITION', status);
            record_info.file_position := amc$eoi;
          IFEND;

        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_skip_unit, amc$skip_req,
                ' AMC$SKIP_TAPE_MARK', status);
          RETURN; {----->
        CASEND;

      = amc$backward =

{ Position to beginning of current record.

        IF record_info.file_position = amc$mid_record THEN
          record_info.current_byte_address := record_info.bor_address;
          record_info.file_position := amc$eor;
        IFEND;

        CASE call_block.skp.unit OF

        = amc$skip_record =

        /bkwd_skip_record/
          BEGIN
            skip_count := call_block.skp.count;

            IF skip_count > 0 THEN
              IF record_info.current_byte_address <> file_instance^.global_file_information^.
                    eoi_byte_address THEN
                validate_record_header;
                IF NOT status.normal THEN
                  RETURN; {----->
                IFEND;
              IFEND;

              WHILE (record_info.current_byte_address <> 0) AND (skip_count <> 0) DO
                IF record_info.current_byte_address < file_instance^.global_file_information^.
                      eoi_byte_address THEN
                  record_info.current_byte_address := record_header^.previous_header_fba;
                ELSE
                  record_info.current_byte_address := record_info.bor_address;
                IFEND;

*copy           bai$validate_record_header
                IF NOT status.normal THEN
                  RETURN; {----->
                IFEND;
                record_info.bor_address := record_header^.previous_header_fba;
                IF record_header^.header_type = bac$partition THEN
                  amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_bop, amc$skip_req,
                        ' RECORD', status);
                  record_info.file_position := amc$eop;
                  EXIT /bkwd_skip_record/; {----->
                IFEND;
                skip_count := skip_count - 1;
              WHILEND;

              IF skip_count <> 0 THEN
                amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_boi, amc$skip_req,
                      ' RECORD', status);
                record_info.file_position := amc$boi;
              ELSE
                record_info.file_position := amc$eor;
              IFEND;
            IFEND;
          END /bkwd_skip_record/;

        = amc$skip_partition =

          skip_count := call_block.skp.count;

          IF (record_info.file_position = amc$bop) AND (record_info.current_byte_address <> 0) THEN
            record_info.current_byte_address := record_info.current_byte_address - #SIZE (bat$record_header);
          IFEND;
          IF record_info.current_byte_address < file_instance^.global_file_information^.eoi_byte_address THEN
            validate_record_header;
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
          IFEND;

{ Do a skip of 0 partitions

          WHILE (record_info.current_byte_address <> 0) AND (record_info.file_position <> amc$bop) DO
            IF record_info.current_byte_address < file_instance^.global_file_information^.
                  eoi_byte_address THEN
              record_info.current_byte_address := record_header^.previous_header_fba;
            ELSE
              record_info.current_byte_address := record_info.bor_address;
            IFEND;
            validate_record_header;
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            IF record_header^.header_type = bac$partition THEN
              record_info.file_position := amc$bop;
            IFEND;
          WHILEND;

          WHILE (record_info.current_byte_address <> 0) AND (skip_count <> 0) DO
            IF record_info.current_byte_address < file_instance^.global_file_information^.
                  eoi_byte_address THEN
              record_info.current_byte_address := record_header^.previous_header_fba;
            ELSE { No header to look at so get address from tables.
              record_info.current_byte_address := record_info.bor_address;
            IFEND;
            validate_record_header;
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            IF (record_header^.header_type = bac$partition) OR (record_info.current_byte_address = 0) THEN
              skip_count := skip_count - 1;
              record_info.file_position := amc$bop;
            IFEND;
          WHILEND;

          IF skip_count = 0 THEN
            record_info.file_position := amc$bop;
            IF record_info.current_byte_address <> 0 THEN

{ Position after the partition delimiter

              record_info.current_byte_address := record_info.current_byte_address +
                    #SIZE (bat$record_header);
            IFEND;
          ELSE
            amp$set_file_instance_abnormal (file_identifier, ame$skip_encountered_boi, amc$skip_req,
                  ' PARTITION', status);
            record_info.file_position := amc$boi;
          IFEND;

        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_skip_unit, amc$skip_req,
                ' AMC$SKIP_TAPE_MARK', status);
          RETURN; {----->
        CASEND;
      ELSE
        amp$set_file_instance_abnormal (file_identifier, ame$improper_skip_direction, amc$skip_req, '',
              status);
        RETURN; {----->
      CASEND;

*copy bai$save_record_info

      file_instance^.residual_skip_count := skip_count;
      call_block.skp.file_position^ := record_info.file_position;

    PROCEND skip;
?? OLDTITLE ??
?? EJECT ??

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

  /process_fap_request/
    BEGIN
      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, error_text, status);
        RETURN; {----->
      IFEND;

      file_instance^.rollback_procedure := ^rollback_procedure;
      CASE call_block.operation OF
      = amc$get_next_req =
        get_next;
      = amc$put_next_req =
        put_next;
      = amc$get_partial_req =
        get_partial;
      = amc$put_partial_req =
        put_partial;
      = amc$open_req =
        open_positioning;
      = amc$close_req =
        IF (file_instance^.private_read_information = NIL) AND
              (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) AND
              (file_instance^.global_file_information^.positioning_info.record_info.file_position =
              amc$mid_record) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.

          record_info := file_instance^.global_file_information^.positioning_info.record_info;
          update_eoi;
          file_instance^.global_file_information^.positioning_info.record_info := record_info;
        IFEND;
        bap$close (file_identifier, status);
        EXIT /process_fap_request/; {----->
      = amc$rewind_req =
        IF (file_instance^.private_read_information = NIL) AND
              (file_instance^.global_file_information^.last_access_operation = amc$put_partial_req) AND
              (file_instance^.global_file_information^.positioning_info.record_info.file_position =
              amc$mid_record) THEN

{ Must have been left mid_record by a put_partial.  EOI needs updating.

          record_info := file_instance^.global_file_information^.positioning_info.record_info;
          update_eoi;
          file_instance^.global_file_information^.positioning_info.record_info := record_info;
        IFEND;
*copy     bai$rewind
      = amc$seek_direct_req =
        file_byte_address := call_block.seekd.byte_address;
        seek_direct;
      = amc$get_direct_req =
        file_byte_address := call_block.getd.byte_address;
        seek_direct;
        IF NOT status.normal THEN
          IF status.condition = ame$position_beyond_eoi THEN
            status.condition := ame$input_after_eoi;
          IFEND;
        ELSE
          get_next;
        IFEND;
      = amc$put_direct_req =
        file_byte_address := call_block.putd.byte_address;
        seek_direct;
        IF status.normal THEN
          put_next;
        IFEND;
      = amc$skip_req =
        skip;
      = amc$fetch_access_information_rq =
        bap$fetch_access_information (file_identifier, call_block, layer_number, status);
        EXIT /process_fap_request/; {----->
      = amc$fetch_req =
        bap$fetch (file_identifier, call_block, layer_number, status);
        EXIT /process_fap_request/; {----->
      = amc$get_segment_pointer_req =
        bap$get_segment_pointer (file_identifier, call_block, layer_number, status);
      = amc$set_segment_eoi_req =
        bap$set_segment_eoi (file_identifier, call_block, layer_number, status);
      = amc$set_segment_position_req =
        bap$set_segment_position (file_identifier, call_block, layer_number, status);
      = amc$replace_req =
        replace_record;
      = amc$store_req =
        bap$store (file_identifier, call_block, layer_number, status);
      = amc$write_end_partition_req =
        write_end_partition;
      = amc$write_tape_mark_req, amc$close_volume_req =
        amp$set_file_instance_abnormal (file_identifier, ame$improper_device_class, call_block.operation,
              'MASS_STORAGE', status);
      = amc$flush_req =
        bap$write_modified_pages (file_instance, file_identifier, status);
      = ifc$fetch_terminal_req, ifc$store_terminal_req =
        IF pmf$job_mode () = jmc$batch THEN
          osp$set_status_abnormal (ifc$interactive_facility_id, ife$current_job_not_interactive,
                'FETCH/STORE_TERMINAL_REQ', status);
        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_device_class, call_block.operation,
                'MASS STORAGE', status);
        IFEND;
      ELSE { NO CASE }
        amp$set_file_instance_abnormal (file_identifier, ame$unimplemented_request, call_block.operation,
              ' for sequential or byte addressable files', status);
      CASEND;

      IF file_instance^.private_read_information = NIL THEN
        IF status.normal THEN
          file_instance^.global_file_information^.error_status := 0;
        ELSE
          file_instance^.global_file_information^.error_status := status.condition;
        IFEND;
        file_instance^.global_file_information^.last_access_operation := call_block.operation;
      ELSE
        IF status.normal THEN
          file_instance^.private_read_information^.error_status := 0;
        ELSE
          file_instance^.private_read_information^.error_status := status.condition;
        IFEND;
        file_instance^.private_read_information^.last_access_operation := call_block.operation;
      IFEND;
    END /process_fap_request/;

    file_instance^.rollback_procedure := NIL;

  PROCEND bap$sys_blk_variable_rec_fap;
MODEND bam$sys_blk_variable_rec_fap;
