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

?? NEWTITLE := '    Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amc$condition_code_limits
*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_wsl
*copyc ame$open_validation_errors
*copyc ame$put_validation_errors
*copyc ame$ring_validation_errors
*copyc ame$unimplemented_request
*copyc ife$error_codes
*copyc amt$fap_declarations
*copyc bat$block_header
*copyc bat$global_file_information
*copyc bat$positioning_info
*copyc bat$record_header_type
*copyc bat$task_file_table
*copyc ost$caller_identifier
?? POP ??
*copyc baf$task_file_entry_p
*copyc amp$set_file_instance_abnormal
*copyc bap$close
*copyc bap$fetch
*copyc bap$fetch_access_information
*copyc bap$get_segment_pointer
*copyc bap$rewind
*copyc bap$set_segment_position
*copyc bap$store
*copyc mmp$set_segment_length
*copyc osp$fetch_locked_variable
*copyc osp$set_status_abnormal
*copyc pmp$get_job_mode
*copyc bav$task_file_table
*copyc i#move
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] BAP$US_BLK_VAR_READ_ONLY_FAP', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$us_blk_var_read_only_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$US_BLK_VAR_READ_ONLY_FAP';

    VAR
      at_eoi: boolean,
      block_header: ^bat$block_header,
      block_info: bat$block_info,
      caller_id: ost$caller_identifier,
      data_moved: 0 .. amc$maximum_block,
      data_ptr: ^cell,
      file_instance: ^bat$task_file_entry,
      job_mode: jmt$job_mode,
      more_data: boolean,
      record_header: ^bat$record_header,
      record_info: bat$record_info,
      record_spans_blocks: boolean,
      starting_new_block: boolean,
      starting_new_record: boolean,
      update_segment_length: boolean,
      wsa: ^cell,
      wsl: amt$working_storage_length,
      x: integer;

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

    PROCEDURE rollback_procedure
      (    condition_status: ost$status);

      status := condition_status;
      file_instance^.rollback_procedure := NIL;
      EXIT bap$us_blk_var_read_only_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;

      IF record_info.file_position = amc$mid_record THEN
        move_to_next_start_header (status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

*copy bai$get_eoi_check
      IF NOT at_eoi THEN
        data_moved := 0;
        more_data := TRUE;
        wsa := call_block.getn.working_storage_area;
        wsl := call_block.getn.working_storage_length;
        REPEAT
          position_to_next_block (status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;

          record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header);
          IF wsl > record_header^.length THEN
            wsl := record_header^.length;
          IFEND;

          data_ptr := #ADDRESS (#RING (file_instance^.file_pva), #SEGMENT (file_instance^.file_pva),
                record_info.current_byte_address);
          i#move (data_ptr, wsa, wsl);
          record_info.current_byte_address := record_info.current_byte_address + wsl;
          data_moved := data_moved + wsl;

          block_info.residual_block_length := block_info.residual_block_length - wsl -
                #SIZE (bat$record_header);

          IF (data_moved < call_block.getn.working_storage_length) AND
                (record_info.current_byte_address < file_instance^.global_file_information^.
                eoi_byte_address) AND (record_header^.header_type <> bac$full_record) AND
                (record_header^.header_type <> bac$end_record) THEN
            { prepare to loop and get more data }
            wsa := #ADDRESS (#RING (wsa), #SEGMENT (wsa), (#OFFSET (wsa) + wsl));
            wsl := call_block.getn.working_storage_length - data_moved;
          ELSE
            more_data := FALSE;
          IFEND;
        UNTIL ((NOT more_data) OR (record_header^.header_type = bac$full_record) OR
              (record_header^.header_type = bac$end_record) OR (record_header^.header_type = bac$partition));

        CASE record_header^.header_type OF
        = bac$full_record, bac$end_record =
          IF wsl < record_header^.length THEN
            record_info.file_position := amc$mid_record;
          ELSE
            record_info.file_position := amc$eor;
          IFEND;
        = bac$start_record, bac$continued_record =
          record_info.file_position := amc$mid_record;
        = bac$partition =
          record_info.file_position := amc$eop;
        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_record_header, call_block.operation,
                error_text, status);
        CASEND;

        { update local file information }
        record_info.record_length := data_moved;
      IFEND; { NOT at eoi }

      call_block.getn.file_position^ := record_info.file_position;
      call_block.getn.transfer_count^ := data_moved;
      IF call_block.operation = amc$get_next_req THEN
        call_block.getn.byte_address^ := record_info.bor_address;
      IFEND;

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

      block_info.residual_block_length := block_info.current_block_byte_address + block_header^.
            block_length + #SIZE (bat$block_header) - record_info.current_byte_address;

      IF ((call_block.getp.skip_option = amc$skip_to_eor) AND
            (record_info.file_position = amc$mid_record)) OR (record_info.current_byte_address = 0) THEN
        move_to_next_start_header (status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

*copy bai$get_eoi_check
      IF NOT at_eoi THEN
        block_header := #ADDRESS (#RING (file_instance^.file_pva), #SEGMENT (file_instance^.file_pva),
              block_info.current_block_byte_address);
*copy   bai$validate_block_header
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

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

        wsa := call_block.getp.working_storage_area;
        wsl := call_block.getp.working_storage_length;
        data_moved := 0;
        more_data := TRUE;

        REPEAT
          position_to_next_block (status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;

          IF (record_info.residual_record_length = 0) OR (record_info.current_byte_address =
                block_info.current_block_byte_address + #SIZE (bat$block_header)) THEN
*copy       bai$validate_record_header
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            record_info.bor_address := record_info.current_byte_address;
            record_info.residual_record_length := record_header^.length;
            record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$record_header);
            block_info.residual_block_length := block_info.residual_block_length - #SIZE (bat$record_header);
          IFEND;

          IF wsl >= record_info.residual_record_length THEN
            wsl := record_info.residual_record_length;
          IFEND;

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

          i#move (data_ptr, wsa, wsl);

          block_info.residual_block_length := block_info.residual_block_length - wsl;

          record_info.current_byte_address := record_info.current_byte_address + wsl;
          data_moved := data_moved + wsl;
          IF (data_moved < call_block.getp.working_storage_length) AND
                (record_info.current_byte_address < file_instance^.global_file_information^.
                eoi_byte_address) AND (record_header^.header_type <> bac$full_record) AND
                (record_header^.header_type <> bac$end_record) THEN
            { prepare to loop and get more data }
            wsa := #ADDRESS (#RING (wsa), #SEGMENT (wsa), (#OFFSET (wsa) + wsl));
            wsl := call_block.getp.working_storage_length - data_moved;
          ELSE
            more_data := FALSE;
          IFEND;
        UNTIL ((NOT more_data) OR (record_header^.header_type = bac$full_record) OR
              (record_header^.header_type = bac$end_record) OR (record_header^.header_type = bac$partition));

        IF record_info.file_position <> amc$mid_record THEN
          record_info.record_length := data_moved;
        ELSE
          record_info.record_length := record_info.record_length + data_moved;
        IFEND;

        CASE record_header^.header_type OF
        = bac$full_record, bac$end_record =
          IF record_info.current_byte_address = record_info.record_header_fba + #SIZE (bat$record_header) +
                record_header^.length THEN
            record_info.file_position := amc$eor;
          ELSE
            record_info.file_position := amc$mid_record;
          IFEND;
        = bac$start_record, bac$continued_record =
          record_info.file_position := amc$mid_record;
        = bac$partition =
          record_info.file_position := amc$eop;
        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_record_header, call_block.operation,
                error_text, status);
        CASEND;
      IFEND; { if not at eoi }

      call_block.getp.byte_address^ := record_info.bor_address;
      call_block.getp.file_position^ := record_info.file_position;
      call_block.getp.transfer_count^ := data_moved;
      call_block.getp.record_length^ := record_info.record_length;

    PROCEND get_partial;
?? OLDTITLE ??
?? NEWTITLE := 'MOVE_TO_NEXT_START_HEADER', EJECT ??

    PROCEDURE [inline] move_to_next_start_header
      (VAR status: ost$status);

      WHILE (record_info.current_byte_address < file_instance^.global_file_information^.eoi_byte_address) AND
            ((record_info.file_position <> amc$eor) OR (block_info.residual_block_length <
            #SIZE (bat$record_header))) DO

        IF block_info.residual_block_length < #SIZE (bat$record_header) THEN
          position_to_next_block (status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        ELSEIF 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;

          record_info.current_byte_address := record_info.bor_address + record_header^.length;
          block_info.residual_block_length := block_info.current_block_byte_address +
                block_header^.block_length + #SIZE (bat$block_header) - record_info.current_byte_address;
        IFEND;
        IF (record_header^.header_type = bac$full_record) OR
              (record_header^.header_type = bac$start_record) OR
              (record_header^.header_type = bac$partition) THEN
          record_info.file_position := amc$eor;
        IFEND;
      WHILEND;

    PROCEND move_to_next_start_header;
?? OLDTITLE ??
?? NEWTITLE := 'POSITION_TO_NEXT_BLOCK', EJECT ??

    PROCEDURE [inline] position_to_next_block
      (VAR status: ost$status);

      IF (block_info.residual_block_length < #SIZE (bat$record_header)) AND
            (record_info.current_byte_address < file_instance^.global_file_information^.eoi_byte_address) THEN
        IF record_info.current_byte_address <> block_info.current_block_byte_address THEN
          block_info.current_block_byte_address := block_info.current_block_byte_address +
                file_instance^.global_file_information^.max_block_size;
          record_info.current_byte_address := block_info.current_block_byte_address;
        IFEND;
        block_header := #ADDRESS (osc$min_ring, #SEGMENT (file_instance^.file_pva),
              block_info.current_block_byte_address);

        IF record_info.current_byte_address < file_instance^.global_file_information^.eoi_byte_address THEN
*copy     bai$validate_block_header
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

        block_info.residual_block_length := block_header^.block_length;
        record_info.current_byte_address := record_info.current_byte_address + #SIZE (bat$block_header);

      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;

    PROCEND position_to_next_block;
?? OLDTITLE ??
?? EJECT ??

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

    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;

*copy bai$get_positioning_info

    CASE call_block.operation OF
    = amc$get_next_req =
      get_next;
    = amc$get_partial_req =
      get_partial;
    = amc$open_req =
      record_info.current_byte_address := 0;
      record_info.file_position := amc$eor;
      block_info.current_block_byte_address := 0;
      block_info.current_block_length := 0;
      block_info.residual_block_length := 0;
    = amc$fetch_access_information_rq =
      bap$fetch_access_information (file_identifier, call_block, layer_number, status);
    = amc$fetch_req =
      bap$fetch (file_identifier, call_block, layer_number, status);
    = amc$get_segment_pointer_req =
      bap$get_segment_pointer (file_identifier, call_block, layer_number, status);
    = amc$set_segment_position_req =
      bap$set_segment_position (file_identifier, call_block, layer_number, status);
    = amc$rewind_req =
    = amc$store_req =
      bap$store (file_identifier, call_block, layer_number, status);
    = amc$close_req =
      bap$close (file_identifier, status);
    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$unimplemented_request, call_block.operation,
            ' for sequential or byte addressable files', status);
    CASEND;

*copy bai$save_positioning_info

    file_instance^.rollback_procedure := NIL;

  PROCEND bap$us_blk_var_read_only_fap;
?? OLDTITLE ??
MODEND bam$us_blk_var_read_only_fap;
