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

{ PURPOSE:
{   The purpose of this module is to supply test a client and a server procedure
{   to test the application support feature.
{ NOTES:
{   1. These are test procedures for local development testing only.
{   2. The server procedure is also called from dfp$client_test_app_sup_r3.

?? NEWTITLE := ' Global Declarations ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfc$client_pause_break
*copyc dfc$client_terminate_break
*copyc dfe$error_condition_codes
*copyc dft$rpc_parameters
*copyc dft$server_state
*copyc osc$server_state_change
*copyc pmt$mainframe_id
*copyc pmt$program_name
?? POP ??
*copyc clp$evaluate_parameters
*copyc dfi$display
*copyc dfp$call_remote_procedure
*copyc dfp$get_mainframe_status
*copyc osp$set_status_abnormal
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$get_mainframe_id
*copyc pmp$long_term_wait

  TYPE
    { NOTE: This type is also defined/used in dfm$test_app_sup_r3
    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_support ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$client_test_app_support
    (    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, 13, 12, 7, 4, 968],
    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;

    VAR
      application: ost$name,
      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: ^SEQ ( * ),
      p_send_data: ^SEQ ( * ),
      p_send_header: ^send_header_record,
      p_send_string: ^string ( * ),
      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;

    { 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;
    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;

    CASE ud OF
    = 'S' =
      PUSH p_send_buffer: [[REP #SIZE (send_header_record) OF cell]];
      RESET p_send_buffer;
      NEXT p_send_header IN p_send_buffer;
      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;
      PUSH p_send_data: [[REP send_size OF cell]];
      RESET p_send_data;
      PUSH p_receive_buffer: [[REP receive_size OF cell]];
      RESET p_receive_buffer;
      p_receive_data := NIL;
    = 'R' =
      PUSH p_send_buffer: [[REP (#SIZE (send_header_record) + send_size) OF cell]];
      RESET p_send_buffer;
      NEXT p_send_header IN p_send_buffer;
      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;
      RESET p_send_buffer;
      PUSH p_receive_data: [[REP receive_size OF cell]];
      RESET p_receive_data;
      p_receive_buffer := NIL;
    = 'B' =
      PUSH p_send_buffer: [[REP #SIZE (send_header_record) OF cell]];
      RESET p_send_buffer;
      NEXT p_send_header IN p_send_buffer;
      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;
      PUSH p_send_data: [[REP send_size OF cell]];
      RESET p_send_buffer;
      PUSH p_receive_data: [[REP receive_size OF cell]];
      p_receive_buffer := NIL;
    = 'N' =
      PUSH p_send_buffer: [[REP (#SIZE (send_header_record) + send_size) OF cell]];
      RESET p_send_buffer;
      NEXT p_send_header IN p_send_buffer;
      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;
      RESET p_send_buffer;
      PUSH p_receive_buffer: [[REP receive_size OF cell]];
      p_receive_data := NIL;
    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
      RETURN;
    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 ??

    STRINGREP (line, line_size, ' Sending RPC request. APPL=', application, ' PROC=', proc_name);
    display (line (1, line_size));

    FOR i := 1 TO repeat_count DO
      dfp$call_remote_procedure (server_location, application, proc_name, p_send_buffer, p_send_data,
            returned_buffer_size, p_receive_buffer, returned_data_size, p_receive_data, status);
      IF NOT status.normal THEN
        display (' ABNORMAL STATUS FROM dfp$call_remote_procedure');
        display_status (status);
        RETURN;
      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);
      IFEND;

    FOREND;
  PROCEND dfp$client_test_app_support;
?? TITLE := 'dfp$scp1', EJECT ??

{ PURPOSE:
{   Provide a generic state_change_procedure

  PROCEDURE [XDCL, #GATE] dfp$scp1
    (    mainframe_id: pmt$mainframe_id;
         partner_is_server: boolean;
         old_state: dft$server_state;
         new_state: dft$server_state;
     VAR status: ost$status);

    VAR
      line: string (120),
      line_size: integer,
      new_name: string (10),
      old_name: string (10);

    status.normal := TRUE;
    STRINGREP (line, line_size, ' DFP$SCP1 called. Mainframe:', mainframe_id);
    display (line (1, line_size));

    CASE old_state OF
    = dfc$terminated =
      old_name := 'terminated';
    = dfc$active =
      old_name := 'active';
    = dfc$inactive =
      old_name := 'inactive';
    = dfc$deactivated =
      old_name := 'deactivate';
    = dfc$awaiting_recovery =
      old_name := 'await_recv';
    = dfc$recovering =
      old_name := 'recovering';
    ELSE
      old_name := '!!??!!??!!??';
    CASEND;

    CASE new_state OF
    = dfc$terminated =
      new_name := 'terminated';
    = dfc$active =
      new_name := 'active';
    = dfc$inactive =
      new_name := 'inactive';
    = dfc$deactivated =
      new_name := 'deactivate';
{ Perform shut-down activities .....
    = dfc$awaiting_recovery =
      new_name := 'await_recv';
    = dfc$recovering =
      new_name := 'recovering';
    ELSE
      new_name := '!!??!!??!!??';
    CASEND;

    STRINGREP (line, line_size, ' Old state: ', old_name, '  New state: ', new_name);
    display (line (1, line_size));


  PROCEND dfp$scp1;
?? TITLE := 'dfp$server_test_app_support', EJECT ??

{ PURPOSE:
{   The purpose of this request is to receive and process data from the client.
{   This procedure is a test remote application procedure.
{ NOTES:
{   1. It is assumed that the test is interested in transferring data either
{      via the parameter/buffer area or the "data" area - not both.

  PROCEDURE [XDCL, #GATE] dfp$server_test_app_support
    (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
      client_receive_size: dft$send_data_size,
      client_send_size: dft$send_data_size,
      condition_for_state: pmt$condition,
      condition_for_break: pmt$condition,
      condition_for_pause: pmt$condition,
      handler_descriptor_for_state: pmt$established_handler,
      handler_descriptor_for_break: pmt$established_handler,
      handler_descriptor_for_pause: pmt$established_handler,
      i: integer,
      line: string (110),
      line_size: integer,
      p_in: ^SEQ ( * ),
      p_buffer_out: ^SEQ ( * ),
      p_data_out: ^SEQ ( * ),
      p_out: ^SEQ ( * ),
      p_receive_string: ^string ( * ),
      p_send_header: ^send_header_record,
      p_send_string: ^string ( * ),
      pause_break_received: boolean,
      server_state_change: boolean,
      server_state: dft$server_state,
      terminate_break_received: boolean;

?? NEWTITLE := 'handle_condition_for_state', EJECT ??

{ PURPOSE:
{   To process user condition

    PROCEDURE handle_condition_for_state
      (    condition_for_state: pmt$condition;
           condition_descriptor_for_state: ^pmt$condition_information;
           save_area_for_state: ^ost$stack_frame_save_area;
       VAR handler_status_for_state: ost$status);


      display (' dfp$server_test_app_support STATE handler entered');

      IF condition_for_state.selector = pmc$user_defined_condition THEN
        IF condition_for_state.user_condition_name = osc$server_state_change THEN
          display (' Server state change condition');
          server_state_change := TRUE;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status_for_state);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status_for_state);
      IFEND;
    PROCEND handle_condition_for_state;

?? OLDTITLE ??

?? NEWTITLE := 'handle_condition_for_break', EJECT ??

{ PURPOSE:
{   To process user condition: TERMINATE

    PROCEDURE handle_condition_for_break
      (    condition_for_break: pmt$condition;
           condition_descriptor_for_break: ^pmt$condition_information;
           save_area_for_break: ^ost$stack_frame_save_area;
       VAR handler_status_for_break: ost$status);


      display (' dfp$server_test_app_support BREAK handler entered');

      IF condition_for_break.selector = pmc$user_defined_condition THEN
        IF condition_for_break.user_condition_name = dfc$client_terminate_break THEN
          display (' Terminate Break received.');
          terminate_break_received := TRUE;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status_for_break);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status_for_break);
      IFEND;
    PROCEND handle_condition_for_break;

?? OLDTITLE ??

?? NEWTITLE := 'handle_condition_for_pause', EJECT ??

{ PURPOSE:
{   To process user condition: PAUSE

    PROCEDURE handle_condition_for_pause
      (    condition_for_pause: pmt$condition;
           condition_descriptor_for_pause: ^pmt$condition_information;
           save_area_for_pause: ^ost$stack_frame_save_area;
       VAR handler_status_for_pause: ost$status);


      display (' dfp$server_test_app_support PAUSE handler entered');

      IF condition_for_pause.selector = pmc$user_defined_condition THEN
        IF condition_for_pause.user_condition_name = dfc$client_pause_break THEN
          display (' Pause Break received.');
          pause_break_received := TRUE;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status_for_pause);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status_for_pause);
      IFEND;
    PROCEND handle_condition_for_pause;

?? OLDTITLE ??

    display (' Entering dfp$server_test_app_support');

    status.normal := TRUE;
    server_state_change := FALSE;
    pause_break_received := FALSE;
    terminate_break_received := FALSE;

    send_parameters_length := 0;
    data_size_to_send_to_client := 0;
    condition_for_state.selector := pmc$user_defined_condition;
    condition_for_state.user_condition_name := osc$server_state_change;
    display (' Establishing STATE condition handler for user_defined_condition');
    pmp$establish_condition_handler (condition_for_state, ^handle_condition_for_state,
          ^handler_descriptor_for_state, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    condition_for_break.selector := pmc$user_defined_condition;
    condition_for_break.user_condition_name := dfc$client_terminate_break;
    display (' Establishing BREAK condition handler for user_defined_condition');
    pmp$establish_condition_handler (condition_for_break, ^handle_condition_for_break,
          ^handler_descriptor_for_break, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    condition_for_pause.selector := pmc$user_defined_condition;
    condition_for_pause.user_condition_name := dfc$client_pause_break;
    display (' Establishing PAUSE condition handler for user_defined_condition');
    pmp$establish_condition_handler (condition_for_pause, ^handle_condition_for_pause,
          ^handler_descriptor_for_pause, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT p_send_header IN p_param_received_from_client;

    display_integer (' Client_send_buffer_size: ', p_send_header^.client_send_buffer_size);
    display_integer (' Client_send_data_size: ', p_send_header^.client_send_data_size);
    display_integer (' Client_receive_buffer_size: ', p_send_header^.client_receive_buffer_size);
    display_integer (' Client_receive_data_size: ', p_send_header^.client_receive_data_size);
    STRINGREP (line, line_size, ' Client_send_first_char: ', p_send_header^.client_send_first_char);
    display (line (1, line_size));
    display_integer (' Server_delay_count: ', p_send_header^.server_delay_count);

    IF p_send_header^.client_send_buffer_size > #SIZE (send_header_record) THEN
      NEXT p_in: [[REP (p_send_header^.client_send_buffer_size - #SIZE (send_header_record)) OF cell]] IN
            p_param_received_from_client;
      client_send_size := p_send_header^.client_send_buffer_size - #SIZE (send_header_record);
    IFEND;

    IF p_send_header^.client_send_data_size > 0 THEN
      NEXT p_in: [[REP p_send_header^.client_send_data_size OF cell]] IN p_data_from_client;
      client_send_size := p_send_header^.client_send_data_size;
    IFEND;
    RESET p_in;

{ Turn off range checking to allow nexting huge string
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
    NEXT p_receive_string: [client_send_size] IN p_in;
    read_test_data (p_receive_string, client_send_size, p_send_header^.client_send_first_char, status);
{ Turn on range checking
?? POP ??
    IF NOT status.normal THEN
      display (' Server -  data mismatch');
      display_status (status);
      osp$set_status_abnormal (dfc$file_server_id, dfe$test_checksum_error, 'DATA MISMATCH', status);
      RETURN;
    IFEND;

    IF p_send_header^.client_receive_buffer_size > 0 THEN
      NEXT p_out: [[REP p_send_header^.client_receive_buffer_size OF cell]] IN p_send_to_client_params;
      send_parameters_length := p_send_header^.client_receive_buffer_size;
      client_receive_size := send_parameters_length;
    IFEND;

    IF p_send_header^.client_receive_data_size > 0 THEN
      NEXT p_out: [[REP p_send_header^.client_receive_data_size OF cell]] IN p_data_to_client;
      data_size_to_send_to_client := p_send_header^.client_receive_data_size;
      client_receive_size := data_size_to_send_to_client;
    IFEND;
    RESET p_out;

{ Turn off range checking to allow nexting huge string
?? PUSH (CHKRNG := OFF, CHKSUB := OFF) ??
    NEXT p_send_string: [client_receive_size] IN p_out;
    fill_test_data (p_send_string, client_receive_size, p_send_header^.client_send_first_char);
{ Turn on range checking
?? POP ??

  /simulate_activity/
    FOR i := 1 TO p_send_header^.server_delay_count DO
      pmp$long_term_wait (1000, 1000);
      #SPOIL (server_state_change, terminate_break_received, pause_break_received);
      IF server_state_change THEN
        dfp$get_mainframe_status (p_send_header^.client_mainframe_id, {partner_is_server} FALSE, server_state,
              status);
        IF status.normal THEN
          IF server_state = dfc$deactivated THEN
            display (' Server detected DEACTIVATED state');
            { Perform shut-down activities}
          IFEND;
        IFEND;
        osp$set_status_abnormal ('DF', 333, ' Server state has changed', status);
        RETURN;
      ELSEIF terminate_break_received THEN
        osp$set_status_abnormal ('DF', 333, ' Terminate break received', status);
        RETURN;
      ELSEIF pause_break_received THEN
        osp$set_status_abnormal ('DF', 333, ' Pause break received', status);
        RETURN;
      IFEND;
    FOREND /simulate_activity/;

  PROCEND dfp$server_test_app_support;
?? 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_application_support;
