?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Deadstart : Deadstart File FAPs' ??
MODULE dsm$deadstart_faps;

{ PURPOSE:
{   This module contains FAPS used by the deadstart utilities.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dse$nos_fap_errors
*copyc mld$memory_link_declarations
?? POP ??
*copyc amp$access_method
*copyc amp$fetch_fap_pointer
*copyc amp$store_fap_pointer
*copyc i#build_adaptable_seq_pointer
*copyc i#move
*copyc osp$set_status_abnormal
?? TITLE := 'Global Declarations Declaraed by This Module', EJECT ??
  CONST
    ai_eop = 4,
    ai_end_of_file = 7,
    ai_end_of_op = 8,

    max_words = (mlc$max_message_length DIV (512 * 8)) * 512,
    disk_block_size = max_words * 8,

    tape_block_size = 256 * 15,
    tape_trailer_eof = 17(8),
    tape_trailer_eor = 0;

  TYPE
    disk_fap_block = RECORD
      file_identifier: amt$file_identifier,
      next_type_of_partition: integer,
      write_end_of_partition: boolean,
      write_to_file: boolean,
    RECEND,

    i_tape_fap_block = RECORD
      file_identifier: amt$file_identifier,
      tape_block: ARRAY [1 .. (tape_block_size + 6)] OF char,
      tape_block_counter: integer,
      data_in_block: integer,
      block_number: integer,
      record_length: amt$max_record_length,
      file_position: amt$file_position,
      write_to_file: boolean,
    RECEND,

    padded_trailer_record = PACKED RECORD
      pad: 0 .. 15,
      trailer: tape_trailer,
      junk: 0 .. 15,
    RECEND,

    si_tape_fap_block = RECORD
      file_identifier: amt$file_identifier,
      block_number: integer,
      write_to_file: boolean,
    RECEND,

    tape_trailer = PACKED RECORD
      block_length: 0 .. 7777(8),
      block_number: 0 .. 77777777(8),
      block_level: 0 .. 7777(8),
    RECEND;
?? TITLE := 'disk_close_file', EJECT ??

{  PURPOSE:
{    This procedure closes the file that has the disk FAP attached.

  PROCEDURE disk_close_file
    (    call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR file_information_p: ^disk_fap_block;
     VAR status: ost$status);

    VAR
      file_identifier: amt$file_identifier;

    status.normal := TRUE;

   /close_file/
    BEGIN
      IF file_information_p^.write_to_file THEN

        { Write the end of partition information to the file.

        disk_write_eop_partition (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          EXIT /close_file/;
        IFEND;
        file_information_p^.next_type_of_partition := ai_end_of_op;
        disk_write_eop_partition (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          EXIT /close_file/;
        IFEND;
      IFEND;
    END /close_file/;

    file_identifier := file_information_p^.file_identifier;
    FREE file_information_p;
    amp$access_method (file_identifier, call_block, layer_number, status);

  PROCEND disk_close_file;
?? TITLE := 'disk_get_next', EJECT ??

{  PURPOSE:
{    This procedure retrieves a record of data from the file that has the disk fap attached.

  PROCEDURE disk_get_next
    (    file_information_p: ^disk_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      access_file_position: amt$file_position,
      access_transfer_count: amt$transfer_count,
      conversion_data_index: integer,
      conversion_data_p: ^PACKED ARRAY [1 .. *] OF 0 .. 0f(16),
      conversion_area_p: ^SEQ ( * ),
      data_block_p: ^SEQ ( * ),
      disk_block: ARRAY [1 .. disk_block_size] OF cell,
      end_of_partition_type: integer,
      file_position_p: ^amt$file_position,
      half_byte_index: 0 .. 16,
      total_data_size_p: ^amt$transfer_count,
      working_storage_data_index: integer,
      working_storage_data_p: ^PACKED ARRAY [1 .. *] OF 0 .. 0f(16),
      working_storage_seq_p: ^SEQ ( * );

    status.normal := TRUE;

    { Build a sequence pointer to the working storage area that will hold the data retrieved.

    file_position_p := call_block.getn.file_position;
    total_data_size_p := call_block.getn.transfer_count;
    total_data_size_p^ := 0;
    i#build_adaptable_seq_pointer (#RING (call_block.getn.working_storage_area),
       #SEGMENT (call_block.getn.working_storage_area),
       #OFFSET (call_block.getn.working_storage_area),
       call_block.getn.working_storage_length, 0, working_storage_seq_p);

    { Build the call block that will remove the data from the disk file.

    access_call_block.operation := amc$get_next_req;
    access_call_block.getn.working_storage_area := ^disk_block;
    access_call_block.getn.working_storage_length := #SIZE (disk_block);
    access_call_block.getn.transfer_count := ^access_transfer_count;
    access_call_block.getn.byte_address := ^access_byte_address;
    access_call_block.getn.file_position := ^access_file_position;

    { Retrieve chunks of data until an end of partition is reached.

    REPEAT
      amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF access_transfer_count > 0 THEN
        NEXT data_block_p: [[REP access_transfer_count OF cell]] IN working_storage_seq_p;
        i#move (^disk_block, data_block_p, access_transfer_count);
        total_data_size_p^ := total_data_size_p^ + access_transfer_count;
      IFEND;
    UNTIL access_file_position = amc$eop;

    IF total_data_size_p^ <> 0 THEN
      PUSH conversion_area_p: [[REP total_data_size_p^ OF cell]];
      RESET conversion_area_p;
      RESET working_storage_seq_p;

      { The data must be converted from groups of 60-bits of data stored right-justified into
      { 64-bit groups to PACKED data.

      NEXT working_storage_data_p: [1 .. (total_data_size_p^ * 2)] IN working_storage_seq_p;
      NEXT conversion_data_p: [1 .. (total_data_size_p^ * 2)] IN conversion_area_p;
      working_storage_data_index := 1;
      conversion_data_index := 1;
      half_byte_index := 0;
      WHILE (working_storage_data_index <= (total_data_size_p^ * 2)) DO
        CASE half_byte_index OF
        = 0 =

          { Skip over the half byte of zero.

        ELSE
          conversion_data_p^ [conversion_data_index] := working_storage_data_p^ [working_storage_data_index];
          conversion_data_index := conversion_data_index + 1;
          conversion_data_p^ [conversion_data_index] := 0;
        CASEND;
        working_storage_data_index := working_storage_data_index + 1;
        half_byte_index := (half_byte_index + 1) MOD 16;
      WHILEND;
      total_data_size_p^ := conversion_data_index DIV 2;
      RESET conversion_area_p;
      RESET working_storage_seq_p;
      i#move (conversion_area_p, working_storage_seq_p, total_data_size_p^);
    IFEND;

    { Retrieve the end of partition data and use it to find the file position.

    access_call_block.getn.working_storage_area := ^end_of_partition_type;
    access_call_block.getn.working_storage_length := #SIZE(end_of_partition_type);
    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
    IF end_of_partition_type = ai_eop THEN
      file_position_p^ := amc$eor;
    ELSEIF end_of_partition_type = ai_end_of_file THEN
      file_position_p^ := amc$eop;
    ELSEIF end_of_partition_type = ai_end_of_op THEN
      file_position_p^ := amc$eoi;
    IFEND;

  PROCEND disk_get_next;
?? TITLE := 'disk_open_file', EJECT ??

{  PURPOSE:
{    This procedure opens the file that has the disk FAP attached.  It also creates a pointer associated with
{    the FAP to save file information that is used for all the calls to access the file.

  PROCEDURE disk_open_file
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      file_information_p: ^disk_fap_block;

    status.normal := TRUE;

    { Open the file.

    amp$access_method (file_identifier, call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Create a FAP pointer that will store necessary information between calls to the FAP.  A FAP pointer
    { is associated with each instance of the file being opened.

    ALLOCATE file_information_p;
    amp$store_fap_pointer (file_identifier, layer_number, file_information_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_information_p^.file_identifier := file_identifier;
    file_information_p^.next_type_of_partition := ai_eop;
    file_information_p^.write_to_file := FALSE;
    file_information_p^.write_end_of_partition := FALSE;

  PROCEND disk_open_file;
?? TITLE := 'disk_put_next', EJECT ??

{  PURPOSE:
{    This procedure puts a record of data onto the file that has the disk fap attached.

  PROCEDURE disk_put_next
    (    file_information_p: ^disk_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      block_size: 1 .. disk_block_size,
      conversion_area_p: ^ SEQ ( * ),
      conversion_data_index: integer,
      conversion_data_p: ^PACKED ARRAY [1 .. *] OF 0 .. 0f(16),
      data_block_p: ^SEQ ( * ),
      disk_block: ARRAY [1 .. disk_block_size] OF cell,
      half_byte_index: 0 .. 16,
      new_record_size: integer,
      working_storage_data_index: integer,
      working_storage_data_p: ^PACKED ARRAY [1 ..*] OF 0 .. 0f(16),
      working_storage_seq_p: ^SEQ ( * );

    status.normal := TRUE;

    IF call_block.putn.working_storage_length = 0 THEN
      RETURN;
    IFEND;

    { Build a sequence pointer to the working storage area that contains the data to be stored.

    i#build_adaptable_seq_pointer (#RING (call_block.putn.working_storage_area),
       #SEGMENT (call_block.putn.working_storage_area),
       #OFFSET (call_block.putn.working_storage_area),
       call_block.putn.working_storage_length, 0, working_storage_seq_p);

    { Write the end of partition information, if necessary.

    IF file_information_p^.write_end_of_partition THEN
      disk_write_eop_partition (file_information_p, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      file_information_p^.next_type_of_partition := ai_eop;
    IFEND;
    file_information_p^.write_end_of_partition := TRUE;

    { Build a call block to put the data.

    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^disk_block;
    access_call_block.putn.byte_address := ^access_byte_address;
    access_byte_address := 0;

    { The data must be converted from the working storage area into groups of 60-bits of data stored
    { right-justified into 64-bit groups.  The new record size (which is defined in bytes) is found
    { by adding up how many 64-bit units are needed to fit the 60-bit chunks.

    new_record_size := ((((call_block.putn.working_storage_length * 8) + 59) DIV 60) * 64) DIV 8;
    PUSH conversion_area_p: [[REP new_record_size OF cell]];
    RESET conversion_area_p;
    NEXT working_storage_data_p: [1 .. (call_block.putn.working_storage_length * 2)] IN working_storage_seq_p;
    NEXT conversion_data_p: [1 .. (new_record_size * 2)] IN conversion_area_p;
    working_storage_data_index := 1;
    conversion_data_index := 1;
    half_byte_index := 0;
    WHILE (working_storage_data_index <= (call_block.putn.working_storage_length * 2)) DO
      CASE half_byte_index OF
      = 0 =
        conversion_data_p^ [conversion_data_index] := 0;
      ELSE
        conversion_data_p^ [conversion_data_index] := working_storage_data_p^ [working_storage_data_index];
        working_storage_data_index := working_storage_data_index + 1;
      CASEND;
      conversion_data_index := conversion_data_index + 1;
      half_byte_index := (half_byte_index + 1) MOD 16;
    WHILEND;
    FOR working_storage_data_index := conversion_data_index TO (new_record_size * 2) DO
      conversion_data_p^ [working_storage_data_index] := 0;
    FOREND;

    { Move the data from the conversion area to the file.

    RESET conversion_area_p;
    WHILE new_record_size > 0 DO
      IF new_record_size > disk_block_size THEN
        block_size := disk_block_size;
      ELSE
        block_size := new_record_size;
      IFEND;
      new_record_size := new_record_size - block_size;
      access_call_block.putn.working_storage_length := block_size;
      NEXT data_block_p: [[REP block_size OF cell]] IN conversion_area_p;
      i#move (data_block_p, ^disk_block, block_size);
      amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    WHILEND;

  PROCEND disk_put_next;
?? TITLE := 'disk_write_eop_partition', EJECT ??

{  PURPOSE:
{    This procedure writes the end of partition information at the end of each record.

  PROCEDURE disk_write_eop_partition
    (    file_information_p: ^disk_fap_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      type_of_partition: integer;

    status.normal := TRUE;
    IF file_information_p^.next_type_of_partition <> ai_eop THEN
      access_call_block.operation := amc$put_next_req;
      access_call_block.putn.working_storage_area := ^type_of_partition;
      access_call_block.putn.working_storage_length := 0;
      access_call_block.putn.byte_address := ^access_byte_address;
      access_byte_address := 0;
      amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
      IF NOT status.normal THEN
       RETURN;
      IFEND;
    IFEND;

    access_call_block.operation := amc$write_end_partition_req;
    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^type_of_partition;
    access_call_block.putn.working_storage_length := #SIZE(type_of_partition);
    access_call_block.putn.byte_address := ^access_byte_address;
    access_byte_address := 0;
    type_of_partition := file_information_p^.next_type_of_partition;
    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);

  PROCEND disk_write_eop_partition;
?? TITLE := 'i_tape_close_file', EJECT ??

{ PURPOSE:
{   This procedure closes the file that has the I tape FAP attached.

  PROCEDURE i_tape_close_file
    (    call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR file_information_p: ^i_tape_fap_block;
     VAR status: ost$status);

    VAR
      file_identifier: amt$file_identifier;

    status.normal := TRUE;

   /close_i_tape/
    BEGIN
      IF file_information_p^.write_to_file THEN
        IF file_information_p^.data_in_block <> 0 THEN
          i_tape_put_block (file_information_p, layer_number, status);
          IF NOT status.normal THEN
            EXIT /close_i_tape/;
          IFEND;
        IFEND;

        tape_finish_file (file_information_p^.file_identifier, file_information_p^.block_number,
              layer_number, status);
        IF NOT status.normal THEN
          EXIT /close_i_tape/;
        IFEND;
      IFEND;
    END /close_i_tape/;

    file_identifier := file_information_p^.file_identifier;
    FREE file_information_p;
    amp$access_method (file_identifier, call_block, layer_number, status);

  PROCEND i_tape_close_file;
?? TITLE := 'i_tape_get_block', EJECT ??

{ PURPOSE:
{   This procedure retrieves a block from an I tape.

  PROCEDURE i_tape_get_block
    (    file_information_p: ^i_tape_fap_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      access_file_position: amt$file_position,
      access_transfer_count: amt$transfer_count,
      padded_trailer: padded_trailer_record,
      trailer: tape_trailer;

    status.normal := TRUE;
    access_call_block.operation := amc$get_next_req;
    access_call_block.getn.working_storage_area := ^file_information_p^.tape_block;
    access_call_block.getn.working_storage_length := #SIZE (file_information_p^.tape_block);
    access_call_block.getn.transfer_count := ^access_transfer_count;
    access_call_block.getn.byte_address := ^access_byte_address;
    access_call_block.getn.file_position := ^access_file_position;
    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (access_transfer_count = 0) AND (access_file_position = amc$eoi) THEN
      file_information_p^.file_position := amc$eoi;
      RETURN;
    IFEND;

    IF (access_transfer_count * 8) MOD 12 = 0 THEN
      i#move (^file_information_p^.tape_block [access_transfer_count - 5], ^trailer, 6);
    ELSE
      i#move (^file_information_p^.tape_block [access_transfer_count - 6], ^padded_trailer, 7);
      trailer := padded_trailer.trailer;
      padded_trailer.trailer.block_length := 0;
    IFEND;

    IF access_transfer_count <> (((trailer.block_length * 12) + 7) DIV 8) THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$tape_damaged, '', status);
      RETURN;
    IFEND;
    IF trailer.block_number <> (file_information_p^.block_number + 1) THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$tape_damaged, '', status);
      RETURN;
    IFEND;

    file_information_p^.block_number := trailer.block_number;
    file_information_p^.data_in_block := access_transfer_count - 6;
    IF access_file_position = amc$eoi THEN
      file_information_p^.file_position := amc$eoi;
    ELSEIF trailer.block_level = 15 THEN
      file_information_p^.file_position := amc$eop;
    ELSEIF file_information_p^.data_in_block < tape_block_size THEN
      file_information_p^.file_position := amc$eor;
    ELSE
      file_information_p^.file_position := amc$mid_record;
    IFEND;
    file_information_p^.tape_block_counter := 1;

  PROCEND i_tape_get_block;
?? TITLE := 'i_tape_get_next', EJECT ??

{ PURPOSE:
{   This procedure retrieves a record from an I tape.

  PROCEDURE i_tape_get_next
    (    file_information_p: ^i_tape_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      data_block_p: ^SEQ ( * ),
      file_position_p: ^amt$file_position,
      length: integer,
      transfer_count_p: ^amt$transfer_count,
      working_storage_p: ^SEQ ( * );

    status.normal := TRUE;
    file_position_p := call_block.getn.file_position;
    transfer_count_p := call_block.getn.transfer_count;
    transfer_count_p^ := 0;
    i#build_adaptable_seq_pointer (#RING (call_block.getn.working_storage_area),
          #SEGMENT (call_block.getn.working_storage_area), #OFFSET (call_block.getn.working_storage_area),
          call_block.getn.working_storage_length, 0, working_storage_p);

    WHILE file_information_p^.file_position <> amc$eor DO
      i_tape_get_block (file_information_p, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF file_information_p^.file_position = amc$eoi THEN
        file_position_p^ := file_information_p^.file_position;
        RETURN;
      IFEND;
    WHILEND;
    file_information_p^.data_in_block := 0;

    WHILE call_block.getn.working_storage_length > transfer_count_p^ DO
      WHILE file_information_p^.data_in_block = 0 DO
        i_tape_get_block (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF (file_information_p^.data_in_block = 0) AND
              (file_information_p^.file_position <> amc$mid_record) THEN
          file_position_p^ := file_information_p^.file_position;
          RETURN;
        IFEND;
      WHILEND;
      IF (call_block.getn.working_storage_length - transfer_count_p^) < file_information_p^.data_in_block THEN
        length := call_block.getn.working_storage_length - transfer_count_p^;
      ELSE
        length := file_information_p^.data_in_block;
      IFEND;
      NEXT data_block_p: [[REP length OF cell]] IN working_storage_p;
      i#move (^file_information_p^.tape_block [file_information_p^.tape_block_counter], data_block_p, length);
      file_information_p^.tape_block_counter := file_information_p^.tape_block_counter + length;
      file_information_p^.data_in_block := file_information_p^.data_in_block - length;
      transfer_count_p^ := transfer_count_p^ + length;
      IF file_information_p^.file_position = amc$eor THEN
        file_position_p^ := file_information_p^.file_position;
        RETURN;
      IFEND;
    WHILEND;

    file_position_p^ := file_information_p^.file_position;

  PROCEND i_tape_get_next;
?? TITLE := 'i_tape_get_partial', EJECT ??

{ PURPOSE:
{   This procedure retrieves a partial record from an I tape.

  PROCEDURE i_tape_get_partial
    (    file_information_p: ^i_tape_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      data_block_p: ^SEQ ( * ),
      file_position_p: ^amt$file_position,
      length: integer,
      record_length_p: ^amt$max_record_length,
      skip_option: amt$skip_option,
      transfer_count_p: ^amt$transfer_count,
      working_storage_p: ^SEQ ( * );

    status.normal := TRUE;
    file_position_p := call_block.getp.file_position;
    record_length_p := call_block.getp.record_length;
    skip_option := call_block.getp.skip_option;
    transfer_count_p := call_block.getp.transfer_count;
    transfer_count_p^ := 0;
    i#build_adaptable_seq_pointer (#RING (call_block.getp.working_storage_area),
          #SEGMENT (call_block.getp.working_storage_area), #OFFSET (call_block.getp.working_storage_area),
          call_block.getp.working_storage_length, 0, working_storage_p);

    IF skip_option = amc$skip_to_eor THEN
      WHILE file_information_p^.file_position <> amc$eor DO
        i_tape_get_block (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF file_information_p^.file_position = amc$eoi THEN
          file_position_p^ := file_information_p^.file_position;
          RETURN;
        IFEND;
      WHILEND;
      file_information_p^.data_in_block := 0;
      file_information_p^.record_length := 0;
    IFEND;

   /get_data_loop/
    WHILE call_block.getp.working_storage_length > transfer_count_p^ DO
      WHILE file_information_p^.data_in_block = 0 DO
        i_tape_get_block (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF (file_information_p^.data_in_block = 0) AND
              (file_information_p^.file_position <> amc$mid_record) THEN
          EXIT /get_data_loop/;
        IFEND;
      WHILEND;
      IF (call_block.getp.working_storage_length - transfer_count_p^) < file_information_p^.data_in_block THEN
        length := call_block.getp.working_storage_length - transfer_count_p^;
      ELSE
        length := file_information_p^.data_in_block;
      IFEND;
      NEXT data_block_p: [[REP length OF cell]] IN working_storage_p;
      i#move (^file_information_p^.tape_block [file_information_p^.tape_block_counter], data_block_p, length);
      file_information_p^.tape_block_counter := file_information_p^.tape_block_counter + length;
      file_information_p^.data_in_block := file_information_p^.data_in_block - length;
      transfer_count_p^ := transfer_count_p^ + length;
      IF file_information_p^.file_position = amc$eor THEN
        EXIT /get_data_loop/;
      IFEND;
    WHILEND /get_data_loop/;

    file_information_p^.record_length := file_information_p^.record_length + transfer_count_p^;
    record_length_p^ := file_information_p^.record_length;
    file_position_p^ := file_information_p^.file_position;

  PROCEND i_tape_get_partial;
?? TITLE := 'i_tape_open_file', EJECT ??

{ PURPOSE:
{   This procedure opens an I tape file.

  PROCEDURE i_tape_open_file
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      file_information_p: ^i_tape_fap_block;

    status.normal := TRUE;
    amp$access_method (file_identifier, call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE file_information_p;
    amp$store_fap_pointer (file_identifier, layer_number, file_information_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_information_p^.file_identifier := file_identifier;
    file_information_p^.tape_block_counter := 1;
    file_information_p^.data_in_block := 0;
    file_information_p^.block_number := -1;
    file_information_p^.record_length := 0;
    file_information_p^.file_position := amc$eor;
    file_information_p^.write_to_file := FALSE;

  PROCEND i_tape_open_file;
?? TITLE := 'i_tape_put_block', EJECT ??

{ PURPOSE:
{   This procedure puts a block of data on the I tape.

  PROCEDURE i_tape_put_block
    (    file_information_p: ^i_tape_fap_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      data_length: integer,
      padding_needed: integer,
      padded_trailer: padded_trailer_record,
      trailer: tape_trailer;

    status.normal := TRUE;
    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^file_information_p^.tape_block;
    access_call_block.putn.byte_address := ^access_byte_address;

    data_length := file_information_p^.data_in_block;
    padding_needed := 60 - ((data_length * 8) MOD 60);
    IF padding_needed < 56 THEN
      data_length := data_length + (padding_needed DIV 8);
    IFEND;

    IF ((data_length + 6) * 8 ) MOD 12 = 0 THEN
      trailer.block_length := ((data_length + 6) * 8) DIV 12;
      trailer.block_number := file_information_p^.block_number + 1;
      trailer.block_level := 0;
      i#move (^trailer, ^file_information_p^.tape_block [data_length + 1], 6);
    ELSE
      IF padding_needed < 56 THEN
        data_length := data_length + 1;
      ELSE
        i#move (^file_information_p^.tape_block [data_length], ^padded_trailer, 1);
      IFEND;
      padded_trailer.trailer.block_length := ((data_length + 6) * 8) DIV 12;
      padded_trailer.trailer.block_number := file_information_p^.block_number + 1;
      padded_trailer.trailer.block_level := 0;
      i#move (^padded_trailer, ^file_information_p^.tape_block [data_length], 7);
    IFEND;

    access_call_block.putn.working_storage_length := data_length + 6;
    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_information_p^.block_number := file_information_p^.block_number + 1;
    file_information_p^.data_in_block := 0;
    file_information_p^.tape_block_counter := 1;

  PROCEND i_tape_put_block;
?? TITLE := 'i_tape_put_next', EJECT ??

{ PURPOSE:
{   This procedure puts the next record on an I tape.

  PROCEDURE i_tape_put_next
    (    file_information_p: ^i_tape_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      data_block_p: ^SEQ ( * ),
      data_length: integer,
      length: integer,
      working_storage_p: ^SEQ ( * );

    status.normal := TRUE;
    i#build_adaptable_seq_pointer (#RING (call_block.putn.working_storage_area),
          #SEGMENT (call_block.putn.working_storage_area), #OFFSET (call_block.putn.working_storage_area),
          call_block.putn.working_storage_length, 0, working_storage_p);

    IF file_information_p^.file_position <> amc$eor THEN
      i_tape_put_block (file_information_p, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      file_information_p^.file_position := amc$mid_record;
    IFEND;
    data_length := call_block.putn.working_storage_length;
    WHILE data_length <> 0 DO
      IF file_information_p^.data_in_block = tape_block_size THEN
        i_tape_put_block (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        file_information_p^.file_position := amc$mid_record;
      IFEND;
      IF data_length <= (tape_block_size - file_information_p^.data_in_block) THEN
        length := data_length;
      ELSE
        length := tape_block_size - file_information_p^.data_in_block;
      IFEND;
      NEXT data_block_p: [[REP length OF cell]] IN working_storage_p;
      i#move (data_block_p, ^file_information_p^.tape_block [file_information_p^.tape_block_counter], length);
      file_information_p^.tape_block_counter := file_information_p^.tape_block_counter + length;
      file_information_p^.data_in_block := file_information_p^.data_in_block + length;
      data_length := data_length - length;
    WHILEND;

    i_tape_put_block (file_information_p, layer_number, status);
    file_information_p^.file_position := amc$eor;

  PROCEND i_tape_put_next;
?? TITLE := 'i_tape_put_partial', EJECT ??

{ PURPOSE:
{   This procedure puts a partial record on an I tape.

  PROCEDURE i_tape_put_partial
    (    file_information_p: ^i_tape_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      data_block_p: ^SEQ ( * ),
      data_length: integer,
      length: integer,
      working_storage_p: ^SEQ ( * );

    status.normal := TRUE;
    i#build_adaptable_seq_pointer (#RING (call_block.putp.working_storage_area),
          #SEGMENT (call_block.putp.working_storage_area), #OFFSET (call_block.putp.working_storage_area),
          call_block.putp.working_storage_length, 0, working_storage_p);

    IF (call_block.putp.term_option = amc$continue) AND (file_information_p^.file_position = amc$eor) THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$write_at_eor, '', status);
      RETURN;
    IFEND;
    IF (call_block.putp.term_option = amc$start) AND (file_information_p^.file_position <> amc$eor) THEN
      i_tape_put_block (file_information_p, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
    IF call_block.putp.term_option = amc$start THEN
      file_information_p^.file_position := amc$mid_record;
    IFEND;

    data_length := call_block.putp.working_storage_length;
    WHILE data_length <> 0 DO
      IF file_information_p^.data_in_block = tape_block_size THEN
        i_tape_put_block (file_information_p, layer_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        file_information_p^.file_position := amc$mid_record;
      IFEND;
      IF data_length <= (tape_block_size - file_information_p^.data_in_block) THEN
        length := data_length;
      ELSE
        length := tape_block_size - file_information_p^.data_in_block;
      IFEND;
      NEXT data_block_p: [[REP length OF cell]] IN working_storage_p;
      i#move (data_block_p, ^file_information_p^.tape_block [file_information_p^.tape_block_counter], length);
      file_information_p^.tape_block_counter := file_information_p^.tape_block_counter + length;
      file_information_p^.data_in_block := file_information_p^.data_in_block + length;
      data_length := data_length - length;
    WHILEND;

    IF call_block.putp.term_option = amc$terminate THEN
      i_tape_put_block (file_information_p, layer_number, status);
      file_information_p^.file_position := amc$eor;
    IFEND;

  PROCEND i_tape_put_partial;
?? TITLE := 'i_tape_write_eof', EJECT ??

{ PURPOSE:
{   This procedure writes an EOF mark on the I tape.

  PROCEDURE i_tape_write_eof
    (    file_information_p: ^i_tape_fap_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      trailer: tape_trailer;

    status.normal := TRUE;
    IF file_information_p^.data_in_block <> 0 THEN
      i_tape_put_block (file_information_p, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^trailer;
    access_call_block.putn.working_storage_length := #SIZE (trailer);
    access_call_block.putn.byte_address := ^access_byte_address;
    trailer.block_length := 4;
    trailer.block_number := file_information_p^.block_number + 1;
    trailer.block_level := 15;
    file_information_p^.block_number := file_information_p^.block_number + 1;
    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_information_p^.file_position := amc$eop;

  PROCEND i_tape_write_eof;
?? TITLE := 'si_tape_close_file', EJECT ??

{  PURPOSE:
{    This procedure closes the file that has the SI tape FAP attached.

  PROCEDURE si_tape_close_file
    (    call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR file_information_p: ^si_tape_fap_block;
     VAR status: ost$status);

    VAR
      file_identifier: amt$file_identifier;

    status.normal := TRUE;

   /close_si_tape/
    BEGIN
      IF file_information_p^.write_to_file THEN

        { Write the EOF mark and the tape marks to the file.

        tape_finish_file (file_information_p^.file_identifier,
              file_information_p^.block_number, layer_number, status);
        IF NOT status.normal THEN
          EXIT /close_si_tape/;
        IFEND;
      IFEND;
    END /close_si_tape/;

    file_identifier := file_information_p^.file_identifier;
    FREE file_information_p;
    amp$access_method (file_identifier, call_block, layer_number, status);

  PROCEND si_tape_close_file;
?? TITLE := 'si_tape_get_next', EJECT ??

{  PURPOSE:
{    This procedure retrieves a record of data from the file that has a SI fap attached.

  PROCEDURE si_tape_get_next
    (    file_information_p: ^si_tape_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      access_file_position: amt$file_position,
      data_block_seq_p: ^SEQ ( * ),
      data_size: amt$transfer_count,
      file_position_p: ^amt$file_position,
      padded_trailer: padded_trailer_record,
      tape_block: ARRAY [1 .. (tape_block_size + 6)] OF char,
      total_data_size_p: ^amt$transfer_count,
      trailer: tape_trailer,
      trailer_found: boolean,
      working_storage_seq_p: ^SEQ ( * );

    status.normal := TRUE;

    { Build a sequence pointer to the working storage area that will hold the data retrieved.

    file_position_p := call_block.getn.file_position;
    total_data_size_p := call_block.getn.transfer_count;
    total_data_size_p^ := 0;
    i#build_adaptable_seq_pointer (#RING (call_block.getn.working_storage_area),
          #SEGMENT (call_block.getn.working_storage_area), #OFFSET (call_block.getn.working_storage_area),
          call_block.getn.working_storage_length, 0, working_storage_seq_p);

    { Build the call block that will remove the data from the SI tape.  The data is removed from the tape
    { in chunks of size "tape_block_size".  The last chunk of data for the record has a tape trailer.

    access_call_block.operation := amc$get_next_req;
    access_call_block.getn.working_storage_area := ^tape_block;
    access_call_block.getn.working_storage_length := #SIZE (tape_block);
    access_call_block.getn.transfer_count := ^data_size;
    access_call_block.getn.byte_address := ^access_byte_address;
    access_call_block.getn.file_position := ^access_file_position;

    trailer_found := FALSE;
    REPEAT

      { Retrieve chunks of data until an "EOI" is reached.

      amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (data_size = 0) AND (access_file_position = amc$eoi) THEN
        file_position_p^ := amc$eoi;
        RETURN;
      IFEND;

      { If the data size of the tape chunk is less then the tape block size then the tape chunk is the last
      { chunk of the record and it has a trailer.  It may possibly contain only a trailer.

      IF data_size < tape_block_size THEN
        trailer_found := TRUE;
        IF (data_size MOD 3) = 0 THEN

          { If the data read from the tape is divisible by 3, then the data in the tape chunk contains an
          { even number of 60-bit words.  The data is written to the tape in 3 groups of 8 bits and an even
          { number of 60-bit words contains a number of 8-bit units that is divisible by 3.  This type of
          { tape chunk contains a normal 48-bit tape trailer following in the data.

          i#move (^tape_block [data_size - (#SIZE (tape_trailer) - 1)], ^trailer, #SIZE (tape_trailer));
        ELSE

          { If the data read from the tape is not divisible by 3, then there will be a remainder of 2.  This
          { occurs when data in the tape chunk contains an odd number of 60-bit words.  An odd number of
          { 60-bit words and a 48-bit tape trailer do not break down evenly into 3 groups of 8 bits.  In
          { this case, all possible 3 groups of 8 bit units are written to the tape and the leftover is
          { written into 2 groups of 8 bit units.  The last four bits of the last group is invalid data and
          { will be ignored.  Because this structure does not fit on a byte boundary a special trailer
          { structure is used to remove the trailer from the data.  The first four bits of this special
          { trailer is actually the last four bits of the valid data.

          i#move (^tape_block [data_size - (#SIZE (padded_trailer_record) - 1)],
                ^padded_trailer, #SIZE (padded_trailer_record));
          trailer := padded_trailer.trailer;
          padded_trailer.trailer.block_length := 0;
        IFEND;

        { Remove the size of the trailer from the data size.

        data_size := data_size - #SIZE (tape_trailer);
      ELSE
        file_information_p^.block_number := file_information_p^.block_number + 1;
      IFEND;

      { Move the data from the tape chunk to the working storage area.

      IF data_size > 0 THEN
        NEXT data_block_seq_p: [[REP data_size OF cell]] IN working_storage_seq_p;
        i#move (^tape_block, data_block_seq_p, data_size);
        total_data_size_p^ := total_data_size_p^ + data_size;
      IFEND;
    UNTIL trailer_found;

    { Check to see if the trailer is damaged.

    IF (data_size + #SIZE (tape_trailer)) <> (((trailer.block_length * 12) + 7) DIV 8) THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$tape_damaged, '', status);
      RETURN;
    IFEND;
    IF trailer.block_number <> (file_information_p^.block_number + 1) THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$tape_damaged, '', status);
      RETURN;
    IFEND;

    { Retrieve the file position from the trailer.

    IF access_file_position = amc$eoi THEN
      file_position_p^ := amc$eoi;
    ELSE
      file_information_p^.block_number := trailer.block_number;
      IF trailer.block_level = tape_trailer_eof THEN
        file_position_p^ := amc$eop;
      ELSEIF trailer.block_level = tape_trailer_eor THEN
        file_position_p^ := amc$eor;
      IFEND;
    IFEND;

  PROCEND si_tape_get_next;
?? TITLE := 'si_tape_open_file', EJECT ??

{  PURPOSE:
{    This procedure opens the file that has the SI tape fap attached.  It also creates a pointer
{    associated with the FAP to save file information that is used for all the calls to access the file.

  PROCEDURE si_tape_open_file
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      file_information_p: ^si_tape_fap_block;

    status.normal := TRUE;

    { Open the file.

    amp$access_method (file_identifier, call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Save a fap pointer that contains some file information.

    ALLOCATE file_information_p;
    file_information_p^.file_identifier := file_identifier;
    file_information_p^.block_number := -1;
    file_information_p^.write_to_file := FALSE;

    amp$store_fap_pointer (file_identifier, layer_number, file_information_p, status);

  PROCEND si_tape_open_file;
?? TITLE := 'si_tape_put_next', EJECT ??

{  PURPOSE:
{    This procedure puts a record of data onto the file that has a SI fap attached.

  PROCEDURE si_tape_put_next
    (    file_information_p: ^si_tape_fap_block;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      data_block_seq_p: ^SEQ ( * ),
      data_size: integer,
      data_size_to_put: integer,
      extra_data: integer,
      padded_trailer: padded_trailer_record,
      tape_block: ARRAY [1 .. tape_block_size + 6] OF char,
      trailer: tape_trailer,
      trailer_written: boolean,
      working_storage_seq_p: ^SEQ ( * );

    status.normal := TRUE;

    { Build a sequence pointer to the working storage area that contains the data to be stored.

    i#build_adaptable_seq_pointer (#RING (call_block.putn.working_storage_area),
          #SEGMENT (call_block.putn.working_storage_area), #OFFSET (call_block.putn.working_storage_area),
          call_block.putn.working_storage_length, 0, working_storage_seq_p);

    { Build a call block to put the data.

    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^tape_block;
    access_call_block.putn.byte_address := ^access_byte_address;

    data_size := call_block.putn.working_storage_length;

    { The data is put into tape chunks with the last chunk containing a trailer.  The last chunk
    { may possibly contain only a trailer.

    REPEAT

      { Find out how much data will be stored in this tape chunk.

      IF data_size >= tape_block_size THEN
        data_size_to_put := tape_block_size;
        trailer_written := FALSE;
      ELSE
        data_size_to_put := data_size;
        trailer_written := TRUE;
      IFEND;

      { Move the data from the working storage area to the tape chunk.

      IF data_size_to_put > 0 THEN
        NEXT data_block_seq_p: [[REP data_size_to_put OF cell]] IN working_storage_seq_p;
        i#move (data_block_seq_p, ^tape_block, data_size_to_put);
      IFEND;

      IF NOT trailer_written THEN
        access_call_block.putn.working_storage_length := data_size_to_put;
        data_size := data_size - data_size_to_put;
      ELSE
        access_call_block.putn.working_storage_length := data_size_to_put + #SIZE (tape_trailer);

        { The block length in the trailer is defined to be in 12-bit units (a NOS byte).

        trailer.block_length := ((data_size_to_put + #SIZE (tape_trailer)) * 8) DIV 12;
        trailer.block_number := file_information_p^.block_number + 1;
        trailer.block_level := tape_trailer_eor;

        IF (data_size_to_put + #SIZE (tape_trailer)) MOD 3 = 0 THEN

          { If the data size and the size of the tape trailer is divisible by 3, then the data to be put
          { in the tape chunk contains an even number of 60-bit words.  The data is written to the tape in
          { 3 groups of 8 bits and an even number of 60-bit words contains a number of 8-bit units that is
          { divisible by 3.  This type of tape chunk contains a normal 48-bit tape trailer following the data.

          i#move (^trailer, ^tape_block [data_size_to_put + 1], #SIZE (tape_trailer));
        ELSE

          { If the data size and the tape trailer size is not divisible by 3, then there will be a remainder
          { of 2.  This occurs when data in the tape chunk contains an odd number of 60-bit words.  An odd
          { number of 60-bit words and a 48-bit tape trailer do not break down evenly into 3 groups of 8 bits.
          { In this case, all possible 3 groups of 8 bit units are written to the tape and the leftover is
          { written into 2 groups of 8 bit units.  The last four bits of the last group is invalid data and
          { should be ignored.  Because this structure does not fit on a byte boundary a special trailer
          { structure is used to add the trailer to the data.  The first four bits of this special trailer is
          { actually the last four bits of the valid data so that the tape trailer immediately follows the
          { last 60-bit word.

          i#move (^tape_block [data_size_to_put], ^padded_trailer, 1);
          padded_trailer.trailer := trailer;
          i#move (^padded_trailer, ^tape_block [data_size_to_put], #SIZE (padded_trailer_record));
        IFEND;
      IFEND;

      amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      file_information_p^.block_number := file_information_p^.block_number + 1;
    UNTIL trailer_written;

  PROCEND si_tape_put_next;
?? TITLE := 'si_tape_write_eof', EJECT ??

{  PURPOSE:
{    This procedure puts an "EOF" mark on the file that has a SI fap attached.

  PROCEDURE si_tape_write_eof
    (    file_information_p: ^si_tape_fap_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      trailer: tape_trailer;

    status.normal := TRUE;

    { Build the call block that writes the EOF.

    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^trailer;
    access_call_block.putn.working_storage_length := #SIZE (trailer);
    access_call_block.putn.byte_address := ^access_byte_address;

    { The block length in the trailer is defined to be in 12-bit units (a NOS byte).

    trailer.block_length := (#SIZE (tape_trailer) * 8) DIV 12;
    trailer.block_number := file_information_p^.block_number + 1;
    trailer.block_level := tape_trailer_eof;

    file_information_p^.block_number := file_information_p^.block_number + 1;

    amp$access_method (file_information_p^.file_identifier, access_call_block, layer_number, status);

  PROCEND si_tape_write_eof;
?? TITLE := 'tape_finish_file', EJECT ??

{  PURPOSE:
{    This procedure writes some necessary ending information to the file.  The necessary ending
{    information contains a tape mark, EOF data and three tape marks.

  PROCEDURE tape_finish_file
    (    file_identifier: amt$file_identifier;
         block_number: integer;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      access_byte_address: amt$file_byte_address,
      access_call_block: amt$call_block,
      string_length: integer,
      tape_block: ARRAY [1 ..tape_block_size + 6] OF char,
      tape_block_index: 1 .. 80,
      temp_string: string (8);

    status.normal := TRUE;
    access_call_block.operation := amc$write_tape_mark_req;
    amp$access_method (file_identifier, access_call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Write the EOF data to the file.

    tape_block [1] := 'E';
    tape_block [2] := 'O';
    tape_block [3] := 'F';
    tape_block [4] := '1';
    FOR tape_block_index := 5 TO 80 DO
      tape_block [tape_block_index] := ' ';
    FOREND;
    STRINGREP (temp_string, string_length, (1000000 + block_number + 1));
    tape_block [55] := temp_string (3);
    tape_block [56] := temp_string (4);
    tape_block [57] := temp_string (5);
    tape_block [58] := temp_string (6);
    tape_block [59] := temp_string (7);
    tape_block [60] := temp_string (8);
    access_call_block.operation := amc$put_next_req;
    access_call_block.putn.working_storage_area := ^tape_block;
    access_call_block.putn.working_storage_length := 80;
    access_call_block.putn.byte_address := ^access_byte_address;
    amp$access_method (file_identifier, access_call_block, layer_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Write three tape marks to the file.

    FOR tape_block_index := 1 TO 3 DO
      access_call_block.operation := amc$write_tape_mark_req;
      amp$access_method (file_identifier, access_call_block, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND tape_finish_file;
?? TITLE := 'dsp$mrf_disk_format', EJECT ??

{  PURPOSE:
{    This procedure is the FAP used to access disk files that were retrieved from NOS using the
{    command 'REPLACE_MULTI_RECORD_FILE' or disk files that will be sent to NOS using the command
{    'GET_MULTI_RECORD_FILE'.

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

    VAR
      file_information_p: ^disk_fap_block;

    status.normal := TRUE;
    IF call_block.operation <> amc$open_req THEN
      amp$fetch_fap_pointer (file_identifier, layer_number, file_information_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    CASE call_block.operation OF
    = amc$close_req =
      disk_close_file (call_block, layer_number, file_information_p, status);
    = amc$get_next_req =
      disk_get_next (file_information_p, call_block, layer_number, status);
    = amc$open_req =
      disk_open_file (file_identifier, call_block, layer_number, status);
    = amc$put_next_req =
      file_information_p^.write_to_file := TRUE;
      disk_put_next (file_information_p, call_block, layer_number, status);
    = amc$rewind_req =
      amp$access_method (file_information_p^.file_identifier, call_block, layer_number, status);
    = amc$write_end_partition_req =
      disk_write_eop_partition (file_information_p, layer_number, status);
      file_information_p^.next_type_of_partition := ai_end_of_file;
    ELSE
      osp$set_status_abnormal (dsc$display_processor_id, dse$command_not_supported, '', status);
    CASEND;

  PROCEND dsp$mrf_disk_format;
?? TITLE := 'dsp$i_tape_format', EJECT ??

{  PURPOSE:
{    This procedure is the FAP used to read or write tapes in I format.

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

    VAR
      file_information_p: ^i_tape_fap_block;

    status.normal := TRUE;
    IF call_block.operation = amc$open_req THEN
      i_tape_open_file (file_identifier, call_block, layer_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
    amp$fetch_fap_pointer (file_identifier, layer_number, file_information_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE call_block.operation OF
    = amc$open_req, amc$close_req =
      ;
    = amc$get_next_req =
      i_tape_get_next (file_information_p, call_block, layer_number, status);
    = amc$get_partial_req =
      i_tape_get_partial (file_information_p, call_block, layer_number, status);
    = amc$put_next_req =
      file_information_p^.write_to_file := TRUE;
      i_tape_put_next (file_information_p, call_block, layer_number, status);
    = amc$put_partial_req =
      file_information_p^.write_to_file := TRUE;
      i_tape_put_partial (file_information_p, call_block, layer_number, status);
    = amc$write_end_partition_req =
      file_information_p^.write_to_file := TRUE;
      i_tape_write_eof (file_information_p, layer_number, status);
    = amc$rewind_req =
      amp$access_method (file_identifier, call_block, layer_number, status);
    ELSE
      osp$set_status_abnormal (dsc$display_processor_id, dse$command_not_supported,
         '', status);
    CASEND;

    IF call_block.operation = amc$close_req THEN
      i_tape_close_file (call_block, layer_number, file_information_p, status);
    IFEND;

  PROCEND dsp$i_tape_format;
?? TITLE := 'dsp$si_tape_format', EJECT ??

{  PURPOSE:
{    This procedure is the FAP used to read or write tapes in SI format.

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

    VAR
      file_information_p: ^si_tape_fap_block;

    status.normal := TRUE;

    IF call_block.operation <> amc$open_req THEN
      amp$fetch_fap_pointer (file_identifier, layer_number, file_information_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    CASE call_block.operation OF
    = amc$close_req =
      si_tape_close_file (call_block, layer_number, file_information_p, status);
    = amc$get_next_req =
      si_tape_get_next (file_information_p, call_block, layer_number, status);
    = amc$open_req =
      si_tape_open_file (file_identifier, call_block, layer_number, status);
    = amc$put_next_req =
      file_information_p^.write_to_file := TRUE;
      si_tape_put_next (file_information_p, call_block, layer_number, status);
    = amc$rewind_req =
      amp$access_method (file_information_p^.file_identifier, call_block, layer_number, status);
    = amc$write_end_partition_req =
      file_information_p^.write_to_file := TRUE;
      si_tape_write_eof (file_information_p, layer_number, status);
    ELSE
      osp$set_status_abnormal (dsc$display_processor_id, dse$command_not_supported, '', status);
    CASEND;

  PROCEND dsp$si_tape_format;
MODEND dsm$deadstart_faps;
