?? RIGHT := 110 ??
?? TITLE := 'NOS/VE File Server : Client : Remote Core Call' ??
MODULE dfm$client_remote_core_call;
{
{   This module contains the client side of the remote procedure call
{   processing provided for system core.  This module very closely  resembles
{   DFM$CLIENT_REMOTE_PROCEDUR_CALL and changes in both modules should be
{   made in tandom.  On the server side the core calls still go through
{   processing in DFM$SERVER_REMOTE_PROCEDUR_CALL.
{
{   The system core remote procedure call mechanism is
{   different than the standard remote procedure call mechanism in that:
{   - Only served family table index may be specified for server location.
{   - No data movement is provided.
{   - Since there is no data movement there is no need to restart requests.
{   - All procedure checksums and versions use the same value.
{   - Waiting is different - pmp$cycle or pmp$delay is used.
{
?? NEWTITLE := '  Global Declarations Referenced by this module' ??
?? PUSH (LISTEXT := ON) ??
*copyc dfc$remote_core_call
*copyc dfc$test_jr_constants
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dfe$error_condition_codes
*copyc dfk$keypoints
*copyc dft$cpu_queue
*copyc dft$procedure_version
*copyc dft$rpc_buffer_header
*copyc dft$rpc_parameters
*copyc dft$rpc_queue_entry_location
*copyc dft$rpc_queue_entry_loc_int
*copyc dft$served_family_table_index
*copyc ost$status
?? POP ??
?? EJECT ??
*copyc dfp$await_core_subsystem_action
*copyc dfp$clear_driver_flags
*copyc dfp$convert_queue_entry_loc
*copyc dfp$fetch_queue_entry
*copyc dfp$fetch_served_family_info
*copyc dfp$get_qit_p_from_direct_index
*copyc dfp$get_queue_directory_index
*copyc dfp$get_system_core_queue_entry
*copyc dfp$queue_client_core_request
*copyc dfp$release_task_queue_entry
*copyc dfp$set_invalid_family_index
*copyc dfp$validate_rpc_status
*copyc dfp$word_boundary
*copyc dfv$send_command_flags
*copyc i#current_sequence_position
*copyc osp$set_status_abnormal
*copyc pmp$get_executing_task_gtid
*copyc pmp$get_job_names
*copyc osp$begin_system_activity
*copyc osp$end_system_activity
*copyc syp$core_hang_if_system_jrt_set
?? TITLE := '  Global Declarations Declared by this module', EJECT ??

?? TITLE := ' [XDCL, #GATE] dfp$begin_remote_core_call', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$begin_remote_core_call
    (    server_location: dft$served_family_table_index;
         allowed_when_server_deactivated: boolean;
     VAR queue_entry_location: dft$rpc_queue_entry_location;
     VAR p_send_to_server_params: dft$p_send_parameters;
     VAR status: ost$status);

    VAR
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_send_buffer_header: ^dft$buffer_header,
      p_send_rpc_buffer_header: ^dft$rpc_buffer_header,
      queue_entry_loc_int: dft$rpc_queue_entry_loc_int;

    #KEYPOINT (osk$entry, osk$m * $INTEGER (allowed_when_server_deactivated),
          dfk$begin_remote_procedure_call);

    locate_server (server_location, p_queue_interface_table, queue_entry_loc_int, status);
    IF status.normal THEN
      p_cpu_queue_header := ^p_queue_interface_table^.queue_directory.cpu_queue_pva_directory
           [queue_entry_loc_int.queue_index].p_cpu_queue^.queue_header;
      IF (p_cpu_queue_header^.partner_status.server_state = dfc$active) OR
       ((p_cpu_queue_header^.partner_status.server_state = dfc$deactivated) AND
         allowed_when_server_deactivated) THEN
        osp$begin_system_activity;
      ELSE
        dfp$set_terminated_status (p_queue_interface_table, queue_entry_loc_int.queue_index,
            status);
      IFEND;
      IF status.normal THEN
        dfp$get_system_core_queue_entry (p_queue_interface_table, queue_entry_loc_int.queue_index,
              queue_entry_loc_int.queue_entry_index, p_driver_queue_entry, p_cpu_queue_entry, status);
        IF status.normal THEN
          syp$core_hang_if_system_jrt_set (dfc$tjr_begin_core_rpc);
          {  Construct pointer to  user part of send buffer area .
          RESET p_cpu_queue_entry^.p_send_buffer;
          NEXT p_send_buffer_header IN p_cpu_queue_entry^.p_send_buffer;
          NEXT p_send_rpc_buffer_header IN p_cpu_queue_entry^.p_send_buffer;
          NEXT p_send_to_server_params IN p_cpu_queue_entry^.p_send_buffer;
          RESET p_send_to_server_params;
          p_cpu_queue_entry^.maximum_data_sent := 0;
          p_cpu_queue_entry^.maximum_data_received := 0;
          dfp$convert_qel_int_to_ext (queue_entry_loc_int, queue_entry_location);
        ELSE
          osp$end_system_activity;
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      #KEYPOINT (osk$exit, osk$m * queue_entry_loc_int.queue_entry_index, dfk$begin_remote_procedure_call);
    ELSE
      #KEYPOINT (osk$exit, 0, dfk$begin_remote_procedure_call);
    IFEND;
  PROCEND dfp$begin_remote_core_call;
?? TITLE := ' [XDCL, #GATE] dfp$end_remote_core_call ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$end_remote_core_call
    (    queue_entry_location: dft$rpc_queue_entry_location;
     VAR status: ost$status);

    VAR
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_entry_loc_int: dft$rpc_queue_entry_loc_int;

    dfp$convert_qel_ext_to_int (queue_entry_location, queue_entry_loc_int);
    #KEYPOINT (osk$entry, osk$m * queue_entry_loc_int.queue_entry_index, dfk$end_remote_procedure_call);
    dfp$get_qit_p_from_direct_index (queue_entry_loc_int.queue_directory_index, p_queue_interface_table);
    syp$core_hang_if_system_jrt_set (dfc$tjr_end_core_rpc);
    dfp$release_task_queue_entry (p_queue_interface_table, queue_entry_loc_int.queue_index,
          queue_entry_loc_int.queue_entry_index, status);
    osp$end_system_activity;
    #KEYPOINT (osk$exit, 0, dfk$end_remote_procedure_call);

  PROCEND dfp$end_remote_core_call;
?? TITLE := ' [XDCL, #GATE] dfp$send_remote_core_call ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$send_remote_core_call
    (    queue_entry_location: dft$rpc_queue_entry_location;
         procedure_ordinal: dft$procedure_address_ordinal;
         send_to_server_params_size: dft$send_parameter_size;
     VAR p_receive_from_server_params: dft$p_receive_parameters;
     VAR status: ost$status);

    VAR
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_entry_loc_int: dft$rpc_queue_entry_loc_int;

    #KEYPOINT (osk$entry, osk$m * $INTEGER (procedure_ordinal), dfk$send_remote_procedure_call);
    dfp$convert_qel_ext_to_int (queue_entry_location, queue_entry_loc_int);
    dfp$get_qit_p_from_direct_index (queue_entry_loc_int.queue_directory_index, p_queue_interface_table);
    dfp$fetch_queue_entry (p_queue_interface_table, queue_entry_loc_int.queue_index,
          queue_entry_loc_int.queue_entry_index, p_driver_queue_entry, p_cpu_queue_entry);

    send_remote_core_call (p_queue_interface_table, queue_entry_loc_int.queue_index,
          queue_entry_loc_int.queue_entry_index, p_cpu_queue_entry, p_driver_queue_entry, procedure_ordinal,
          send_to_server_params_size, p_receive_from_server_params, status);

    #KEYPOINT (osk$exit, 0, dfk$send_remote_procedure_call);

  PROCEND dfp$send_remote_core_call;
?? TITLE := ' initialize_rpc_send ', EJECT ??

  PROCEDURE initialize_rpc_send
    (    procedure_ordinal: dft$procedure_address_ordinal;
         p_cpu_queue_entry: ^dft$cpu_queue_entry;
         p_send_buffer_header: ^dft$buffer_header;
         p_send_rpc_buffer_header: ^dft$rpc_buffer_header;
         user_parameter_size: dft$send_parameter_size);

    VAR
      ignore_status: ost$status,
      user_supplied_name: jmt$user_supplied_name;

    { Initialize standard buffer header
    p_send_buffer_header^.version := dfc$rpc_request_buffer_version;
    p_send_buffer_header^.remote_processor := procedure_ordinal;
    p_send_buffer_header^.data_length_sent := 0;

    { Initialize remote procedure call buffer header
    pmp$get_job_names (user_supplied_name, p_send_rpc_buffer_header^.system_supplied_job_name, ignore_status);
    p_send_rpc_buffer_header^.procedure_version := dfc$system_core_version;
    p_send_rpc_buffer_header^.procedure_name_checksum := dfc$system_core_checksum;
    p_send_rpc_buffer_header^.procedure_class := dfc$system_core_call;

    { Initialize rpc progress record
    p_send_rpc_buffer_header^.call_progress.transaction_per_rpc_request := 0;
    p_send_rpc_buffer_header^.call_progress.total_data_sent := 0;
    p_send_rpc_buffer_header^.call_progress.total_data_received := 0;
    p_send_rpc_buffer_header^.call_progress.user_buffer_length_sent := user_parameter_size;
    p_send_rpc_buffer_header^.call_progress.user_data_length_sent := 0;

    { Initialize cpu queue entry
    pmp$get_executing_task_gtid (p_cpu_queue_entry^.global_task_id);
    p_cpu_queue_entry^.call_progress := p_send_rpc_buffer_header^.call_progress;
    p_cpu_queue_entry^.total_data_to_receive := 0;
  PROCEND initialize_rpc_send;
?? TITLE := ' locate_server ', EJECT ??

  PROCEDURE locate_server
    (    served_family_table_index: dft$served_family_table_index;
     VAR p_queue_interface_table: dft$p_queue_interface_table;
     VAR queue_entry_loc_int: dft$rpc_queue_entry_loc_int;
     VAR status: ost$status);

    VAR
      family: ost$family_name,
      family_found: boolean,
      server_state: dft$server_state;

    dfp$fetch_served_family_info (served_family_table_index, family,
          queue_entry_loc_int.server_mainframe_id, p_queue_interface_table, queue_entry_loc_int.queue_index,
          family_found);
    IF NOT family_found THEN
      dfp$set_invalid_family_index (served_family_table_index, 'DFP$BEGIN_REMOTE_CORE_CALL',
            status);
    IFEND;
    IF p_queue_interface_table = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$family_not_served, ' Family deleted ', status);
    IFEND;

    IF status.normal THEN
      dfp$get_queue_directory_index (p_queue_interface_table, queue_entry_loc_int.queue_directory_index);
    IFEND;
  PROCEND locate_server;
?? TITLE := ' send_remote_core_call ', EJECT ??

  PROCEDURE send_remote_core_call
    (    p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
         queue_entry_index: dft$queue_entry_index;
         p_cpu_queue_entry: ^dft$cpu_queue_entry;
         p_driver_queue_entry: ^dft$driver_queue_entry;
         procedure_ordinal: dft$procedure_address_ordinal;
         send_to_server_params_size: dft$send_parameter_size;
     VAR p_receive_from_server_params: dft$p_receive_parameters;
     VAR status: ost$status);

    VAR
      p_receive_rpc_buffer_header: ^dft$rpc_response_buffer_header,
      p_send_buffer_header: ^dft$buffer_header,
      p_send_rpc_buffer_header: ^dft$rpc_buffer_header;

    p_receive_from_server_params := NIL;
    RESET p_cpu_queue_entry^.p_send_buffer;
    NEXT p_send_buffer_header IN p_cpu_queue_entry^.p_send_buffer;
    NEXT p_send_rpc_buffer_header IN p_cpu_queue_entry^.p_send_buffer;
    initialize_rpc_send (procedure_ordinal, p_cpu_queue_entry, p_send_buffer_header, p_send_rpc_buffer_header,
          send_to_server_params_size);
    send_request_to_server (p_queue_interface_table, queue_index, queue_entry_index, p_cpu_queue_entry,
          p_driver_queue_entry, send_to_server_params_size, p_send_buffer_header, p_send_rpc_buffer_header,
          p_receive_rpc_buffer_header, status);
    IF status.normal THEN
        IF p_receive_rpc_buffer_header^.call_progress.user_buffer_length_sent > 0 THEN
          NEXT p_receive_from_server_params: [[REP p_receive_rpc_buffer_header^.call_progress.
                user_buffer_length_sent OF cell]] IN p_cpu_queue_entry^.p_receive_buffer;
        IFEND;
    IFEND;
  PROCEND send_remote_core_call;
?? TITLE := ' send_request_to_server ', EJECT ??

  PROCEDURE send_request_to_server
    (    p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
         queue_entry_index: dft$queue_entry_index;
         p_cpu_queue_entry: ^dft$cpu_queue_entry;
         p_driver_queue_entry: ^dft$driver_queue_entry;
         send_to_server_params_size: dft$send_parameter_size;
         p_send_buffer_header: ^dft$buffer_header;
         p_send_rpc_buffer_header: ^dft$rpc_buffer_header;
     VAR p_receive_rpc_buffer_header: ^dft$rpc_response_buffer_header;
     VAR status: ost$status);

    p_driver_queue_entry^.data_descriptor.actual_length := 0;
    p_send_buffer_header^.data_length_sent := 0;
    p_send_buffer_header^.buffer_length_sent := dfp$word_boundary
          (#SIZE (dft$buffer_header) + #SIZE (dft$rpc_buffer_header) + send_to_server_params_size);

    { Initialize cpu queue entry
    p_cpu_queue_entry^.retransmission_count := 0;
    p_cpu_queue_entry^.transaction_count := p_cpu_queue_entry^.transaction_count + 1;
    { Update call progress
    p_cpu_queue_entry^.call_progress.transaction_per_rpc_request :=
          p_cpu_queue_entry^.call_progress.transaction_per_rpc_request + 1;

    { Complete initialization standard buffer header
    p_send_buffer_header^.transaction_count := p_cpu_queue_entry^.transaction_count;
    p_send_buffer_header^.retransmission_count := 0;
    { Complete Initialization  Remote procedure call header
    p_send_rpc_buffer_header^.call_progress := p_cpu_queue_entry^.call_progress;

    p_driver_queue_entry^.send_buffer_descriptor.actual_length := p_send_buffer_header^.buffer_length_sent;
    p_driver_queue_entry^.flags := dfv$send_command_flags;
    dfp$queue_client_core_request (p_queue_interface_table, queue_index, queue_entry_index, status);
    syp$core_hang_if_system_jrt_set (dfc$tjr_send_core_rpc);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    dfp$await_core_subsystem_action (p_driver_queue_entry);
    dfp$clear_driver_flags (p_driver_queue_entry);
    dfp$validate_rpc_status (p_cpu_queue_entry, p_receive_rpc_buffer_header, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    p_cpu_queue_entry^.total_data_to_receive := 0;
  PROCEND send_request_to_server;
MODEND dfm$client_remote_core_call;
