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

{
{   The purpose of this module is to manage the 'preserved family table'.
{ The preserved family table is a disk copy of the the served family table,
{ that is used to recover the served family table on a recovery of the client
{ mainframe.
{   The served family is copied to the preserved family table at idle system
{ and terminate system time, and whenever the state changes in the served family
{ table.
{   The preserved family table is a permanent file that resides under
{ the $SYSTEM master catalog. The file is a segment access file.
{ If the preserved family table needs to be read or written prior to the
{ point of commitment then pfp$restricted_attach is used to attach it.
{

?? PUSH (LISTEXT := ON) ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$return
*copyc dsp$system_committed
*copyc mmp$lock_segment
*copyc mmp$unlock_segment
*copyc pfp$attach
*copyc pfp$define
*copyc pfp$restricted_attach
*copyc dfi$display
*copyc dfi$log_display
*copyc dfp$clear_read_lock
*copyc dfp$set_read_lock
*copyc dfp$store_served_family_entry
*copyc dfp$verify_system_administrator
*copyc dft$served_family_table
*copyc dfv$file_server_debug_enabled
*copyc dfv$served_family_table_lock
*copyc dfv$served_family_table_root
*copyc dfv$server_state_string
*copyc pfp$purge
*copyc syp$hang_if_system_jrt_set
?? POP ??

  TYPE
    dft$preserved_family_header = record
      version: ost$name,
      valid_flag: string (5),
      number_of_families: 0 .. (dfc$max_family_ptr_array_size * dfc$served_family_list_size),
    recend,

    dft$served_family_array = array [1 .. * ] of dft$served_family_table_entry;

  CONST
    dfc$preserved_family_valid = 'VALID',
    dfc$preserved_family_updating = 'BADPF',
    dfc$preserved_family_version = ' PRESERVED_FAMILY_TABLE';

  CONST
    dfc$preserved_family_table_name = 'DFF$PRESERVED_FAMILY_TABLE     ';

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

{
{   The purpose of this procedure is to a copy the served family
{ table that resides in the server wired segment to the disk permanent
{ file.
{

  PROCEDURE [XDCL] dfp$flush_served_family_table
    (VAR status: ost$status);

    VAR
      cycle_selector: pft$cycle_selector,
      family_list_index: dft$served_family_list_index,
      cycle_number: fst$cycle_number,
      file_id: amt$file_identifier,
      local_status: ost$status,
      log_string: string (80),
      log_string_length: integer,
      preserved_family_table_path: array [1 .. 3] of pft$name,
      p_header: ^dft$preserved_family_header,
      p_seq: ^SEQ ( * ),
      p_served_family_table_entry: ^dft$served_family_table_entry,
      pointers_index: dft$family_pointer_index,
      segment_pointer: amt$segment_pointer;

    IF dfv$file_server_debug_enabled THEN
      display (' Saving served family table ');
    IFEND;
    preserved_family_table_path [1] := ' ';
    preserved_family_table_path [2] := ' ';
    preserved_family_table_path [3] := dfc$preserved_family_table_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    IF dsp$system_committed () THEN
      pfp$attach (dfc$preserved_family_table_name, preserved_family_table_path, cycle_selector,
            osc$null_name, -$pft$usage_selections [], $pft$share_selections [pfc$read], pfc$wait, status);
    ELSE
      pfp$restricted_attach (dfc$preserved_family_table_name, preserved_family_table_path, cycle_selector,
            osc$null_name, -$pft$usage_selections [], $pft$share_selections [pfc$read], cycle_number, status);
    IFEND;
    IF NOT status.normal AND (status.condition = pfe$unknown_permanent_file) AND dsp$system_committed () THEN
      pfp$define (dfc$preserved_family_table_name, preserved_family_table_path, cycle_selector, osc$null_name,
            pfc$maximum_retention, pfc$log, status);
    IFEND;
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;

    amp$open (dfc$preserved_family_table_name, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      display_status (status);
      amp$return (dfc$preserved_family_table_name, local_status);
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF status.normal THEN
      mmp$lock_segment (segment_pointer.sequence_pointer, mmc$lus_lock_for_write,
           osc$wait, status);
    IFEND;
    IF NOT status.normal THEN
      display_status (status);
      amp$close (file_id, local_status);
      amp$return (dfc$preserved_family_table_name, local_status);
      RETURN;
    IFEND;

    p_seq := segment_pointer.sequence_pointer;
    NEXT p_header IN p_seq;
    p_header^.version := dfc$preserved_family_version;
    p_header^.valid_flag := dfc$preserved_family_updating;
    p_header^.number_of_families := 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
          NEXT p_served_family_table_entry IN p_seq;
          syp$hang_if_system_jrt_set (dfc$tjr_flush_served_family);

          p_served_family_table_entry^ := dfv$served_family_table_root.
                p_family_list_pointer_array^ [pointers_index].p_served_family_list^ [family_list_index];
          STRINGREP (log_string, log_string_length, ' Preserve family ',
                p_served_family_table_entry^.family_name (1, 16),
                dfv$server_state_string [p_served_family_table_entry^.server_state], ' Life/Birth',
                p_served_family_table_entry^.server_lifetime, p_served_family_table_entry^.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;
          p_header^.number_of_families := p_header^.number_of_families + 1;
        FOREND /search_family_list/;
      FOREND /for_all_lists/;
    IFEND;

    p_header^.valid_flag := dfc$preserved_family_valid;
    dfp$clear_read_lock (dfv$served_family_table_lock);
    IF dfv$file_server_debug_enabled THEN
      display_integer (' Server families preserved: ', p_header^.number_of_families);
    IFEND;
    log_display_integer ($pmt$ascii_logset [pmc$system_log], ' Server families preserved: ',
          p_header^.number_of_families);

    mmp$unlock_segment (p_seq, mmc$lus_write, osc$nowait, status);
    amp$close (file_id, status);
    amp$return (dfc$preserved_family_table_name, status);
  PROCEND dfp$flush_served_family_table;
?? TITLE := ' [XDCL] dfp$purge_preserved_family_file', EJECT ??

{
{   This procedure removes the current preserved family table.  If this
{ is called after the point of commitment the preserved family table
{ is merely deleted.  If this is called before the point of commitment
{ the count of the number of families is set to zero.
{

  PROCEDURE [XDCL] dfp$purge_preserved_family_file
    (VAR status: ost$status);

    VAR
      cycle_number: fst$cycle_number,
      cycle_selector: pft$cycle_selector,
      file_id: amt$file_identifier,
      local_status: ost$status,
      p_header: ^dft$preserved_family_header,
      p_seq: ^SEQ ( * ),
      preserved_family_table_path: array [1 .. 3] of pft$name,
      segment_pointer: amt$segment_pointer;

    preserved_family_table_path [1] := '';
    preserved_family_table_path [2] := '';
    preserved_family_table_path [3] := dfc$preserved_family_table_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    IF dsp$system_committed () THEN
      pfp$purge (preserved_family_table_path, cycle_selector, osc$null_name, status);
    ELSE
      pfp$restricted_attach (dfc$preserved_family_table_name, preserved_family_table_path, cycle_selector,
            osc$null_name, -$pft$usage_selections [], $pft$share_selections [pfc$read], cycle_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      amp$open (dfc$preserved_family_table_name, amc$segment, NIL, file_id, status);
      IF NOT status.normal THEN
        amp$return (dfc$preserved_family_table_name, local_status);
        RETURN;
      IFEND;

      amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
      IF NOT status.normal THEN
        amp$close (file_id, local_status);
        amp$return (dfc$preserved_family_table_name, local_status);
        RETURN;
      IFEND;
      p_seq := segment_pointer.sequence_pointer;
      NEXT p_header IN p_seq;
      p_header^.version := dfc$preserved_family_version;
      p_header^.number_of_families := 0;
      p_header^.valid_flag := dfc$preserved_family_valid;
      amp$close (file_id, status);
      amp$return (dfc$preserved_family_table_name, status);
    IFEND;
  PROCEND dfp$purge_preserved_family_file;
?? TITLE := ' dfp$rebuild_served_family_table', EJECT ??

{
{   This procedure copies the preserved family back to the
{ server wired segment.
{ After rebuild the same served family table index must be used.
{ Families in the terminated or deleted state are left in that state.
{ Families in any other state will be placed in the awaiting recovery state.
{

  PROCEDURE [XDCL] dfp$rebuild_served_family_table
    (VAR status: ost$status);

    VAR
      cycle_selector: pft$cycle_selector,
      preserved_family_table_path: array [1 .. 3] of pft$name,
      family: 0 .. (dfc$max_family_ptr_array_size * dfc$served_family_list_size),
      file_id: amt$file_identifier,
      local_status: ost$status,
      cycle_number: fst$cycle_number,
      log_string: string (80),
      log_string_length: integer,
      p_header: ^dft$preserved_family_header,
      p_seq: ^SEQ ( * ),
      p_served_family_table_entries: ^dft$served_family_array,
      p_served_family_table_entry: ^dft$served_family_table_entry,
      segment_pointer: amt$segment_pointer,
      served_family_table_index: dft$served_family_table_index;

    IF dfv$file_server_debug_enabled THEN
      display (' Rebuilding served family table ');
    IFEND;

    preserved_family_table_path [1] := ' ';
    preserved_family_table_path [2] := ' ';
    preserved_family_table_path [3] := dfc$preserved_family_table_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    IF dsp$system_committed () THEN
      pfp$attach (dfc$preserved_family_table_name, preserved_family_table_path, cycle_selector,
            osc$null_name, -$pft$usage_selections [], $pft$share_selections [pfc$read], pfc$wait, status);
    ELSE
      pfp$restricted_attach (dfc$preserved_family_table_name, preserved_family_table_path, cycle_selector,
            osc$null_name, -$pft$usage_selections [], $pft$share_selections [pfc$read], cycle_number, status);
    IFEND;
    IF (NOT status.normal) THEN
      IF status.condition = pfe$unknown_permanent_file THEN

{ No served family to recover

        IF dfv$file_server_debug_enabled THEN
          display (' Unknown preserved family table');
        IFEND;
        status.normal := TRUE;
      ELSE
        log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
      IFEND;
      RETURN;
    IFEND;

    amp$open (dfc$preserved_family_table_name, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      display_status (status);
      log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
      amp$return (dfc$preserved_family_table_name, local_status);
      RETURN;
    IFEND;
    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      display_status (status);
      amp$close (file_id, local_status);
      amp$return (dfc$preserved_family_table_name, local_status);
      RETURN;
    IFEND;
    p_seq := segment_pointer.sequence_pointer;
    NEXT p_header IN p_seq;
    IF (p_header^.version <> dfc$preserved_family_version) OR
          (p_header^.valid_flag <> dfc$preserved_family_valid) THEN
      IF dfv$file_server_debug_enabled THEN
        display (' Unrecognized preserved family table');
        display (p_header^.version);
        log_display ($pmt$ascii_logset [pmc$system_log], p_header^.version);
        display (p_header^.valid_flag);
        log_display ($pmt$ascii_logset [pmc$system_log], p_header^.valid_flag);
      IFEND;
      log_display ($pmt$ascii_logset [pmc$system_log], ' Unrecognized preserved family table');
      amp$close (file_id, status);
      amp$return (dfc$preserved_family_table_name, local_status);
      dfp$purge_preserved_family_file (local_status);
      RETURN;
    IFEND;
    IF p_header^.number_of_families > 0 THEN
      NEXT p_served_family_table_entries: [1 .. p_header^.number_of_families] IN p_seq;
      FOR family := 1 TO p_header^.number_of_families DO
        dfp$store_served_family_entry (p_served_family_table_entries^ [family], served_family_table_index,
              status);
        IF NOT status.normal THEN
          display (' Error in dfp$store_served_family_entry ');
          log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
          display_status (status);
          amp$close (file_id, local_status);
          amp$return (dfc$preserved_family_table_name, local_status);
          RETURN;
        IFEND;
        p_served_family_table_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];
        CASE p_served_family_table_entry^.server_state OF
        = dfc$deleted, dfc$terminated =

{ Leave these families alone

        ELSE { inactive, awaiting_recovery, active, deactivating, recovering
          p_served_family_table_entry^.server_state := dfc$awaiting_recovery;
        CASEND;

{ p_queue_interface_table and queue_index should not be referenced
{ make the dump obvious.

        p_served_family_table_entry^.active_since_deadstart := FALSE;
        p_served_family_table_entry^.p_queue_interface_table := NIL;
        p_served_family_table_entry^.queue_index := UPPERVALUE (dft$queue_index);
        STRINGREP (log_string, log_string_length, ' Rebuild family ',
              p_served_family_table_entry^.family_name (1, 20),
              dfv$server_state_string [p_served_family_table_entry^.server_state], ' Life/Birth',
              p_served_family_table_entry^.server_lifetime, p_served_family_table_entry^.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;
      FOREND
    IFEND;
    IF dfv$file_server_debug_enabled THEN
      display_integer (' Server families rebuilt: ', p_header^.number_of_families);
    IFEND;
    log_display_integer ($pmt$ascii_logset [pmc$system_log], ' Server families rebuilt: ',
          p_header^.number_of_families);
    amp$close (file_id, status);
    amp$return (dfc$preserved_family_table_name, status);

  PROCEND dfp$rebuild_served_family_table;


MODEND dfm$preserved_family_manager;



