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

{ PURPOSE:
{   This module manages connecting from the client to the server.  This involves executing a command on the
{   client that specifies the connection information.  This module also manages the served family table, which
{   is created as a result of the above command.  Interfaces are provided to obtain information about the
{   served families.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfs$server_wired
*copyc dfc$iou_names
*copyc dfc$poll_constants
*copyc dfc$server_mainframes_catalog
*copyc dfd$driver_queue_types
*copyc dfe$error_condition_codes
*copyc ose$system_task_exceptions
*copyc pme$program_services_exceptions
*copyc dfk$keypoints
*copyc clt$parameter_list_contents
*copyc dft$cpu_queue
*copyc dft$display_identifier
*copyc dft$family_list
*copyc dft$partner_mainframe_list
*copyc dft$poll_family_list
*copyc dft$queue_interface_directory
*copyc dft$read_write_lock
*copyc dft$served_family_table
*copyc dft$served_family_table_index
*copyc dpt$window_id
*copyc mmt$io_identifier
*copyc pmt$family_name_count
*copyc pmt$family_name_list
*copyc pmt$program_description
?? POP ??
*copyc clp$evaluate_parameters
*copyc clp$scan_argument_list
*copyc dfp$check_if_valid
*copyc dfp$clear_read_lock
*copyc dfp$clear_write_lock
*copyc dfp$crack_connection_parameters
*copyc dfp$create_image_file
*copyc dfp$create_queue
*copyc dfp$display
*copyc dfp$find_mainframe_id
*copyc dfp$flush_served_family_table
*copyc dfp$format_task_name
*copyc dfp$locate_esm_definition
*copyc dfp$new_crack_mainframe_id
*copyc dfp$record_server_translation
*copyc dfp$set_read_lock
*copyc dfp$set_write_lock
*copyc dfp$start_cdcnet_client
*copyc dfp$verify_stornet_channel
*copyc dfp$verify_system_administrator
*copyc jmp$activate_deferred_family
*copyc jmp$defer_deactivated_family
*copyc osp$activate_system_task
*copyc osp$append_status_integer
*copyc osp$deactivate_system_task
*copyc osp$decrement_locked_variable
*copyc osp$define_system_task
*copyc osp$get_set_name
*copyc osp$increment_locked_variable
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$verify_system_privilege
*copyc pfp$define_catalog
*copyc pmp$convert_binary_mainframe_id
*copyc dfi$display
*copyc dfi$log_display
?? EJECT ??
*copyc dfv$family_access_enabled
*copyc dfv$file_server_debug_enabled
*copyc dfv$number_served_family_lists
*copyc dfv$p_queue_interface_directory
*copyc dfv$served_family_table_lock
*copyc dfv$served_family_table_root
*copyc dfv$server_state_string
*copyc dfv$server_wired_heap
*copyc osv$system_family_name
*copyc osv$page_size
*copyc osv$upper_to_lower
?? TITLE := 'Global Variables Declared by This Module', EJECT ??

  CONST
    c$asynchronous_start_procedure = 'DFP$MANAGE_SERVER_CONNECTION';

?? TITLE := '[XDCL] dfp$change_family_server_state ', EJECT ??
  PROCEDURE [XDCL] dfp$change_family_server_state
    (    new_state: dft$server_state;
         mainframe_id: pmt$binary_mainframe_id);

    VAR
      family_list_index: dft$served_family_list_index,
      family_name_list: array [1 .. 1] OF ost$name,
      leveled_families_affected: boolean,
      log_string: string (80),
      log_string_length: integer,
      p_family_list: ^array [dft$served_family_list_index] of dft$served_family_table_entry,
      pointers_index: dft$family_pointer_index,
      previous_state: dft$server_state,
      server_mainframe_id: pmt$mainframe_id,
      status: ost$status;

{-------------------------------------------------------------------------
{   This procedure changes Server_State in the Served_Family_Table to one
{   requested by the input parameter. It selects the Family entries by
{   matching the the mainframe_id supplied by the input parameter with
{   one in the Served_Family_Table but rejects those entries whose
{   Server_State is DELETED. The DELETED state in the Served_Family_Table
{   may only be changed by Define_Server and Define_Served_Families
{   subcommands.
{-------------------------------------------------------------------------

    leveled_families_affected := FALSE;
    pmp$convert_binary_mainframe_id (mainframe_id, server_mainframe_id, status);
    STRINGREP (log_string, log_string_length, ' Server ', server_mainframe_id,
       ' ', dfv$server_state_string [new_state]);
    log_display ($pmt$ascii_logset [pmc$system_log], log_string (1, log_string_length));
    IF dfv$file_server_debug_enabled THEN
      display (log_string (1, log_string_length));
    IFEND;
    dfp$set_read_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN

    /for_all_pointers/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO
        p_family_list := dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list;

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO

          IF (p_family_list^ [family_list_index].server_mainframe_id = mainframe_id) AND
                (p_family_list^ [family_list_index].server_state <> dfc$deleted) THEN
            leveled_families_affected := leveled_families_affected OR (dfc$job_leveling_access IN
                  p_family_list^ [family_list_index].family_access);
            previous_state := p_family_list^ [family_list_index].server_state;
            p_family_list^ [family_list_index].server_state := new_state;
            CASE new_state OF
            = dfc$deleted =
              p_family_list^ [family_list_index].verified_by_server := FALSE;
              p_family_list^ [family_list_index].p_queue_interface_table := NIL;
            = dfc$active =
              p_family_list^ [family_list_index].active_since_deadstart := TRUE;
              IF (previous_state <> dfc$active) AND ((dfc$remote_login_access IN
                     p_family_list^ [family_list_index].family_access) OR
                     (dfc$job_leveling_access IN p_family_list^[family_list_index].
                     family_access)) THEN
                family_name_list [1] := p_family_list^ [family_list_index].family_name;
                jmp$activate_deferred_family (^family_name_list);
              IFEND;
            = dfc$inactive, dfc$awaiting_recovery =
              IF (previous_state <> new_state) THEN
                { Even if the current family_access does not allow login or leveling
                { there might be a job left over.
                family_name_list [1] := p_family_list^ [family_list_index].family_name;
                jmp$defer_deactivated_family (^family_name_list);
              IFEND;
            ELSE
            CASEND;
          IFEND;

        FOREND /search_family_list/;
      FOREND /for_all_pointers/;

    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

    IF leveled_families_affected THEN
      dfp$change_job_leveler_state;
    IFEND;

    dfp$flush_served_family_table (status);
  PROCEND dfp$change_family_server_state;

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

  PROCEDURE [XDCL] dfp$change_family_verification
    (    family_name: ost$name;
         mainframe_id: pmt$binary_mainframe_id;
         family_access: dft$family_access;
         verified_by_server: boolean;
         server_lifetime: dft$server_lifetime;
         server_birthdate: integer;
         current_server_state: dft$server_state;
     VAR verification_changed: boolean;
     VAR status: ost$status);

    VAR
      family_found: boolean,
      family_index: dft$served_family_table_index,
      family_name_list: array [1 .. 1] OF ost$name,
      ignore_verify: boolean,
      list_index: dft$served_family_list_index,
      log_string: string (80),
      log_string_length: integer,
      p_queue_interface_table: dft$p_queue_interface_table,
      pointers_index: dft$family_pointer_index,
      previous_server_state: dft$server_state,
      queue_index: dft$queue_index,
      server_mainframe_id: pmt$binary_mainframe_id;

    STRINGREP (log_string, log_string_length, ' Server ', family_name (1, 20),
        dfv$server_state_string [current_server_state],
       ' Life/birth', server_lifetime, server_birthdate);
    log_display ($pmt$ascii_logset [pmc$system_log], log_string (1, log_string_length));
    IF dfv$file_server_debug_enabled THEN
      display (log_string (1, log_string_length));
    IFEND;
    dfp$set_read_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN
      locate_served_family (family_name, family_found, family_index, server_mainframe_id,
            p_queue_interface_table, queue_index, previous_server_state, ignore_verify);
      IF family_found AND (mainframe_id = server_mainframe_id) THEN
        pointers_index := family_index.pointers_index;
        list_index := family_index.family_list_index;
        verification_changed := (dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list^ [list_index].verified_by_server <> verified_by_server);
        dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list^ [list_index].family_access := family_access;
        dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list^ [list_index].verified_by_server := verified_by_server;
        dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list^ [list_index].server_lifetime := server_lifetime;
        dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list^ [list_index].server_birthdate := server_birthdate;
        IF (previous_server_state = dfc$deleted) AND verified_by_server THEN
          dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                p_served_family_list^ [list_index].server_state := current_server_state;
          IF current_server_state = dfc$active THEN
            dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                  p_served_family_list^ [list_index].active_since_deadstart := TRUE;
            IF (dfc$remote_login_access IN family_access) OR
                     (dfc$job_leveling_access IN family_access) THEN
             family_name_list [1] := family_name;
              jmp$activate_deferred_family (^family_name_list);
            IFEND;
          IFEND;
        IFEND;
        status.normal := TRUE;

      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$family_not_found, family_name, status);
      IFEND;
    ELSE
      osp$set_status_abnormal (dfc$file_server_id, dfe$family_not_found, family_name, status);
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);
    IF status.normal THEN
      dfp$flush_served_family_table (status);
    IFEND;
  PROCEND dfp$change_family_verification;
?? TITLE := '[XDCL] dfp$change_job_leveler_state', EJECT ??

{ PURPOSE:
{   This procedure activates the job leveler task if there are any leveled
{   families and deactivates it when there are no leveled families.

  PROCEDURE [XDCL] dfp$change_job_leveler_state;

    VAR
      family_list_index: dft$served_family_list_index,
      job_leveler_file_list_p: ^llt$object_file_list,
      leveled_family_found: boolean,
      pointers_index: dft$family_pointer_index,
      program_attributes_p: ^llt$program_attributes,
      program_description_p: ^llt$program_description,
      family_list_p: ^array [dft$served_family_list_index] of dft$served_family_table_entry,
      spy_id: pmt$spy_identifier,
      status: ost$status,
      task_name: ost$name,
      task_params: string (1);

    dfp$set_read_lock (dfv$served_family_table_lock);
    leveled_family_found := FALSE;

    IF dfv$served_family_table_root.valid THEN

    /for_all_lists/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO
        family_list_p := dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list;

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO

          IF (family_list_p^ [family_list_index].server_state = dfc$active) AND
                family_list_p^ [family_list_index].verified_by_server AND
                (dfc$job_leveling_access IN family_list_p^ [family_list_index].family_access) THEN
            leveled_family_found := TRUE;
            EXIT /for_all_lists/;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

    task_name := 'JOB_LEVELER';
    IF leveled_family_found THEN
      osp$activate_system_task (task_name, status);
      IF NOT status.normal AND (status.condition = ose$system_task_not_defined) THEN
        spy_id := 0;
        PUSH program_description_p: [[REP (#size(llt$program_attributes) + #size(clt$path_name))
                OF CELL]];
        RESET program_description_p;
        NEXT program_attributes_p IN program_description_p;
        program_attributes_p^.contents := $pmt$prog_description_contents
              [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified,
               pmc$object_file_list_specified];
        program_attributes_p^.starting_procedure := 'JMP$JOB_LEVELER_TASK';
        program_attributes_p^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
        program_attributes_p^.termination_error_level := pmc$warning_load_errors;
        program_attributes_p^.number_of_object_files := 1;
        NEXT job_leveler_file_list_p: [1 .. 1] IN program_description_p;
        job_leveler_file_list_p^ [1] := ':$SYSTEM.$SYSTEM.FILE_SERVER.OSF$JOB_LEVELER_TASK';
        task_params := ' ';
        osp$define_system_task (task_name, {auto_restart=} TRUE,
              {deactivate_option=} osc$tt_terminate, {idle_option=} osc$tt_ignore_or_prohibited,
              {restart_after_idle=} TRUE, spy_id, {execution_ring=} osc$sj_ring_3, program_description_p,
              #SEQ (task_params), status);
        osp$activate_system_task (task_name, status);
      IFEND;
    ELSE
      osp$deactivate_system_task (task_name, status);
    IFEND;

  PROCEND dfp$change_job_leveler_state;
?? TITLE := '[XDCL] dfp$clear_family_queues ', EJECT ??
{
{   This procedure clears the p_queue_interface_table and queue_index in
{   the served family table. It selects the family entries by
{   matching the the mainframe_id supplied by the input parameter.
{   This is called when DELETE_SERVER is done on a family in the awaiting
{   recovery state. These fields are cleared since they are no longer
{   valid, and clearing them allows the remote procedure call mechanism
{   to proceed and avoid using them.
{
  PROCEDURE [XDCL] dfp$clear_family_queues
    (    mainframe_id: pmt$binary_mainframe_id);

    VAR
      family_list_index: dft$served_family_list_index,
      family_name_list: array [1 .. 1] of ost$name,
      log_string: string (80),
      log_string_length: integer,
      p_family_list: ^array [dft$served_family_list_index] of dft$served_family_table_entry,
      pointers_index: dft$family_pointer_index,
      server_mainframe_id: pmt$mainframe_id,
      status: ost$status;


    pmp$convert_binary_mainframe_id (mainframe_id, server_mainframe_id, status);
    STRINGREP (log_string, log_string_length, ' Server ', server_mainframe_id, ' deleting queues ');
    log_display ($pmt$ascii_logset [pmc$system_log], log_string (1, log_string_length));
    IF dfv$file_server_debug_enabled THEN
      display (log_string (1, log_string_length));
    IFEND;
    dfp$set_read_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN

    /for_all_pointers/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO
        p_family_list := dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list;

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO

          IF (p_family_list^ [family_list_index].server_mainframe_id = mainframe_id) AND
                (p_family_list^ [family_list_index].server_state = dfc$awaiting_recovery) THEN
            p_family_list^ [family_list_index].p_queue_interface_table := NIL;
            p_family_list^ [family_list_index].queue_index := UPPERVALUE (dft$queue_index);
          IFEND;

        FOREND /search_family_list/;
      FOREND /for_all_pointers/;

    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

    dfp$flush_served_family_table (status);
  PROCEND dfp$clear_family_queues;

?? TITLE := '[XDCL, #GATE] dfp$define_served_families_cmnd ', EJECT ??

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

    VAR
      family_access: dft$family_access,
      family_list_container: dft$family_list_container,
      ignore_p_directory_entry: ^dft$q_interface_directory_entry,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_family_list: dft$p_family_list,
      p_queue_interface_table: ^dft$queue_interface_table,
      queue_index: dft$queue_index,
      server_mainframe_id: pmt$binary_mainframe_id,
      server_mainframe_name: pmt$mainframe_id,
      server_to_client: boolean;

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

    crack_define_family_command (parameter_list, family_list_container, p_family_list, server_mainframe_name,
          server_mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_to_client := FALSE;
    dfp$find_mainframe_id (server_mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
          p_cpu_queue, queue_index, ignore_p_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_server, server_mainframe_name, status);
      RETURN;
    IFEND;
    IF p_cpu_queue^.queue_header.number_of_monitor_queue_entries = 0 THEN
      osp$set_status_condition (dfe$no_families_when_zero_nomqe, status);
      RETURN;
    IFEND;

    verify_families_not_registered (p_family_list^, server_mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF ((p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) OR
        (p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery) OR
        (p_cpu_queue^.queue_header.partner_status.server_state = dfc$inactive)) AND
         p_cpu_queue^.queue_header.partner_status.verify_queue THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$server_is_activating, '', status);
      RETURN;
    IFEND;

    family_access := $dft$family_access [dfc$remote_file_access];
    dfp$register_served_families (p_family_list^, family_access, {client_definition=} TRUE,
          p_queue_interface_table, queue_index, status);

  PROCEND dfp$define_served_families_cmnd;

?? TITLE := '[XDCL, #GATE] dfp$define_server_command ', EJECT ??

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

    VAR
      connection_parameters: dft$connection_parameters,
      family_access: dft$family_access,
      family_list_container: dft$family_list_container,
      family_list_p: dft$p_family_list,
      queue_interface_table_p: dft$p_queue_interface_table,
      served_family_birthdate: integer,
      served_family_found: boolean,
      served_family_lifetime: dft$server_lifetime,
      served_family_state: dft$server_state,
      server_mainframe_name: pmt$mainframe_id,
      server_mainframe_id: pmt$binary_mainframe_id,
      task_name: ost$name;

    status.normal := TRUE;
    dfp$verify_system_administrator ('DEFINE_SERVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_define_server (parameter_list, family_list_container, family_list_p, server_mainframe_name,
          server_mainframe_id, connection_parameters, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    IF family_list_p <> NIL THEN
      IF connection_parameters.number_of_monitor_queue_entries = 0 THEN
        osp$set_status_condition (dfe$no_families_when_zero_nomqe, status);
        RETURN;
      IFEND;
      verify_families_not_registered (family_list_p^, server_mainframe_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    process_new_mainframe (connection_parameters, server_mainframe_name, server_mainframe_id,
          queue_interface_table_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$get_highest_sf_lifetime (server_mainframe_id, served_family_found, served_family_state,
         served_family_lifetime, served_family_birthdate);
    IF served_family_found THEN
      IF served_family_state = dfc$awaiting_recovery THEN

        { Recover the lifetime and the birthdate from the served family table.

        queue_interface_table_p^.queue_directory.cpu_queue_pva_directory
              [connection_parameters.client_queue_index].p_cpu_queue^.queue_header.partner_status.
              server_state := dfc$awaiting_recovery;
        queue_interface_table_p^.queue_directory.cpu_queue_pva_directory
              [connection_parameters.client_queue_index].p_cpu_queue^.queue_header.partner_status.
              server_pages_saved := TRUE;
        queue_interface_table_p^.queue_directory.cpu_queue_pva_directory
              [connection_parameters.client_queue_index].p_cpu_queue^.queue_header.server_lifetime :=
              served_family_lifetime;
        queue_interface_table_p^.queue_directory.cpu_queue_pva_directory
              [connection_parameters.client_queue_index].p_cpu_queue^.queue_header.server_birthdate :=
              served_family_birthdate;
      IFEND;

      { No matter what make sure the correct queue info is stored.

      set_served_family_queue_info (server_mainframe_id, queue_interface_table_p,
             connection_parameters.client_queue_index);
    IFEND;

    { Check if Task_Name is already in the System_Task_Table.  If not, define the task, else do nothing -
    { it's been defined.

    dfp$format_task_name (server_mainframe_name, task_name);
    define_asynchronous_task (server_mainframe_name, status);
    IF NOT status.normal AND (status.condition <> ose$system_task_already_defined) THEN
      RETURN;
    ELSE
      status.normal := TRUE;
    IFEND;

    IF family_list_p <> NIL THEN
      family_access := $dft$family_access [dfc$remote_file_access];
      dfp$register_served_families (family_list_p^, family_access, {client_definition=} TRUE,
            queue_interface_table_p, connection_parameters.client_queue_index, status);
    IFEND;

  PROCEND dfp$define_server_command;

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

{ This procedure only removes the family if there is no chance that it has been
{ referenced yet.

  PROCEDURE [XDCL] dfp$delete_family_if_last
    (    family_name: ost$family_name);

    VAR
      actual: integer,
      error: boolean,
      family_deleted: boolean,
      high_family_list_index: integer,
      high_pointer_index: integer,
      p_served_family_table_entry: ^dft$served_family_table_entry,
      status: ost$status;

    family_deleted := FALSE;
    dfp$set_write_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN
      high_pointer_index := dfv$served_family_table_root.number_of_active_pointers;
      IF high_pointer_index > 0 THEN
        high_family_list_index := dfv$served_family_table_root.
              p_family_list_pointer_array^ [high_pointer_index].highest_valid_entry;
        IF (high_family_list_index > 0) THEN
          p_served_family_table_entry := ^dfv$served_family_table_root.
                p_family_list_pointer_array^ [high_pointer_index].
                p_served_family_list^ [high_family_list_index];
          IF (p_served_family_table_entry^.family_name = family_name) AND
               (NOT p_served_family_table_entry^.verified_by_server) AND
               (p_served_family_table_entry^.server_state IN $dft$server_states
               [dfc$terminated, dfc$deleted]) AND
               (p_served_family_table_entry^.server_lifetime = 1) THEN
            dfv$served_family_table_root.p_family_list_pointer_array^ [high_pointer_index].
                  p_served_family_list^ [high_family_list_index].family_name := osc$null_name;
            osp$decrement_locked_variable (dfv$served_family_table_root.
                  p_family_list_pointer_array^ [high_pointer_index].highest_valid_entry,
                  dfv$served_family_table_root.p_family_list_pointer_array^ [high_pointer_index].
                  highest_valid_entry, actual, error);
            family_deleted := TRUE;
            IF error THEN
              osp$system_error (' ERROR IN DELETING LAST FAMILY', NIL);
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
    dfp$clear_write_lock (dfv$served_family_table_lock);
    IF family_deleted THEN
      dfp$flush_served_family_table (status);
    IFEND;
  PROCEND dfp$delete_family_if_last;
?? TITLE := '[XDCL] dfp$display_served_family_table ', EJECT ??

{ PURPOSE:
{   The purpose of this request is to display the server families at the
{   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_served_family_table
    (VAR display_identifier: dft$display_identifier;
     VAR message_written {input, output} : boolean;
     VAR status: ost$status);

    VAR
      access_location: 1 .. 80,
      display_string: string (80),
      family_list_index: dft$served_family_list_index,
      pointers_index: dft$family_pointer_index,
      served_family_table_entry: dft$served_family_table_entry,
      server_mainframe_id: pmt$mainframe_id;

    dfp$set_read_lock (dfv$served_family_table_lock);

    IF dfv$served_family_table_root.valid THEN
      dfp$display (' ---SERVER FAMILY----------------ACCESS-----SERVER MAINFRAME---SERVER STATE----',
           display_identifier, status);
      IF NOT status.normal THEN
        dfp$clear_read_lock (dfv$served_family_table_lock);
        RETURN;
      IFEND;
      message_written := TRUE;

    /for_all_lists/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO
          served_family_table_entry := dfv$served_family_table_root.
                p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index];
          display_string := ' ';
          display_string (2, * ) := served_family_table_entry.family_name;

          IF (served_family_table_entry.server_state = dfc$active) AND
                served_family_table_entry.verified_by_server THEN
            access_location := 34;
            IF dfc$remote_file_access IN served_family_table_entry.family_access THEN
              display_string (access_location, *) := 'FILE';
            IFEND;
            IF dfc$remote_login_access IN served_family_table_entry.family_access THEN
              display_string (access_location, *) := 'LOGIN';
            IFEND;
            IF dfc$job_leveling_access IN served_family_table_entry.family_access THEN
              display_string (access_location, *) := 'LEVELED';
            IFEND;
          ELSE
            display_string (34, * ) := 'NONE';
          IFEND;

          pmp$convert_binary_mainframe_id (served_family_table_entry.server_mainframe_id, server_mainframe_id,
                status);
          IF NOT status.normal THEN
            EXIT /for_all_lists/;
          IFEND;
          display_string (45, * ) := server_mainframe_id;
          display_string (64, * ) := dfv$server_state_string [served_family_table_entry.server_state];

          dfp$display (display_string, display_identifier, status);
          IF NOT status.normal THEN
            EXIT /for_all_lists/;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

  PROCEND dfp$display_served_family_table;

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

  PROCEDURE [XDCL] dfp$format_verify_family
    (    mainframe_id: pmt$binary_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);

{   ---------------------------------------------------------------------
{   This procedure prepares a list of families to be sent to the Server
{   mainframe for verification. It does so by selecting families from
{   the Served_Family_Table whose entries match the mainframe_id supplied
{   by the input parameter.
{   Family entries whose Server_State is DELETED are not considered for
{   the selection.
{   ---------------------------------------------------------------------

    VAR
      family_list_index: dft$served_family_list_index,
      p_family_container: ^SEQ (REP dfc$max_family_parameters of dft$family_verification),
      p_family_record: ^dft$family_verification,
      pointers_index: dft$family_pointer_index;

    p_family_container := ^family_container;
    RESET p_family_container;
    number_of_families := 0;
    p_family_list := NIL;

    dfp$set_read_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN

    /for_all_pointers/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO

          IF (dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                p_served_family_list^ [family_list_index].server_mainframe_id = mainframe_id) THEN

            IF (dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                 p_served_family_list^ [family_list_index].server_state <> dfc$deleted) THEN
              NEXT p_family_record IN p_family_container;
              p_family_record^.family := dfv$served_family_table_root.
                   p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index].
                   family_name;
              p_family_record^.family_access := dfv$served_family_table_root.
                   p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index].
                   family_access;
              p_family_record^.valid := FALSE;
              number_of_families := number_of_families + 1;
            IFEND;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_pointers/;

      IF number_of_families > 0 THEN
        RESET p_family_container;
        NEXT p_family_list: [1 .. number_of_families] IN p_family_container;
      IFEND;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

  PROCEND dfp$format_verify_family;
?? TITLE := '[XDCL] dfp$get_family_access', EJECT ??
*copy dfh$get_family_access

  PROCEDURE [XDCL] dfp$get_family_access
    (    family: ost$family_name;
     VAR family_known: boolean;
     VAR family_access: dft$family_access;
     VAR server_state: dft$server_state;
     VAR leveler_status: jmt$jl_job_leveler_status);

    VAR
      family_found: boolean,
      ignored_set_name: stt$set_name,
      local_status: ost$status,
      p_queue_interface_table: dft$p_queue_interface_table,
      queue_index: dft$queue_index,
      served_family_table_index: dft$served_family_table_index,
      server_mainframe_id: pmt$binary_mainframe_id,
      verified_by_server: boolean;

    osp$verify_system_privilege;
    dfp$set_read_lock (dfv$served_family_table_lock);

    locate_served_family (family, family_known, served_family_table_index,
          server_mainframe_id, p_queue_interface_table, queue_index,
          server_state, verified_by_server);

    IF (NOT family_known) OR (server_state = dfc$deleted) THEN
      dfp$clear_read_lock (dfv$served_family_table_lock);
      osp$get_set_name (family, ignored_set_name, local_status);
      family_known := local_status.normal;
      IF family_known {but only locally} THEN
        family_access := $dft$family_access [];
      IFEND;
      RETURN;
    IFEND;

    family_access := dfv$served_family_table_root.
          p_family_list_pointer_array^ [served_family_table_index.
          pointers_index].p_served_family_list^
          [served_family_table_index.family_list_index].family_access;
    server_state := dfv$served_family_table_root.
          p_family_list_pointer_array^ [served_family_table_index.
          pointers_index].p_served_family_list^
          [served_family_table_index.family_list_index].server_state;
    IF p_queue_interface_table = NIL THEN
      leveler_status.leveler_state := jmc$jl_leveler_disabled;
      leveler_status.cleanup_completed := FALSE;
    ELSE
      leveler_status := p_queue_interface_table^.queue_directory.
            cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header.
            leveler_status;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

  PROCEND dfp$get_family_access;

?? TITLE := '[XDCL] dfp$get_highest_sf_lifetime ', EJECT ??
  PROCEDURE [XDCL] dfp$get_highest_sf_lifetime
    (    server_mainframe_id: pmt$binary_mainframe_id;
     VAR server_found: boolean;
     VAR server_state: dft$server_state;
     VAR highest_server_lifetime: dft$server_lifetime;
     VAR server_birthdate: integer);

    VAR
      family_list_index: dft$served_family_list_index,
      pointers_index: dft$family_pointer_index;

{========================================================================
{   This procedure searches through all of the entries in the Served
{   Family Table for the given mainframe ID and returns the highest
{   value of the Server Lifetime found in the entries for that mainframe.
{   If the mainframe has no entries then Lifetime of zero is returned.
{========================================================================

    server_found := FALSE;
    highest_server_lifetime := 0;
    server_birthdate := 0;
    dfp$set_read_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN

    /for_all_lists/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO
          { Assume no deletion
          IF (dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                p_served_family_list^ [family_list_index].server_mainframe_id = server_mainframe_id) THEN
            server_found := TRUE;
            IF (dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                p_served_family_list^ [family_list_index].server_lifetime > highest_server_lifetime) THEN
              highest_server_lifetime := dfv$served_family_table_root.p_family_list_pointer_array^
                   [pointers_index].p_served_family_list^ [family_list_index].server_lifetime;
              server_state := dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                   p_served_family_list^ [family_list_index].server_state;
              server_birthdate :=  dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                   p_served_family_list^ [family_list_index].server_birthdate;
            IFEND;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);
  PROCEND dfp$get_highest_sf_lifetime;
?? TITLE := '[XDCL, #GATE] dfp$get_served_family_names ', EJECT ??
*copyc dfh$get_served_family_names

  PROCEDURE [XDCL, #GATE] dfp$get_served_family_names
    (VAR family_names: pmt$family_name_list;
     VAR family_count: pmt$family_name_count;
     VAR status: ost$status);

    VAR
      family_list_index: dft$served_family_list_index,
      pointers_index: dft$family_pointer_index,
      served_family_table_entry: dft$served_family_table_entry;

    status.normal := TRUE;
    family_count := 0;
    dfp$set_read_lock (dfv$served_family_table_lock);

    IF dfv$served_family_table_root.valid THEN

    /for_all_lists/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO
          served_family_table_entry := dfv$served_family_table_root.
                p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index];
          IF served_family_table_entry.server_state <> dfc$deleted THEN
            family_count := family_count + 1;
            IF family_count > UPPERBOUND (family_names) THEN
              { Despite an error, continue counting the families.
              osp$set_status_abnormal (dfc$file_server_id, pme$result_array_too_small, '', status);
            ELSE
              family_names [family_count] := served_family_table_entry.family_name;
            IFEND;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

  PROCEND dfp$get_served_family_names;
?? TITLE := ' [XDCL] dfp$get_server_mainframe_list', eject ??
{
{   This procedure return a list of server mainframes from the served family table.
{ If server count > Upperbound (p_server_mainframes^) then server_count may be
{ inaccurate. The requested_states parameter is used to specify that only
{ servers in the specified state be returned.
{
  PROCEDURE [XDCL] dfp$get_server_mainframe_list
    (    requested_states: dft$server_states;
     VAR server_mainframes: dft$partner_mainframe_list;
     VAR server_count: dft$partner_mainframe_count);


    FUNCTION min
      (    value_a: integer;
           value_b: integer): integer;

      IF value_a < value_b THEN
        min := value_a;
      ELSE
        min := value_b;
      IFEND;
    FUNCEND min;

    VAR
      family_list_index: dft$served_family_list_index,
      mainframe: dft$partner_mainframe_count,
      pointers_index: dft$family_pointer_index,
      served_family_table_entry: dft$served_family_table_entry;

    server_count := 0;
    dfp$set_read_lock (dfv$served_family_table_lock);

    IF dfv$served_family_table_root.valid THEN

    /for_all_lists/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO
          served_family_table_entry := dfv$served_family_table_root.
                p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index];

          IF served_family_table_entry.server_state IN requested_states THEN

          /search_for_duplicate_server/
            FOR mainframe := 1 TO min (server_count, UPPERBOUND (server_mainframes)) DO
              IF served_family_table_entry.server_mainframe_id = server_mainframes [mainframe].
                    mainframe_id THEN
                {Mainframe already recorded}
                CYCLE /search_family_list/
              IFEND;
            FOREND /search_for_duplicate_server/;
            server_count := server_count + 1;
            IF server_count <= UPPERBOUND (server_mainframes) THEN
              server_mainframes [server_count].mainframe_id := served_family_table_entry.server_mainframe_id;
              server_mainframes [server_count].partner_state := served_family_table_entry.server_state;
            IFEND;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);
  PROCEND dfp$get_server_mainframe_list;

?? TITLE := '[XDCL, #GATE] dfp$get_server_state_string ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$get_server_state_string
    (    server_state: dft$server_state;
     VAR server_state_string: string (*) );

    osp$verify_system_privilege;
    server_state_string := dfv$server_state_string[server_state];

  PROCEND dfp$get_server_state_string;
?? TITLE := '[XDCL, #GATE] dfp$locate_every_served_family ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$locate_every_served_family
    (    family: ost$family_name;
     VAR family_found: boolean;
     VAR served_family_table_index: dft$served_family_table_index;
     VAR server_mainframe_id: pmt$binary_mainframe_id;
     VAR p_queue_interface_table: dft$p_queue_interface_table;
     VAR queue_index: dft$queue_index;
     VAR server_state: dft$server_state);

    VAR
      verified_by_server: boolean;

    osp$verify_system_privilege;
    dfp$set_read_lock (dfv$served_family_table_lock);

    locate_served_family (family, family_found, served_family_table_index, server_mainframe_id,
          p_queue_interface_table, queue_index, server_state, verified_by_server);

    dfp$clear_read_lock (dfv$served_family_table_lock);

    IF family_found THEN
      family_found := dfv$family_access_enabled;
    IFEND;

  PROCEND dfp$locate_every_served_family;
?? TITLE := '[XDCL, #GATE] dfp$locate_served_family ', EJECT ??
*copyc dfh$locate_served_family

  PROCEDURE [XDCL, #GATE] dfp$locate_served_family
    (    family: ost$family_name;
     VAR family_found: boolean;
     VAR served_family_table_index: dft$served_family_table_index;
     VAR server_mainframe_id: pmt$binary_mainframe_id;
     VAR p_queue_interface_table: dft$p_queue_interface_table;
     VAR queue_index: dft$queue_index;
     VAR server_state: dft$server_state);

    VAR
      verified_by_server: boolean;

    #KEYPOINT (osk$entry, 0, dfk$locate_served_family);
    osp$verify_system_privilege;
    dfp$set_read_lock (dfv$served_family_table_lock);

    locate_served_family (family, family_found, served_family_table_index, server_mainframe_id,
          p_queue_interface_table, queue_index, server_state, verified_by_server);

    dfp$clear_read_lock (dfv$served_family_table_lock);
    IF family_found THEN
      #KEYPOINT (osk$exit, osk$m * served_family_table_index.pointers_index *
            served_family_table_index.family_list_index, dfk$locate_served_family);
      family_found := verified_by_server AND dfv$family_access_enabled;
    ELSE
      #KEYPOINT (osk$exit, 0, dfk$locate_served_family);
    IFEND;
  PROCEND dfp$locate_served_family;

?? TITLE := '[XDCL] dfp$register_served_families', EJECT ??
  PROCEDURE [XDCL] dfp$register_served_families
    (    family_list: dft$family_list;
         family_access: dft$family_access;
         client_definition: boolean;
         p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
     VAR status: ost$status);

    VAR
      connection_type: dft$connection_type,
      family: 1 .. dfc$max_family_parameters,
      family_found: boolean,
      family_name_list: array [1 .. 1] OF ost$name,
      found_server_mainframe_id: pmt$binary_mainframe_id,
      ignore_index: dft$queue_index,
      ignore_status: ost$status,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_found_queue_interface_tbl: ^dft$queue_interface_table,
      previous_server_state: dft$server_state,
      served_family_indexes: dft$served_family_table_index,
      served_family_table_entry: dft$served_family_table_entry,
      server_mainframe_found: boolean,
      server_mainframe_id: pmt$binary_mainframe_id,
      verified_by_server: boolean;

    status.normal := TRUE;
    dfp$set_write_lock (dfv$served_family_table_lock);

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

    /register_all_families/
      FOR family := LOWERBOUND (family_list) TO UPPERBOUND (family_list) DO
        locate_served_family (family_list [family], family_found, served_family_indexes,
              found_server_mainframe_id, p_found_queue_interface_tbl, ignore_index, previous_server_state,
              verified_by_server);
        IF family_found THEN
          IF server_mainframe_id = found_server_mainframe_id THEN
            initialize_served_family_entry (family_access, server_mainframe_id, connection_type,
                 p_queue_interface_table, queue_index, dfv$served_family_table_root.
                 p_family_list_pointer_array^
                 [served_family_indexes.pointers_index].p_served_family_list^ [served_family_indexes.
                 family_list_index]);
            IF (p_cpu_queue_header^.partner_status.server_state = dfc$active) AND
               (previous_server_state <> dfc$active) AND ((dfc$remote_login_access IN family_access) OR
               (dfc$job_leveling_access IN family_access)) THEN
              { What if it got queued up previously?
              family_name_list [1] := family_list [family];
              jmp$activate_deferred_family (^family_name_list);
            IFEND;
            IF (p_cpu_queue_header^.partner_status.server_state = dfc$inactive) OR
               (p_cpu_queue_header^.partner_status.server_state = dfc$awaiting_recovery) AND
               (previous_server_state <> p_cpu_queue_header^.partner_status.server_state) THEN
              { Even if the current family_access does not allow login or leveling
              { there might be a job left over.
              family_name_list [1] := family_list [family];
              jmp$defer_deactivated_family (^family_name_list);
            IFEND;

          ELSE  { The family has been registered to a different mainframe.
             IF verified_by_server AND (previous_server_state = dfc$active) THEN
               { Don't allow redirecting an active family to a different mainframe.
               { Note: Changes in the policy of when to allow redirecting a family
               {  should also be reflected in procedure verify_families_not_registered.
               osp$set_status_abnormal (dfc$file_server_id, dfe$family_already_defined,
                    family_list [family], status);
               EXIT /register_all_families/;
            IFEND;
            create_served_family_entry (family_list [family], family_access, server_mainframe_id,
                 connection_type, p_queue_interface_table, queue_index, status);
            IF NOT status.normal THEN
              EXIT /register_all_families/;
            IFEND;
            IF (p_cpu_queue_header^.partner_status.server_state = dfc$active) AND
               ((dfc$remote_login_access IN family_access) OR
                     (dfc$job_leveling_access IN family_access)) THEN
              family_name_list [1] := family_list [family];
              jmp$activate_deferred_family (^family_name_list);
            IFEND;
            set_moved_family_name (served_family_indexes);
          IFEND;

        ELSE  { Family not found
          create_served_family_entry (family_list [family], family_access, server_mainframe_id,
               connection_type, p_queue_interface_table, queue_index, status);
          IF NOT status.normal THEN
            EXIT /register_all_families/;
          IFEND;
          IF (p_cpu_queue_header^.partner_status.server_state = dfc$active)  AND
               ((dfc$remote_login_access IN family_access) OR
                     (dfc$job_leveling_access IN family_access)) THEN
            family_name_list [1] := family_list [family];
            jmp$activate_deferred_family (^family_name_list);
          IFEND;
        IFEND;
      FOREND /register_all_families/;

      IF status.normal AND (p_cpu_queue_header^.partner_status.server_state = dfc$active) AND
            client_definition THEN
        p_cpu_queue_header^.partner_status.verify_family := TRUE;
      IFEND;

    dfp$clear_write_lock (dfv$served_family_table_lock);

    dfp$flush_served_family_table (ignore_status);
  PROCEND dfp$register_served_families;
?? TITLE := '[XDCL] dfp$store_served_family_entry ', EJECT ??
  PROCEDURE [XDCL] dfp$store_served_family_entry
    (    served_family_table_entry: dft$served_family_table_entry;
     VAR served_family_table_index: dft$served_family_table_index;
     VAR status: ost$status);

    VAR
      actual: integer,
      free_entry_found: boolean,
      served_family_list_pointer: dft$served_family_list_pointer,
      table_full: boolean;

    status.normal := TRUE;

    IF NOT dfv$served_family_table_root.valid THEN
      create_family_table_root (dfv$served_family_table_root);
    IFEND;

    locate_free_entry (dfv$served_family_table_root, table_full, free_entry_found, served_family_table_index);

    IF table_full THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$maximum_families_configured,
            served_family_table_entry.family_name, status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            (dfc$served_family_list_size * dfv$number_served_family_lists), {Base =} 10,
            { Display base = } FALSE, status);
    ELSE
      IF NOT free_entry_found THEN
        create_family_list (served_family_list_pointer);
        update_pointer_array (served_family_list_pointer, dfv$served_family_table_root,
              served_family_table_index.pointers_index);
        served_family_table_index.family_list_index := LOWERBOUND (served_family_list_pointer.
              p_served_family_list^);
      IFEND;
      dfv$served_family_table_root.p_family_list_pointer_array^ [served_family_table_index.pointers_index].
            p_served_family_list^ [served_family_table_index.family_list_index] := served_family_table_entry;
      #SPOIL (dfv$served_family_table_root.p_family_list_pointer_array^
            [served_family_table_index.pointers_index].p_served_family_list^
            [served_family_table_index.family_list_index]);
      osp$increment_locked_variable (dfv$served_family_table_root.
            p_family_list_pointer_array^ [served_family_table_index.pointers_index].highest_valid_entry,
            dfv$served_family_table_root.p_family_list_pointer_array^
            [served_family_table_index.pointers_index].highest_valid_entry, actual);
    IFEND;
  PROCEND dfp$store_served_family_entry;
?? TITLE := '[XDCL, #GATE] dfp$$served_family_access', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to implement the command language
{   function $served_family_access.
{

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

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

    VAR
      access_string: string (7),
      avt: array [1 .. 2] of clt$value,
      family_access: dft$family_access,
      family_known: boolean,
      family_name: ost$family_name,
      ignore_leveler_status: jmt$jl_job_leveler_status,
      ignore_server_state: dft$server_state,
      server_mainframe_name: pmt$mainframe_id;

    clp$scan_argument_list (function_name, argument_list, ^client_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_mainframe_name := avt [1].name.value;
    {NOTE: server_mainframe_name not currently used.

    family_name := avt [2].name.value;

    dfp$get_family_access (family_name, family_known, family_access, ignore_server_state,
          ignore_leveler_status);

    value.descriptor := 'STRING';
    value.kind := clc$string_value;

    IF NOT family_known THEN
      value.str.size := 7;
      value.str.value := 'UNKNOWN';
    ELSEIF family_access = $dft$family_access [] THEN
      value.str.size := 4;
      value.str.value := 'NONE';
    ELSEIF dfc$job_leveling_access IN family_access THEN
      value.str.size := 7;
      value.str.value := 'LEVELED';
    ELSEIF dfc$remote_login_access IN family_access THEN
      value.str.size := 5;
      value.str.value := 'LOGIN';
    ELSEIF dfc$remote_file_access IN family_access THEN
      value.str.size := 4;
      value.str.value := 'FILE';
    IFEND;

  PROCEND dfp$$served_family_access;

?? TITLE := 'crack_define_family_command ', EJECT ??
  PROCEDURE crack_define_family_command
    (    parameter_list: clt$parameter_list;
     VAR family_list_container: dft$family_list_container;
     VAR family_list_p: dft$p_family_list;
     VAR server_mainframe_name: pmt$mainframe_id;
     VAR server_mainframe_id: pmt$binary_mainframe_id;
     VAR status: ost$status);

{ PROCEDURE define_served_family, defsf (
{   server_mainframe_identifier, smi: name pmc$mainframe_id_size = $required
{   family, families, f: list 1 .. dfc$max_family_parameters of name = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 8, 30, 13, 1, 52, 677],
    clc$command, 6, 3, 2, 0, 0, 0, 3, ''], [
    ['F                              ',clc$abbreviation_entry, 2],
    ['FAMILIES                       ',clc$alias_entry, 2],
    ['FAMILY                         ',clc$nominal_entry, 2],
    ['SERVER_MAINFRAME_IDENTIFIER    ',clc$nominal_entry, 1],
    ['SMI                            ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [pmc$mainframe_id_size, pmc$mainframe_id_size]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [5, 1, dfc$max_family_parameters, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$server_mainframe_identifier = 1,
      p$family = 2,
      p$status = 3;

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

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

    crack_family_list (pvt [p$family].value, family_list_container, family_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_mainframe_name := pvt [p$server_mainframe_identifier].value^.name_value;
    dfp$new_crack_mainframe_id (server_mainframe_name, server_mainframe_id, status);

  PROCEND crack_define_family_command;

?? TITLE := 'crack_define_server ', EJECT ??
  PROCEDURE crack_define_server
    (    parameter_list: clt$parameter_list;
     VAR family_list_container: dft$family_list_container;
     VAR family_list_p: dft$p_family_list;
     VAR server_mainframe_name: pmt$mainframe_id;
     VAR server_mainframe_id: pmt$binary_mainframe_id;
     VAR connection_parameters: dft$connection_parameters;
     VAR status: ost$status);

{ PROCEDURE define_server, defs (
{   family, families, f: list 1 .. dfc$max_family_parameters of name
{   server_mainframe_identifier, smi: name pmc$mainframe_id_size = $required
{   client_id_number, cin, cidn: integer 1 .. dfc$max_number_of_mainframes  = $required
{   server_id_number, sin, sidn: integer 1 .. dfc$max_number_of_mainframes = $required
{   number_of_monitor_queue_entries, nomqe: integer 0 .. dfc$max_queue_entries-2 = 50
{   number_of_task_queue_entries, notqe: integer 1 .. dfc$max_queue_entries-2 = 4
{   connection_type, ct: any of key stornet keyend, name, anyend = stornet
{   element_name, en: name = $required
{   send_channel, sc: list 1 .. 2 of name = $required
{   receive_channel, rc: list 1 .. 2 of name
{   dma_available, da: boolean  = true
{   timeout_interval, ti: integer 1 .. dfc$maximum_timeout = 10
{   maximum_request_timeout_count, mrtc: integer 1 .. dfc$max_req_timeout_count_value = 5
{   maximum_retransmission_count, mrc: integer 1 .. dfc$max_retransmit_count_value = 5
{   users_wait_on_terminated, uwot: boolean = true
{   preallocate_image_size, pis: integer 0 .. osc$max_segment_length = 0
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 36] of clt$pdt_parameter_name,
      parameters: array [1 .. 17] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (7),
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type10: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type11: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type12: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type13: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type14: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type15: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type16: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type17: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 8, 30, 12, 57, 47, 246],
    clc$command, 36, 17, 5, 0, 0, 0, 17, ''], [
    ['CIDN                           ',clc$abbreviation_entry, 3],
    ['CIN                            ',clc$alias_entry, 3],
    ['CLIENT_ID_NUMBER               ',clc$nominal_entry, 3],
    ['CONNECTION_TYPE                ',clc$nominal_entry, 7],
    ['CT                             ',clc$abbreviation_entry, 7],
    ['DA                             ',clc$abbreviation_entry, 11],
    ['DMA_AVAILABLE                  ',clc$nominal_entry, 11],
    ['ELEMENT_NAME                   ',clc$nominal_entry, 8],
    ['EN                             ',clc$abbreviation_entry, 8],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FAMILIES                       ',clc$alias_entry, 1],
    ['FAMILY                         ',clc$nominal_entry, 1],
    ['MAXIMUM_REQUEST_TIMEOUT_COUNT  ',clc$nominal_entry, 13],
    ['MAXIMUM_RETRANSMISSION_COUNT   ',clc$nominal_entry, 14],
    ['MRC                            ',clc$abbreviation_entry, 14],
    ['MRTC                           ',clc$abbreviation_entry, 13],
    ['NOMQE                          ',clc$abbreviation_entry, 5],
    ['NOTQE                          ',clc$abbreviation_entry, 6],
    ['NUMBER_OF_MONITOR_QUEUE_ENTRIES',clc$nominal_entry, 5],
    ['NUMBER_OF_TASK_QUEUE_ENTRIES   ',clc$nominal_entry, 6],
    ['PIS                            ',clc$abbreviation_entry, 16],
    ['PREALLOCATE_IMAGE_SIZE         ',clc$nominal_entry, 16],
    ['RC                             ',clc$abbreviation_entry, 10],
    ['RECEIVE_CHANNEL                ',clc$nominal_entry, 10],
    ['SC                             ',clc$abbreviation_entry, 9],
    ['SEND_CHANNEL                   ',clc$nominal_entry, 9],
    ['SERVER_ID_NUMBER               ',clc$nominal_entry, 4],
    ['SERVER_MAINFRAME_IDENTIFIER    ',clc$nominal_entry, 2],
    ['SIDN                           ',clc$abbreviation_entry, 4],
    ['SIN                            ',clc$alias_entry, 4],
    ['SMI                            ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 17],
    ['TI                             ',clc$abbreviation_entry, 12],
    ['TIMEOUT_INTERVAL               ',clc$nominal_entry, 12],
    ['USERS_WAIT_ON_TERMINATED       ',clc$nominal_entry, 15],
    ['UWOT                           ',clc$abbreviation_entry, 15]],
    [
{ PARAMETER 1
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$optional_parameter,
  0, 0],
{ PARAMETER 2
    [28, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 4
    [27, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 5
    [19, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 6
    [20, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 7
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 8
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 9
    [26, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$required_parameter,
  0, 0],
{ PARAMETER 10
    [24, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$optional_parameter,
  0, 0],
{ PARAMETER 11
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 12
    [34, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 13
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 14
    [14, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 15
    [35, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 16
    [22, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 17
    [32, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [5, 1, dfc$max_family_parameters, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 2
    [[1, 0, clc$name_type], [pmc$mainframe_id_size, pmc$mainframe_id_size]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, dfc$max_number_of_mainframes, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, dfc$max_number_of_mainframes, 10]],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [0, dfc$max_queue_entries-2, 10],
    '50'],
{ PARAMETER 6
    [[1, 0, clc$integer_type], [1, dfc$max_queue_entries-2, 10],
    '4'],
{ PARAMETER 7
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['STORNET                        ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'stornet'],
{ PARAMETER 8
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 9
    [[1, 0, clc$list_type], [5, 1, 2, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 10
    [[1, 0, clc$list_type], [5, 1, 2, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 11
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 12
    [[1, 0, clc$integer_type], [1, dfc$maximum_timeout, 10],
    '10'],
{ PARAMETER 13
    [[1, 0, clc$integer_type], [1, dfc$max_req_timeout_count_value, 10],
    '5'],
{ PARAMETER 14
    [[1, 0, clc$integer_type], [1, dfc$max_retransmit_count_value, 10],
    '5'],
{ PARAMETER 15
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 16
    [[1, 0, clc$integer_type], [0, osc$max_segment_length, 10],
    '0'],
{ PARAMETER 17
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$family = 1,
      p$server_mainframe_identifier = 2,
      p$client_id_number = 3,
      p$server_id_number = 4,
      p$number_of_monitor_queue_entri = 5 {NUMBER_OF_MONITOR_QUEUE_ENTRIES} ,
      p$number_of_task_queue_entries = 6,
      p$connection_type = 7,
      p$element_name = 8,
      p$send_channel = 9,
      p$receive_channel = 10,
      p$dma_available = 11,
      p$timeout_interval = 12,
      p$maximum_request_timeout_count = 13,
      p$maximum_retransmission_count = 14,
      p$users_wait_on_terminated = 15,
      p$preallocate_image_size = 16,
      p$status = 17;

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

    VAR
      computed_queue_size: ost$non_negative_integers,
      data_value: clt$data_value,
      esm_table_entry_p: ^dft$esm_definition_table_entry;

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

    crack_family_list (pvt [p$family].value, family_list_container, family_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    server_mainframe_name := pvt [p$server_mainframe_identifier].value^.name_value;
    dfp$new_crack_mainframe_id (server_mainframe_name, server_mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    connection_parameters.server_queue_index := pvt [p$client_id_number].value^.integer_value.value;
    connection_parameters.client_queue_index :=
          pvt [p$server_id_number].value^.integer_value.value + dfc$max_number_of_mainframes;
    connection_parameters.number_of_monitor_queue_entries :=
          pvt [p$number_of_monitor_queue_entri].value^.integer_value.value;
    connection_parameters.number_of_task_queue_entries :=
          pvt [p$number_of_task_queue_entries].value^.integer_value.value;

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

    computed_queue_size := ((connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries + 1) * #SIZE (dft$driver_queue_entry)) +
          #SIZE (dft$driver_queue_header);
    IF computed_queue_size > osv$page_size THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$too_many_queue_entries, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, computed_queue_size, 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, osv$page_size, 10, FALSE, status);
      RETURN;
    IFEND;

    connection_parameters.client_to_server.client_to_server := TRUE;
    connection_parameters.client_to_server.users_wait_on_terminated :=
          pvt [p$users_wait_on_terminated].value^.boolean_value.value;
    connection_parameters.client_to_server.preallocate_image_size :=
          pvt [p$preallocate_image_size].value^.integer_value.value;
    connection_parameters.client_to_server.timeout_interval :=
          pvt [p$timeout_interval].value^.integer_value.value;
    connection_parameters.client_to_server.maximum_request_timeout_count :=
          pvt [p$maximum_request_timeout_count].value^.integer_value.value;
    connection_parameters.client_to_server.maximum_retransmission_count :=
          pvt [p$maximum_retransmission_count].value^.integer_value.value;

    IF (pvt [p$connection_type].value^.kind = clc$keyword) AND
          (pvt [p$connection_type].value^.keyword_value = 'STORNET') THEN
      connection_parameters.connection_type := dfc$esm_connection;
      connection_parameters.esm_parameters.element_name := pvt [p$element_name].value^.name_value;

      data_value := pvt [p$send_channel].value^;
      connection_parameters.esm_parameters.send_channel.channel_name := data_value.element_value^.name_value;
      IF data_value.link = NIL THEN
        connection_parameters.esm_parameters.send_channel.iou_name := dfc$iou_name0;
      ELSE
        data_value := data_value.link^;
        IF (data_value.element_value^.name_value <> dfc$iou_name0) AND
              (data_value.element_value^.name_value <> dfc$iou_name1) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$send_channel_invalid_iou,
                data_value.element_value^.name_value, status);
          RETURN;
        IFEND;
        connection_parameters.esm_parameters.send_channel.iou_name :=
              data_value.element_value^.name_value;
      IFEND;
      dfp$verify_stornet_channel (connection_parameters.esm_parameters.element_name,
            connection_parameters.esm_parameters.send_channel, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF NOT pvt [p$receive_channel].specified THEN
        connection_parameters.esm_parameters.receive_channel :=
              connection_parameters.esm_parameters.send_channel;
      ELSE
        data_value := pvt [p$receive_channel].value^;
        connection_parameters.esm_parameters.receive_channel.channel_name :=
              data_value.element_value^.name_value;
        IF data_value.link = NIL THEN
          connection_parameters.esm_parameters.receive_channel.iou_name :=
                connection_parameters.esm_parameters.send_channel.iou_name;
        ELSE
          data_value := data_value.link^;
          IF (data_value.element_value^.name_value <> dfc$iou_name0) AND
                (data_value.element_value^.name_value <> dfc$iou_name1) THEN
            osp$set_status_abnormal (dfc$file_server_id, dfe$receive_channel_invalid_iou,
                  data_value.element_value^.name_value, status);
            RETURN;
          IFEND;
          connection_parameters.esm_parameters.receive_channel.iou_name :=
                data_value.element_value^.name_value;
        IFEND;
        dfp$verify_stornet_channel (connection_parameters.esm_parameters.element_name,
              connection_parameters.esm_parameters.receive_channel, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      connection_parameters.esm_parameters.source_id_number :=
            pvt [p$client_id_number].value^.integer_value.value;
      connection_parameters.esm_parameters.destination_id_number :=
            pvt [p$server_id_number].value^.integer_value.value;
      connection_parameters.esm_parameters.dma_available := pvt [p$dma_available].value^.boolean_value.value;

      dfp$locate_esm_definition (connection_parameters.esm_parameters.element_name, esm_table_entry_p);
      IF esm_table_entry_p = NIL THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$stornet_not_defined,
             connection_parameters.esm_parameters.element_name, status);
        RETURN;
      IFEND;
      connection_parameters.esm_parameters.esm_memory_size := esm_table_entry_p^.memory_size;
      connection_parameters.esm_parameters.esm_base_addresses := esm_table_entry_p^.esm_base_addresses;
      connection_parameters.client_to_server.maximum_data_bytes := esm_table_entry_p^.maximum_data_bytes;

      connection_parameters.driver_name := connection_parameters.esm_parameters.send_channel.channel_name;

      IF pvt [p$client_id_number].value^.integer_value.value >
            connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$id_number_exceeds_nomf, 'Client', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              pvt [p$client_id_number].value^.integer_value.value, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes, 10, FALSE,
              status);
        RETURN;
      IFEND;
      IF pvt [p$server_id_number].value^.integer_value.value >
            connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$id_number_exceeds_nomf, 'Server', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              pvt [p$server_id_number].value^.integer_value.value, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes, 10, FALSE,
              status);
        RETURN;
      IFEND;

    ELSEIF pvt [p$connection_type].value^.name_value = 'CDCNET' THEN
      connection_parameters.connection_type := dfc$cdcnet_connection;
      connection_parameters.driver_name := pvt [p$element_name].value^.name_value;
    ELSEIF pvt [p$connection_type].value^.name_value = 'MOCK' THEN
      connection_parameters.connection_type := dfc$mock_connection;
      connection_parameters.driver_name := pvt [p$element_name].value^.name_value;
    ELSE
      connection_parameters.driver_name := pvt [p$element_name].value^.name_value;
    IFEND;

  PROCEND crack_define_server;

?? TITLE := 'crack_family_list ', EJECT ??
  PROCEDURE crack_family_list
    (    family_value_list_p: ^clt$data_value;
     VAR family_list_container: dft$family_list_container;
     VAR family_list_p: dft$p_family_list;
     VAR status: ost$status);

    VAR
      family_list_container_p: ^dft$family_list_container,
      family_p: ^ost$name,
      family_value_p: ^clt$data_value,
      list_p: ^clt$data_value,
      number_of_families: integer;

    status.normal := TRUE;
    family_list_p := NIL;
    number_of_families := 0;
    family_list_container_p := ^family_list_container;
    RESET family_list_container_p;

    list_p := family_value_list_p;
    WHILE list_p <> NIL DO
      family_value_p := list_p^.element_value;
      list_p := list_p^.link;

      IF family_value_p^.name_value = osv$system_family_name THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$system_family_not_allowed,
              family_value_p^.name_value, status);
        RETURN;
      IFEND;

      NEXT family_p IN family_list_container_p;
      family_p^ := family_value_p^.name_value;
      number_of_families := number_of_families + 1;
    WHILEND;

    IF number_of_families > 0 THEN
      RESET family_list_container_p;
      NEXT family_list_p: [1 .. number_of_families] IN family_list_container_p;
    IFEND;

  PROCEND crack_family_list;

?? TITLE := 'create_family_list ', EJECT ??
  PROCEDURE create_family_list
    (VAR served_family_list_pointer: dft$served_family_list_pointer);

    VAR
      family: dft$served_family_list_index;

    served_family_list_pointer.highest_valid_entry := 0;
    ALLOCATE served_family_list_pointer.p_served_family_list IN dfv$server_wired_heap^;
    IF served_family_list_pointer.p_served_family_list = NIL THEN
      osp$system_error (' NIL FAMILY LIST POINTER ', NIL);
    IFEND;

  /blank_out_family_names/
    FOR family := LOWERBOUND (served_family_list_pointer.p_served_family_list^)
          TO UPPERBOUND (served_family_list_pointer.p_served_family_list^) DO
      served_family_list_pointer.p_served_family_list^ [family].family_name := ' ';
    FOREND /blank_out_family_names/;
  PROCEND create_family_list;
?? TITLE := 'create_family_table_root ', EJECT ??

  PROCEDURE create_family_table_root
    (VAR served_family_table_root: dft$served_family_table_root);

    VAR
      pointer_index: dft$family_pointer_index;

    ALLOCATE served_family_table_root.p_family_list_pointer_array: [1 .. dfv$number_served_family_lists] IN
          dfv$server_wired_heap^;
    IF served_family_table_root.p_family_list_pointer_array = NIL THEN
      osp$system_error (' NIL FAMILY TABLE ROOT', NIL);
    IFEND;

  /initialize_family_lists/
    FOR pointer_index := 1 TO dfv$number_served_family_lists DO
      served_family_table_root.p_family_list_pointer_array^ [pointer_index].highest_valid_entry := 0;
      served_family_table_root.p_family_list_pointer_array^ [pointer_index].p_served_family_list := NIL;
    FOREND /initialize_family_lists/;

    #SPOIL (served_family_table_root);
    served_family_table_root.number_of_active_pointers := 0;
    #SPOIL (served_family_table_root);
    served_family_table_root.valid := TRUE;
  PROCEND create_family_table_root;

?? TITLE := 'create_served_family_entry  ', EJECT ??
  PROCEDURE create_served_family_entry
    (    family_name: ost$family_name;
         family_access: dft$family_access;
         server_mainframe_id: pmt$binary_mainframe_id;
         connection_type: dft$connection_type;
         p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
     VAR status: ost$status);

    VAR
      p_cpu_queue_header: ^dft$cpu_queue_header,
      served_family_table_entry: dft$served_family_table_entry,
      served_family_table_index: dft$served_family_table_index;

    { Initialize entry before setting entry in use to assure consistant
    { structure.
    served_family_table_entry.family_name := family_name;
    initialize_served_family_entry (family_access, server_mainframe_id, connection_type,
         p_queue_interface_table, queue_index, served_family_table_entry);
    p_cpu_queue_header := ^p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].
          p_cpu_queue^.queue_header;
    served_family_table_entry.server_lifetime := p_cpu_queue_header^.server_lifetime;
    served_family_table_entry.server_birthdate := p_cpu_queue_header^.server_birthdate;
    served_family_table_entry.active_since_deadstart :=
       (served_family_table_entry.server_state = dfc$active);
    status.normal := TRUE;

    dfp$store_served_family_entry (served_family_table_entry,
      served_family_table_index, status);
  PROCEND create_served_family_entry;

?? TITLE := 'define_asynchronous_task ', EJECT ??

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

    VAR
      program_attributes: llt$program_attributes,
      p_task_params: ^clt$parameter_list,
      parameter_string: ^clt$parameter_list_contents,
      spy_id: pmt$spy_identifier,
      string_length: integer,
      task_name: ost$name;

    dfp$format_task_name (mainframe_name, task_name);
    spy_id := 0;

    PUSH parameter_string: [STRLENGTH (mainframe_name)];
    parameter_string^.size := STRLENGTH (mainframe_name);
    parameter_string^.text := mainframe_name;
    p_task_params := #SEQ (parameter_string^);

    program_attributes.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified];
    program_attributes.starting_procedure := c$asynchronous_start_procedure;
    program_attributes.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    program_attributes.termination_error_level := pmc$warning_load_errors;

    osp$define_system_task (task_name, {auto_restart=} FALSE,
          {deactivate_option=} osc$tt_terminate, {idle_option=} osc$tt_ignore_or_prohibited,
          {restart_after_idle=} TRUE, spy_id, {execution_ring=} osc$user_ring, #SEQ (program_attributes),
          p_task_params, status);

  PROCEND define_asynchronous_task;
?? TITLE := 'define_servers_catalog', EJECT ??
  PROCEDURE define_servers_catalog;

    VAR
      catalog_path: array [1 .. 3] of pft$name,
      status: ost$status;

    status.normal := TRUE;
    catalog_path [1] := ' ';
    catalog_path [2] := ' ';
    catalog_path [3] := dfc$server_mainframes_catalog;
    pfp$define_catalog (catalog_path, status);
    IF (NOT status.normal) AND (status.condition <> pfe$name_already_subcatalog) THEN
      RETURN;
    IFEND;
  PROCEND define_servers_catalog;
?? TITLE := 'initialize_served_family_entry', EJECT ??
{ Note: This routine must NOT set lifetinme or birthdate.

  PROCEDURE initialize_served_family_entry
    (    family_access: dft$family_access,
         server_mainframe_id: pmt$binary_mainframe_id;
         connection_type: dft$connection_type;
         p_queue_interface_table: ^dft$queue_interface_table;
         queue_index: dft$queue_index;
     VAR served_family_table_entry: dft$served_family_table_entry);

    VAR
      p_cpu_queue_header: ^dft$cpu_queue_header;

    served_family_table_entry.family_access := family_access;
    served_family_table_entry.server_mainframe_id := server_mainframe_id;
    served_family_table_entry.connection_type := connection_type;
    served_family_table_entry.p_queue_interface_table := p_queue_interface_table;
    served_family_table_entry.queue_index := queue_index;
    served_family_table_entry.verified_by_server := FALSE;
    p_cpu_queue_header := ^p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].
          p_cpu_queue^.queue_header;
    served_family_table_entry.server_state := p_cpu_queue_header^.partner_status.server_state;
    IF served_family_table_entry.server_state = dfc$active THEN
      served_family_table_entry.active_since_deadstart := TRUE;
    IFEND;
  PROCEND initialize_served_family_entry;

?? TITLE := 'locate_free_entry ', EJECT ??
  PROCEDURE locate_free_entry
    (    served_family_table_root: dft$served_family_table_root;
     VAR table_full: boolean;
     VAR free_entry_found: boolean;
     VAR served_family_table_index: dft$served_family_table_index);

    VAR
      pointers_index: dft$family_pointer_index;

    table_full := FALSE;
    IF served_family_table_root.number_of_active_pointers = 0 THEN
      free_entry_found := FALSE;
    ELSE
      pointers_index := served_family_table_root.number_of_active_pointers;
      free_entry_found := served_family_table_root.p_family_list_pointer_array^ [pointers_index].
            highest_valid_entry < UPPERBOUND (served_family_table_root.
            p_family_list_pointer_array^ [pointers_index].p_served_family_list^);
    IFEND;
    IF free_entry_found THEN
      served_family_table_index.pointers_index := pointers_index;
      served_family_table_index.family_list_index := served_family_table_root.
            p_family_list_pointer_array^ [served_family_table_index.pointers_index].highest_valid_entry + 1;
      RETURN;
    IFEND;

    table_full := served_family_table_root.number_of_active_pointers =
          UPPERBOUND (served_family_table_root.p_family_list_pointer_array^);
  PROCEND locate_free_entry;
?? TITLE := 'locate_served_family ', EJECT ??

  PROCEDURE locate_served_family
    (    family: ost$family_name;
     VAR family_found: boolean;
     VAR served_family_table_index: dft$served_family_table_index;
     VAR server_mainframe_id: pmt$binary_mainframe_id;
     VAR p_queue_interface_table: dft$p_queue_interface_table;
     VAR queue_index: dft$queue_index;
     VAR server_state: dft$server_state;
     VAR verified_by_server: boolean);

    VAR
      family_list_index: dft$served_family_list_index,
      pointers_index: dft$family_pointer_index,
      served_family_table_entry: dft$served_family_table_entry;

    IF dfv$served_family_table_root.valid THEN

    /for_all_lists/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO
          { Assume no deletion
          IF (dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
                p_served_family_list^ [family_list_index].family_name = family) THEN
            family_found := TRUE;
            served_family_table_index.pointers_index := pointers_index;
            served_family_table_index.family_list_index := family_list_index;
            served_family_table_entry := dfv$served_family_table_root.
                  p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index];
            server_mainframe_id := served_family_table_entry.server_mainframe_id;
            p_queue_interface_table := served_family_table_entry.p_queue_interface_table;
            queue_index := served_family_table_entry.queue_index;
            server_state := served_family_table_entry.server_state;
            verified_by_server := served_family_table_entry.verified_by_server;
            RETURN;
          IFEND;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;
    family_found := FALSE;
  PROCEND locate_served_family;

?? TITLE := 'process_new_mainframe ', EJECT ??
  PROCEDURE process_new_mainframe
    (    connection_parameters: dft$connection_parameters;
         server_mainframe_name: pmt$mainframe_id;
         server_mainframe_id: pmt$binary_mainframe_id;
     VAR queue_interface_table_p: ^dft$queue_interface_table;
     VAR status: ost$status);

    VAR
      client_queue_index: dft$queue_index,
      cpu_queue_p: ^dft$cpu_queue,
      found_server_mainframe_id: pmt$binary_mainframe_id,
      ignore_directory_entry_p: ^dft$q_interface_directory_entry,
      image_file_exists: boolean,
      queue_index: dft$queue_index,
      served_family_table_index: dft$served_family_table_index,
      server_mainframe_found: boolean,
      server_to_client: boolean;

    status.normal := TRUE;
    server_to_client := FALSE;
    dfp$find_mainframe_id (server_mainframe_name, server_to_client, server_mainframe_found,
          queue_interface_table_p, cpu_queue_p, queue_index, ignore_directory_entry_p);
    IF server_mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$server_already_defined, server_mainframe_name, status);
      RETURN;
    IFEND;

    dfp$create_queue (connection_parameters, server_mainframe_name, server_mainframe_id, server_to_client,
          queue_interface_table_p, status);
    client_queue_index := connection_parameters.client_queue_index;
    IF status.normal THEN
      dfp$record_server_translation (server_mainframe_id);
      define_servers_catalog;
      dfp$create_image_file (server_mainframe_id,
            connection_parameters.client_to_server.preallocate_image_size, image_file_exists, status);
    IFEND;
    IF status.normal AND (connection_parameters.connection_type = dfc$cdcnet_connection) THEN
      dfp$start_cdcnet_client (queue_interface_table_p, connection_parameters.driver_name,
            server_mainframe_name, client_queue_index, status);
    IFEND;

  PROCEND process_new_mainframe;

?? TITLE := 'set_moved_family_name ', EJECT ??
{
{ This procedure sets the family name in the served family entry to a value that will
{ not be found by any of the search routines.  The family entry must remain valid
{ and cannot be re-used because we don't know if there are outstanding users of the
{ served_family_table_index, for example attached files.  We cannot reliably assign
{ a new lifetime because define_served_family may be done after the server is already
{ active.

  PROCEDURE set_moved_family_name
    (    served_family_table_index: dft$served_family_table_index);

    VAR
      p_served_family_entry: ^dft$served_family_table_entry;

    p_served_family_entry := ^dfv$served_family_table_root.
          p_family_list_pointer_array^ [served_family_table_index.pointers_index].
          p_served_family_list^ [served_family_table_index.family_list_index];

    #TRANSLATE (osv$upper_to_lower, p_served_family_entry^.family_name, p_served_family_entry^.family_name);

    p_served_family_entry^.family_name (osc$max_name_size) := '*';

  PROCEND set_moved_family_name;
?? TITLE := 'set_served_family_queue_info', EJECT ??

{   This procedure changes queue information in the Served_Family_Table to one
{   requested by the input parameters. It selects the Family entries by
{   matching the the mainframe_id supplied by the input parameter with
{   one in the Served_Family_Table.

  PROCEDURE set_served_family_queue_info
    (    mainframe_id: pmt$binary_mainframe_id;
         p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index);

    VAR
      family_list_index: dft$served_family_list_index,
      p_family_list: ^array [dft$served_family_list_index] of dft$served_family_table_entry,
      pointers_index: dft$family_pointer_index;

    dfp$set_read_lock (dfv$served_family_table_lock);
    IF dfv$served_family_table_root.valid THEN

    /for_all_pointers/
      FOR pointers_index := 1 TO dfv$served_family_table_root.number_of_active_pointers DO
        p_family_list := dfv$served_family_table_root.p_family_list_pointer_array^ [pointers_index].
              p_served_family_list;

      /search_family_list/
        FOR family_list_index := 1 TO dfv$served_family_table_root.
              p_family_list_pointer_array^ [pointers_index].highest_valid_entry DO

          IF (p_family_list^ [family_list_index].server_mainframe_id = mainframe_id) THEN
            p_family_list^ [family_list_index].p_queue_interface_table := p_queue_interface_table;
            p_family_list^ [family_list_index].queue_index := queue_index;
          IFEND;

        FOREND /search_family_list/;
      FOREND /for_all_pointers/;

    IFEND;
    dfp$clear_read_lock (dfv$served_family_table_lock);

  PROCEND set_served_family_queue_info;

?? TITLE := 'update_pointer_array ', EJECT ??
  PROCEDURE update_pointer_array
    (    served_family_list_pointer: dft$served_family_list_pointer;
     VAR served_family_table_root: {Input, Output} dft$served_family_table_root;
     VAR assigned_pointers_index: dft$family_pointer_index);

    VAR
      actual: integer;

    served_family_table_root.p_family_list_pointer_array^
          [served_family_table_root.number_of_active_pointers + 1] := served_family_list_pointer;
    #SPOIL (served_family_table_root.p_family_list_pointer_array^
          [served_family_table_root.number_of_active_pointers + 1]);
    osp$increment_locked_variable (served_family_table_root.number_of_active_pointers,
          served_family_table_root.number_of_active_pointers, actual);
    assigned_pointers_index := served_family_table_root.number_of_active_pointers;
  PROCEND update_pointer_array;

?? TITLE := 'verify_families_not_registered ', EJECT ??
  PROCEDURE verify_families_not_registered
    (    family_list: dft$family_list;
         requested_mainframe: pmt$binary_mainframe_id;
     VAR status: ost$status);

    VAR
      family: 1 .. dfc$max_family_parameters,
      family_found: boolean,
      ignore_indexes: dft$served_family_table_index,
      ignore_p_qit: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      ignore_verification: boolean,
      registered_mainframe: pmt$binary_mainframe_id,
      server_state: dft$server_state;

    status.normal := TRUE;
  /locate_each_family/
    FOR family := LOWERBOUND (family_list) TO UPPERBOUND (family_list) DO
      locate_served_family (family_list [family], family_found, ignore_indexes, registered_mainframe,
           ignore_p_qit, ignore_queue_index, server_state, ignore_verification);
      IF family_found AND ((server_state = dfc$active) OR ((requested_mainframe = registered_mainframe) AND
          ((server_state <> dfc$deleted) AND (server_state <> dfc$terminated) AND
          (server_state <> dfc$awaiting_recovery)))) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$family_already_defined, family_list [family],
             status);
        EXIT /locate_each_family/;
      IFEND;
    FOREND /locate_each_family/;

  PROCEND verify_families_not_registered;
?? OLDTITLE ??
?? OLDTITLE ??
MODEND dfm$served_family_manager;
