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

?? NEWTITLE := 'Global Type Declarations' ??
?? SET (LISTEXT := ON) ??
?? EJECT ??
*copyc rhc$condition_limits
*copyc rhd$nos_ve_types

?? TITLE := 'External Procedures Referenced By This Module' ??
?? SET (LISTEXT := ON) ??
?? EJECT ??
*copyc MLP$SIGN_ON
*copyc MLP$ADD_SENDER
*copyc MLP$SIGN_OFF
*copyc PMP$LOG
*copyc PMP$WAIT
*copyc OSP$FORMAT_MESSAGE
*copyc RHP$SET_STATUS_ABNORMAL

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

{ MLI_LINK
{
{     The purpose of this procedure is to provide all linkage
{ facilities to the MLI for all IRHF applications.  This
{ procedure allows an application to sign on and sign off
{ the MLI.  As part of the sign on facilities, the partner
{ sending application is also identified to the MLI.
{
{     MLI_LINK (DIRECTION,APPLICATION_NAMES,STATUS)
{
{ DIRECTION: (input) This parameter specifies the linkage
{     direction; i.e., sign_on or sign_off.
{
{ APPLICATION_NAMES: (input) This parameter contains the sending and
{     receiving application names required for MLI communications.
{
{ STATUS: (output) This parameter returns the success or failure of
{     the application sign on or sign off.
{

  PROCEDURE [XDCL] mli_link (direction: rht$mli_link_direction;
    VAR application_names: rht$mli_application_names;
    VAR status: ost$status);

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

{ LOG_ERROR_MESSAGE
{
{        The purpose of this procedure is to format and log an error
{ to the job log.
{
{         LOG_ERROR_MESSAGE (MESSAGE_STATUS, STATUS)
{
{ MESSAGE_STATUS: (input) This parameter contains the status to format and
{                 write to the job log.
{
{ STATUS: (output) This parameter returns the success or failure of logging
{         the error.
{

    PROCEDURE log_error_message (message_status: ost$status;
      VAR status: ost$status);

      VAR
        message: ost$status_message,
        message_area: ^ost$status_message,
        message_line_count: ^ost$status_message_line_count,
        message_line_index: 1 .. osc$max_status_message_lines,
        message_line_size: ^ost$status_message_line_size,
        message_line: ^string (*),
        page_width: ost$status_message_line_size;


      status.normal := TRUE;
      page_width := osc$max_status_message_line;
      osp$format_message (message_status, osc$full_message_level,
        page_width, message, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      message_area := ^message;
      RESET message_area;
      NEXT message_line_count IN message_area;
      FOR message_line_index := 1 TO message_line_count^ DO
        NEXT message_line_size IN message_area;
        NEXT message_line: [message_line_size^] IN message_area;
        pmp$log (message_line^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

    PROCEND log_error_message;
?? TITLE := 'mli_link' ??
?? SET (LIST := ON) ??
?? EJECT ??

    VAR
      unique: mlt$application_name, { see note below }
      msg_status: ost$status;

    status.normal := TRUE;
  /mli_link_loop/
    BEGIN
      IF direction = on THEN
        REPEAT
{
{ WARNING:
{    This sign_on request assumes that the unique application name
{    generation feature of mli is not used.
{
          mlp$sign_on (application_names.application.application_name,
                rhc$max_messages, unique, status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$nosve_not_up, mlc$ant_full, mlc$busy_interlock,
                  mlc$pool_buffer_not_avail =
              pmp$wait (1000, 1000);
            ELSE
              rhp$set_status_abnormal (status);
              log_error_message (status, msg_status);
              EXIT /mli_link_loop/;
            CASEND;
          IFEND;
        UNTIL status.normal;
        REPEAT
          mlp$add_sender (application_names.application.application_name,
              application_names.destination.application_name, status);
          IF NOT status.normal THEN
            IF status.condition = mlc$busy_interlock THEN
              pmp$wait (1000, 1000);
            ELSE
              rhp$set_status_abnormal (status);
              log_error_message (status, msg_status);
              EXIT /mli_link_loop/;
            IFEND;
          IFEND;
        UNTIL status.normal;
      ELSE
        REPEAT
          mlp$sign_off (application_names.application.application_name, status);
          IF NOT status.normal THEN
            CASE status.condition OF
            = mlc$nosve_not_up, mlc$queued_msgs_lost,
                  mlc$receiver_not_signed_on =
              status.normal := TRUE;
            = mlc$busy_interlock =
            ELSE
              EXIT /mli_link_loop/;
            CASEND;
            pmp$wait (1000, 1000);
          IFEND;
        UNTIL status.normal;
      IFEND;
    END /mli_link_loop/;

  PROCEND mli_link;

MODEND rhm$linkage_to_memory_link;
