?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File Server: queue_initialization ' ??
MODULE dfm$queue_initialization;

{ PURPOSE:
{   The purpose of this module is to allow for creation and initialization of the queue interface directory,
{   queue interface table, driver queues, and cpu queues.  All tables allocated are  allocated in the server
{   wired segment.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfc$loopback_server_mainframe
*copyc dfc$poll_constants
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfi$log_display
*copyc dfs$server_wired
*copyc dft$allocated_rpc_data
*copyc dft$command_buffer
*copyc dft$connection_parameters
*copyc dft$cpu_queue
*copyc dft$display_identifier
*copyc dft$page_io_request
*copyc dft$page_io_response
*copyc dft$partner_mainframe_list
*copyc dft$partner_queue_list
*copyc dft$queue_interface_directory
*copyc dpt$window_id
*copyc jmt$active_job_list
*copyc jmt$jl_job_leveler_status
*copyc oss$job_paged_literal
*copyc ost$signature_lock_status
*copyc pmt$mainframe_id
*copyc syt$180_idle_code
?? POP ??
*copyc clp$get_value
*copyc clp$scan_argument_list
*copyc clp$scan_parameter_list
*copyc cmp$store_file_server_info
*copyc dfp$change_family_server_state
*copyc dfp$display
*copyc dfp$free_image_file
*copyc dfp$get_client_mf_file_info
*copyc dfp$get_highest_sf_lifetime
*copyc dfp$get_queue_directory_index
*copyc dfp$verify_element_name
*copyc dfp$word_boundary
*copyc i#real_memory_address
*copyc jmp$called_by_job_leveler
*copyc jmp$convert_date_time_to_clock
*copyc jmp$verify_job_leveler
*copyc osp$append_status_integer
*copyc osp$clear_job_signature_lock
*copyc osp$convert_to_real_model_num
*copyc osp$fetch_locked_variable
*copyc osp$initialize_signature_lock
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$test_sig_lock
*copyc osp$verify_system_privilege
*copyc pmp$convert_binary_mainframe_id
*copyc pmp$convert_mainframe_to_binary
*copyc pmp$get_compact_date_time
*copyc pmp$wait
*copyc pmp$zero_out_table
?? EJECT ??
*copyc dfv$file_server_debug_enabled
*copyc dfv$one_word_response_handler
*copyc dfv$p_queue_interface_directory
*copyc dfv$queue_initialization_lock
*copyc dfv$server_wired_heap
*copyc gfv$null_sfid
*copyc osv$page_size
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
  VAR
    v$assigned_to_m: [READ, oss$job_paged_literal] string (256) :=
          '???????????????????????????????? ????????????????????????????????M??????????????P?????' CAT
          '???????????abcdefghijklmnopqrstuvwxyz??????????????????????????????????????????????????' CAT
          '???????????????????????????????????????????????????????????????????????????????????',

    v$assigned_to_t: [READ, oss$job_paged_literal] string (256) :=
          '???????????????????????????????? ????????????????????????????????T??????????????P?????' CAT
          '???????????abcdefghijklmnopqrstuvwxyz??????????????????????????????????????????????????' CAT
          '???????????????????????????????????????????????????????????????????????????????????',

    v$connection_names: [READ, oss$job_paged_literal] ARRAY [dft$connection_types] OF string (7) :=
          ['STORNET', 'CDCNET', 'MOCK'],
    v$io_string: [READ, oss$job_paged_literal] ARRAY [dft$monitor_io_types] OF string (8) :=
          ['IO', 'ALLOCATE'];
?? OLDTITLE ??
?? NEWTITLE := 'dfp$count_mainframes_per_esm', EJECT ??

{ PURPOSE:
{   This procedure scans the queue_interface_directory entries looking for and counting mainframes configured
{   with the element_name provided by the input parameter.

  PROCEDURE [XDCL] dfp$count_mainframes_per_esm
    (    element_name: cmt$element_name;
     VAR mainframe_count: 0 .. dfc$max_number_of_mainframes);

    VAR
      queue_directory_index: dft$queue_directory_index;

    mainframe_count := 0;

    IF dfv$p_queue_interface_directory <> NIL THEN
      FOR queue_directory_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
        IF dfv$p_queue_interface_directory^ [queue_directory_index].element_name = element_name THEN
          mainframe_count := mainframe_count + 1;
        IFEND;
      FOREND;
    IFEND;

  PROCEND dfp$count_mainframes_per_esm;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$create_queue', EJECT ??
*copy dfh$create_queue

  PROCEDURE [XDCL] dfp$create_queue
    (    connection_parameters: dft$connection_parameters;
         destination_mainframe_name: pmt$mainframe_id;
         destination_mainframe_id: pmt$binary_mainframe_id;
         server_to_client: boolean;
     VAR queue_interface_table_p: dft$p_queue_interface_table;
     VAR status: ost$status);

    VAR
      cpu_queue_p: ^dft$cpu_queue,
      driver_queue_p: ^dft$driver_queue,
      ignore_status: ost$status,
      mandated_queue_index: dft$queue_index,
      rma: integer,
      same_definition_mainframe_count: 0 .. dfc$max_number_of_mainframes - 1;

    status.normal := TRUE;

    { Verify that the element has STORNET identification.

    IF connection_parameters.connection_type = dfc$esm_connection THEN
      dfp$verify_element_name (connection_parameters.esm_parameters.element_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    get_same_df_mainframe_count (connection_parameters.driver_name, server_to_client,
          same_definition_mainframe_count);
    IF same_definition_mainframe_count = (dfc$max_number_of_mainframes - 1) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$too_many_servers_or_clients,
            destination_mainframe_name, status);
      RETURN;
    IFEND;

    dfp$fetch_qit (connection_parameters.driver_name, queue_interface_table_p, ignore_status);

    osp$set_job_signature_lock (dfv$queue_initialization_lock);

   /lock_set/
    BEGIN
      IF server_to_client THEN
        mandated_queue_index := connection_parameters.server_queue_index;
      ELSE
        mandated_queue_index := connection_parameters.client_queue_index;
      IFEND;

      IF queue_interface_table_p = NIL THEN
        create_queue_interface_table (connection_parameters, queue_interface_table_p);
        record_queue_interface (connection_parameters.driver_name, queue_interface_table_p,
              connection_parameters);
      ELSE

        { Queue interface table already exists.

        IF (queue_interface_table_p^.queue_directory.
              driver_queue_rma_directory [mandated_queue_index].driver_queue_rma > 0) OR
              (queue_interface_table_p^.queue_directory.
              cpu_queue_pva_directory [mandated_queue_index].p_cpu_queue <> NIL) THEN
          IF server_to_client THEN
            osp$set_status_abnormal (dfc$file_server_id, dfe$id_number_in_use, 'client', status);
          ELSE
            osp$set_status_abnormal (dfc$file_server_id, dfe$id_number_in_use, 'server', status);
          IFEND;
          EXIT /lock_set/;
        IFEND;
      IFEND;

      create_driver_queue (connection_parameters, server_to_client, driver_queue_p);

      create_cpu_queue (connection_parameters, destination_mainframe_name, destination_mainframe_id,
            queue_interface_table_p^.maximum_data_bytes, cpu_queue_p);

      initialize_queue_entries (server_to_client, queue_interface_table_p, mandated_queue_index,
            connection_parameters.number_of_monitor_queue_entries,
            connection_parameters.number_of_task_queue_entries,
            cpu_queue_p^.queue_header.p_allocated_data_rma_list,
            driver_queue_p^.queue_entries, cpu_queue_p^.queue_entries);

      i#real_memory_address (driver_queue_p, rma);
      queue_interface_table_p^.queue_directory.
            driver_queue_rma_directory [mandated_queue_index].driver_queue_rma := rma;
      queue_interface_table_p^.queue_directory.
            driver_queue_pva_directory [mandated_queue_index].p_driver_queue := driver_queue_p;
      queue_interface_table_p^.queue_directory.
            cpu_queue_pva_directory [mandated_queue_index].p_cpu_queue := cpu_queue_p;
      #SPOIL (queue_interface_table_p^.queue_directory);

      IF queue_interface_table_p^.queue_directory.number_of_queues < mandated_queue_index THEN
        queue_interface_table_p^.queue_directory.number_of_queues := mandated_queue_index;
      IFEND;
    END /lock_set/;

    osp$clear_job_signature_lock (dfv$queue_initialization_lock);

  PROCEND dfp$create_queue;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$display_queues ', EJECT ??

{ PURPOSE:
{   The purpose of this request is to display the remote queues at the local operator display.
{
{ Notes:
{   Upon entry to this procedure the 'message_written' parameter has been set to FALSE by the calling
{   procedure.  It is set to TRUE if a line is displayed by this procedure.

  PROCEDURE [XDCL] dfp$display_queues
    (VAR display_identifier {input, output} : dft$display_identifier;
     VAR message_written: boolean;
     VAR status: ost$status);

    VAR
      assignment_string: string(dfc$queue_assignment_strng_size),
      base_micros: jmt$clock_time,
      buffer_rate: real,
      current_date_time: ost$date_time,
      current_micros: jmt$clock_time,
      data_rate: real,
      destination_client_or_server: string (3),
      display_string: string (80),
      elapsed_seconds: real,
      io_type: dft$monitor_io_types,
      inn: integer,
      leader: string (4),
      length: integer,
      length_in_entries: integer,
      limit: integer,
      lock_status: ost$signature_lock_status,
      out: integer,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      queue_interface: dft$queue_directory_index,
      state_flag: string (17),
      transaction_rate: real,
      total_buffer_length_sent: integer,
      total_data_pages_sent: integer,
      total_transaction_count: integer,
      wait_flag: string (12);

    osp$test_sig_lock (dfv$queue_initialization_lock, lock_status);
    IF lock_status <> osc$sls_not_locked THEN
      status.normal := TRUE;
      dfp$display (' Queues being defined ', display_identifier, status);
      RETURN;
    IFEND;

    IF dfv$p_queue_interface_directory <> NIL THEN

    /for_all_queue_interfaces_tables/
      FOR queue_interface := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
        STRINGREP (display_string, length, ' -- element name ',
              dfv$p_queue_interface_directory^ [queue_interface].element_name, ' connection ',
              v$connection_names [dfv$p_queue_interface_directory^ [queue_interface].connection_type],
              '  chan ', dfv$p_queue_interface_directory^ [queue_interface].send_channel.channel_name (1, 6));
        dfp$display (display_string (1, length), display_identifier, status);
        p_queue_interface_table := dfv$p_queue_interface_directory^ [queue_interface].p_queue_interface_table;
        IF p_queue_interface_table <> NIL THEN

          IF dfv$file_server_debug_enabled THEN
            osp$fetch_locked_variable (p_queue_interface_table^.request_buffer_directory.inn, inn);
            out := p_queue_interface_table^.request_buffer_directory.out;
            limit := p_queue_interface_table^.request_buffer_directory.limit;
            IF inn >= out THEN
              length_in_entries := (inn - out) DIV 8;
            ELSE
              length_in_entries := (limit - out + inn) DIV 8;
            IFEND;
            STRINGREP (display_string, length, ' -- Inn: ', inn: 5, '    Out: ', out: 5, '    Limit ',
                  limit: 5, '     Entries in use: ', length_in_entries: 5);
            dfp$display (display_string (1, length), display_identifier, status);
          IFEND;

          dfp$display (' ----DESTINATION MAINFRAME-----TRANSACTIONS-------BUFFER DATA------PAGE DATA--',
                display_identifier, status);
          message_written := TRUE;

        /for_all_queues/
          FOR queue_index := 1 TO UPPERBOUND (p_queue_interface_table^.queue_directory.
                cpu_queue_pva_directory) DO
            IF p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].p_cpu_queue <>
                  NIL THEN
              p_cpu_queue_header := ^p_queue_interface_table^.queue_directory.
                    cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header;
              pmp$get_compact_date_time (current_date_time, status);
              jmp$convert_date_time_to_clock (current_date_time, current_micros);
              jmp$convert_date_time_to_clock (p_cpu_queue_header^.transaction_data.transaction_start_time,
                    base_micros);
              elapsed_seconds := ($REAL (current_micros) - $REAL (base_micros)) / 1000000.0;
              osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_transaction_count,
                    total_transaction_count);
              osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_buffer_length_sent,
                    total_buffer_length_sent);
              osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_data_pages_sent,
                    total_data_pages_sent);
              IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                    p_driver_queue^.queue_header.connection_descriptor.destination.flags.server_to_client THEN
                destination_client_or_server := ' S ';
              ELSE
                destination_client_or_server := ' C ';
              IFEND;
              leader := ' ';
              IF dfv$file_server_debug_enabled THEN
                STRINGREP (leader, length, queue_index);
              IFEND;
              STRINGREP (display_string, length, leader, p_cpu_queue_header^.destination_mainframe_name,
                    '    ', destination_client_or_server, total_transaction_count: 10, '     ',
                    total_buffer_length_sent: 14, '     ', total_data_pages_sent: 10);
              dfp$display (display_string (1, length), display_identifier, status);

              transaction_rate := $REAL (total_transaction_count) / elapsed_seconds;
              buffer_rate := $REAL (total_buffer_length_sent) / elapsed_seconds;
              data_rate := $REAL (total_data_pages_sent) / elapsed_seconds;

              wait_flag := ' ';
              IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                    p_driver_queue^.queue_header.connection_descriptor.destination.flags.server_to_client THEN
                {Will be overwritten if terminated.
                IF p_cpu_queue_header^.leveler_status.leveler_state = jmc$jl_leveler_enabled THEN
                  wait_flag := ' LEVELING ON';
                ELSEIF p_cpu_queue_header^.leveler_status.leveler_state = jmc$jl_server_profile_mismatch THEN
                  wait_flag := ' PROFILE MISM';
                IFEND;
              IFEND;

              IF (((p_cpu_queue_header^.partner_status.server_state = dfc$terminated) OR
                    (p_cpu_queue_header^.partner_status.server_state = dfc$inactive) OR
                    (p_cpu_queue_header^.partner_status.server_state = dfc$awaiting_recovery)) AND
                    p_cpu_queue_header^.partner_status.verify_queue) THEN
                wait_flag := ' ACTIVATING ';
              IFEND;
              CASE p_cpu_queue_header^.partner_status.server_state OF
              = dfc$terminated=
                state_flag := '  TERMINATED ';
                IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                      p_driver_queue^.queue_header.connection_descriptor.destination.flags.
                      server_to_client THEN
                  IF NOT p_cpu_queue_header^.partner_status.verify_queue THEN
                    IF p_cpu_queue_header^.partner_status.users_wait_on_terminated_server THEN
                      wait_flag := '  WAIT';
                    ELSE
                      wait_flag := '  NO WAIT';
                    IFEND;
                  IFEND;
                IFEND;
              = dfc$awaiting_recovery =
                state_flag := 'AWAITING_RECOVERY';
                IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                      p_driver_queue^.queue_header.connection_descriptor.destination.flags.
                      server_to_client THEN
                  IF NOT p_cpu_queue_header^.partner_status.verify_queue THEN
                    IF NOT p_cpu_queue_header^.partner_status.server_pages_saved THEN
                      wait_flag := ' UNSAFE_DATA';
                    IFEND;
                  IFEND;
                IFEND;
              = dfc$recovering =
                state_flag := '  RECOVERING ';
              = dfc$inactive =
                state_flag := '  INACTIVE   ';
              = dfc$active =
                state_flag := '  ACTIVE     ';
              = dfc$deactivated =
                state_flag := '  DEACTIVATED';
              ELSE
                state_flag := 'UNKNOWN STATE';
              CASEND;

              STRINGREP (display_string, length, '  ', state_flag, wait_flag, transaction_rate: 9: 2,
                    '         ', buffer_rate: 10: 2, '     ', data_rate: 10: 2);
              dfp$display (display_string (1, length), display_identifier, status);
              IF dfv$file_server_debug_enabled THEN
                IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                      p_driver_queue^.queue_header.connection_descriptor.destination.flags.
                      server_to_client THEN
                  { Client to server connection
                  assignment_string := p_cpu_queue_header^.queue_entry_assignment_table;
                  #translate (v$assigned_to_m, assignment_string (2, p_cpu_queue_header^.
                      number_of_monitor_queue_entries),
                      assignment_string (2, p_cpu_queue_header^.
                      number_of_monitor_queue_entries));
                  #translate (v$assigned_to_t, assignment_string (2 + p_cpu_queue_header^.
                      number_of_monitor_queue_entries, p_cpu_queue_header^.number_of_task_queue_entries),
                      assignment_string (2 + p_cpu_queue_header^.
                      number_of_monitor_queue_entries, p_cpu_queue_header^.number_of_task_queue_entries));
                  display_string := assignment_string;
                  dfp$display (display_string, display_identifier, status);
                  display_string := assignment_string (81, *);
                  IF display_string (1) <> dfc$pad_entry_char THEN
                    dfp$display (display_string, display_identifier, status);
                  IFEND;
                ELSE
                  { Server to client connection

                /display_io_rate/
                  FOR io_type := dfc$monitor_io TO dfc$monitor_allocate DO
                    total_transaction_count := p_cpu_queue_header^.monitor_io [io_type].number_of_requests;
                    current_micros := p_cpu_queue_header^.monitor_io [io_type].total_request_time;
                    transaction_rate := $REAL (total_transaction_count) / elapsed_seconds;
                    IF total_transaction_count > 0 THEN
                      data_rate := $REAL (current_micros) / $REAL (total_transaction_count);
                    ELSE
                      data_rate := $REAL (0);
                    IFEND;
                    STRINGREP (display_string, length, '        ', v$io_string [io_type], ' #',
                          total_transaction_count: 10, '   #/sec ', transaction_rate: 8: 2, '   Ave Time',
                          data_rate: 9: 2);
                    dfp$display (display_string (1, length), display_identifier, status);
                  FOREND /display_io_rate/;
                IFEND;
              IFEND;
            IFEND;
          FOREND /for_all_queues/;
        IFEND;
      FOREND /for_all_queue_interfaces_tables/;
    IFEND;

  PROCEND dfp$display_queues;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$fetch_qit  ', EJECT ??

  PROCEDURE [XDCL] dfp$fetch_qit
    (    driver_name: ost$name;
     VAR queue_interface_table_p: dft$p_queue_interface_table;
     VAR status: ost$status);

    VAR
      index: dft$queue_directory_index;

    status.normal := TRUE;
    queue_interface_table_p := NIL;

    IF dfv$p_queue_interface_directory <> NIL THEN
      FOR index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
        IF dfv$p_queue_interface_directory^ [index].driver_name = driver_name THEN
          queue_interface_table_p := dfv$p_queue_interface_directory^ [index].p_queue_interface_table;
          RETURN;
        IFEND;
      FOREND;
    IFEND;

    osp$set_status_abnormal (dfc$file_server_id, dfe$unknown_driver, driver_name, status);

  PROCEND dfp$fetch_qit;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$find_mainframe_id', EJECT ??
*copy dfh$find_mainframe_id

  PROCEDURE [XDCL, #GATE] dfp$find_mainframe_id
    (    mainframe_id: pmt$mainframe_id;
         server_to_client: boolean;
     VAR mainframe_found: boolean;
     VAR queue_interface_table_p: ^dft$queue_interface_table;
     VAR cpu_queue_p: ^dft$cpu_queue;
     VAR queue_index: dft$queue_index;
     VAR q_interface_directory_entry_p: ^dft$q_interface_directory_entry);

    VAR
      driver_queue_p: ^dft$driver_queue,
      qit_p: ^dft$queue_interface_table,
      queue_directory_index: dft$queue_directory_index;

    mainframe_found := FALSE;
    osp$verify_system_privilege;

    IF dfv$p_queue_interface_directory = NIL THEN
      RETURN;
    IFEND;

    FOR queue_directory_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
      qit_p := dfv$p_queue_interface_directory^ [queue_directory_index].p_queue_interface_table;
      IF qit_p <> NIL THEN
        FOR queue_index := 1 TO qit_p^.queue_directory.number_of_queues DO
          cpu_queue_p := qit_p^.queue_directory.cpu_queue_pva_directory [queue_index].p_cpu_queue;
          IF cpu_queue_p <> NIL THEN
            driver_queue_p := qit_p^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue;
            IF (mainframe_id = cpu_queue_p^.queue_header.destination_mainframe_name) AND
                  (server_to_client =
                  driver_queue_p^.queue_header.connection_descriptor.source.flags.server_to_client) THEN
              mainframe_found := TRUE;
              queue_interface_table_p := qit_p;
              q_interface_directory_entry_p := ^dfv$p_queue_interface_directory^ [queue_directory_index];
              RETURN;
            IFEND;
          IFEND;
        FOREND;
      IFEND;
    FOREND;

  PROCEND dfp$find_mainframe_id;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$get_mainframe_list', EJECT ??
*copy dfh$get_mainframe_list

{ NOTE:
{   This procedure returns the REAL processor model number.

  PROCEDURE [XDCL, #GATE] dfp$get_mainframe_list
    (    partners_are_servers: boolean;
     VAR partner_mainframes: dft$partner_mainframe_list;
     VAR partner_count: dft$partner_mainframe_count);

    VAR
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_directory_index: dft$queue_directory_index,
      queue_index: dft$queue_index;

    partner_count := 0;
    IF dfv$p_queue_interface_directory = NIL THEN
      RETURN;
    IFEND;

  /search_que_interf_directory/
    FOR queue_directory_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
      p_queue_interface_table := dfv$p_queue_interface_directory^ [queue_directory_index].
            p_queue_interface_table;
      IF p_queue_interface_table <> NIL THEN

      /search_queues/
        FOR queue_index := 1 TO UPPERBOUND (p_queue_interface_table^.queue_directory.
              driver_queue_pva_directory) DO
          IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                p_driver_queue <> NIL THEN
            IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                  p_driver_queue^.queue_header.connection_descriptor.destination.flags.server_to_client =
                  partners_are_servers THEN
              p_cpu_queue_header := ^p_queue_interface_table^.queue_directory.
                    cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header;
              partner_count := partner_count + 1;
              IF (UPPERBOUND (partner_mainframes) >= partner_count) THEN
                partner_mainframes [partner_count].mainframe_id :=
                      p_cpu_queue_header^.destination_mainframe_id;
                osp$convert_to_real_model_num (p_cpu_queue_header^.destination_mainframe_id.model_number,
                      partner_mainframes [partner_count].mainframe_id.model_number);
                partner_mainframes [partner_count].partner_state :=
                      p_cpu_queue_header^.partner_status.server_state;
                partner_mainframes [partner_count].mainframe_name :=
                      p_cpu_queue_header^.destination_mainframe_name;
              IFEND;
            IFEND;
          IFEND;
        FOREND /search_queues/;
      IFEND;
    FOREND /search_que_interf_directory/;
  PROCEND dfp$get_mainframe_list;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$get_mainframe_status', EJECT ??
*copyc dfh$get_mainframe_status

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

    VAR
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index;

    dfp$find_mainframe_id (partner_mainframe_id, NOT partner_is_server, mainframe_found,
          p_queue_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN
      server_state := p_cpu_queue^.queue_header.partner_status.server_state;
      status.normal := TRUE;
    ELSE
      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;
    IFEND;

  PROCEND dfp$get_mainframe_status;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$get_partner_mainframes', EJECT ??
*copy dfh$get_partner_mainframes

  PROCEDURE [XDCL, #GATE] dfp$get_partner_mainframes
    (    partners_are_servers: boolean;
         p_partner_mainframes { output } : ^dft$partner_mainframe_list;
     VAR partner_count: dft$partner_mainframe_count);

    VAR
      called_by_leveler: boolean,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_directory_index: dft$queue_directory_index,
      queue_index: dft$queue_index;

    partner_count := 0;
    called_by_leveler := jmp$called_by_job_leveler ();
    IF NOT called_by_leveler THEN
      osp$verify_system_privilege;
    IFEND;

    IF dfv$p_queue_interface_directory = NIL THEN
      RETURN;
    IFEND;

  /search_que_interf_directory/
    FOR queue_directory_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
      p_queue_interface_table := dfv$p_queue_interface_directory^ [queue_directory_index].
            p_queue_interface_table;
      IF p_queue_interface_table <> NIL THEN

      /search_queues/
        FOR queue_index := 1 TO UPPERBOUND (p_queue_interface_table^.queue_directory.
              driver_queue_pva_directory) DO
          IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                p_driver_queue <> NIL THEN
            IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                  p_driver_queue^.queue_header.connection_descriptor.destination.flags.server_to_client =
                  partners_are_servers THEN
              p_cpu_queue_header := ^p_queue_interface_table^.queue_directory.
                    cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header;
              IF p_cpu_queue_header^.destination_mainframe_name = dfc$loopback_server_mainframe THEN
                CYCLE /search_queues/;
              IFEND;
              IF called_by_leveler THEN
                IF partners_are_servers AND
                  (p_cpu_queue_header^.partner_status.server_state = dfc$active) AND
                  (NOT p_cpu_queue_header^.partner_status.job_reconcilliation_completed) THEN
                  { Dont tell the leveler about this server till job reconcilliation completed
                   CYCLE /search_queues/;
                IFEND;
                p_cpu_queue_header^.leveler_status.cleanup_completed := FALSE;
                {This is done to prevent going to an inactive state while job leveler is still procesing.
              IFEND;
              partner_count := partner_count + 1;
              IF (p_partner_mainframes <> NIL) AND (UPPERBOUND (p_partner_mainframes^) >= partner_count) THEN
                p_partner_mainframes^ [partner_count].mainframe_id :=
                      p_cpu_queue_header^.destination_mainframe_id;
                p_partner_mainframes^ [partner_count].partner_state :=
                      p_cpu_queue_header^.partner_status.server_state;
                p_partner_mainframes^ [partner_count].mainframe_name :=
                      p_cpu_queue_header^.destination_mainframe_name;
              IFEND;
            IFEND;
          IFEND;
        FOREND /search_queues/;
      IFEND;
    FOREND /search_que_interf_directory/;
  PROCEND dfp$get_partner_mainframes;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$get_partner_queues', EJECT ??
*copyc dfh$get_partner_queues
  PROCEDURE [XDCL, #GATE] dfp$get_partner_queues
    (    p_partner_queue_list { output } : ^dft$partner_queue_list;
     VAR partner_queue_count: dft$partner_queue_count);

    VAR
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_directory_index: dft$queue_directory_index,
      queue_index: dft$queue_index;

    osp$verify_system_privilege;
    partner_queue_count := 0;

    IF dfv$p_queue_interface_directory = NIL THEN
      RETURN;
    IFEND;

  /search_que_interf_directory/
    FOR queue_directory_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
      p_queue_interface_table := dfv$p_queue_interface_directory^ [queue_directory_index].
            p_queue_interface_table;
      IF p_queue_interface_table <> NIL THEN

      /search_queues/
        FOR queue_index := 1 TO UPPERBOUND (p_queue_interface_table^.queue_directory.
              driver_queue_pva_directory) DO
          IF p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
                p_driver_queue <> NIL THEN
            partner_queue_count := partner_queue_count + 1;
            IF (p_partner_queue_list <> NIL) AND
               (UPPERBOUND (p_partner_queue_list^) >= partner_queue_count) THEN
              p_partner_queue_list^ [partner_queue_count].p_driver_queue := p_queue_interface_table^
                    .queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue;
              p_partner_queue_list^ [partner_queue_count].p_cpu_queue := p_queue_interface_table^
                    .queue_directory.cpu_queue_pva_directory [queue_index].p_cpu_queue;
            IFEND;
          IFEND;
        FOREND /search_queues/;
      IFEND;
    FOREND /search_que_interf_directory/;
  PROCEND dfp$get_partner_queues;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$prepare_for_idle_system', EJECT ??
{
{   The purpose of this procedure is to gracefully bring the file server
{ down in preparation for a terminate_system.
{ An attempt is made to deactivate any active connections, and failing that,
{ they are forced to awaiting recovery.
{ Any connection that is 'activating' is forced back to its previous state.
{ If a client-to-server connection was awaiting_recovery but pages were
{ not able to be saved then the connection is terminated, since the pages
{ would not be available following the continuation deadstart.

  PROCEDURE [XDCL, #GATE] dfp$prepare_for_idle_system
    (    idle_code: syt$180_idle_code;
     VAR status: ost$status);

    CONST
      one_second_in_microseconds = 1000000,
      one_second_in_milliseconds = 1000;

    VAR
      active_partner_count: dft$partner_queue_count,
      display_string: string (80),
      display_length: integer,
      endtime: integer,
      index: dft$partner_queue_count,
      p_partner_queues: ^dft$partner_queue_list,
      partner_queue_count: dft$partner_queue_count,
      timeout_partner: boolean;

    status.normal := TRUE;
    osp$verify_system_privilege;

    PUSH p_partner_queues: [1 .. dfc$maximum_partner_queues];
    dfp$get_partner_queues (p_partner_queues, partner_queue_count);

    IF partner_queue_count > 0 THEN
      CASE idle_code OF
      = syc$ic_idle_command, syc$ic_system_terminated =
        timeout_partner := FALSE;
        endtime := #FREE_RUNNING_CLOCK (0) + (80 * one_second_in_microseconds);
      ELSE
{       = (syc$ic_hardware_idle,) syc$ic_long_power =
{         OR System idling due to fatal software error.
{         This procedure is not called for idle_code of syc$ic_hardware_idle.
        timeout_partner := TRUE;
        endtime := #FREE_RUNNING_CLOCK (0) + (40 * one_second_in_microseconds);
      CASEND;

    /await_inactive/
      REPEAT
        active_partner_count := 0;

      /deactivate_partners/
        FOR index := 1 TO partner_queue_count DO
          #SPOIL (p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status);
          CASE p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.server_state OF
          = dfc$active =
            active_partner_count := active_partner_count + 1;
            IF timeout_partner THEN
{             Drive queue to state of dfc$terminated or dfc$awaiting_recovery.
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
            ELSE
{             Same as DEACTIVATE_CLIENT or DEACTIVATE_SERVER command processing.
{             Drive queue to state of dfc$inactive.
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.send_deactivate_partner :=
                    TRUE;
            IFEND;

          = dfc$deactivated =
{           The queue is in a transition state on its way to dfc$inactive.
{           Wait for this queue to reach state of dfc$inactive.
            active_partner_count := active_partner_count + 1;

          = dfc$recovering =
{           The queue is in a transition state on its way to dfc$active.
{           Wait for this queue to reach state of dfc$active.
            active_partner_count := active_partner_count + 1;

          = dfc$terminated =
            { Don't wait for the server to become active.
            IF p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue THEN
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
              active_partner_count := active_partner_count + 1;
            IFEND;

          = dfc$inactive =
            IF p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue THEN
{             The queue is in a transition state on its way to dfc$active.
{             Drive queue to state of dfc$terminated or dfc$awaiting_recovery.
{             It's better to not let the server go active, so that IO will
{             not be performed on any files.
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
              active_partner_count := active_partner_count + 1;
            IFEND;

          = dfc$awaiting_recovery =
            IF p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue THEN
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
              active_partner_count := active_partner_count + 1;
            ELSEIF (NOT p_partner_queues^ [index].p_driver_queue^.queue_header.connection_descriptor.
                  source.flags.server_to_client) AND (NOT p_partner_queues^ [index].p_cpu_queue^.
                  queue_header.partner_status.server_pages_saved) AND
                  (idle_code = syc$ic_system_terminated) THEN
               dfp$free_image_file (p_partner_queues^ [index].p_cpu_queue^.queue_header.
                     destination_mainframe_id, status);
               p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.server_state :=
                     dfc$terminated;
               #SPOIL (p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status);
               dfp$change_family_server_state (dfc$terminated, p_partner_queues^ [index].
                    p_cpu_queue^.queue_header.destination_mainframe_id);
               STRINGREP (display_string, display_length, ' Terminating server ',
                    p_partner_queues^ [index].p_cpu_queue^.queue_header.destination_mainframe_name,
                    ' due to unsaved pages');
               clp$put_job_command_response (display_string (1, display_length), status);
               log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
            IFEND;

          ELSE { dfc$deleted }
            ;
          CASEND;
        FOREND /deactivate_partners/;
        IF active_partner_count > 0 THEN
          pmp$wait (10 * one_second_in_milliseconds, 10 * one_second_in_milliseconds);
        IFEND;
      UNTIL (#FREE_RUNNING_CLOCK (0) > endtime) OR (active_partner_count = 0);

      IF active_partner_count > 0 THEN
{       This situation is most likely to occur when deactivating partners
{       as a result of the IDLE_SYSTEM command.
        STRINGREP (display_string, display_length, active_partner_count,
          ' file server partner(s) not Inactive, force timeout.');
        clp$put_job_command_response (display_string (1, display_length), status);
        log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
        endtime := #FREE_RUNNING_CLOCK (0) + (20 * one_second_in_microseconds);

      /await_timeout/
        REPEAT
          active_partner_count := 0;

        /timeout_partners/
          FOR index := 1 TO partner_queue_count DO
            #SPOIL (p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status);
            CASE p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.server_state OF
            = dfc$active =
{             Not likely to be in this state, just covering all bases.
{             Drive queue to state of dfc$terminated or dfc$awaiting_recovery.
              STRINGREP (display_string, display_length, ' Active partner ',
                    p_partner_queues^ [index].p_cpu_queue^.queue_header.destination_mainframe_name,
                    ' forced to awaiting recovery ');
              clp$put_job_command_response (display_string (1, display_length), status);
              log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
              active_partner_count := active_partner_count + 1;

            = dfc$deactivated =
{             Most likely to be in this state with deactivation taking too long.
{             The queue is in a transition state on its way to dfc$inactive.
{             Drive queue to state of dfc$terminated or dfc$awaiting_recovery.
              STRINGREP (display_string, display_length, ' Deactivating partner ',
                    p_partner_queues^ [index].p_cpu_queue^.queue_header.destination_mainframe_name,
                    ' forced to awaiting recovery ');
              clp$put_job_command_response (display_string (1, display_length), status);
              log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
              active_partner_count := active_partner_count + 1;

            = dfc$recovering =
{             The queue is in a transition state on its way to dfc$active.
{             Drive queue to state of dfc$terminated or dfc$awaiting_recovery.
              STRINGREP (display_string, display_length, ' Recovering partner ',
                    p_partner_queues^ [index].p_cpu_queue^.queue_header.destination_mainframe_name,
                    ' forced to awaiting recovery ');
              clp$put_job_command_response (display_string (1, display_length), status);
              log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
              p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
              active_partner_count := active_partner_count + 1;

            = dfc$inactive, dfc$terminated, dfc$awaiting_recovery =
              IF p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue THEN
{               The queue is in a transition state on its way to dfc$active.
{               Drive queue to state of dfc$terminated or dfc$awaiting_recovery.
                STRINGREP (display_string, display_length, ' Activating partner ',
                      p_partner_queues^ [index].p_cpu_queue^.queue_header.destination_mainframe_name,
                      ' forced to awaiting recovery ');
                clp$put_job_command_response (display_string (1, display_length), status);
                log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
                p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
                p_partner_queues^ [index].p_cpu_queue^.queue_header.partner_status.verify_queue := FALSE;
                active_partner_count := active_partner_count + 1;
              IFEND;
            ELSE { dfc$deleted }
              ;
            CASEND;
          FOREND /timeout_partners/;
          IF active_partner_count > 0 THEN
            pmp$wait (5 * one_second_in_milliseconds, 5 * one_second_in_milliseconds);
          IFEND;
        UNTIL (#FREE_RUNNING_CLOCK (0) > endtime) OR (active_partner_count = 0);

        IF active_partner_count > 0 THEN
          STRINGREP (display_string, display_length, active_partner_count,
              ' file server partner(s) not Inactive, continute termination');
          clp$put_job_command_response (display_string (1, display_length), status);
          log_display ($pmt$ascii_logset [pmc$system_log], display_string (1, display_length));
        ELSE
          clp$put_job_command_response ('  All file server partners forced Inactive or Awaiting Recovery.',
                status);
          log_display ($pmt$ascii_logset [pmc$system_log],
                '  All file server partners forced Inactive or Awaiting Recovery.');
        IFEND;
      ELSE
        log_display ($pmt$ascii_logset [pmc$system_log],
              '  All file server partners Inactive or Awaiting Recovery.');
        clp$put_job_command_response ('  All file server partners Inactive or Awaiting Recovery.', status);
      IFEND;
    IFEND;

  PROCEND dfp$prepare_for_idle_system;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$store_leveler_status', EJECT ??
*copy dfh$store_leveler_status

  PROCEDURE [XDCL, #GATE] dfp$store_leveler_status
    (    server_mainframe_id: pmt$binary_mainframe_id;
         leveler_status: jmt$jl_job_leveler_status;
     VAR status: ost$status);

    VAR
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_q_interface_table: ^dft$queue_interface_table,
      queue_directory_index: dft$queue_directory_index,
      queue_index: dft$queue_index,
      server_name: pmt$mainframe_id;

    status.normal := TRUE;
    jmp$verify_job_leveler;

    pmp$convert_binary_mainframe_id (server_mainframe_id, server_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$find_mainframe_id (server_name, {host_is_server_to_client=} FALSE, mainframe_found,
          p_q_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF mainframe_found THEN
      p_cpu_queue^.queue_header.leveler_status := leveler_status;
    ELSE
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, server_name, status);
    IFEND;

  PROCEND dfp$store_leveler_status;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$$client_state', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$$client_state
    (    function_name: clt$name;
         argument_list: string ( * );
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      deck_adt: [STATIC, READ, cls$adt] array [1 .. 1] of clt$argument_descriptor :=
            [[[clc$required], [NIL, clc$name_value, 1, osc$max_name_size]]];

    VAR
      avt: array [1 .. 1] of clt$value,
      host_is_server_to_client: boolean,
      mainframe_name: pmt$mainframe_id;

    clp$scan_argument_list (function_name, argument_list, ^deck_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    host_is_server_to_client := TRUE;

    mainframe_name := avt [1].name.value;

    get_partner_state (mainframe_name, host_is_server_to_client, value);

  PROCEND dfp$$client_state;
?? OLDTITLE ??
?? NEWTITLE := 'dfp$$server_state', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$$server_state
    (    function_name: clt$name;
         argument_list: string ( * );
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      deck_adt: [STATIC, READ, cls$adt] array [1 .. 1] of clt$argument_descriptor :=
            [[[clc$required], [NIL, clc$name_value, 1, osc$max_name_size]]];

    VAR
      avt: array [1 .. 1] of clt$value,
      host_is_server_to_client: boolean,
      mainframe_name: pmt$mainframe_id;

    clp$scan_argument_list (function_name, argument_list, ^deck_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    host_is_server_to_client := FALSE;

    mainframe_name := avt [1].name.value;

    get_partner_state (mainframe_name, host_is_server_to_client, value);

  PROCEND dfp$$server_state;
?? OLDTITLE ??
?? NEWTITLE := 'build_qe_p_data_rma_list', EJECT ??

  PROCEDURE [INLINE] build_qe_p_data_rma_list
    (    pva: ^cell;
         number_of_rma_list_entries: 1 .. dfc$max_rma_list_entries;
     VAR p_data_rma_list: dft$p_data_rma_list);

    VAR
      p_sequence_record: ^RECORD
        sequence: SEQ (REP 7fffffff(16) OF CELL),
      RECEND,
      p_sequence: ^SEQ (REP 7fffffff(16) OF CELL);

    p_sequence_record := pva;
    p_sequence := ^p_sequence_record^.sequence;
    RESET p_sequence;
    NEXT p_data_rma_list :[1 .. number_of_rma_list_entries] IN p_sequence;

  PROCEND build_qe_p_data_rma_list;
?? OLDTITLE ??
?? NEWTITLE := 'create_cpu_queue ', EJECT ??

  PROCEDURE create_cpu_queue
    (    connection_parameters: dft$connection_parameters;
         destination_mainframe_name: pmt$mainframe_id;
         destination_mainframe_id: pmt$binary_mainframe_id;
         maximum_data_bytes: dfc$min_data_record_bytes .. dfc$max_data_record_bytes;
     VAR cpu_queue_p: ^dft$cpu_queue);

    VAR
      extra_character: 3 .. dfc$queue_assignment_strng_size,
      local_status: ost$status,
      rma_list_index: 1 .. dfc$max_rma_list_entries * dfc$max_queue_entries;

    { Add 1 to the number of queue entries to account for the Poll Task.

    ALLOCATE cpu_queue_p: [1 .. (connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries + 1)] IN dfv$server_wired_heap^;
    IF cpu_queue_p = NIL THEN
      osp$system_error (' NIL cpu_queue_p', NIL);
    IFEND;

    { Allocated space for all queue entry's data RMA lists (except for POLL task entry).

    ALLOCATE cpu_queue_p^.queue_header.p_allocated_data_rma_list:[1 ..
          ((maximum_data_bytes DIV osv$page_size) * (connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries))] IN dfv$server_wired_heap^;
    IF cpu_queue_p^.queue_header.p_allocated_data_rma_list = NIL THEN
      osp$system_error (' NIL allocated_data_rma_list_p', NIL);
    IFEND;

    FOR rma_list_index := LOWERBOUND (cpu_queue_p^.queue_header.p_allocated_data_rma_list^.rma_list) TO
          UPPERBOUND (cpu_queue_p^.queue_header.p_allocated_data_rma_list^.rma_list) DO
      cpu_queue_p^.queue_header.p_allocated_data_rma_list^.rma_list [rma_list_index].fill := 0;
      cpu_queue_p^.queue_header.p_allocated_data_rma_list^.rma_list [rma_list_index].length := 0;
      cpu_queue_p^.queue_header.p_allocated_data_rma_list^.rma_list [rma_list_index].rma := 0;
    FOREND;

    { Initialize queue header.

    cpu_queue_p^.queue_header.number_of_monitor_queue_entries :=
          connection_parameters.number_of_monitor_queue_entries;
    cpu_queue_p^.queue_header.number_of_task_queue_entries :=
          connection_parameters.number_of_task_queue_entries;

    { This assumes free is the blank.

    cpu_queue_p^.queue_header.queue_entry_assignment_table := '';

    FOR extra_character := (connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries + 2) TO
          #SIZE (cpu_queue_p^.queue_header.queue_entry_assignment_table) DO
      cpu_queue_p^.queue_header.queue_entry_assignment_table (extra_character) := dfc$pad_entry_char;
    FOREND;

    { Assign 1st entry to the Poll Task.

    cpu_queue_p^.queue_header.queue_entry_assignment_table (1, 1) := dfc$assigned_entry_char;

    cpu_queue_p^.queue_header.connection_type := connection_parameters.connection_type;
    cpu_queue_p^.queue_header.timeout_interval :=
          connection_parameters.client_to_server.timeout_interval * 1000000;
    cpu_queue_p^.queue_header.maximum_request_timeout_count :=
          connection_parameters.client_to_server.maximum_request_timeout_count;
    cpu_queue_p^.queue_header.maximum_retransmission_count :=
          connection_parameters.client_to_server.maximum_retransmission_count;
    cpu_queue_p^.queue_header.destination_mainframe_id := destination_mainframe_id;
    cpu_queue_p^.queue_header.destination_mainframe_name := destination_mainframe_name;
    cpu_queue_p^.queue_header.leveler_status.leveler_state := jmc$jl_leveler_disabled;
    cpu_queue_p^.queue_header.leveler_status.cleanup_completed := TRUE;
    cpu_queue_p^.queue_header.server_lifetime := 0;
    cpu_queue_p^.queue_header.server_birthdate := 0;
    cpu_queue_p^.queue_header.partner_status.terminate_partner := FALSE;
    cpu_queue_p^.queue_header.partner_status.timeout_partner := FALSE;
    cpu_queue_p^.queue_header.partner_status.users_wait_on_terminated_server :=
          connection_parameters.client_to_server.users_wait_on_terminated;
    cpu_queue_p^.queue_header.partner_status.deactivate_complete := FALSE;
    cpu_queue_p^.queue_header.partner_status.server_state := dfc$terminated;
    cpu_queue_p^.queue_header.partner_status.verify_queue := FALSE;
    pmp$get_compact_date_time (cpu_queue_p^.queue_header.transaction_data.transaction_start_time,
          local_status);
    cpu_queue_p^.queue_header.transaction_data.total_transaction_count := 0;
    cpu_queue_p^.queue_header.transaction_data.total_buffer_length_sent := 0;
    cpu_queue_p^.queue_header.transaction_data.total_data_pages_sent := 0;
    cpu_queue_p^.queue_header.transaction_data.total_buffer_length_received := 0;
    cpu_queue_p^.queue_header.transaction_data.total_data_pages_received := 0;
    cpu_queue_p^.queue_header.p_host_application_info := NIL;
    cpu_queue_p^.queue_header.p_remote_application_info := NIL;
    cpu_queue_p^.queue_header.p_application_rpc_list := NIL;

  PROCEND create_cpu_queue;
?? OLDTITLE ??
?? NEWTITLE := 'create_driver_queue ', EJECT ??

  PROCEDURE create_driver_queue
    (    connection_parameters: dft$connection_parameters;
         server_to_client: boolean;
     VAR driver_queue_p: ^dft$driver_queue);

    { Add 1 to the number of queue entries to account for the Poll Task.

    ALLOCATE driver_queue_p: [1 .. (connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries + 1)] IN dfv$server_wired_heap^;
    IF driver_queue_p = NIL THEN
      osp$system_error ('NIL driver_queue_p', NIL);
    IFEND;
    pmp$zero_out_table (driver_queue_p, #SIZE (driver_queue_p^));

    { Initialize queue header

    driver_queue_p^.queue_header.flags.idle := TRUE;

    { Add 1 to total number of queue entries to account for the Poll Task.

    driver_queue_p^.queue_header.number_of_queue_entries :=
          connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries + 1;
    driver_queue_p^.queue_header.connection_descriptor.source.flags.server_to_client := server_to_client;
    IF server_to_client THEN
      driver_queue_p^.queue_header.connection_descriptor.source.queue_index :=
            connection_parameters.server_queue_index;
      driver_queue_p^.queue_header.connection_descriptor.destination.queue_index :=
            connection_parameters.client_queue_index;
    ELSE {client to server queue}
      driver_queue_p^.queue_header.connection_descriptor.source.queue_index :=
            connection_parameters.client_queue_index;
      driver_queue_p^.queue_header.connection_descriptor.destination.queue_index :=
            connection_parameters.server_queue_index;
    IFEND;

    driver_queue_p^.queue_header.connection_descriptor.destination.flags.server_to_client :=
          NOT server_to_client;
    IF connection_parameters.connection_type = dfc$esm_connection THEN
      driver_queue_p^.queue_header.connection_descriptor.source.id_number :=
            connection_parameters.esm_parameters.source_id_number;
      driver_queue_p^.queue_header.connection_descriptor.destination.id_number :=
            connection_parameters.esm_parameters.destination_id_number;
    IFEND;

  PROCEND create_driver_queue;
?? OLDTITLE ??
?? NEWTITLE := 'create_queue_interface_table ', EJECT ??

  PROCEDURE create_queue_interface_table
    (    connection_parameters: dft$connection_parameters;
     VAR queue_interface_table_p: dft$p_queue_interface_table);

    VAR
      number_request_buffer_entries: 1 .. dfc$max_request_buffer_entries,
      queue: dft$queue_index,
      request_buffer_p: ^dft$request_buffer,
      rma: integer;

    ALLOCATE queue_interface_table_p IN dfv$server_wired_heap^;
    IF queue_interface_table_p = NIL THEN
      osp$system_error ('NIL queue_interface_table_p ', NIL);
    IFEND;
    pmp$zero_out_table (queue_interface_table_p, #SIZE (queue_interface_table_p^));

    pmp$zero_out_table (^queue_interface_table_p^.request_buffer_directory,
          #SIZE (queue_interface_table_p^.request_buffer_directory));
    ALLOCATE request_buffer_p IN dfv$server_wired_heap^;
    IF request_buffer_p = NIL THEN
      osp$system_error (' NIL request_buffer_p', NIL);
    IFEND;
    pmp$zero_out_table (request_buffer_p, #SIZE (request_buffer_p^));

    queue_interface_table_p^.request_buffer_directory.limit := #SIZE (request_buffer_p^);
    queue_interface_table_p^.request_buffer_directory.inn := 0;
    queue_interface_table_p^.request_buffer_directory.out := 0;
    i#real_memory_address (request_buffer_p, rma);
    queue_interface_table_p^.request_buffer_directory.request_buffer_rma := rma;
    queue_interface_table_p^.request_buffer_directory.p_request_buffer := request_buffer_p;

    IF connection_parameters.connection_type = dfc$esm_connection THEN
      queue_interface_table_p^.esm_base_addresses := connection_parameters.esm_parameters.esm_base_addresses;
      queue_interface_table_p^.queue_directory.source_id_number :=
            connection_parameters.esm_parameters.source_id_number;
    IFEND;

    queue_interface_table_p^.maximum_data_bytes :=
          connection_parameters.client_to_server.maximum_data_bytes;

    { Set up empty queue directory.

    queue_interface_table_p^.queue_directory.number_of_queues := 0;

    FOR queue := 1 TO UPPERBOUND (queue_interface_table_p^.queue_directory.driver_queue_pva_directory) DO
      queue_interface_table_p^.queue_directory.driver_queue_pva_directory [queue].p_driver_queue := NIL;
      queue_interface_table_p^.queue_directory.cpu_queue_pva_directory [queue].p_cpu_queue := NIL;
      queue_interface_table_p^.queue_directory.driver_queue_rma_directory [queue].driver_queue_rma := 0;
    FOREND;

  PROCEND create_queue_interface_table;
?? OLDTITLE ??
?? NEWTITLE := 'get_partner_state', EJECT ??

  PROCEDURE get_partner_state
    (    mainframe_name: pmt$mainframe_id;
         host_is_server_to_client: boolean;
     VAR value: clt$value);

    VAR
      ignore_status: ost$status,
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_exists: boolean,
      queue_index: dft$queue_index,
      server_birthdate: integer,
      server_lifetime: dft$lifetime,
      server_state: dft$server_state;

    dfp$find_mainframe_id (mainframe_name, host_is_server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, p_q_interface_directory_entry);

    value.descriptor := 'STRING';
    value.kind := clc$string_value;
    queue_exists := mainframe_found;
    IF mainframe_found THEN
      server_state := p_cpu_queue^.queue_header.partner_status.server_state;
    ELSE { No queues exist
      pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, ignore_status);
      IF host_is_server_to_client THEN
        dfp$get_client_mf_file_info (mainframe_id, mainframe_found, server_state, server_lifetime,
              server_birthdate);
      ELSE
        dfp$get_highest_sf_lifetime (mainframe_id, mainframe_found, server_state, server_lifetime,
              server_birthdate);
      IFEND;
    IFEND;

    IF NOT mainframe_found OR (server_state = dfc$deleted) THEN
      { Server state of deleted is set to deleted for test compatability.
      value.str.size := 7;
      value.str.value := 'UNKNOWN';
    ELSE
      CASE server_state OF
      = dfc$active =
        value.str.size := 6;
        value.str.value := 'ACTIVE';
      = dfc$deactivated =
        value.str.size := 11;
        value.str.value := 'DEACTIVATED';
      = dfc$inactive =
        value.str.size := 8;
        value.str.value := 'INACTIVE';
      = dfc$terminated =
        IF queue_exists AND p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          value.str.size := 10;
          value.str.value := 'ACTIVATING';
        ELSE
          value.str.size := 10;
          value.str.value := 'TERMINATED';
        IFEND;
      = dfc$recovering =
        value.str.size := 10;
        value.str.value := 'RECOVERING';
      = dfc$awaiting_recovery =
        IF queue_exists AND p_cpu_queue^.queue_header.partner_status.verify_queue THEN
          value.str.size := 10;
          value.str.value := 'ACTIVATING';
        ELSE
          value.str.size := 17;
          value.str.value := 'AWAITING_RECOVERY';
        IFEND;
      ELSE
        value.str.size := 7;
        value.str.value := 'UNKNOWN';
      CASEND;
    IFEND;

  PROCEND get_partner_state;
?? OLDTITLE ??
?? NEWTITLE := 'get_same_df_mainframe_count', EJECT ??

{ PURPOSE:
{   This procedure scans the queue_interface_table entries counting mainframes configured with the same
{   element_name and the same source mainframe as the two input parameters.

  PROCEDURE get_same_df_mainframe_count
    (    element_name: cmt$element_name;
         server_to_client: boolean;
     VAR same_destination_mainframes: 0 .. dfc$max_number_of_mainframes - 1);

    VAR
      driver_queue_p: ^dft$driver_queue,
      index: dft$queue_index,
      q_interface_directory_entry_p: ^dft$q_interface_directory_entry,
      qit_p: ^dft$queue_interface_table,
      queue_directory_index: dft$queue_directory_index;

    same_destination_mainframes := 0;

    IF dfv$p_queue_interface_directory = NIL THEN
      RETURN;
    IFEND;

    FOR queue_directory_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
      IF dfv$p_queue_interface_directory^ [queue_directory_index].driver_name = element_name THEN
        qit_p := dfv$p_queue_interface_directory^ [queue_directory_index].p_queue_interface_table;
        IF qit_p <> NIL THEN
          FOR index := 1 TO qit_p^.queue_directory.number_of_queues DO
            IF qit_p^.queue_directory.cpu_queue_pva_directory [index].p_cpu_queue <> NIL THEN
              driver_queue_p := qit_p^.queue_directory.driver_queue_pva_directory [index].p_driver_queue;
              IF server_to_client =
                    driver_queue_p^.queue_header.connection_descriptor.source.flags.server_to_client THEN
                same_destination_mainframes := same_destination_mainframes + 1;
              IFEND;
            IFEND;
          FOREND;
        IFEND;
      IFEND;
    FOREND;

  PROCEND get_same_df_mainframe_count;
?? OLDTITLE ??
?? NEWTITLE := 'initialize_monitor_cpu_q_entry ', EJECT ??

  PROCEDURE initialize_monitor_cpu_q_entry
    (    server_to_client: boolean;
         p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
         queue_entry_index: dft$queue_entry_index;
     VAR cpu_queue_entry: dft$cpu_queue_entry);

    CONST
      null_ajl_ordinal = jmc$max_ajl_ord;

    VAR
      directory_index: dft$queue_directory_index;

    IF server_to_client THEN
      { Set up the io id so that monitor only need full in io function.
      cpu_queue_entry.io_id.specified := TRUE;
      cpu_queue_entry.io_id.io_function := ioc$read_for_server;
      dfp$get_queue_directory_index (p_queue_interface_table, directory_index);
      cpu_queue_entry.io_id.queue_entry_location.directory_index := directory_index;
      cpu_queue_entry.io_id.queue_entry_location.queue_index := queue_index;
      cpu_queue_entry.io_id.queue_entry_location.queue_entry_index := queue_entry_index;
      { Initialize all fields to null values.
      cpu_queue_entry.ajlo := null_ajl_ordinal;
      cpu_queue_entry.io_type := ioc$read_for_server;
      cpu_queue_entry.sfid := gfv$null_sfid;
      ALLOCATE cpu_queue_entry.p_server_iocb IN dfv$server_wired_heap^;
      IF cpu_queue_entry.p_server_iocb = NIL THEN
        osp$system_error (' p_server_iocb = NIL', NIL);
      IFEND;
      pmp$zero_out_table (cpu_queue_entry.p_server_iocb, #SIZE (cpu_queue_entry.p_server_iocb^));
      cpu_queue_entry.p_server_iocb^.server_state := mmc$ss_waiting;
      cpu_queue_entry.p_server_iocb^.sfid := gfv$null_sfid;
      cpu_queue_entry.p_server_iocb^.offset := 0;
      cpu_queue_entry.p_server_iocb^.length := 0;
      cpu_queue_entry.p_server_iocb^.eoi := 0;
      cpu_queue_entry.p_server_iocb^.sub_reqcode := mmc$iorc_await_io_completion;
      cpu_queue_entry.p_server_iocb^.condition := dfc$null_server_condition;
      cpu_queue_entry.p_server_iocb^.io_already_active := FALSE;
      cpu_queue_entry.p_server_iocb^.active_io_count := 0;
      cpu_queue_entry.p_server_iocb^.reissue_request := FALSE;
    ELSE { Client mainframe
      cpu_queue_entry.io_id.specified := FALSE;
      cpu_queue_entry.io_id.io_function := ioc$no_io;
      cpu_queue_entry.ajlo := null_ajl_ordinal;
      cpu_queue_entry.io_type := ioc$keypoint_io;
      cpu_queue_entry.sfid := gfv$null_sfid;
      cpu_queue_entry.p_server_iocb := NIL;
    IFEND;

  PROCEND initialize_monitor_cpu_q_entry;
?? OLDTITLE ??
?? NEWTITLE := 'initialize_queue_entries ', EJECT ??

  PROCEDURE initialize_queue_entries
    (    server_to_client: boolean;
         p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
         number_of_monitor_queue_entries: 0 .. dfc$max_queue_entries;
         number_of_task_queue_entries: dft$queue_entry_index;
         p_allocated_data_rma_list: dft$p_allocated_data_rma_list;
     VAR driver_queue_entries: dft$driver_queue_entries;
     VAR cpu_queue_entries: dft$cpu_queue_entries);

    VAR
      number_of_rma_list_entries: 1 .. dfc$max_rma_list_entries,
      p_allocated_command_buffer: dft$p_allocated_command_buffer,
      p_allocated_rpc_data_area: ^dft$allocated_rpc_data_area,
      p_allocated_monitor_buffer: dft$p_allocated_monitor_buffer,
      pva: ^cell,
      queue_entry_index: dft$queue_entry_index,
      rma: integer;

    pmp$zero_out_table (^driver_queue_entries, #SIZE (driver_queue_entries));

    pmp$zero_out_table (^cpu_queue_entries, #SIZE (cpu_queue_entries));

    number_of_rma_list_entries := p_queue_interface_table^.maximum_data_bytes DIV osv$page_size;

  /initialize_each_entry/
    FOR queue_entry_index := 1 TO UPPERBOUND (driver_queue_entries) DO
      IF queue_entry_index = dfc$poll_queue_index THEN
        cpu_queue_entries [queue_entry_index].processor_type := dfc$task_services;
        driver_queue_entries [queue_entry_index].flags.active_entry := TRUE;
      ELSEIF queue_entry_index <= number_of_monitor_queue_entries + 1 THEN
        cpu_queue_entries [queue_entry_index].processor_type := dfc$monitor;
      ELSE
        cpu_queue_entries [queue_entry_index].processor_type := dfc$task_services;
      IFEND;
      cpu_queue_entries [queue_entry_index].transaction_count := 0;
      cpu_queue_entries [queue_entry_index].transaction_state := dfc$queue_entry_available;
      cpu_queue_entries [queue_entry_index].request_timeout_count := 0;
      cpu_queue_entries [queue_entry_index].retransmission_count := 0;

      { Initialize send buffer
      IF (cpu_queue_entries [queue_entry_index].processor_type = dfc$monitor) THEN
        IF server_to_client THEN
          ALLOCATE p_allocated_monitor_buffer: [[REP 1 OF dft$buffer_header, REP 1 OF syt$monitor_status,
                REP 1 OF dft$page_io_response]] IN dfv$server_wired_heap^;
        ELSE {Client side.
          ALLOCATE p_allocated_monitor_buffer: [[REP 1 OF dft$buffer_header, REP 1 OF syt$monitor_status,
                REP 1 OF dft$page_io_request]] IN dfv$server_wired_heap^;
        IFEND;
        IF (p_allocated_monitor_buffer = NIL) THEN
          osp$system_error (' NIL p_allocated_monitor_buffer', NIL);
        ELSE
          cpu_queue_entries [queue_entry_index].p_send_buffer := ^p_allocated_monitor_buffer^.buffer;
        IFEND;
      ELSE {Task Services task.
        ALLOCATE p_allocated_command_buffer: [[REP dfc$command_buffer_size OF cell]] IN
              dfv$server_wired_heap^;
        IF (p_allocated_command_buffer = NIL) THEN
          osp$system_error (' NIL p_allocated_command_buffer', NIL);
        ELSE
          cpu_queue_entries [queue_entry_index].p_send_buffer := ^p_allocated_command_buffer^.buffer;
        IFEND;
      IFEND;
      RESET cpu_queue_entries [queue_entry_index].p_send_buffer;

      { Touch the page to assure it is created in real memory.
      IF (cpu_queue_entries [queue_entry_index].processor_type = dfc$monitor) THEN
        pmp$zero_out_table (p_allocated_monitor_buffer, #SIZE (p_allocated_monitor_buffer^));
      ELSE {Task Services task.
        pmp$zero_out_table (p_allocated_command_buffer, #SIZE (p_allocated_command_buffer^));
      IFEND;

      i#real_memory_address (cpu_queue_entries [queue_entry_index].p_send_buffer, rma);
      driver_queue_entries [queue_entry_index].send_buffer_descriptor.address := rma;
      driver_queue_entries [queue_entry_index].send_buffer_descriptor.indirect_address := FALSE;
      driver_queue_entries [queue_entry_index].send_buffer_descriptor.actual_length := 0;

      { Initialize receive buffer
      { Note actual length initialized differently than send buffer.
      IF (cpu_queue_entries [queue_entry_index].processor_type = dfc$monitor) THEN
        IF server_to_client THEN
          ALLOCATE p_allocated_monitor_buffer: [[REP 1 OF dft$buffer_header, REP 1 OF syt$monitor_status,
                REP 1 OF dft$page_io_request]] IN dfv$server_wired_heap^;
        ELSE {Client side.
          ALLOCATE p_allocated_monitor_buffer: [[REP 1 OF dft$buffer_header, REP 1 OF syt$monitor_status,
                REP 1 OF dft$page_io_response]] IN dfv$server_wired_heap^;
        IFEND;
        IF (p_allocated_monitor_buffer = NIL) THEN
          osp$system_error (' NIL p_allocated_monitor_buffer', NIL);
        ELSE
          cpu_queue_entries [queue_entry_index].p_receive_buffer := ^p_allocated_monitor_buffer^.buffer;
        IFEND;
      ELSE {Task Services task.
        ALLOCATE p_allocated_command_buffer: [[REP dfc$command_buffer_size OF cell]] IN
              dfv$server_wired_heap^;
        IF (p_allocated_command_buffer = NIL) THEN
          osp$system_error (' NIL p_allocated_command_buffer', NIL);
        ELSE
          cpu_queue_entries [queue_entry_index].p_receive_buffer := ^p_allocated_command_buffer^.buffer;
        IFEND;
      IFEND;

      { Touch the page to assure it is created in real memory.
      IF (cpu_queue_entries [queue_entry_index].processor_type = dfc$monitor) THEN
        pmp$zero_out_table (p_allocated_monitor_buffer, #SIZE (p_allocated_monitor_buffer^));
      ELSE {Task Services task.
        pmp$zero_out_table (p_allocated_command_buffer, #SIZE (p_allocated_command_buffer^));
      IFEND;

      i#real_memory_address (cpu_queue_entries [queue_entry_index].p_receive_buffer, rma);
      driver_queue_entries [queue_entry_index].receive_buffer_descriptor.address := rma;
      driver_queue_entries [queue_entry_index].receive_buffer_descriptor.indirect_address := FALSE;
      IF (cpu_queue_entries [queue_entry_index].processor_type = dfc$monitor) THEN
        driver_queue_entries [queue_entry_index].receive_buffer_descriptor.actual_length :=
              dfp$word_boundary (#SIZE (p_allocated_monitor_buffer^));
      ELSE {Task Services task.
        driver_queue_entries [queue_entry_index].receive_buffer_descriptor.actual_length :=
              #SIZE (p_allocated_command_buffer^);
      IFEND;

{     Initialize pointer to queue entry's data RMA list.
      IF queue_entry_index = dfc$poll_queue_index THEN
        cpu_queue_entries [queue_entry_index].p_data_rma_list := NIL;
        driver_queue_entries [queue_entry_index].data_descriptor.indirect_address := FALSE;
        driver_queue_entries [queue_entry_index].data_descriptor.actual_length := 0;
        driver_queue_entries [queue_entry_index].data_descriptor.address := 0;
      ELSE
{       This code requires that dfc$poll_queue_index be equal to 1.
        pva := ^p_allocated_data_rma_list^.rma_list[((queue_entry_index -2) * number_of_rma_list_entries) +1];
        build_qe_p_data_rma_list (pva, number_of_rma_list_entries,
             cpu_queue_entries [queue_entry_index].p_data_rma_list);

        i#real_memory_address (cpu_queue_entries [queue_entry_index].p_data_rma_list, rma);
        driver_queue_entries [queue_entry_index].data_descriptor.address := rma;
        driver_queue_entries [queue_entry_index].data_descriptor.indirect_address := TRUE;
        { Actual length of zero is used to indicate not ready for data
        driver_queue_entries [queue_entry_index].data_descriptor.actual_length := 0;
      IFEND;


      IF cpu_queue_entries [queue_entry_index].processor_type = dfc$monitor THEN
        initialize_monitor_cpu_q_entry (server_to_client, p_queue_interface_table, queue_index,
              queue_entry_index, cpu_queue_entries [queue_entry_index]);
      ELSEIF queue_entry_index <> dfc$poll_queue_index THEN
        cpu_queue_entries [queue_entry_index].server_to_client := server_to_client;
        IF server_to_client THEN
          cpu_queue_entries [queue_entry_index].p_last_wired_data := NIL;
          cpu_queue_entries [queue_entry_index].last_wired_length := 0;
        IFEND;
        ALLOCATE p_allocated_rpc_data_area IN dfv$server_wired_heap^;
        IF p_allocated_rpc_data_area = NIL THEN
          osp$system_error ('NIL p_send_data ', NIL);
        IFEND;
        cpu_queue_entries [queue_entry_index].p_send_data := ^p_allocated_rpc_data_area^.data;
        ALLOCATE p_allocated_rpc_data_area IN dfv$server_wired_heap^;
        IF p_allocated_rpc_data_area = NIL THEN
          osp$system_error ('NIL p_receive_data ', NIL);
        IFEND;
        cpu_queue_entries [queue_entry_index].p_receive_data := ^p_allocated_rpc_data_area^.data;

      IFEND;

    FOREND /initialize_each_entry/;

  PROCEND initialize_queue_entries;
?? OLDTITLE ??
?? NEWTITLE := 'record_queue_interface ', EJECT ??

{ PURPOSE:
{   The purpose of this routine is to store the queue interface table pointer into the queue interface
{   directory.

  PROCEDURE record_queue_interface
    (    driver_name: ost$name;
         queue_interface_table_p: dft$p_queue_interface_table;
         connection_parameters: dft$connection_parameters);

    VAR
      ignore_status: ost$status,
      index: dft$queue_directory_index,
      old_directory_p: dft$p_queue_interface_directory;

    IF dfv$p_queue_interface_directory = NIL THEN
      ALLOCATE dfv$p_queue_interface_directory: [1 .. 1] IN dfv$server_wired_heap^;
      IF dfv$p_queue_interface_directory = NIL THEN
        osp$system_error (' NIL dfv$p_queue_interface_directory', NIL);
      IFEND;
    ELSE
      old_directory_p := dfv$p_queue_interface_directory;
      ALLOCATE dfv$p_queue_interface_directory: [1 .. (UPPERBOUND (old_directory_p^) + 1)] IN
            dfv$server_wired_heap^;
      IF dfv$p_queue_interface_directory = NIL THEN
        osp$system_error (' NIL dfv$p_queue_interface_directory', NIL);
      IFEND;

      FOR index := 1 TO UPPERBOUND (old_directory_p^) DO
        dfv$p_queue_interface_directory^ [index] := old_directory_p^ [index];
      FOREND;

      FREE old_directory_p IN dfv$server_wired_heap^;
    IFEND;

    index := UPPERBOUND (dfv$p_queue_interface_directory^);
    dfv$p_queue_interface_directory^ [index].driver_name := driver_name;
    dfv$p_queue_interface_directory^ [index].p_queue_interface_table := queue_interface_table_p;
    dfv$p_queue_interface_directory^ [index].driver_active := FALSE;
    dfv$p_queue_interface_directory^ [index].connection_type := connection_parameters.connection_type;
    IF connection_parameters.connection_type = dfc$esm_connection THEN
      osp$initialize_signature_lock (dfv$p_queue_interface_directory^ [index].load_unload_pp_lock,
            ignore_status);
      dfv$p_queue_interface_directory^ [index].element_name :=
            connection_parameters.esm_parameters.element_name;
      dfv$p_queue_interface_directory^ [index].send_channel :=
            connection_parameters.esm_parameters.send_channel;
      dfv$p_queue_interface_directory^ [index].receive_channel :=
            connection_parameters.esm_parameters.receive_channel;
      dfv$p_queue_interface_directory^ [index].use_dma := connection_parameters.esm_parameters.dma_available;
      dfv$p_queue_interface_directory^ [index].send_pp.pp_status.activated := FALSE;
      dfv$p_queue_interface_directory^ [index].send_pp.pp_status.loaded := FALSE;
      dfv$p_queue_interface_directory^ [index].send_pp.pp_status.idled := TRUE;
      dfv$p_queue_interface_directory^ [index].send_pp.p_element_reservations := NIL;
      dfv$p_queue_interface_directory^ [index].receive_pp.pp_status.activated := FALSE;
      dfv$p_queue_interface_directory^ [index].receive_pp.pp_status.loaded := FALSE;
      dfv$p_queue_interface_directory^ [index].receive_pp.pp_status.idled := TRUE;
      dfv$p_queue_interface_directory^ [index].receive_pp.p_element_reservations := NIL;
    IFEND;

  PROCEND record_queue_interface;
?? OLDTITLE ??
MODEND dfm$queue_initialization;
