?? RIGHT := 110 ??
?? NEWTITLE := ' NOS/VE File Server : Test Remote Procedure Call ', EJECT ??
MODULE dfm$test_remote_procedure_call;

{
{  Purpose:  This module contains code used to test the remote procedure call
{            interfaces.  The command test_remote_procedure_call is provided
{            to allow testing all remote procedure call options.

?? NEWTITLE := ' Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clp$get_value
*copyc clp$scan_command_line
*copyc clp$scan_parameter_list
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfp$delete_client_rpc_segment
*copyc dfp$receive_server_rpc_segment
*copyc dfp$reserve_server_rpc_segment
*copyc dfp$compute_checksum
*copyc dfp$crack_mainframe_id
*copyc dfp$get_test_queue_location
*copyc dfp$page_count
*copyc dfp$receive_client_rpc_segment
*copyc dfp$send_client_rpc_segment
*copyc dfp$send_remote_procedure_call
*copyc dfp$touch_pages
*copyc dft$procedure_address_ordinal
*copyc dft$rpc_buffer_header
*copyc dft$rpc_parameters
*copyc dpp$put_next_line
*copyc dpv$system_core_display
*copyc i#build_adaptable_seq_pointer
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc mmv$max_segment_length
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc osp$system_error
*copyc pmp$get_mainframe_id
*copyc pmp$log_ascii
*copyc pmp$zero_out_table
?? POP ??
*copyc dft$rpc_test_request_header

?? TITLE := '  Client: [XDCL] dfp$test_remote_procedure_call ', EJECT ??

  PROCEDURE [XDCL] dfp$test_remote_procedure_call
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt test_remote_rpc_call_pdt       (
{ queue_identifier, qid: name  = current
{ send_buffer_size, sbs: integer 0 .. dfc$maximum_test_request_buffer = 333
{ send_data_size, sds: integer 0 .. dfc$maximum_user_data_area = 0
{ receive_buffer_size, rbs: integer 0 .. dfc$maximum_test_request_buffer = 77
{ receive_data_size, rds: integer 0 .. dfc$maximum_user_data_area = 0
{ receive_segment_size, rss: integer 0 .. osc$max_segment_length = 0
{ receive_segment_offset, rso: integer 0 .. osc$max_segment_length = 0
{ send_segment_size, sss: integer 0 .. osc$max_segment_length = 0
{ send_segment_offset, sso: integer 0 .. osc$max_segment_length = 0
{ request_restartable, rr: boolean = true
{ allowed_when_server_deactivated, awsd: boolean = false
{ compute_checksum, cc: boolean = true
{ repeat_count, rc: integer 1 .. 10000000 = 1
{ status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    test_remote_rpc_call_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
  ^test_remote_rpc_call_pdt_names, ^test_remote_rpc_call_pdt_params];

  VAR
    test_remote_rpc_call_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 27] of
  clt$parameter_name_descriptor := [['QUEUE_IDENTIFIER', 1], ['QID', 1], ['SEND_BUFFER_SIZE', 2], ['SBS', 2],
  ['SEND_DATA_SIZE', 3], ['SDS', 3], ['RECEIVE_BUFFER_SIZE', 4], ['RBS', 4], ['RECEIVE_DATA_SIZE', 5], ['RDS'
  , 5], ['RECEIVE_SEGMENT_SIZE', 6], ['RSS', 6], ['RECEIVE_SEGMENT_OFFSET', 7], ['RSO', 7], [
  'SEND_SEGMENT_SIZE', 8], ['SSS', 8], ['SEND_SEGMENT_OFFSET', 9], ['SSO', 9], ['REQUEST_RESTARTABLE', 10], [
  'RR', 10], ['ALLOWED_WHEN_SERVER_DEACTIVATED', 11], ['AWSD', 11], ['COMPUTE_CHECKSUM', 12], ['CC', 12], [
  'REPEAT_COUNT', 13], ['RC', 13], ['STATUS', 14]];

  VAR
    test_remote_rpc_call_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 14] of
  clt$parameter_descriptor := [

{ QUEUE_IDENTIFIER QID }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$name_value, 1, osc$max_name_size]],

{ SEND_BUFFER_SIZE SBS }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, dfc$maximum_test_request_buffer]],

{ SEND_DATA_SIZE SDS }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, dfc$maximum_user_data_area]],

{ RECEIVE_BUFFER_SIZE RBS }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, dfc$maximum_test_request_buffer]],

{ RECEIVE_DATA_SIZE RDS }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv5], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, dfc$maximum_user_data_area]],

{ RECEIVE_SEGMENT_SIZE RSS }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv6], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, osc$max_segment_length]],

{ RECEIVE_SEGMENT_OFFSET RSO }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv7], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, osc$max_segment_length]],

{ SEND_SEGMENT_SIZE SSS }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv8], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, osc$max_segment_length]],

{ SEND_SEGMENT_OFFSET SSO }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv9], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 0, osc$max_segment_length]],

{ REQUEST_RESTARTABLE RR }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv10], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$boolean_value]],

{ ALLOWED_WHEN_SERVER_DEACTIVATED AWSD }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv11], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$boolean_value]],

{ COMPUTE_CHECKSUM CC }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv12], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$boolean_value]],

{ REPEAT_COUNT RC }
    [[clc$optional_with_default, ^test_remote_rpc_call_pdt_dv13], 1, 1, 1, 1, clc$value_range_not_allowed,
  [NIL, clc$integer_value, 1, 10000000]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
  clc$array_not_allowed, clc$status_value]]];

  VAR
    test_remote_rpc_call_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := 'current';

  VAR
    test_remote_rpc_call_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := '333';

  VAR
    test_remote_rpc_call_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    test_remote_rpc_call_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '77';

  VAR
    test_remote_rpc_call_pdt_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    test_remote_rpc_call_pdt_dv6: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    test_remote_rpc_call_pdt_dv7: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    test_remote_rpc_call_pdt_dv8: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    test_remote_rpc_call_pdt_dv9: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    test_remote_rpc_call_pdt_dv10: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

  VAR
    test_remote_rpc_call_pdt_dv11: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';

  VAR
    test_remote_rpc_call_pdt_dv12: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

  VAR
    test_remote_rpc_call_pdt_dv13: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '1';

?? FMT (FORMAT := ON) ??
?? POP ??

?? NEWTITLE := 'dfp$remote_procedure_call_ch', EJECT ??

{ PURPOSE:
{   This procedure is a condition handler established to call a routine to clear the assignment of a task
{   services queue_entry if a task aborts with a queue_entry assigned to it.  The queue_entry must be clear
{   before the task can safely exit.

    PROCEDURE dfp$remote_procedure_call_ch
      (    condition: pmt$condition;
           cond_desc: ^pmt$condition_information;
           save: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      dfp$ch_cleanup;
      osp$set_status_from_condition (dfc$file_server_id, condition, save, status, handler_status);
      EXIT dfp$test_remote_procedure_call;

    PROCEND dfp$remote_procedure_call_ch;
*block
*copyc dfp$begin_ch_remote_proc_call
*copyc dfp$end_ch_remote_proc_call
*blockend
?? OLDTITLE, EJECT ??
    VAR
      allowed_when_server_deactivated: boolean,
      begin_time: integer,
      checksum: integer,
      compute_checksum: boolean,
      end_time: integer,
      first_char: char,
      local_status: ost$status,
      p_queue_interface_table: ^dft$queue_interface_table,
      p_receive_buffer: dft$p_receive_parameters,
      p_receive_data: dft$p_receive_data,
      p_receive_string: ^string ( * ),
      p_send_buffer: dft$p_send_parameters,
      p_send_data: dft$p_send_data,
      p_send_string: ^string ( * ),
      p_test_request_header: ^dft$rpc_test_request_header,
      page_count: ost$non_negative_integers,
      p_receive_segment: ^SEQ ( * ),
      p_send_segment: ^SEQ ( * ),
      procedure_ordinal: dft$procedure_address_ordinal,
      queue_entry_location: dft$rpc_queue_entry_location,
      queue_index: dft$queue_index,
      receive_buffer_size: dft$send_parameter_size,
      receive_data_size: dft$send_data_size,
      receive_segment_size: ost$segment_length,
      receive_segment_offset: ost$segment_length,
      repeat_count: integer,
      request_restartable: boolean,
      segment_pointer: amt$segment_pointer,
      send_buffer_size: dft$send_parameter_size,
      send_count: integer,
      send_data_size: dft$send_data_size,
      send_end_time: integer,
      send_segment_checksum: integer,
      send_segment_size: ost$segment_length,
      send_segment_offset: ost$segment_length,
      send_segment_pointer: amt$segment_pointer,
      send_start_time: integer,
      server_location: dft$server_location,
      total_bytes_transferred: integer,
      value: clt$value;

{ Crack parameters.

    clp$scan_parameter_list (parameter_list, test_remote_rpc_call_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('QUEUE_IDENTIFIER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.name.value = 'CURRENT' THEN
      dfp$get_test_queue_location (p_queue_interface_table, queue_index);
      server_location.server_location_selector := dfc$mainframe_id;
      server_location.server_mainframe := p_queue_interface_table^.queue_directory.
            cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header.
            destination_mainframe_name;
{ ???
    ELSEIF value.name.value (1, 7) = '$SYSTEM' THEN

{ Assume its a mainframe name.

      server_location.server_location_selector := dfc$mainframe_id;
      server_location.server_mainframe := value.name.value (1, 17);
    ELSE { family name
      server_location.server_location_selector := dfc$family_name;
      server_location.family_name := value.name.value;
    IFEND;

    clp$get_value ('SEND_BUFFER_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    send_buffer_size := value.int.value;

    clp$get_value ('RECEIVE_BUFFER_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    receive_buffer_size := value.int.value;

    clp$get_value ('SEND_DATA_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    send_data_size := value.int.value;

    clp$get_value ('RECEIVE_DATA_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    receive_data_size := value.int.value;

    clp$get_value ('RECEIVE_SEGMENT_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    receive_segment_size := value.int.value;
    clp$get_value ('RECEIVE_SEGMENT_OFFSET', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    receive_segment_offset := value.int.value;
    IF receive_segment_size > 0 THEN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      i#build_adaptable_seq_pointer (#RING (segment_pointer.sequence_pointer),
            #SEGMENT (segment_pointer.sequence_pointer), receive_segment_offset,
            { Length } mmv$max_segment_length - receive_segment_offset, { Next } 0, p_receive_segment);
      RESET p_receive_segment;
    IFEND;

    clp$get_value ('SEND_SEGMENT_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    send_segment_size := value.int.value;
    clp$get_value ('SEND_SEGMENT_OFFSET', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    send_segment_offset := value.int.value;
    IF send_segment_size > 0 THEN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, send_segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_send_segment := send_segment_pointer.sequence_pointer;
      RESET p_send_segment;
    IFEND;

    clp$get_value ('REQUEST_RESTARTABLE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    request_restartable := value.bool.value;

    clp$get_value ('ALLOWED_WHEN_SERVER_DEACTIVATED', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    allowed_when_server_deactivated := value.bool.value;

    clp$get_value ('COMPUTE_CHECKSUM', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    compute_checksum := value.bool.value;
    IF compute_checksum THEN
      first_char := $CHAR (((send_buffer_size + send_data_size) MOD 10) + 1);
    ELSE
      first_char := $CHAR (0);
    IFEND;

    clp$get_value ('REPEAT_COUNT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    repeat_count := value.int.value;
    IF  (repeat_count > 1) AND (send_segment_size > 1) THEN
      osp$set_status_abnormal (dfc$file_server_id,  dfe$test_startup_error,
         ' send_segment_size > 1 not supported with repeat_count', status);
      RETURN;
    IFEND;

    begin_time := #FREE_RUNNING_CLOCK (0);
    dfp$begin_ch_remote_proc_call (server_location, allowed_when_server_deactivated, queue_entry_location,
          p_send_buffer, p_send_data, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Fill send segment

    send_segment_checksum := 0;
    IF send_segment_size > 0 THEN
      IF compute_checksum THEN
{ Turn off range checking to allow nexting huge string
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
        NEXT p_send_string: [send_segment_size] IN p_send_segment;
        fill_test_data (p_send_string, send_segment_size, first_char);
        dfp$compute_checksum (p_send_string, send_segment_size,
              send_segment_checksum);
{ Turn on range checking
?? POP ??
      ELSE
        dfp$touch_pages (p_send_segment, send_segment_size, page_count);
      IFEND;
      RESET p_send_segment;
      send_start_time := #FREE_RUNNING_CLOCK (0);
      dfp$send_client_rpc_segment (queue_entry_location, p_send_segment,
          send_segment_offset, send_segment_size, status);
      send_end_time := #FREE_RUNNING_CLOCK (0);
      IF NOT status.normal THEN
        display (' ABNORMAL STATUS FROM dfp$send_client_rpc_segment ');
        dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
        RETURN;
      IFEND;
      display_integer ('  Send_segment bytes per second = ', (1000000 * send_segment_size) DIV
          (send_end_time - send_start_time));
    IFEND;

    IF compute_checksum THEN
      pmp$zero_out_table (p_send_buffer, #SIZE (p_send_buffer^));
      pmp$zero_out_table (p_send_data, #SIZE (p_send_data^));
    IFEND;
    NEXT p_test_request_header IN p_send_buffer;
    p_test_request_header^.start_time := begin_time;
    p_test_request_header^.compute_checksum := compute_checksum;
    p_test_request_header^.send_buffer_size := send_buffer_size;
    p_test_request_header^.receive_buffer_size := receive_buffer_size;
    p_test_request_header^.send_buffer_starting_char := first_char;
    p_test_request_header^.send_data_size := send_data_size;
    p_test_request_header^.receive_data_size := receive_data_size;
    p_test_request_header^.receive_segment_size := receive_segment_size;
    p_test_request_header^.receive_segment_offset := receive_segment_offset;
    p_test_request_header^.segment_starting_char := first_char;
    p_test_request_header^.send_segment_size := send_segment_size;
    p_test_request_header^.send_segment_offset := send_segment_offset;
    p_test_request_header^.send_segment_starting_char := first_char;
    p_test_request_header^.send_segment_checksum := send_segment_checksum;
{ Fill test buffer

    IF send_buffer_size > 0 THEN
      NEXT p_send_string: [send_buffer_size] IN p_send_buffer;
      IF compute_checksum THEN
        fill_test_data (p_send_string, send_buffer_size, first_char);
        dfp$compute_checksum (p_send_string, send_buffer_size, p_test_request_header^.buffer_checksum);
      ELSE
        p_test_request_header^.buffer_checksum := 0;
      IFEND;
    IFEND;

{ Fill test data

    p_test_request_header^.data_starting_char := first_char;
    IF send_data_size > 0 THEN
      IF compute_checksum THEN
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
        NEXT p_send_string: [send_data_size] IN p_send_data;
        fill_test_data (p_send_string, send_data_size, first_char);
        dfp$compute_checksum (p_send_string, send_data_size, p_test_request_header^.data_checksum);
?? POP ??
      ELSE
        dfp$touch_pages (p_send_data, send_data_size, page_count);
        p_test_request_header^.data_checksum := 0;
      IFEND;
    IFEND;


    IF request_restartable THEN
      procedure_ordinal := dfc$rpc_restartable_test;
    ELSE
      procedure_ordinal := dfc$rpc_unrestartable_test;
    IFEND;

    send_start_time := #FREE_RUNNING_CLOCK (0);

{ Call the server

    FOR send_count := 1 TO repeat_count DO
      dfp$send_remote_procedure_call (queue_entry_location, procedure_ordinal, send_buffer_size +
            #SIZE (dft$rpc_test_request_header), send_data_size, p_receive_buffer, p_receive_data, status);
      IF NOT status.normal THEN
        display (' ABNORMAL STATUS FROM dfp$send_remote_procedure_call ');
        dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
        RETURN;
      IFEND;
    FOREND;
    send_end_time := #FREE_RUNNING_CLOCK (0);

{ Check receive buffer

    NEXT p_test_request_header IN p_receive_buffer;
    IF p_test_request_header^.start_time <> begin_time THEN
      display_integer ('CLIENT - TIME MISMATCH ', begin_time);
      display_integer ('CLIENT - RECEIVE TIME ', p_test_request_header^.start_time);
    IFEND;
    IF (receive_buffer_size > 0) THEN
      IF compute_checksum THEN
        NEXT p_receive_string: [receive_buffer_size] IN p_receive_buffer;
        dfp$compute_checksum (p_receive_string, receive_buffer_size, checksum);
        IF checksum <> p_test_request_header^.buffer_checksum THEN
          display ('CLIENT - RECEIVE BUFFER CHECKSUM MISMATCH ');
        IFEND;
        read_test_data (p_receive_string, receive_buffer_size,
              p_test_request_header^.send_buffer_starting_char, status);
        IF NOT status.normal THEN
          display ('CLIENT - RECEIVE BUFFER DATA MISMATCH ');
          display_status (status);
        IFEND;
      IFEND;
    IFEND;

{ Check receive data

    IF (receive_data_size > 0) THEN
      IF compute_checksum THEN
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
        NEXT p_receive_string: [receive_data_size] IN p_receive_data;
        dfp$compute_checksum (p_receive_string, receive_data_size, checksum);
        IF checksum <> p_test_request_header^.data_checksum THEN
          display ('CLIENT - DATA CHECKSUM MISMATCH ');
        IFEND;
        read_test_data (p_receive_string, receive_data_size, p_test_request_header^.data_starting_char,
              status);
        IF NOT status.normal THEN
          display ('CLIENT - DATA MISMATCH ');
          display_status (status);
        IFEND;
?? POP ??
      IFEND;
    IFEND;

{ Check receive segment

    IF (receive_segment_size > 0) THEN
      dfp$receive_server_rpc_segment (queue_entry_location, receive_segment_offset, receive_segment_size,
            p_receive_segment, status);
      IF NOT status.normal THEN
        display ('CLIENT - COULD NOT RECEIVE SEGMENT');
        display_status (status);
      IFEND;
      IF status.normal AND compute_checksum THEN
        RESET p_receive_segment;
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
        NEXT p_receive_string: [receive_segment_size] IN p_receive_segment;
        dfp$compute_checksum (p_receive_string, receive_segment_size, checksum);
        IF checksum <> p_test_request_header^.segment_checksum THEN
          display ('CLIENT - SEGMENT CHECKSUM MISMATCH ');
        IFEND;
        read_test_data (p_receive_string, receive_segment_size, p_test_request_header^.segment_starting_char,
              status);
        IF NOT status.normal THEN
          display ('CLIENT - SEGMENT MISMATCH ');
          display_status (status);
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (segment_pointer, local_status);
?? POP ??
    IFEND;

    dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
    IF NOT local_status.normal THEN
      display (' dfp$end_ch_remote_proc_call');
      display_status (local_status);
    IFEND;
    end_time := #FREE_RUNNING_CLOCK (0);
    total_bytes_transferred := repeat_count * (send_buffer_size + receive_buffer_size + send_data_size +
          receive_data_size) + receive_segment_size;
    display_integer ('   Total user bytes transferred = ', total_bytes_transferred);
    display_integer ('   Bytes per second = ', (1000000 * total_bytes_transferred) DIV
          (send_end_time - send_start_time));
  PROCEND dfp$test_remote_procedure_call;
?? TITLE := ' Server : [XDCL] dfp$receive_test_rpc ', EJECT ??

{ This procedure is the server side of the procedure dfp$test_remote_procedure_call.
{ This verified the parameters if requests, and sends back any buffer, data, or segment
{ requested.

  PROCEDURE [XDCL] dfp$receive_test_rpc
    (VAR p_param_received_from_client {Input} : dft$p_receive_parameters;
     VAR p_data_from_client {Input} : dft$p_receive_data;
     VAR p_send_to_client_params {^Output} : dft$p_send_parameters;
     VAR p_data_to_client {^Output} : dft$p_send_data;
     VAR send_parameters_length: dft$send_parameter_size;
     VAR data_size_to_send_to_client: dft$send_data_size;
     VAR status: ost$status);

    VAR
      checksum: integer,
      p_client_segment: ^SEQ ( * ),
      p_receive_segment: ^SEQ ( * ),
      p_receive_string: ^string ( * ),
      p_receive_test_rpc_header: ^dft$rpc_test_request_header,
      p_send_string: ^string ( * ),
      p_send_test_rpc_header: ^dft$rpc_test_request_header;

    status.normal := TRUE;
    NEXT p_receive_test_rpc_header IN p_param_received_from_client;

    IF p_receive_test_rpc_header^.compute_checksum THEN
      pmp$zero_out_table (p_send_to_client_params, #SIZE (p_send_to_client_params^));
      pmp$zero_out_table (p_data_to_client, #SIZE (p_data_to_client^));
    IFEND;

{ Verify receive buffer

    IF p_receive_test_rpc_header^.send_buffer_size > 0 THEN
      NEXT p_receive_string: [p_receive_test_rpc_header^.send_buffer_size] IN p_param_received_from_client;
      IF p_receive_test_rpc_header^.compute_checksum THEN
        dfp$compute_checksum (p_receive_string, p_receive_test_rpc_header^.send_buffer_size, checksum);
        IF checksum <> p_receive_test_rpc_header^.buffer_checksum THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$test_checksum_error,
                'SERVER - RECEIVE BUFFER CHECKSUM', status);
          RETURN;
        IFEND;
        read_test_data (p_receive_string, p_receive_test_rpc_header^.send_buffer_size,
              p_receive_test_rpc_header^.send_buffer_starting_char, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

{ Verify receive data

    IF p_receive_test_rpc_header^.send_data_size > 0 THEN
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
      NEXT p_receive_string: [p_receive_test_rpc_header^.send_data_size] IN p_data_from_client;
      IF p_receive_test_rpc_header^.compute_checksum THEN
        dfp$compute_checksum (p_receive_string, p_receive_test_rpc_header^.send_data_size, checksum);
        IF checksum <> p_receive_test_rpc_header^.data_checksum THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$test_checksum_error,
                'SERVER- RECEIVE DATA CHECKSUM', status);
          RETURN;
        IFEND;
        read_test_data (p_receive_string, p_receive_test_rpc_header^.send_data_size,
              p_receive_test_rpc_header^.data_starting_char, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
?? POP ??
    IFEND;

{ Verify segment sent from client

    IF p_receive_test_rpc_header^.send_segment_size > 0 THEN
      dfp$receive_client_rpc_segment (p_client_segment, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Turn of range checking to allow working with data as huge string.
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
      IF p_receive_test_rpc_header^.send_segment_offset > 0 THEN
        { Advance the sequence so the data is received at the correct offset.
        NEXT p_receive_string: [p_receive_test_rpc_header^.send_segment_offset] IN p_client_segment;
      IFEND;
      NEXT p_receive_string: [p_receive_test_rpc_header^.send_segment_size] IN p_client_segment;
      IF p_receive_test_rpc_header^.compute_checksum THEN
        dfp$compute_checksum (p_receive_string, p_receive_test_rpc_header^.send_segment_size, checksum);
        IF checksum <> p_receive_test_rpc_header^.send_segment_checksum THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$test_checksum_error,
                'SERVER- SEND SEGMENT CHECKSUM', status);
          dfp$delete_client_rpc_segment;
          RETURN;
        IFEND;
        read_test_data (p_receive_string, p_receive_test_rpc_header^.send_segment_size,
              p_receive_test_rpc_header^.send_segment_starting_char, status);
        IF NOT status.normal THEN
          dfp$delete_client_rpc_segment;
          RETURN;
        IFEND;
      IFEND;
      dfp$delete_client_rpc_segment;
{ Turn on range checking.
?? POP ??
    IFEND;


{ Initialize send test header.

    NEXT p_send_test_rpc_header IN p_send_to_client_params;
    p_send_test_rpc_header^.start_time := p_receive_test_rpc_header^.start_time;
    p_send_test_rpc_header^.compute_checksum := p_receive_test_rpc_header^.compute_checksum;
    p_send_test_rpc_header^.send_buffer_size := p_receive_test_rpc_header^.receive_buffer_size;
    p_send_test_rpc_header^.receive_buffer_size := p_receive_test_rpc_header^.send_buffer_size;
    p_send_test_rpc_header^.send_buffer_starting_char := p_receive_test_rpc_header^.send_buffer_starting_char;
    p_send_test_rpc_header^.send_data_size := p_receive_test_rpc_header^.receive_data_size;
    p_send_test_rpc_header^.receive_data_size := p_receive_test_rpc_header^.send_data_size;
    p_send_test_rpc_header^.receive_segment_size := p_receive_test_rpc_header^.receive_segment_size;
    p_send_test_rpc_header^.receive_segment_offset := p_receive_test_rpc_header^.receive_segment_offset;
    p_send_test_rpc_header^.segment_starting_char := p_receive_test_rpc_header^.segment_starting_char;
    p_send_test_rpc_header^.segment_checksum := p_receive_test_rpc_header^.segment_checksum;

    send_parameters_length := p_receive_test_rpc_header^.receive_buffer_size +
          #SIZE (dft$rpc_test_request_header);

{ Generate send buffer

    IF p_receive_test_rpc_header^.receive_buffer_size > 0 THEN
      NEXT p_send_string: [p_receive_test_rpc_header^.receive_buffer_size] IN p_send_to_client_params;
      IF p_receive_test_rpc_header^.compute_checksum THEN
        fill_test_data (p_send_string, p_receive_test_rpc_header^.receive_buffer_size,
              p_send_test_rpc_header^.send_buffer_starting_char);
        dfp$compute_checksum (p_send_string, p_receive_test_rpc_header^.receive_buffer_size,
              p_send_test_rpc_header^.buffer_checksum);
      ELSE
        p_send_test_rpc_header^.buffer_checksum := 0;
      IFEND;
    IFEND;

{ Generate send data

    data_size_to_send_to_client := p_receive_test_rpc_header^.receive_data_size;
    p_send_test_rpc_header^.data_starting_char := p_receive_test_rpc_header^.data_starting_char;
    IF p_receive_test_rpc_header^.receive_data_size > 0 THEN
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
      NEXT p_send_string: [p_receive_test_rpc_header^.receive_data_size] IN p_data_to_client;
      IF p_receive_test_rpc_header^.compute_checksum THEN
        fill_test_data (p_send_string, p_receive_test_rpc_header^.receive_data_size,
              p_send_test_rpc_header^.data_starting_char);
        dfp$compute_checksum (p_send_string, p_receive_test_rpc_header^.receive_data_size,
              p_send_test_rpc_header^.data_checksum);
      ELSE
        p_send_string^ := '';
        p_send_test_rpc_header^.data_checksum := 0;
      IFEND;
?? POP ??
    IFEND;

{ Generate send segment

    IF p_receive_test_rpc_header^.receive_segment_size > 0 THEN
      dfp$reserve_server_rpc_segment (p_receive_segment, status);
      IF status.normal THEN
        IF p_receive_test_rpc_header^.receive_segment_offset > 0 THEN
          i#build_adaptable_seq_pointer (#RING (p_receive_segment), #SEGMENT (p_receive_segment),
                p_receive_test_rpc_header^.receive_segment_offset,
                { Length } mmv$max_segment_length - p_receive_test_rpc_header^.receive_segment_offset,
                { Next (relative to offset) } 0, p_receive_segment);
        IFEND;
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
        NEXT p_send_string: [p_receive_test_rpc_header^.receive_segment_size] IN p_receive_segment;
        IF p_receive_test_rpc_header^.compute_checksum THEN
          fill_test_data (p_send_string, p_receive_test_rpc_header^.receive_segment_size,
                p_send_test_rpc_header^.segment_starting_char);
          dfp$compute_checksum (p_send_string, p_receive_test_rpc_header^.receive_segment_size,
                p_send_test_rpc_header^.segment_checksum);
        ELSE

{ No need to touch the pages since they need not be wired

          p_send_test_rpc_header^.segment_checksum := 0;
        IFEND;
?? POP ??
      IFEND;
    IFEND;
  PROCEND dfp$receive_test_rpc;
?? TITLE := '   Client : [XDCL] dfp$send_remote_command_line ', EJECT ??

  PROCEDURE [XDCL] dfp$send_remote_command_line
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ pdt send_rcl_pdt (server_mainframe_id, smid: name 17 = $required
{   statement_list, sl: string = $required
{   PRIVILEGE,p: key current_job, system_job = system_job
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      send_rcl_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^send_rcl_pdt_names, ^send_rcl_pdt_params];

    VAR
      send_rcl_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
            clt$parameter_name_descriptor := [['SERVER_MAINFRAME_ID', 1], ['SMID', 1], ['STATEMENT_LIST', 2],
            ['SL', 2], ['PRIVILEGE', 3], ['P', 3], ['STATUS', 4]];

    VAR
      send_rcl_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor := [

{ SERVER_MAINFRAME_ID SMID

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 17, 17]],

{ STATEMENT_LIST SL

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$string_value, 0, osc$max_string_size]],

{ PRIVILEGE P

      [[clc$optional_with_default, ^send_rcl_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^send_rcl_pdt_kv3, clc$keyword_value]],

{ STATUS

      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

    VAR
      send_rcl_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of
            ost$name := ['CURRENT_JOB', 'SYSTEM_JOB'];

    VAR
      send_rcl_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (10) := 'system_job';

?? POP ??

?? NEWTITLE := 'dfp$remote_procedure_call_ch', EJECT ??

{ PURPOSE:
{   This procedure is a condition handler established to call a routine to clear the assignment of a task
{   services queue_entry if a task aborts with a queue_entry assigned to it.  The queue_entry must be clear
{   before the task can safely exit.

    PROCEDURE dfp$remote_procedure_call_ch
      (    condition: pmt$condition;
           cond_desc: ^pmt$condition_information;
           save: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      dfp$ch_cleanup;
      osp$set_status_from_condition (dfc$file_server_id, condition, save, status, handler_status);
      EXIT dfp$send_remote_command_line;

    PROCEND dfp$remote_procedure_call_ch;
*block
*copyc dfp$begin_ch_remote_proc_call
*copyc dfp$end_ch_remote_proc_call
*blockend
?? OLDTITLE, EJECT ??
    VAR
      local_status: ost$status,
      mainframe_id: pmt$binary_mainframe_id,
      p_receive_buffer: dft$p_receive_parameters,
      p_receive_data: dft$p_receive_data,
      p_send_buffer: dft$p_send_parameters,
      p_send_data: dft$p_send_data,
      p_send_string: ^string ( * ),
      procedure_ordinal: dft$procedure_address_ordinal,
      queue_entry_location: dft$rpc_queue_entry_location,
      server_location: dft$server_location,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, send_rcl_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    server_location.server_location_selector := dfc$mainframe_id;
    dfp$crack_mainframe_id ('SERVER_MAINFRAME_ID', server_location.server_mainframe, mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('PRIVILEGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.name.value = 'CURRENT_JOB' THEN
      procedure_ordinal := dfc$send_remote_cl_current;
    ELSE { SYSTEM_JOB
      procedure_ordinal := dfc$send_remote_cl_system;
    IFEND;

    clp$get_value ('STATEMENT_LIST', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$begin_ch_remote_proc_call (server_location, FALSE, queue_entry_location, p_send_buffer, p_send_data,
          status);
    IF status.normal THEN
      NEXT p_send_string: [value.str.size] IN p_send_buffer;
      p_send_string^ := value.str.value (1, value.str.size);

      dfp$send_remote_procedure_call (queue_entry_location, procedure_ordinal, #SIZE (p_send_string^), 0,
            p_receive_buffer, p_receive_data, status);
      dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
    IFEND;
  PROCEND dfp$send_remote_command_line;
?? TITLE := ' Server : [XDCL] dfp$receive_remote_command_line ', EJECT ??

  PROCEDURE [XDCL] dfp$receive_remote_command_line
    (VAR p_param_received_from_client {input} : dft$p_receive_parameters;
     VAR p_data_from_client {input} : dft$p_receive_data;
     VAR p_send_to_client_params {^output} : dft$p_send_parameters;
     VAR p_data_to_client: dft$p_send_data;
     VAR send_parameters_length: dft$send_parameter_size;
     VAR data_size_to_send_to_client: dft$send_data_size;
     VAR status: ost$status);

    VAR
      p_string: ^string ( * );

    send_parameters_length := 0;
    data_size_to_send_to_client := 0;

    NEXT p_string: [#SIZE (p_param_received_from_client^)] IN p_param_received_from_client;

    clp$scan_command_line (p_string^, status);
  PROCEND dfp$receive_remote_command_line;
?? TITLE := '  Client : [XDCL] dfp$send_remote_message ', EJECT ??

  PROCEDURE [XDCL] dfp$send_remote_message
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ pdt send_remote_message_pdt (server_mainframe_id, smid: name 17 = $required
{  message, m : string = $required
{  status)

?? PUSH (LISTEXT := ON) ??

    VAR
      send_remote_message_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^send_remote_message_pdt_names, ^send_remote_message_pdt_params];

    VAR
      send_remote_message_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
            clt$parameter_name_descriptor := [['SERVER_MAINFRAME_ID', 1], ['SMID', 1], ['MESSAGE', 2],
            ['M', 2], ['STATUS', 3]];

    VAR
      send_remote_message_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of
            clt$parameter_descriptor := [

{ SERVER_MAINFRAME_ID SMID

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 17, 17]],

{ MESSAGE M

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$string_value, 0, osc$max_string_size]],

{ STATUS

      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

?? POP ??

?? NEWTITLE := 'dfp$remote_procedure_call_ch', EJECT ??

{ PURPOSE:
{   This procedure is a condition handler established to call a routine to clear the assignment of a task
{   services queue_entry if a task aborts with a queue_entry assigned to it.  The queue_entry must be clear
{   before the task can safely exit.

    PROCEDURE dfp$remote_procedure_call_ch
      (    condition: pmt$condition;
           cond_desc: ^pmt$condition_information;
           save: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      dfp$ch_cleanup;
      osp$set_status_from_condition (dfc$file_server_id, condition, save, status, handler_status);
      EXIT dfp$send_remote_message;

    PROCEND dfp$remote_procedure_call_ch;
*block
*copyc dfp$begin_ch_remote_proc_call
*copyc dfp$end_ch_remote_proc_call
*blockend
?? OLDTITLE, EJECT ??
    VAR
      client_mainframe: pmt$mainframe_id,
      local_status: ost$status,
      mainframe_id: pmt$binary_mainframe_id,
      p_receive_buffer: dft$p_receive_parameters,
      p_receive_data: dft$p_receive_data,
      p_send_buffer: dft$p_send_parameters,
      p_send_data: dft$p_send_data,
      p_send_string: ^string ( * ),
      queue_entry_location: dft$rpc_queue_entry_location,
      server_location: dft$server_location,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, send_remote_message_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    server_location.server_location_selector := dfc$mainframe_id;
    dfp$crack_mainframe_id ('SERVER_MAINFRAME_ID', server_location.server_mainframe, mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$begin_ch_remote_proc_call (server_location, FALSE, queue_entry_location, p_send_buffer, p_send_data,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('MESSAGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
      RETURN;
    IFEND;

    NEXT p_send_string: [#SIZE (server_location.server_mainframe) + 2] IN p_send_buffer;
    pmp$get_mainframe_id (client_mainframe, local_status);
    p_send_string^ := client_mainframe;
    NEXT p_send_string: [value.str.size] IN p_send_buffer;
    p_send_string^ := value.str.value (1, value.str.size);
    dfp$send_remote_procedure_call (queue_entry_location, dfc$send_remote_message, { Buffer Size}
          #SIZE (p_send_string^) + #SIZE (server_location.server_mainframe) + 2, { Data size} 0,
          p_receive_buffer, p_receive_data, status);
    dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
  PROCEND dfp$send_remote_message;
?? TITLE := ' Server : [XDCL] dfp$receive_remote_message ', EJECT ??

  PROCEDURE [XDCL] dfp$receive_remote_message
    (VAR p_param_received_from_client {input} : dft$p_receive_parameters;
     VAR p_data_from_client {input} : dft$p_receive_data;
     VAR p_send_to_client_params {^output} : dft$p_send_parameters;
     VAR p_data_to_client: dft$p_send_data;
     VAR send_parameters_length: dft$send_parameter_size;
     VAR data_size_to_send_to_client: dft$send_data_size;
     VAR status: ost$status);

    VAR
      p_string: ^string ( * );

    send_parameters_length := 0;
    data_size_to_send_to_client := 0;

    NEXT p_string: [#SIZE (p_param_received_from_client^)] IN p_param_received_from_client;
    dpp$put_next_line (dpv$system_core_display, p_string^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pmp$log_ascii (p_string^, $pmt$ascii_logset [pmc$system_log, pmc$job_log], pmc$msg_origin_program,
          status);

  PROCEND dfp$receive_remote_message;
?? TITLE := '  fill_test_data', EJECT ??

?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??

  PROCEDURE fill_test_data
    (    p_string: ^string ( * );
         char_count: integer;
         first_char: char);

    VAR
      count: integer,
      fill_char: char;

    fill_char := first_char;

  /fill_data/
    FOR count := 1 TO char_count DO
      p_string^ (count) := fill_char;
      IF $INTEGER (fill_char) < 255 THEN
        fill_char := $CHAR ($INTEGER (fill_char) + 1);
      ELSE
        fill_char := $CHAR (0);
      IFEND;
    FOREND /fill_data/;

  PROCEND fill_test_data;
?? POP ??
?? TITLE := '  read_test_data', EJECT ??
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??

  PROCEDURE read_test_data
    (    p_string: ^string ( * );
         char_count: integer;
         first_char: char;
     VAR status: ost$status);

    VAR
      count: integer,
      fill_char: char;

    status.normal := TRUE;
    fill_char := first_char;

  /check_data/
    FOR count := 1 TO char_count DO
      IF p_string^ (count) <> fill_char THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$test_checksum_error, 'DATA MISMATCH', status);
        RETURN;
      IFEND;
      IF $INTEGER (fill_char) < 255 THEN
        fill_char := $CHAR ($INTEGER (fill_char) + 1);
      ELSE
        fill_char := $CHAR (0);
      IFEND;
    FOREND /check_data/;

  PROCEND read_test_data;
?? POP ??
MODEND dfm$test_remote_procedure_call;

