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

?? PUSH (LISTEXT := ON) ??
*copyc AMT$FILE_BYTE_ADDRESS
*copyc AMT$FILE_POSITION
*copyc AMT$SKIP_OPTION
*copyc amc$fap_request_codes
*copyc AMT$MAX_RECORD_LENGTH
*copyc AMT$TRANSFER_COUNT
*copyc AME$GET_VALIDATION_ERRORS
*copyc AMT$WORKING_STORAGE_LENGTH
*copyc AME$GET_PROGRAM_ACTIONS
*copyc AMP$SET_FILE_INSTANCE_ABNORMAL
*copyc ICE$ERROR_CODES
*copyc ICF$OPEN_FILE_DESCRIPTOR
*copyc IFE$ERROR_CODES
*copyc ICP$SET_STATUS_ABNORMAL
*copyc ICP$STATUS_PARTNER_JOB
*copyc I#PTR
*copyc I#MOVE
*copyc MLP$CONFIRM_SEND
*copyc MLP$FETCH_RECEIVE_LIST
*copyc MLP$FETCH_LINK_PARTNER_INFO
*copyc MLP$RECEIVE_MESSAGE
*copyc OST$STATUS
*copyc OSV$TASK_PRIVATE_HEAP
*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$WAIT
*copyc PMP$LONG_TERM_WAIT
?? POP ??

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

  PROCEDURE [XDCL] icp$get
    (    icf_file: ^icf_open_file_descriptor;
         operation: amt$fap_operation;
         working_storage_area: ^cell;
         wsa_length: amt$working_storage_length;
         transfer_count: ^amt$transfer_count;
         skip_option: amt$skip_option;
     VAR status: ost$status);

    VAR
      buff_in: [STATIC] integer := 0,
      buff_out: [STATIC] integer := 0,
      p1: ^cell,
      p2: ^cell,
      p3: integer,
      fatal: boolean,
      zero_length_record: boolean,
      offset: amt$working_storage_length,
      message_length: mlt$message_length,
      unused_bits: integer,
      eoi: [STATIC] boolean := FALSE,
      eop: [STATIC] boolean := FALSE,
      first_message: [STATIC] boolean := FALSE,
      last_message: [STATIC] boolean := FALSE,
      last_op: mlt$operation,
      arbitrary_info: mlt$arbitrary_info,
      signal_record: mlt$signal_record,
      signal: mlt$signal;

{  RECEIVER
{
{     The purpose of this procedure is to read the next message into
{  the buffer.

    PROCEDURE receiver;

      VAR
        frl_list: mlt$receive_list,
        frl_count: mlt$receive_count,
        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
          busy_count: 0 .. 100,
          local_status: ost$status;

{  Receive any pending message before processing the break.

        busy_count := 0;

      /receive_message_loop/
        WHILE TRUE DO
          mlp$receive_message (icf_file^.application_name, arbitrary_info,
                signal, icf_file^.buff, message_length, mlc$max_message_length,
                0, icf_file^.partner_id.application_name, status);
          IF status.normal THEN
            EXIT /receive_message_loop/;
          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_send/
                WHILE TRUE DO
                  mlp$confirm_send (icf_file^.application_name,
                        icf_file^.partner_id.application_name, status);
                  IF (status.normal) OR (status.condition = mlc$ok) OR
                        (status.condition = mlc$prior_msg_not_received) THEN
                    busy_count := 0;
                    pmp$long_term_wait (icf_interval, icf_interval);
                    CYCLE /receive_message_loop/;
                  ELSEIF (status.condition = mlc$busy_interlock) THEN
                    pmp$wait (icf_short_interval, icf_short_interval);
                    CYCLE /confirm_send/;
                  ELSEIF (status.condition = mlc$sender_not_permitted) THEN
                    pmp$long_term_wait (icf_interval, icf_interval);
                    CYCLE /confirm_send/;
                  ELSEIF status.condition = mlc$receiver_not_signed_on THEN
                    icp$status_partner_job (icf_file^.partner_id, partner_stat,
                          status);
                    IF status.normal THEN
                      IF partner_stat = icc$partner_not_found THEN
                        EXIT /receive_message_loop/;
                      ELSE
                        busy_count := 0;
                        pmp$long_term_wait (icf_interval, icf_interval);
                        CYCLE /receive_message_loop/;
                      IFEND;
                    ELSE
                      EXIT /receive_message_loop/;
                    IFEND;
                  IFEND;
                WHILEND /confirm_send/;
              IFEND;
            ELSE
              EXIT /receive_message_loop/;
            CASEND;
          IFEND;
        WHILEND /receive_message_loop/;
        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);
          fatal := TRUE;
          EXIT receiver;
        IFEND;
        break_status.normal := TRUE;
        RETURN;
      PROCEND handle_break;

{ Begin procedure RECEIVER.

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

    /receive_loop/
      WHILE TRUE DO
        mlp$receive_message (icf_file^.application_name, arbitrary_info,
              signal, icf_file^.buff, message_length, mlc$max_message_length,
              0, icf_file^.partner_id.application_name, stat);

        IF stat.normal THEN
          EXIT /receive_loop/;
        ELSE
          CASE stat.condition OF
          = mlc$ok, mlc$signal_failed_ignored, mlc$signal_to_c170_ignored =
            EXIT /receive_loop/;
          = mlc$busy_interlock =
            pmp$wait (icf_short_interval, icf_short_interval);
            CYCLE /receive_loop/;
          = mlc$receive_list_index_invalid =

{  Check for read deadlock and partner ended.

          /confirm_loop/
            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 /confirm_loop/;
              ELSE
                CASE stat.condition OF
                = mlc$prior_msg_not_received =
                  pmp$long_term_wait (icf_interval, icf_interval);
                  CYCLE /receive_loop/;
                = mlc$busy_interlock =
                  pmp$wait (icf_short_interval, icf_short_interval);
                  CYCLE /confirm_loop/;
                = mlc$sender_not_permitted =
                  pmp$long_term_wait (icf_interval, icf_interval);
                  CYCLE /confirm_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);
                      fatal := TRUE;
                      osp$disestablish_cond_handler;
                      RETURN;
                    ELSE
                      pmp$long_term_wait (icf_interval, icf_interval);
                      CYCLE /receive_loop/;
                    IFEND;
                  ELSE
                    fatal := TRUE;
                    osp$disestablish_cond_handler;
                    pmp$exit (stat);
                  IFEND;
                ELSE
                  icp$set_status_abnormal (stat);
                  fatal := TRUE;
                  osp$disestablish_cond_handler;
                  pmp$exit (stat);
                CASEND;
              IFEND;
            WHILEND /confirm_loop/;

          /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);
                      fatal := TRUE;
                      osp$disestablish_cond_handler;
                      pmp$exit (stat);
                    ELSE
                      pmp$long_term_wait (icf_interval, icf_interval);
                      CYCLE /receive_loop/;
                    IFEND;
                  ELSE
                    fatal := TRUE;
                    osp$disestablish_cond_handler;
                    pmp$exit (stat);
                  IFEND;
                ELSE
                  icp$set_status_abnormal (stat);
                  fatal := TRUE;
                  osp$disestablish_cond_handler;
                  pmp$exit (stat);
                CASEND;
              IFEND;
            WHILEND /flpi_loop_1/;

            IF (last_op.req = mlc$receive_message_req) AND
                  (last_op.stat_condition = mlc$receive_list_index_invalid)
                  THEN

            /fetchrl_loop/
              WHILE TRUE DO
                mlp$fetch_receive_list (icf_file^.application_name,
                      icf_file^.partner_id.application_name, frl_list,
                      frl_count, stat);
                IF (stat.normal) OR (stat.condition = mlc$ok) THEN
                  IF frl_count <> 0 THEN
                    CYCLE /receive_loop/;
                  ELSE
                    amp$set_file_instance_abnormal
                          (icf_file^.file_id, ice$read_deadlock, operation, '',
                          status);
                    fatal := TRUE;
                    RETURN;
                  IFEND;
                ELSE
                  CASE stat.condition OF
                  = mlc$busy_interlock =
                    pmp$wait (icf_short_interval, icf_short_interval);
                    CYCLE /fetchrl_loop/;
                  ELSE
                    icp$set_status_abnormal (stat);
                    fatal := TRUE;
                    osp$disestablish_cond_handler;
                    pmp$exit (stat);
                  CASEND;
                IFEND;
              WHILEND /fetchrl_loop/;
            ELSE
              pmp$long_term_wait (icf_interval, icf_interval);
              CYCLE /receive_loop/;
            IFEND;
          ELSE
            fatal := TRUE;
            osp$disestablish_cond_handler;
            pmp$exit (stat);
          CASEND;
        IFEND;
      WHILEND /receive_loop/;
      zero_length_record := (message_length = 0);
      buff_in := message_length;
      buff_out := 0;
      unused_bits := arbitrary_info DIV 16;
      eoi := arbitrary_info MOD 16 >= 8;
      eop := arbitrary_info MOD 8 >= 4;
      first_message := arbitrary_info MOD 4 >= 2;
      last_message := arbitrary_info MOD 2 >= 1;
      osp$disestablish_cond_handler;

    PROCEND receiver;

{  Body of icp$get.

    status.normal := TRUE;
    IF icf_file^.position = amc$eoi THEN
      amp$set_file_instance_abnormal (icf_file^.file_id, ame$input_after_eoi,
            operation, '', status);
      RETURN;
    IFEND;
    IF NOT icf_file^.opened_for_get THEN
      amp$set_file_instance_abnormal (icf_file^.file_id,
            ame$improper_input_attempt, operation, '', status);
      RETURN;
    IFEND;
    signal := ^signal_record;
    offset := 0;
    zero_length_record := FALSE;
    IF icf_file^.buff = NIL THEN
      ALLOCATE icf_file^.buff IN osv$task_private_heap^;
    IFEND;
    IF (operation = amc$get_next_req) OR (operation = amc$get_direct_req) OR
          ((operation = amc$get_partial_req) AND
          (skip_option = amc$skip_to_eor)) THEN

      icf_file^.record_length := 0;
      first_message := FALSE;

{  Skip past any partial records until the beginning of a record
{  is found.

    /repeat_loop_1/
      REPEAT
        receiver;
        IF fatal THEN
          RETURN;
        IFEND;
      UNTIL first_message; {/REPEAT_LOOP_1/}
    IFEND;

{  Transfer data from the buffer until the end of a record is reached
{  or the user's record area is filled.  Call procedure 'receiver' to
{  fill or replenish the buffer as needed.

  /repeat_loop_2/
    WHILE TRUE DO
      IF (buff_out >= buff_in) AND (offset < wsa_length) AND
            (NOT zero_length_record) THEN
        receiver;
        IF fatal THEN
          RETURN;
        IFEND;
      IFEND;
      IF (offset <= wsa_length) AND (buff_out < buff_in) THEN
        IF (wsa_length - offset) < (buff_in - buff_out) THEN
          p3 := (wsa_length - offset);
        ELSE
          p3 := (buff_in - buff_out);
        IFEND;
        p1 := i#ptr (buff_out, icf_file^.buff); {source}
        p2 := i#ptr (offset, working_storage_area); {destination}
        i#move (p1, p2, p3);
        offset := offset + p3;
        buff_out := buff_out + p3;
      IFEND;
      IF (offset >= wsa_length) OR ((buff_out >= buff_in) AND (last_message))
            THEN
        EXIT /repeat_loop_2/;
      IFEND;
    WHILEND /repeat_loop_2/;
    transfer_count^ := offset;
    icf_file^.record_length := icf_file^.record_length + offset;

{  Store file position information.

    IF last_message THEN
      IF eoi THEN
        icf_file^.position := amc$eoi;
      ELSEIF eop THEN
        icf_file^.position := amc$eop;
      ELSEIF buff_out < buff_in THEN
        icf_file^.position := amc$mid_record;
      ELSE
        icf_file^.position := amc$eor;
        icf_file^.last_length := icf_file^.record_length;
      IFEND;
    ELSE
      icf_file^.position := amc$mid_record;
    IFEND;
  PROCEND icp$get;

MODEND icm$get;
