*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := 'NOS/VE  Remote Host :' ??
MODULE rhm$permanent_file_get_replace;

?? NEWTITLE := '        Global Declarations' ??
*copy syt$data_conversions

  TYPE
    pf_op_types = (pf_get, pf_rep);

  CONST
    first_binary_conversion = syc$56_bit_binary_to_64_bit;

?? SET (LIST := ON) ??
?? EJECT ??
*copyc OSC$PROCESSOR_DEFINED_REGISTERS
*copyc oss$job_paged_literal
*copyc RHC$CONSTANTS
*copyc RHD$CONDITION_CODES
*copyc rht$attachment_option
*copyc rht$file_cycle_attribute

?? TITLE := '        External Procedures Referenced By This Module' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc AMP$RETURN
*copyc AMP$GET_FILE_ATTRIBUTES
*copyc AMP$REWIND
*copyc FSP$CLOSE_FILE
*copyc FSP$COPY_FILE
*copyc FSP$OPEN_FILE
*copyc RMP$GET_DEVICE_CLASS
*copyc osp$append_status_file
*copyc OSP$SET_STATUS_ABNORMAL
*copyc PMP$ESTABLISH_CONDITION_HANDLER
*copyc pmp$get_unique_name
*copyc PMP$CONTINUE_TO_CAUSE
*copyc RHP$CLOSE_B56_FILE
*copyc RHH$MLI_GET_PERMANENT_FILE
*copyc RHP$MLI_GET_PERMANENT_FILE
*copyc RHH$MLI_REPLACE_PERMANENT_FILE
*copyc RHP$MLI_REPLACE_PERMANENT_FILE
*copyc RHP$OPEN_B56_FILE

?? TITLE := '        Convert_ascii88_to_ascii812' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ CONVERT_ASCII88_TO_ASCII812
{
{       The purpose of this procedure is to convert an 8/8 ascii string to
{ an A170 8/12 ascii string.
{
{       CONVERT_ASCII88_TO_ASCII812 (ASCII88_STRING,ASCII812_STRING
{,CONVERSION_STATUS)
{
{ ASCII88_STRING: (input) This parameter contains the 8/8 ascii string which
{                 is to be converted.
{
{ ASCII812_STRING: (output) This parameter contains the 8/12 ascii string which
{                  is the result of the conversion.
{
{ CONVERSION_STATUS: (output) This parameter indicates the success or failure
{ of
{                    the conversion.  If the output string is not large enough
{                    to complete the conversion of the entire input string then
{                    a status of non_fatal_error will be returned otherwise the
{                    conversion will be successful.  In either case, conversion
{                    of as much of the string as is possible will be performed.
{

  PROCEDURE convert_ascii88_to_ascii812
    (    ascii88_string: string ( * );
     VAR ascii812_string: array [ * ] of rht$c180_ascii812_word;
     VAR conversion_status: rht$status);

    VAR
      ascii88_string_length: 0 .. 256,
      ascii812_string_lbound: integer,
      ascii812_string_ubound: integer,
      words_required: 0 .. 55,
      last_word#: integer,
      chars_in_last_word: 1 .. 5,
      word#: integer,
      ascii88_char#: 0 .. 256,
      ascii812_char#: 2 .. 5;

    ascii88_string_length := STRLENGTH (ascii88_string);
    ascii812_string_lbound := LOWERBOUND (ascii812_string);
    ascii812_string_ubound := UPPERBOUND (ascii812_string);
    words_required := (ascii88_string_length + 4) DIV 5;
    IF (ascii812_string_ubound - ascii812_string_lbound + 1) <
          words_required THEN
      last_word# := ascii812_string_ubound;
      chars_in_last_word := 5;
      conversion_status := non_fatal_error;
    ELSE
      last_word# := ascii812_string_lbound + words_required - 1;
      chars_in_last_word := ascii88_string_length - (words_required - 1) * 5;
      conversion_status := successful;
    IFEND;
    ascii88_char# := 0;
    FOR word# := ascii812_string_lbound TO last_word# - 1 DO
      ascii88_char# := ascii88_char# + 1;
      ascii812_string [word#].ascii812_char1.filler := 0;
      ascii812_string [word#].ascii812_char1.ascii88_char :=
            ascii88_string (ascii88_char#);
      FOR ascii812_char# := 2 TO 5 DO
        ascii88_char# := ascii88_char# + 1;
        ascii812_string [word#].ascii812_char2_5 [ascii812_char#].filler := 0;
        ascii812_string [word#].ascii812_char2_5 [ascii812_char#].
              ascii88_char := ascii88_string (ascii88_char#);
      FOREND;
    FOREND;
    ascii88_char# := ascii88_char# + 1;
    ascii812_string [last_word#].ascii812_char1.filler := 0;
    ascii812_string [last_word#].ascii812_char1.ascii88_char :=
          ascii88_string (ascii88_char#);
    FOR ascii812_char# := 2 TO chars_in_last_word DO
      ascii88_char# := ascii88_char# + 1;
      ascii812_string [last_word#].ascii812_char2_5 [ascii812_char#].filler :=
            0;
      ascii812_string [last_word#].ascii812_char2_5 [ascii812_char#].
            ascii88_char := ascii88_string (ascii88_char#);
    FOREND;

  PROCEND convert_ascii88_to_ascii812;

?? TITLE := '        [XDCL] rhp$get' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc rhh$get_file

  PROCEDURE [XDCL] rhp$get ALIAS 'rhxget'
    (    file: fst$file_reference;
         pf_name: string (31);
         conversion: syt$data_conversions;
         user_or_id: string (9);
         file_cycle: string (3);
         file_password: array [1 .. 2] of string (9);
     VAR status: ost$status);

?? SET (LIST := ON) ??
?? EJECT ??

    PROCEDURE getf_handle_break
      (    cond: pmt$condition;
           cd: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR ch_status: ost$status);

      VAR
        ost: ost$status;


      ch_status.normal := TRUE;

      IF break_active THEN
        RETURN;
      IFEND;
      break_active := TRUE;

{ Close data file.

      IF file_open THEN
        IF conversion = syc$64_bit_binary_to_56_bit THEN

{ We must close a B56 file in ring 3 in order to override the file attributes.

          rhp$close_b56_file (local_file_info, ost);
        ELSE
          fsp$close_file (local_file_info.file_identifier, ost);
        IFEND;
      IFEND;
      IF copy_required THEN
        amp$return (scratch_fn, ost);
      IFEND;

{ Exit the PF operation with abnormal status

      CASE cond.interactive_condition OF
      = ifc$pause_break =
        osp$set_status_abnormal (rhc$remote_host_id,
            rhe$pause_break_received, '', status);
      = ifc$terminate_break =
        osp$set_status_abnormal (rhc$remote_host_id,
            rhe$terminal_break_occurred, '', status);
      ELSE
        osp$set_status_abnormal (rhc$remote_host_id,
            rhe$terminal_connection_broken, '', status);
      CASEND;
      EXIT rhp$get;

    PROCEND getf_handle_break;

?? EJECT ??

    VAR
      wait: ost$wait,
      permanent_file_name: array [1 .. 7] of rht$c180_ascii812_word,
      user_id: array [1 .. 2] of rht$c180_ascii812_word,
      cycle_number: array [1 .. 1] of rht$c180_ascii812_word,
      file_passwords: array [1 .. 2] of array [1 .. 2] of
            rht$c180_ascii812_word,
      conversion_status: rht$status,
      local_file_info: rht$local_file_info,
      conversion_file_name: amt$local_file_name,
      conversion_file_identifier: amt$file_identifier,
      close_status: ost$status,
      cond_desc: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [ifc$interactive_condition]],
      estab_handler: pmt$established_handler,
      local_status: ost$status,
      conversion_file_open,
      file_open,
      break_active: boolean,
      open_attributes: rht$file_cycle_attribute,
      output_file_attachment_options: rht$attachment_option,
      scratch_fn: amt$local_file_name,
      file_found: boolean,
      copy_required: boolean;

{ Initialize.

    conversion_file_open := FALSE;
    file_open := FALSE;
    file_found := TRUE;
    break_active := FALSE;
    copy_required := FALSE;
    pmp$establish_condition_handler (cond_desc, ^getf_handle_break,
          ^estab_handler, local_status);

{ Set up information needed to get the permanent file.

    convert_ascii88_to_ascii812 (pf_name (1, 31), permanent_file_name,
          conversion_status);
    convert_ascii88_to_ascii812 (user_or_id (1, 9),
          user_id, conversion_status);
    convert_ascii88_to_ascii812 (file_cycle (1, 3), cycle_number,
          conversion_status);
    convert_ascii88_to_ascii812 (file_password [1] (1, 9), file_passwords [1],
          conversion_status);
    convert_ascii88_to_ascii812 (file_password [2] (1, 9), file_passwords [2],
          conversion_status);

  /getf/
    BEGIN

{ Open local file.

      prepare_file_attributes (file, conversion, pf_get, open_attributes,
            copy_required, status);
      IF NOT status.normal THEN
        EXIT /getf/;
      IFEND;

{ Define the output file attachment options.

      output_file_attachment_options [1].selector :=
            fsc$access_and_share_modes;
      output_file_attachment_options [1].access_modes.selector :=
            fsc$specific_access_modes;
      output_file_attachment_options [1].access_modes.value :=
            $fst$file_access_options [fsc$append, fsc$shorten];
      output_file_attachment_options [1].share_modes.selector :=
            fsc$specific_share_modes;
      output_file_attachment_options [1].share_modes.value :=
            $fst$file_access_options [];
      output_file_attachment_options [2].selector :=
            fsc$access_and_share_modes;
      output_file_attachment_options [2].access_modes.selector :=
            fsc$specific_access_modes;
      output_file_attachment_options [2].access_modes.value :=
            $fst$file_access_options [fsc$append];
      output_file_attachment_options [2].share_modes.selector :=
            fsc$specific_share_modes;
      output_file_attachment_options [2].share_modes.value :=
            $fst$file_access_options [];
      output_file_attachment_options [3].selector := fsc$open_share_modes;
      output_file_attachment_options [3].open_share_modes :=
            $fst$file_access_options [];
      output_file_attachment_options [4].selector := fsc$sequential_access;
      output_file_attachment_options [4].sequential_access := TRUE;
      output_file_attachment_options [5].selector := fsc$delete_data;
      output_file_attachment_options [5].delete_data := TRUE;
      IF copy_required THEN
        pmp$get_unique_name (scratch_fn, local_status);
        fsp$open_file (scratch_fn, amc$record, ^output_file_attachment_options,
              NIL, ^open_attributes, ^open_attributes, NIL,
              local_file_info.file_identifier, status);
        IF NOT status.normal THEN
          EXIT /getf/;
        IFEND;
      ELSE
        IF (conversion = syc$56_bit_binary_to_64_bit) THEN

{ We must open the B56 file in ring 3 to override the attributes.

          rhp$open_b56_file (file, output_file_attachment_options,
                local_file_info, status);
        ELSE
          fsp$open_file (file, amc$record, ^output_file_attachment_options,
                NIL, ^open_attributes, ^open_attributes, NIL,
                local_file_info.file_identifier, status);
        IFEND;
        IF NOT status.normal THEN
          EXIT /getf/;
        IFEND;
      IFEND;
      file_open := status.normal;

{ Have the 170 permanent file converted while copying to a local file.

      rhp$mli_get_permanent_file (permanent_file_name, user_id, cycle_number,
            file_passwords, local_file_info, conversion, status);
      IF NOT status.normal THEN
        file_found := FALSE;
        EXIT /getf/;
      IFEND;
      IF copy_required THEN
        fsp$close_file (local_file_info.file_identifier, status);
        IF NOT status.normal THEN
          EXIT /getf/;
        IFEND;
        fsp$copy_file (scratch_fn, file, NIL, NIL, NIL, status);
        IF NOT status.normal THEN
          EXIT /getf/;
        IFEND;
      IFEND;

    END /getf/;

    amp$rewind (local_file_info.file_identifier, wait, local_status);
    IF conversion = syc$64_bit_binary_to_56_bit THEN

{ We must close a B56 file in ring 3 in order to override the file attributes.

      rhp$close_b56_file (local_file_info, local_status);
    ELSE
      fsp$close_file (local_file_info.file_identifier, local_status);
    IFEND;
    IF copy_required THEN
      amp$return (scratch_fn, local_status);
    IFEND;
    IF NOT file_found THEN
      amp$return (file, local_status);
    IFEND;
    file_open := FALSE;

  PROCEND rhp$get;

?? TITLE := '        [XDCL] rhp$replace' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc RHH$REPLACE

  PROCEDURE [XDCL] rhp$replace ALIAS 'rhxrep'
    (    file: fst$file_reference;
         pf_name: string (31);
         conversion: syt$data_conversions;
         user_or_id: string (9);
         file_cycle: string (3);
         file_password: array [1 .. 2] of string (9);
     VAR status: ost$status);

?? SET (LIST := ON) ??
?? EJECT ??

    PROCEDURE repf_handle_break
      (    cond: pmt$condition;
           cd: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR ch_status: ost$status);

      VAR
        ost: ost$status;

      ch_status.normal := TRUE;

      IF break_active THEN
        RETURN;
      IFEND;
      break_active := TRUE;

{ Close data file.

      IF file_open THEN
        IF conversion = syc$64_bit_binary_to_56_bit THEN

{ We must close a B56 file in ring 3 in order to override the file attributes.

          rhp$close_b56_file (local_file_info, ost);
        ELSE
          fsp$close_file (local_file_info.file_identifier, ost);
        IFEND;
      IFEND;
      IF copy_required THEN
        amp$return (scratch_fn, ost);
      IFEND;

{ Exit the PF operation with abnormal status

      CASE cond.interactive_condition OF
      = ifc$pause_break =
        osp$set_status_abnormal (rhc$remote_host_id,
            rhe$pause_break_received, '', status);
      = ifc$terminate_break =
        osp$set_status_abnormal (rhc$remote_host_id,
            rhe$terminal_break_occurred, '', status);
      ELSE
        osp$set_status_abnormal (rhc$remote_host_id,
            rhe$terminal_connection_broken, '', status);
      CASEND;
      EXIT rhp$replace;

    PROCEND repf_handle_break;

?? EJECT ??

    VAR
      local_file_info: rht$local_file_info,
      permanent_file_name: array [1 .. 7] of rht$c180_ascii812_word,
      user_id: array [1 .. 2] of rht$c180_ascii812_word,
      cycle_number: array [1 .. 1] of rht$c180_ascii812_word,
      file_passwords: array [1 .. 2] of array [1 .. 2] of
            rht$c180_ascii812_word,
      cond_desc: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [ifc$interactive_condition]],
      estab_handler: pmt$established_handler,
      local_status: ost$status,
      file_open,
      break_active: boolean,
      open_attributes: rht$file_cycle_attribute,
      input_file_attachment_options: rht$attachment_option,
      scratch_fn: amt$local_file_name,
      copy_required: boolean,
      conversion_status: rht$status;


{ Initialize.

    file_open := FALSE;
    break_active := FALSE;
    copy_required := FALSE;
    pmp$establish_condition_handler (cond_desc, ^repf_handle_break,
          ^estab_handler, local_status);

{ Set up the information that identifies the permanent file that will be
{replaced.

    convert_ascii88_to_ascii812 (pf_name (1, 31), permanent_file_name,
          conversion_status);
    convert_ascii88_to_ascii812 (user_or_id (1, 9),
          user_id, conversion_status);
    convert_ascii88_to_ascii812 (file_cycle (1, 3), cycle_number,
          conversion_status);
    convert_ascii88_to_ascii812 (file_password [1] (1, 9), file_passwords [1],
          conversion_status);
    convert_ascii88_to_ascii812 (file_password [2] (1, 9), file_passwords [2],
          conversion_status);

{ Open the local file.

  /repf/
    BEGIN
      prepare_file_attributes (file, conversion, pf_rep, open_attributes,
            copy_required, status);
      IF NOT status.normal THEN
        EXIT /repf/;
      IFEND;

{ Set up the input file attachment options for a REPF.

      input_file_attachment_options [1].selector := fsc$access_and_share_modes;
      input_file_attachment_options [1].access_modes.selector :=
            fsc$specific_access_modes;
      input_file_attachment_options [1].access_modes.value :=
            $fst$file_access_options [fsc$read];
      input_file_attachment_options [1].share_modes.selector :=
            fsc$specific_share_modes;
      input_file_attachment_options [1].share_modes.value :=
            $fst$file_access_options [fsc$read, fsc$execute];
      input_file_attachment_options [2].selector := fsc$open_share_modes;
      input_file_attachment_options [2].open_share_modes :=
            $fst$file_access_options [fsc$read, fsc$execute];
      input_file_attachment_options [3].selector := fsc$create_file;
      input_file_attachment_options [3].create_file := FALSE;
      input_file_attachment_options [4].selector := fsc$sequential_access;
      input_file_attachment_options [4].sequential_access := TRUE;
      input_file_attachment_options [5].selector := fsc$delete_data;
      input_file_attachment_options [5].delete_data := TRUE;
      IF copy_required THEN
        pmp$get_unique_name (scratch_fn, local_status);
        fsp$copy_file (file, scratch_fn, NIL, ^open_attributes,
              ^open_attributes, status);
        IF NOT status.normal THEN
          EXIT /repf/;
        IFEND;
        fsp$open_file (scratch_fn, amc$record, ^input_file_attachment_options,
              NIL, ^open_attributes, ^open_attributes, NIL,
              local_file_info.file_identifier, status);
        IF NOT status.normal THEN
          EXIT /repf/;
        IFEND;
      ELSE
        IF conversion = syc$64_bit_binary_to_56_bit THEN

{ We must open a B56 file in ring 3 in order to override the file attributes.

          rhp$open_b56_file (file, input_file_attachment_options,
                local_file_info, status);
        ELSE
          fsp$open_file (file, amc$record, ^input_file_attachment_options, NIL,
                ^open_attributes, ^open_attributes, NIL,
                local_file_info.file_identifier, status);
        IFEND;
        IF NOT status.normal THEN
          EXIT /repf/;
        IFEND;
      IFEND;
      file_open := status.normal;

{ Have the permanent file replaced with the local file.

      rhp$mli_replace_permanent_file (permanent_file_name, user_id,
            cycle_number, file_passwords, local_file_info, conversion, status);
    END /repf/;

{ We must close a B56 file in ring 3 in order to override the file attributes.

    IF conversion = syc$64_bit_binary_to_56_bit THEN
      rhp$close_b56_file (local_file_info, local_status);
    ELSE
      fsp$close_file (local_file_info.file_identifier, local_status);
    IFEND;
    IF copy_required THEN
      amp$return (scratch_fn, local_status);
    IFEND;
    file_open := FALSE;

  PROCEND rhp$replace;

?? TITLE := '          prepare_file_attributes' ??
?? EJECT ??

  PROCEDURE prepare_file_attributes
    (    file: fst$file_reference;
         conversion: syt$data_conversions;
         op_type: pf_op_types;
     VAR open_attributes: rht$file_cycle_attribute;
     VAR copy_required: boolean;
     VAR status: ost$status);

    VAR
      lf,
      ef,
      cd: boolean,
      device_class: rmt$device_class,
      device_assigned: boolean,
      fattr: array [1 .. 4] of amt$get_item;

    status.normal := TRUE;
    copy_required := FALSE;

    open_attributes [1].selector := fsc$record_type;
    open_attributes [1].record_type := amc$variable;
    open_attributes [2].selector := fsc$file_organization;
    open_attributes [2].file_organization := amc$sequential;
    open_attributes [3].selector := fsc$block_type;
    open_attributes [3].block_type := amc$system_specified;

{ copy only ascii coded files

    IF conversion < first_binary_conversion THEN

    /cfc/
      BEGIN
        rmp$get_device_class (file, device_assigned, device_class, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        fattr [1].key := amc$block_type;
        fattr [2].key := amc$open_position;
        fattr [3].key := amc$file_organization;
        fattr [4].key := amc$record_type;
        amp$get_file_attributes (file, fattr, lf, ef, cd, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF fattr [2].open_position <> amc$open_at_boi THEN
          IF op_type = pf_get THEN
            copy_required := TRUE;
            EXIT /cfc/;
          ELSE

{ op_type = pf_rep, return bad status

            osp$set_status_abnormal (rhc$remote_host_id,
                  rhe$open_position_conflict, '', status);
            osp$append_status_file (osc$status_parameter_delimiter, file,
                  status);
            RETURN;
          IFEND;
        IFEND;
        IF device_class <> rmc$mass_storage_device THEN
          copy_required := TRUE;
          EXIT /cfc/;
        IFEND;
        IF fattr [1].block_type <> amc$system_specified THEN
          copy_required := TRUE;
          EXIT /cfc/;
        IFEND;
        IF (fattr [3].file_organization <> amc$sequential) AND
              (fattr [3].file_organization <> amc$byte_addressable) THEN
          copy_required := TRUE;
          EXIT /cfc/;
        IFEND;
        IF fattr [4].record_type <> amc$variable THEN
          copy_required := TRUE;
          EXIT /cfc/;
        IFEND;
      END /cfc/;
    ELSE
      open_attributes [1].record_type := amc$undefined;
    IFEND;

  PROCEND prepare_file_attributes;

MODEND rhm$permanent_file_get_replace;
