?? NEWTITLE := '  NOS/VE Set Management ' ??
MODULE stm$modify_ast_r1;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains those procedure that modify the active set table.
{
{ DESIGN:
{   This modules live in system core library 113.
{   The pointer to the active set table is maintained as a static  pointer  in
{   this module.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ose$heap_full_exceptions
*copyc ste$error_condition_codes
*copyc ost$heap
*copyc ost$signature_lock
*copyc ost$status
*copyc ost$user_identification
*copyc ost$wait
*copyc rmt$recorded_vsn
*copyc stt$active_set_table
*copyc stt$dm_packet
*copyc stt$mel_index
?? POP ??
*copyc osp$append_status_parameter
*copyc osp$clear_mainframe_sig_lock
*copyc osp$initialize_sig_lock
*copyc osp$set_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc osp$test_set_main_sig_lock
*copyc osp$test_sig_lock
*copyc pmp$cycle
*copyc stp$members_active_on_set
*copyc osv$mainframe_pageable_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    stv$global_modify_lock: [XDCL] ost$signature_lock := [0],
    stv$global_read_lock_set: [XDCL] boolean := FALSE,
    stv$global_number_of_readers: [XDCL] integer := 0,
    stv$p_ast: [XDCL] ^stt$active_set_table := NIL;

?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$add_member_in_ast', EJECT ??
*copyc sth$add_member_in_ast

  PROCEDURE [XDCL, #GATE] stp$add_member_in_ast
    (    member_vol: rmt$recorded_vsn;
         member_internal_vsn: dmt$internal_vsn;
         members_activity: stt$vol_activity_status;
         members_avt_index: dmt$active_volume_table_index;
         ast_index: stt$ast_index;
         dm_packet_storage: stt$dm_packet_storage);

    VAR
      mel_index: stt$mel_index;

    stp$get_unused_mel_entry (ast_index, mel_index);
    stp$insert_member_into_mel (ast_index, mel_index, member_vol, member_internal_vsn, members_activity,
          members_avt_index, dm_packet_storage);

  PROCEND stp$add_member_in_ast;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$change_ast_access_status', EJECT ??
*copyc sth$change_ast_access_status

  PROCEDURE [XDCL, #GATE] stp$change_ast_access_status
    (    ast_index: stt$ast_index;
         access_status: stt$access_status;
     VAR status: ost$status);

    stv$p_ast^ [ast_index].access_status := access_status;
    status.normal := TRUE;

  PROCEND stp$change_ast_access_status;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$clear_ast_pf_lock', EJECT ??
*copyc sth$clear_ast_pf_lock

  PROCEDURE [XDCL, #GATE] stp$clear_ast_pf_lock
    (    ast_index: stt$ast_index;
     VAR status: ost$status);

    VAR
      lock_status: ost$signature_lock_status;

    osp$test_sig_lock (stv$p_ast^ [ast_index].pf_lock, lock_status);
    IF lock_status = osc$sls_not_locked THEN
      osp$set_status_abnormal (stc$set_management_id, ste$lock_not_set, stv$p_ast^ [ast_index].set_name,
            status);
    ELSE
      status.normal := TRUE;
      osp$clear_mainframe_sig_lock (stv$p_ast^ [ast_index].pf_lock);
    IFEND;

  PROCEND stp$clear_ast_pf_lock;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$clear_exclusive_access', EJECT ??
*copyc sth$clear_exclusive_access

  PROCEDURE [XDCL, #GATE] stp$clear_exclusive_access;

    osp$clear_mainframe_sig_lock (stv$global_modify_lock);

  PROCEND stp$clear_exclusive_access;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$clear_read_access', EJECT ??
*copyc sth$clear_read_access

  PROCEDURE [XDCL, #GATE] stp$clear_read_access;

    osp$set_mainframe_sig_lock (stv$global_modify_lock);
    stv$global_number_of_readers := stv$global_number_of_readers - 1;
    IF stv$global_number_of_readers < 0 THEN
      stv$global_number_of_readers := 0;
    IFEND;
    stv$global_read_lock_set := stv$global_number_of_readers > 0;

    osp$clear_mainframe_sig_lock (stv$global_modify_lock);

  PROCEND stp$clear_read_access;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$create_ast_entry', EJECT ??
*copyc sth$create_ast_entry

  PROCEDURE [XDCL, #GATE] stp$create_ast_entry
    (    set_name: stt$set_name;
         unique_set: stt$unique_set_name;
         master_vol: rmt$recorded_vsn;
         master_internal_vsn: dmt$internal_vsn;
         active_volume_table_index: dmt$active_volume_table_index;
         set_owner: ost$user_identification;
         access_status: stt$access_status;
         dm_packet_storage: stt$dm_packet_storage;
     VAR ast_index: stt$ast_index;
     VAR create_entry_status: ost$status);

    VAR
      entry_p: ^stt$active_set_entry;

    stp$get_unused_entry_in_ast (ast_index, create_entry_status);
    IF create_entry_status.normal THEN {space was found in the ast}
      entry_p := ^stv$p_ast^ [ast_index];
      entry_p^.entry_type := stc$valid;
      entry_p^.set_name := set_name;
      entry_p^.unique_set_name := unique_set;
      entry_p^.master_vsn := master_vol;
      entry_p^.master_internal_vsn := master_internal_vsn;
      entry_p^.access_status := access_status;
      entry_p^.p_member_entry_list := NIL;
      entry_p^.master_ever_up := TRUE;
      entry_p^.master_volume_activity.volume_activity_status := stc$active;
      entry_p^.master_volume_activity.avt_index := active_volume_table_index;
      entry_p^.set_owner := set_owner;
      entry_p^.number_of_jobs_using_set := 0;
      entry_p^.pf_root_ever_stored := FALSE;
      osp$initialize_sig_lock (entry_p^.pf_lock);
      entry_p^.master_dm_packet_storage := dm_packet_storage;
{     create_entry_status.normal := TRUE;
    IFEND;

  PROCEND stp$create_ast_entry;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$deallocate_ast_entry', EJECT ??
*copyc sth$deallocate_ast_entry

  PROCEDURE [XDCL, #GATE] stp$deallocate_ast_entry
    (    ast_index: stt$ast_index;
     VAR status: ost$status);

    VAR
      active_members_found: boolean;

    status.normal := TRUE;
    IF stv$p_ast^ [ast_index].number_of_jobs_using_set > 0 THEN
      osp$set_status_abnormal (stc$set_management_id, ste$jobs_on_set, stv$p_ast^ [ast_index].set_name,
            status);

    ELSEIF stv$p_ast^ [ast_index].master_volume_activity.volume_activity_status = stc$inactive THEN
      stp$members_active_on_set (ast_index, active_members_found);
      IF NOT active_members_found THEN
        stp$remove_set_from_ast (ast_index, status);
      IFEND;
    IFEND;

  PROCEND stp$deallocate_ast_entry;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$decrement_job_use_in_ast', EJECT ??
*copyc sth$decrement_job_use_in_ast

  PROCEDURE [XDCL, #GATE] stp$decrement_job_use_in_ast
    (    ast_index: stt$ast_index);

    stv$p_ast^ [ast_index].number_of_jobs_using_set := stv$p_ast^ [ast_index].number_of_jobs_using_set - 1;

  PROCEND stp$decrement_job_use_in_ast;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$get_unused_entry_in_ast', EJECT ??
*copyc sth$get_unused_entry_in_ast

  PROCEDURE [XDCL, #GATE] stp$get_unused_entry_in_ast
    (VAR ast_index: stt$ast_index;
     VAR status: ost$status);

    CONST
      stc$initial_ast_size = 3,
      stc$expand_ast_amount = 3;

    VAR
      p_new_ast: ^stt$active_set_table,
      p_old_ast: ^stt$active_set_table,
      space_found: boolean;

?? NEWTITLE := '[inline] p$initialize_ast_to_unused', EJECT ??

    PROCEDURE [INLINE] p$initialize_ast_to_unused
      (    stv$p_ast: ^stt$active_set_table);

{  PURPOSE:
{    This procedure initializes an active set table, to indicate that
{    all entries are unused.

      VAR
        ast_index: stt$ast_index;

      IF stv$p_ast <> NIL THEN
        FOR ast_index := 1 TO UPPERBOUND (stv$p_ast^) DO
          stv$p_ast^ [ast_index].entry_type := stc$unused;
        FOREND;
      IFEND;

    PROCEND p$initialize_ast_to_unused;
?? OLDTITLE ??
?? NEWTITLE := '[inline] p$transfer_old_to_new_ast', EJECT ??

    PROCEDURE [INLINE] p$transfer_old_to_new_ast
      (    p_old_ast: ^stt$active_set_table;
           p_new_ast: ^stt$active_set_table);

{  PURPOSE:
{    This procedure transfers an old active set table, to a new one.  The new
{    table must be equal to or larger than the old table.  If the new table
{    is larger, additional tables are initialized to indicate they are unused.

      VAR
        ast_index: stt$ast_index;

      FOR ast_index := 1 TO UPPERBOUND (p_old_ast^) DO
        p_new_ast^ [ast_index] := p_old_ast^ [ast_index];
      FOREND;
      FOR ast_index := (UPPERBOUND (p_old_ast^) + 1) TO UPPERBOUND (p_new_ast^) DO
        p_new_ast^ [ast_index].entry_type := stc$unused;
      FOREND;

    PROCEND p$transfer_old_to_new_ast;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;
    space_found := FALSE;
    IF stv$p_ast = NIL THEN
{     ALLOCATE A NEW ACTIVE SET TABLE
{     There must be a lock to prevent others from doing the expansion.
      ALLOCATE stv$p_ast: [1 .. stc$initial_ast_size] IN osv$mainframe_pageable_heap^;
      IF stv$p_ast = NIL THEN
        osp$set_status_abnormal (stc$set_management_id, ose$mainframe_pageable_full,
              stc$space_unavailable_ast, status);
      ELSE
        p$initialize_ast_to_unused (stv$p_ast);
        stp$search_ast_for_unused (stv$p_ast, ast_index, space_found);
      IFEND;
    ELSE
      stp$search_ast_for_unused (stv$p_ast, ast_index, space_found);
      IF NOT space_found THEN {expand the old table }
        ALLOCATE p_new_ast: [1 .. (UPPERBOUND (stv$p_ast^) + stc$expand_ast_amount)] IN
              osv$mainframe_pageable_heap^;
        IF p_new_ast = NIL THEN
          osp$set_status_abnormal (stc$set_management_id, ose$mainframe_pageable_full,
                stc$space_unavailable_ast, status);
        ELSE
          p$transfer_old_to_new_ast (stv$p_ast, p_new_ast);
          p_old_ast := stv$p_ast;
          stv$p_ast := p_new_ast;
          FREE p_old_ast IN osv$mainframe_pageable_heap^;
          stp$search_ast_for_unused (stv$p_ast, ast_index, space_found);
        IFEND;
      IFEND;
    IFEND;

  PROCEND stp$get_unused_entry_in_ast;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$get_unused_mel_entry', EJECT ??
*copyc sth$get_unused_mel_entry

  PROCEDURE [XDCL, #GATE] stp$get_unused_mel_entry
    (    ast_index: stt$ast_index;
     VAR mel_index: stt$mel_index);

    CONST
      stc$initial_mel_size = 8,
      stc$expand_mel_amount = 4;

    VAR
      p_new_mel: ^stt$member_entry_list,
      p_old_mel: ^stt$member_entry_list,
      unused_entry_found: boolean;

?? NEWTITLE := '[inline] p$search_mel_for_unused', EJECT ??

    PROCEDURE [INLINE] p$search_mel_for_unused
      (    p_mel: ^stt$member_entry_list;
       VAR mel_index: stt$mel_index;
       VAR unused_entry_found: boolean);

{  PURPOSE:
{    This procedure searches the member entry list of the active set table,
{    looking for an unused entry.  If an unused entry is found, the index
{    of the entry is returned.

      unused_entry_found := FALSE;
      IF p_mel <> NIL THEN
        FOR mel_index := LOWERBOUND (p_mel^) TO UPPERBOUND (p_mel^) DO
          IF p_mel^ [mel_index].entry_type = stc$unused THEN
            unused_entry_found := TRUE;
            RETURN; {----->
          IFEND;
        FOREND;
      IFEND;

    PROCEND p$search_mel_for_unused;
?? OLDTITLE ??
?? NEWTITLE := 'p$transfer_old_to_new_mel', EJECT ??

    PROCEDURE [INLINE] p$transfer_old_to_new_mel
      (    p_old_mel: ^stt$member_entry_list;
           p_new_mel: ^stt$member_entry_list);

{  PURPOSE:
{    This procedure transfers an old member entry list, to a new one.
{    The new member is assumed equal to or larger than the old member.
{    If the new is larger, additional entries are initialized to unused.

      VAR
        mel_index: stt$mel_index;

      FOR mel_index := (LOWERBOUND (p_old_mel^)) TO UPPERBOUND (p_old_mel^) DO
        p_new_mel^ [mel_index] := p_old_mel^ [mel_index];
      FOREND;
      FOR mel_index := (UPPERBOUND (p_old_mel^) + 1) TO UPPERBOUND (p_new_mel^) DO
        p_new_mel^ [mel_index].entry_type := stc$unused;
      FOREND;

    PROCEND p$transfer_old_to_new_mel;
?? OLDTITLE ??
?? NEWTITLE := 'p$initialize_mel_to_unused', EJECT ??

    PROCEDURE [INLINE] p$initialize_mel_to_unused
      (    p_mel: ^stt$member_entry_list);

{  PURPUSE:
{    This procedure initializes a member entry list to indicate that
{    all entries are unused.

      VAR
        mel_index: stt$mel_index;

      IF p_mel <> NIL THEN
        FOR mel_index := LOWERBOUND (p_mel^) TO UPPERBOUND (p_mel^) DO
          p_mel^ [mel_index].entry_type := stc$unused;
        FOREND;
      IFEND;

    PROCEND p$initialize_mel_to_unused;
?? OLDTITLE ??
?? EJECT ??

    IF stv$p_ast^ [ast_index].p_member_entry_list = NIL THEN
{
{     CREATE A NEW MEMBER ENTRY LIST
{
      ALLOCATE stv$p_ast^ [ast_index].p_member_entry_list: [1 .. stc$initial_mel_size] IN
            osv$mainframe_pageable_heap^;
      IF stv$p_ast^ [ast_index].p_member_entry_list = NIL THEN
        { Cant happen - the heap manager will force a system error.
      ELSE
        p$initialize_mel_to_unused (stv$p_ast^ [ast_index].p_member_entry_list);
        p$search_mel_for_unused (stv$p_ast^ [ast_index].p_member_entry_list, mel_index, unused_entry_found);
      IFEND;
    ELSE
      p$search_mel_for_unused (stv$p_ast^ [ast_index].p_member_entry_list, mel_index, unused_entry_found);
      IF NOT unused_entry_found THEN
        ALLOCATE p_new_mel: [1 .. (UPPERBOUND (stv$p_ast^ [ast_index].p_member_entry_list^) +
              stc$expand_mel_amount)] IN osv$mainframe_pageable_heap^;
        IF p_new_mel = NIL THEN
          { Cant happen - the heap manager will force a system error.
        ELSE
          p$transfer_old_to_new_mel (stv$p_ast^ [ast_index].p_member_entry_list, p_new_mel);
          p_old_mel := stv$p_ast^ [ast_index].p_member_entry_list;
          stv$p_ast^ [ast_index].p_member_entry_list := p_new_mel;
          FREE p_old_mel IN osv$mainframe_pageable_heap^;
          p$search_mel_for_unused (stv$p_ast^ [ast_index].p_member_entry_list, mel_index, unused_entry_found);
        IFEND;
      IFEND;
    IFEND;

  PROCEND stp$get_unused_mel_entry;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$inactive_master', EJECT ??
*copyc sth$inactivate_master

  PROCEDURE [XDCL, #GATE] stp$inactivate_master
    (    ast_index: stt$ast_index;
         dm_packet_storage: stt$dm_packet_storage;
     VAR status: ost$status);

    VAR
      entry_p: ^stt$active_set_entry;

    entry_p := ^stv$p_ast^ [ast_index];
    entry_p^.master_volume_activity.volume_activity_status := stc$inactive;
    entry_p^.master_dm_packet_storage := dm_packet_storage;
    status.normal := TRUE;

  PROCEND stp$inactivate_master;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$inactive_member', EJECT ??
*copyc sth$inactivate_member

  PROCEDURE [XDCL, #GATE] stp$inactivate_member
    (    ast_index: stt$ast_index;
         inactive_vol: rmt$recorded_vsn;
         internal_vsn: dmt$internal_vsn;
         dm_packet_storage: stt$dm_packet_storage;
     VAR status: ost$status);

    VAR
      entry_p: ^stt$active_set_entry,
      mel_index: stt$mel_index,
      member_entry: stt$member_entry,
      vol_found: boolean;

    entry_p := ^stv$p_ast^ [ast_index];
    IF entry_p^.p_member_entry_list = NIL THEN
      osp$set_status_abnormal (stc$set_management_id, ste$dm_mel_mismatch, inactive_vol, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, entry_p^.set_name, status);
    ELSE
      stp$search_mel_for_vol (inactive_vol, ast_index, member_entry, mel_index, vol_found);
      IF vol_found THEN
        IF member_entry.member_internal_vsn = internal_vsn THEN
          entry_p^.p_member_entry_list^ [mel_index].member_volume_activity.volume_activity_status :=
                stc$inactive;
          entry_p^.p_member_entry_list^ [mel_index].member_dm_packet_storage := dm_packet_storage;
          status.normal := TRUE;
        ELSE
          osp$set_status_abnormal (stc$set_management_id, ste$internal_vsn_mismatch, inactive_vol, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (stc$set_management_id, ste$dm_mel_mismatch, inactive_vol, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, entry_p^.set_name, status);
      IFEND;
    IFEND;

  PROCEND stp$inactivate_member;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$increment_job_count_in_ast', EJECT ??
*copyc sth$increment_job_count_in_ast

  PROCEDURE [XDCL, #GATE] stp$increment_job_count_in_ast
    (    ast_index: stt$ast_index;
     VAR status: ost$status);

    IF stv$p_ast^ [ast_index].entry_type = stc$valid THEN
      status.normal := TRUE;
      stv$p_ast^ [ast_index].number_of_jobs_using_set := stv$p_ast^ [ast_index].number_of_jobs_using_set + 1;
      {what about interlocks lock up entry }
    ELSE
      osp$set_status_abnormal (stc$set_management_id, ste$set_not_active, stc$null_parameter, status);
    IFEND;

  PROCEND stp$increment_job_count_in_ast;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$insert_member_into_mel', EJECT ??
*copyc sth$insert_member_into_mel

  PROCEDURE [XDCL, #GATE] stp$insert_member_into_mel
    (    ast_index: stt$ast_index;
         mel_index: stt$mel_index;
         member_vol: rmt$recorded_vsn;
         member_internal_vsn: dmt$internal_vsn;
         members_activity: stt$vol_activity_status;
         members_avt_index: dmt$active_volume_table_index;
         dm_packet_storage: stt$dm_packet_storage);

    VAR
      entry_p: ^stt$member_entry;

    entry_p := ^stv$p_ast^ [ast_index].p_member_entry_list^ [mel_index];
    entry_p^.entry_type := stc$valid;
    entry_p^.member_vsn := member_vol;
    entry_p^.member_internal_vsn := member_internal_vsn;
    entry_p^.member_volume_activity.volume_activity_status := members_activity;
    IF members_activity = stc$active THEN
      entry_p^.member_volume_activity.avt_index := members_avt_index;
    IFEND;
    entry_p^.member_dm_packet_storage := dm_packet_storage;

  PROCEND stp$insert_member_into_mel;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$obtain_ast_member_list', EJECT ??
*copyc sth$obtain_ast_member_list

  PROCEDURE [XDCL, #GATE] stp$obtain_ast_member_list
    (    ast_index: stt$ast_index;
     VAR ast_member_list: stt$member_entry_list;
     VAR ast_member_entry_list_size: integer);

    VAR
      input_list_size: integer,
      mel_index: integer,
      p_member_entry_list: ^stt$member_entry_list;

    p_member_entry_list := stv$p_ast^ [ast_index].p_member_entry_list;
    IF p_member_entry_list = NIL THEN
      ast_member_entry_list_size := 0;
    ELSE
      ast_member_entry_list_size := UPPERBOUND (p_member_entry_list^);
      input_list_size := UPPERBOUND (ast_member_list);

    /loop_through_member_list/
      FOR mel_index := 1 TO ast_member_entry_list_size DO
        IF mel_index > input_list_size THEN
          EXIT /loop_through_member_list/; {----->
        ELSE
          ast_member_list [mel_index] := p_member_entry_list^ [mel_index];
        IFEND;
      FOREND /loop_through_member_list/;
    IFEND;

  PROCEND stp$obtain_ast_member_list;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$purge_ast_pf_root', EJECT ??
*copyc sth$purge_ast_pf_root

  PROCEDURE [XDCL, #GATE] stp$purge_ast_pf_root
    (    ast_index: stt$ast_index);

    IF stv$p_ast^ [ast_index].pf_root_ever_stored AND (stv$p_ast^ [ast_index].p_pf_root <> NIL) THEN
      FREE stv$p_ast^ [ast_index].p_pf_root IN osv$mainframe_pageable_heap^;
    IFEND;
    stv$p_ast^ [ast_index].pf_root_ever_stored := FALSE;

  PROCEND stp$purge_ast_pf_root;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$remove_member_from_mel', EJECT ??
*copyc sth$remove_member_from_mel

  PROCEDURE [XDCL, #GATE] stp$remove_member_from_mel
    (    member_vol: rmt$recorded_vsn;
         ast_index: stt$ast_index;
     VAR status: ost$status);

    VAR
      mel_index: stt$mel_index,
      member_entry: stt$member_entry,
      vol_found: boolean;

    stp$search_mel_for_vol (member_vol, ast_index, member_entry, mel_index, vol_found);
    IF vol_found THEN
      stv$p_ast^ [ast_index].p_member_entry_list^ [mel_index].entry_type := stc$unused;
      status.normal := TRUE;
    ELSE
      osp$set_status_abnormal (stc$set_management_id, ste$member_not_in_mel, member_vol, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, stv$p_ast^ [ast_index].set_name, status);
    IFEND;

  PROCEND stp$remove_member_from_mel;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$remove_set_from_ast', EJECT ??
*copyc sth$remove_set_from_ast

  PROCEDURE [XDCL, #GATE] stp$remove_set_from_ast
    (    ast_index: stt$ast_index;
     VAR status: ost$status);

    IF stv$p_ast^ [ast_index].entry_type = stc$valid THEN
      IF stv$p_ast^ [ast_index].p_member_entry_list <> NIL THEN
        FREE stv$p_ast^ [ast_index].p_member_entry_list IN osv$mainframe_pageable_heap^;
      IFEND;
      IF stv$p_ast^ [ast_index].pf_root_ever_stored AND (stv$p_ast^ [ast_index].p_pf_root <> NIL) THEN
        FREE stv$p_ast^ [ast_index].p_pf_root IN osv$mainframe_pageable_heap^;
      IFEND;
    IFEND;
    status.normal := TRUE;
    stv$p_ast^ [ast_index].entry_type := stc$unused;

  PROCEND stp$remove_set_from_ast;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] stp$search_ast_for_unused', EJECT ??

  PROCEDURE [XDCL] stp$search_ast_for_unused
    (    stv$p_ast: ^stt$active_set_table;
     VAR ast_index: stt$ast_index;
     VAR unused_found: boolean);

{  PURPOSE:
{   This procedure searches the active set table looking for an unused
{    table entry.  The unused index number is returned.

    VAR
      upper: stt$ast_index;

    unused_found := FALSE;
    IF stv$p_ast <> NIL THEN
      ast_index := 1;
      upper := UPPERBOUND (stv$p_ast^);
      WHILE NOT unused_found AND (ast_index <= upper) DO
        IF stv$p_ast^ [ast_index].entry_type = stc$unused THEN
          unused_found := TRUE;
        ELSE
          ast_index := ast_index + 1;
        IFEND;
      WHILEND;
    IFEND;

  PROCEND stp$search_ast_for_unused;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$search_mel_for_vol', EJECT ??
*copyc sth$search_mel_for_vol

  PROCEDURE [XDCL, #GATE] stp$search_mel_for_vol
    (    member_vol: rmt$recorded_vsn;
         ast_index: stt$ast_index;
     VAR member_entry: stt$member_entry;
     VAR mel_index: stt$mel_index;
     VAR volume_found: boolean);

    VAR
      p_mel: ^stt$member_entry_list;

    volume_found := FALSE;
    p_mel := stv$p_ast^ [ast_index].p_member_entry_list;
    IF p_mel <> NIL THEN
      FOR mel_index := LOWERBOUND (p_mel^) TO UPPERBOUND (p_mel^) DO
        IF p_mel^ [mel_index].entry_type = stc$valid THEN
          IF p_mel^ [mel_index].member_vsn = member_vol THEN
            member_entry := p_mel^ [mel_index];
            volume_found := TRUE;
            RETURN; {----->
          IFEND;
        IFEND;
      FOREND;
    IFEND;

  PROCEND stp$search_mel_for_vol;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$store_ast_pf_lock', EJECT ??
*copyc sth$set_ast_pf_lock

  PROCEDURE [XDCL, #GATE] stp$set_ast_pf_lock
    (    ast_index: stt$ast_index;
     VAR status: ost$status);

    VAR
      lock_status: ost$signature_lock_status,
      locked: boolean;

    status.normal := TRUE;
    osp$test_sig_lock (stv$p_ast^ [ast_index].pf_lock, lock_status);
    IF lock_status = osc$sls_locked_by_current_task THEN
      osp$set_status_abnormal (stc$set_management_id, ste$lock_set_in_task, stv$p_ast^ [ast_index].set_name,
            status);
    ELSEIF lock_status = osc$sls_locked_by_another_task THEN
      osp$set_status_abnormal (stc$set_management_id, ste$lock_set_in_another_task,
            stv$p_ast^ [ast_index].set_name, status);
    ELSE
      osp$test_set_main_sig_lock (stv$p_ast^ [ast_index].pf_lock, locked);
    IFEND;

  PROCEND stp$set_ast_pf_lock;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$set_exclusive_access', EJECT ??
*copyc sth$set_exclusive_access

  PROCEDURE [XDCL, #GATE] stp$set_exclusive_access;

    VAR
      local_status: ost$status,
      need_to_wait: boolean;

?? NEWTITLE := 'p$set_exclusive_access_in_ast', EJECT ??

    PROCEDURE p$set_exclusive_access_in_ast
      (VAR need_to_wait: boolean);

      osp$set_mainframe_sig_lock (stv$global_modify_lock);
      need_to_wait := stv$global_read_lock_set;
      IF need_to_wait THEN
        {dont wait with the lock set }
        osp$clear_mainframe_sig_lock (stv$global_modify_lock);
      IFEND;

    PROCEND p$set_exclusive_access_in_ast;
?? OLDTITLE ??
?? EJECT ??

    p$set_exclusive_access_in_ast (need_to_wait);
    WHILE need_to_wait DO
      pmp$cycle (local_status);
      p$set_exclusive_access_in_ast (need_to_wait);
    WHILEND;

  PROCEND stp$set_exclusive_access;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$set_read_access', EJECT ??
*copyc sth$set_read_access

  PROCEDURE [XDCL, #GATE] stp$set_read_access;

    osp$set_mainframe_sig_lock (stv$global_modify_lock);
    stv$global_read_lock_set := TRUE;
    stv$global_number_of_readers := stv$global_number_of_readers + 1;
    osp$clear_mainframe_sig_lock (stv$global_modify_lock);

  PROCEND stp$set_read_access;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$store_ast_master_header', EJECT ??
*copyc sth$store_ast_master_header

  PROCEDURE [XDCL, #GATE] stp$store_ast_master_header
    (    ast_index: stt$ast_index;
         masters_avt_index: dmt$active_volume_table_index;
         set_owner: ost$user_identification;
         dm_packet_storage: stt$dm_packet_storage;
         pf_root_stored: boolean;
         pf_root: pft$root;
     VAR status: ost$status);

    VAR
      entry_p: ^stt$active_set_entry;

    status.normal := TRUE;
    entry_p := ^stv$p_ast^ [ast_index];
    IF NOT entry_p^.master_ever_up THEN
      entry_p^.master_ever_up := TRUE;
      entry_p^.number_of_jobs_using_set := 0;
      entry_p^.pf_root_ever_stored := FALSE;
    IFEND;
    entry_p^.master_volume_activity.volume_activity_status := stc$active;
    entry_p^.master_volume_activity.avt_index := masters_avt_index;
    entry_p^.set_owner := set_owner;
    osp$initialize_sig_lock (entry_p^.pf_lock);
    entry_p^.master_dm_packet_storage := dm_packet_storage;
    IF pf_root_stored THEN
      stp$store_ast_pf_root (ast_index, pf_root, status);
    IFEND;

  PROCEND stp$store_ast_master_header;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$store_ast_pf_root', EJECT ??
*copyc sth$store_ast_pf_root

  PROCEDURE [XDCL, #GATE] stp$store_ast_pf_root
    (    ast_index: stt$ast_index;
         pf_root: pft$root;
     VAR status: ost$status);

    VAR
      entry_p: ^stt$active_set_entry,
      new_size: pft$root_size,
      p_new_pf_root: ^pft$root;

    status.normal := TRUE;
    new_size := #SIZE (pf_root);
    ALLOCATE p_new_pf_root: [[REP new_size OF cell]] IN osv$mainframe_pageable_heap^;
    IF p_new_pf_root = NIL THEN
      osp$set_status_abnormal (stc$set_management_id, ose$mainframe_pageable_full, stc$space_unavailable_ast,
            status);
    ELSE
      entry_p := ^stv$p_ast^ [ast_index];
      IF entry_p^.pf_root_ever_stored AND (entry_p^.p_pf_root <> NIL) THEN
        FREE entry_p^.p_pf_root IN osv$mainframe_pageable_heap^;
      IFEND;
      entry_p^.pf_root_ever_stored := TRUE;
      entry_p^.pf_root_size := new_size;
      entry_p^.p_pf_root := p_new_pf_root;
      entry_p^.p_pf_root^ := pf_root;
    IFEND;

  PROCEND stp$store_ast_pf_root;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$store_dm_packet_in_mel', EJECT ??
*copyc sth$store_dm_packet_in_mel

  PROCEDURE [XDCL, #GATE] stp$store_dm_packet_in_mel
    (    ast_index: stt$ast_index;
         mel_index: stt$mel_index;
         dm_packet_storage: stt$dm_packet_storage);

    stv$p_ast^ [ast_index].p_member_entry_list^ [mel_index].member_dm_packet_storage := dm_packet_storage;

  PROCEND stp$store_dm_packet_in_mel;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$store_inactive_master', EJECT ??
*copyc sth$store_inactive_master

  PROCEDURE [XDCL, #GATE] stp$store_inactive_master
    (    set_name: stt$set_name;
         unique_set_name: stt$unique_set_name;
         master_vsn: rmt$recorded_vsn;
         internal_vsn: dmt$internal_vsn;
         access_status: stt$access_status;
         ast_index: stt$ast_index);

    VAR
      entry_p: ^stt$active_set_entry;

    entry_p := ^stv$p_ast^ [ast_index];

    entry_p^.entry_type := stc$valid;
    entry_p^.set_name := set_name;
    entry_p^.unique_set_name := unique_set_name;
    entry_p^.p_member_entry_list := NIL;
    entry_p^.access_status := access_status;
    entry_p^.master_vsn := master_vsn;
    entry_p^.master_internal_vsn := internal_vsn;
    entry_p^.master_ever_up := FALSE;

  PROCEND stp$store_inactive_master;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] stp$update_system_set_name', EJECT ??
*copyc stv$system_set_name

  PROCEDURE [XDCL, #GATE] stp$update_system_set_name
    (    set_name: stt$set_name);

    stv$system_set_name := set_name;

  PROCEND stp$update_system_set_name;
?? OLDTITLE ??
MODEND stm$modify_ast_r1;
