?? NEWTITLE := 'NOS/VE Basic Access Method : Segment Access Management' ??
MODULE bam$segment_pointer;
?? RIGHT := 110 ??

?? NEWTITLE := 'Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amc$condition_code_limits
*copyc ame$conflicting_access_level
*copyc ame$conflicting_access_level
*copyc ame$device_class_validation
*copyc ame$improper_file_id
*copyc ame$put_validation_errors
*copyc ame$ring_validation_errors
*copyc ame$segment_validation_errors
*copyc amt$fap_declarations
*copyc amt$file_byte_address
*copyc amt$segment_pointer
*copyc bac$minimum_open_ring
*copyc i#build_adaptable_heap_pointer
*copyc i#build_adaptable_seq_pointer
*copyc i#current_sequence_position
*copyc osd$cybil_structure_definitions
*copyc osd$virtual_address
*copyc ost$caller_identifier
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$set_file_instance_abnormal
*copyc baf$task_file_entry_p
*copyc bap$set_file_instance_abnormal
*copyc mmp$change_segment_number
*copyc mmp$get_page_size
*copyc mmp$get_segment_length
*copyc mmp$set_segment_length
*copyc osp$set_status_abnormal

*copyc amv$device_class_names
*copyc bav$task_file_table
*copyc osv$page_size
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] BAP$GET_SEGMENT_POINTER' ??
*copyc bah$get_segment_pointer

  PROCEDURE [XDCL] bap$get_segment_pointer
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         fap_layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    CONST
      error_text = 'BAP$GET_SEGMENT_POINTER';

    VAR
      caller_id: ost$caller_identifier,
      current_byte_address: amt$file_byte_address,
      file_instance_p: ^bat$task_file_entry,
      heap_length: 0 .. osc$maximum_offset,
      heap_var: ^HEAP ( * ),
      pva: ^cell,
      pva_ptr: ^cell,
      segment_length: ost$segment_length,
      seq_length: ost$segment_length,
      seq_next: 0 .. osc$maximum_offset,
      seq_var: ^SEQ ( * );

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

  /get_segment_pointer/
    BEGIN
      file_instance_p := baf$task_file_entry_p (file_identifier);
      IF file_instance_p = NIL THEN
        osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, error_text, status);
        EXIT /get_segment_pointer/; {----->
      IFEND;

      IF caller_id.ring <> osc$tsrv_ring {task services ring - ring 3} THEN
        IF caller_id.ring > file_instance_p^.instance_attributes.static_label.ring_attributes.r2 THEN
          amp$set_file_instance_abnormal (file_identifier, ame$ring_validation_error, call_block.operation,
                error_text, status);
          EXIT /get_segment_pointer/; {----->
        IFEND;
      IFEND;

      IF file_instance_p^.device_class <> rmc$mass_storage_device THEN
        IF (file_instance_p^.device_class = rmc$null_device) THEN
          EXIT /get_segment_pointer/; {----->
        ELSE
          amp$set_file_instance_abnormal (file_identifier, ame$improper_device_class, call_block.operation,
                'NON-MASS_STORAGE', status);
          EXIT /get_segment_pointer/; {----->
        IFEND;
      IFEND;

      pva := file_instance_p^.file_pva;

      mmp$get_segment_length (pva, #RING (pva), segment_length, status);
      IF NOT status.normal THEN
        EXIT /get_segment_pointer/; {----->
      IFEND;

      IF segment_length = 0 THEN
        IF (($pft$usage_selections [pfc$shorten, pfc$append, pfc$modify]) *
              file_instance_p^.instance_attributes.dynamic_label.access_mode) = $pft$usage_selections [] THEN
          amp$set_file_instance_abnormal (file_identifier, ame$read_of_empty_segment, call_block.operation,
                error_text, status);
          EXIT /get_segment_pointer/; {----->
        ELSEIF NOT (pfc$append IN file_instance_p^.instance_attributes.dynamic_label.access_mode) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$write_of_empty_segment, call_block.operation,
                error_text, status);
          EXIT /get_segment_pointer/; {----->
        IFEND;
      IFEND;

      IF file_instance_p^.private_read_information = NIL THEN
        current_byte_address := file_instance_p^.global_file_information^.positioning_info.record_info.
              current_byte_address;
      ELSE
        current_byte_address := file_instance_p^.private_read_information^.positioning_info.record_info.
              current_byte_address;
      IFEND;

      CASE call_block.getsegp.pointer_kind OF
      = amc$cell_pointer =
        call_block.getsegp.segment_pointer^.cell_pointer :=
              #ADDRESS (#RING (pva), #SEGMENT (pva), current_byte_address);
        call_block.getsegp.segment_pointer^.kind := amc$cell_pointer;
        RETURN; {----->

      = amc$heap_pointer =
        IF pfc$append IN file_instance_p^.instance_attributes.dynamic_label.access_mode THEN
          IF file_instance_p^.global_file_information^.file_limit <= osc$maximum_offset THEN
            heap_length := file_instance_p^.global_file_information^.file_limit;
          ELSE
            heap_length := osc$maximum_offset;
          IFEND;
        ELSE
          heap_length := segment_length;
        IFEND;
        i#build_adaptable_heap_pointer (#RING (pva), #SEGMENT (pva), current_byte_address, heap_length,
              heap_var);
        call_block.getsegp.segment_pointer^.heap_pointer := heap_var;
        call_block.getsegp.segment_pointer^.kind := amc$heap_pointer;
        RETURN; {----->

      = amc$sequence_pointer =
        IF current_byte_address <= segment_length THEN
          seq_next := current_byte_address;
        ELSE
          seq_next := segment_length;
        IFEND;
        IF pfc$append IN file_instance_p^.instance_attributes.dynamic_label.access_mode THEN
          IF file_instance_p^.global_file_information^.file_limit <= osc$maximum_offset THEN
            seq_length := file_instance_p^.global_file_information^.file_limit;
          ELSE
            seq_length := osc$maximum_offset;
          IFEND;
        ELSE
          seq_length := segment_length;
        IFEND;

        i#build_adaptable_seq_pointer (#RING (pva), #SEGMENT (pva), #OFFSET (pva),
              seq_length, seq_next, seq_var);
        call_block.getsegp.segment_pointer^.sequence_pointer := seq_var;
        call_block.getsegp.segment_pointer^.kind := amc$sequence_pointer;
        RETURN; {----->

      ELSE
        amp$set_file_instance_abnormal (file_identifier, ame$improper_pointer_kind,
              amc$get_segment_pointer_req, error_text, status);
      CASEND;
    END /get_segment_pointer/;

    CASE call_block.getsegp.pointer_kind OF
    = amc$cell_pointer =
      call_block.getsegp.segment_pointer^.cell_pointer := NIL;
      call_block.getsegp.segment_pointer^.kind := amc$cell_pointer;
    = amc$heap_pointer =
      call_block.getsegp.segment_pointer^.heap_pointer := NIL;
      call_block.getsegp.segment_pointer^.kind := amc$heap_pointer;
    = amc$sequence_pointer =
      call_block.getsegp.segment_pointer^.sequence_pointer := NIL;
      call_block.getsegp.segment_pointer^.kind := amc$sequence_pointer;
    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$improper_pointer_kind, amc$get_segment_pointer_req,
            error_text, status);
    CASEND;

  PROCEND bap$get_segment_pointer;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] BAP$SET_SEGMENT_POSITION', EJECT ??

*copyc bah$set_segment_position

  PROCEDURE [XDCL] bap$set_segment_position
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         fap_layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    CONST
      error_text = 'BAP$SET_SEGMENT_POSITION';

    VAR
      byte_address: amt$file_byte_address,
      call_block_pva: ^cell,
      caller_id: ost$caller_identifier,
      file_instance_p: ^bat$task_file_entry,
      pva: ^cell,
      segment_length: ost$segment_length;

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

    file_instance_p := baf$task_file_entry_p (file_identifier);
    IF file_instance_p = NIL THEN
      osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, error_text, status);
      RETURN; {----->
    IFEND;

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

    IF file_instance_p^.device_class <> rmc$mass_storage_device THEN
      IF (file_instance_p^.device_class = rmc$null_device) THEN
        RETURN; {----->
      ELSE
        amp$set_file_instance_abnormal (file_identifier, ame$improper_device_class, call_block.operation,
              'NON-MASS_STORAGE', status);
        RETURN; {----->
      IFEND;
    IFEND;

    pva := file_instance_p^.file_pva;

    CASE call_block.segpos.segment_pointer.kind OF
    = amc$cell_pointer =
      call_block_pva := call_block.segpos.segment_pointer.cell_pointer;
      byte_address := #OFFSET (call_block_pva);

    = amc$sequence_pointer =
      call_block_pva := call_block.segpos.segment_pointer.sequence_pointer;
      byte_address := i#current_sequence_position (call_block.segpos.segment_pointer.sequence_pointer);
    = amc$heap_pointer =
      amp$set_file_instance_abnormal (file_identifier, ame$set_on_adaptable_heap,
            amc$set_segment_position_req, error_text, status);
      RETURN; {----->
    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$improper_pointer_kind,
            amc$set_segment_position_req, error_text, status);
      RETURN; {----->
    CASEND;

    IF (call_block_pva = NIL) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_segment_pointer, call_block.operation, '',
            status);
      RETURN; {----->
    IFEND;

    IF (#SEGMENT (call_block_pva) <> #SEGMENT (pva)) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_segment_number, call_block.operation, '',
            status);
      RETURN; {----->
    IFEND;

    mmp$get_segment_length (pva, #RING (pva), segment_length, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF byte_address > segment_length THEN
      amp$set_file_instance_abnormal (file_identifier, ame$set_pos_beyond_eoi, call_block.operation, '',
            status);
      RETURN; {----->
    IFEND;

    IF file_instance_p^.private_read_information <> NIL THEN
      file_instance_p^.private_read_information^.positioning_info.record_info.current_byte_address :=
            byte_address;
    ELSE
      file_instance_p^.global_file_information^.positioning_info.record_info.current_byte_address :=
            byte_address;
    IFEND;

  PROCEND bap$set_segment_position;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] BAP$SET_SEGMENT_EOI', EJECT ??

*copyc bah$set_segment_eoi

  PROCEDURE [XDCL] bap$set_segment_eoi
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         fap_layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    CONST
      error_text = 'BAP$SET_SEGMENT_EOI';

    VAR
      call_block_pva: ^cell,
      caller_id: ost$caller_identifier,
      file_instance_p: ^bat$task_file_entry,
      proposed_eoi: amt$file_byte_address,
      pva: ^cell,
      segment_eoi: ost$segment_length;

?? NEWTITLE := 'validate_proposed_eoi', EJECT ??

    PROCEDURE validate_proposed_eoi
      (VAR status: ost$status);

      IF proposed_eoi > (((file_instance_p^.global_file_information^.file_limit + (osv$page_size - 1)) DIV
            osv$page_size) * osv$page_size) THEN
        amp$set_file_instance_abnormal (file_identifier, ame$position_beyond_file_limit, call_block.operation,
              '', status);
      IFEND;

    PROCEND validate_proposed_eoi;
?? OLDTITLE, EJECT ??

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

    file_instance_p := baf$task_file_entry_p (file_identifier);
    IF file_instance_p = NIL THEN
      osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, error_text, status);
      RETURN; {----->
    IFEND;

    IF caller_id.ring > file_instance_p^.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_p^.device_class <> rmc$mass_storage_device THEN
      IF (file_instance_p^.device_class = rmc$null_device) THEN
        RETURN; {----->
      ELSE
        amp$set_file_instance_abnormal (file_identifier, ame$improper_device_class, call_block.operation,
              'NON-MASS_STORAGE', status);
        RETURN; {----->
      IFEND;
    IFEND;
    pva := file_instance_p^.file_pva;

    CASE call_block.segeoi.segment_pointer.kind OF
    = amc$cell_pointer =
      call_block_pva := call_block.segeoi.segment_pointer.cell_pointer;
      proposed_eoi := #OFFSET (call_block_pva);

    = amc$sequence_pointer =
      call_block_pva := call_block.segeoi.segment_pointer.sequence_pointer;
      proposed_eoi := i#current_sequence_position (call_block.segeoi.segment_pointer.sequence_pointer);

    = amc$heap_pointer =
      amp$set_file_instance_abnormal (file_identifier, ame$set_on_adaptable_heap, amc$set_segment_eoi_req,
            error_text, status);
      RETURN; {----->

    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$improper_pointer_kind, amc$set_segment_eoi_req,
            error_text, status);
      RETURN; {----->
    CASEND;

    IF (call_block_pva = NIL) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_segment_pointer, call_block.operation, '',
            status);
      RETURN; {----->
    IFEND;

    IF (#SEGMENT (call_block_pva) <> #SEGMENT (pva)) THEN
      amp$set_file_instance_abnormal (file_identifier, ame$improper_segment_number, call_block.operation, '',
            status);
      RETURN; {----->
    IFEND;

    mmp$get_segment_length (pva, #RING (pva), segment_eoi, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF (segment_eoi MOD osv$page_size) > 0 THEN

{ Eoi is not on a page boundary so it must have been explicitly set.

      IF proposed_eoi < segment_eoi THEN
        IF NOT (pfc$shorten IN file_instance_p^.instance_attributes.dynamic_label.access_mode) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$set_eoi_needs_shorten, call_block.operation,
                '', status);
          RETURN; {----->
        IFEND;
      ELSEIF proposed_eoi > segment_eoi THEN
        IF NOT (pfc$append IN file_instance_p^.instance_attributes.dynamic_label.access_mode) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$set_eoi_needs_append, call_block.operation, '',
                status);
          RETURN; {----->
        ELSE
          validate_proposed_eoi (status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
        { ELSE
        {   proposed_eoi = segment_eoi is okay
      IFEND;
    ELSE

{ Eoi is on a page boundary so we don't know if that's the true value or
{ just the result of a page fault - we can only check for shorten access
{ if the requested address is not within the last referenced page.

      IF proposed_eoi < (segment_eoi - osv$page_size) THEN
        IF NOT (pfc$shorten IN file_instance_p^.instance_attributes.dynamic_label.access_mode) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$set_eoi_needs_shorten, call_block.operation,
                '', status);
          RETURN; {----->
        IFEND;
      ELSEIF proposed_eoi > segment_eoi THEN
        IF NOT (pfc$append IN file_instance_p^.instance_attributes.dynamic_label.access_mode) THEN
          amp$set_file_instance_abnormal (file_identifier, ame$set_eoi_needs_append, call_block.operation, '',
                status);
          RETURN; {----->
        ELSE
          validate_proposed_eoi (status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    mmp$set_segment_length (file_instance_p^.file_pva, caller_id.ring, proposed_eoi, status);

    IF status.normal THEN
      file_instance_p^.global_file_information^.positioning_info.record_info.current_byte_address :=
            proposed_eoi;
      file_instance_p^.global_file_information^.eoi_byte_address := proposed_eoi;
    IFEND;

  PROCEND bap$set_segment_eoi;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] fsp$change_segment_number', EJECT ??
*copyc fsh$change_segment_number

  PROCEDURE [XDCL, #GATE] fsp$change_segment_number
    (    file_identifier: amt$file_identifier;
         new_segment_number: ost$segment;
         validation_ring: ost$valid_ring;
         pointer_kind: amt$pointer_kind;
     VAR segment_pointer: amt$segment_pointer;
     VAR status: ost$status);

    CONST
      change_segment_number_request = 'FSP$CHANGE_SEGMENT_NUMBER';

    VAR
      caller_id: ost$caller_identifier,
      file_instance_p: ^bat$task_file_entry,
      old_segment_pointer: amt$segment_pointer,
      new_segment_pointer: amt$segment_pointer,
      validation_ring_number: ost$valid_ring;

    #CALLER_ID (caller_id);
    IF validation_ring > caller_id.ring THEN
      validation_ring_number := validation_ring;
    ELSE
      validation_ring_number := caller_id.ring;
    IFEND;

    CASE pointer_kind OF
    = amc$cell_pointer =
      segment_pointer.cell_pointer := NIL;
      segment_pointer.kind := amc$cell_pointer;
    = amc$heap_pointer =
      segment_pointer.heap_pointer := NIL;
      segment_pointer.kind := amc$heap_pointer;
    = amc$sequence_pointer =
      segment_pointer.sequence_pointer := NIL;
      segment_pointer.kind := amc$sequence_pointer;
    ELSE
    CASEND;

    amp$get_segment_pointer (file_identifier, amc$cell_pointer, old_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{   File_id was validated by amp$get_segment_pointer.}
    file_instance_p := baf$task_file_entry_p (file_identifier);

    IF file_instance_p^.device_class <> rmc$mass_storage_device THEN
      bap$set_file_instance_abnormal (file_identifier, ame$improper_device_class,
            change_segment_number_request, amv$device_class_names [file_instance_p^.device_class].name,
            status);
      RETURN; {----->
    IFEND;

    IF validation_ring_number > file_instance_p^.instance_attributes.static_label.ring_attributes.r2 THEN
      bap$set_file_instance_abnormal (file_identifier, ame$ring_validation_error,
            change_segment_number_request, '', status);
      RETURN; {----->
    IFEND;

    mmp$change_segment_number (old_segment_pointer, new_segment_number, bac$minimum_open_ring,
          new_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    file_instance_p^.file_pva := new_segment_pointer.cell_pointer;

    amp$get_segment_pointer (file_identifier, pointer_kind, segment_pointer, status);

  PROCEND fsp$change_segment_number;
?? OLDTITLE ??
MODEND bam$segment_pointer;
