?? RIGHT := 110 ??
?? NEWTITLE := ' NOS/VE File Server: Client: Asynchronous Connection Manager', EJECT ??
MODULE dfm$manage_server_connection;

{==============================================================================
{
{  This module is an asynchronous task running on the Client and managing the
{  connection with the DF Server mainframe. This includes reacting to the
{  operator's commands:
{     Activate_Server
{     Deactivate_Server
{     Define_Served_Family
{     Terminate_Server
{
{  as well as sending periodic polls to the Server, processing its poll
{  replies, and timing out the user requests.
{
{
{  The operator requests come to this task indirectly: the various action
{  signals are set in the CPU_Queue header (Partner_Status record) by the
{  command processors and this task acts upon them.
{  One of the signals (Deactivate_Server) may come from the Server as a
{  result of a subcommand by the operator of the Server mainframe.
{  dfm$manage_server_connection will treat it as if it came from the
{  native operator.
{
{  Abnormal conditions will cause dfm$manage_server_connection to abort
{  the connection with the Server and to terminate or timeout itself.
{  Such conditions
{  include: garbled poll replies from the Server, repeated time-outs of
{  of the same request (either user or poll), and negative reply to the
{  attempt to verify Server Queue definition. A negative reply to
{  Verify_Family request, however, does not however cause an abort. The
{  Family will remain inaccessible to the users in this case.
{
{  Additionally this procedure detects timeout and termination detected
{  from monitor mode.
{==============================================================================

?? NEWTITLE := '    Global Declarations ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clp$scan_parameter_list
*copyc dfc$poll_constants
*copyc dfc$test_jr_constants
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfi$log_display
*copyc dfp$attach_application_library
*copyc dfp$change_family_server_state
*copyc dfp$change_family_verification
*copyc dfp$change_job_leveler_state
*copyc dfp$crack_mainframe_id
*copyc dfp$delete_family_if_last
*copyc dfp$execute_state_change_task
*copyc dfp$find_mainframe_id
*copyc dfp$format_task_name
*copyc dfp$format_verify_family
*copyc dfp$free_image_file
*copyc dfp$get_highest_sf_lifetime
*copyc dfp$get_queue_directory_index
*copyc dfp$queue_task_request
*copyc dfp$load_pp_if_first
*copyc dfp$register_served_families
*copyc dfp$reset_mainframe_tables
*copyc dfp$return_application_library
*copyc dfp$term_requests_to_server
*copyc dfp$timeout_requests_to_server
*copyc dfp$timeout_server_files
*copyc dfp$unload_pp_if_last
*copyc dfp$verify_system_administrator
*copyc dfp$await_all_queue_entrys_free
*copyc dfp$word_boundary
*copyc dft$command_buffer
*copyc dft$cpu_queue
*copyc dft$display_identifier
*copyc dft$entry_type
*copyc dft$family_list
*copyc dft$poll_family_list
*copyc dft$poll_header
*copyc dft$poll_message
*copyc dft$poll_queue_information
*copyc dft$procedure_address_ordinal
*copyc dft$queue_index
*copyc dft$queue_interface_directory
*copyc dft$rb_file_server_request
*copyc dfv$display_poll
*copyc dfv$file_server_debug_enabled
*copyc dfv$poll_type_string
*copyc dfv$send_command_flags
*copyc dfv$job_recovery_enabled
*copyc i#call_monitor
*copyc i#current_sequence_position
*copyc jmp$ready_job_leveler_task
*copyc ofd$type_definition
*copyc ose$system_task_exceptions
*copyc osp$append_status_parameter
*copyc osp$deactivate_system_task
*copyc osp$format_message
*copyc osp$get_cause_of_idle
*copyc osp$set_status_abnormal
*copyc osp$set_system_task_restart
*copyc osp$system_error
*copyc oss$job_paged_literal
*copyc oss$task_shared
*copyc osv$task_shared_heap
*copyc pmd$system_log_interface
*copyc pmp$compute_time_dif_in_seconds
*copyc pmp$exit
*copyc pmp$execute
*copyc pmp$get_compact_date_time
*copyc pmp$get_executing_task_gtid
*copyc pmp$get_mainframe_id
*copyc pmp$get_time
*copyc pmp$wait
*copyc pmt$binary_mainframe_id
*copyc pmt$mainframe_id
*copyc pmt$program_description
*copyc syp$hang_if_system_jrt_set
*copyc syp$invoke_system_debugger
?? POP ??

  CONST
    get_remote_app_start_proc = 'DFP$REQUEST_REMOTE_APP_INFO',
    idle_task_start_proc = 'DFP$IDLE_REQUESTS_TO_SERVER',
    recovery_task_start_proc = 'DFP$RECOVER_REQUESTS_TO_SERVER',
    verify_jobs_task_start_proc = 'DFP$VERIFY_CLIENT_JOBS';

  VAR
    dfv$p_get_app_info_status: [XDCL, oss$task_shared] ^pmt$task_status := NIL,
    dfv$p_idle_task_status: [XDCL, oss$task_shared] ^pmt$task_status := NIL,
    dfv$p_recovery_task_status: [XDCL, oss$task_shared] ^pmt$task_status := NIL,
    dfv$p_verify_jobs_task_status: [XDCL, oss$task_shared] ^pmt$task_status := NIL;

  VAR
    transaction_state_string: [READ, oss$job_paged_literal] array
          [dfc$null_state .. dfc$server_waiting_request] of string (26) := [
          { } 'null_state',
          { } 'queue_entry_available',
          { } 'queue_entry_assigned',
          { } 'request_queued',
          { } 'request_sent',
          { } 'server_must_read_page_data',
          { } 'server_received_request',
          { } 'server_sent_response',
          { } 'client_must_read_page_data',
          { } 'response_received',
          { } 'media_error',
          { } 'message_content_error',
          { } 'server_waiting_request'];

*copyc osv$os_defaults
*copyc osv$page_size

?? TITLE := '    dfp$manage_server_connection', EJECT ??

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

{     pdt manage_server_con_pdt (
{         mainframe_name: name pmc$mainframe_id_size = $required
{         status)

?? PUSH (LISTEXT := ON) ??

    VAR
      manage_server_con_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^manage_server_con_pdt_names, ^manage_server_con_pdt_params];

    VAR
      manage_server_con_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of
            clt$parameter_name_descriptor := [['MAINFRAME_NAME', 1], ['STATUS', 2]];

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

{ MAINFRAME_NAME

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$name_value, pmc$mainframe_id_size, pmc$mainframe_id_size]],

{ STATUS

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

?? POP ??

    VAR
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id,
      message_length: integer,
      start_message: string (80),
      task_name: ost$name;

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

    clp$scan_parameter_list (parameter_list, manage_server_con_pdt, status);
    IF NOT status.normal THEN
      send_status_to_operator (status);
      RETURN;
    IFEND;
    dfp$crack_mainframe_id ('MAINFRAME_NAME', mainframe_name, mainframe_id, status);
    IF NOT status.normal THEN
      send_status_to_operator (status);
      RETURN;
    IFEND;

    dfp$format_task_name (mainframe_name, task_name);
    osp$set_system_task_restart (task_name, { restart } FALSE, status);

    STRINGREP (start_message, message_length, ' Task ', task_name, ' running.');
    display (start_message (1, message_length));
    log_display ($pmt$ascii_logset[pmc$system_log], start_message (1,message_length));
    dfp$determine_server_status (mainframe_name, status);

  PROCEND dfp$manage_server_connection;

?? TITLE := '    dfp$determine_server_status', EJECT ??

  PROCEDURE dfp$determine_server_status
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

     CONST
       seconds_per_hour = 3600;

    VAR
      all_queue_entries_free: boolean,
      family_container: SEQ (REP dfc$max_family_parameters of dft$family_verification),
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      message_length: integer,
      operator_message: string (79),
      max_verify_jobs_count_down: 0 .. seconds_per_hour,
      number_of_families: 0 .. dfc$max_family_parameters,
      p_cpu_queue: ^dft$cpu_queue,
      p_family_list: ^dft$poll_family_list,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      poll_header: dft$poll_header,
      queue_directory_index: dft$queue_directory_index,
      queue_index: dft$queue_index,
      reply_received: boolean,
      server_name: pmt$mainframe_id,
      server_to_client: boolean,
      time_after_wait: integer,
      time_before_wait: integer,
      verify_jobs_count_down: 0 .. seconds_per_hour,
      wait_time: integer;

    server_to_client := FALSE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, mainframe_name, status);
      system_error ('INCORRECT SERVER MAINFRAME_ID IN ASYNCH TASK', ^status);
      pmp$exit (status);
    IFEND;
    pmp$get_executing_task_gtid (p_cpu_queue^.queue_entries [dfc$poll_queue_index].global_task_id);
    pmp$get_mainframe_id (poll_header.mainframe_name, status);
    server_name := mainframe_name;
    mainframe_id := p_cpu_queue^.queue_header.destination_mainframe_id;
    dfp$get_queue_directory_index (p_queue_interface_table, queue_directory_index);
    wait_time := p_cpu_queue^.queue_header.timeout_interval DIV 1000;
    max_verify_jobs_count_down := (seconds_per_hour * 1000) DIV wait_time;
    verify_jobs_count_down := 1; {Allow first poll to complete
    dfp$attach_application_library (p_cpu_queue);

  /poll_loop/
    WHILE TRUE DO
      #SPOIL (p_cpu_queue^.queue_header.partner_status);
      syp$hang_if_system_jrt_set (dfc$tjr_determine_server_status);

      IF p_cpu_queue^.queue_header.partner_status.terminate_partner THEN
        terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
              { restart } FALSE);
      ELSEIF p_cpu_queue^.queue_header.partner_status.timeout_partner THEN

{ Monitor has indicated a destination mainframe down and
{ is using this flag to indicate to timeout.

        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name, { RESTART}
             FALSE);
      ELSE
        CASE p_cpu_queue^.queue_header.partner_status.server_state OF

        = dfc$inactive =
          IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
            pmp$get_executing_task_gtid (p_cpu_queue^.queue_entries [dfc$poll_queue_index].
                  global_task_id);
            poll_header.poll_type := dfc$verify_queue;
            send_verify_queue (p_cpu_queue, queue_index, p_queue_interface_table, poll_header,
                  p_q_interface_directory_entry, server_name, family_container, number_of_families);
          IFEND;

        = dfc$terminated, dfc$awaiting_recovery =
          IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
            poll_header.poll_type := dfc$verify_queue;
            send_verify_queue (p_cpu_queue, queue_index, p_queue_interface_table, poll_header,
                  p_q_interface_directory_entry, server_name, family_container, number_of_families);
          ELSE
            system_error ('SERVER STATE = TERM/AREC , NO VERIFY_QUEUE, AND ASYNCH RUNNING', NIL);
            timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name, FALSE);
          IFEND;

        = dfc$recovering =
          IF p_cpu_queue^.queue_header.partner_status.recovery_complete THEN
            poll_header.poll_type := dfc$recovery_complete;
          ELSE
            poll_header.poll_type := dfc$normal_poll;
          IFEND;
          issue_server_poll (p_cpu_queue, queue_index, p_queue_interface_table, poll_header,
                {p_poll_family_list=} NIL, {p_poll_queue_information=} NIL);

        = dfc$deactivated =
          IF p_cpu_queue^.queue_header.partner_status.deactivate_complete THEN
            dfp$await_all_queue_entrys_free (p_cpu_queue, { Maximum wait }
                15000 { 15 seconds }, all_queue_entries_free);
            IF NOT all_queue_entries_free THEN
              STRINGREP (operator_message, message_length, ' Server ', mainframe_name,
               ' would not turn Inactive due to outstanding requests. Force timeout.');
              display (operator_message (1, message_length));
              log_display ($pmt$ascii_logset[pmc$system_log],
                    operator_message (1,message_length));
              timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, mainframe_name,
                    { restart } FALSE);
              { There is no return from timeout_task
            IFEND;
            poll_header.poll_type := dfc$deactivate_complete;
            issue_server_poll (p_cpu_queue, queue_index, p_queue_interface_table, poll_header,
                  {p_poll_family_list=} NIL, {p_poll_queue_information=} NIL);
            STRINGREP (operator_message, message_length, ' Server ', mainframe_name, ' turned Inactive.');
            display (operator_message (1, message_length));
            log_display ($pmt$ascii_logset[pmc$system_log],
                  operator_message (1,message_length));
            p_cpu_queue^.queue_header.partner_status.deactivate_complete := FALSE;
            p_cpu_queue^.queue_header.partner_status.server_state := dfc$inactive;
            verify_jobs_count_down := 1; {Allow first poll to complete
            dfp$change_family_server_state (dfc$inactive, mainframe_id);
            dfp$unload_pp_if_last (^dfv$p_queue_interface_directory^ [queue_directory_index], queue_index,
                  status);
            IF NOT status.normal THEN
              send_status_to_operator (status);
              timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, mainframe_name,
                    { restart } FALSE);
            IFEND;
            dfp$execute_state_change_task (mainframe_name, { partner_is_server } TRUE, dfc$deactivated,
                  dfc$inactive, osc$wait, status);
          IFEND;

        = dfc$active =
          p_family_list := NIL;
          number_of_families := 0;
          IF p_cpu_queue^.queue_header.partner_status.verify_family AND
                (p_cpu_queue^.queue_header.number_of_monitor_queue_entries = 0) THEN
            p_cpu_queue^.queue_header.partner_status.verify_family := FALSE;
          IFEND;
          IF p_cpu_queue^.queue_header.partner_status.send_deactivate_partner THEN
            poll_header.poll_type := dfc$deactivate_server;

          ELSEIF p_cpu_queue^.queue_header.partner_status.verify_family THEN
            poll_header.poll_type := dfc$verify_served_family;
            dfp$format_verify_family (p_cpu_queue^.queue_header.destination_mainframe_id, family_container,
                  number_of_families, p_family_list);


          ELSE {normal poll}
            IF verify_jobs_count_down = 0 THEN
              verify_jobs_count_down := max_verify_jobs_count_down;
              IF (dfv$p_verify_jobs_task_status = NIL) OR
                    dfv$p_verify_jobs_task_status^.complete THEN
                execute_verify_jobs_task (mainframe_name, status);
                IF NOT status.normal THEN
                  send_status_to_operator (status);
                  timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, mainframe_name,
                        { restart } FALSE);
                IFEND;
              IFEND;
            ELSE
              verify_jobs_count_down := verify_jobs_count_down - 1;
            IFEND;
            IF dfv$p_get_app_info_status = NIL THEN
              dfp$execute_get_app_info (mainframe_name, status);
              IF NOT status.normal THEN
                send_status_to_operator (status);
                log_display_status ($pmt$ascii_logset [pmc$job_log, pmc$system_log], FALSE, status);
                status.normal := TRUE;
              IFEND;
            IFEND;
            poll_header.poll_type := dfc$normal_poll;
          IFEND;

          issue_server_poll (p_cpu_queue, queue_index, p_queue_interface_table, poll_header, p_family_list,
                {p_poll_queue_information=} NIL);
          IF poll_header.poll_type = dfc$deactivate_server THEN
            p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := FALSE;
            p_cpu_queue^.queue_header.partner_status.server_state := dfc$deactivated;
            dfp$change_family_server_state (dfc$deactivated, mainframe_id);
            execute_idle_task (mainframe_name, status);
            { State change procedure called within idle task.
            IF NOT status.normal THEN
              send_status_to_operator (status);
              timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, mainframe_name,
                    { restart } FALSE);
            IFEND;
          IFEND;
        ELSE
          system_error ('BAD SERVER STATE IN ASYNCH TASK -TERMINATING', NIL);
          { The state of the server is confused so it's best to terminate and start over.
          terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                { restart } FALSE);
        CASEND;
      IFEND;

{ Note:
{   Process_poll_reply may have changed the state since the initial check above.

      #SPOIL (p_cpu_queue^.queue_header.partner_status.server_state);

      CASE p_cpu_queue^.queue_header.partner_status.server_state OF
      = dfc$active, dfc$deactivated, dfc$recovering =

        reply_received := FALSE;

      /wait_for_reply/
        REPEAT
          time_before_wait := #FREE_RUNNING_CLOCK (0);
          pmp$wait (wait_time, wait_time);
          determine_wakeup_cause (p_cpu_queue, queue_index, p_queue_interface_table, time_before_wait,
                server_name, reply_received);
          time_out_requests (p_cpu_queue, queue_index, p_queue_interface_table, server_name);
        UNTIL reply_received;

      = dfc$inactive =

        IF p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          determine_wakeup_cause (p_cpu_queue, queue_index, p_queue_interface_table, time_before_wait,
                server_name, reply_received);
        ELSE
          time_before_wait := #FREE_RUNNING_CLOCK (0);
          pmp$wait (wait_time, wait_time);
        IFEND;

      = dfc$terminated, dfc$awaiting_recovery =
        time_before_wait := #FREE_RUNNING_CLOCK (0);
        determine_wakeup_cause (p_cpu_queue, queue_index, p_queue_interface_table, time_before_wait,
              server_name, reply_received);

      ELSE
        system_error ('BAD SERVER STATE IN ASYNCH TASK -TERMINATING', NIL);
        { The state of the server is confused so it's best to terminate and start over.
        terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
               { restart } FALSE);
      CASEND;

    WHILEND /poll_loop/;

  PROCEND dfp$determine_server_status;

?? TITLE := '      build_queue_info_record ', EJECT ??

  PROCEDURE build_queue_info_record
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
     VAR queue_information: dft$poll_queue_information);

    VAR
      family_found: boolean,
      p_driver_header: ^dft$driver_queue_header,
      server_birthdate: integer,
      server_lifetime: dft$server_lifetime,
      server_state: dft$server_state,
      status: ost$status;

    status.normal := TRUE;
    queue_information.status.normal := TRUE;

{   ---------------------------------
{   queue_information from cpu_table.
{   ---------------------------------

    queue_information.destination_mainframe_name := p_cpu_queue^.queue_header.destination_mainframe_name;
    queue_information.number_of_monitor_queue_entries := p_cpu_queue^.queue_header.
          number_of_monitor_queue_entries;
    queue_information.number_of_task_queue_entries := p_cpu_queue^.queue_header.number_of_task_queue_entries;
    queue_information.timeout_interval := p_cpu_queue^.queue_header.timeout_interval;
    queue_information.maximum_timeout_count := p_cpu_queue^.queue_header.maximum_request_timeout_count;
    queue_information.maximum_retransmission_count := p_cpu_queue^.queue_header.maximum_retransmission_count;

{   ---------------------------------------------
{   queue_information from queue_interface_table.
{   ---------------------------------------------

    queue_information.esm_base_addresses := p_queue_interface_table^.esm_base_addresses;

{   -------------------------------------------
{   queue_information from driver_queue_header.
{   -------------------------------------------

    p_driver_header := ^p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue^.queue_header;
    queue_information.driver_number_of_queue_entries := p_driver_header^.number_of_queue_entries;
    queue_information.driver_source_id_number := p_driver_header^.connection_descriptor.source.id_number;
    queue_information.driver_source_queue_index := p_driver_header^.connection_descriptor.source.queue_index;
    queue_information.driver_destination_id_number := p_driver_header^.connection_descriptor.destination.
          id_number;
    queue_information.driver_destination_queue_index := p_driver_header^.connection_descriptor.destination.
          queue_index;

{   ---------------------
{   System Information.
{   ---------------------

    queue_information.client_page_size := osv$page_size;
    queue_information.client_os_name := osv$os_defaults_os_name;

    queue_information.server_state := p_cpu_queue^.queue_header.partner_status.server_state;

    CASE p_cpu_queue^.queue_header.partner_status.server_state OF
    = dfc$terminated, dfc$awaiting_recovery =
      dfp$get_highest_sf_lifetime (p_cpu_queue^.queue_header.destination_mainframe_id, family_found,
            server_state, server_lifetime, server_birthdate);
      IF NOT family_found THEN
        server_lifetime := p_cpu_queue^.queue_header.server_lifetime;
        server_birthdate := p_cpu_queue^.queue_header.server_birthdate;
      IFEND;
      IF p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery THEN
        queue_information.previous_server_lifetime := server_lifetime;
        queue_information.previous_server_birthdate := server_birthdate;
      IFEND;

{ Now assign a new lifetime and birthdate.

      queue_information.server_lifetime := server_lifetime + 1;
      queue_information.server_birthdate := #FREE_RUNNING_CLOCK (0);
    = dfc$inactive =
      queue_information.server_lifetime := p_cpu_queue^.queue_header.server_lifetime;
      queue_information.server_birthdate := p_cpu_queue^.queue_header.server_birthdate;
      queue_information.previous_server_lifetime := queue_information.server_lifetime;
      queue_information.previous_server_birthdate := queue_information.server_birthdate;

    ELSE
      system_error ('ERROR - WRONG SERVER STATE IN QUEUE VERIFICATION', NIL);
      pmp$exit (status);
    CASEND;

  PROCEND build_queue_info_record;
?? TITLE := '    deactivate_system_task ', EJECT ??

  PROCEDURE deactivate_system_task
    (    server_name: pmt$mainframe_id);

    VAR
      local_status: ost$status,
      task_name: ost$name;

    dfp$format_task_name (server_name, task_name);
    osp$deactivate_system_task (task_name, local_status);
    IF NOT local_status.normal THEN
      IF local_status.condition = ose$system_task_not_active THEN
        system_error ('SYSTEM TASK NOT enabled AND DF POLLING_TASK running.', NIL);
      ELSE
        system_error ('DEACTIVATE_SYSTEM_TASK RETURNED ABNORMAL STATUS.', ^local_status);
      IFEND;
    IFEND;

{   -----------------------------------------------------------------------
{   Deactivate_system_task procedure does not terminate a task immediately.
{   Need to give it time to do its thing.
{   -----------------------------------------------------------------------

  /wait_till_termination/
    WHILE TRUE DO
      pmp$wait (1000, 1000);
    WHILEND /wait_till_termination/;
  PROCEND deactivate_system_task;
?? TITLE := '    determine_wakeup_cause', EJECT ??

  PROCEDURE determine_wakeup_cause
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
         time_before_wait: integer;
         server_name: pmt$mainframe_id;
     VAR reply_received: boolean);

    VAR
      message_length: integer,
      operator_message: string (79),
      p_buffer_parameters: ^dft$poll_message,
      p_driver_flags: ^dft$queue_entry_flags,
      p_receive_buffer: dft$p_command_buffer,
      remaining_wait_time: integer,
      status: ost$status,
      time_after_wait: integer,
      wait_time: integer;

    status.normal := TRUE;
    reply_received := FALSE;
    p_driver_flags := ^p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue^.queue_entries [dfc$poll_queue_index].flags;
    p_receive_buffer := p_cpu_queue^.queue_entries [dfc$poll_queue_index].p_receive_buffer;
    wait_time := p_cpu_queue^.queue_header.timeout_interval DIV 1000;
    RESET p_receive_buffer;
    NEXT p_buffer_parameters IN p_receive_buffer;

{----------------------------------------------------------------------
{   This procedure will loop here until the wait_time expires.
{   IF during this time:
{      driver_flags.subsystem_action = TRUE AND
{      transaction count in the CPU Queue Entry = transaction count
{                                                 in the Receive Buffer
{   THEN the poll reply has arrived and will be processed.
{
{   If both conditions are not met then the wait time will be exhausted
{   with no other processing done here.
{----------------------------------------------------------------------

    REPEAT
      #SPOIL (p_cpu_queue^.queue_header.partner_status);
      #SPOIL (p_driver_flags^);

      IF p_cpu_queue^.queue_header.partner_status.terminate_partner THEN
        terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
             { restart } FALSE);
      IFEND;

      IF p_cpu_queue^.queue_header.partner_status.timeout_partner THEN
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
             { restart } FALSE);
      IFEND;

      IF NOT reply_received THEN
        IF p_driver_flags^.subsystem_action THEN
          IF p_driver_flags^.driver_error_alert THEN
            system_error ('DRIVER ERROR FLAG SET -TIMING OUT', NIL);
            { The task should never see driver_error_alert, but still recovery is likely.
            timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
          ELSEIF (p_buffer_parameters^.buffer_header.transaction_count = p_cpu_queue^.
                queue_entries [dfc$poll_queue_index].transaction_count) THEN
            process_poll_reply (p_cpu_queue, queue_index, p_queue_interface_table, server_name);
            reply_received := TRUE;
          ELSEIF (p_buffer_parameters^.buffer_header.transaction_count > p_cpu_queue^.
                queue_entries [dfc$poll_queue_index].transaction_count) THEN
            STRINGREP (operator_message, message_length, ' Server ', server_name,
                  ' has mismatched transaction count .');
            display (operator_message (1, message_length));
            log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
            STRINGREP (operator_message, message_length, ' From server ',
                  p_buffer_parameters^.buffer_header.transaction_count,
                  ' Client ', p_cpu_queue^. queue_entries [dfc$poll_queue_index].transaction_count);
            display (operator_message (1, message_length));
            log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
            timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } TRUE);
          IFEND;
        IFEND;
      IFEND;

      time_after_wait := #FREE_RUNNING_CLOCK (0);
      remaining_wait_time := wait_time - ((time_after_wait - time_before_wait) DIV 1000);
      IF (remaining_wait_time > 0) THEN
        pmp$wait (remaining_wait_time, remaining_wait_time);
      IFEND;

    UNTIL (remaining_wait_time <= 0);

  PROCEND determine_wakeup_cause;

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

{ PURPOSE:
{   The purpose of this request is to execute a task which will request and
{   process information from the server mainframe concerning application
{   information.

  PROCEDURE [XDCL] dfp$execute_get_app_info
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      p_parameter_sequence: ^pmt$program_parameters,
      p_parameter_string: ^ost$string,
      p_program_attributes: ^pmt$program_attributes,
      p_program_description: ^pmt$program_description,
      taskid: pmt$task_id;

    PUSH p_program_description: [[REP 1 OF pmt$program_attributes]];
    RESET p_program_description;
    NEXT p_program_attributes IN p_program_description;
    p_program_attributes^.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified];
    p_program_attributes^.starting_procedure := get_remote_app_start_proc;
    p_program_attributes^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    p_program_attributes^.termination_error_level := pmc$warning_load_errors;

    PUSH p_parameter_sequence: [[REP 1 OF ost$string]];
    RESET p_parameter_sequence;
    NEXT p_parameter_string IN p_parameter_sequence;
    p_parameter_string^.size := #SIZE (mainframe_name);
    p_parameter_string^.value := mainframe_name;

    IF dfv$p_get_app_info_status = NIL THEN
      ALLOCATE dfv$p_get_app_info_status IN osv$task_shared_heap^;
    IFEND;

    IF dfv$file_server_debug_enabled THEN
      display (' Starting get_app_info task ');
    IFEND;

    pmp$execute (p_program_description^, p_parameter_sequence^, osc$nowait, taskid,
          dfv$p_get_app_info_status^, status);

  PROCEND dfp$execute_get_app_info;

?? TITLE := '    execute_idle_task', EJECT ??

  PROCEDURE execute_idle_task
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      p_parameter_sequence: ^pmt$program_parameters,
      p_parameter_string: ^ost$string,
      p_program_attributes: ^pmt$program_attributes,
      p_program_description: ^pmt$program_description,
      taskid: pmt$task_id;

    PUSH p_program_description: [[REP 1 OF pmt$program_attributes]];
    RESET p_program_description;
    NEXT p_program_attributes IN p_program_description;
    p_program_attributes^.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified];
    p_program_attributes^.starting_procedure := idle_task_start_proc;
    p_program_attributes^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    p_program_attributes^.termination_error_level := pmc$warning_load_errors;

    PUSH p_parameter_sequence: [[REP 1 OF ost$string]];
    RESET p_parameter_sequence;
    NEXT p_parameter_string IN p_parameter_sequence;
    p_parameter_string^.size := #SIZE (mainframe_name);
    p_parameter_string^.value := mainframe_name;

    IF dfv$p_idle_task_status = NIL THEN
      ALLOCATE dfv$p_idle_task_status IN osv$task_shared_heap^;
    IFEND;

    pmp$execute (p_program_description^, p_parameter_sequence^, osc$nowait, taskid, dfv$p_idle_task_status^,
          status);
  PROCEND execute_idle_task;
?? TITLE := '    execute_recovery_task', EJECT ??

  PROCEDURE execute_recovery_task
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      p_parameter_sequence: ^pmt$program_parameters,
      p_parameter_string: ^ost$string,
      p_program_attributes: ^pmt$program_attributes,
      p_program_description: ^pmt$program_description,
      taskid: pmt$task_id;

    PUSH p_program_description: [[REP 1 OF pmt$program_attributes]];
    RESET p_program_description;
    NEXT p_program_attributes IN p_program_description;
    p_program_attributes^.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified];
    p_program_attributes^.starting_procedure := recovery_task_start_proc;
    p_program_attributes^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    p_program_attributes^.termination_error_level := pmc$warning_load_errors;

    PUSH p_parameter_sequence: [[REP 1 OF ost$string]];
    RESET p_parameter_sequence;
    NEXT p_parameter_string IN p_parameter_sequence;
    p_parameter_string^.size := #SIZE (mainframe_name);
    p_parameter_string^.value := mainframe_name;

    IF dfv$p_recovery_task_status = NIL THEN
      ALLOCATE dfv$p_recovery_task_status IN osv$task_shared_heap^;
    IFEND;
    IF dfv$file_server_debug_enabled THEN
      display (' Starting recovery task ');
    IFEND;
    log_display ($pmt$ascii_logset[pmc$system_log], ' Start recovery task ');
    pmp$execute (p_program_description^, p_parameter_sequence^, osc$nowait, taskid,
          dfv$p_recovery_task_status^, status);
  PROCEND execute_recovery_task;

?? TITLE := '    execute_verify_jobs_task', EJECT ??

  PROCEDURE execute_verify_jobs_task
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      p_parameter_sequence: ^pmt$program_parameters,
      p_parameter_string: ^ost$string,
      p_program_attributes: ^pmt$program_attributes,
      p_program_description: ^pmt$program_description,
      taskid: pmt$task_id;

    PUSH p_program_description: [[REP 1 OF pmt$program_attributes]];
    RESET p_program_description;
    NEXT p_program_attributes IN p_program_description;
    p_program_attributes^.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified];
    p_program_attributes^.starting_procedure := verify_jobs_task_start_proc;
    p_program_attributes^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    p_program_attributes^.termination_error_level := pmc$warning_load_errors;

    PUSH p_parameter_sequence: [[REP 1 OF ost$string]];
    RESET p_parameter_sequence;
    NEXT p_parameter_string IN p_parameter_sequence;
    p_parameter_string^.size := #SIZE (mainframe_name);
    p_parameter_string^.value := mainframe_name;

    IF dfv$p_verify_jobs_task_status = NIL THEN
      ALLOCATE dfv$p_verify_jobs_task_status IN osv$task_shared_heap^;
    IFEND;

    IF dfv$file_server_debug_enabled THEN
      display (' Starting verify_jobs task ');
    IFEND;

    pmp$execute (p_program_description^, p_parameter_sequence^, osc$nowait, taskid,
          dfv$p_verify_jobs_task_status^, status);

  PROCEND execute_verify_jobs_task;

?? TITLE := '    [INLINE] find_next_active_entry', EJECT ??

  PROCEDURE [INLINE] find_next_active_entry
    (    starting_position: integer;
         number_of_characters: integer;
         entry_assignment_string: string ( * <= dfc$queue_assignment_strng_size);
     VAR entry_assignment: integer);

{=================================================================================
{
{    This procedure scans the input string for a next active entry (one whose
{    value is dfc$assigned_entry_char), and if such entry is found in the entry
{    assignment string, it returns its index value.
{    The string will only be scanned from the starting position for number_of_characters.
{    If no active entry is found, zero is returned in the index.
{
{=================================================================================

    TYPE
      char_set = set of char;

    VAR
      entry_found: boolean,
      find_char_set: char_set;

    find_char_set := $char_set [dfc$assigned_entry_char];

    #SCAN (find_char_set, entry_assignment_string (starting_position, number_of_characters), entry_assignment,
          entry_found);
    IF entry_found THEN
      entry_assignment := starting_position + entry_assignment - 1;
    ELSE
      entry_assignment := 0;
    IFEND;
  PROCEND find_next_active_entry;
?? TITLE := '    issue_server_poll', EJECT ??

  PROCEDURE issue_server_poll
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
         poll_header: dft$poll_header;
         p_family_list: ^dft$poll_family_list;
         p_queue_information: ^dft$poll_queue_information);

    VAR
      actual_length: integer,
      p_driver_entry: ^dft$driver_queue_entry,
      p_number_of_families: ^0 .. dfc$max_family_parameters,
      p_poll_family_list: ^dft$poll_family_list,
      p_poll_queue_information: ^dft$poll_queue_information,
      p_send_buffer: dft$p_command_buffer,
      p_send_parameters: ^dft$poll_message,
      status: ost$status;

    p_send_buffer := p_cpu_queue^.queue_entries [dfc$poll_queue_index].p_send_buffer;
    p_driver_entry := ^p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue^.queue_entries [dfc$poll_queue_index];

    IF p_driver_entry^.flags.driver_action THEN
      RETURN;

    ELSE
      p_cpu_queue^.queue_entries [dfc$poll_queue_index].transaction_count := p_cpu_queue^.
            queue_entries [dfc$poll_queue_index].transaction_count + 1;
      RESET p_send_buffer;
      NEXT p_send_parameters IN p_send_buffer;
      p_send_parameters^.buffer_header.version := dfc$poll_task_version;
      p_send_parameters^.buffer_header.transaction_count :=
            p_cpu_queue^.queue_entries [dfc$poll_queue_index].transaction_count;
      p_send_parameters^.buffer_header.remote_processor := dfc$poll_task;
      p_send_parameters^.buffer_header.data_length_sent := 0;
      p_send_parameters^.poll_header := poll_header;
      p_send_parameters^.buffer_header.retransmission_count := 0;

      p_cpu_queue^.queue_entries [dfc$poll_queue_index].retransmission_count := 0;
      CASE poll_header.poll_type OF
      = dfc$normal_poll, dfc$deactivate_server, dfc$deactivate_complete, dfc$recovery_complete =

{       These poll types only require poll_header.

      = dfc$verify_served_family, dfc$verify_queue =
        NEXT p_number_of_families IN p_send_buffer;
        IF (p_family_list = NIL) THEN
          p_number_of_families^ := 0;
        ELSE
          p_number_of_families^ := UPPERBOUND (p_family_list^.families);
          NEXT p_poll_family_list: [1 .. UPPERBOUND (p_family_list^.families)] IN p_send_buffer;
          p_poll_family_list^ := p_family_list^;
        IFEND;

        IF (poll_header.poll_type = dfc$verify_queue) THEN
          IF (p_queue_information = NIL) THEN
            system_error ('INTERNAL ERROR - NO QUEUE INFO LIST.-TIMEOUT', NIL);
            { Some error occurred, but it might cleanup on next activation.
            timeout_task (p_cpu_queue, queue_index, p_queue_interface_table,
                  p_cpu_queue^.queue_header.destination_mainframe_name,
                  { restart } FALSE);

          ELSE
            NEXT p_poll_queue_information IN p_send_buffer;
            p_poll_queue_information^ := p_queue_information^;
          IFEND;
        IFEND;

      ELSE
        system_error ('INTERNAL ERROR - INCORRECT POLL TYPE.-TIMOUT.', NIL);
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table,
              p_cpu_queue^.queue_header.destination_mainframe_name,
              { restart } FALSE);
      CASEND;

      actual_length := dfp$word_boundary (i#current_sequence_position (p_send_buffer));
      p_send_parameters^.buffer_header.buffer_length_sent := actual_length;
      p_driver_entry^.flags := dfv$send_command_flags;
      p_driver_entry^.send_buffer_descriptor.actual_length := actual_length;
      IF dfv$display_poll THEN
        display (dfv$poll_type_string [poll_header.poll_type]);
      IFEND;
      dfp$queue_task_request (p_queue_interface_table, queue_index, dfc$poll_queue_index);
    IFEND;

  PROCEND issue_server_poll;

?? TITLE := '    process_family_verification', EJECT ??

  PROCEDURE process_family_verification
    (    number_of_families: 0 .. dfc$max_family_parameters;
         p_received_families: ^dft$poll_family_list;
         server_lifetime: dft$server_lifetime;
         server_birthdate: integer;
         server_state: dft$server_state;
         p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index);

    VAR
      family_access: dft$family_access,
      family_index: 1 .. dfc$max_family_parameters,
      family_list: array [1 .. 1] of ost$name,
      message_length: integer,
      operator_message: string (ofc$max_send_message),
      server_mainframe_id: pmt$binary_mainframe_id,
      status: ost$status,
      verification_changed: boolean;


    server_mainframe_id := p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].
          p_cpu_queue^.queue_header.destination_mainframe_id;

  /process_each_family/
    FOR family_index := number_of_families DOWNTO 1 DO
      family_access := p_received_families^.families [family_index].family_access;
      IF p_received_families^.families [family_index].valid THEN
        dfp$change_family_verification (p_received_families^.families [family_index].family,
              server_mainframe_id, family_access, {verified=} TRUE, server_lifetime, server_birthdate,
              server_state, verification_changed, status);
        IF (NOT status.normal) AND (status.condition = dfe$family_not_found) THEN

{ The family came from a change_client_access command on the server.

          status.normal := TRUE;
          family_list [1] := p_received_families^.families [family_index].family;
          dfp$register_served_families (family_list, family_access, {client_definition =} FALSE,
                p_queue_interface_table, queue_index, status);
          IF status.normal THEN
            dfp$change_family_verification (p_received_families^.families [family_index].family,
                  server_mainframe_id, family_access, {verified=} TRUE, server_lifetime, server_birthdate,
                  server_state, verification_changed, status);
          ELSE
            STRINGREP (operator_message, message_length, ' Server Family ', p_received_families^.
                  families [family_index].family, ' NOT available.');
            log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
            display (operator_message (1, message_length));
            send_status_to_operator (status);
          IFEND;
        IFEND;
        IF status.normal AND verification_changed THEN
          STRINGREP (operator_message, message_length, ' Served Family ', p_received_families^.
                families [family_index].family, ' available.');
          log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
          display (operator_message (1, message_length));
        IFEND;

      ELSE
        STRINGREP (operator_message, message_length, ' Served Family ', p_received_families^.
              families [family_index].family, ' NOT available.');
        log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
        display (operator_message (1, message_length));
        dfp$change_family_verification (p_received_families^.families [family_index].family,
              server_mainframe_id, family_access, {verified=} FALSE, server_lifetime,
              server_birthdate, server_state, verification_changed, status);
        dfp$delete_family_if_last (p_received_families^.families [family_index].family);
      IFEND;
    FOREND /process_each_family/;
  PROCEND process_family_verification;

?? TITLE := '    process_poll_reply', EJECT ??

  PROCEDURE process_poll_reply
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
         server_name: pmt$mainframe_id);

    VAR
      client_date_time: ost$date_time,
      ignore_task_executing: boolean,
      message_length: integer,
      old_state: dft$server_state,
      operator_message: string (180),
      p_buffer_parameters: ^dft$poll_message,
      p_number_of_families: ^0 .. dfc$max_family_parameters,
      p_poll_header: ^dft$poll_header,
      p_queue_information: ^dft$poll_queue_information,
      p_receive_buffer: dft$p_command_buffer,
      p_received_families: ^dft$poll_family_list,
      seconds_time_dif: integer,
      status: ost$status,
      time_dif_direction: string (6);

    CONST
      acceptable_time_dif = 5;

    status.normal := TRUE;
    p_receive_buffer := p_cpu_queue^.queue_entries [dfc$poll_queue_index].p_receive_buffer;
    RESET p_receive_buffer;
    NEXT p_buffer_parameters IN p_receive_buffer;
    IF p_buffer_parameters^.poll_header.poll_type = dfc$verify_queue_reply THEN
      pmp$get_compact_date_time (client_date_time, status);
    IFEND;

{----------------------------
{   Verify Buffer Header
{----------------------------

    IF ((p_buffer_parameters^.buffer_header.version = dfc$poll_task_version) AND
          (p_buffer_parameters^.buffer_header.remote_processor = dfc$poll_task) AND
          (p_buffer_parameters^.buffer_header.data_length_sent = 0)) THEN
      p_poll_header := ^p_buffer_parameters^.poll_header;
      IF NOT (p_poll_header^.mainframe_name = p_cpu_queue^.queue_header.destination_mainframe_name) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$incorrect_server_mainframe,
              p_cpu_queue^.queue_header.destination_mainframe_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_poll_header^.mainframe_name, status);
        send_status_to_operator (status);
        { It won't get any better by attempting to recover.
        terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
               { restart } FALSE);
      IFEND;
      IF (p_buffer_parameters^.buffer_header.transaction_count <> p_cpu_queue^.
          queue_entries [dfc$poll_queue_index].transaction_count) THEN
        STRINGREP (operator_message, message_length, ' Server ', server_name,
              ' Transaction mismatch - timing out.');
        log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
        display (operator_message (1, message_length));
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                { restart } FALSE);
      IFEND;
    ELSE
      system_error ('INCORRECT BUFFER HEADER RECEIVED FROM SERVER-TIMEOUT', NIL);
      timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
              { restart } FALSE);
    IFEND;

{-----------------------------------------------------------
{   Correct Poll Reply type is dependent on the Server State
{-----------------------------------------------------------
   old_state := p_cpu_queue^.queue_header.partner_status.server_state;

    CASE p_cpu_queue^.queue_header.partner_status.server_state OF

    = dfc$active =

      CASE p_poll_header^.poll_type OF
      = dfc$poll_reply =

{       No need to process the normal poll reply.

      = dfc$verify_family_reply =
        IF p_cpu_queue^.queue_header.partner_status.verify_family THEN
          p_cpu_queue^.queue_header.partner_status.verify_family := FALSE;
          NEXT p_number_of_families IN p_receive_buffer;
          IF (p_number_of_families^ > 0) THEN
            NEXT p_received_families: [1 .. p_number_of_families^] IN p_receive_buffer;
          IFEND;
          IF p_cpu_queue^.queue_header.number_of_monitor_queue_entries > 0 THEN
            process_family_verification (p_number_of_families^, p_received_families,
                  p_cpu_queue^.queue_header.server_lifetime, p_cpu_queue^.queue_header.server_birthdate,
                  dfc$active, p_queue_interface_table, queue_index);
            dfp$change_job_leveler_state;
          IFEND;
        ELSE
          system_error ('INCORRECT POLL REPLY RECEIVED FROM SERVER-TIMING OUT', NIL);
          timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
        IFEND;

      = dfc$deactivate_server =
        STRINGREP (operator_message, message_length, ' Server ', server_name, ' deactivating.');
        log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
        display (operator_message (1, message_length));
        p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := TRUE;

      = dfc$req_verify_served_family =
        p_cpu_queue^.queue_header.partner_status.verify_family :=
              p_cpu_queue^.queue_header.number_of_monitor_queue_entries > 0;

      ELSE
        system_error ('INCORRECT POLL REPLY RECEIVED FROM SERVER-TIMING OUT', NIL);
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
      CASEND;

    = dfc$deactivated =
      IF p_poll_header^.poll_type = dfc$deactivate_reply THEN

{       No need to process deactivate_reply.

      ELSE
        system_error ('INCORRECT POLL REPLY RECEIVED FROM SERVER-TIMING OUT', NIL);
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                { restart } FALSE);
      IFEND;

    = dfc$inactive, dfc$terminated, dfc$awaiting_recovery =
      IF p_poll_header^.poll_type = dfc$verify_queue_reply THEN
        p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
        NEXT p_number_of_families IN p_receive_buffer;
        IF (p_number_of_families^ = 0) THEN
          p_received_families := NIL;
        ELSE
          NEXT p_received_families: [1 .. p_number_of_families^] IN p_receive_buffer;
        IFEND;
        NEXT p_queue_information IN p_receive_buffer;

{       -------------------------------------------------------------------
{       If Server accepted queue_verification_message, Server State will be
{       set to dfc$active or dfc$recovering and the accepted families will become available
{       for user processing. If load leveling is not disabled then the job
{       leveler task will be readied.
{       If Server rejected the message then with one exception, the Server
{       State will be set to dfc$terminated and this task will terminate.
{       The one exception occurs under following conditions: the current
{       Server State = dfc$terminated AND the error condition indicates
{       Lifetime/Birthdate conflict. In this case, verify_queue will remain
{       set to TRUE and, as a result, another dfc$verify_queue message will
{       be sent to Server.
{       -------------------------------------------------------------------

        IF p_queue_information^.status.normal OR (p_queue_information^.status.condition =
              dfe$os_name_conflict) THEN
          IF NOT p_queue_information^.status.normal THEN
            send_status_to_operator (p_queue_information^.status);
          IFEND;
          p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := FALSE;
          p_cpu_queue^.queue_header.server_lifetime := p_queue_information^.server_lifetime;
          p_cpu_queue^.queue_header.server_birthdate := p_queue_information^.server_birthdate;
          IF (p_number_of_families^ > 0) AND (p_cpu_queue^.queue_header.number_of_monitor_queue_entries > 0)
                THEN
            process_family_verification (p_number_of_families^, p_received_families,
                  p_cpu_queue^.queue_header.server_lifetime, p_cpu_queue^.queue_header.server_birthdate,
                  dfc$active, p_queue_interface_table, queue_index);
          IFEND;
          IF (p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery) THEN
            p_cpu_queue^.queue_header.partner_status.recovery_complete := FALSE;
            p_cpu_queue^.queue_header.partner_status.server_state := dfc$recovering;
            dfp$change_family_server_state (dfc$recovering, p_cpu_queue^.queue_header.
                  destination_mainframe_id);
            { State change procedures are called from within the recovery task.
            execute_recovery_task (p_cpu_queue^.queue_header.destination_mainframe_name, status);
          ELSE { Coming active after termination or inactive
            p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := FALSE;
            p_cpu_queue^.queue_header.partner_status.job_reconcilliation_completed := FALSE;
            p_cpu_queue^.queue_header.partner_status.server_state := dfc$active;
            dfp$change_family_server_state (dfc$active, p_cpu_queue^.queue_header.destination_mainframe_id);
            IF p_cpu_queue^.queue_header.leveler_status.leveler_state <> jmc$jl_leveler_disabled THEN
              jmp$ready_job_leveler_task (ignore_task_executing);
            IFEND;
            dfp$execute_state_change_task (p_cpu_queue^.queue_header.destination_mainframe_name,
                   { partner_is_server } TRUE, old_state, dfc$active, osc$nowait, status);
          IFEND;

{         Compare Server system time with Client system time, and WARN operator
{         of difference. Changes made to served catalogs/files with utilities
{         such as Edit_Catalog may not be recognized if the Server's system
{         time is not the same as the Client's system time.
          pmp$compute_time_dif_in_seconds (p_queue_information^.server_date_time, client_date_time,
               seconds_time_dif, status);
          IF seconds_time_dif < 0 THEN
{           The Servers system time is ahead of the Clients system time.
{           (This case seems to cause no problem for Edit_Catalog.)
            seconds_time_dif := (seconds_time_dif) * (-1);
            time_dif_direction := 'faster';
          ELSE
            time_dif_direction := 'slower';
          IFEND;
          IF seconds_time_dif >= acceptable_time_dif THEN
            STRINGREP (operator_message, message_length, 'WARNING - Server ', server_name,
                ' system time is', seconds_time_dif, ' seconds ', time_dif_direction, ' than client. ',
                'Use CHANGE_TIME command to make Client system time same as Server time.');
            display (operator_message (1, message_length));
            log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
          IFEND;

        ELSEIF (p_queue_information^.status.condition = dfe$client_lifetime_error) OR
               (p_queue_information^.status.condition = dfe$force_client_termination) THEN
          send_status_to_operator (p_queue_information^.status);
          IF (p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) THEN
           { Wait for the server to re-activate and retry again.
            p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;
          ELSE
            terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                  { restart } TRUE);
          IFEND;
        ELSEIF (p_queue_information^.status.condition = dfe$force_server_recovery) OR
          (p_queue_information^.status.condition = dfe$force_server_termination) THEN

          { Wait for the server to re-activate and retry again.
          send_status_to_operator (p_queue_information^.status);
          p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;
        ELSEIF p_queue_information^.status.condition = dfe$force_client_recovery THEN
          send_status_to_operator (p_queue_information^.status);
          p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;
          p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
          timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } TRUE);
        ELSE
          STRINGREP (operator_message, message_length, ' Server ', server_name,
                ' rejected queue verification.');
          log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
          display (operator_message (1, message_length));
          STRINGREP (operator_message, message_length, ' Server ', server_name, ' returned following error:');
          log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
          display (operator_message (1, message_length));
          status := p_queue_information^.status;
          send_status_to_operator (status);
          timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                  { restart } FALSE);
        IFEND;

      ELSE
        system_error ('INCORRECT POLL REPLY RECEIVED FROM SERVER-TIMING OUT', NIL);
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
      IFEND;

    = dfc$recovering =
      CASE p_poll_header^.poll_type OF
      = dfc$poll_reply =

{ Do nothing this is normal

      = dfc$recovery_complete_reply =
        STRINGREP (operator_message, message_length, ' Server ', server_name, ' recovery complete');
        display (operator_message (1, message_length));
        log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
        p_cpu_queue^.queue_header.partner_status.send_deactivate_partner := FALSE;
        p_cpu_queue^.queue_header.partner_status.verify_family := TRUE;
        p_cpu_queue^.queue_header.partner_status.job_reconcilliation_completed := TRUE;
        p_cpu_queue^.queue_header.partner_status.server_state := dfc$active;
        IF p_cpu_queue^.queue_header.partner_status.send_deactivate_partner THEN
          { Probably not supported
          STRINGREP (operator_message, message_length, ' Server ', server_name, ' begining deactivation');
          display (operator_message (1, message_length));
          log_display ($pmt$ascii_logset[pmc$system_log], operator_message (1,message_length));
          dfp$change_family_server_state (dfc$deactivated, p_cpu_queue^.queue_header.
                destination_mainframe_id);
        ELSE
          dfp$change_family_server_state (dfc$active, p_cpu_queue^.queue_header.destination_mainframe_id);
        IFEND;
        dfp$execute_state_change_task (p_cpu_queue^.queue_header.destination_mainframe_name,
                { partner_is_server } TRUE, dfc$recovering, dfc$active, osc$nowait, status);
      ELSE
        system_error ('INCORRECT POLL REPLY RECEIVED FROM RECOVERING- TIMING OUT  ', NIL);
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
      CASEND;

    ELSE
      system_error ('INCORRECT SERVER STATE IN PROCESS_POLL_REPLY-TERMINATING.', NIL);
      { The state is probably confused enough that recovery should not be tried.
      terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
    CASEND;

  PROCEND process_poll_reply;
?? TITLE := '    restart_system_task ', eject ??
  PROCEDURE restart_system_task
    (    p_cpu_queue: ^dft$cpu_queue;
         mainframe_name: pmt$mainframe_id);

    VAR
      message: string (80),
      message_length: integer,
      status: ost$status,
      task_name: ost$name;

    dfp$reset_mainframe_tables (mainframe_name, {server_to_client } FALSE, status);
    IF NOT status.normal THEN
      display_status (status);
    IFEND;
    p_cpu_queue^.queue_header.partner_status.verify_queue := TRUE;

    dfp$format_task_name (mainframe_name, task_name);
    STRINGREP (message, message_length, ' Task ', task_name, ' restarting.');
    display (message (1, message_length));
    log_display ($pmt$ascii_logset[pmc$system_log], message (1,message_length));
    osp$set_system_task_restart (task_name, { restart } TRUE, status);
    IF status.normal THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$restart_server_task, mainframe_name, status);
      pmp$exit (status);
    ELSE
      display (' Unable to automatically restart system task');
      log_display ($pmt$ascii_logset[pmc$system_log],
            ' Unable to automatically restart system task');
      display_status (status);
      log_display_status ($pmt$ascii_logset[pmc$system_log], TRUE,
          status);
      display (' ACTIVATE_SERVER command required');
      deactivate_system_task (mainframe_name);
    IFEND;
  PROCEND restart_system_task;
?? TITLE := '      send_status_to_operator ', EJECT ??

  PROCEDURE send_status_to_operator
    (    status: ost$status);

    VAR
      ignore_status: ost$status,
      line_count: ost$status_message_line_count,
      message: ost$status_message,
      p_line_count: ^ost$status_message_line_count,
      p_line_size: ^ost$status_message_line_size,
      p_message: ^ost$status_message,
      p_message_line: ^string ( * );

    p_message := ^message;
    osp$format_message (status, osc$full_message_level, ofc$max_display_message, p_message^, ignore_status);

    RESET p_message;
    NEXT p_line_count IN p_message;
    IF p_line_count^ > 0 THEN

    /display_each_line/
      FOR line_count := 1 TO (p_line_count^) DO
        NEXT p_line_size IN p_message;
        NEXT p_message_line: [p_line_size^] IN p_message;
        display (p_message_line^);
        log_display ($pmt$ascii_logset[pmc$system_log], p_message_line^);
      FOREND /display_each_line/;
    IFEND;
  PROCEND send_status_to_operator;

?? TITLE := '      send_verify_queue ', EJECT ??

  PROCEDURE send_verify_queue
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
         poll_header: dft$poll_header;
         p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         server_name: pmt$mainframe_id;
     VAR family_container: SEQ (REP dfc$max_family_parameters of dft$family_verification);
     VAR number_of_families: 0 .. dfc$max_family_parameters);

    VAR
      p_family_list: ^dft$poll_family_list,
      p_driver_flags: ^dft$queue_entry_flags,
      p_driver_queue: ^dft$driver_queue,
      queue_info_record: dft$poll_queue_information,
      status: ost$status,
      wait_time: integer;

{-------------------------------------
{   Bring up PP if necessary.
{-------------------------------------

    p_driver_queue := p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue;
    wait_time := p_cpu_queue^.queue_header.timeout_interval DIV 1000;
    status.normal := TRUE;

    dfp$load_pp_if_first (p_q_interface_directory_entry, queue_index, status);
    IF NOT status.normal THEN
      p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
      send_status_to_operator (status);
      { Perhaps not enough pp's are available.
      timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
    IFEND;

{--------------------------------------
{   Format and send the verify message.
{--------------------------------------

    build_queue_info_record (p_cpu_queue, queue_index, p_queue_interface_table, queue_info_record);
    number_of_families := 0;
    p_family_list := NIL;
    IF p_cpu_queue^.queue_header.number_of_monitor_queue_entries > 0 THEN
      dfp$format_verify_family (p_cpu_queue^.queue_header.destination_mainframe_id, family_container,
            number_of_families, p_family_list);
    IFEND;
    issue_server_poll (p_cpu_queue, queue_index, p_queue_interface_table, poll_header, p_family_list,
          ^queue_info_record);

{------------------------------------
{   Wait for the reply to come back.
{------------------------------------

    p_driver_flags := ^p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue^.queue_entries [dfc$poll_queue_index].flags;

  /wait_for_reply/
    REPEAT
      #SPOIL (p_cpu_queue^.queue_header.partner_status);
      #SPOIL (p_driver_flags^.subsystem_action);

      IF (p_cpu_queue^.queue_header.partner_status.terminate_partner) OR
         ((p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) AND
           (NOT p_cpu_queue^.queue_header.partner_status.verify_queue)) THEN
        terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
      ELSEIF p_cpu_queue^.queue_header.partner_status.timeout_partner THEN
        timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
      IFEND;
      pmp$wait (wait_time, wait_time);
      time_out_requests (p_cpu_queue, queue_index, p_queue_interface_table, server_name);
    UNTIL p_driver_flags^.subsystem_action;

  PROCEND send_verify_queue;

?? TITLE := '    system_error  ', EJECT ??

  PROCEDURE system_error
    (    text: string ( * );
         p_status: ^ost$status);

    VAR
      local_status: ost$status;

    display (' File server - server system task- system error:');
    log_display ($pmt$ascii_logset[pmc$system_log],
         ' File server - server system task- system error:');
    display (text);
    log_display ($pmt$ascii_logset[pmc$system_log], text);
    IF p_status <> NIL THEN
      display_status (p_status^);
      log_display_status ($pmt$ascii_logset[pmc$system_log], {format} TRUE,
            p_status^);
    IFEND;
    local_status.normal := TRUE;
    IF dfv$file_server_debug_enabled THEN
      syp$invoke_system_debugger (text, 0, local_status);
    IFEND;
  PROCEND system_error;
?? TITLE := '    terminate_task', EJECT ??

  PROCEDURE terminate_task
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
         server_name: pmt$mainframe_id;
         restart: boolean);

    VAR
      leveler_complete: boolean,
      previous_state: dft$server_state,
      queue_directory_index: dft$queue_directory_index,
      status: ost$status;

    status.normal := TRUE;
    previous_state :=p_cpu_queue^.queue_header.partner_status.server_state;
    p_cpu_queue^.queue_header.partner_status.server_state := dfc$terminated;
    dfp$change_family_server_state (dfc$terminated, p_cpu_queue^.queue_header.destination_mainframe_id);
    dfp$term_requests_to_server (server_name, dfv$p_idle_task_status, status);
    IF NOT status.normal THEN
      send_status_to_operator (status);
    IFEND;

    IF p_cpu_queue^.queue_header.leveler_status.leveler_state = jmc$jl_leveler_enabled THEN
      dfp$wait_until_leveler_complete (p_cpu_queue, leveler_complete);
    IFEND;

    IF dfv$p_get_app_info_status <> NIL THEN
      FREE dfv$p_get_app_info_status IN osv$task_shared_heap^;
      dfv$p_get_app_info_status := NIL;
    IFEND;

{   ------------------------------------
{   Cleanup Partner_Status in CPU_Queue.
{   ------------------------------------

    p_cpu_queue^.queue_header.partner_status.terminate_partner := FALSE;
    p_cpu_queue^.queue_header.partner_status.timeout_partner := FALSE;
    p_cpu_queue^.queue_header.partner_status.deactivate_complete := FALSE;
    p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;

{   ---------------
{   Bring down PP.
{   ---------------

    p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue^.
          queue_header.flags.idle := TRUE;
    dfp$get_queue_directory_index (p_queue_interface_table, queue_directory_index);
    dfp$unload_pp_if_last (^dfv$p_queue_interface_directory^ [queue_directory_index], queue_index, status);
    IF NOT status.normal THEN
      send_status_to_operator (status);
    IFEND;

    dfp$free_image_file (p_cpu_queue^.queue_header.destination_mainframe_id,
          status);

    dfp$execute_state_change_task (server_name,
         { partner_is_server } TRUE, previous_state, dfc$terminated, osc$wait, status);

    dfp$return_application_library (p_cpu_queue);

    IF restart THEN
      restart_system_task (p_cpu_queue, server_name);
    ELSE
      deactivate_system_task (server_name);
    IFEND;

  PROCEND terminate_task;
?? TITLE := '    timeout_task', EJECT ??

  PROCEDURE timeout_task
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: ^dft$queue_interface_table;
         server_name: pmt$mainframe_id;
         restart: boolean);

    VAR
      idle_code: syt$180_idle_code,
      leveler_complete: boolean,
      previous_state: dft$server_state,
      queue_directory_index: dft$queue_directory_index,
      status: ost$status;

    status.normal := TRUE;
    IF dfv$file_server_debug_enabled THEN
      display ('  Timing out task ');
    IFEND;
    IF (NOT dfv$job_recovery_enabled) OR
       (p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) THEN
      IF (NOT dfv$job_recovery_enabled) THEN
        log_display ($pmt$ascii_logset[pmc$system_log],
              '  FILE_SERVER_RECOVERY_ENABLED = 0');
      IFEND;
      terminate_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
            restart);
      RETURN;
    IFEND;
    p_cpu_queue^.queue_header.partner_status.timeout_partner := FALSE;
    p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
    osp$get_cause_of_idle (idle_code);
    previous_state := p_cpu_queue^.queue_header.partner_status.server_state;
    { Note: IF the previous_state is inactive
    { This should only happen as a result of a TERMINATE_SYSTEM command.
    { (idle_code = syc$ic_system_terminated) or as a result of a
    { 'TIMEOUT_SERVER' commands when inactive.
    { If the previous state was inactive there is no need to
    { save image file pages.
    p_cpu_queue^.queue_header.partner_status.server_state := dfc$awaiting_recovery;
    p_cpu_queue^.queue_header.partner_status.server_pages_saved := (previous_state = dfc$inactive);
    dfp$change_family_server_state (dfc$awaiting_recovery,
          p_cpu_queue^.queue_header.destination_mainframe_id);

    IF (previous_state <> dfc$inactive) THEN
      IF dfv$file_server_debug_enabled THEN
        display ('  Process queued entries ');
      IFEND;

      dfp$timeout_requests_to_server (server_name, status);
      IF NOT status.normal THEN
        send_status_to_operator (status);
      IFEND;
    IFEND;

    IF (previous_state = dfc$recovering) THEN
      { All of the files should already be awaiting_recovery. Allow the
      { recovery task to complete.
      pmp$wait (1000, 1000);
    ELSE
      dfp$timeout_server_files (p_cpu_queue^.queue_header.destination_mainframe_id, status);
      IF NOT status.normal THEN
        send_status_to_operator (status);
      IFEND;
    IFEND;
    p_cpu_queue^.queue_header.partner_status.server_pages_saved := (status.normal) OR
       (status.condition <> dfe$no_space_for_server_pages);

    IF p_cpu_queue^.queue_header.leveler_status.leveler_state = jmc$jl_leveler_enabled THEN
      dfp$wait_until_leveler_complete (p_cpu_queue, leveler_complete);
    IFEND;

{   ------------------------------------
{   Cleanup Partner_Status in CPU_Queue.
{   ------------------------------------

    p_cpu_queue^.queue_header.partner_status.terminate_partner := FALSE;
    p_cpu_queue^.queue_header.partner_status.timeout_partner := FALSE;
    p_cpu_queue^.queue_header.partner_status.deactivate_complete := FALSE;
    p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;

{   ---------------
{   Bring down PP.
{   ---------------

    p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue^.
          queue_header.flags.idle := TRUE;
    dfp$get_queue_directory_index (p_queue_interface_table, queue_directory_index);
    dfp$unload_pp_if_last (^dfv$p_queue_interface_directory^ [queue_directory_index], queue_index, status);
    IF NOT status.normal THEN
      send_status_to_operator (status);
    IFEND;

    dfp$execute_state_change_task (server_name, { partner_is_server } TRUE, previous_state,
         dfc$awaiting_recovery, osc$wait, status);

    IF restart AND (idle_code <> syc$ic_system_terminated) THEN
      restart_system_task (p_cpu_queue, server_name);
    ELSE
      deactivate_system_task (server_name);
      IF dfv$file_server_debug_enabled THEN
        display ('  Timeout complete ');
      IFEND;
    IFEND;
  PROCEND timeout_task;

?? TITLE := '    time_out_requests', EJECT ??

  PROCEDURE time_out_requests
    (    p_cpu_queue: ^dft$cpu_queue;
         queue_index: dft$queue_index;
         p_queue_interface_table: dft$p_queue_interface_table;
         server_name: pmt$mainframe_id);

    VAR
      current_time: integer,
      display_size: integer,
      display_string: string (80),
      elapsed_time: integer,
      entry_index: dft$queue_entry_index,
      found_entry: integer,
      local_status: ost$status,
      number_of_characters: integer,
      previous_time: integer,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_driver_entry: ^dft$driver_queue_entry,
      p_send_buffer: dft$p_command_buffer,
      p_send_parameters: ^dft$buffer_header,
      request_block: dft$rb_file_server_request,
      starting_position: integer,
      status: ost$status,
      time: ost$time;

    number_of_characters := dfc$queue_assignment_strng_size;
    starting_position := 1;

  /process_all_active_requests/
    REPEAT
      #SPOIL (p_cpu_queue^.queue_header.queue_entry_assignment_table);

      find_next_active_entry (starting_position, number_of_characters,
            p_cpu_queue^.queue_header.queue_entry_assignment_table, found_entry);

      IF (found_entry > 0) THEN
        entry_index := found_entry;
        starting_position := found_entry + 1;
        number_of_characters := dfc$queue_assignment_strng_size - entry_index;

        p_driver_entry := ^p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
              p_driver_queue^.queue_entries [entry_index];
        p_cpu_queue_entry := ^p_cpu_queue^.queue_entries [entry_index];

        CASE p_cpu_queue_entry^.transaction_state OF
        = dfc$request_queued, dfc$request_sent, dfc$server_must_read_page_data, dfc$server_received_request,
          dfc$server_sent_response, dfc$media_error, dfc$message_content_error, dfc$server_waiting_request =
          IF p_cpu_queue_entry^.last_time_progress_checked = 0 THEN

{ last_time_progress_checked is zeroed each time a non-inquiry request is queued.
{ request_start_time is established each time a non-inquiry request is queued.

            previous_time := p_cpu_queue_entry^.request_start_time;
          ELSE
            previous_time := p_cpu_queue_entry^.last_time_progress_checked;
          IFEND;
          current_time := #FREE_RUNNING_CLOCK (0);
          elapsed_time := current_time - previous_time;

          IF (elapsed_time >= p_cpu_queue^.queue_header.timeout_interval) THEN
            IF ((p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) OR
                  (p_cpu_queue^.queue_header.partner_status.server_state = dfc$inactive) OR
                  (p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery)) AND
                  (entry_index = dfc$poll_queue_index) THEN
              p_cpu_queue_entry^.retransmission_count := 0;

            ELSE
              IF dfv$file_server_debug_enabled THEN
                pmp$get_time (osc$hms_time, time, status);
                STRINGREP (display_string, display_size, time.hms, ' TimeOut Q', queue_index, ' Qe',
                      entry_index, ' Tr#', p_cpu_queue_entry^.transaction_count, ' Retr#',
                      p_cpu_queue_entry^.retransmission_count, ' tc#',
                      p_cpu_queue_entry^.request_timeout_count, ' ',
                      transaction_state_string [p_cpu_queue_entry^.transaction_state]);
                display (display_string (1, display_size));
              IFEND;
            IFEND;
            IF p_cpu_queue_entry^.retransmission_count >= p_cpu_queue^.queue_header.
                  maximum_retransmission_count THEN
              display_integer (' Retransmission count exceeded, Count =',
                    p_cpu_queue_entry^.retransmission_count);
             log_display_integer ($pmt$ascii_logset[pmc$system_log],
                   ' Retransmission count exceeded, Count =',
                    p_cpu_queue_entry^.retransmission_count);
              STRINGREP (display_string, display_size, ' Timing out server ',
                    p_cpu_queue^.queue_header.destination_mainframe_name);
              log_display ($pmt$ascii_logset[pmc$system_log], display_string (1, display_size));
              display (display_string (1, display_size));
              timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
            ELSE
              p_cpu_queue_entry^.last_time_progress_checked := current_time;

{ Check on transaction state of timed out request.

              request_block.reqcode := syc$rc_file_server_request;
              request_block.status.normal := TRUE;
              request_block.request := dfc$fsr_request_timeout;
              request_block.p_queue_interface_table := p_queue_interface_table;
              request_block.queue_index := queue_index;
              request_block.queue_entry_index := entry_index;
              i#call_monitor (#LOC (request_block), #SIZE (request_block));
            IFEND;

{ Provide a 'deadman' timeout to detect that no reponse has
{ been received in the maximum time.
{ This is the only code on the Client side which is responsible for
{ detecting a broken connection to the Server side. The transaction
{ state can advance beyond dfc$request_sent only if the link between
{ Client and Server is functioning.

            IF (entry_index = dfc$poll_queue_index) AND ((p_cpu_queue_entry^.transaction_state =
                  dfc$request_queued) OR (p_cpu_queue_entry^.transaction_state = dfc$request_sent)) AND
                  ((p_cpu_queue^.queue_header.partner_status.server_state = dfc$active) OR
                  (p_cpu_queue^.queue_header.partner_status.server_state = dfc$deactivated) OR
                  (p_cpu_queue^.queue_header.partner_status.server_state = dfc$recovering)) AND
                  ((current_time - p_cpu_queue_entry^.request_start_time) >=
                  (p_cpu_queue^.queue_header.timeout_interval * p_cpu_queue^.queue_header.
                  maximum_request_timeout_count * p_cpu_queue^.queue_header.maximum_retransmission_count))
                  THEN
              display (' Server Poll Message TIMED OUT ');
              log_display ($pmt$ascii_logset[pmc$system_log],
                    ' Server Poll Message TIMED OUT ');
              STRINGREP (display_string, display_size, ' Timing out server ',
                    p_cpu_queue^.queue_header.destination_mainframe_name);
              display (display_string (1, display_size));
              log_display ($pmt$ascii_logset[pmc$system_log], display_string (1, display_size));
              timeout_task (p_cpu_queue, queue_index, p_queue_interface_table, server_name,
                    { restart } FALSE);
            IFEND;
          IFEND;
        ELSE { Ignore all other transaction states. }
        CASEND;
      IFEND;

    UNTIL ((found_entry = 0) OR (entry_index = 1 + p_cpu_queue^.queue_header.number_of_monitor_queue_entries +
          p_cpu_queue^.queue_header.number_of_task_queue_entries));

  PROCEND time_out_requests;

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

  PROCEDURE [XDCL] dfp$wait_until_leveler_complete
    (    p_cpu_queue: ^dft$cpu_queue;
     VAR leveler_complete: boolean);

    VAR
      task_executing: boolean,
      waits: 0 .. 20;

    jmp$ready_job_leveler_task (task_executing);
    IF NOT task_executing THEN
      leveler_complete := TRUE;
      RETURN;
    IFEND;

    IF dfv$file_server_debug_enabled THEN
      display (' Waiting for job leveler to complete');
    IFEND;

    waits := 0;

  /wait_for_job_leveler/
    WHILE NOT p_cpu_queue^.queue_header.leveler_status.cleanup_completed DO
      waits := waits + 1;
      jmp$ready_job_leveler_task (task_executing);
      IF task_executing THEN
        pmp$wait (15000, 15000);
      ELSE
        EXIT /wait_for_job_leveler/;
      IFEND;
      IF waits >= 20 THEN
        EXIT /wait_for_job_leveler/;
      IFEND;
      #SPOIL (p_cpu_queue^.queue_header.leveler_status);
    WHILEND /wait_for_job_leveler/;

    IF waits < 20 THEN
       leveler_complete := TRUE;
       IF dfv$file_server_debug_enabled THEN
         display (' Job leveler has completed.');
       IFEND;
    ELSE
      leveler_complete := FALSE;
      display (' Deadman time out waiting for job leveler to complete.');
      log_display ($pmt$ascii_logset[pmc$system_log],
         ' Deadman time out waiting for job leveler to complete.');
    IFEND;

  PROCEND dfp$wait_until_leveler_complete;

MODEND dfm$manage_server_connection;

