*copyc OSD$DEFAULT_PRAGMATS
MODULE iim$memory_link_access;
?? TITLE := 'MODULE iim$memory_link_access' ??

?? PUSH (LISTEXT := OFF) ??
*copyc IFE$ERROR_CODES
*copyc IIK$KEYPOINTS
*copyc IIT$CONNECTION_DESCRIPTION
*copyc TMC$WAIT_TIMES
*copyc IIV$INTERACTIVE_TERMINATED
*copyc IIP$REPORT_STATUS_ERROR
*copyc IIV$INT_TASK_OPEN_FILE_COUNT
*copyc IIV$CONNECTION_DESC_PTR
*copyc PMP$LONG_TERM_WAIT
*copyc MLP$ADD_SENDER
*copyc MLP$CONFIRM_SEND
*copyc MLP$FORCE_SEND_MESSAGE
*copyc MLP$RECEIVE_MESSAGE
*copyc MLP$REGISTER_SIGNAL_HANDLER
*copyc MLP$SEND_MESSAGE
*copyc MLP$SIGN_OFF
*copyc MLP$SIGN_ON
*copyc OSP$SET_STATUS_ABNORMAL
?? POP ??

?? TITLE := 'Global Internal Type, Constant and Variable Declarations', EJECT
  ??

  TYPE
    iit$mli_status = set of mlt$status;


?? TITLE := 'PROCEDURE iip$sign_on', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$sign_on (VAR application_name:
    mlt$application_name;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to Sign On to the Memory Link.
{  DESIGN:
{    A MLP$SIGN_ON request specifying that a unique application name should be
{    created is issued to the Memory Link.
{


{ Sign On to the Memory Link.

  /sign_on_to_mli/
    WHILE TRUE DO
      {Note use of max_messages = 0, which allows mlc$max_in_transit messages to be in use
      mlp$sign_on (mlc$unique_name, 0, application_name, status);
      IF status.normal THEN
        EXIT /sign_on_to_mli/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock,
              mlc$ant_full, mlc$pool_buffer_not_avail] THEN
          pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
        ELSE
          iip$report_status_error (status, 'sign_on');
          EXIT /sign_on_to_mli/;
        IFEND;
      IFEND;
    WHILEND /sign_on_to_mli/;

  PROCEND iip$sign_on;

?? TITLE := 'PROCEDURE iip$add_sender', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$add_sender (application_name:
    mlt$application_name;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to permit the Pass-On application to
{    send messages to the interactive task.
{  DESIGN:
{    A MLP$ADD_SENDER request for the Pass-On is issued to the Memory Link.
{

{ Permit Pass-On to send messages to us.

  /permit_pass_on_to_send/
    WHILE TRUE DO
      mlp$add_sender (application_name, iic$passon_application_name, status);
      IF status.normal THEN
        EXIT /permit_pass_on_to_send/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock] THEN
          pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
        ELSE
          iip$report_status_error (status, 'add_sender');
          EXIT /permit_pass_on_to_send/;
        IFEND;
      IFEND;
    WHILEND /permit_pass_on_to_send/;

  PROCEND iip$add_sender;

?? TITLE := 'PROCEDURE iip$send_to_pass_on', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$send_to_pass_on (application_name:
    mlt$application_name;
        message_pointer: ^cell;
        message_length: mlt$message_length;
        message_type: mlt$arbitrary_info;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to send a message to the Pass-On.
{  DESIGN:
{    A MLP$SEND_MESSAGE to Pass-On request is issued to the Memory Link.
{    If the message is a CON/END/R a MLP$FORCE_SEND_MESSAGE is issued to
{    insure that the connection is ended (VLR--10/14/86--NV0J496).
{

    VAR
      lst: ost$status,
      msg: ^iit$output_supervisory_message;


    msg := message_pointer;
  /send_message_to_pass_on/
    WHILE TRUE DO

      IF msg^.message_type <> iic$sm_end_connection THEN
        mlp$send_message (application_name, message_type, NIL, message_pointer,
              message_length, iic$passon_application_name, status);
      ELSE
        mlp$force_send_message (application_name, message_type, NIL, message_pointer,
              message_length, iic$passon_application_name, status);
      IFEND;

      IF status.normal THEN
        EXIT /send_message_to_pass_on/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock,
              mlc$pool_buffer_not_avail, mlc$prior_msg_not_received,
              mlc$receive_list_full] THEN
            IF status.condition IN $iit$mli_status [mlc$busy_interlock,
                  mlc$pool_buffer_not_avail, mlc$receive_list_full] THEN
              pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
            ELSE
              pmp$long_term_wait (tmc$infinite_wait, 4000);
            IFEND;
        ELSEIF status.condition IN $iit$mli_status [mlc$receiver_not_signed_on]
              THEN

{ assume disconnect

          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$connection_break_disconnect, '', status);
          EXIT /send_message_to_pass_on/;
        ELSE
          iip$report_status_error (status, 'send_message');
          EXIT /send_message_to_pass_on/;
        IFEND;
      IFEND;
    WHILEND /send_message_to_pass_on/;

  PROCEND iip$send_to_pass_on;

?? TITLE := 'PROCEDURE iip$receive_from_pass_on', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$receive_from_pass_on (application_name:
    mlt$application_name;
        buffer_pointer: ^cell;
        buffer_length: mlt$message_length;
    VAR message_length: mlt$message_length;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to receive a message from the Pass-On.
{  DESIGN:
{    - MLP$RECEIVE_MESSAGE from Pass-On requests are issued to the Memory Link
{      until a message is received.
{

    VAR
      lst: ost$status,
      sender_application_name: mlt$application_name,
      arbitrary_information: mlt$arbitrary_info;


  /receive_message_from_pass_on/
    WHILE TRUE DO
      mlp$receive_message (application_name, arbitrary_information, NIL,
            buffer_pointer, message_length, buffer_length, 0,
            sender_application_name, status);
      IF status.normal THEN
        EXIT /receive_message_from_pass_on/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock,
              mlc$receive_list_index_invalid] THEN
            IF status.condition IN $iit$mli_status [mlc$busy_interlock] THEN
              pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
            ELSE
              pmp$long_term_wait (tmc$infinite_wait, 4000);
            IFEND;
        ELSE
          iip$report_status_error (status, 'receive_message');
          EXIT /receive_message_from_pass_on/;
        IFEND;
      IFEND;
    WHILEND /receive_message_from_pass_on/;

  PROCEND iip$receive_from_pass_on;

?? TITLE := 'PROCEDURE iip$confirm_send', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$confirm_send (application_name:
    mlt$application_name;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to determine whether or not a
{    a message can be sent to the Pass-On.
{  DESIGN:
{    A MLP$CONFIRM_SEND request for the Pass-On is issued to the Memory
{    Link.
{

  /confirm_send_to_pass_on/
    WHILE TRUE DO
      mlp$confirm_send (application_name, iic$passon_application_name, status);
      IF status.normal THEN
        EXIT /confirm_send_to_pass_on/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock,
              mlc$prior_msg_not_received, mlc$receive_list_full] THEN
          pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
        ELSEIF status.condition IN $iit$mli_status [mlc$receiver_not_signed_on]
              THEN

{ assume disconnect

          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$connection_break_disconnect, '', status);
          EXIT /confirm_send_to_pass_on/;
        ELSE
          iip$report_status_error (status, 'confirm_send');
          EXIT /confirm_send_to_pass_on/;
        IFEND;
      IFEND;
    WHILEND /confirm_send_to_pass_on/;

  PROCEND iip$confirm_send;

?? TITLE := 'PROCEDURE iip$sign_off', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$sign_off (application_name: mlt$application_name;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to sign off from the Memory Link.
{  DESIGN:
{    A MLP$SIGN_OFF request is issued to the Memory Link.
{

  /sign_off_from_mli/
    WHILE TRUE DO
      mlp$sign_off (application_name, status);
      IF status.normal THEN
        EXIT /sign_off_from_mli/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock] THEN
          pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
        ELSE
          iip$report_status_error (status, 'sign_off');
          EXIT /sign_off_from_mli/;
        IFEND;
      IFEND;
    WHILEND /sign_off_from_mli/;

  PROCEND iip$sign_off;

?? TITLE := 'PROCEDURE iip$register_handler', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$register_handler (application_name:
    mlt$application_name;
        handler: mlt$handler;
    VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to register a signal handler for a
{    given application name.
{  DESIGN:
{    A MLP$REGISTER_SIGNAL_HANDLER request is issued to the memory link.
{

{ Permit Pass-On to send messages to us.

  /register_handler/
    WHILE TRUE DO
      mlp$register_signal_handler (application_name, handler, status);
      IF status.normal THEN
        EXIT /register_handler/;
      ELSE
        IF status.condition IN $iit$mli_status [mlc$busy_interlock] THEN
          pmp$long_term_wait (iic$user_time_delay, iic$user_time_delay);
        ELSE
          iip$report_status_error (status, 'register_handler');
          EXIT /register_handler/;
        IFEND;
      IFEND;
    WHILEND /register_handler/;

  PROCEND iip$register_handler;

MODEND iim$memory_link_access;
