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

{ PURPOSE:
{   This server module contains the code to delete tables associated
{   with a partner (server or client) mainframe.
{
{ DESIGN:
{   Implementation is based upon "undoing" those actions performed by the
{   define_client or define_server command. The served family table on the
{   client cannot be physically deleted since pointers to it may exist in
{   other parts of the system.

?? NEWTITLE := '    Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfc$poll_constants
*copyc dfe$error_condition_codes
*copyc dft$client_mainframe_file
*copyc dft$cpu_queue
*copyc dfv$p_queue_interface_directory
*copyc dfv$server_wired_heap
?? POP ??
*copyc amp$return
*copyc dfp$build_client_mf_file_name
*copyc dfp$change_family_server_state
*copyc dfp$clear_family_queues
*copyc dfp$find_mainframe_id
*copyc dfp$purge_image_file
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc pfp$purge
*copyc pfp$purge_catalog

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

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

    VAR
      active_queue: boolean,
      client_mainframe_name: ost$name,
      cycle_selector: pft$cycle_selector,
      element_name: ost$name,
      i: integer,
      ignore_status: ost$status,
      mainframe_found: boolean,
      next_p_host_app_info: ^dft$host_application_info,
      next_p_remote_app_info: ^dft$remote_application_info,
      mainframe_id: pmt$binary_mainframe_id,
      p_catalog_path: ^pft$path,
      p_cpu_queue: ^dft$cpu_queue,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_host_app_info: ^dft$host_application_info,
      p_remote_app_info: ^dft$remote_application_info,
      p_mainframe_file_path: ^pft$path,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      q_d_index: dft$queue_directory_index,
      queue_index: dft$queue_index,
      queue_entry_index: dft$queue_entry_index,
      server_state: dft$server_state,
      total_queue_entries: dft$queue_entry_index;

    status.normal := TRUE;
    dfp$find_mainframe_id (mainframe_name, host_is_server_to_client, mainframe_found,
          p_queue_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found  THEN
      osp$system_error (' UNKNOWN MAINFRAME - DFP$DELETE_TABLES_OF_PARTNER', NIL);
      RETURN;
    IFEND;
     mainframe_id := p_cpu_queue^.queue_header.destination_mainframe_id;

    server_state := p_cpu_queue^.queue_header.partner_status.server_state;
    IF NOT (server_state IN $dft$server_states [dfc$terminated, dfc$awaiting_recovery] ) THEN
      IF host_is_server_to_client THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_deleteable, mainframe_name, status);
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_deleteable, mainframe_name, status);
      IFEND;
      RETURN;
    IFEND;

  /check_if_reserved/
    {Since the directory has been searched before, there is no need to check pointers, etc.
    FOR q_d_index := 1 to UPPERBOUND (dfv$p_queue_interface_directory^) DO
      IF dfv$p_queue_interface_directory^ [q_d_index].p_queue_interface_table =
             p_queue_interface_table THEN
        IF dfv$p_queue_interface_directory^ [q_d_index].connection_type <> dfc$esm_connection  THEN
          CYCLE /check_if_reserved/;
        IFEND;
        IF (dfv$p_queue_interface_directory^ [q_d_index].send_pp.p_element_reservations <> NIL)  THEN
          element_name :=dfv$p_queue_interface_directory^ [q_d_index].driver_name;
        ELSE
          element_name := ' ';
        IFEND;
        IF element_name <> ' ' THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$element_still_reserved, mainframe_name,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, element_name, status);
          RETURN;
        IFEND;
        EXIT /check_if_reserved/;
      IFEND;
    FOREND /check_if_reserved/;

    IF (NOT host_is_server_to_client) AND (server_state = dfc$terminated) THEN
      dfp$change_family_server_state (dfc$deleted, p_cpu_queue^.queue_header.destination_mainframe_id);
    IFEND;

    total_queue_entries := p_queue_interface_table^.queue_directory.driver_queue_pva_directory
          [queue_index].p_driver_queue^.queue_header.number_of_queue_entries;

{FREE buffers,etc

    FOR queue_entry_index := 1 TO total_queue_entries DO
      p_cpu_queue_entry := ^p_cpu_queue^.queue_entries [queue_entry_index];
      IF p_cpu_queue_entry^.processor_type = dfc$monitor THEN
        IF p_cpu_queue_entry^.p_server_iocb <> NIL THEN
          FREE p_cpu_queue_entry^.p_server_iocb IN dfv$server_wired_heap^;
        IFEND;
      ELSEIF queue_entry_index <> dfc$poll_queue_index THEN
        FREE p_cpu_queue_entry^.p_send_data IN dfv$server_wired_heap^;
        FREE p_cpu_queue_entry^.p_receive_data IN dfv$server_wired_heap^;
      IFEND;

      p_cpu_queue_entry^.p_data_rma_list := NIL;
      FREE p_cpu_queue_entry^.p_receive_buffer IN dfv$server_wired_heap^;
      FREE p_cpu_queue_entry^.p_send_buffer IN dfv$server_wired_heap^;
    FOREND;

    FREE p_cpu_queue^.queue_header.p_allocated_data_rma_list IN dfv$server_wired_heap^;

    p_host_app_info := p_cpu_queue^.queue_header.p_host_application_info;
    WHILE p_host_app_info <> NIL DO
      IF p_host_app_info^.p_library_file_path <> NIL THEN
        FREE p_host_app_info^.p_library_file_path IN dfv$server_wired_heap^;
      IFEND;
      IF p_host_app_info^.sequence_pointer <> NIL THEN
        FREE p_host_app_info^.sequence_pointer IN dfv$server_wired_heap^;
      IFEND;
      IF p_host_app_info^.p_attached_file_info <> NIL THEN
        FOR i := 1 to UPPERBOUND (p_host_app_info^.p_attached_file_info^) do
          FREE p_host_app_info^.p_attached_file_info^ [i] in dfv$server_wired_heap^;
        FOREND;
        FREE p_host_app_info^.p_attached_file_info IN dfv$server_wired_heap^;
      IFEND;
      next_p_host_app_info := p_host_app_info^.next_p_application_info;
      FREE p_host_app_info IN dfv$server_wired_heap^;
      p_host_app_info := next_p_host_app_info;
    WHILEND;

    p_remote_app_info := p_cpu_queue^.queue_header.p_remote_application_info;
    WHILE p_remote_app_info <> NIL DO
      next_p_remote_app_info := p_remote_app_info^.next_p_application_info;
      FREE p_remote_app_info IN dfv$server_wired_heap^;
      p_remote_app_info := next_p_remote_app_info;
    WHILEND;


    IF p_cpu_queue^.queue_header.p_application_rpc_list <> NIL THEN
      FREE p_cpu_queue^.queue_header.p_application_rpc_list IN dfv$server_wired_heap^;
    IFEND;

    FREE p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].p_cpu_queue IN
          dfv$server_wired_heap^;
    FREE p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue IN
          dfv$server_wired_heap^;
    p_queue_interface_table^.queue_directory.driver_queue_rma_directory [queue_index].driver_queue_rma := 0;

{Current queue of interest has been deleted.  Now check for any remaining active queues.

    active_queue := FALSE;

  /check_for_active_queue/
    FOR queue_index := 1 TO p_queue_interface_table^.queue_directory.number_of_queues DO
      active_queue := p_queue_interface_table^.queue_directory.driver_queue_rma_directory [queue_index].
            driver_queue_rma <> 0;
      IF active_queue THEN
        EXIT /check_for_active_queue/;
      IFEND;
    FOREND /check_for_active_queue/;

    IF NOT active_queue THEN
      FREE p_queue_interface_table^.request_buffer_directory.p_request_buffer IN dfv$server_wired_heap^;
      p_q_interface_directory_entry^.p_queue_interface_table := NIL;
      FREE p_queue_interface_table IN dfv$server_wired_heap^;
      p_q_interface_directory_entry^.driver_name := ' ';

    /check_directory/
      BEGIN
        FOR q_d_index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
          IF dfv$p_queue_interface_directory^ [q_d_index].p_queue_interface_table <> NIL THEN
            EXIT /check_directory/;
          IFEND;
        FOREND;
        FREE dfv$p_queue_interface_directory IN dfv$server_wired_heap^;
        dfv$p_queue_interface_directory := NIL;
      END /check_directory/;
    IFEND;

    IF server_state = dfc$terminated THEN
      IF host_is_server_to_client THEN
        dfp$build_client_mf_file_name (mainframe_name, client_mainframe_name);
        amp$return (client_mainframe_name, ignore_status);
        PUSH p_mainframe_file_path: [1 .. 4];
        p_mainframe_file_path^ [1] := ' ';
        p_mainframe_file_path^ [2] := ' ';
        p_mainframe_file_path^ [3] := dfc$client_mainframe_catalog;
        p_mainframe_file_path^ [4] := client_mainframe_name;
        cycle_selector.cycle_option := pfc$specific_cycle;
        cycle_selector.cycle_number := 1;
        pfp$purge (p_mainframe_file_path^, cycle_selector, osc$null_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE { Client to server
        dfp$purge_image_file (mainframe_id, status);
      IFEND;
    ELSE { awaiting_recovery
      IF NOT host_is_server_to_client THEN
       dfp$clear_family_queues (mainframe_id);
      IFEND;
    IFEND;
  PROCEND dfp$delete_tables_of_partner;

MODEND dfm$delete_tables_of_partner;
