MODULE ram$nos_file_transfer;
*copyc OSD$DEFAULT_PRAGMATS
?? PUSH (LISTEXT := OFF) ??
*copyc CLP$EVALUATE_PARAMETERS
*copyc fsp$open_file
*copyc AMP$WRITE_TAPE_MARK
*copyc AMP$ACCESS_METHOD
*copyc fsp$close_file
*copyc AMP$GET_NEXT
*copyc AMP$PUT_NEXT
*copyc AMP$WRITE_END_PARTITION
*copyc I#MOVE
*copyc I#BUILD_ADAPTABLE_SEQ_POINTER
*copyc OSP$SET_STATUS_ABNORMAL
*copyc MLP$SIGN_ON
*copyc MLP$CONFIRM_SEND
*copyc MLP$ADD_SENDER
*copyc MLP$SEND_MESSAGE
*copyc MLP$RECEIVE_MESSAGE
*copyc MLP$RECEIVE_MESSAGE
*copyc MLP$SIGN_OFF
*copyc PMP$LONG_TERM_WAIT
*copyc PMT$PROGRAM_PARAMETERS
*copyc PMP$LOG
*copyc AMT$FAP_DECLARATIONS
?? POP ??

  CONST
    ic_file = 'nos_tape_ic_file               ',
    lfn170 = 'nos_xfer                       ',
    ai_ident_170 = 0,
    ai_begin_write = 1,
    ai_begin_read = 2,
    ai_data = 3,
    ai_eop = 4,
    ai_rewind = 5,
    ai_skipf = 6,
    ai_end_of_file = 7,
    ai_end_of_op = 8,
    wait_time = 1000,
    max_words = (mlc$max_message_length DIV (512 * 8)) * 512,
    max_bytes = max_words * 8;

  VAR
    mlibuf: array [1 .. max_bytes] of cell,
    curpos: integer := 1,
    an170,
    an180: mlt$application_name,
    operation: integer := 0,
    total_bytes,
    total_blocks: integer := 0,
    curdata: integer := 0,
    last_ai: mlt$arbitrary_info := ai_data,
    open: boolean := FALSE,
    type_of_partition: integer,
    ic_fid: amt$file_identifier;


  PROCEDURE init_xfer (op_type: mlt$arbitrary_info;
    VAR status: ost$status);

    VAR
      tc: amt$transfer_count,
      ba: amt$file_byte_address,
      id180: array [1 .. 2] of integer,
      fp: amt$file_position;

    status.normal := TRUE;
    IF open THEN
      RETURN;
    IFEND;
    fsp$open_file (ic_file, amc$record, NIL, NIL, NIL, NIL, NIL, ic_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    amp$get_next (ic_fid, #LOC (an170), #SIZE (an170), tc, ba, fp, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    REPEAT
      mlp$sign_on (mlc$unique_name, 0, an180, status);
      IF NOT status.normal THEN
        CASE status.condition OF
        = mlc$ant_full, mlc$busy_interlock, mlc$pool_buffer_not_avail =
          pmp$long_term_wait (wait_time, wait_time);
        ELSE
          RETURN;
        CASEND;
      IFEND;
    UNTIL status.normal;

    REPEAT
      mlp$add_sender (an180, an170, status);
      IF NOT status.normal THEN
        CASE status.condition OF
        = mlc$busy_interlock =
          pmp$long_term_wait (wait_time, wait_time);
        ELSE
          RETURN;
        CASEND;
      IFEND;
    UNTIL status.normal;

    id180 [1] := an180;
    id180 [2] := op_type;
    amp$put_next (ic_fid, #LOC (id180), #SIZE (id180), ba, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    operation := op_type;
    open := TRUE;

  PROCEND init_xfer;
?? EJECT ??

  PROCEDURE terminate_xfer (VAR status: ost$status);

    VAR
      ai: mlt$arbitrary_info,
      ml: mlt$message_length,
      str: string (40),
      iii: integer,
      sn: mlt$application_name;

    IF operation = ai_begin_write THEN
      flush (ai_end_of_op, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    /wait_end/
      BEGIN
        REPEAT
          mlp$receive_message (an180, ai, NIL, #LOC (mlibuf), ml, 1, 0, sn,
                status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock, mlc$receive_list_index_invalid =
              pmp$long_term_wait (wait_time, wait_time);
            ELSE
              EXIT /wait_end/;
            CASEND;
          IFEND;
        UNTIL status.normal;
      END /wait_end/;
    IFEND;

    REPEAT
      mlp$sign_off (an180, status);
      IF NOT status.normal THEN
        CASE status.condition OF
        = mlc$busy_interlock =
          pmp$long_term_wait (wait_time, wait_time);
        ELSE
          RETURN;
        CASEND;
      IFEND;
    UNTIL status.normal;

    fsp$close_file (ic_fid, status);
    str := '    ';
    STRINGREP (str, iii, ' BLOCKS/BYTES: ', total_blocks, total_bytes);
    pmp$log (str, status);
    total_blocks := 0;
    total_bytes := 0;
    status.normal := TRUE;
    open := FALSE;
  PROCEND terminate_xfer;
?? EJECT ??

  PROCEDURE flush (ai: mlt$arbitrary_info;
    VAR status: ost$status);

    VAR
{!      iii: integer,
{!      str: string (30),
      ps: ^cell,
{     ci: syt$conversion_info,
      xb: array [1 .. max_words] of integer,
      sl: integer;

{!    str := '   ';
{!    STRINGREP (str, iii, ' flush ', curpos - 1);
{!    pmp$log (str, status);
    REPEAT
      mlp$send_message (an180, ai, NIL, #LOC (mlibuf), curpos - 1, an170,
            status);
      IF NOT status.normal THEN
        CASE status.condition OF
        = mlc$busy_interlock, mlc$prior_msg_not_received,
              mlc$receive_list_full, mlc$pool_buffer_not_avail,
                mlc$sender_not_permitted =
          pmp$long_term_wait (wait_time, wait_time);
        ELSE
          RETURN;
        CASEND;
      IFEND;
    UNTIL status.normal;
    total_bytes := total_bytes + curpos - 1;
    total_blocks := total_blocks + 1;
    curpos := 1;
  PROCEND flush;
?? EJECT ??

  PROCEDURE send_to_170 (data: ^cell;
        len: integer;
    VAR status: ost$status);

    VAR
      xl,
      llen: integer,
      ps: ^cell,
{     ci: syt$conversion_info,
      xb: array [1 .. max_words] of integer,
      sl: integer,
{!      str: string (30),
{!      iii: integer,
      pac: ^array [1 .. 07ffffff(16)] of cell,
      clp: integer,
      done: boolean;

    llen := len;
    done := FALSE;
    pac := data;
    clp := 1;
{!    str := '   ';
{!    STRINGREP (str, iii, ' put ', len);
{!    pmp$log (str, status);
    REPEAT
      IF (curpos + llen) > max_bytes THEN
        xl := max_bytes - (curpos - 1);
        i#move (#LOC (pac^ [clp]), #LOC (mlibuf [curpos]), xl);
{!        str := '   ';
{!        STRINGREP (str, iii, ' send 170 ', sl);
{!        pmp$log (str, status);
        REPEAT
          mlp$send_message (an180, ai_data, NIL, #LOC (mlibuf), max_bytes,
                an170, status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock, mlc$prior_msg_not_received,
                  mlc$receive_list_full, mlc$pool_buffer_not_avail,
                    mlc$sender_not_permitted =
              pmp$long_term_wait (wait_time, wait_time);
            ELSE
              RETURN;
            CASEND;
          IFEND;
        UNTIL status.normal;
        total_bytes := total_bytes + max_bytes;
        total_blocks := total_blocks + 1;
        curpos := 1;
        llen := llen - xl;
        clp := clp + xl;
      ELSE
        i#move (#LOC (pac^ [clp]), #LOC (mlibuf [curpos]), llen);
        curpos := curpos + llen;
        done := TRUE;
      IFEND;
    UNTIL done;
  PROCEND send_to_170;
?? EJECT ??

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

    VAR
      iii: integer,
      str: string (30);

    CASE call_block.operation OF
    = amc$open_req =
      IF call_block.open.access_level <> amc$record THEN
        osp$set_status_abnormal ('XX', 99, 'must be record access', status);
        RETURN;
      IFEND;
      amp$access_method (file_id, call_block, layer_number, status);
      IF status.normal THEN
        init_xfer (ai_begin_write, status);
      IFEND;
    = amc$put_next_req =
      send_to_170 (call_block.putn.working_storage_area, call_block.putn.
            working_storage_length, status);
    = amc$put_partial_req =
      send_to_170 (call_block.putp.working_storage_area, call_block.putp.
            working_storage_length, status);
    = amc$fetch_access_information_rq, amc$fetch_req, amc$store_req =
      amp$access_method (file_id, call_block, layer_number, status);
    = amc$rewind_req =
    = amc$write_end_partition_req =
      flush (ai_eop, status);
    = amc$close_req =
      terminate_xfer (status);
      amp$access_method (file_id, call_block, layer_number, status);
    = amc$write_tape_mark_req =
      flush (ai_end_of_file, status);
    ELSE
      str := '   ';
      STRINGREP (str, iii, ' amp$? ', call_block.operation);
      osp$set_status_abnormal ('XX', 98, str, status);
    CASEND;
  PROCEND rap$nos_file_write;
?? EJECT ??

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

    VAR
      iii: integer,
      str: string (30);

    CASE call_block.operation OF
    = amc$open_req =
      IF call_block.open.access_level <> amc$record THEN
        osp$set_status_abnormal ('XX', 99, 'must be record access', status);
        RETURN;
      IFEND;
      amp$access_method (file_id, call_block, layer_number, status);
      IF status.normal THEN
        init_xfer (ai_begin_read, status);
      IFEND;
    = amc$get_next_req =
      receive_from_170 (call_block.getn.working_storage_area, call_block.getn.
            working_storage_length, call_block.getn.transfer_count, call_block.
            getn.file_position, status);
    = amc$get_partial_req =
      receive_from_170 (call_block.getp.working_storage_area, call_block.getp.
            working_storage_length, call_block.getp.transfer_count, call_block.
            getp.file_position, status);
    = amc$fetch_access_information_rq, amc$fetch_req, amc$store_req =
      amp$access_method (file_id, call_block, layer_number, status);
    = amc$rewind_req =
    = amc$skip_req =
      IF call_block.skp.direction <> amc$forward THEN
        osp$set_status_abnormal ('XX', 96, 'skip not forward', status);
        RETURN;
      IFEND;
      IF call_block.skp.unit <> amc$skip_partition THEN
        osp$set_status_abnormal ('XX', 95, 'skip not partition', status);
        RETURN;
      IFEND;
{!      str := '  ';
{!      STRINGREP (str, iii, ' skip count', call_block.skp.count);
{!      pmp$log (str, status);
      skip (status);
      IF last_ai <> ai_end_of_op THEN
        call_block.skp.file_position^ := amc$bop;
      ELSE
        call_block.skp.file_position^ := amc$eoi;
      IFEND;
    = amc$close_req =
      terminate_xfer (status);
      amp$access_method (file_id, call_block, layer_number, status);
    ELSE
      str := '   ';
      STRINGREP (str, iii, ' amp$? ', call_block.operation);
      osp$set_status_abnormal ('XX', 98, str, status);
    CASEND;
  PROCEND rap$nos_file_read;
?? EJECT ??

  PROCEDURE receive_from_170 (wsa: ^cell;
        wsl: integer;
        tc: ^amt$transfer_count;
        fp: ^amt$file_position;
    VAR status: ost$status);

    VAR
      psa,
      ps: ^cell,
{     ci: syt$conversion_info,
      xb: array [1 .. max_words] of integer,
      sl: integer,
      xl,
      llen: integer,
      sn: mlt$application_name,
      ml: mlt$message_length,
      pac: ^array [1 .. 07ffffff(16)] of cell,
{!      str: string (40),
{!      iii: integer,
      clp: integer;

    status.normal := TRUE;
    clp := 1;
    pac := wsa;
    llen := wsl;

  /get_next/
    BEGIN
      REPEAT

        IF curpos > curdata THEN
          IF last_ai <> ai_data THEN
            EXIT /get_next/;
          IFEND;

{ get more data from 170

          REPEAT
            mlp$receive_message (an180, last_ai, NIL, #LOC (mlibuf), ml, #SIZE
                  (mlibuf), 0, sn, status);
            IF NOT status.normal THEN
              CASE status.condition OF
              = mlc$busy_interlock, mlc$receive_list_index_invalid =
                pmp$long_term_wait (wait_time, wait_time);
              ELSE
                RETURN;
              CASEND;
            IFEND;
          UNTIL status.normal;

          curdata := ml;
          curpos := 1;
          total_bytes := total_bytes + curdata;
          total_blocks := total_blocks + 1;
{!          str := '  ';
{!          STRINGREP (str, iii, ' curdata= ', curdata);
{!          pmp$log (str, status);
{!          str := '   ';
{!          STRINGREP (str, iii, ' get 170 ', ml, curdata);
{!          pmp$log (str, status);
        IFEND;

        IF (curdata - (curpos - 1)) < llen THEN
          xl := curdata - (curpos - 1);
        ELSE
          xl := llen;
        IFEND;

        i#move (#LOC (mlibuf [curpos]), #LOC (pac^ [clp]), xl);
        clp := clp + xl;
        llen := llen - xl;
        curpos := curpos + xl;
      UNTIL llen = 0;
    END /get_next/;

    IF curpos > curdata THEN
      CASE last_ai OF
      = ai_eop =
{!        str := '   ';
{!        STRINGREP (str, iii, ' get eop ', clp - 1);
{!        pmp$log (str, status);
        type_of_partition := ai_eop;
        IF fp <> NIL THEN
          IF llen > 0 THEN
            fp^ := amc$eop;
          ELSE
            fp^ := amc$eor;
          IFEND;
        IFEND;
        IF llen > 0 THEN
          last_ai := ai_data;
        IFEND;
      = ai_end_of_file =
{!        str := '   ';
{!        STRINGREP (str, iii, ' get eof ', clp - 1);
{!        pmp$log (str, status);
        type_of_partition := ai_end_of_file;
        IF fp <> NIL THEN
          IF llen > 0 THEN
            fp^ := amc$eop;
          ELSE
            fp^ := amc$eor;
          IFEND;
        IFEND;
        IF llen > 0 THEN
          last_ai := ai_data;
        IFEND;
      = ai_end_of_op =
{!        str := '   ';
{!        STRINGREP (str, iii, ' get eoi ', clp - 1);
{!        pmp$log (str, status);
        type_of_partition := ai_end_of_op;
        IF fp <> NIL THEN
          fp^ := amc$eoi;
        IFEND;
      = ai_data =
{!        str := '   ';
{!        STRINGREP (str, iii, ' get data ', clp - 1, wsl);
{!        pmp$log (str, status);
        IF fp <> NIL THEN
          fp^ := amc$eor;
        IFEND;
      ELSE
        osp$set_status_abnormal ('XX', 96, 'last ai on get confused', status);
        RETURN;
      CASEND;
    ELSE
{!      str := '   ';
{!      STRINGREP (str, iii, ' get data ', clp - 1, wsl);
{!      pmp$log (str, status);
      IF fp <> NIL THEN
        fp^ := amc$eor;
      IFEND;
    IFEND;
    IF tc <> NIL THEN
      tc^ := clp - 1;
    IFEND;
  PROCEND receive_from_170;
?? EJECT ??

  PROCEDURE skip (VAR status: ost$status);

    VAR
      xb: array [1 .. max_words] of integer,
      sn: mlt$application_name,
      ml: mlt$message_length;

    status.normal := TRUE;
    IF last_ai = ai_eop THEN
      last_ai := ai_data;
      curdata := 0;
      curpos := 1;
      RETURN;
    IFEND;

    REPEAT
      REPEAT
        mlp$receive_message (an180, last_ai, NIL, #LOC (xb), ml, #SIZE (xb), 0,
              sn, status);
        IF NOT status.normal THEN
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            pmp$long_term_wait (wait_time, wait_time);
          ELSE
            RETURN;
          CASEND;
        IFEND;
      UNTIL status.normal;
    UNTIL last_ai <> ai_data;

    IF last_ai <> ai_end_of_op THEN
      last_ai := ai_data;
    IFEND;
    curdata := 0;
    curpos := 1;
  PROCEND skip;
?? EJECT ??

  PROCEDURE [XDCL, #GATE] rap$getmrf (plist: clt$parameter_list;
    VAR status: ost$status);

{    PROCEDURE (osm$mrf) mrf (
{        file: file = $required
{        status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 4, 22, 15, 17, 0, 500],
    clc$command, 2, 2, 1, 0, 0, 0, 2, 'OSM$MRF'], [
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$file = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;
?? EJECT ??

    VAR
      oa: array [1 .. 2] of fst$attachment_option,
      ia: array [1 .. 1] of fst$attachment_option,
      fid170,
      fid180: amt$file_identifier,
      tc: amt$transfer_count,
      ba: amt$file_byte_address,
      fp: amt$file_position,
      buffer: array [1 .. max_bytes] of cell;

    clp$evaluate_parameters (plist, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    oa [1].selector := fsc$open_position;
    oa [1].open_position := amc$open_at_boi;
    oa [2].selector := fsc$access_and_share_modes;
    oa [2].share_modes.selector := fsc$specific_share_modes;
    oa [2].share_modes.value := $fst$file_access_options[];
    oa [2].access_modes.selector := fsc$specific_access_modes;
    oa [2].access_modes.value := $fst$file_access_options[fsc$shorten, fsc$append,
          fsc$modify, fsc$read];
    ia [1].selector := fsc$access_and_share_modes;
    ia [1].share_modes.selector := fsc$specific_share_modes;
    ia [1].share_modes.value := $fst$file_access_options[fsc$read, fsc$shorten,
          fsc$append, fsc$modify, fsc$execute];
    ia [1].access_modes.selector := fsc$specific_access_modes;
    ia [1].access_modes.value := $fst$file_access_options[fsc$read];

    fsp$open_file (pvt [p$file].value^.file_value^, amc$record, ^oa, NIL,
        NIL, NIL, NIL, fid180, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    fsp$open_file (lfn170, amc$record, NIL, NIL, NIL, NIL, NIL, fid170, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    REPEAT
      amp$get_next (fid170, #LOC (buffer), #SIZE (buffer), tc, ba, fp, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      amp$put_next (fid180, #LOC (buffer), tc, ba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE fp OF
      = amc$eor =
      = amc$mid_record =
        osp$set_status_abnormal ('XX', 99, 'mid record file position', status);
        RETURN;
      = amc$eop, amc$eoi =
        amp$write_end_partition (fid180, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        amp$put_next (fid180, #LOC (type_of_partition), #SIZE
              (type_of_partition), ba, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      CASEND;
    UNTIL fp = amc$eoi;

    fsp$close_file (fid170, status);
    fsp$close_file (fid180, status);
  PROCEND rap$getmrf;
?? EJECT ??

  PROCEDURE [XDCL, #GATE] rap$repmrf (plist: clt$parameter_list;
    VAR status: ost$status);

{    PROCEDURE (osm$mrf) mrf (
{        file: file = $required
{        status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 4, 22, 15, 17, 0, 500],
    clc$command, 2, 2, 1, 0, 0, 0, 2, 'OSM$MRF'], [
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$file = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;
?? EJECT ??

    VAR
      oa: array [1 .. 2] of fst$attachment_option,
      ia: array [1 .. 1] of fst$attachment_option,
      fid170,
      fid180: amt$file_identifier,
      tc: amt$transfer_count,
      ba: amt$file_byte_address,
      fp: amt$file_position,
      buffer: array [1 .. max_bytes] of cell;

    clp$evaluate_parameters (plist, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    oa [1].selector := fsc$open_position;
    oa [1].open_position := amc$open_at_boi;
    oa [2].selector := fsc$access_and_share_modes;
    oa [2].share_modes.selector := fsc$specific_share_modes;
    oa [2].share_modes.value := $fst$file_access_options[];
    oa [2].access_modes.selector := fsc$specific_access_modes;
    oa [2].access_modes.value := $fst$file_access_options[fsc$shorten, fsc$append,
          fsc$modify, fsc$read];
    ia [1].selector := fsc$access_and_share_modes;
    ia [1].share_modes.selector := fsc$specific_share_modes;
    ia [1].share_modes.value := $fst$file_access_options[fsc$read, fsc$shorten,
          fsc$append, fsc$modify, fsc$execute];
    ia [1].access_modes.selector := fsc$specific_access_modes;
    ia [1].access_modes.value := $fst$file_access_options[fsc$read];
    fsp$open_file (pvt [p$file].value^.file_value^, amc$record, ^ia, NIL,
        NIL, NIL, NIL, fid180, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    fsp$open_file (lfn170, amc$record, ^oa, NIL, NIL, NIL, NIL, fid170, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    REPEAT
      amp$get_next (fid180, #LOC (buffer), #SIZE (buffer), tc, ba, fp, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      amp$put_next (fid170, #LOC (buffer), tc, ba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE fp OF
      = amc$eor, amc$eoi =
      = amc$mid_record =
        osp$set_status_abnormal ('XX', 99, 'mid record file position', status);
        RETURN;
      = amc$eop =
        type_of_partition := 999;
        amp$get_next (fid180, #LOC (type_of_partition), #SIZE
              (type_of_partition), tc, ba, fp, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        CASE type_of_partition OF
        = ai_eop =
          amp$write_end_partition (fid170, status);
        = ai_end_of_file =
          amp$write_tape_mark (fid170, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = ai_end_of_op =
          IF curpos > 1 THEN
            amp$write_end_partition (fid170, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal ('XX', 109, 'unknown partition', status);
          RETURN;
        CASEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      CASEND;
    UNTIL fp = amc$eoi;

    fsp$close_file (fid170, status);
    fsp$close_file (fid180, status);
  PROCEND rap$repmrf;
MODEND ram$nos_file_transfer;
