?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File Server: Server/Client: Application Information Manager' ??
MODULE dfm$manage_application_info;

{ PURPOSE:
{   This module contains the procedures to generate, display and delete
{   information required for applications "calling" from a client mainframe
{   procedures which reside and execute on a server mainframe.
{
{ DESIGN:
{   Procedures are provided to process the commands concerning the information.
{   The commands are sub-commands of the MANAGE_FILE_SERVER utility.
{   Externally referenced procedures appear in this module before local
{   procedures.

?? NEWTITLE := '  Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfe$error_condition_codes
*copyc dfi$console_display
*copyc dfi$display
*copyc dfi$log_display
*copyc dft$application_support_limits
*copyc dft$app_support_limits_af
*copyc dft$cpu_queue
*copyc dft$rpc_parameters
*copyc dft$rpc_procedure_address_list
*copyc pmt$mainframe_id
*copyc ost$name
?? POP ??
*copyc amp$return
*copyc clp$close_display
*copyc clp$count_list_elements
*copyc clp$evaluate_parameters
*copyc clp$include_command
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc dfp$find_mainframe_id
*copyc dfp$get_mainframe_list
*copyc dfp$verify_system_administrator
*copyc i#current_sequence_position
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$clear_job_signature_lock
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$test_sig_lock
*copyc pmp$zero_out_table
*copyc dfv$application_info_lock
*copyc dfv$file_server_debug_enabled
*copyc dfv$p_client_mainframe_file
*copyc dfv$server_wired_heap
?? OLDTITLE ??
?? NEWTITLE := 'Server: [XDCL, #GATE] dfp$define_application_rpc_cmnd', EJECT ??

{ PURPOSE:
{   The purpose of this request is to define the applications procedures which
{   can be called on the server mainframe from application procedures on
{   specified client mainframes.

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

{ PROCEDURE define_application_rpc, defar (
{   application_name, an: name = $required
{   library, l: file = $required
{   remote_procedure, rp: list 1 .. 50 of record
{     remote_procedure_name: name = $required
{     request_restartable: boolean = "FALSE" $optional
{     job_recovery_location: key
{       (caller_waits_for_volume, cwfv)
{       (caller_starts_recovery, csr)
{      keyend = "caller_waits_for_volume" $optional
{      recover_job_on_server: boolean ="FALSE" $optional
{      application_ring: integer 3..15 = "6" $optional
{      allow_terminate_break: boolean = "TRUE" $optional
{      allow_pause_break: boolean = "TRUE" $optional
{    recend = $required
{    client_mainframe_identifiers, client_mainframe_identifier, cmi: any of
{      list of name 17..17
{        key
{          all
{        keyend
{     anyend = $REQUIRED
{     state_change_procedure, scp: any of
{       program_name
{       key
{         none
{       keyend
{     anyend = none
{     sequence_size, ss: any of
{       integer 0..524288
{       key
{         none
{       keyend
{     anyend = none
{     attach_file, attach_files, af: (hidden) any of
{       list 1 ..25 of file
{       key
{         none
{       keyend
{     anyend = none
{     status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 17] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$record_type_qualifier,
          field_spec_1: clt$field_specification,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
          field_spec_2: clt$field_specification,
          element_type_spec_2: record
            header: clt$type_specification_header,
          recend,
          field_spec_3: clt$field_specification,
          element_type_spec_3: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 4] of clt$keyword_specification,
          recend,
          field_spec_4: clt$field_specification,
          element_type_spec_4: record
            header: clt$type_specification_header,
          recend,
          field_spec_5: clt$field_specification,
          element_type_spec_5: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
          field_spec_6: clt$field_specification,
          element_type_spec_6: record
            header: clt$type_specification_header,
          recend,
          field_spec_7: clt$field_specification,
          element_type_spec_7: record
            header: clt$type_specification_header,
          recend,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (4),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (4),
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 8, 23, 6, 56, 16, 65],
    clc$command, 17, 8, 4, 0, 1, 0, 8, ''], [
    ['AF                             ',clc$abbreviation_entry, 7],
    ['AN                             ',clc$abbreviation_entry, 1],
    ['APPLICATION_NAME               ',clc$nominal_entry, 1],
    ['ATTACH_FILE                    ',clc$nominal_entry, 7],
    ['ATTACH_FILES                   ',clc$alias_entry, 7],
    ['CLIENT_MAINFRAME_IDENTIFIER    ',clc$alias_entry, 4],
    ['CLIENT_MAINFRAME_IDENTIFIERS   ',clc$nominal_entry, 4],
    ['CMI                            ',clc$abbreviation_entry, 4],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LIBRARY                        ',clc$nominal_entry, 2],
    ['REMOTE_PROCEDURE               ',clc$nominal_entry, 3],
    ['RP                             ',clc$abbreviation_entry, 3],
    ['SCP                            ',clc$abbreviation_entry, 5],
    ['SEQUENCE_SIZE                  ',clc$nominal_entry, 6],
    ['SS                             ',clc$abbreviation_entry, 6],
    ['STATE_CHANGE_PROCEDURE         ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 8]],
    [
{ PARAMETER 1
    [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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [10, 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$required_parameter, 0
  , 0],
{ PARAMETER 3
    [11, 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, 467,
  clc$required_parameter, 0, 0],
{ PARAMETER 4
    [7, 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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 5
    [16, 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, 67,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [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, 84,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 7
    [4, clc$hidden_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 8
    [17, 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]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$list_type], [451, 1, 50, 0, FALSE, FALSE],
      [[1, 0, clc$record_type], [7],
      ['REMOTE_PROCEDURE_NAME          ', clc$required_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['REQUEST_RESTARTABLE            ', clc$optional_field, 3], [[1, 0, clc$boolean_type]],
      ['JOB_RECOVERY_LOCATION          ', clc$optional_field, 155], [[1, 0, clc$keyword_type], [4], [
        ['CALLER_STARTS_RECOVERY         ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['CALLER_WAITS_FOR_VOLUME        ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['CSR                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
        ['CWFV                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
        ],
      ['RECOVER_JOB_ON_SERVER          ', clc$optional_field, 3], [[1, 0, clc$boolean_type]],
      ['APPLICATION_RING               ', clc$optional_field, 20], [[1, 0, clc$integer_type], [3, 15, 10]],
      ['ALLOW_TERMINATE_BREAK          ', clc$optional_field, 3], [[1, 0, clc$boolean_type]],
      ['ALLOW_PAUSE_BREAK              ', clc$optional_field, 3], [[1, 0, clc$boolean_type]]
      ]
    ],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$name_type], [17, 17]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ],
{ PARAMETER 5
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'none'],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    20, [[1, 0, clc$integer_type], [0, 524288, 10]],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'none'],
{ PARAMETER 7
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    19, [[1, 0, clc$list_type], [3, 1, 25, 0, FALSE, FALSE],
        [[1, 0, clc$file_type]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'none'],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$application_name = 1,
      p$library = 2,
      p$remote_procedure = 3,
      p$client_mainframe_identifiers = 4,
      p$state_change_procedure = 5,
      p$sequence_size = 6,
      p$attach_file = 7,
      p$status = 8;

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

    VAR
      attached_file_index: dft$number_of_attached_files,
      client_id: pmt$mainframe_id,
      client_index: clt$list_size,
      client_list_count: clt$list_size,
      command_name: ost$name,
      host_application_info: dft$host_application_info,
      j: dft$number_of_procs_per_app,
      local_status: ost$status,
      mainframe_found: boolean,
      number_of_attached_files: dft$number_of_attached_files,
      number_of_procedures: dft$number_of_procs_per_app,
      p_application_rpc_list: ^array [ * ] of dft$rpc_procedure_address_entry,
      p_attached_file_info: ^array [ * ] of ^fst$file_reference,
      p_client_list: ^dft$partner_mainframe_list,
      p_cpu_queue: ^dft$cpu_queue,
      p_library_file_path: ^fst$file_reference,
      p_list_value: ^clt$data_value,
      partner_count: dft$partner_mainframe_count,
      procedure_index: dft$number_of_procs_per_app,
      procedure_name: pmt$program_name,
      remote_application_info: dft$remote_application_info,
      sequence_size: dft$send_data_size;

?? NEWTITLE := 'block_exit_handler', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to clear the application info lock if
{   it is set.

    PROCEDURE block_exit_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        lock_status: ost$signature_lock_status;

      osp$test_sig_lock (dfv$application_info_lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (dfv$application_info_lock);
      IFEND;

    PROCEND block_exit_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    local_status.normal := TRUE;
    command_name := 'DEFINE_APPLICATION_RPC';

    dfp$verify_system_administrator (command_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Crack host application information.

    host_application_info.application_name := pvt [p$application_name].value^.name_value;
    p_library_file_path := pvt [p$library].value^.file_value;

    IF (pvt [p$state_change_procedure].value^.kind = clc$program_name) AND
          (pvt [p$state_change_procedure].value^.program_name_value <> 'NONE') THEN
      host_application_info.state_change_procedure_name := pvt [p$state_change_procedure].value^.name_value;
    ELSE
      host_application_info.state_change_procedure_name := osc$null_name;
    IFEND;

    IF pvt [p$sequence_size].value^.kind = clc$integer THEN
      sequence_size := pvt [p$sequence_size].value^.integer_value.value;
    ELSE
      sequence_size := 0;
    IFEND;

    host_application_info.next_p_application_info := NIL;

{ NOTE: Implemention of attached file processing has been DEFERRED
{   IF pvt [p$attach_file].specified THEN
{     number_of_attached_files := clp$count_list_elements (pvt [p$attach_file].value);
{     p_list_value := pvt [p$attach_file].value;
{
{     PUSH p_attached_file_info: [1 .. number_of_attached_files];
{
{     FOR attached_file_index := 1 TO number_of_attached_files DO
{       p_attached_file_info^ [attached_file_index] := p_list_value^.element_value^.file_value;
{
{       p_list_value := p_list_value^.link;
{     FOREND;
{   ELSE
    p_attached_file_info := NIL;
{   IFEND;

{ Crack remote application information.

    remote_application_info.application_name := pvt [p$application_name].value^.name_value;
    remote_application_info.next_p_application_info := NIL;
    number_of_procedures := clp$count_list_elements (pvt [p$remote_procedure].value);
    remote_application_info.number_of_procedures := number_of_procedures;

{ Build procedure address list (without address)

    p_list_value := pvt [p$remote_procedure].value;

    PUSH p_application_rpc_list: [1 .. number_of_procedures];

  /process_remote_procedures/
    FOR procedure_index := 1 TO number_of_procedures DO
      procedure_name := p_list_value^.element_value^.field_values^ [1].value^.name_value;
      IF procedure_index > 1 THEN

      /check_name_uniqueness/
        FOR j := 1 TO procedure_index - 1 DO
          IF p_application_rpc_list^ [j].debug_display = procedure_name THEN
            osp$set_status_abnormal (dfc$file_server_id, dfe$procedure_already_defined, procedure_name,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  host_application_info.application_name, status);
            RETURN;
          IFEND;
        FOREND /check_name_uniqueness/;
      IFEND;
      p_application_rpc_list^ [procedure_index].debug_display := procedure_name;

      p_application_rpc_list^ [procedure_index].procedure_address := NIL;
      { procedure_address to be added when loaded

      p_application_rpc_list^ [procedure_index].class := dfc$application_call;

      IF p_list_value^.element_value^.field_values^ [2].value = NIL THEN { default }
        p_application_rpc_list^ [procedure_index].request_restartable := dfc$request_not_restartable;
      ELSEIF p_list_value^.element_value^.field_values^ [2].value^.boolean_value.value THEN
        p_application_rpc_list^ [procedure_index].request_restartable := dfc$request_restartable;
      ELSE
        p_application_rpc_list^ [procedure_index].request_restartable := dfc$request_not_restartable;
      IFEND;

      IF p_list_value^.element_value^.field_values^ [3].value = NIL THEN
        p_application_rpc_list^ [procedure_index].job_recovery_location := dfc$job_rec_in_unavailable_wait;
      ELSEIF (p_list_value^.element_value^.field_values^ [3].value^.keyword_value =
            'CALLER_WAITS_FOR_VOLUME') OR (p_list_value^.element_value^.field_values^ [3].value^.
            keyword_value = 'CWFV') THEN
        p_application_rpc_list^ [procedure_index].job_recovery_location := dfc$job_rec_in_unavailable_wait;
      ELSE
        p_application_rpc_list^ [procedure_index].job_recovery_location := dfc$job_rec_started_by_caller;
      IFEND;

      IF p_list_value^.element_value^.field_values^ [4].value = NIL THEN
        p_application_rpc_list^ [procedure_index].recover_job_on_server_call := FALSE;
      ELSE
        p_application_rpc_list^ [procedure_index].recover_job_on_server_call :=
              p_list_value^.element_value^.field_values^ [4].value^.boolean_value.value;
      IFEND;

      p_application_rpc_list^ [procedure_index].procedure_version := '1234';
      p_application_rpc_list^ [procedure_index].procedure_name_checksum := #FREE_RUNNING_CLOCK (0);

      IF p_list_value^.element_value^.field_values^ [5].value = NIL THEN
        p_application_rpc_list^ [procedure_index].application_ring := 6;
      ELSE
        p_application_rpc_list^ [procedure_index].application_ring :=
              p_list_value^.element_value^.field_values^ [5].value^.integer_value.value;
      IFEND;

      IF p_list_value^.element_value^.field_values^ [6].value = NIL THEN
        p_application_rpc_list^ [procedure_index].allow_terminate_break := TRUE;
      ELSE
        p_application_rpc_list^ [procedure_index].allow_terminate_break :=
              p_list_value^.element_value^.field_values^ [6].value^.boolean_value.value;
      IFEND;

      IF p_list_value^.element_value^.field_values^ [7].value = NIL THEN
        p_application_rpc_list^ [procedure_index].allow_pause_break := TRUE;
      ELSE
        p_application_rpc_list^ [procedure_index].allow_pause_break :=
              p_list_value^.element_value^.field_values^ [7].value^.boolean_value.value;
      IFEND;

      p_list_value := p_list_value^.link;

    FOREND /process_remote_procedures/;

    IF pvt [p$client_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
      PUSH p_client_list: [1 .. 10];
      dfp$get_mainframe_list ({partners_are_servers} FALSE, p_client_list^, partner_count);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF partner_count = 0 THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$no_partner_mainframe, command_name, status);
        RETURN;
      IFEND;
      IF partner_count > 10 THEN
        PUSH p_client_list: [1 .. partner_count];
        dfp$get_mainframe_list ({partners_are_servers} FALSE, p_client_list^, partner_count);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      client_list_count := partner_count;
      FOR client_index := 1 TO client_list_count DO
        IF (p_client_list^ [client_index].partner_state <> dfc$terminated) AND
              (p_client_list^ [client_index].partner_state <> dfc$awaiting_recovery) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_state_for_def_app, command_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                p_client_list^ [client_index].mainframe_name, status);
          RETURN;
        IFEND;
      FOREND;
    ELSE
      p_list_value := pvt [p$client_mainframe_identifiers].value;
      client_list_count := clp$count_list_elements (pvt [p$client_mainframe_identifiers].value);
    IFEND;

    osp$establish_block_exit_hndlr (^block_exit_handler);

    osp$set_job_signature_lock (dfv$application_info_lock);

  /add_application_info_for_client/
    FOR client_index := 1 TO client_list_count DO
      IF pvt [p$client_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
        client_id := p_client_list^ [client_index].mainframe_name;
      ELSE
        client_id := p_list_value^.element_value^.name_value;
        p_list_value := p_list_value^.link;
      IFEND;
      add_host_application_info (host_application_info, {host_is_server} TRUE, client_id, sequence_size,
            p_attached_file_info, p_library_file_path, command_name, p_cpu_queue, status);
      IF NOT status.normal THEN
        IF dfv$file_server_debug_enabled THEN
          display_status (status);
          log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
        IFEND;
        EXIT /add_application_info_for_client/;
      IFEND;
      add_remote_application_info (remote_application_info, p_cpu_queue, p_application_rpc_list, status);
      IF NOT status.normal THEN
        delete_host_application (host_application_info.application_name, client_id, {host_is_server} TRUE,
              command_name, local_status);
        EXIT /add_application_info_for_client/;
      IFEND;

    FOREND /add_application_info_for_client/;

    osp$clear_job_signature_lock (dfv$application_info_lock);
    osp$disestablish_cond_handler;

    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

  PROCEND dfp$define_application_rpc_cmnd;
?? OLDTITLE ??
?? NEWTITLE := 'Client:[XDCL, #GATE] dfp$define_client_app_info_cmnd', EJECT ??

{ PURPOSE:
{   The purpose of this request is to define the application information
{   on a client mainframe.


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

{     PROCEDURE define_client_application_info, defcai (
{       application_name, an: name = $required
{       library, l: file
{       server_mainframe_identifiers, server_mainframe_identifier, smi: any of
{         list of name 17..17
{         key
{           all
{         keyend
{       anyend = $REQUIRED
{       state_change_procedure, scp: any of
{         program_name
{         key
{           none
{         keyend
{       anyend = none
{       sequence_size, ss: any of
{         integer 0..524288
{         key
{           none
{         keyend
{       anyend = none
{       status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 12] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (4),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 12, 9, 42, 12, 772],
    clc$command, 12, 6, 2, 0, 0, 0, 6, ''], [
    ['AN                             ',clc$abbreviation_entry, 1],
    ['APPLICATION_NAME               ',clc$nominal_entry, 1],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LIBRARY                        ',clc$nominal_entry, 2],
    ['SCP                            ',clc$abbreviation_entry, 4],
    ['SEQUENCE_SIZE                  ',clc$nominal_entry, 5],
    ['SERVER_MAINFRAME_IDENTIFIER    ',clc$alias_entry, 3],
    ['SERVER_MAINFRAME_IDENTIFIERS   ',clc$nominal_entry, 3],
    ['SMI                            ',clc$abbreviation_entry, 3],
    ['SS                             ',clc$abbreviation_entry, 5],
    ['STATE_CHANGE_PROCEDURE         ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [2, 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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, 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_parameter, 0
  , 0],
{ PARAMETER 3
    [8, 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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 4
    [11, 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, 67,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 5
    [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, 84,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [12, 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]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$name_type], [17, 17]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'none'],
{ PARAMETER 5
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    20, [[1, 0, clc$integer_type], [0, 524288, 10]],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'none'],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

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

    CONST
      p$application_name = 1,
      p$library = 2,
      p$server_mainframe_identifiers = 3,
      p$state_change_procedure = 4,
      p$sequence_size = 5,
      p$status = 6;

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

    VAR
      command_name: ost$name,
      host_application_info: dft$host_application_info,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_library_file_path: ^fst$file_reference,
      p_list_value: ^clt$data_value,
      p_server_list: ^dft$partner_mainframe_list,
      partner_count: dft$partner_mainframe_count,
      sequence_size: dft$send_data_size,
      server_id: pmt$mainframe_id,
      server_index: clt$list_size,
      server_list_count: clt$list_size;

?? NEWTITLE := 'block_exit_handler', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to clear the application info lock if
{   it is set.

    PROCEDURE block_exit_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        lock_status: ost$signature_lock_status;

      osp$test_sig_lock (dfv$application_info_lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (dfv$application_info_lock);
      IFEND;

    PROCEND block_exit_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    command_name := 'DEFINE_CLIENT_APPLICATION_INFO';

    dfp$verify_system_administrator (command_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    host_application_info.application_name := pvt [p$application_name].value^.name_value;

    IF pvt [p$library].specified THEN
      p_library_file_path := pvt [p$library].value^.file_value;
    ELSE
      p_library_file_path := NIL;
    IFEND;

    host_application_info.attached_library_lfn := osc$null_name;

    IF (pvt [p$state_change_procedure].value^.kind = clc$program_name) AND
          (pvt [p$state_change_procedure].value^.program_name_value <> 'NONE') THEN
      IF pvt [p$library].specified THEN
        host_application_info.state_change_procedure_name := pvt [p$state_change_procedure].value^.name_value;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$scp_par_requires_lib_par, '', status);
        RETURN;
      IFEND;
    ELSE
      host_application_info.state_change_procedure_name := osc$null_name;
    IFEND;

    IF pvt [p$sequence_size].value^.kind = clc$integer THEN
      sequence_size := pvt [p$sequence_size].value^.integer_value.value;
    ELSE
      sequence_size := 0;
    IFEND;

    host_application_info.p_attached_file_info := NIL;
    host_application_info.next_p_application_info := NIL;

    IF pvt [p$server_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
      PUSH p_server_list: [1 .. 10];
      dfp$get_mainframe_list ({partners_are_servers} TRUE, p_server_list^, partner_count);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF partner_count = 0 THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$no_partner_mainframe, command_name, status);
        RETURN;
      IFEND;
      IF partner_count > 10 THEN
        PUSH p_server_list: [1 .. partner_count];
        dfp$get_mainframe_list ({partners_are_servers} TRUE, p_server_list^, partner_count);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      server_list_count := partner_count;
      FOR server_index := 1 TO server_list_count DO
        IF (p_server_list^ [server_index].partner_state <> dfc$terminated) AND
              (p_server_list^ [server_index].partner_state <> dfc$awaiting_recovery) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_state_for_def_app, command_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                p_server_list^ [server_index].mainframe_name, status);
          RETURN;
        IFEND;
      FOREND;
    ELSE
      p_list_value := pvt [p$server_mainframe_identifiers].value;
      server_list_count := clp$count_list_elements (pvt [p$server_mainframe_identifiers].value);
    IFEND;

    osp$establish_block_exit_hndlr (^block_exit_handler);

    osp$set_job_signature_lock (dfv$application_info_lock);

  /add_application_info_for_server/
    FOR server_index := 1 TO server_list_count DO
      IF pvt [p$server_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
        server_id := p_server_list^ [server_index].mainframe_name;
      ELSE
        server_id := p_list_value^.element_value^.name_value;
        p_list_value := p_list_value^.link;
      IFEND;
      add_host_application_info (host_application_info, FALSE, server_id, sequence_size, NIL,
            p_library_file_path, command_name, p_cpu_queue, status);
      IF NOT status.normal THEN
        IF dfv$file_server_debug_enabled THEN
          display_status (status);
          log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
        IFEND;
        RETURN;
      IFEND;

    FOREND /add_application_info_for_server/;

    osp$clear_job_signature_lock (dfv$application_info_lock);
    osp$disestablish_cond_handler;

  PROCEND dfp$define_client_app_info_cmnd;
?? OLDTITLE ??
?? NEWTITLE := 'Server: [XDCL, #GATE] dfp$delete_application_rpc_cmnd', EJECT ??

{ PURPOSE:
{   The purpose of this request is to delete all application information
{   previously defined by the define_application_rpc command for the
{   specified client mainframes.

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

{   PROCEDURE delete_application_rpc, delar (
{     application_name, an: name = $REQUIRED
{     client_mainframe_identifiers, client_mainframe_identifier, cmi: any of
{       list of name 17..17
{       key
{         all
{       keyend
{     anyend = $REQUIRED
{     status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 7, 28, 14, 55, 57, 909],
    clc$command, 6, 3, 2, 0, 0, 0, 3, ''], [
    ['AN                             ',clc$abbreviation_entry, 1],
    ['APPLICATION_NAME               ',clc$nominal_entry, 1],
    ['CLIENT_MAINFRAME_IDENTIFIER    ',clc$alias_entry, 2],
    ['CLIENT_MAINFRAME_IDENTIFIERS   ',clc$nominal_entry, 2],
    ['CMI                            ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, 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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, 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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [6, 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]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$name_type], [17, 17]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$application_name = 1,
      p$client_mainframe_identifiers = 2,
      p$status = 3;

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

    VAR
      application_name: ost$name,
      client_id: pmt$mainframe_id,
      client_index: clt$list_size,
      client_list_count: clt$list_size,
      command_name: ost$name,
      p_client_list: ^dft$partner_mainframe_list,
      p_list_value: ^clt$data_value,
      partner_count: dft$partner_mainframe_count;

?? NEWTITLE := 'block_exit_handler', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to clear the application info lock if
{   it is set.

    PROCEDURE block_exit_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        lock_status: ost$signature_lock_status;

      osp$test_sig_lock (dfv$application_info_lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (dfv$application_info_lock);
      IFEND;

    PROCEND block_exit_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    command_name := 'DELETE_APPLICATION_RPC';

    dfp$verify_system_administrator (command_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    application_name := pvt [p$application_name].value^.name_value;

    IF pvt [p$client_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
      PUSH p_client_list: [1 .. 10];
      dfp$get_mainframe_list ({partners_are_servers} FALSE, p_client_list^, partner_count);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF partner_count = 0 THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$no_partner_mainframe, command_name, status);
        RETURN;
      IFEND;
      IF partner_count > 10 THEN
        PUSH p_client_list: [1 .. partner_count];
        dfp$get_mainframe_list ({partners_are_servers} FALSE, p_client_list^, partner_count);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      client_list_count := partner_count;
      FOR client_index := 1 TO client_list_count DO
        IF (p_client_list^ [client_index].partner_state <> dfc$terminated) AND
              (p_client_list^ [client_index].partner_state <> dfc$awaiting_recovery) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_state_for_def_app, command_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                p_client_list^ [client_index].mainframe_name, status);
          RETURN;
        IFEND;
      FOREND;
    ELSE
      p_list_value := pvt [p$client_mainframe_identifiers].value;
      client_list_count := clp$count_list_elements (pvt [p$client_mainframe_identifiers].value);
    IFEND;

    osp$establish_block_exit_hndlr (^block_exit_handler);

    osp$set_job_signature_lock (dfv$application_info_lock);

  /del_info_for_client/
    FOR client_index := 1 TO client_list_count DO
      IF pvt [p$client_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
        client_id := p_client_list^ [client_index].mainframe_name;
      ELSE
        client_id := p_list_value^.element_value^.name_value;
        p_list_value := p_list_value^.link;
      IFEND;

      delete_host_application (application_name, client_id, {host_is_server} TRUE, command_name, status);
      IF status.normal THEN
        delete_remote_application (application_name, client_id, {host_is_server} TRUE, status);
      IFEND;
      IF NOT status.normal THEN
        IF dfv$file_server_debug_enabled THEN
          display_status (status);
          log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
        IFEND;
        RETURN;
      IFEND;

    FOREND /del_info_for_client/;

    osp$clear_job_signature_lock (dfv$application_info_lock);
    osp$disestablish_cond_handler;

  PROCEND dfp$delete_application_rpc_cmnd;
?? OLDTITLE ??
?? NEWTITLE := 'Client: [XDCL, #GATE] dfp$delete_client_app_info_cmnd', EJECT ??

{ PURPOSE:
{   The purpose of this request is to delete all application information
{   previously defined by the define_client_application command for the
{   specified server mainframes.

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

{   PROCEDURE delete_client_application_info, delcai (
{     application_name, an: name = $REQUIRED
{     server_mainframe_identifiers, server_mainframe_identifier, smi: any of
{       list of name 17..17
{       key
{         all
{       keyend
{     anyend = $REQUIRED
{     status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 7, 28, 15, 8, 38, 342],
    clc$command, 6, 3, 2, 0, 0, 0, 3, ''], [
    ['AN                             ',clc$abbreviation_entry, 1],
    ['APPLICATION_NAME               ',clc$nominal_entry, 1],
    ['SERVER_MAINFRAME_IDENTIFIER    ',clc$alias_entry, 2],
    ['SERVER_MAINFRAME_IDENTIFIERS   ',clc$nominal_entry, 2],
    ['SMI                            ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, 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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, 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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [6, 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]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$name_type], [17, 17]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$application_name = 1,
      p$server_mainframe_identifiers = 2,
      p$status = 3;

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

    VAR
      application_name: ost$name,
      command_name: ost$name,
      p_list_value: ^clt$data_value,
      p_server_list: ^dft$partner_mainframe_list,
      partner_count: dft$partner_mainframe_count,
      server_id: pmt$mainframe_id,
      server_index: clt$list_size,
      server_list_count: clt$list_size;

?? NEWTITLE := 'block_exit_handler', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to clear the application info lock if
{   it is set.

    PROCEDURE block_exit_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        lock_status: ost$signature_lock_status;

      osp$test_sig_lock (dfv$application_info_lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (dfv$application_info_lock);
      IFEND;

    PROCEND block_exit_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    command_name := 'DELETE_CLIENT_APPLICATION_INFO';

    dfp$verify_system_administrator (command_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    application_name := pvt [p$application_name].value^.name_value;

    IF pvt [p$server_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
      PUSH p_server_list: [1 .. 10];
      dfp$get_mainframe_list ({partners_are_servers} TRUE, p_server_list^, partner_count);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF partner_count = 0 THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$no_partner_mainframe, command_name, status);
        RETURN;
      IFEND;
      IF partner_count > 10 THEN
        PUSH p_server_list: [1 .. partner_count];
        dfp$get_mainframe_list ({partners_are_servers} TRUE, p_server_list^, partner_count);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      server_list_count := partner_count;
      FOR server_index := 1 TO server_list_count DO
        IF (p_server_list^ [server_index].partner_state <> dfc$terminated) AND
              (p_server_list^ [server_index].partner_state <> dfc$awaiting_recovery) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_state_for_def_app, command_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                p_server_list^ [server_index].mainframe_name, status);
          RETURN;
        IFEND;
      FOREND;
    ELSE
      p_list_value := pvt [p$server_mainframe_identifiers].value;
      server_list_count := clp$count_list_elements (pvt [p$server_mainframe_identifiers].value);
    IFEND;

    osp$establish_block_exit_hndlr (^block_exit_handler);

    osp$set_job_signature_lock (dfv$application_info_lock);

  /del_application_info_for_server/
    FOR server_index := 1 TO server_list_count DO
      IF pvt [p$server_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
        server_id := p_server_list^ [server_index].mainframe_name;
      ELSE
        server_id := p_list_value^.element_value^.name_value;
        p_list_value := p_list_value^.link;
      IFEND;
      delete_host_application (application_name, server_id, {host_is_server} FALSE, command_name, status);
      IF NOT status.normal THEN
        IF dfv$file_server_debug_enabled THEN
          display_status (status);
          log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
        IFEND;
        RETURN;
      IFEND;

    FOREND /del_application_info_for_server/;

    osp$clear_job_signature_lock (dfv$application_info_lock);
    osp$disestablish_cond_handler;

  PROCEND dfp$delete_client_app_info_cmnd;
?? OLDTITLE ??
?? NEWTITLE := 'Server: [XDCL, #GATE] dfp$display_application_rpc', EJECT ??

{ PURPOSE:
{   The purpose of this request is to process the command requesting
{   display of information concerning application procedures previously
{   defined by the define_application_rpc_command.

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

{    PROCEDURE display_application_rpc, disar (
{      application_name, an: any of name
{        key
{          all
{        keyend
{      anyend = all
{      client_mainframe_identifiers, client_mainframe_identifier, cmi: any of
{        list of name 17..17
{        key
{          all
{        keyend
{      anyend = $REQUIRED
{      display_options, display_option, do : KEY
{       (brief, b)
{       (full, f)
{      keyend = brief
{      output, o : FILE = $output
{      status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 11] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (3),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (5),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 4, 12, 46, 38, 834],
    clc$command, 11, 5, 1, 0, 0, 0, 5, ''], [
    ['AN                             ',clc$abbreviation_entry, 1],
    ['APPLICATION_NAME               ',clc$nominal_entry, 1],
    ['CLIENT_MAINFRAME_IDENTIFIER    ',clc$alias_entry, 2],
    ['CLIENT_MAINFRAME_IDENTIFIERS   ',clc$nominal_entry, 2],
    ['CMI                            ',clc$abbreviation_entry, 2],
    ['DISPLAY_OPTION                 ',clc$alias_entry, 3],
    ['DISPLAY_OPTIONS                ',clc$nominal_entry, 3],
    ['DO                             ',clc$abbreviation_entry, 3],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OUTPUT                         ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [2, 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, 69,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 2
    [4, 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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [7, 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, 155,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 4
    [10, 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, 7],
{ PARAMETER 5
    [11, 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$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'all'],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$name_type], [17, 17]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BRIEF                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FULL                           ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'brief'],
{ PARAMETER 4
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$application_name = 1,
      p$client_mainframe_identifiers = 2,
      p$display_options = 3,
      p$output = 4,
      p$status = 5;

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

    VAR
      all_applications: boolean,
      application_found: boolean,
      application_name: ost$name,
      client_index: clt$list_size,
      client_list_count: clt$list_size,
      client_id: pmt$mainframe_id,
      command_name: ost$name,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      ignore_status: ost$status,
      line: string (200),
      line_size: integer,
      mainframe_found: boolean,
      next_p_info: ^dft$host_application_info,
      number_of_applications: dft$number_of_applications,
      p_cpu_queue: ^dft$cpu_queue,
      p_client_list: ^dft$partner_mainframe_list,
      p_host_application_info: ^dft$host_application_info,
      p_list_value: ^clt$data_value,
      p_remote_application_info: ^dft$remote_application_info,
      partner_count: dft$partner_mainframe_count;

?? NEWTITLE := 'block_exit_handler', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to gracefully terminate the generated
{   display in case of an abnormal termination.

    PROCEDURE block_exit_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status,
        lock_status: ost$signature_lock_status;

      osp$test_sig_lock (dfv$application_info_lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (dfv$application_info_lock);
      IFEND;
      clp$close_display (display_control, ignore_status);

    PROCEND block_exit_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    command_name := ' DISPLAY_APPLICATION_RPC';

    dfp$verify_system_administrator (command_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    application_name := pvt [p$application_name].value^.name_value;
    all_applications := application_name = 'ALL';

    client_list_count := clp$count_list_elements (pvt [p$client_mainframe_identifiers].value);

    IF pvt [p$client_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
      PUSH p_client_list: [1 .. 10];
      dfp$get_mainframe_list ({partners_are_servers} FALSE, p_client_list^, partner_count);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF partner_count = 0 THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$no_partner_mainframe, 'DISPLAY_APPLICATION_RPC',
              status);
        RETURN;
      IFEND;
      IF partner_count > 10 THEN
        PUSH p_client_list: [1 .. partner_count];
        dfp$get_mainframe_list ({partners_are_servers} FALSE, p_client_list^, partner_count);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      client_list_count := partner_count;
    ELSE
      p_list_value := pvt [p$client_mainframe_identifiers].value;
      client_list_count := clp$count_list_elements (pvt [p$client_mainframe_identifiers].value);
    IFEND;

    osp$establish_block_exit_hndlr (^block_exit_handler);

    default_ring_attributes.r1 := 11;
    default_ring_attributes.r2 := 11;
    default_ring_attributes.r3 := 11;

    clp$open_display_reference (pvt [p$output].value^.file_value^, NIL, fsc$list, default_ring_attributes,
          display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    clp$put_display (display_control, command_name, clc$trim, status);

    osp$set_job_signature_lock (dfv$application_info_lock);

    application_found := FALSE;

  /display_client/
    FOR client_index := 1 TO client_list_count DO
      IF pvt [p$client_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
        client_id := p_client_list^ [client_index].mainframe_name;
      ELSE
        client_id := p_list_value^.element_value^.name_value;
        p_list_value := p_list_value^.link;
      IFEND;
      STRINGREP (line, line_size, ' Client Mainframe: ', client_id);
      clp$put_display (display_control, ' ', clc$trim, status);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        EXIT /display_client/;
      IFEND;
      dfp$find_mainframe_id (client_id, {host_is_server} TRUE, mainframe_found, ignore_p_q_interf_table,
            p_cpu_queue, ignore_queue_index, ignore_p_q_interf_dir_entry);
      IF NOT mainframe_found THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, client_id, status);
        EXIT /display_client/;
      IFEND;
      p_host_application_info := p_cpu_queue^.queue_header.p_host_application_info;
      p_remote_application_info := p_cpu_queue^.queue_header.p_remote_application_info;

    /display_application/
      WHILE p_host_application_info <> NIL DO
        IF all_applications THEN
          application_name := p_host_application_info^.application_name;
        IFEND;
        IF p_host_application_info^.application_name = application_name THEN
          display_host_application_info ({host_is_server} TRUE, p_host_application_info,
                p_remote_application_info, p_cpu_queue, display_control, status);
          IF NOT status.normal THEN
            EXIT /display_client/;
          IFEND;
          application_found := TRUE;
          IF pvt [p$display_options].value^.keyword_value (1) = 'F' THEN
            display_remote_info (p_remote_application_info, p_cpu_queue, display_control, status);
            IF NOT status.normal THEN
              EXIT /display_application/;
            IFEND;
          IFEND;
          IF NOT all_applications THEN
            EXIT /display_application/;
          IFEND;
        IFEND;
        p_host_application_info := p_host_application_info^.next_p_application_info;
        p_remote_application_info := p_remote_application_info^.next_p_application_info;
      WHILEND /display_application/;

      IF p_host_application_info = NIL THEN
        IF NOT all_applications THEN
          STRINGREP (line, line_size, ' Undefined application: ', application_name);
          clp$put_display (display_control, line (1, line_size), clc$trim, status);
        IFEND;
      IFEND;

    FOREND /display_client/;

    IF (NOT application_found) AND (NOT all_applications) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
    IFEND;

    IF status.normal THEN
      clp$close_display (display_control, status);
    ELSE
      clp$close_display (display_control, ignore_status);
    IFEND;

    osp$clear_job_signature_lock (dfv$application_info_lock);
    osp$disestablish_cond_handler;

  PROCEND dfp$display_application_rpc;
?? OLDTITLE ??
?? NEWTITLE := 'Client: [XDCL, #GATE] dfp$display_client_app_info_cmn', EJECT ??

{ PURPOSE:
{   The purpose of this request is to process the command requesting
{   display of information concerning application defined on this client.

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

{  PROCEDURE display_client_app_info, discai (
{    application_name, an: any of name
{      key
{        all
{      keyend
{    anyend = all
{    server_mainframe_identifiers, server_mainframe_identifier, smi: any of
{      list of name 17..17
{        key
{          all
{        keyend
{      anyend = $REQUIRED
{      display_options, display_option, do : KEY
{       (brief, b)
{       (full, f)
{     keyend = brief
{     output, o : FILE = $output
{     status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 11] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        default_value: string (3),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (5),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 7, 28, 15, 11, 57, 978],
    clc$command, 11, 5, 1, 0, 0, 0, 5, ''], [
    ['AN                             ',clc$abbreviation_entry, 1],
    ['APPLICATION_NAME               ',clc$nominal_entry, 1],
    ['DISPLAY_OPTION                 ',clc$alias_entry, 3],
    ['DISPLAY_OPTIONS                ',clc$nominal_entry, 3],
    ['DO                             ',clc$abbreviation_entry, 3],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OUTPUT                         ',clc$nominal_entry, 4],
    ['SERVER_MAINFRAME_IDENTIFIER    ',clc$alias_entry, 2],
    ['SERVER_MAINFRAME_IDENTIFIERS   ',clc$nominal_entry, 2],
    ['SMI                            ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [2, 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, 69,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 2
    [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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [4, 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, 155,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 4
    [7, 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, 7],
{ PARAMETER 5
    [11, 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$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'all'],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$name_type], [17, 17]]
      ],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BRIEF                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FULL                           ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'brief'],
{ PARAMETER 4
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$application_name = 1,
      p$server_mainframe_identifiers = 2,
      p$display_options = 3,
      p$output = 4,
      p$status = 5;

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

    VAR
      all_applications: boolean,
      application_found: boolean,
      application_name: ost$name,
      command_name: ost$name,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      ignore_status: ost$status,
      line: string (200),
      line_size: integer,
      mainframe_found: boolean,
      next_p_info: ^dft$host_application_info,
      number_of_applications: dft$number_of_applications,
      p_cpu_queue: ^dft$cpu_queue,
      p_host_application_info: ^dft$host_application_info,
      p_list_value: ^clt$data_value,
      p_remote_application_info: ^dft$remote_application_info,
      p_server_list: ^dft$partner_mainframe_list,
      partner_count: dft$partner_mainframe_count,
      server_index: clt$list_size,
      server_list_count: clt$list_size,
      server_id: pmt$mainframe_id;

?? NEWTITLE := 'block_exit_handler', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to gracefully terminate the generated
{   display in case of an abnormal termination.

    PROCEDURE block_exit_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status,
        lock_status: ost$signature_lock_status;

      osp$test_sig_lock (dfv$application_info_lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (dfv$application_info_lock);
      IFEND;
      clp$close_display (display_control, ignore_status);

    PROCEND block_exit_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    command_name := ' DISPLAY_CLIENT_APPLICATION_INF';

    dfp$verify_system_administrator (command_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    application_name := pvt [p$application_name].value^.name_value;
    all_applications := application_name = 'ALL';

    server_list_count := clp$count_list_elements (pvt [p$server_mainframe_identifiers].value);

    IF pvt [p$server_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
      PUSH p_server_list: [1 .. 10];
      dfp$get_mainframe_list ({partners_are_servers} TRUE, p_server_list^, partner_count);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF partner_count = 0 THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$no_partner_mainframe,
              'DISPLAY_CLIENT_APPLICATION_INFO', status);
        RETURN;
      IFEND;
      IF partner_count > 10 THEN
        PUSH p_server_list: [1 .. partner_count];
        dfp$get_mainframe_list ({partners_are_servers} TRUE, p_server_list^, partner_count);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      server_list_count := partner_count;
    ELSE
      p_list_value := pvt [p$server_mainframe_identifiers].value;
      server_list_count := clp$count_list_elements (pvt [p$server_mainframe_identifiers].value);
    IFEND;

    osp$establish_block_exit_hndlr (^block_exit_handler);

    default_ring_attributes.r1 := 11;
    default_ring_attributes.r2 := 11;
    default_ring_attributes.r3 := 11;

    clp$open_display_reference (pvt [p$output].value^.file_value^, NIL, fsc$list, default_ring_attributes,
          display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    clp$put_display (display_control, command_name, clc$trim, status);

    osp$set_job_signature_lock (dfv$application_info_lock);

    application_found := FALSE;

  /display_server/
    FOR server_index := 1 TO server_list_count DO
      IF pvt [p$server_mainframe_identifiers].value^.kind = clc$keyword THEN {must be ALL
        server_id := p_server_list^ [server_index].mainframe_name;
      ELSE
        server_id := p_list_value^.element_value^.name_value;
        p_list_value := p_list_value^.link;
      IFEND;
      STRINGREP (line, line_size, ' Server Mainframe: ', server_id);
      clp$put_display (display_control, ' ', clc$trim, status);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        EXIT /display_server/;
      IFEND;
      dfp$find_mainframe_id (server_id, {host_is_server} FALSE, mainframe_found, ignore_p_q_interf_table,
            p_cpu_queue, ignore_queue_index, ignore_p_q_interf_dir_entry);
      IF NOT mainframe_found THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, server_id, status);
        RETURN;
      IFEND;
      p_host_application_info := p_cpu_queue^.queue_header.p_host_application_info;
      p_remote_application_info := NIL;

    /display_application/
      WHILE p_host_application_info <> NIL DO
        IF all_applications THEN
          application_name := p_host_application_info^.application_name;
        IFEND;
        IF p_host_application_info^.application_name = application_name THEN
          display_host_application_info ({host_is_server} FALSE, p_host_application_info,
                p_remote_application_info, p_cpu_queue, display_control, status);
          IF NOT status.normal THEN
            EXIT /display_server/;
          IFEND;
          application_found := TRUE;
          IF NOT all_applications THEN
            EXIT /display_application/;
          IFEND;
        IFEND;

        p_host_application_info := p_host_application_info^.next_p_application_info;

      WHILEND /display_application/;

      IF pvt [p$display_options].value^.keyword_value (1) = 'F' THEN
        { Since client applications may be defined in a different order than applications on the server,
        { the remote application info array is processed separately from the client info

        p_remote_application_info := p_cpu_queue^.queue_header.p_remote_application_info;
        IF p_remote_application_info = NIL THEN
          clp$put_display (display_control, ' ', clc$trim, status);
          clp$put_display (display_control, ' No remote_information from server.', clc$trim, status);
          CYCLE /display_server/;
        IFEND;

      /display_remote/
        WHILE p_remote_application_info <> NIL DO
          IF all_applications THEN
            application_name := p_remote_application_info^.application_name;
          IFEND;
          IF p_remote_application_info^.application_name = application_name THEN
            clp$put_display (display_control, '  ', clc$trim, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            STRINGREP (line, line_size, '  Application_name: ', application_name);
            clp$put_display (display_control, line (1, line_size), clc$trim, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            application_found := TRUE;
            display_remote_info (p_remote_application_info, p_cpu_queue, display_control, status);
            IF NOT status.normal THEN
              display_status (status);
              status.normal := TRUE;
            IFEND;
            IF NOT all_applications THEN
              EXIT /display_remote/;
            IFEND;
          IFEND;
          p_remote_application_info := p_remote_application_info^.next_p_application_info;
        WHILEND /display_remote/;
      IFEND;

      IF p_host_application_info = NIL THEN
        IF NOT all_applications THEN
          STRINGREP (line, line_size, ' Undefined application: ', application_name);
          clp$put_display (display_control, line (1, line_size), clc$trim, status);
        IFEND;
      IFEND;

    FOREND /display_server/;

    IF (NOT application_found) AND (NOT all_applications) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
    IFEND;

    IF status.normal THEN
      clp$close_display (display_control, status);
    ELSE
      clp$close_display (display_control, ignore_status);
    IFEND;

    osp$clear_job_signature_lock (dfv$application_info_lock);
    osp$disestablish_cond_handler;

  PROCEND dfp$display_client_app_info_cmn;

?? OLDTITLE ??
?? TITLE := ' [XDCL, #GATE] dfp$get_application_info', EJECT ??
*copyc dfh$get_application_info

  PROCEDURE [XDCL, #GATE] dfp$get_application_info
    (    partner_mainframe_id: pmt$mainframe_id;
         partner_is_server: boolean;
         application_name: ost$name;
     VAR sequence_pointer: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      application_found: boolean,
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_host_application_info: ^dft$host_application_info;

    status.normal := TRUE;
    sequence_pointer := NIL;
    application_found := FALSE;

    dfp$find_mainframe_id (partner_mainframe_id, NOT partner_is_server, mainframe_found,
          ignore_p_q_interf_table, p_cpu_queue, ignore_queue_index, ignore_p_q_interf_dir_entry);
    IF NOT mainframe_found THEN
      IF partner_is_server THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, partner_mainframe_id, status);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, partner_mainframe_id, status);
      IFEND;
      RETURN;
    IFEND;


    IF p_cpu_queue^.queue_header.p_host_application_info = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
      RETURN;
    IFEND;

    p_host_application_info := p_cpu_queue^.queue_header.p_host_application_info;

  /find_application/
    WHILE p_host_application_info <> NIL DO
      IF p_host_application_info^.application_name = application_name THEN
        application_found := TRUE;
        EXIT /find_application/;
      IFEND;
      p_host_application_info := p_host_application_info^.next_p_application_info;
    WHILEND /find_application/;
    IF NOT application_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
      RETURN;
    IFEND;

    sequence_pointer := p_host_application_info^.sequence_pointer;

  PROCEND dfp$get_application_info;
?? NEWTITLE := 'Server: [XDCL] dfp$send_remote_app_info ', EJECT ??

{ PURPOSE:
{   The purpose of this request is to satisfy the requirement for a remote
{   procedure to transfer application information to the client.

  PROCEDURE [XDCL] dfp$send_remote_app_info
    (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
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      line: string (200),
      line_size: integer,
      log_string: string (80),
      log_string_length: integer,
      mainframe_found: boolean,
      p_application_name: ^ost$name,
      p_cpu_queue: ^dft$cpu_queue,
      p_mainframe_name: ^pmt$mainframe_id,
      p_number_of_applications: ^dft$number_of_applications,
      p_proc_list: ^array [ * ] of dft$rpc_procedure_address_entry,
      p_remote_application_info: ^dft$remote_application_info,
      p_send_remote_app_info: ^dft$remote_application_info,
      p_total_proc_count: ^dft$total_number_of_app_procs;

    status.normal := TRUE;
    send_parameters_length := 0;

    NEXT p_mainframe_name IN p_param_received_from_client;

    dfp$find_mainframe_id (p_mainframe_name^, {host_is_server=} TRUE, mainframe_found,
          ignore_p_q_interf_table, p_cpu_queue, ignore_queue_index, ignore_p_q_interf_dir_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, p_mainframe_name^, status);
      RETURN;
    IFEND;

    NEXT p_number_of_applications IN p_data_to_client;
    NEXT p_total_proc_count IN p_data_to_client;
    p_number_of_applications^ := 0;
    p_total_proc_count^ := 0;
    IF p_cpu_queue^.queue_header.p_remote_application_info = NIL THEN
      data_size_to_send_to_client := i#current_sequence_position (p_data_to_client);
      RETURN;
    IFEND;

    p_remote_application_info := p_cpu_queue^.queue_header.p_remote_application_info;
    WHILE p_remote_application_info <> NIL DO
      p_number_of_applications^ := p_number_of_applications^ +1;
      NEXT p_send_remote_app_info IN p_data_to_client;
      p_send_remote_app_info^ := p_remote_application_info^;
      p_remote_application_info := p_remote_application_info^.next_p_application_info;
    WHILEND;

    p_total_proc_count^ := UPPERBOUND (p_cpu_queue^.queue_header.p_application_rpc_list^);

    NEXT p_proc_list: [1 .. p_total_proc_count^] IN p_data_to_client;
    p_proc_list^ := p_cpu_queue^.queue_header.p_application_rpc_list^;

    data_size_to_send_to_client := i#current_sequence_position (p_data_to_client);

    STRINGREP (log_string, log_string_length, ' Client ', p_mainframe_name^, ' Total_applications:',
          p_number_of_applications^, '   Total_procedures:', p_total_proc_count^);
    log_display ($pmt$ascii_logset [pmc$system_log], log_string (1, log_string_length));
    IF dfv$file_server_debug_enabled THEN
      display (log_string (1, log_string_length));
      display_to_console (log_string (1, log_string_length));
    IFEND;

  PROCEND dfp$send_remote_app_info;
?? OLDTITLE ??
?? NEWTITLE := 'add_host_application_info', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to allocate in server-wired the
{   specified host application information.

  PROCEDURE add_host_application_info
    (    host_application_info: dft$host_application_info;
         host_is_server: boolean;
         partner_id: pmt$mainframe_id;
         sequence_size: dft$send_data_size;
         p_attached_file_info: ^array [ * ] of ^fst$file_reference;
         p_library_file_path: ^fst$file_reference;
         command_name: ost$name;
     VAR p_cpu_queue: ^dft$cpu_queue;
     VAR status: ost$status);

    VAR
      attached_file_index: dft$number_of_attached_files,
      defined_application_count: dft$number_of_applications,
      hold_p_host_application_info: ^dft$host_application_info,
      number_of_attached_files: dft$number_of_attached_files,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_host_application_info: ^dft$host_application_info;

    status.normal := TRUE;

    check_partner_state (partner_id, host_is_server, command_name, p_cpu_queue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_cpu_queue_header := ^p_cpu_queue^.queue_header;

    hold_p_host_application_info := NIL;
    p_host_application_info := p_cpu_queue_header^.p_host_application_info;
    defined_application_count := 0;

  /find_last_application/
    WHILE p_host_application_info <> NIL DO
      IF p_host_application_info^.application_name = host_application_info.application_name THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$application_already_defined,
              host_application_info.application_name, status);
        RETURN;
      IFEND;
      defined_application_count := defined_application_count + 1;
      hold_p_host_application_info := p_host_application_info;
      p_host_application_info := p_host_application_info^.next_p_application_info;
    WHILEND /find_last_application/;

    IF defined_application_count >= dfc$max_number_of_applications THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$max_application_count, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, dfc$max_number_of_applications, 10, FALSE,
            status);
      RETURN;
    IFEND;

    ALLOCATE p_host_application_info IN dfv$server_wired_heap^;
    IF p_host_application_info = NIL THEN
      osp$system_error (' NIL p_host_application_info', NIL);
    IFEND;

    p_host_application_info^ := host_application_info;

    IF p_library_file_path = NIL THEN
      p_host_application_info^.p_library_file_path := NIL;
    ELSE
      ALLOCATE p_host_application_info^.p_library_file_path: [#SIZE (p_library_file_path^)] IN
            dfv$server_wired_heap^;
      IF p_host_application_info^.p_library_file_path = NIL THEN
        osp$system_error (' NIL p_library_file_path', NIL);
      IFEND;
      p_host_application_info^.p_library_file_path^ := p_library_file_path^;
    IFEND;

    IF sequence_size > 0 THEN
      ALLOCATE p_host_application_info^.sequence_pointer: [[REP sequence_size OF cell]] IN
            dfv$server_wired_heap^;
      IF p_host_application_info^.sequence_pointer = NIL THEN
        osp$system_error (' NIL sequence_pointer', NIL);
      IFEND;
      RESET p_host_application_info^.sequence_pointer;
      pmp$zero_out_table (p_host_application_info^.sequence_pointer, sequence_size);
    ELSE
      p_host_application_info^.sequence_pointer := NIL;
    IFEND;

    IF p_attached_file_info = NIL THEN
      p_host_application_info^.p_attached_file_info := NIL;
    ELSE
      number_of_attached_files := UPPERBOUND (p_attached_file_info^);
      ALLOCATE p_host_application_info^.p_attached_file_info: [1 .. number_of_attached_files] IN
            dfv$server_wired_heap^;
      IF p_host_application_info^.p_attached_file_info = NIL THEN
        osp$system_error (' NIL p_attached_file_info', NIL);
      IFEND;
      FOR attached_file_index := 1 TO number_of_attached_files DO
        ALLOCATE p_host_application_info^.p_attached_file_info^
              [attached_file_index]: [#SIZE (p_attached_file_info^ [attached_file_index]^)] IN
              dfv$server_wired_heap^;
        IF p_host_application_info^.p_attached_file_info^ [attached_file_index] = NIL THEN
          osp$system_error (' NIL p_attached_file_info^', NIL);
        IFEND;
        p_host_application_info^.p_attached_file_info^ [attached_file_index]^ :=
              p_attached_file_info^ [attached_file_index]^;
      FOREND;
    IFEND;

{ Link in with CPU queue.
    IF hold_p_host_application_info = NIL THEN
      p_cpu_queue_header^.p_host_application_info := p_host_application_info;
    ELSE
      hold_p_host_application_info^.next_p_application_info := p_host_application_info;
    IFEND;

  PROCEND add_host_application_info;
?? OLDTITLE ??
?? NEWTITLE := 'add_remote_application_info', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to add to server-wired the remote application
{   information and the extended application address list.
{ NOTES:
{   Although the remote application info pointed to by the cpu queue header,
{   the application rpc list  consists of information for all applications.


  PROCEDURE add_remote_application_info
    (    remote_application_info: dft$remote_application_info;
         p_cpu_queue: ^dft$cpu_queue;
         p_application_rpc_list: ^array [ * ] of dft$rpc_procedure_address_entry;
     VAR status: ost$status);

    VAR
      add_procedure_count: dft$number_of_procs_per_app,
      application_index: dft$number_of_applications,
      hold_p_application_rpc_list: ^array [ * ] of dft$rpc_procedure_address_entry,
      hold_p_remote_application_info: ^dft$remote_application_info,
      next_procedure_ordinal: dft$procedure_address_ordinal,
      old_procedure_count: dft$total_number_of_app_procs,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_remote_application_info: ^dft$remote_application_info,
      procedure_index: dft$total_number_of_app_procs;

    status.normal := TRUE;
    IF p_application_rpc_list = NIL THEN
      RETURN;
    IFEND;

    p_cpu_queue_header := ^p_cpu_queue^.queue_header;
    application_index := 1;
    p_remote_application_info := p_cpu_queue_header^.p_remote_application_info;
    hold_p_remote_application_info := NIL;

  /find_last_application/
    WHILE p_remote_application_info <> NIL DO
      application_index := application_index + 1;
      hold_p_remote_application_info := p_remote_application_info;
      p_remote_application_info := p_remote_application_info^.next_p_application_info;
    WHILEND /find_last_application/;

    IF p_cpu_queue_header^.p_application_rpc_list <> NIL THEN
      check_for_dup_proc_names (p_cpu_queue_header^.p_application_rpc_list, p_application_rpc_list, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    ALLOCATE p_remote_application_info IN dfv$server_wired_heap^;
    IF p_remote_application_info = NIL THEN
      osp$system_error (' NIL p_remote_application_info', NIL);
    IFEND;

    IF hold_p_remote_application_info <> NIL THEN
      hold_p_remote_application_info^.next_p_application_info := p_remote_application_info;
    ELSE
      p_cpu_queue_header^.p_remote_application_info := p_remote_application_info;
    IFEND;

    p_remote_application_info^ := remote_application_info;

{ Process rpc address list
    add_procedure_count := UPPERBOUND (p_application_rpc_list^);
    old_procedure_count := 0;
    next_procedure_ordinal := SUCC (dfc$last_system_procedure);

    IF p_cpu_queue_header^.p_application_rpc_list <> NIL THEN
      old_procedure_count := UPPERBOUND (p_cpu_queue_header^.p_application_rpc_list^);
      PUSH hold_p_application_rpc_list: [1 .. old_procedure_count];
      hold_p_application_rpc_list^ := p_cpu_queue_header^.p_application_rpc_list^;
      FREE p_cpu_queue_header^.p_application_rpc_list IN dfv$server_wired_heap^;

      ALLOCATE p_cpu_queue^.queue_header.p_application_rpc_list:
            [1 .. (old_procedure_count + add_procedure_count)] IN dfv$server_wired_heap^;
      IF p_cpu_queue^.queue_header.p_application_rpc_list = NIL THEN
        osp$system_error (' NIL p_application_rpc_list', NIL);
      IFEND;

    /copy_old_procedure_list/
      FOR procedure_index := 1 TO old_procedure_count DO
        p_cpu_queue_header^.p_application_rpc_list^ [procedure_index] :=
              hold_p_application_rpc_list^ [procedure_index];
        next_procedure_ordinal := SUCC (next_procedure_ordinal);
      FOREND /copy_old_procedure_list/;

    ELSE
      ALLOCATE p_cpu_queue^.queue_header.p_application_rpc_list: [1 .. add_procedure_count] IN
            dfv$server_wired_heap^;
      IF p_cpu_queue^.queue_header.p_application_rpc_list = NIL THEN
        osp$system_error (' NIL p_application_rpc_list', NIL);
      IFEND;
    IFEND;

    p_remote_application_info^.first_procedure_rpc_ordinal := next_procedure_ordinal;

  /add_new_procedures/
    FOR procedure_index := 1 TO add_procedure_count DO
      p_application_rpc_list^ [procedure_index].application_index := application_index;
      p_cpu_queue_header^.p_application_rpc_list^ [procedure_index + old_procedure_count] :=
            p_application_rpc_list^ [procedure_index];
    FOREND /add_new_procedures/;

  PROCEND add_remote_application_info;
?? OLDTITLE ??
?? NEWTITLE := 'check_for dup_proc_names', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to check that no name of remote procedures
{   being added duplicate a name already in the remote procedure list. It is
{   assumed that all names in the new list are unique.

  PROCEDURE check_for_dup_proc_names
    (    old_procedure_list: ^array [ * ] of dft$rpc_procedure_address_entry;
         new_procedure_list: ^array [ * ] of dft$rpc_procedure_address_entry;
     VAR status: ost$status);

    VAR
      old_index: dft$total_number_of_app_procs,
      new_index: dft$number_of_procs_per_app,
      proc_name: pmt$program_name;

    IF UPPERBOUND (old_procedure_list^) + UPPERBOUND (new_procedure_list^) > dfc$max_number_of_app_procs THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$max_remote_proc_count, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, dfc$max_number_of_app_procs, 10, FALSE,
            status);
      RETURN;
    IFEND;

    FOR new_index := 1 TO UPPERBOUND (new_procedure_list^) DO
      proc_name := new_procedure_list^ [new_index].debug_display;

    /search_old_procedure_list/
      FOR old_index := 1 TO UPPERBOUND (old_procedure_list^) DO
        IF proc_name = old_procedure_list^ [old_index].debug_display THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$procedure_already_defined, proc_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, ' (previous) ', status);
          RETURN;
        IFEND;
      FOREND /search_old_procedure_list/;
    FOREND;

    status.normal := TRUE;

  PROCEND check_for_dup_proc_names;
?? OLDTITLE ??
?? NEWTITLE := 'check_partner_state', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to obtain the state of the partner mainframe
{   and to check that it is either terminated or awaiting_recovery.

  PROCEDURE check_partner_state
    (    partner_id: pmt$mainframe_id;
         host_is_server: boolean;
         command_name: ost$name;
     VAR p_cpu_queue: ^dft$cpu_queue;
     VAR status: ost$status);

    VAR
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      mainframe_found: boolean,
      partner_state: dft$server_state;

    status.normal := TRUE;

    dfp$find_mainframe_id (partner_id, host_is_server, mainframe_found, ignore_p_q_interf_table, p_cpu_queue,
          ignore_queue_index, ignore_p_q_interf_dir_entry);
    IF NOT mainframe_found THEN
      IF host_is_server THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, partner_id, status);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, partner_id, status);
      IFEND;
      RETURN;
    IFEND;

    partner_state := p_cpu_queue^.queue_header.partner_status.server_state;
    IF (partner_state <> dfc$terminated) AND (partner_state <> dfc$awaiting_recovery) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_state_for_def_app, command_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, partner_id, status);
      RETURN;
    IFEND;

  PROCEND check_partner_state;
?? OLDTITLE ??
?? NEWTITLE := ' delete_host_application', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to delete host application information
{   associated with a particular partner mainframe.

  PROCEDURE delete_host_application
    (    application_name: ost$name;
         mainframe_id: pmt$mainframe_id;
         host_is_server: boolean;
         command_name: ost$name;
     VAR status: ost$status);

    VAR
      attached_file_index: dft$number_of_attached_files,
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_host_application_info: ^dft$host_application_info,
      p_p_host_application_info: ^^dft$host_application_info;

    status.normal := TRUE;
    check_partner_state (mainframe_id, host_is_server, command_name, p_cpu_queue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_host_application_info := p_cpu_queue^.queue_header.p_host_application_info;
    p_p_host_application_info := ^p_cpu_queue^.queue_header.p_host_application_info;

  /search_for_application/
    WHILE p_host_application_info <> NIL DO
      IF p_host_application_info^.application_name = application_name THEN
        IF p_host_application_info^.p_attached_file_info <> NIL THEN

        /free_file_info/
          FOR attached_file_index := 1 TO UPPERBOUND (p_host_application_info^.p_attached_file_info^) DO
            FREE p_host_application_info^.p_attached_file_info^ [attached_file_index] IN
                  dfv$server_wired_heap^;
          FOREND /free_file_info/;
          FREE p_host_application_info^.p_attached_file_info IN dfv$server_wired_heap^;
        IFEND;

        IF p_host_application_info^.sequence_pointer <> NIL THEN
          FREE p_host_application_info^.sequence_pointer IN dfv$server_wired_heap^;
        IFEND;

        IF p_host_application_info^.p_library_file_path <> NIL THEN
          FREE p_host_application_info^.p_library_file_path IN dfv$server_wired_heap^;
        IFEND;
        p_p_host_application_info^ := p_host_application_info^.next_p_application_info;
        FREE p_host_application_info IN dfv$server_wired_heap^;
        RETURN;
      IFEND;
      p_p_host_application_info := ^p_host_application_info^.next_p_application_info;
      p_host_application_info := p_host_application_info^.next_p_application_info;
    WHILEND /search_for_application/;

    osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);

  PROCEND delete_host_application;
?? OLDTITLE ??
?? NEWTITLE := ' delete_remote_application', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to remove from server-wired the remote
{   application information associated with a particular partner mainframe.

  PROCEDURE delete_remote_application
    (    application_name: ost$name;
         mainframe_id: pmt$mainframe_id;
         host_is_server: boolean;
     VAR status: ost$status);

    VAR
      application_found_index: dft$number_of_applications,
      application_index: dft$number_of_applications,
      free_p_remote_application_info: ^dft$remote_application_info,
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      last_procedure_index: dft$total_number_of_app_procs,
      mainframe_found: boolean,
      old_procedure_count: dft$total_number_of_app_procs,
      p_cpu_queue: ^dft$cpu_queue,
      p_new_application_rpc_list: ^array [ * ] of dft$rpc_procedure_address_entry,
      p_next_remote_application_info: ^dft$remote_application_info,
      p_old_application_rpc_list: ^array [ * ] of dft$rpc_procedure_address_entry,
      p_p_remote_application_info: ^^dft$remote_application_info,
      p_remote_application_info: ^dft$remote_application_info,
      procedure_index: dft$total_number_of_app_procs,
      procedure_ordinal: dft$procedure_address_ordinal,
      remove_procedure_count: dft$number_of_procs_per_app,
      start_remove_index: dft$total_number_of_app_procs;

    status.normal := TRUE;
    dfp$find_mainframe_id (mainframe_id, host_is_server, mainframe_found, ignore_p_q_interf_table,
          p_cpu_queue, ignore_queue_index, ignore_p_q_interf_dir_entry);
    IF NOT mainframe_found THEN
      IF host_is_server THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_id, status);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_id, status);
      IFEND;
      RETURN;
    IFEND;

    p_remote_application_info := p_cpu_queue^.queue_header.p_remote_application_info;
    p_old_application_rpc_list := p_cpu_queue^.queue_header.p_application_rpc_list;
    p_p_remote_application_info := ^p_cpu_queue^.queue_header.p_remote_application_info;
    free_p_remote_application_info := NIL;
    application_index := 0;
    application_found_index := 0;

  /find_application/
    WHILE p_remote_application_info <> NIL DO
      application_index := application_index + 1;
      IF p_remote_application_info^.application_name = application_name THEN
        application_found_index := application_index;
        p_p_remote_application_info^ := p_remote_application_info^.next_p_application_info;
        IF p_cpu_queue^.queue_header.p_application_rpc_list <> NIL THEN
          old_procedure_count := UPPERBOUND (p_old_application_rpc_list^);
          remove_procedure_count := p_remote_application_info^.number_of_procedures;
          procedure_ordinal := p_remote_application_info^.first_procedure_rpc_ordinal;
          start_remove_index := $INTEGER (p_remote_application_info^.first_procedure_rpc_ordinal) -
                $INTEGER (dfc$last_system_procedure);
          IF old_procedure_count > remove_procedure_count THEN
            ALLOCATE p_new_application_rpc_list: [1 .. (old_procedure_count - remove_procedure_count)] IN
                  dfv$server_wired_heap^;
            IF p_new_application_rpc_list = NIL THEN
              osp$system_error (' NIL p_new_application_rpc_list', NIL);
            IFEND;
            FOR procedure_index := 1 TO start_remove_index - 1 DO
              p_new_application_rpc_list^ [procedure_index] := p_old_application_rpc_list^ [procedure_index];
            FOREND;
            last_procedure_index := start_remove_index - 1;
          ELSE
            p_new_application_rpc_list := NIL;
          IFEND;
          free_p_remote_application_info := p_remote_application_info;
          application_index := application_index - 1; {for next application
        IFEND;

      ELSEIF application_found_index > 0 THEN { Entry is beyond the deleted entry
        p_remote_application_info^.first_procedure_rpc_ordinal := procedure_ordinal;
        FOR procedure_index := (last_procedure_index + 1) TO
              (last_procedure_index + p_remote_application_info^.number_of_procedures) DO
          p_new_application_rpc_list^ [procedure_index] := p_old_application_rpc_list^
                [procedure_index + remove_procedure_count];
          p_new_application_rpc_list^ [procedure_index].application_index := application_index;
          procedure_ordinal := SUCC (procedure_ordinal);
        FOREND;

      IFEND;
      p_p_remote_application_info := ^p_remote_application_info^.next_p_application_info;
      p_remote_application_info := p_remote_application_info^.next_p_application_info;
    WHILEND /find_application/;

    IF application_found_index = 0 THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
      RETURN;
    IFEND;

    IF free_p_remote_application_info <> NIL THEN
      FREE free_p_remote_application_info IN dfv$server_wired_heap^;
      free_p_remote_application_info := NIL;
    IFEND;

    FREE p_cpu_queue^.queue_header.p_application_rpc_list IN dfv$server_wired_heap^;
    p_cpu_queue^.queue_header.p_application_rpc_list := p_new_application_rpc_list;

  PROCEND delete_remote_application;
?? OLDTITLE ??
?? NEWTITLE := 'display_host_application_info', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to display the information associated
{   with one application.

  PROCEDURE display_host_application_info
    (    host_is_server: boolean;
         p_host_application_info: ^dft$host_application_info;
         p_remote_application_info: ^dft$remote_application_info;
         p_cpu_queue: ^dft$cpu_queue;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      first_proc_index: dft$total_number_of_app_procs,
      i: dft$number_of_attached_files,
      line: string (200),
      line_size: integer,
      next_p_app_info: ^dft$host_application_info,
      number_of_attached_files: dft$number_of_attached_files,
      p_app_info: ^dft$host_application_info,
      p_attached_file_info: ^array [ * ] of ^fst$file_reference,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      sequence_size: dft$send_data_size,
      str: string (25);

    clp$put_display (display_control, '  ', clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    p_app_info := p_host_application_info;
    p_cpu_queue_header := ^p_cpu_queue^.queue_header;

    STRINGREP (line, line_size, '  Application_name: ', p_app_info^.application_name);
    clp$put_display (display_control, line (1, line_size), clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_app_info^.p_library_file_path = NIL THEN
      STRINGREP (line, line_size, '  Library: (none specified)');
    ELSE
      STRINGREP (line, line_size, '  Library: ', p_app_info^.p_library_file_path^);
    IFEND;
    clp$put_display (display_control, line (1, line_size), clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF dfv$file_server_debug_enabled THEN
      STRINGREP (line, line_size, '  p_library_file_path: ', p_app_info^.p_library_file_path);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
    IFEND;
    IF p_app_info^.state_change_procedure_name = osc$null_name THEN
      STRINGREP (line, line_size, '  State_change_procedure:  (none)');
    ELSE
      STRINGREP (line, line_size, '  State_change_procedure: ', p_app_info^.state_change_procedure_name);
    IFEND;
    clp$put_display (display_control, line (1, line_size), clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF p_app_info^.sequence_pointer = NIL THEN
      sequence_size := 0;
    ELSE
      sequence_size := #SIZE (p_app_info^.sequence_pointer^);
    IFEND;
    STRINGREP (line, line_size, '  Sequence_size: ', sequence_size);
    clp$put_display (display_control, line (1, line_size), clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF NOT host_is_server THEN
      RETURN;
    IFEND;

    IF dfv$file_server_debug_enabled THEN
      IF p_app_info^.p_attached_file_info = NIL THEN
        number_of_attached_files := 0;
      ELSE
        p_attached_file_info := p_app_info^.p_attached_file_info;
        number_of_attached_files := UPPERBOUND (p_attached_file_info^);
      IFEND;
      STRINGREP (line, line_size, '  Number of Attach_files: ', number_of_attached_files);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      FOR i := 1 TO number_of_attached_files DO
        STRINGREP (line, line_size, '    ', p_attached_file_info^ [i]^);
        clp$put_display (display_control, line (1, line_size), clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
    IFEND;

    IF p_remote_application_info^.number_of_procedures > 0 THEN
      STRINGREP (line, line_size, '  Remote procedure count: ',
            p_remote_application_info^.number_of_procedures);
    ELSE
      STRINGREP (line, line_size, '  Remote procedure count: (none)');
    IFEND;
    clp$put_display (display_control, line (1, line_size), clc$trim, status);

  PROCEND display_host_application_info;
?? OLDTITLE ??
?? NEWTITLE := 'display_remote_info', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to display the remote application information.

  PROCEDURE display_remote_info
    (    p_remote_application_info: ^dft$remote_application_info;
         p_cpu_queue: ^dft$cpu_queue;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      first_proc_index: dft$total_number_of_app_procs,
      line: string (200),
      line_size: integer,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      proc_index: dft$total_number_of_app_procs,
      procedure_ordinal: dft$procedure_address_ordinal,
      str: string (25);

    clp$put_display (display_control, '  ', clc$trim, status);
    status.normal := TRUE;
    p_cpu_queue_header := ^p_cpu_queue^.queue_header;

    IF p_cpu_queue_header^.p_application_rpc_list = NIL THEN
      clp$put_display (display_control, ' No extended procedure list', clc$trim, status);
      RETURN;
    IFEND;
    clp$put_display (display_control, '  Remote_procedures:', clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    first_proc_index := $INTEGER (p_remote_application_info^.first_procedure_rpc_ordinal) -
          $INTEGER (dfc$last_system_procedure);
    procedure_ordinal := p_remote_application_info^.first_procedure_rpc_ordinal;
    FOR proc_index := first_proc_index TO (first_proc_index +
          p_remote_application_info^.number_of_procedures - 1) DO
      clp$put_display (display_control, '  ', clc$trim, status);
      STRINGREP (line, line_size, '    Name: ', p_cpu_queue_header^.p_application_rpc_list^ [proc_index].
            debug_display);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF dfv$file_server_debug_enabled THEN
        STRINGREP (line, line_size, '    Procedure ordinal: ', procedure_ordinal);
        clp$put_display (display_control, line (1, line_size), clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      IF p_cpu_queue_header^.p_application_rpc_list^ [proc_index].request_restartable =
            dfc$request_restartable THEN
        str := 'TRUE';
      ELSE
        str := 'FALSE';
      IFEND;
      STRINGREP (line, line_size, '    Request_restartable: ', str);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      CASE p_cpu_queue_header^.p_application_rpc_list^ [proc_index].job_recovery_location OF
      = dfc$job_rec_started_by_caller =
        str := 'caller_starts_recovery';
      = dfc$job_rec_in_unavailable_wait =
        str := 'caller_waits_for_volume';
      ELSE
        str := ' ???  ';
      CASEND;
      STRINGREP (line, line_size, '    Job_recovery_location: ', str);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF p_cpu_queue_header^.p_application_rpc_list^ [proc_index].recover_job_on_server_call THEN
        str := 'TRUE'
      ELSE
        str := 'FALSE';
      IFEND;
      STRINGREP (line, line_size, '    Recover_job_on_server_call: ',
            p_cpu_queue_header^.p_application_rpc_list^ [proc_index].recover_job_on_server_call);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF dfv$file_server_debug_enabled THEN
        STRINGREP (line, line_size, '    Procedure_version: ', p_cpu_queue_header^.
              p_application_rpc_list^ [proc_index].procedure_version);
        clp$put_display (display_control, line (1, line_size), clc$trim, status);
        STRINGREP (line, line_size, '    Procedure_name_checksum: ',
              p_cpu_queue_header^.p_application_rpc_list^ [proc_index].procedure_name_checksum);
        clp$put_display (display_control, line (1, line_size), clc$trim, status);
        STRINGREP (line, line_size, '    Application_index: ', p_cpu_queue_header^.
              p_application_rpc_list^ [proc_index].application_index);
        clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IFEND;

      STRINGREP (line, line_size, '    Application_ring: ', p_cpu_queue_header^.
            p_application_rpc_list^ [proc_index].application_ring);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF p_cpu_queue_header^.p_application_rpc_list^ [proc_index].allow_terminate_break THEN
        str := 'TRUE';
      ELSE
        str := 'FALSE';
      IFEND;

      STRINGREP (line, line_size, '    Allow_terminate_break: ', str);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF p_cpu_queue_header^.p_application_rpc_list^ [proc_index].allow_pause_break THEN
        str := 'TRUE';
      ELSE
        str := 'FALSE';
      IFEND;
      STRINGREP (line, line_size, '    Allow_pause_break: ', str);
      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF proc_index < (first_proc_index + p_remote_application_info^.number_of_procedures - 1) THEN
        procedure_ordinal := SUCC (procedure_ordinal);
      IFEND;

    FOREND;
  PROCEND display_remote_info;
?? OLDTITLE ??

MODEND dfm$manage_application_info;
