*copyc OSD$DEFAULT_PRAGMATS
MODULE icm$partner_job_mli_access;
?? TITLE := 'MODULE icm$partner_job_mli_access' ??

?? PUSH (LIST := ON) ??
*copyc ICE$ERROR_CODES
*copyc ICT$PARTNER_MESSAGES
*copyc ICF$OPEN_FILE_DESCRIPTOR
*copyc ICP$REPORT_STATUS_ERROR
*copyc ICP$SET_STATUS_ABNORMAL
*copyc IFE$ERROR_CODES
*copyc OSP$DISESTABLISH_COND_HANDLER
*copyc OSP$ESTABLISH_CONDITION_HANDLER
*copyc OSP$SET_STATUS_ABNORMAL
*copyc PMP$CONTINUE_TO_CAUSE
*copyc PMP$LONG_TERM_WAIT
*copyc PMP$WAIT
*copyc MLP$ADD_SENDER
*copyc MLP$CONFIRM_SEND
*copyc MLP$RECEIVE_MESSAGE
*copyc MLP$SEND_MESSAGE
*copyc MLP$SIGN_OFF
*copyc MLP$SIGN_ON
?? POP ??

?? TITLE := 'PROCEDURE icp$pj_sign_on', EJECT ??

  PROCEDURE [XDCL] icp$pj_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.
{

    PROCEDURE handle_break
      (    cond: pmt$condition;
           condition_info: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR break_status: ost$status);

      VAR
        local_status: ost$status;

      IF (cond.selector = ifc$interactive_condition) THEN
        IF cond.interactive_condition = ifc$pause_break THEN
          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$pause_break_received, '', status);
        ELSEIF cond.interactive_condition = ifc$terminate_break THEN
          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$terminate_break_received, '', status);
        IFEND;
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        EXIT icp$pj_sign_on;
      IFEND;
      break_status.normal := TRUE;
      RETURN;
    PROCEND handle_break;

{ Begin procedure ICP$PJ_SIGN_ON.

    status.normal := TRUE;
    osp$establish_condition_handler (^handle_break, FALSE);

{ Sign On to the Memory Link.

  /sign_on_to_mli/
    WHILE TRUE DO
      mlp$sign_on (mlc$unique_name, 1, application_name, status);
      IF status.normal THEN
        EXIT /sign_on_to_mli/;
      ELSE
        CASE status.condition OF
        = mlc$busy_interlock, mlc$pool_buffer_not_avail =
          pmp$wait (icf_short_interval, icf_short_interval);
        = mlc$ant_full =
          pmp$long_term_wait (icf_interval, icf_interval);
        ELSE
          icp$set_status_abnormal (status);
          EXIT /sign_on_to_mli/;
        CASEND;
      IFEND;
    WHILEND /sign_on_to_mli/;
    osp$disestablish_cond_handler;

  PROCEND icp$pj_sign_on;

?? TITLE := 'PROCEDURE icp$pj_add_sender', EJECT ??

  PROCEDURE [XDCL] icp$pj_add_sender
    (    application_name: mlt$application_name;
     VAR status: ost$status);

{  PURPOSE:
{    The purpose of this procedure is to permit the Partner-Job-Exec
{    application to send messages to the interstate communication task.
{  DESIGN:
{    A MLP$ADD_SENDER request for the Partner-Job-Exec is issued to the Memory
{    Link.
{

{ Permit Partner-Job-Exec to send messages to us.

    status.normal := TRUE;

  /permit_pj_exec_to_send/
    WHILE TRUE DO
      mlp$add_sender (application_name, icc$pj_exec_application_name, status);
      IF status.normal THEN
        EXIT /permit_pj_exec_to_send/;
      ELSE
        CASE status.condition OF
        = mlc$busy_interlock =
          pmp$wait (icf_short_interval, icf_short_interval);
        ELSE
          icp$set_status_abnormal (status);
          EXIT /permit_pj_exec_to_send/;
        CASEND;
      IFEND;
    WHILEND /permit_pj_exec_to_send/;

  PROCEND icp$pj_add_sender;

?? TITLE := 'PROCEDURE icp$send_to_pj_exec', EJECT ??

  PROCEDURE [XDCL] icp$send_to_pj_exec
    (    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
{    Partner-Job-Exec.
{  DESIGN:
{    A MLP$SEND_MESSAGE to Partner-Job-Exec request is issued to the Memory
{    Link.
{

    PROCEDURE handle_break
      (    cond: pmt$condition;
           condition_info: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR break_status: ost$status);

      VAR
        local_status: ost$status;

      IF (cond.selector = ifc$interactive_condition) THEN
        IF cond.interactive_condition = ifc$pause_break THEN
          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$pause_break_received, '', status);
        ELSEIF cond.interactive_condition = ifc$terminate_break THEN
          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$terminate_break_received, '', status);
        IFEND;
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        EXIT icp$send_to_pj_exec;
      IFEND;
      break_status.normal := TRUE;
      RETURN;
    PROCEND handle_break;

{ Begin procedure ICP$SEND_TO_PJ_EXEC.

    status.normal := TRUE;
    osp$establish_condition_handler (^handle_break, FALSE);

  /send_message_to_pj_exec/
    WHILE TRUE DO
      mlp$send_message (application_name, message_type, NIL, message_pointer,
            message_length, icc$pj_exec_application_name, status);
      IF status.normal THEN
        EXIT /send_message_to_pj_exec/;
      ELSE
        CASE status.condition OF
        = mlc$busy_interlock, mlc$pool_buffer_not_avail =
          pmp$wait (icf_short_interval, icf_short_interval);
        = mlc$receive_list_full, mlc$prior_msg_not_received =
          pmp$long_term_wait (icf_interval, icf_interval);
        ELSE
          icp$set_status_abnormal (status);
          EXIT /send_message_to_pj_exec/;
        CASEND;
      IFEND;
    WHILEND /send_message_to_pj_exec/;
    osp$disestablish_cond_handler;

  PROCEND icp$send_to_pj_exec;

?? TITLE := 'PROCEDURE icp$receive_from_pj_exec', EJECT ??

  PROCEDURE [XDCL] icp$receive_from_pj_exec
    (    application_name: mlt$application_name;
         buffer_pointer: ^cell;
         buffer_length: mlt$message_length;
     VAR message_length: mlt$message_length;
     VAR arbitrary_info: mlt$arbitrary_info;
     VAR status: ost$status);

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

    VAR
      busy_count: 0 .. 100,
      sender_application_name: mlt$application_name;


    PROCEDURE handle_break
      (    cond: pmt$condition;
           condition_info: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR break_status: ost$status);

      VAR
        local_status: ost$status;

      IF (cond.selector = ifc$interactive_condition) THEN
        IF cond.interactive_condition = ifc$pause_break THEN
          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$pause_break_received, '', status);
        ELSEIF cond.interactive_condition = ifc$terminate_break THEN
          osp$set_status_abnormal (ifc$interactive_facility_id,
                ife$terminate_break_received, '', status);
        IFEND;
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        EXIT icp$receive_from_pj_exec;
      IFEND;
      break_status.normal := TRUE;
      RETURN;
    PROCEND handle_break;

{ Begin procedure ICP$RECEIVE_FROM_PJ_EXEC.

    status.normal := TRUE;
    busy_count := 0;
    osp$establish_condition_handler (^handle_break, FALSE);

  /receive_message_from_pj_exec/
    WHILE TRUE DO
      mlp$receive_message (application_name, arbitrary_info, NIL,
            buffer_pointer, message_length, buffer_length, 0,
            sender_application_name, status);
      IF status.normal THEN
        EXIT /receive_message_from_pj_exec/;
      ELSE
        CASE status.condition OF
        = mlc$busy_interlock =
          pmp$wait (icf_short_interval, icf_short_interval);
        = mlc$receive_list_index_invalid =
          IF busy_count < 100 THEN
            busy_count := busy_count + 1;
            pmp$long_term_wait (icf_interval, icf_interval);
          ELSE

          /confirm_loop/
            WHILE TRUE DO
              mlp$confirm_send (application_name, sender_application_name,
                    status);
              IF (status.normal) OR (status.condition =
                    mlc$prior_msg_not_received) THEN
                busy_count := 0;
                pmp$long_term_wait (icf_interval, icf_interval);
                CYCLE /receive_message_from_pj_exec/;
              ELSEIF (status.condition = mlc$busy_interlock) THEN
                pmp$wait (icf_short_interval, icf_short_interval);
                CYCLE /confirm_loop/;
              ELSEIF status.condition = mlc$sender_not_permitted THEN
                pmp$long_term_wait (icf_interval, icf_interval);
                CYCLE /confirm_loop/;
              ELSEIF status.condition = mlc$receiver_not_signed_on THEN
                osp$set_status_abnormal (icc$interstate_communication_id,
                      ice$partner_ended, '', status);
                EXIT /receive_message_from_pj_exec/;
              ELSE
                icp$set_status_abnormal (status);
                EXIT /receive_message_from_pj_exec/;
              IFEND;
            WHILEND /confirm_loop/;
          IFEND;
        ELSE
          icp$set_status_abnormal (status);
          EXIT /receive_message_from_pj_exec/;
        CASEND;
      IFEND;
    WHILEND /receive_message_from_pj_exec/;
    osp$disestablish_cond_handler;

  PROCEND icp$receive_from_pj_exec;


?? TITLE := 'PROCEDURE icp$pj_sign_off', EJECT ??

  PROCEDURE [XDCL] icp$pj_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.
{

    status.normal := TRUE;

  /sign_off_from_mli/
    WHILE TRUE DO
      mlp$sign_off (application_name, status);
      IF status.normal THEN
        EXIT /sign_off_from_mli/;
      ELSE
        CASE status.condition OF
        = mlc$busy_interlock =
          pmp$wait (icf_short_interval, icf_short_interval);
        ELSE
          icp$set_status_abnormal (status);
          EXIT /sign_off_from_mli/;
        CASEND;
      IFEND;
    WHILEND /sign_off_from_mli/;

  PROCEND icp$pj_sign_off;

MODEND icm$partner_job_mli_access;
