*copyc osd$default_pragmats
?? NEWTITLE := 'NOS/VE  Remote Host :' ??
MODULE rhm$permanent_file_memory_link ALIAS 'rhmpml';

?? NEWTITLE := '        Global Type Declarations' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc oss$job_paged_literal
*copyc osv$170_os_type
*copyc rhc$constants
*copyc rhd$nos_ve_types
*copyc rhd$condition_codes
*copyc rht$attachment_option
*copyc rht$file_cycle_attribute
*copyc osc$processor_defined_registers
*copyc ost$caller_identifier
*copyc syp$memory_link_data_conversion
*copyc amp$set_segment_eoi
*copyc amp$set_segment_position
*copyc amp$fetch_access_information
*copyc i#move

?? TITLE := '        External Procedures Referenced By This Module' ??
?? SET (LIST := ON) ??
?? EJECT ??

*copyc amp$get_segment_pointer
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#compare
*copyc jmp$get_job_attributes
*copyc pmp$long_term_wait
*copyc pmp$establish_condition_handler
*copyc pmp$continue_to_cause
*copyc rhp$get_link_user_descriptor
*copyc rhp$set_status_abnormal
*copyc mlp$sign_on
*copyc mlp$add_sender
*copyc mlp$send_message
*copyc mlp$receive_message
*copyc mlp$sign_off
*copyc mlp$delete_sender
*copyc mmp$set_access_selections
*copyc osp$set_status_abnormal
*copyc osv$task_private_heap
*copyc osp$set_status_from_condition

?? TITLE := '        Type Declarations and Variables Global Within This Module'
        ??
?? SET (LIST := ON) ??
?? EJECT ??

  TYPE
    rht$mem_link_status = set of mlt$status;

{
{  The following variable defines the value to be used as the signal parameter
{    on all (c180 remote host) mli send & receive requests.
{    (rhinput, rhoutq8, get, replace)
{

  VAR
    rhv$signal: [XDCL, STATIC, #GATE] mlt$signal := NIL,

{  The following variable is used to remember the unique application name
{    generated by mlp$sign_on for use in all other mli requests during
{    c180 remote host pf (get/replace) processing.  Note that this variable
{    must reside in task private.
{

    rhv$application_name: [STATIC] mlt$application_name := mlc$null_name,

{ Other varaibles global within this module.

    pj_identifier: integer,
    sign_on_status_ptr: ^ost$status := NIL,
    link_user_descriptor: rht$link_user_descriptor;

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

{
{ MEMORY_LINK_SIGN_ON
{
{      The purpose of this procedure is to sign on to the memory link.
{
{               MEMORY_LINK_SIGN_ON (STATUS)
{
{ STATUS: (output) This parameter returns the status of the sign_on.
{

  PROCEDURE memory_link_sign_on
    (VAR status: ost$status);


{ Sign on to the memory link.

    IF sign_on_status_ptr = NIL THEN
      ALLOCATE sign_on_status_ptr IN osv$task_private_heap^;
    IFEND;

    REPEAT
      mlp$sign_on (mlc$null_name, 0, rhv$application_name,
            sign_on_status_ptr^);
      IF NOT sign_on_status_ptr^.normal THEN
        CASE sign_on_status_ptr^.condition OF
        = mlc$ant_full, mlc$busy_interlock, mlc$pool_buffer_not_avail =
          pmp$long_term_wait (1000, 1000);
        ELSE
          status := sign_on_status_ptr^;
          rhp$set_status_abnormal (status);
          RETURN;
        CASEND;
      IFEND;
    UNTIL sign_on_status_ptr^.normal OR (sign_on_status_ptr^.condition =
          mlc$max_signons_this_appl);

  PROCEND memory_link_sign_on;

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

{
{ MEMORY_LINK_SIGN_OFF
{
{     The purpose of this procedure is to sign off the memory link.
{
{           MEMORY_LINK_SIGN_OFF (SIGN_OFF_STATUS)
{
{ SIGN_OFF_STATUS: (output) This parameter gives the status of the sign off.
{

  PROCEDURE memory_link_sign_off
    (VAR sign_off_status: ost$status);

    VAR
      off_status: ost$status,
      delete_sender_status: ost$status;

{ Sign off the memory link.

    REPEAT
      mlp$delete_sender (rhv$application_name, pj_identifier,
            delete_sender_status);
    UNTIL delete_sender_status.normal OR (delete_sender_status.condition <>
          mlc$busy_interlock);
    IF sign_on_status_ptr^.normal THEN
      REPEAT
        mlp$sign_off (rhv$application_name, off_status);
      UNTIL off_status.normal OR (off_status.condition <> mlc$busy_interlock);
    IFEND;

  PROCEND memory_link_sign_off;

?? 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 := '        Convert_Ascii812_to_Ascii88' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ CONVERT_ASCII812_TO_ASCII88
{
{       The purpose of this procedure is to convert an A170 8/12 ascii string
{ to an 8/8 ascii string.
{
{       CONVERT_ASCII812_TO_ASCII88 (ASCII812_STRING, ASCII88_STRING,
{              CONVERSION_STATUS)
{
{ ASCII812_STRING: (input) This parameter contains the 8/12 ascii string which
{                 is to be converted.
{
{ ASCII88_STRING: (output) This parameter contains the 8/8 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_ascii812_to_ascii88
    (    ascii812_string: array [ * ] of rht$c180_ascii812_word;
     VAR ascii88_string: string ( * );
     VAR conversion_status: rht$status);

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

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

  PROCEND convert_ascii812_to_ascii88;

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


{ SEND_PJ_FUNCTION_REQUEST
{
{        The purpose of this procedure is to transmit a partner job function
{ request to the partner job function processor and receive the results of
{ the processing of the requested function.
{
{        SEND_PJ_FUNCTION_REQUEST (PJ_FUNCTION,
{          PJ_IDENTIFIER,STATUS)
{
{ PJ_FUNCTION: (input) This parameter specifies the partner job function to
{              be performed.
{
{ PJ_IDENTIFIER: (input/output) This parameter is used to specify the partner
{                job identifier.  PJ_IDENTIFIER is returned (output) from a
{                submit_pj function.  PJ_IDENTIFIER must be supplied (input)
{                by the user for a status_pj pj_function.
{
{ STATUS: (output) This parameter indicates the status of sending the partner
{         job function request or the condition of the partner job.
{

  PROCEDURE send_pj_function_request
    (    pj_function: rht$pj_functions;
     VAR pj_identifier: integer;
     VAR status: ost$status);

    CONST
      submit_pj = rhc$submit_pj,
      status_pj = rhc$status_pj,
      zero_receive_index = 0, { index for receive any pending message }
      time_out_limit = 100;

    VAR
      local_status: ost$status,
      conversion_status: rht$status,
      partner_job_info: record
        case info_type: (identifier, validation) of
        = identifier =
          job_identifier: ALIGNED [0 MOD 8] integer,
        = validation =
          job_validation: record
            user_name: array [1 .. 2] of rht$c180_ascii812_word,
            password: array [1 .. 7] of rht$c180_ascii812_word,
            family_name: array [1 .. 2] of rht$c180_ascii812_word,
            charge_number: array [1 .. 7] of rht$c180_ascii812_word,
            project_number: array [1 .. 7] of rht$c180_ascii812_word,
            original_user_name: array [1 .. 2] of rht$c180_ascii812_word,
            original_family_name: array [1 .. 2] of rht$c180_ascii812_word,
            original_charge_number: array [1 .. 7] of rht$c180_ascii812_word,
            original_project_number: array [1 .. 7] of rht$c180_ascii812_word,
          recend,
        casend,
      recend,
      get_attribute_p: ^jmt$job_attribute_results,
      time_count: 0 .. (time_out_limit + 1),
      arbitrary_info: mlt$arbitrary_info,
      message_length: mlt$message_length,
      sender_application_name: mlt$application_name,
      destination_name: [STATIC, READ, oss$job_paged_literal] rht$mli_application_name :=
            [c180_id, [0, rhc$partner_job_processor, 0]],
      msg_status: ost$status,
      string_length: integer;


{ Add application name.

    REPEAT
      mlp$add_sender (rhv$application_name, destination_name.application_name,
            status);
      IF NOT status.normal THEN
        CASE status.condition OF
        = mlc$busy_interlock, mlc$dup_permits_ignored =
        ELSE
          osp$set_status_abnormal (rhc$remote_host_id,
                rhe$unable_to_communicate, '', status);
          RETURN;
        CASEND;
      IFEND;
    UNTIL status.normal OR (status.condition <> mlc$busy_interlock);


    CASE pj_function OF

{ Initialize parameters required to have a partner job execute
{ on the 170 side.

    = submit_pj =
      rhp$get_link_user_descriptor (link_user_descriptor, status);
      IF status.normal THEN
        convert_ascii88_to_ascii812 (link_user_descriptor.user (1, 9),
              partner_job_info.job_validation.user_name, conversion_status);
        convert_ascii88_to_ascii812 (link_user_descriptor.password (1, 31),
              partner_job_info.job_validation.password, conversion_status);
        convert_ascii88_to_ascii812 (link_user_descriptor.family (1, 9),
              partner_job_info.job_validation.family_name, conversion_status);
        convert_ascii88_to_ascii812 (link_user_descriptor.charge (1, 31),
              partner_job_info.job_validation.charge_number,
              conversion_status);
        convert_ascii88_to_ascii812 (link_user_descriptor.project (1, 31),
              partner_job_info.job_validation.project_number,
              conversion_status);
        PUSH get_attribute_p: [1 .. 4];
        get_attribute_p^ [1].key := jmc$login_family;
        get_attribute_p^ [2].key := jmc$login_user;
        get_attribute_p^ [3].key := jmc$login_account;
        get_attribute_p^ [4].key := jmc$login_project;
        jmp$get_job_attributes (get_attribute_p, status);

        IF NOT status.normal THEN
          RETURN;
        IFEND;

{ We also need to convert the original login USER, FAMILY, ACCOUNT, and
{ PROJECT.

        convert_ascii88_to_ascii812 (get_attribute_p^ [2].login_user (1, 9),
              partner_job_info.job_validation.original_user_name,
              conversion_status);
        convert_ascii88_to_ascii812 (get_attribute_p^ [1].login_family (1, 9),
              partner_job_info.job_validation.original_family_name,
              conversion_status);
        convert_ascii88_to_ascii812 (get_attribute_p^ [3].
              login_account (1, 31), partner_job_info.job_validation.
              original_charge_number, conversion_status);
        convert_ascii88_to_ascii812 (get_attribute_p^ [4].
              login_project (1, 31), partner_job_info.job_validation.
              original_project_number, conversion_status);
        message_length := #SIZE (partner_job_info.job_validation);
        arbitrary_info := submit_pj;
      ELSE
        RETURN;
      IFEND;

{ Initialize parameters required to get the status of
{ the partner job executing on the 170 side.

    = status_pj =
      partner_job_info.job_identifier := pj_identifier;
      message_length := #SIZE (partner_job_info.job_identifier);
      arbitrary_info := status_pj;
    CASEND;
    time_count := 0;

  /communication_block/
    WHILE TRUE DO

{ Send function and parameters to the 170 function processor.

      REPEAT
        IF pj_function = submit_pj THEN
          mlp$send_message (rhv$application_name, arbitrary_info, rhv$signal,
                ^partner_job_info.job_validation, message_length,
                destination_name.application_name, status);
        ELSE {  pj function is status_pj }
          mlp$send_message (rhv$application_name, arbitrary_info, rhv$signal,
                ^partner_job_info.job_identifier, message_length,
                destination_name.application_name, status);
        IFEND;
        IF NOT status.normal THEN
          CASE status.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail,
                mlc$receive_list_full, mlc$prior_msg_not_received =
            pmp$long_term_wait (1000, 1000);
          ELSE
            osp$set_status_abnormal (rhc$remote_host_id,
                  rhe$unable_to_communicate, '', status);
            EXIT /communication_block/;
          CASEND;
        IFEND;
      UNTIL status.normal;

{ Get status of request back from 170 function processor.

      REPEAT
        mlp$receive_message (rhv$application_name, arbitrary_info,
              rhv$signal, ^partner_job_info.job_identifier,
              message_length, #SIZE (partner_job_info.job_identifier),
              zero_receive_index, sender_application_name, status);
        IF NOT status.normal THEN
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            pmp$long_term_wait (1000, 1000);
          ELSE
            osp$set_status_abnormal (rhc$remote_host_id,
                  rhe$unable_to_communicate, '', status);
            EXIT /communication_block/;
          CASEND;
        IFEND;
      UNTIL status.normal;
      status.condition := arbitrary_info;
      IF message_length <> 0 THEN
        pj_identifier := partner_job_info.job_identifier;
        EXIT /communication_block/;
      IFEND;
      IF status.condition = rhe$no_ml_free_entries_found THEN
        time_count := time_count + 1;
        IF time_count < time_out_limit THEN
          arbitrary_info := submit_pj;
          message_length := #SIZE (partner_job_info.job_identifier);
          pmp$long_term_wait (1000, 1000);
          CYCLE /communication_block/;
        ELSE
          osp$set_status_abnormal (rhc$remote_host_id,
                rhe$no_ml_free_entries_found, '', status);
          EXIT /communication_block/;
        IFEND;
      ELSE
        EXIT /communication_block/;
      IFEND;
    WHILEND /communication_block/;

{ Delete application name.

    REPEAT
      mlp$delete_sender (rhv$application_name,
            destination_name.application_name, local_status);
    UNTIL local_status.normal OR (local_status.condition <>
          mlc$busy_interlock);

  PROCEND send_pj_function_request;

?? TITLE := '        [XDCL, #GATE] rhp$mli_get_permanent_file' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc rhh$mli_get_permanent_file

  PROCEDURE [XDCL, #GATE] rhp$mli_get_permanent_file
    (    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_password: array [1 .. 2] of array [1 .. 2] of
          rht$c180_ascii812_word;
         local_file_info: rht$local_file_info;
         conversion: syt$data_conversions;
     VAR status: ost$status);

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

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

      VAR
        ignore_status,
        ost: ost$status;


      ch_status.normal := TRUE;

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

{ Send request to 170 to see if partner job is still running in
{ order for the job to be cleared from the memory link table.

      IF partner_job_started THEN
        send_pj_function_request (status_pj, pj_identifier, ignore_status);
      IFEND;

{ sign off mli

      IF signed_on THEN
        mlp$sign_off (rhv$application_name, local_status);
      IFEND;

{ exit the PF operation with abnormal status


      IF cond.selector = ifc$interactive_condition THEN
        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;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        osp$set_status_from_condition ('OS', cond, sa, status, ost);
        IF NOT ost.normal THEN
          status := ost;
        IFEND;
      IFEND;

      EXIT rhp$mli_get_permanent_file;

    PROCEND handle_break;

?? TITLE := '        [XDCL, #GATE] rhp$mli_get_permanent_file' ??
?? SET (LIST := ON) ??
?? EJECT ??

    CONST
      submit_pj = rhc$submit_pj,
      get_pf = rhc$get_pf,
      normal = rhc$ok,
      time_limit_for_170_signon = 30,
      time_out_limit = 500,
      moi = rhc$middle_of_information,
      eoi = rhc$end_of_information,
      status_pj = rhc$status_pj,
      job_found = rhc$job_found,
      job_not_found = rhc$job_not_found;

    TYPE
      get_communication_states = (send_info, fetch_size, fetch_info, check_job,
            out);

    VAR
      message_length: mlt$message_length,
      cml: integer,
      ba: integer,
      pba: ^0 .. 0ff(16),
      sp: amt$segment_pointer,
      file_length: integer,
      arbitrary_info: mlt$arbitrary_info,
      sender_application_name: mlt$application_name,
      current_state: get_communication_states,
      send_return_state: get_communication_states,
      time_count: 0 .. time_out_limit + 1,
      check_return_state: get_communication_states,
      permanent_file_info: record
        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_password: array [1 .. 2] of array [1 .. 2] of
              rht$c180_ascii812_word,
      recend,
      be_file_id: string (9),
      ml_stat: ost$status,
      conversion_status: rht$status,
      local_180_file_info: rht$local_file_info,
      data_buffer: rht$file_data_buffer,
      sign_off_status: ost$status,
      cond_desc: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [ifc$interactive_condition, pmc$user_defined_condition]],
      estab_handler: pmt$established_handler,
      local_status: ost$status,
      signed_on,
      break_active: boolean,
      cnv_info: syt$conversion_info,
      bufptr: ^cell,
      partner_job_started: boolean,
      msg_status: ost$status;


{ Initialize.

    signed_on := FALSE;
    break_active := FALSE;
    partner_job_started := FALSE;
    pmp$establish_condition_handler (cond_desc, ^handle_break, ^estab_handler,
          local_status);

{ Sign on to the memory link.

    status.normal := TRUE;
    memory_link_sign_on (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    signed_on := TRUE;

{ Send request to execute partner job.

    send_pj_function_request (submit_pj, pj_identifier, status);
    IF status.normal THEN
      REPEAT
        partner_job_started := TRUE;
        mlp$add_sender (rhv$application_name, pj_identifier, status);
      UNTIL status.normal OR (status.condition <> mlc$busy_interlock);
    IFEND;
    IF NOT status.normal THEN
      memory_link_sign_off (sign_off_status);
      RETURN;
    IFEND;

{ Initialize to send permanent file information.

    local_180_file_info := local_file_info;
    permanent_file_info.permanent_file_name := permanent_file_name;
    permanent_file_info.user_id := user_id;
    convert_ascii812_to_ascii88 (user_id, be_file_id, conversion_status);
    IF be_file_id = '         ' THEN
      convert_ascii88_to_ascii812 (link_user_descriptor.user,
            permanent_file_info.user_id, conversion_status);
    IFEND;
    permanent_file_info.cycle_number := cycle_number;
    permanent_file_info.file_password [1] := file_password [1];
    permanent_file_info.file_password [2] := file_password [2];
    current_state := send_info;
    send_return_state := fetch_info;

  /communication_loop/
    REPEAT
      CASE current_state OF

{ Send permanent file information.

      = send_info =
        time_count := 0;
        message_length := #SIZE (permanent_file_info);
        arbitrary_info := get_pf;
        REPEAT
          mlp$send_message (rhv$application_name, arbitrary_info, rhv$signal,
                ^permanent_file_info, message_length, pj_identifier, status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail =
              pmp$long_term_wait (1000, 1000);
            = mlc$receiver_not_signed_on, mlc$sender_not_permitted =
              time_count := time_count + 1;

{ Check status of partner job every 30 seconds to see if it is in the NOS
{ executing queue.  If it is, then try to send the message again, otherwise
{ abort the GET_FILE command.

              IF time_count > time_limit_for_170_signon THEN
                current_state := check_job;
                check_return_state := send_info;
                CYCLE /communication_loop/;
              ELSE
                pmp$long_term_wait (1000, 1000);
              IFEND;
            = mlc$receiver_name_syntax_error =
              osp$set_status_abnormal (rhc$remote_host_id,
                    rhe$partner_job_not_executing, '', status);
              EXIT /communication_loop/;
            ELSE
              rhp$set_status_abnormal (status);
              EXIT /communication_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;
        current_state := fetch_size;
      = fetch_size =
        time_count := 0;
        REPEAT
          mlp$receive_message (rhv$application_name, arbitrary_info,
                rhv$signal, ^file_length, message_length, #SIZE (file_length),
                0, sender_application_name, status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock =
              pmp$long_term_wait (1000, 1000);
            = mlc$receive_list_index_invalid =
              time_count := time_count + 1;
              IF time_count > time_out_limit THEN
                current_state := check_job;
                check_return_state := fetch_size;
                CYCLE /communication_loop/;
              ELSE
                pmp$long_term_wait (1000, 1000);
              IFEND;
            ELSE
              rhp$set_status_abnormal (status);
              EXIT /communication_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;

        IF arbitrary_info <> moi THEN
          osp$set_status_abnormal (rhc$remote_host_id, arbitrary_info, '',
                status);
          EXIT /communication_loop/;
        IFEND;

        amp$get_segment_pointer (local_file_info.file_identifier,
              amc$cell_pointer, sp, status);
        IF NOT status.normal THEN
          EXIT /communication_loop/;
        IFEND;

{ Call set access selections to have file in sequential mode with free behind pages.

        mmp$set_access_selections (sp.cell_pointer, mmc$as_sequential, status);
        IF NOT status.normal THEN
          EXIT /communication_loop/;
        IFEND;

        ba := file_length * 64 * 8;
        pba := #ADDRESS (1, #SEGMENT (sp.cell_pointer),
              ba + #OFFSET (sp.cell_pointer));

{!!!        pba^ := 0;

        amp$get_segment_pointer (local_file_info.file_identifier,
              amc$sequence_pointer, sp, status);
        IF NOT status.normal THEN
          EXIT /communication_loop/;
        IFEND;

        cnv_info.conversion_type := conversion;
        cnv_info.file_pointer := sp.sequence_pointer;
        cnv_info.save_area := 0;
        RESET cnv_info.file_pointer;
        bufptr := ^data_buffer;

        current_state := fetch_info;

{ Copy data from 170 permanent file to 180 local file.

      = fetch_info =
        REPEAT
          time_count := 0;

{ Get data from permanent file.  The IF test is done outside of the
{ repeat loop to save on performance - it will only get executed once.

          IF osv$170_os_type = osc$ot7_dual_state_nos_be THEN
            REPEAT
              mlp$receive_message (rhv$application_name, arbitrary_info,
                    rhv$signal, bufptr, message_length, #SIZE (data_buffer), 0,
                    sender_application_name, status);
              IF NOT status.normal THEN
                CASE status.condition OF
                = mlc$busy_interlock =
                  pmp$long_term_wait (1000, 1000);
                = mlc$receive_list_index_invalid =
                  time_count := time_count + 1;
                  IF time_count > time_out_limit THEN
                    current_state := check_job;
                    check_return_state := fetch_info;
                    CYCLE /communication_loop/;
                  ELSE
                    pmp$long_term_wait (1000, 1000);
                  IFEND;
                ELSE
                  rhp$set_status_abnormal (status);
                  EXIT /communication_loop/;
                CASEND;
              IFEND;
              UNTIL status.normal;
          ELSE { this is the case of NOS dual state running. }
            REPEAT
              mlp$receive_message (rhv$application_name, arbitrary_info,
                    rhv$signal, bufptr, message_length,
                    #SIZE (data_buffer) - #SIZE (integer), 0,
                    sender_application_name, status);
              IF NOT status.normal THEN
                CASE status.condition OF
                = mlc$busy_interlock =
                  pmp$long_term_wait (1000, 1000);
                = mlc$receive_list_index_invalid =
                  time_count := time_count + 1;
                  IF time_count > time_out_limit THEN
                    current_state := check_job;
                    check_return_state := fetch_info;
                    CYCLE /communication_loop/;
                  ELSE
                    pmp$long_term_wait (1000, 1000);
                  IFEND;
                ELSE
                  rhp$set_status_abnormal (status);
                  EXIT /communication_loop/;
                CASEND;
              IFEND;
            UNTIL status.normal;
          IFEND;

{ Write data to local file.

          CASE arbitrary_info OF
          = moi, eoi =

            IF message_length > 0 THEN
              cml := message_length DIV 8;
              syp$memory_link_data_conversion (^cnv_info, bufptr, cml);
            IFEND;

            IF arbitrary_info = eoi THEN
              sp.sequence_pointer := cnv_info.file_pointer;
              amp$set_segment_eoi (local_file_info.file_identifier, sp,
                    status);
              IF NOT status.normal THEN
                EXIT /communication_loop/;
              IFEND;

            IFEND;
          ELSE
            osp$set_status_abnormal (rhc$remote_host_id, arbitrary_info, '',
                  status);
            EXIT /communication_loop/;
          CASEND;
        UNTIL arbitrary_info = eoi;
        EXIT /communication_loop/;

{ Check status of partner job.

      = check_job =
        send_pj_function_request (status_pj, pj_identifier, status);
        CASE status.condition OF
        = job_found =
          current_state := check_return_state;
        = job_not_found =
          osp$set_status_abnormal (rhc$remote_host_id,
                rhe$partner_job_not_executing, ' ', status);
          EXIT /communication_loop/;
        ELSE
          rhp$set_status_abnormal (status);
          EXIT /communication_loop/;
        CASEND;
      CASEND;
    UNTIL FALSE; {communication_loop end

{ Sign off the memory link.

    memory_link_sign_off (sign_off_status);

  PROCEND rhp$mli_get_permanent_file;

?? TITLE := '        [XDCL, #GATE] rhp$mli_replace_permanent_file' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc rhh$mli_replace_permanent_file

  PROCEDURE [XDCL, #GATE] rhp$mli_replace_permanent_file
    (    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_password: array [1 .. 2] of array [1 .. 2] of
          rht$c180_ascii812_word;
         local_file_info: rht$local_file_info;
         conversion: syt$data_conversions;
     VAR status: ost$status);

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

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

      VAR
        partner_status: ost$status;

      ch_status.normal := TRUE;

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

{ tell partner job to terminate

      IF pj_active THEN
        send_pj_function_request (status_pj, pj_identifier, partner_status);
        IF (partner_status.condition = job_found) THEN
          time_count := 0;

        /tpj/
          WHILE TRUE DO
            mlp$send_message (rhv$application_name, rhe$rh_system_error,
                  rhv$signal, ^permanent_file_info, zero_message_length,
                  pj_identifier, status);
            IF NOT status.normal THEN
              CASE status.condition OF
              = mlc$busy_interlock, mlc$pool_buffer_not_avail =
              = mlc$prior_msg_not_received =
                time_count := time_count + 1;
                IF time_count > time_out_limit THEN
                  EXIT /tpj/;
                IFEND;
              ELSE
                EXIT /tpj/;
              CASEND;
              pmp$long_term_wait (1000, 1000);
              CYCLE /tpj/;
            ELSE
              EXIT /tpj/;
            IFEND;
          WHILEND /tpj/;
        IFEND;
      IFEND;

{ sign off mli

      IF signed_on THEN
        mlp$sign_off (rhv$application_name, local_status);
      IFEND;

{ exit the PF operation with abnormal status


      IF cond.selector = ifc$interactive_condition THEN
        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;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        osp$set_status_from_condition ('OS', cond, sa, status, local_status);
        IF NOT local_status.normal THEN
          status := local_status;
        IFEND;
      IFEND;

      EXIT rhp$mli_replace_permanent_file;

    PROCEND handle_break;

?? TITLE := '        [XDCL, #GATE] rhp$mli_replace_permanent_file' ??

    CONST
      normal = rhc$ok,
      replace_pf = rhc$replace_pf,
      time_limit_for_170_signon = 30,
      time_out_limit = 500,
      receive_any_msg_receive_index = 0,
      eoi = rhc$end_of_information,
      ok = rhc$ok,
      zero_message_length = 0,
      status_pj = rhc$status_pj,
      job_found = rhc$job_found,
      job_not_found = rhc$job_not_found,
      bfzw = (mlc$max_message_length DIV (64 * 8)) * 64,
      submit_pj = rhc$submit_pj;

    TYPE
      name_types = (full, abbreviated),
      replace_communication_states = (send_pf_info, get_pf_data, send_pf_data,
            fetch_replace_condition, send_condition, check_job);

    VAR
      sender_application_name: mlt$application_name,
      permanent_file_info: record
        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_password: array [1 .. 2] of array [1 .. 2] of
              rht$c180_ascii812_word,
      recend,
      local_180_file_info: rht$local_file_info,
      current_state: replace_communication_states,
      time_count: 0 .. time_out_limit + 1,
      alternate_user_number: string (9),
      alternate_password: string (9),
      check_return_state: replace_communication_states,
      data_buffer: rht$file_data_buffer,
      message_length: mlt$message_length,
      arbitrary_info: mlt$arbitrary_info,
      conversion_status: rht$status,
      rh_file_position: rht$file_position,
      cond_desc: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [ifc$interactive_condition, pmc$user_defined_condition]],
      estab_handler: pmt$established_handler,
      local_status: ost$status,
      save_status: ost$status,
      signed_on,
      pj_active,
      break_active: boolean,
      cml: integer,
      mli_failure: boolean,
      sp: amt$segment_pointer,
      cnv_info: syt$conversion_info,
      bufptr: ^cell,
      cap: ^array [1 .. * ] of cell,
      total: integer,
      fai: array [1 .. 1] of amt$access_info,
      msg_status: ost$status,
      sign_off_status: ost$status;


{ Initialize.

    pj_active := FALSE;
    signed_on := FALSE;
    break_active := FALSE;
    mli_failure := FALSE;
    pmp$establish_condition_handler (cond_desc, ^handle_break, ^estab_handler,
          local_status);

{ Sign on to the memory link.

    status.normal := TRUE;
    save_status.normal := TRUE;
    memory_link_sign_on (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    signed_on := TRUE;

{ Send request to submit partner job.

    send_pj_function_request (submit_pj, pj_identifier, status);
    IF status.normal THEN
      pj_active := TRUE;
      REPEAT
        mlp$add_sender (rhv$application_name, pj_identifier, status);
      UNTIL status.normal OR (status.condition <> mlc$busy_interlock);
    IFEND;
    IF NOT status.normal THEN
      memory_link_sign_off (sign_off_status);
      RETURN;
    IFEND;

{ Initialize to send permanent file information.

    local_180_file_info := local_file_info;
    permanent_file_info.permanent_file_name := permanent_file_name;
    permanent_file_info.user_id := user_id;
    permanent_file_info.cycle_number := cycle_number;

{ Check if alternate user number the same.

    convert_ascii812_to_ascii88 (user_id, alternate_user_number,
          conversion_status);
    IF osv$170_os_type = osc$ot7_dual_state_nos_be THEN

{Use the user_id from SETLA command if the NOSBE user did
{not specify a user_id.

      IF alternate_user_number = '         ' THEN
        convert_ascii88_to_ascii812 (link_user_descriptor.user,
              permanent_file_info.user_id, conversion_status);
      IFEND;
    ELSE
      IF link_user_descriptor.user = alternate_user_number THEN
        convert_ascii812_to_ascii88 (file_password [1], alternate_password,
              conversion_status);
        IF (link_user_descriptor.password = alternate_password) OR
              (alternate_password = '       ') THEN
          convert_ascii88_to_ascii812 ('       ', permanent_file_info.user_id,
                conversion_status);
        IFEND;
      IFEND;
    IFEND;
    permanent_file_info.file_password [1] := file_password [1];
    permanent_file_info.file_password [2] := file_password [2];
    current_state := send_pf_info;

  /communication_loop/
    REPEAT
      CASE current_state OF

{ Send information on permanent file to be replaced.

      = send_pf_info =
        time_count := 0;
        message_length := #SIZE (permanent_file_info);
        arbitrary_info := replace_pf;
        REPEAT
          mlp$send_message (rhv$application_name, arbitrary_info, rhv$signal,
                ^permanent_file_info, message_length, pj_identifier, status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail =
              pmp$long_term_wait (1000, 1000);
            = mlc$receiver_not_signed_on, mlc$sender_not_permitted =
              time_count := time_count + 1;

{ Check status of partner job every 30 seconds to see if it is in the NOS
{ executing queue.  If it is, then try to send the message again, otherwise
{ abort the REPLACE_FILE command.

              IF time_count > time_limit_for_170_signon THEN
                current_state := check_job;
                check_return_state := send_pf_info;
                CYCLE /communication_loop/;
              ELSE
                pmp$long_term_wait (1000, 1000);
              IFEND;
            = mlc$receiver_name_syntax_error =
              osp$set_status_abnormal (rhc$remote_host_id,
                    rhe$partner_job_not_executing, '', status);
              EXIT /communication_loop/;
            ELSE
              mli_failure := TRUE;
              EXIT /communication_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;

        amp$get_segment_pointer (local_file_info.file_identifier,
              amc$sequence_pointer, sp, status);
        IF NOT status.normal THEN
          arbitrary_info := rhe$file_io_error;
          save_status := status;
          current_state := send_condition;
          CYCLE /communication_loop/;
        IFEND;

        IF conversion = syc$no_conversion THEN
          RESET sp.sequence_pointer;
          fai [1].key := amc$eoi_byte_address;
          amp$fetch_access_information (local_file_info.file_identifier, fai,
                status);
          IF NOT status.normal THEN
            arbitrary_info := rhe$file_io_error;
            save_status := status;
            current_state := send_condition;
            CYCLE /communication_loop/;
          IFEND;
          total := fai [1].eoi_byte_address;
        ELSE
          cnv_info.save_area := 0;
          cnv_info.conversion_type := conversion;
          cnv_info.file_pointer := sp.sequence_pointer;
          RESET cnv_info.file_pointer;
          bufptr := ^data_buffer;
        IFEND;

        rh_file_position := rhc$middle_of_information;

        current_state := get_pf_data;

{ Get data from the local file.

      = get_pf_data =

        IF conversion = syc$no_conversion THEN
          IF total < bfzw * 8 THEN
            cml := total;
          ELSE
            cml := bfzw * 8;
          IFEND;
          IF cml > 0 THEN
            NEXT cap: [1 .. cml] IN sp.sequence_pointer;
            bufptr := cap;
          ELSE
            IF total <> 0 THEN

{ something went wrong

              osp$set_status_abnormal (rhc$remote_host_id, rhe$rh_system_error,
                    'file length', status);
              arbitrary_info := rhe$file_io_error;
              save_status := status;
              current_state := send_condition;
              CYCLE /communication_loop/;
            IFEND;
          IFEND;
          total := total - cml;
          IF total <= 0 THEN
            rh_file_position := eoi;
            amp$set_segment_position (local_file_info.file_identifier, sp,
                  local_status);
          IFEND;
          message_length := ((cml + 7) DIV 8) * 8;
        ELSE
          cml := bfzw;
          syp$memory_link_data_conversion (^cnv_info, bufptr, cml);
          IF cml <> bfzw THEN
            rh_file_position := eoi;
            sp.sequence_pointer := cnv_info.file_pointer;
            amp$set_segment_position (local_file_info.file_identifier, sp,
                  local_status);
          IFEND;
          message_length := cml * 8;
        IFEND;

        current_state := send_pf_data;

{ Send data from local file to the partner job.

      = send_pf_data =
        time_count := 0;
        REPEAT
          arbitrary_info := rh_file_position;
          mlp$send_message (rhv$application_name, arbitrary_info, rhv$signal,
                bufptr, message_length, pj_identifier, status);
          IF status.normal THEN
            IF arbitrary_info = eoi THEN
              current_state := fetch_replace_condition;
            ELSE
              current_state := get_pf_data;
            IFEND;
          ELSE
            CASE status.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail =
              pmp$long_term_wait (1000, 1000);
            = mlc$prior_msg_not_received, mlc$receive_list_full =
              time_count := time_count + 1;
              IF time_count > time_out_limit THEN
                current_state := check_job;
                check_return_state := send_pf_data;
                CYCLE /communication_loop/;
              ELSE
                pmp$long_term_wait (1000, 1000);
              IFEND;
            ELSE
              mli_failure := TRUE;
              EXIT /communication_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;

{ Terminate on EOI and check status of the replace.

      = fetch_replace_condition =
        time_count := 0;
        REPEAT
          mlp$receive_message (rhv$application_name, arbitrary_info,
                rhv$signal, ^data_buffer, message_length,
                #SIZE (data_buffer) - #SIZE (integer),
                receive_any_msg_receive_index, sender_application_name,
                status);
          IF status.normal THEN
            IF arbitrary_info <> ok THEN
              osp$set_status_abnormal (rhc$remote_host_id, arbitrary_info, ' ',
                    status);
            IFEND;
            EXIT /communication_loop/;
          ELSE
            CASE status.condition OF
            = mlc$busy_interlock =
              pmp$long_term_wait (1000, 1000);
            = mlc$receive_list_index_invalid =
              time_count := time_count + 1;
              IF time_count > time_out_limit THEN
                current_state := check_job;
                check_return_state := fetch_replace_condition;
                CYCLE /communication_loop/;
              ELSE
                pmp$long_term_wait (1000, 1000);
              IFEND;
            ELSE
              mli_failure := TRUE;
              EXIT /communication_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;

{ Tell partner job error occurred trying to get data from the local file.

      = send_condition =
        time_count := 0;
        REPEAT
          mlp$send_message (rhv$application_name, arbitrary_info, rhv$signal,
                ^permanent_file_info, zero_message_length, pj_identifier,
                status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail =
              pmp$long_term_wait (1000, 1000);
            = mlc$prior_msg_not_received =
              time_count := time_count + 1;
              IF time_count > time_out_limit THEN
                current_state := check_job;
                check_return_state := send_condition;
                CYCLE /communication_loop/;
              ELSE
                pmp$long_term_wait (1000, 1000);
              IFEND;
            ELSE
              mli_failure := TRUE;
              EXIT /communication_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;
        IF NOT save_status.normal THEN
          status := save_status;
        ELSE
          osp$set_status_abnormal (rhc$remote_host_id, arbitrary_info, '',
                status);
        IFEND;
        EXIT /communication_loop/;

{ Check status of partner job.

      = check_job =
        send_pj_function_request (status_pj, pj_identifier, status);
        CASE status.condition OF
        = job_found =
          current_state := check_return_state;
        = job_not_found =
          osp$set_status_abnormal (rhc$remote_host_id,
                rhe$partner_job_not_executing, '', status);
          EXIT /communication_loop/;
        ELSE
          rhp$set_status_abnormal (status);
          EXIT /communication_loop/;
        CASEND;
      CASEND;
    UNTIL FALSE;

    IF mli_failure THEN

{ try to terminate the 170 job

      time_count := 0;

    /tpj/
      WHILE TRUE DO
        mlp$send_message (rhv$application_name, rhe$rh_system_error,
              rhv$signal, ^permanent_file_info, zero_message_length,
              pj_identifier, local_status);
        IF NOT status.normal THEN
          CASE status.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail =
          = mlc$prior_msg_not_received =
            time_count := time_count + 1;
            IF time_count > 30 THEN
              rhp$set_status_abnormal (status);
              EXIT /tpj/;
            IFEND;
          ELSE
            rhp$set_status_abnormal (status);
            EXIT /tpj/;
          CASEND;
          pmp$long_term_wait (1000, 1000);
          CYCLE /tpj/;
        ELSE
          EXIT /tpj/;
        IFEND;
      WHILEND /tpj/;
    IFEND;

{ Sign off the memory link.

    memory_link_sign_off (sign_off_status);

  PROCEND rhp$mli_replace_permanent_file;
?? TITLE := '        [XDCL, #GATE] rhp$open_b56_file', EJECT ??

{
{ RHP$OPEN_B56_FILE
{
{  This procedure is called by rhp$get/rhp$replace to open a B56 file.
{
{           RHP$OPEN_B56_FILE (FILE_ATTACHMENT_OPTIONS,
{               LOCAL_FILE_INFO, STATUS);
{
{  FILE_ATTACHMENT_OPTIONS: (input) This parameter contains the access
{      requirements to get the file.
{
{  LOCAL_FILE_INFO: (input, output) This parameter contains all the local
{      file information.
{
{  STATUS: (output) This parameter specifies the status returned to the
{      calling procedure.
{

  PROCEDURE [XDCL, #GATE] rhp$open_b56_file
    (    file: fst$file_reference;
         file_attachment_options: rht$attachment_option;
     VAR local_file_info: rht$local_file_info;
     VAR status: ost$status);

    VAR
      attribute_override: rht$file_cycle_attribute,
      caller_id: ost$caller_identifier,
      required_open_attributes: array [1 .. 1] of fst$file_cycle_attribute;

{ Set up the required open attributes and the override attributes for a B56
{ file.

    #CALLER_ID (caller_id);
    required_open_attributes [1].selector := fsc$ring_attributes;
    required_open_attributes [1].ring_attributes.r1 := caller_id.ring;
    required_open_attributes [1].ring_attributes.r2 := caller_id.ring;
    required_open_attributes [1].ring_attributes.r3 := caller_id.ring;
    attribute_override [1].selector := fsc$record_type;
    attribute_override [1].record_type := amc$undefined;
    attribute_override [2].selector := fsc$file_organization;
    attribute_override [2].file_organization := amc$sequential;
    attribute_override [3].selector := fsc$block_type;
    attribute_override [3].block_type := amc$system_specified;
    fsp$open_file (file, amc$record, ^file_attachment_options, NIL,
          ^required_open_attributes, NIL, ^attribute_override,
          local_file_info.file_identifier, status);

  PROCEND rhp$open_b56_file;
?? TITLE := '        [XDCL, #GATE] rhp$close_b56_file', EJECT ??

{
{ RHP$CLOSE_B56_FILE
{
{  This procedure is called by rhp$get/rhp$replace to close a B56 file.
{
{           RHP$CLOSE_B56_FILE (LOCAL_FILE_INFO, STATUS)
{
{  LOCAL_FILE_INFO: (input) This parameter contains all the local
{      file information.
{
{  STATUS: (output) This parameter specifies the status returned to the
{      calling procedure.
{

  PROCEDURE [XDCL, #GATE] rhp$close_b56_file
    (    local_file_info: rht$local_file_info;
     VAR status: ost$status);

    fsp$close_file (local_file_info.file_identifier, status);

  PROCEND rhp$close_b56_file;

MODEND rhm$permanent_file_memory_link;
