?? RIGHT := 110 ??
?? TITLE := 'NOS/VE: IIM$XT_XTERM_FAP' ??
?? NEWTITLE := 'XREF TYPES' ??
MODULE iim$xt_xterm_fap;
?? PUSH (LISTEXT := ON) ??
*copyc amt$fap_declarations
*copyc amt$call_block
*copyc ifc$interrupt
*copyc iic$xt_compiling_for_trace
*copyc ost$caller_identifier
*copyc ost$i_wait
*copyc ost$status
?? TITLE := 'CONDITION_CODES', EJECT ??
*copyc ame$device_class_validation
*copyc nae$application_interfaces
*copyc nae$namve_conditions
?? POP ??
?? TITLE := 'XREF PROCEDURES', EJECT ??
*copyc amp$set_file_instance_abnormal
*copyc bap$close
*copyc bap$fetch
*copyc bap$fetch_access_information
*copyc bap$store
*copyc iip$xt_open_file
*copyc iip$xt_close_file
*copyc iip$xt_fetch_attributes
*copyc iip$xt_receive_data
*copyc iip$xt_send_data
*copyc iip$xt_send_interrupt
*copyc iip$xt_synchronize
*copyc iip$xt_synchronize_confirm
*copyc iip$xt_store_attributes
*copyc iip$xt_write_trace
*copyc iip$xt_write_trace_status
*copyc iiv$xt_xterm_control_block
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$establish_condition_handler
*copyc osp$i_await_activity_completion
*copyc osp$set_status_abnormal
*copyc pmp$continue_to_cause
*copyc pmp$get_executing_task_gtid
*copyc pmp$long_term_wait
?? TITLE := 'iip$xt_xterm_fap', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_xterm_fap
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer: amt$fap_layer_number;
     VAR status: ost$status);

    PROCEDURE terminate_network_fap
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);


      PROCEDURE process_block_exit
        (    condition: pmt$condition;
             ignore_condition_descriptor: ^pmt$condition_information;
             sa: ^ost$stack_frame_save_area;
         VAR condition_status: ost$status);

        CASE call_block.operation OF
        = amc$get_next_req, amc$get_partial_req, nac$se_receive_data_req =

          IF (status.normal) AND ((call_block.operation <> nac$se_receive_data_req) OR
                ((call_block.operation = nac$se_receive_data_req) AND
                (call_block.se_receive_data_req.wait = osc$wait))) THEN
            WHILE NOT activity_status^.complete DO
              pmp$long_term_wait (wait_time, 0);
            WHILEND;
          IFEND;
        = amc$put_next_req, amc$put_partial_req, nac$se_send_data_req =

          IF (status.normal) AND ((call_block.operation <> nac$se_send_data_req) OR
                ((call_block.operation = nac$se_send_data_req) AND
                (call_block.se_send_data_req.wait = osc$wait))) THEN
            WHILE NOT activity_status^.complete DO
              pmp$long_term_wait (wait_time, 0);
            WHILEND;
          IFEND;
        ELSE
        CASEND;

      PROCEND process_block_exit;

      CASE condition.selector OF
      = ifc$interactive_condition =
        IF request_started THEN
          osp$establish_block_exit_hndlr (^process_block_exit);
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        IF request_started THEN
          osp$disestablish_cond_handler;
        IFEND;
        condition_status.normal := TRUE;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          CASE call_block.operation OF
          = amc$get_next_req, amc$get_partial_req, nac$se_receive_data_req =
            osp$set_status_abnormal (nac$status_id, nae$job_recovery, '', status);
            pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
            EXIT iip$xt_xterm_fap;
          = amc$put_next_req, amc$put_partial_req, nac$se_send_data_req =
            osp$set_status_abnormal (nac$status_id, nae$job_recovery, '', status);
            pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
            EXIT iip$xt_xterm_fap;
          ELSE
            ;
          CASEND;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      CASEND;
    PROCEND terminate_network_fap;

    PROCEDURE terminate_await_data_available
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IF (condition.selector = ifc$interactive_condition) AND
            (condition.interactive_condition = ifc$interrupt) THEN
        osp$set_status_abnormal (nac$status_id, nae$interactive_cond_interrupt, '', status);
        EXIT iip$xt_xterm_fap;
      IFEND;
    PROCEND terminate_await_data_available;
?? EJECT ??

    CONST
      nac$wait_to_receive_increment = 2000,
      nac$wait_to_send_increment = 2000;

    VAR
      activity_status: ^ost$activity_status,
      caller_id: ost$caller_identifier,
      end_time: integer,
      global_task_id: ost$global_task_id,
      ignore_structure_pointer: ^cell,
      ready_index: integer,
      request_started: boolean,
      start_time: integer,
      validation_ok: boolean,
      wait_list: array [1 .. 2] of ost$i_activity,
      wait_time: nat$wait_time;

    status.normal := TRUE;
    #CALLER_ID (caller_id);

    CASE call_block.operation OF

    = amc$open_req =
      iip$xt_open_file (file_identifier, layer, call_block, status);

    = amc$close_req =
      iip$xt_close_file (file_identifier, layer, call_block, status);
      bap$close (file_identifier, status);

    = amc$fetch_access_information_rq =
      bap$fetch_access_information (file_identifier, call_block, layer, status);

    = amc$fetch_req =
      bap$fetch (file_identifier, call_block, layer, status);

    = amc$store_req =
      bap$store (file_identifier, call_block, layer, status);

    = amc$get_next_req, amc$get_partial_req, nac$se_receive_data_req =
      IF call_block.operation = nac$se_receive_data_req THEN
        activity_status := call_block.se_receive_data_req.activity_status;
      ELSE
        PUSH activity_status;
        IF call_block.operation = amc$get_next_req THEN
          call_block.getn.byte_address^ := 0;
        ELSE
          call_block.getp.byte_address^ := 0;
        IFEND;
      IFEND;
      activity_status^.complete := TRUE;
      activity_status^.status.normal := TRUE;

      request_started := FALSE;
      start_time := #FREE_RUNNING_CLOCK (0);
      osp$establish_condition_handler (^terminate_network_fap, FALSE);
      iip$xt_receive_data (file_identifier, layer, call_block, start_time, request_started, wait_time,
            activity_status, status);
      WHILE (status.normal AND NOT request_started AND NOT activity_status^.complete) DO
        end_time := #FREE_RUNNING_CLOCK (0);
        IF wait_time > ((end_time - start_time) DIV 1000) THEN
          wait_time := wait_time - ((end_time - start_time) DIV 1000);
          IF wait_time > nac$wait_to_receive_increment THEN
            pmp$long_term_wait (nac$wait_to_receive_increment, 0);
          ELSE
            pmp$long_term_wait (wait_time, 0);
          IFEND;
          iip$xt_receive_data (file_identifier, layer, call_block, start_time, request_started, wait_time,
                activity_status, status);
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$data_transfer_timeout, '', status);
        IFEND;
      WHILEND;

    = amc$put_next_req, amc$put_partial_req, nac$se_send_data_req =
      IF call_block.operation = nac$se_send_data_req THEN
        activity_status := call_block.se_send_data_req.activity_status;
      ELSE
        PUSH activity_status;
        IF call_block.operation = amc$put_next_req THEN
          call_block.putn.byte_address^ := 0;
        ELSE
          call_block.putp.byte_address^ := 0;
        IFEND;
      IFEND;
      activity_status^.complete := TRUE;
      activity_status^.status.normal := TRUE;

      request_started := FALSE;
      start_time := #FREE_RUNNING_CLOCK (0);
      osp$establish_condition_handler (^terminate_network_fap, FALSE);
      iip$xt_send_data (file_identifier, layer, call_block, start_time, request_started, wait_time,
            activity_status, status);

    = nac$se_synchronize_req =
      iip$xt_synchronize (file_identifier, layer, call_block, status);

    = nac$se_synchronize_confirm_req =
      iip$xt_synchronize_confirm (file_identifier, layer, call_block, status);

    = nac$await_data_available =
      iip$xt_write_trace (' Begin await_data_available');
      IF iiv$xt_xterm_control_block.xterm_state >= iic$execute_xterm_task THEN
        pmp$get_executing_task_gtid (global_task_id);
        IF global_task_id = iiv$xt_xterm_control_block.xterm_global_task_id THEN
          osp$set_status_abnormal (nac$status_id, nae$no_data_available, '', status);
        ELSE
          wait_list [1].activity := nac$i_await_data_available;
          wait_list [1].file_identifier := file_identifier;
          wait_list [2].activity := osc$i_await_time;
          wait_list [2].milliseconds := call_block.await_data_available.wait_time;
          osp$establish_condition_handler (^terminate_await_data_available, FALSE);
          osp$i_await_activity_completion (wait_list, ready_index, status);
          IF (status.normal) AND (ready_index = 2) THEN
            osp$set_status_abnormal (nac$status_id, nae$no_data_available, '', status);
          IFEND;
        IFEND;
      IFEND;

      IF status.normal THEN
        iip$xt_write_trace (' Exit await_data_available');
      ELSE
        iip$xt_write_trace_status (' await_data_available failed', status);
      IFEND;

    = nac$fetch_attributes =
      iip$xt_fetch_attributes (file_identifier, layer, call_block, status);

    = nac$store_attributes =
      iip$xt_store_attributes (file_identifier, layer, call_block, status);

    = amc$flush_req, amc$rewind_req, amc$skip_req, amc$write_end_partition_req =
      ; {ignore request (return normal status)
    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$improper_device_class, call_block.operation,
            'CALL_BLOCK ERROR - iip$xt_xterm_fap', status);
    CASEND;

  PROCEND iip$xt_xterm_fap;

MODEND iim$xt_xterm_fap;

