?? TITLE := 'NOS/VE:  BASIC ACCESS METHOD' ??
MODULE bam$v_to_t_record_conversion;
?? RIGHT := 110 ??

?? NEWTITLE := '    Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$access_validation_errors
*copyc ame$improper_file_id
*copyc ame$ring_validation_errors
*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 amp$set_local_name_abnormal
*copyc osp$set_status_abnormal
*copyc bav$task_file_table
*copyc i#move
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] BAP$V_TO_T_RECORD_CONVERSION', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$v_to_t_record_conversion
    (    from_fid: amt$file_identifier;
         to_fid: amt$file_identifier;
         file_size_source: amt$file_byte_address;
     VAR current_byte_source: amt$file_byte_address;
     VAR current_byte_destination: amt$file_byte_address;
     VAR last_move: boolean;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance_from: ^bat$task_file_entry,
      file_instance_to: ^bat$task_file_entry,
      from_pointer: ^cell,
      move_to: amt$file_byte_address,
      to_pointer: ^cell;

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

    PROCEDURE rollback_procedure
      (    condition_status: ost$status);

      status := condition_status;
      file_instance_from^.rollback_procedure := NIL;
      file_instance_to^.rollback_procedure := NIL;
      EXIT bap$v_to_t_record_conversion; {----->
    PROCEND rollback_procedure;
?? OLDTITLE ??
?? EJECT ??

  /main_program/
    BEGIN
      #CALLER_ID (caller_id);

      status.normal := TRUE;
      file_instance_from := baf$task_file_entry_p (from_fid);
      IF file_instance_from = NIL THEN
        osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, 'bap$v_to_t_record_conversion',
              status);
        RETURN; {----->
      ELSEIF caller_id.ring <> file_instance_from^.open_ring THEN
        amp$set_file_instance_abnormal (from_fid, ame$ring_validation_error, fsc$copy_file_req, ' ', status);
        RETURN; {----->
      ELSEIF file_instance_from^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (from_fid, ame$improper_access_attempt, fsc$copy_file_req, ' RECORD ',
              status);
        RETURN; {----->
      ELSEIF NOT (pfc$read IN file_instance_from^.instance_attributes.dynamic_label.access_mode) THEN
        amp$set_file_instance_abnormal (from_fid, ame$improper_access_attempt, fsc$copy_file_req, ' READ ',
              status);
        RETURN; {----->
      IFEND;

      file_instance_to := baf$task_file_entry_p (to_fid);
      IF file_instance_to = NIL THEN
        osp$set_status_abnormal (amc$access_method_id, ame$improper_file_id, 'bap$v_to_t_record_conversion',
              status);
        RETURN; {----->
      ELSEIF caller_id.ring <> file_instance_to^.open_ring THEN
        amp$set_file_instance_abnormal (to_fid, ame$ring_validation_error, fsc$copy_file_req, ' ', status);
        RETURN; {----->
      ELSEIF file_instance_to^.access_level <> amc$record THEN
        amp$set_file_instance_abnormal (to_fid, ame$improper_access_attempt, fsc$copy_file_req, ' RECORD ',
              status);
        RETURN; {----->
      ELSEIF NOT (file_instance_to^.instance_attributes.dynamic_label.access_mode >=
            $pft$usage_selections [pfc$shorten, pfc$append]) THEN
        amp$set_file_instance_abnormal (to_fid, ame$improper_access_attempt, fsc$copy_file_req,
              ' SHORTEN, APPEND ', status);
        RETURN; {----->
      IFEND;

{Now, we change the file instance and so have to set it back at exit.
      file_instance_from^.rollback_procedure := ^rollback_procedure;
      file_instance_to^.rollback_procedure := ^rollback_procedure;

      from_pointer := #ADDRESS (#RING (file_instance_from^.file_pva), #SEGMENT (file_instance_from^.file_pva),
            current_byte_source);
      to_pointer := #ADDRESS (#RING (file_instance_to^.file_pva), #SEGMENT (file_instance_to^.file_pva),
            current_byte_destination);
      move_data (from_pointer, to_pointer, file_size_source,
            file_instance_to^.global_file_information^.record_delimiting_character, current_byte_source,
            current_byte_destination, last_move);

      IF file_instance_from^.private_read_information <> NIL THEN
        file_instance_from^.private_read_information^.positioning_info.record_info.current_byte_address :=
              current_byte_source;
        IF last_move THEN
          file_instance_from^.private_read_information^.positioning_info.record_info.file_position := amc$eoi;
        IFEND;
      ELSE
        file_instance_from^.global_file_information^.positioning_info.record_info.current_byte_address :=
              current_byte_source;
        IF last_move THEN
          file_instance_from^.global_file_information^.positioning_info.record_info.file_position := amc$eoi;
        IFEND;
      IFEND;

      file_instance_to^.instance_of_open_modified := TRUE;

      file_instance_to^.global_file_information^.positioning_info.record_info.current_byte_address :=
            current_byte_destination;
      file_instance_to^.global_file_information^.eoi_byte_address := current_byte_destination;
      file_instance_to^.global_file_information^.positioning_info.record_info.file_position := amc$eoi;
    END /main_program/;

    file_instance_from^.rollback_procedure := NIL;
    file_instance_to^.rollback_procedure := NIL;

  PROCEND bap$v_to_t_record_conversion;
?? OLDTITLE ??
?? NEWTITLE := 'MOVE_DATA', EJECT ??

  PROCEDURE [INLINE] move_data
    (    source: ^cell;
         destination: ^cell;
         file_length_source: amt$file_byte_address;
         record_delimiting_character: char;
     VAR current_byte_source: amt$file_byte_address;
     VAR current_byte_destination: amt$file_byte_address;
     VAR last_move: boolean);

    VAR
      from_ring: 0 .. 0f(16),
      to_ring: 0 .. 0f(16),
      from_segment: 0 .. 0fff(16),
      to_segment: 0 .. 0fff(16),
      from_header: 0 .. 0ffffffff(16),
      from_record: 0 .. 0ffffffff(16),
      to_record: 0 .. 0ffffffff(16),
      next_from: ^cell,
      next_to: ^cell,
      next_header: ^bat$record_header,
      records_moved: integer,
      transfer_length: integer,
      trailing_character_p: ^char;

    from_ring := #RING (source);
    from_segment := #SEGMENT (source);
    from_header := #OFFSET (source);
    from_record := from_header + #SIZE (bat$record_header);
    to_ring := #RING (destination);
    to_segment := #SEGMENT (destination);
    to_record := #OFFSET (destination);
    last_move := TRUE;
    records_moved := 0;

  /copy_the_records/
    WHILE from_header < file_length_source DO
      next_from := #ADDRESS (from_ring, from_segment, from_record);
      next_to := #ADDRESS (to_ring, to_segment, to_record);
      next_header := #ADDRESS (from_ring, from_segment, from_header);
      transfer_length := next_header^.length;
      IF transfer_length > 0 THEN
        i#move (next_from, next_to, transfer_length);
      IFEND;
      trailing_character_p := #ADDRESS (to_ring, to_segment, to_record + transfer_length);
      trailing_character_p^ := record_delimiting_character;
      from_record := from_record + transfer_length + #SIZE (bat$record_header);
      from_header := from_header + transfer_length + #SIZE (bat$record_header);
      to_record := to_record + transfer_length + 1;
      records_moved := records_moved + 1;

{ 10000 records were chosen to allow for interruptability of the copy
      IF records_moved = 10000 THEN
        last_move := FALSE;
        EXIT /copy_the_records/; {----->
      IFEND;
    WHILEND /copy_the_records/;

    current_byte_source := from_header;
    current_byte_destination := to_record;

  PROCEND move_data;
?? OLDTITLE ??
MODEND bam$v_to_t_record_conversion;
