?? RIGHT := 110 ??
MODULE osm$family_manager;
?? PUSH (LISTEXT := ON) ??
*copyc dft$family_access
*copyc dft$partner_mainframe_list
*copyc dft$served_family_table_index
*copyc osd$integer_limits
*copyc osp$clear_mainframe_sig_lock
*copyc osp$set_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc oss$mainframe_pageable
*copyc ost$family_table
*copyc ost$name
*copyc ost$status
*copyc ost$user_identification
*copyc osv$mainframe_wired_heap
*copyc pfe$error_condition_codes
*copyc pme$program_services_exceptions
*copyc pmt$binary_mainframe_id
*copyc pmt$family_name_count
*copyc pmt$family_name_list
*copyc stt$set_name
?? POP ??

  VAR
    osv$family_table_lock: [STATIC, oss$mainframe_pageable] ost$signature_lock := [0],
    osv$family_table: [XDCL, #GATE, oss$mainframe_pageable] ^ost$family_table := NIL;

?? TITLE := 'PROCEDURE osp$add_family', EJECT ??

  PROCEDURE [XDCL, #GATE] osp$add_family
    (    family: ost$name;
         set_name: stt$set_name;
     VAR status: ost$status);

*copyc osp$get_set_name

    VAR
      i: integer,
      ignore_set_name: stt$set_name,
      new_family_table: ^ost$family_table;

    osp$set_mainframe_sig_lock (osv$family_table_lock);

    IF osv$family_table = NIL THEN
      ALLOCATE osv$family_table: [1 .. 100] IN osv$mainframe_wired_heap^;
      FOR i := 1 TO 100 DO
        osv$family_table^ [i].family_name := osc$null_name;
      FOREND;
    IFEND;

    osp$get_set_name (family, ignore_set_name, status);
    IF status.normal THEN
      {If family already exists, error !
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$family_already_exists, family, status);
      osp$clear_mainframe_sig_lock (osv$family_table_lock);
      RETURN;
    IFEND;

    status.normal := TRUE;

    FOR i := 1 TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [i].family_name = osc$null_name THEN
        osv$family_table^ [i].family_name := family;
        osv$family_table^ [i].set_name := set_name;
        osv$family_table^ [i].default_family_access := $dft$family_access [];
        osv$family_table^ [i].p_client_access_list := NIL;
        osp$clear_mainframe_sig_lock (osv$family_table_lock);
        RETURN;
      IFEND;
    FOREND;

    {Table is full, expand
    ALLOCATE new_family_table: [1 .. 2 * UPPERBOUND (osv$family_table^)] IN osv$mainframe_wired_heap^;
    FOR i := 1 TO UPPERBOUND (osv$family_table^) DO
      new_family_table^ [i] := osv$family_table^ [i];
    FOREND;
    FOR i := UPPERBOUND (osv$family_table^) + 1 TO UPPERBOUND (new_family_table^) DO
      new_family_table^ [i].family_name := osc$null_name;
    FOREND;

    new_family_table^ [UPPERBOUND (osv$family_table^) + 1].family_name := family;
    new_family_table^ [UPPERBOUND (osv$family_table^) + 1].set_name := set_name;
    new_family_table^ [UPPERBOUND (osv$family_table^) + 1].default_family_access := $dft$family_access [];
    new_family_table^ [UPPERBOUND (osv$family_table^) + 1].p_client_access_list := NIL;

    FREE osv$family_table IN osv$mainframe_wired_heap^;
    osv$family_table := new_family_table;
    osp$clear_mainframe_sig_lock (osv$family_table_lock);

  PROCEND osp$add_family;
?? TITLE := 'PROCEDURE [XDCL, #GATE] osp$check_client_leveled_access', EJECT ??
*copy osh$check_client_leveled_access

  PROCEDURE [XDCL, #GATE] osp$check_client_leveled_access
    (    family_name: ost$name;
     VAR leveled_access: boolean);

    VAR
      family_index: ost$non_negative_integers,
      p_current: ^dft$family_table_client_entry;

    leveled_access := FALSE;
    IF (osv$family_table = NIL) OR (family_name = osc$null_name) THEN
      RETURN;
    IFEND;

  /find_family/
    FOR family_index := 1 TO UPPERBOUND (osv$family_table^) DO
      IF (osv$family_table^ [family_index].family_name <> osc$null_name) AND
            (osv$family_table^ [family_index].family_name = family_name) THEN
        p_current := osv$family_table^ [family_index].p_client_access_list;

        WHILE (p_current <> NIL) AND (NOT leveled_access) DO
          leveled_access := (dfc$job_leveling_access IN p_current^.family_access);
          p_current := p_current^.p_next_client;
        WHILEND;

        EXIT /find_family/;
      IFEND;
    FOREND /find_family/;

  PROCEND osp$check_client_leveled_access;
?? TITLE := 'PROCEDURE osp$delete_family', EJECT ??

  PROCEDURE [XDCL, #GATE] osp$delete_family
    (    family: ost$name;
     VAR status: ost$status);

    VAR
      i: integer,
      p_current: ^dft$family_table_client_entry,
      p_next: ^dft$family_table_client_entry;

    osp$set_mainframe_sig_lock (osv$family_table_lock);

    IF osv$family_table = NIL THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family, family, status);
      osp$clear_mainframe_sig_lock (osv$family_table_lock);
      RETURN;
    IFEND;

    status.normal := TRUE;

    FOR i := 1 TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [i].family_name = family THEN
        osv$family_table^ [i].family_name := osc$null_name;
        p_current := osv$family_table^ [i].p_client_access_list;

        WHILE p_current <> NIL DO
          p_next := p_current^.p_next_client;
          FREE p_current IN osv$mainframe_wired_heap^;
          p_current := p_next;
        WHILEND;

        osv$family_table^ [i].set_name := osc$null_name;
        osp$clear_mainframe_sig_lock (osv$family_table_lock);
        RETURN;
      IFEND;
    FOREND;

    osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family, family, status);
    osp$clear_mainframe_sig_lock (osv$family_table_lock);

  PROCEND osp$delete_family;
?? TITLE := 'PROCEDURE osp$get_accessed_clients', EJECT ??
*copy osh$get_accessed_clients

  PROCEDURE [XDCL, #GATE] osp$get_accessed_clients
    (    p_binary_client_list {output} : ^array [1 .. * ] of pmt$binary_mainframe_id;
     VAR client_count: 0 .. dfc$maximum_partner_mainframes);

    VAR
      client_index: 0 .. dfc$maximum_partner_mainframes,
      family_index: ost$non_negative_integers,
      match: boolean,
      p_current: ^dft$family_table_client_entry;

    client_count := 0;

  /search_families/
    FOR family_index := LOWERBOUND (osv$family_table^) TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [family_index].family_name = osc$null_name THEN
        CYCLE /search_families/;
      IFEND;
      p_current := osv$family_table^ [family_index].p_client_access_list;

    /search_clients/
      WHILE p_current <> NIL DO
        match := FALSE;
      /check_for_match/
        FOR client_index := 1 to client_count DO
          IF p_current^.client_binary_id = p_binary_client_list^ [client_index] THEN
            match := TRUE;
            EXIT /check_for_match/;
          IFEND;
        FOREND /check_for_match/;
        IF NOT match THEN
          client_count := client_count + 1;
          IF p_binary_client_list <> NIL THEN
            IF UPPERBOUND (p_binary_client_list^) >= client_count THEN
              p_binary_client_list^ [client_count] := p_current^.client_binary_id;
            IFEND;
          IFEND;
        IFEND;
        p_current := p_current^.p_next_client;
      WHILEND /search_clients/;

    FOREND /search_families/;

  PROCEND osp$get_accessed_clients;
?? TITLE := 'PROCEDURE osp$get_accessed_families', EJECT ??
*copy osh$get_accessed_families

  PROCEDURE [XDCL, #GATE] osp$get_accessed_families
    (    p_family_list {output} : ^array [1 .. * ] of ost$family_name;
     VAR family_count: 0 .. dfc$max_family_ptr_array_size);

    VAR
      i: ost$non_negative_integers;

    family_count := 0;

    IF osv$family_table = NIL THEN
      RETURN;
    IFEND;

  /find_families/
    FOR i := 1 TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [i].family_name = osc$null_name THEN
        CYCLE /find_families/;
      IFEND;
      IF (osv$family_table^ [i].default_family_access <> $dft$family_access []) OR
            (osv$family_table^ [i].p_client_access_list <> NIL) THEN
        family_count := family_count + 1;
        IF p_family_list <> NIL THEN
          IF family_count <= UPPERBOUND (p_family_list^) THEN
            p_family_list^ [family_count] := osv$family_table^ [i].family_name;
          IFEND;
        IFEND;
      IFEND;
    FOREND /find_families/;

  PROCEND osp$get_accessed_families;
?? TITLE := 'PROCEDURE osp$get_client_family_access', EJECT ??
*copy osh$get_client_family_access

  PROCEDURE [XDCL, #GATE] osp$get_client_family_access
    (    client_binary_id: pmt$binary_mainframe_id;
         family_name: ost$family_name;
     VAR family_access: dft$family_access);

    VAR
      family_index: ost$non_negative_integers,
      p_current: ^dft$family_table_client_entry;

    family_access := $dft$family_access [];
    IF osv$family_table = NIL THEN
      RETURN;
    IFEND;

  /find_family/
    FOR family_index := 1 TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [family_index].family_name = family_name THEN
        family_access := osv$family_table^ [family_index].default_family_access;
        p_current := osv$family_table^ [family_index].p_client_access_list;

      /find_client/
        WHILE p_current <> NIL DO
          IF p_current^.client_binary_id = client_binary_id THEN
            family_access := p_current^.family_access;
            EXIT /find_client/;
          IFEND;
          p_current := p_current^.p_next_client;
        WHILEND /find_client/;

        EXIT /find_family/;
      IFEND;
    FOREND /find_family/;

  PROCEND osp$get_client_family_access;

?? TITLE := 'PROCEDURE osp$get_family_names_by_set', EJECT ??

{ PURPOSE:
{   This procedure returns a list of family names assigned to a
{   given set.


  PROCEDURE [XDCL, #GATE] osp$get_family_names_by_set
    (    set_name: stt$set_name;
     VAR family_names: pmt$family_name_list;
     VAR name_count: pmt$family_name_count;
     VAR status: ost$status);

    VAR
      i: integer;

    IF osv$family_table = NIL THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family, '', status);
      RETURN;
    IFEND;
    status.normal := TRUE;
    name_count := 0;

    FOR i := 1 TO UPPERBOUND (osv$family_table^) DO
      IF (osv$family_table^ [i].family_name <> osc$null_name) AND
           (osv$family_table^ [i].set_name = set_name) THEN
        name_count := name_count + 1;
        IF name_count <= UPPERBOUND (family_names) THEN
          family_names [name_count] := osv$family_table^ [i].family_name;
        IFEND;
      IFEND;
    FOREND;

  PROCEND osp$get_family_names_by_set;

?? TITLE := 'PROCEDURE osp$get_family_names', EJECT ??

  PROCEDURE [XDCL, #GATE] osp$get_family_names
    (VAR family_names: pmt$family_name_list;
     VAR name_count: pmt$family_name_count;
     VAR status: ost$status);

    VAR
      i: integer;

    IF osv$family_table = NIL THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family, '', status);
      RETURN;
    IFEND;

    status.normal := TRUE;
    name_count := 0;

    FOR i := 1 TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [i].family_name <> osc$null_name THEN
        name_count := name_count + 1;
        IF name_count <= UPPERBOUND (family_names) THEN
          family_names [name_count] := osv$family_table^ [i].family_name;
        IFEND;
      IFEND;
    FOREND;

  PROCEND osp$get_family_names;

?? TITLE := '  [XDCL, #GATE] osp$get_families_for_client', EJECT ??
*copy osh$get_families_for_client

  PROCEDURE [XDCL, #GATE] osp$get_families_for_client
    (    client_binary_id: pmt$binary_mainframe_id;
         p_family_list { output } : ^array [1 .. * ] of ost$family_name;
         p_access_list { output } : ^array [1 .. * ] of dft$family_access;
     VAR family_count: 0 .. dfc$max_family_ptr_array_size);


    VAR
      family_access: dft$family_access,
      family_index: integer,
      family_name: ost$family_name,
      p_current: ^dft$family_table_client_entry;

    family_count := 0;

  /search_families/
    FOR family_index := LOWERBOUND (osv$family_table^) TO UPPERBOUND (osv$family_table^) DO
      family_name := osv$family_table^ [family_index].family_name;
      IF family_name = osc$null_name THEN
        CYCLE /search_families/;
      IFEND;
      family_access := osv$family_table^ [family_index].default_family_access;
      p_current := osv$family_table^ [family_index].p_client_access_list;


    /search_clients/
      WHILE p_current <> NIL DO
        IF p_current^.client_binary_id = client_binary_id THEN
          family_access := p_current^.family_access;
          EXIT /search_clients/;
        IFEND;
        p_current := p_current^.p_next_client;
      WHILEND /search_clients/;

      IF family_access <> $dft$family_access [] THEN
        family_count := family_count + 1;
        IF p_family_list <> NIL THEN
          IF UPPERBOUND (p_family_list^) >= family_count THEN
            p_family_list^ [family_count] := family_name;
          IFEND;
        IFEND;
        IF p_access_list <> NIL THEN
          IF UPPERBOUND (p_access_list^) >= family_count THEN
            p_access_list^ [family_count] := family_access;
          IFEND;
        IFEND;
      IFEND;
    FOREND /search_families/;

  PROCEND osp$get_families_for_client;
?? TITLE := '    [XDCL, #GATE] osp$set_client_access', EJECT ??
*copy osh$set_client_access

  PROCEDURE [XDCL, #GATE] osp$set_client_access
    (    family: ost$family_name;
         family_access: dft$family_access;
         all_clients: boolean;
         p_binary_client_list: ^array [1 .. * ] of pmt$binary_mainframe_id;
         number_of_clients: 0 .. dfc$maximum_partner_mainframes;
     VAR status: ost$status);

    VAR
      family_index: integer,
      index: integer,
      p_client_entry: ^dft$family_table_client_entry,
      p_next_entry: ^dft$family_table_client_entry,
      p_set: ^array [1 .. * ] of boolean;

    IF osv$family_table = NIL THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family, family, status);
      RETURN;
    IFEND;

    status.normal := TRUE;

  /find/
    FOR family_index := 1 TO UPPERBOUND (osv$family_table^) DO
      IF osv$family_table^ [family_index].family_name = family THEN
        EXIT /find/;
      IFEND;
    FOREND /find/;

    IF osv$family_table^ [family_index].family_name <> family THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family, family, status);
      RETURN;
    IFEND;

    osp$set_mainframe_sig_lock (osv$family_table_lock);

    IF all_clients AND (osv$family_table^ [family_index].p_client_access_list = NIL) THEN
      osv$family_table^ [family_index].default_family_access := family_access;
      osp$clear_mainframe_sig_lock (osv$family_table_lock);
      RETURN;
    IFEND;

    IF (osv$family_table^ [family_index].p_client_access_list = NIL) THEN
      ALLOCATE p_client_entry IN osv$mainframe_wired_heap^;
      p_client_entry^.client_binary_id := p_binary_client_list^ [1];
      p_client_entry^.family_access := family_access;
      p_client_entry^.p_next_client := NIL;
      osv$family_table^ [family_index].p_client_access_list := p_client_entry;
    ELSE
      p_client_entry := osv$family_table^ [family_index].p_client_access_list;
    IFEND;

    IF all_clients THEN
      osv$family_table^ [family_index].default_family_access := family_access;
      WHILE p_client_entry <> NIL DO
        p_client_entry^.family_access := family_access;
        p_client_entry := p_client_entry^.p_next_client;
      WHILEND;
      osp$clear_mainframe_sig_lock (osv$family_table_lock);
      RETURN;
    IFEND;

{ There is at least one unique entry in the client list chain and the
{  client list specified contains at least one unique entry - not ALL.

{ p_client_entry points to the first entry in the linked list.

    p_next_entry := p_client_entry;
    PUSH p_set: [1 .. number_of_clients];
    FOR index := 1 TO number_of_clients DO
      p_set^ [index] := FALSE;
    FOREND;


{For each entry in the linked list, check if that client id is specifed.
{If so, update family access and flag the input entry as beiing set

    WHILE p_next_entry <> NIL DO
      p_client_entry := p_next_entry;

    /set_linked/
      FOR index := 1 TO number_of_clients DO
        IF p_client_entry^.client_binary_id = p_binary_client_list^ [index] THEN
          p_client_entry^.family_access := family_access;
          p_set^ [index] := TRUE;
          EXIT /set_linked/;
        IFEND;
      FOREND /set_linked/;

      p_next_entry := p_client_entry^.p_next_client;
    WHILEND;

{Add to the linked list any specified clients which are not linked

    FOR index := 1 TO number_of_clients DO
      IF NOT p_set^ [index] THEN
        ALLOCATE p_next_entry IN osv$mainframe_wired_heap^;
        p_next_entry^.client_binary_id := p_binary_client_list^ [index];
        p_next_entry^.family_access := family_access;
        p_next_entry^.p_next_client := NIL;
        p_client_entry^.p_next_client := p_next_entry;
        p_client_entry := p_next_entry;
      IFEND;
    FOREND;

    osp$clear_mainframe_sig_lock (osv$family_table_lock);

  PROCEND osp$set_client_access;

MODEND osm$family_manager
