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

?? PUSH (LISTEXT := ON) ??
*copyc AMT$FILE_BYTE_ADDRESS
*copyc AMT$FILE_POSITION
*copyc amc$fap_request_codes
*copyc AMT$MAX_BLOCK_LENGTH
*copyc AMT$TERM_OPTION
*copyc AMT$TRANSFER_COUNT
*copyc AME$PUT_VALIDATION_ERRORS
*copyc AMT$WORKING_STORAGE_LENGTH
*copyc AMP$SET_FILE_INSTANCE_ABNORMAL
*copyc ICE$ERROR_CODES
*copyc ICF$OPEN_FILE_DESCRIPTOR
*copyc ICP$DELETE_PARTNER_JOB
*copyc ICP$PUT
*copyc ICP$SET_STATUS_ABNORMAL
*copyc ICP$STATUS_PARTNER_JOB
*copyc IFE$ERROR_CODES
*copyc MLP$CONFIRM_SEND
*copyc MLP$FETCH_LINK_PARTNER_INFO
*copyc MLP$SEND_MESSAGE
*copyc MLP$SIGN_OFF
*copyc OST$STATUS
*copyc OSP$DISESTABLISH_COND_HANDLER
*copyc OSP$ESTABLISH_CONDITION_HANDLER
*copyc OSP$SET_STATUS_ABNORMAL
*copyc PMP$CONTINUE_TO_CAUSE
*copyc PMP$EXIT
*copyc PMP$LONG_TERM_WAIT
*copyc PMP$TASK_STATE
*copyc PMP$WAIT
?? POP ??

?? NEWTITLE := 'PROCEDURE icp$close' ??

{  ICP$CLOSE
{
{     The purpose of this procedure is to close the link file. That
{  is, to (1) terminate any partial records that may have been sent,
{  (2) send an eoi if the file has been open for sending, (3) wait
{  for the partner job to receive the eoi, (4) sign off from the
{  memory link, and (5) force the partner's sign off.

  PROCEDURE [XDCL] icp$close
    (    icf_file: ^icf_open_file_descriptor;
         operation: amt$fap_operation;
     VAR status: ost$status);

    VAR
      ptr: ^cell,
      eoi: boolean,
      eop: boolean,
      first_message: boolean,
      last_message: boolean,
      last_op: mlt$operation,
      arbitrary_info: mlt$arbitrary_info,
      signal_record: mlt$signal_record,
      signal: mlt$signal,
      partner_stat: ict$status_partner_status,
      stat: ost$status;


    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$close;
      IFEND;
      break_status.normal := TRUE;
      RETURN;
    PROCEND handle_break;

{ Begin procedure ICP$CLOSE

    status.normal := TRUE;
    osp$establish_condition_handler (^handle_break, FALSE);
    ptr := icf_file;
    IF pmp$task_state () = pmc$task_active THEN
      IF icf_file^.opened_for_put THEN
        IF (icf_file^.last_fap_op = amc$put_partial_req) AND
              (icf_file^.position = amc$mid_record) THEN

{  Terminate prior partial records.

          icp$put (icf_file, amc$put_next_req, ptr, 0, amc$terminate, stat);
          IF NOT stat.normal THEN
            status := stat;
          IFEND;
        IFEND;

{  Send an eoi indication.

        signal := ^signal_record;
        eoi := TRUE;
        eop := FALSE;
        first_message := TRUE;
        last_message := TRUE;
        arbitrary_info := $INTEGER (eoi) * 8 + $INTEGER (eop) *
              4 + $INTEGER (first_message) * 2 + $INTEGER (last_message);

      /loop_1/
        WHILE TRUE DO
          mlp$send_message (icf_file^.application_name, arbitrary_info, signal,
                ptr, 0, icf_file^.partner_id.application_name, stat);
          IF (stat.normal) OR (stat.condition = mlc$ok) OR
                (stat.condition = mlc$signal_failed_ignored) OR
                (stat.condition = mlc$signal_to_c170_ignored) THEN
            EXIT /loop_1/;
          ELSE
            CASE stat.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail =
              pmp$wait (icf_short_interval, icf_short_interval);
              CYCLE /loop_1/;
            = mlc$receiver_not_signed_on =
              icp$status_partner_job (icf_file^.partner_id, partner_stat,
                    stat);
              IF stat.normal THEN
                IF partner_stat = icc$partner_not_found THEN
                  amp$set_file_instance_abnormal
                        (icf_file^.file_id, ice$partner_ended, operation, '',
                        status);
                  EXIT /loop_1/;
                ELSE
                  pmp$long_term_wait (icf_interval, icf_interval);
                  CYCLE /loop_1/;
                IFEND;
              ELSE
                osp$disestablish_cond_handler;
                pmp$exit (stat);
              IFEND;
            = mlc$prior_msg_not_received, mlc$receive_list_full =

            /flpi_loop_1/
              WHILE TRUE DO
                mlp$fetch_link_partner_info (icf_file^.application_name,
                      icf_file^.partner_id.application_name, last_op, stat);
                IF (stat.normal) OR (stat.condition = mlc$ok) THEN
                  EXIT /flpi_loop_1/;
                ELSE
                  CASE stat.condition OF
                  = mlc$busy_interlock =
                    pmp$wait (icf_short_interval, icf_short_interval);
                    CYCLE /flpi_loop_1/;
                  = mlc$receiver_not_signed_on =
                    icp$status_partner_job (icf_file^.partner_id, partner_stat,
                          stat);
                    IF stat.normal THEN
                      IF partner_stat = icc$partner_not_found THEN
                        amp$set_file_instance_abnormal
                              (icf_file^.file_id, ice$partner_ended, operation,
                              '', status);
                        EXIT /loop_1/;
                      ELSE
                        pmp$long_term_wait (icf_interval, icf_interval);
                        CYCLE /loop_1/;
                      IFEND;
                    ELSE
                      icp$set_status_abnormal (stat);
                      osp$disestablish_cond_handler;
                      pmp$exit (stat);
                    IFEND;
                  ELSE
                    icp$set_status_abnormal (stat);
                    osp$disestablish_cond_handler;
                    pmp$exit (stat);
                  CASEND;
                IFEND;
              WHILEND /flpi_loop_1/;

              IF ((last_op.req = mlc$send_message_req) OR
                    (last_op.req = mlc$confirm_send_req)) AND
                    ((last_op.stat_condition = mlc$prior_msg_not_received) OR
                    (last_op.stat_condition = mlc$receive_list_full)) THEN
                amp$set_file_instance_abnormal (icf_file^.file_id,
                      ice$write_deadlock, operation, '', status);
                EXIT /loop_1/;
              ELSE
                pmp$long_term_wait (icf_interval, icf_interval);
                CYCLE /loop_1/;
              IFEND;
            ELSE
              icp$set_status_abnormal (stat);
              osp$disestablish_cond_handler;
              pmp$exit (stat);
            CASEND;
          IFEND;
        WHILEND /loop_1/;
        icf_file^.position := amc$eoi;

{  Wait for partner to receive last message.

      /loop_2/
        WHILE TRUE DO
          mlp$confirm_send (icf_file^.application_name,
                icf_file^.partner_id.application_name, stat);
          IF (stat.normal) OR (stat.condition = mlc$ok) THEN
            EXIT /loop_2/;
          ELSE
            CASE stat.condition OF
            = mlc$busy_interlock =
              pmp$wait (icf_short_interval, icf_short_interval);
              CYCLE /loop_2/;
            = mlc$receiver_not_signed_on =
              icp$status_partner_job (icf_file^.partner_id, partner_stat,
                    stat);
              IF stat.normal THEN
                IF partner_stat = icc$partner_not_found THEN
                  amp$set_file_instance_abnormal
                        (icf_file^.file_id, ice$partner_ended, operation, '',
                        status);
                  EXIT /loop_2/;
                ELSE
                  pmp$long_term_wait (icf_interval, icf_interval);
                  CYCLE /loop_2/;
                IFEND;
              ELSE
                osp$disestablish_cond_handler;
                pmp$exit (stat);
              IFEND;
            = mlc$prior_msg_not_received, mlc$receive_list_full =

            /flpi_loop_2/
              WHILE TRUE DO
                mlp$fetch_link_partner_info (icf_file^.application_name,
                      icf_file^.partner_id.application_name, last_op, stat);
                IF (stat.normal) OR (stat.condition = mlc$ok) THEN
                  EXIT /flpi_loop_2/;
                ELSE
                  CASE stat.condition OF
                  = mlc$busy_interlock =
                    pmp$wait (icf_short_interval, icf_short_interval);
                    CYCLE /flpi_loop_2/;
                  = mlc$receiver_not_signed_on =
                    icp$status_partner_job (icf_file^.partner_id, partner_stat,
                          stat);
                    IF stat.normal THEN
                      IF partner_stat = icc$partner_not_found THEN
                        amp$set_file_instance_abnormal
                              (icf_file^.file_id, ice$partner_ended, operation,
                              '', status);
                        EXIT /loop_2/;
                      ELSE
                        pmp$long_term_wait (icf_interval, icf_interval);
                        CYCLE /loop_2/;
                      IFEND;
                    ELSE
                      osp$disestablish_cond_handler;
                      pmp$exit (stat);
                    IFEND;
                  ELSE
                    icp$set_status_abnormal (stat);
                    osp$disestablish_cond_handler;
                    pmp$exit (stat);
                  CASEND;
                IFEND;
              WHILEND /flpi_loop_2/;

              IF ((last_op.req = mlc$send_message_req) OR
                    (last_op.req = mlc$confirm_send_req)) AND
                    ((last_op.stat_condition = mlc$prior_msg_not_received) OR
                    (last_op.stat_condition = mlc$receive_list_full)) THEN
                amp$set_file_instance_abnormal (icf_file^.file_id,
                      ice$write_deadlock, operation, '', status);
                EXIT /loop_2/;
              ELSE
                pmp$long_term_wait (icf_interval, icf_interval);
                CYCLE /loop_2/;
              IFEND;
            ELSE
              icp$set_status_abnormal (stat);
              osp$disestablish_cond_handler;
              pmp$exit (stat);
            CASEND;
          IFEND;
        WHILEND /loop_2/;
      IFEND;
    IFEND;

{  Sign off from the memory link.

    mlp$sign_off (icf_file^.application_name, stat);
    IF NOT stat.normal THEN
      CASE stat.condition OF
      = mlc$receiver_not_signed_on, mlc$queued_msgs_lost =
      ELSE
        icp$set_status_abnormal (stat);
        osp$disestablish_cond_handler;
        pmp$exit (stat);
      CASEND;
    IFEND;

{  Force the partner's sign off.

    icp$delete_partner_job (icf_file^.partner_id, stat);

  PROCEND icp$close;
MODEND icm$close;
