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

?? 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$SET_STATUS_ABNORMAL
*copyc ICP$STATUS_PARTNER_JOB
*copyc IFE$ERROR_CODES
*copyc I#PTR
*copyc MLP$FETCH_LINK_PARTNER_INFO
*copyc MLP$SEND_MESSAGE
*copyc OSP$DISESTABLISH_COND_HANDLER
*copyc OSP$ESTABLISH_CONDITION_HANDLER
*copyc OSP$SET_STATUS_ABNORMAL
*copyc OSV$170_OS_TYPE
*copyc PMP$CONTINUE_TO_CAUSE
*copyc PMP$EXIT
*copyc PMP$LONG_TERM_WAIT
*copyc PMP$WAIT
?? POP ??

?? NEWTITLE := 'PROCEDURE icp$put' ??
{  ICP$PUT
{
{     The purpose of this procedure is to send a record or a
{  partial record to the 170 partner job.

  PROCEDURE [XDCL] icp$put
    (    icf_file: ^icf_open_file_descriptor;
         operation: amt$fap_operation;
         working_storage_area: ^cell;
         working_storage_length: amt$working_storage_length;
         term_option: amt$term_option;
     VAR status: ost$status);

    CONST max_nosbe_retries = 10;

    VAR
      offset: amt$working_storage_length,
      message_length: mlt$message_length,
      unused_bits: integer,
      partial: boolean,
      first_message: boolean,
      last_message: boolean,
      retry_count: 0 .. max_nosbe_retries,
      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$put;
      IFEND;
      break_status.normal := TRUE;
      RETURN;
    PROCEND handle_break;

{ Begin procedure ICP$PUT.

    status.normal := TRUE;
    osp$establish_condition_handler (^handle_break, FALSE);
    IF working_storage_length > amc$maximum_block THEN
      amp$set_file_instance_abnormal (icf_file^.file_id,
            ame$record_exceeds_mbl, operation, '', status);
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    IF NOT icf_file^.opened_for_put THEN
      amp$set_file_instance_abnormal (icf_file^.file_id,
            ame$improper_output_attempt, operation, '', status);
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    IF (term_option = amc$continue) AND (icf_file^.position <> amc$mid_record)
          THEN
      amp$set_file_instance_abnormal (icf_file^.file_id,
            ame$improper_term_option, operation, '', status);
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;

{  Terminate any prior partial record.

    IF (term_option = amc$start) AND (icf_file^.position = amc$mid_record) THEN
      icp$put (icf_file, amc$put_next_req, working_storage_area, 0,
            amc$terminate, stat);
      IF NOT stat.normal THEN
        status := stat;
        osp$disestablish_cond_handler;
        RETURN;
      IFEND;
    IFEND;
    partial := (operation = amc$put_partial_req);
    offset := 0;
    signal := ^signal_record;

{  Send data until the user's record area is empty.

  /outer_loop/
    REPEAT
      IF (working_storage_length - offset) <
            ((mlc$max_message_length DIV 8) * 8) THEN
        message_length := (working_storage_length - offset);
      ELSE
        message_length := ((mlc$max_message_length DIV 8) * 8);
      IFEND;
      first_message := (offset = 0) AND ((NOT partial) OR
            (partial AND (term_option = amc$start)) OR
            (partial AND (icf_file^.position <> amc$mid_record)));
      last_message := ((offset + message_length) >= working_storage_length) AND
            (NOT partial OR (partial AND (term_option = amc$terminate)));
      arbitrary_info := ($INTEGER (first_message) * 2) +
            $INTEGER (last_message);
      IF last_message AND ((working_storage_length MOD 8) <> 0) THEN
        unused_bits := 8 * (8 - (working_storage_length MOD 8));
        arbitrary_info := arbitrary_info + (unused_bits * 16);
      IFEND;
      IF first_message THEN
        icf_file^.record_length := 0;
      IFEND;

      retry_count := 0;
    /inner_loop/
      WHILE TRUE DO

        mlp$send_message (icf_file^.application_name, arbitrary_info, signal,
              i#ptr (offset, working_storage_area), message_length,
              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 /inner_loop/;
        ELSE
          CASE stat.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail =
            pmp$wait (icf_short_interval, icf_short_interval);
            CYCLE /inner_loop/;
          = mlc$sender_not_permitted =
            pmp$long_term_wait (icf_interval, icf_interval);
            CYCLE /inner_loop/;
          = 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
                IF osv$170_os_type = osc$ot7_dual_state_nos_be THEN
                  IF retry_count = max_nosbe_retries THEN
                    amp$set_file_instance_abnormal (icf_file^.file_id,
                        ice$partner_ended, operation, '', status);
                    EXIT /outer_loop/;
                  ELSE
                    retry_count := retry_count + 1;
                    pmp$long_term_wait (icf_short_interval, icf_short_interval);
                    CYCLE /inner_loop/;
                  IFEND;
                ELSE
                  amp$set_file_instance_abnormal (icf_file^.file_id,
                      ice$partner_ended, operation, '', status);
                  EXIT /outer_loop/;
                IFEND;
              ELSE
                pmp$long_term_wait (icf_interval, icf_interval);
                CYCLE /inner_loop/;
              IFEND;
            ELSE
              osp$disestablish_cond_handler;
              pmp$exit (stat);
            IFEND;
          = mlc$prior_msg_not_received, mlc$receive_list_full =

          /flpi_loop/
            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/;
              ELSE
                CASE stat.condition OF
                = mlc$busy_interlock =
                  pmp$wait (icf_short_interval, icf_short_interval);
                  CYCLE /flpi_loop/;
                = 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);
                      RETURN;
                    ELSE
                      pmp$long_term_wait (icf_interval, icf_interval);
                      CYCLE /inner_loop/;
                    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/;

            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);
              osp$disestablish_cond_handler;
              RETURN;
            ELSE
              pmp$long_term_wait (icf_interval, icf_interval);
              CYCLE /inner_loop/;
            IFEND;
          ELSE
            icp$set_status_abnormal (stat);
            osp$disestablish_cond_handler;
            pmp$exit (stat);
          CASEND;
        IFEND;
      WHILEND /inner_loop/;

      offset := offset + message_length;
      icf_file^.record_length := icf_file^.record_length + message_length;
    UNTIL offset >= working_storage_length {/outer_loop/} ;

{  Store the file position information.

    IF last_message THEN
      icf_file^.position := amc$eor;
      icf_file^.last_length := icf_file^.record_length;
    ELSE
      icf_file^.position := amc$mid_record;
    IFEND;
    osp$disestablish_cond_handler;

  PROCEND icp$put;

MODEND icm$put;
