?? RIGHT := 110 ??
?? TITLE := ' NOS/VE File Server : Test Application Support - Ring 3', EJECT ??
MODULE dfm$test_app_sup_r3;

{ PURPOSE:
{   The purpose of this module is to provide a ring 3 procedure which uses the
{   application support interface dfp$send_remote_app. It is for local testing
{   called by (RAMBO5) and may not be transmitted.

?? NEWTITLE := ' Global Declarations ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dft$server_state
*copyc dft$rpc_parameters
*copyc pmt$mainframe_id
*copyc pmt$program_name
?? POP ??
*copyc clp$evaluate_parameters
*copyc dfp$send_application_rpc
*copyc dfp$verify_system_administrator
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$get_mainframe_id

  TYPE
    { NOTE: This type is also defined/used in dfm$test_application_support.
    send_header_record = record
      client_send_buffer_size: integer,
      client_send_data_size: integer,
      client_receive_buffer_size: integer,
      client_receive_data_size: integer,
      server_delay_count: integer,
      client_send_first_char: char,
      client_mainframe_id: pmt$mainframe_id,
    recend;

?? TITLE := '  NOS/VE File Server : Client: [XDCL, #GATE] dfp$client_test_app_sup_r3 ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$client_test_app_sup_r3
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{         procedure client       (
{          family_name, family, fn,f: name = testing
{          send_size, ss: integer = 200
{          receive_size, rs: integer = 2000
{          use_data_area, uda, ud: key
{              send, s
{              receive, r
{              both, b
{              none, n
{              keyend = both
{          remote_procedure_name: program_name = dfp$server_test_app_support
{          application_name, an: name = doit_app
{          allowed_when_server_deactivated, awsd: boolean = false
{          compute_checksum, cc: boolean = true
{          repeat_count, rc: integer = 1
{          server_delay_count, sdc: integer = 0 "seconds"
{          status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 23] of clt$pdt_parameter_name,
      parameters: array [1 .. 11] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
        default_value: string (7),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (4),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 8] of clt$keyword_specification,
        default_value: string (4),
      recend,
      type5: record
        header: clt$type_specification_header,
        default_value: string (27),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
        default_value: string (8),
      recend,
      type7: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type8: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type10: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (11),
      recend,
      type11: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 5, 15, 10, 50, 853],
    clc$command, 23, 11, 0, 0, 0, 0, 11, ''], [
    ['ALLOWED_WHEN_SERVER_DEACTIVATED',clc$nominal_entry, 7],
    ['AN                             ',clc$abbreviation_entry, 6],
    ['APPLICATION_NAME               ',clc$nominal_entry, 6],
    ['AWSD                           ',clc$abbreviation_entry, 7],
    ['CC                             ',clc$abbreviation_entry, 8],
    ['COMPUTE_CHECKSUM               ',clc$nominal_entry, 8],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FAMILY                         ',clc$alias_entry, 1],
    ['FAMILY_NAME                    ',clc$nominal_entry, 1],
    ['FN                             ',clc$alias_entry, 1],
    ['RC                             ',clc$abbreviation_entry, 9],
    ['RECEIVE_SIZE                   ',clc$nominal_entry, 3],
    ['REMOTE_PROCEDURE_NAME          ',clc$nominal_entry, 5],
    ['REPEAT_COUNT                   ',clc$nominal_entry, 9],
    ['RS                             ',clc$abbreviation_entry, 3],
    ['SDC                            ',clc$abbreviation_entry, 10],
    ['SEND_SIZE                      ',clc$nominal_entry, 2],
    ['SERVER_DELAY_COUNT             ',clc$nominal_entry, 10],
    ['SS                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 11],
    ['UD                             ',clc$abbreviation_entry, 4],
    ['UDA                            ',clc$alias_entry, 4],
    ['USE_DATA_AREA                  ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 2
    [17, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 4
    [23, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 5
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 27],
{ PARAMETER 6
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 7
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 8
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 9
    [14, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 10
    [18, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 11],
{ PARAMETER 11
    [20, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size],
    'testing'],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '200'],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '2000'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [8], [
    ['B                              ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['BOTH                           ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['N                              ', clc$nominal_entry, clc$normal_usage_entry, 8],
    ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 7],
    ['R                              ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['RECEIVE                        ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['S                              ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['SEND                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'both'],
{ PARAMETER 5
    [[1, 0, clc$program_name_type],
    'dfp$server_test_app_support'],
{ PARAMETER 6
    [[1, 0, clc$name_type], [1, osc$max_name_size],
    'doit_app'],
{ PARAMETER 7
    [[1, 0, clc$boolean_type],
    'false'],
{ PARAMETER 8
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 9
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '1'],
{ PARAMETER 10
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '0 "seconds"'],
{ PARAMETER 11
    [[1, 0, clc$status_type]]];

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

    CONST
      p$family_name = 1,
      p$send_size = 2,
      p$receive_size = 3,
      p$use_data_area = 4,
      p$remote_procedure_name = 5,
      p$application_name = 6,
      p$allowed_when_server_deactivat = 7 {ALLOWED_WHEN_SERVER_DEACTIVATED} ,
      p$compute_checksum = 8,
      p$repeat_count = 9,
      p$server_delay_count = 10,
      p$status = 11;

    VAR
      pvt: array [1 .. 11] of clt$parameter_value;

?? 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$client_test_app_sup_r3;

    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
      application: ost$name,
      allowed_when_server_deactivated: boolean,
      compute_checksum: boolean,
      family: ost$name,
      first_char: char,
      i: integer,
      line: string (200),
      line_size: integer,
      local_status: ost$status,
      proc_name: pmt$program_name,
      repeat_count: integer,
      send_size: dft$send_data_size,
      server_location: dft$server_location,
      receive_size: dft$send_data_size,
      p_data: ^SEQ ( * ),
      p_receive_buffer: ^SEQ ( * ),
      p_receive_data: ^SEQ ( * ),
      p_receive_string: ^string ( * ),
      p_send_buffer: dft$p_send_parameters,
      p_send_data: dft$p_send_data,
      p_send_header: ^send_header_record,
      p_send_string: ^string ( * ),
      queue_entry_location: dft$rpc_queue_entry_location,
      receive_buffer_size: dft$send_parameter_size,
      receive_data_size: 0 .. dfc$maximum_user_data_area,
      returned_buffer_size: 0 .. dfc$maximum_user_buffer_area,
      returned_data_size: 0 .. dfc$maximum_user_data_area,
      send_buffer_size: dft$send_parameter_size,
      send_data_size: dft$send_data_size,
      ud: char;

    status.normal := TRUE;
    local_status.normal := TRUE;

    dfp$verify_system_administrator ('DFP$CLIENT_TEST_APP_SUP_R3', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Crack parameters.

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    family := pvt [p$family_name].value^.name_value;
    allowed_when_server_deactivated := pvt [p$allowed_when_server_deactivat].value^.
          boolean_value.value;
    compute_checksum := pvt [p$compute_checksum].value^.boolean_value.value;
    server_location.server_location_selector := dfc$family_name;
    server_location.family_name := family;

    send_size := pvt [p$send_size].value^.integer_value.value;
    receive_size := pvt [p$receive_size].value^.integer_value.value;
    ud := pvt [p$use_data_area].value^.keyword_value (1);
    proc_name := pvt [p$remote_procedure_name].value^.name_value;
    application := pvt [p$application_name].value^.name_value;
    repeat_count := pvt [p$repeat_count].value^.integer_value.value;
    first_char := $CHAR (((send_size + receive_size) MOD 10) + 1);
    p_data := NIL;
    p_send_data := NIL;

    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;

   /begin_remote_proc_call/
    BEGIN

      NEXT p_send_header IN p_send_buffer;

    CASE ud OF
    = 'S' =
      p_send_header^.client_send_buffer_size := #SIZE (send_header_record);
      p_send_header^.client_send_data_size := send_size;
      p_send_header^.client_receive_buffer_size := receive_size;
      p_send_header^.client_receive_data_size := 0;
    = 'R' =
      p_send_header^.client_send_buffer_size := #SIZE (send_header_record) + send_size;
      p_send_header^.client_send_data_size := 0;
      p_send_header^.client_receive_buffer_size := 0;
      p_send_header^.client_receive_data_size := receive_size;
      NEXT p_data: [[REP send_size OF cell]] IN p_send_buffer;
    = 'B' =
      p_send_header^.client_send_buffer_size := #SIZE (send_header_record);
      p_send_header^.client_send_data_size := send_size;
      p_send_header^.client_receive_buffer_size := 0;
      p_send_header^.client_receive_data_size := receive_size;

    = 'N' =
      p_send_header^.client_send_buffer_size := #SIZE (send_header_record) + send_size;
      p_send_header^.client_send_data_size := 0;
      p_send_header^.client_receive_buffer_size := receive_size;
      p_send_header^.client_receive_data_size := 0;
      NEXT p_data: [[REP send_size OF cell]] IN p_send_buffer;
    ELSE
      display (' OPTION of use_data_area not implemented');
      EXIT /begin_remote_proc_call/;
    CASEND;

    p_send_header^.client_send_first_char := first_char;
    p_send_header^.server_delay_count := pvt [p$server_delay_count].value^.integer_value.
         value;
    pmp$get_mainframe_id (p_send_header^.client_mainframe_id, status);
    IF NOT status.normal THEN
      EXIT /begin_remote_proc_call/;
    IFEND;

{ Turn off range checking to allow nexting huge string
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
    IF p_send_data <> NIL THEN
      RESET p_send_data;
      NEXT p_send_string: [send_size] IN p_send_data;
    ELSEIF p_data <> NIL THEN
      RESET p_data;
      NEXT p_send_string: [send_size] IN p_data;
    IFEND;
    fill_test_data (p_send_string, send_size, first_char);
{ Turn on range checking
?? POP ??

    send_buffer_size := p_send_header^.client_send_buffer_size;
    send_data_size :=  p_send_header^.client_send_data_size;

    STRINGREP (line, line_size, ' Sending RPC request. APPL=', application, ' PROC=', proc_name);
    display (line (1, line_size));
/doit/
    FOR i := 1 TO repeat_count DO

      dfp$send_application_rpc (queue_entry_location, application, proc_name,
            send_buffer_size, send_data_size, p_receive_buffer, p_receive_data, status);

      IF NOT status.normal THEN
        display (' ABNORMAL STATUS FROM dfp$send_application_rpc');
        display_status (status);
        exit /doit/;
      ELSE
        IF i = repeat_count THEN
          display (' NORMAL status from RPC call.');
        IFEND;
      IFEND;
      { Process receive buffer

{ Turn off range checking to allow nexting huge string
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
      IF p_receive_data <> NIL THEN
        NEXT p_receive_string: [receive_size] IN p_receive_data;
      ELSE
        NEXT p_receive_string: [receive_size] IN p_receive_buffer;
      IFEND;
      read_test_data (p_receive_string, receive_size, first_char, status);
{ Turn on range checking
?? POP ??
      IF NOT status.normal THEN
        display (' Client -  data mismatch');
        display_status (status);
        EXIT /begin_remote_proc_call/;
      IFEND;

    FOREND /doit/;

    END /begin_remote_proc_call/;

    dfp$end_ch_remote_proc_call (queue_entry_location, local_status);

  PROCEND dfp$client_test_app_sup_r3;
?? 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_app_sup_r3;



