?? TITLE := 'NOS/VE Permanent Files : Catalog Access Methods' ??
MODULE pfm$catalog_access_methods;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains the interfaces to access the various pieces contained
{   in the catalogs.

?? NEWTITLE := '  Global Declarations Referenced by this module' ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc pfc$family_path_index
*copyc pfc$master_catalog_path_index
*copyc pfc$maximum_cycle_number
*copyc pfc$minimum_cycle_number
*copyc dfd$file_server_info
*copyc pfe$error_condition_codes
*copyc pfe$internal_error_conditions
*copyc pft$catalog_path_index
*copyc pft$cycle_selector
*copyc pft$file_path_index
*copyc pft$group
*copyc pft$log_index
*copyc pft$object_index
*copyc pft$p_cycle
*copyc pft$p_log
*copyc pft$p_log_list
*copyc pft$p_queued_internal_catalog
*copyc pft$password_selector
*copyc pft$permit_index
*copyc pft$selections_string
*copyc pft$share_selections
?? POP ??
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$recoverable_system_error
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pfp$allocate_cycle_list
*copyc pfp$attach_catalog
*copyc pfp$attach_last_queued_catalog
*copyc pfp$attach_root_catalog
*copyc pfp$build_fmd_pointer
*copyc pfp$build_object_list_locator
*copyc pfp$build_object_list_pointer
*copyc pfp$build_permit_list_pointer
*copyc pfp$compute_checksum
*copyc pfp$convert_pf_path_to_fs_path
*copyc pfp$establish_free_object_entry
*copyc pfp$get_queued_catalog
*copyc pfp$get_root_attached
*copyc pfp$locate_object
*copyc pfp$locate_specific_cycle
*copyc pfp$log_ascii
*copyc pfp$log_path
*copyc pfp$open_attached_catalog
*copyc pfp$physically_attach_catalog
*copyc pfp$process_unexpected_status
*copyc pfp$release_locked_apfid
*copyc pfp$report_system_error
*copyc pfp$return_catalog
*copyc pfp$set_status_abnormal
*copyc pfp$validate_password
*copyc pmp$continue_to_cause
*copyc pmp$get_account_project
*copyc pmp$get_user_identification
*copyc stp$get_set_owner
*copyc dfv$file_server_info_enabled
*copyc osv$catalog_name_security
*copyc osv$system_family_name
*copyc pfv$locked_apfid
*copyc pfv$locked_catalog_list
*copyc pfv$p_p_job_heap
*copyc i#move
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by this module', EJECT ??

  CONST
    include_radix = TRUE,
    radix = 10;

  VAR
    null_permit_entry: [oss$job_paged_literal, READ] pft$permit_entry := [pfc$free_permit_entry];

?? OLDTITLE ??
?? NEWTITLE := '  [INLINE] f$highest_cycle', EJECT ??

  FUNCTION [INLINE] f$highest_cycle
    (    p_cycle_list: {input} pft$p_cycle_list): pft$p_cycle;

    VAR
      cycle_entry_p: ^pft$physical_cycle,
      cycle_index: pft$cycle_index,
      highest_cycle_number: fst$cycle_number;

    f$highest_cycle := NIL;

    IF p_cycle_list <> NIL THEN
      highest_cycle_number := pfc$minimum_cycle_number;

      FOR cycle_index := 1 TO UPPERBOUND (p_cycle_list^) DO
        cycle_entry_p := ^p_cycle_list^ [cycle_index];
        IF (cycle_entry_p^.cycle_entry.entry_type = pfc$normal_cycle_entry)
{     } AND (cycle_entry_p^.cycle_entry.cycle_number >= highest_cycle_number) THEN
          highest_cycle_number := cycle_entry_p^.cycle_entry.cycle_number;
          f$highest_cycle := cycle_entry_p;
        IFEND;
      FOREND;
    IFEND;

  FUNCEND f$highest_cycle;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] f$lowest_cycle', EJECT ??

  FUNCTION [INLINE] f$lowest_cycle
    (    p_cycle_list: {input} pft$p_cycle_list): pft$p_cycle;

    VAR
      cycle_entry_p: ^pft$physical_cycle,
      cycle_index: pft$cycle_index,
      lowest_cycle_number: fst$cycle_number;

    f$lowest_cycle := NIL;

    IF p_cycle_list <> NIL THEN
      lowest_cycle_number := pfc$maximum_cycle_number;

      FOR cycle_index := 1 TO UPPERBOUND (p_cycle_list^) DO
        cycle_entry_p := ^p_cycle_list^ [cycle_index];
        IF (cycle_entry_p^.cycle_entry.entry_type = pfc$normal_cycle_entry)
{     } AND (cycle_entry_p^.cycle_entry.cycle_number <= lowest_cycle_number) THEN
          lowest_cycle_number := cycle_entry_p^.cycle_entry.cycle_number;
          f$lowest_cycle := cycle_entry_p;
        IFEND;
      FOREND;
    IFEND;

  FUNCEND f$lowest_cycle;
?? OLDTITLE ??
?? NEWTITLE := '  [INLINE] locate_internal_catalog', EJECT ??

  FUNCTION [INLINE] locate_internal_catalog
    (    catalog: pft$name;
         parent: pft$internal_catalog_name;
         p_internal_catalog_list: {input} pft$p_queued_internal_catalog): pft$p_queued_internal_catalog;

    VAR
      found_internal_catalog: pft$p_queued_internal_catalog;

    found_internal_catalog := p_internal_catalog_list;

    WHILE found_internal_catalog <> NIL DO
      IF (found_internal_catalog^.external_catalog_name = catalog) AND
            (found_internal_catalog^.parent_catalog_name = parent) THEN { Catalog found.
        locate_internal_catalog := found_internal_catalog;
        RETURN; {----->
      ELSE
        found_internal_catalog := found_internal_catalog^.p_next_internal_catalog;
      IFEND;
    WHILEND;
    locate_internal_catalog := found_internal_catalog;

  FUNCEND locate_internal_catalog;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$access_last_object', EJECT ??

  PROCEDURE [XDCL] pfp$access_last_object
    (    path: pft$complete_path;
         authority: pft$authority;
         valid_objects: pft$object_selections;
     VAR catalog_locator: {i/o} pft$catalog_locator;
     VAR permit_entry: {i/o} pft$permit_entry;
     VAR p_object: {output} pft$p_object;
     VAR internal_name: pft$internal_name;
     VAR status: ost$status);

    VAR
      extracted_permit: pft$permit_entry,
      fs_path: fst$path,
      fs_path_size: fst$path_size,
      last_index: pft$array_index,
      new_valid_objects: pft$object_selections;

    last_index := UPPERBOUND (path);

    {
    { This call to access_next_object is to locate objects that already exist.
    { Therefore, pfc$free_object is deleted from the set of valid objects. If the
    { object does not exist a call to pfp$establish_free_object_entry will be used
    { to locate a free object.
    {
    new_valid_objects := (valid_objects - $pft$object_selections [pfc$free_object]) +
          $pft$object_selections [pfc$file_object, pfc$catalog_object];

    access_next_object (catalog_locator.object_list_descriptor, path [last_index], new_valid_objects,
          authority, catalog_locator.p_catalog_file, p_object, extracted_permit);
    IF p_object <> NIL THEN
      p$reduce_permits (permit_entry, extracted_permit, permit_entry);
    IFEND;

    IF (p_object <> NIL)
{ } AND ((authority.ownership <> $pft$ownership []) OR ((permit_entry.entry_type =
          pfc$normal_permit_entry) AND (permit_entry.usage_permissions <> $pft$permit_selections [])) OR
          (p_object^.object_entry.object_type = pfc$catalog_object)) THEN
      { known and (permitted_object or catalog)
      IF p_object^.object_entry.object_type IN valid_objects THEN
        internal_name := p_object^.object_entry.internal_object_name;
        status.normal := TRUE;
      ELSE
        pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);

        IF valid_objects = $pft$object_selections [pfc$catalog_object] THEN
          IF osv$catalog_name_security AND (authority.ownership = $pft$ownership []) AND
                ((permit_entry.entry_type = pfc$free_permit_entry) OR
                (permit_entry.usage_permissions = $pft$permit_selections [])) THEN
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_last_subcatalog,
                  fs_path (1, fs_path_size), status);
          ELSE
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$last_name_not_subcatalog,
                  fs_path (1, fs_path_size), status);
          IFEND;
        ELSEIF valid_objects = $pft$object_selections [pfc$file_object] THEN
          IF osv$catalog_name_security AND (authority.ownership = $pft$ownership []) AND
                ((permit_entry.entry_type = pfc$free_permit_entry) OR
                (permit_entry.usage_permissions = $pft$permit_selections [])) THEN
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_permanent_file,
                  fs_path (1, fs_path_size), status);
          ELSE
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$name_not_permanent_file,
                  fs_path (1, fs_path_size), status);
          IFEND;
        ELSEIF p_object^.object_entry.object_type = pfc$file_object THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$name_already_permanent_file,
                fs_path (1, fs_path_size), status);
        ELSE
          CASE last_index OF
          = pfc$family_path_index =
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$duplicate_family_catalog,
                  fs_path (1, fs_path_size), status);
          = pfc$master_catalog_path_index =
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$duplicate_master_catalog,
                  fs_path (1, fs_path_size), status);
          ELSE
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$name_already_subcatalog,
                  fs_path (1, fs_path_size), status);
          CASEND;
        IFEND;
      IFEND;
    ELSE {unknown object or unpermitted file}
      IF (p_object = NIL) AND (pfc$free_object IN valid_objects) THEN
        pfp$establish_free_object_entry (^path, catalog_locator.p_catalog_file,
              catalog_locator.object_list_descriptor, p_object, status);
      ELSEIF valid_objects <= $pft$object_selections [pfc$catalog_object, pfc$purged_catalog_object] THEN
        IF (p_object <> NIL) AND (p_object^.object_entry.object_type IN valid_objects) THEN
          internal_name := p_object^.object_entry.internal_object_name;
          status.normal := TRUE;
        ELSE
          pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
          CASE last_index OF
          = pfc$family_path_index =
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_family,
                  fs_path (1, fs_path_size), status);
          = pfc$master_catalog_path_index =
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_master_catalog,
                  fs_path (1, fs_path_size), status);
          ELSE
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_last_subcatalog,
                  fs_path (1, fs_path_size), status);
          CASEND;
        IFEND;
      ELSE
        pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);

        IF valid_objects <= $pft$object_selections [pfc$file_object, pfc$purged_file_object] THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_permanent_file,
                fs_path (1, fs_path_size), status);
        ELSEIF p_object = NIL THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_item, fs_path (1, fs_path_size),
                status);
        ELSE
          CASE last_index OF
          = pfc$family_path_index =
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$duplicate_family_catalog,
                  fs_path (1, fs_path_size), status);
          = pfc$master_catalog_path_index =
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$duplicate_master_catalog,
                  fs_path (1, fs_path_size), status);
          ELSE
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_permanent_file,
                  fs_path (1, fs_path_size), status);
          CASEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND pfp$access_last_object;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$access_next_catalog', EJECT ??

  PROCEDURE [XDCL] pfp$access_next_catalog
    (    access_kind: pft$access_kind;
         last_catalog_locator: pft$catalog_locator;
         p_catalog_object: {input} pft$p_object;
         catalog_remote: boolean;
     VAR next_catalog_locator: pft$catalog_locator;
     VAR status: ost$status);

    VAR
      p_physical_fmd: pft$p_physical_fmd;

    IF p_catalog_object^.object_entry.catalog_object_locator.catalog_type = pfc$internal_catalog THEN
      next_catalog_locator := last_catalog_locator;
      pfp$build_object_list_pointer (p_catalog_object^.object_entry.catalog_object_locator.
            object_list_locator, last_catalog_locator.p_catalog_file,
            next_catalog_locator.object_list_descriptor.p_object_list);
      next_catalog_locator.object_list_descriptor.sorted_object_count :=
            p_catalog_object^.object_entry.catalog_object_locator.object_list_locator.sorted_object_count;
      next_catalog_locator.object_list_descriptor.free_sorted_object_count :=
            p_catalog_object^.object_entry.catalog_object_locator.object_list_locator.
            free_sorted_object_count;
      next_catalog_locator.object_list_descriptor.catalog_type := pfc$internal_catalog;
      next_catalog_locator.object_list_descriptor.p_parent_catalog := p_catalog_object;
      status.normal := TRUE;
    ELSE {external catalog}
      pfp$build_fmd_pointer (p_catalog_object^.object_entry.catalog_object_locator.fmd_locator,
            last_catalog_locator.p_catalog_file, p_physical_fmd);
      IF p_physical_fmd = NIL THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
              ' NIL catalog FMD in pfp$access_next_catalog', status);
      ELSE
        pfp$attach_catalog (^p_physical_fmd^.fmd, last_catalog_locator.set_name,
              p_catalog_object^.object_entry.internal_object_name,
              p_catalog_object^.object_entry.catalog_object_locator.global_file_name, access_kind,
              catalog_remote, next_catalog_locator, status);
      IFEND;
    IFEND;

  PROCEND pfp$access_next_catalog;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$access_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to establish access to the object
{   specified by the path parameter.  This includes extracting permit
{   information that may apply.
{
{ DESIGN:
{   The valid_objects parameter allows the selection of object type checking
{   options.  If the type of the object does not match the valid types, an
{   appropriate abnormal status is returned.  If the object is unknown and a
{   free object is selected as valid, the p_object parameter is set to point to
{   a free object entry.  This feature can be used to create new, uniquely
{   named, objects.  An internal path of internal names, starting with the
{   unique set name, is also built in this routine.

  PROCEDURE [XDCL] pfp$access_object
    (    path: pft$complete_path;
         access_kind: pft$access_kind;
         authority: pft$authority;
         valid_objects: pft$object_selections;
     VAR parent_charge_id: pft$charge_id;
     VAR catalog_locator: pft$catalog_locator;
     VAR p_physical_object: {output} ^pft$physical_object;
     VAR internal_path: pft$internal_path;
     VAR permit_entry: pft$permit_entry;
     VAR status: ost$status);

    VAR
      last_catalog_index: pft$catalog_path_index,
      ignore_status: ost$status,
      p_parent_path: ^pft$complete_path,
      path_index: pft$catalog_path_index,
      process_non_local_exit: boolean,
      variant_path: pft$variant_path;

?? NEWTITLE := 'ACCESS_OBJECT_HANDLER', EJECT ??

    PROCEDURE access_object_handler
      (    condition: pmt$condition;
           p_condition_info: ^pmt$condition_information;
           p_sfsa: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        variant_path: pft$variant_path,
        status_id: ost$status_identifier,
        local_status: ost$status;

      variant_path.complete_path := TRUE;
      variant_path.p_complete_path := ^path;

      IF NOT process_non_local_exit THEN
        pfp$log_ascii ('***PF Condition Handler***', $pmt$ascii_logset [pmc$system_log, pmc$job_log],
              pmc$msg_origin_system, {critical_message} FALSE, local_status);
        pfp$log_path (variant_path, $pmt$ascii_logset [pmc$system_log, pmc$job_log], pmc$msg_origin_system,
              {critical_message} FALSE, local_status);
      IFEND;

      CASE condition.selector OF
      = pmc$system_conditions, pmc$block_exit_processing, mmc$segment_access_condition =
        IF process_non_local_exit THEN
          RETURN; {----->
        IFEND;

        IF catalog_locator.attached THEN
          catalog_locator.abort_catalog_operation := TRUE;
          pfp$return_catalog (catalog_locator, local_status);
          IF NOT local_status.normal THEN
            pfp$report_system_error (local_status);
          IFEND;
        IFEND;

        osp$set_status_from_condition (status_id, condition, p_sfsa, local_status, handler_status);
        osp$recoverable_system_error ('UNEXPECTED STATUS', ^local_status);

        status := local_status;
        initiate_non_local_exit;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          {syp$invalidate_open_sfid (catalog_locator.system_file_id, local_status);
          initiate_non_local_exit;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      CASEND;

    PROCEND access_object_handler;
?? OLDTITLE ??
?? NEWTITLE := 'INITIATE_NON_LOCAL_EXIT', EJECT ??

    PROCEDURE initiate_non_local_exit;

      process_non_local_exit := TRUE;
      #SPOIL (process_non_local_exit);
      EXIT pfp$access_object; {----->

    PROCEND initiate_non_local_exit;
?? OLDTITLE ??
?? EJECT ??
{ Check parameters.
    IF valid_objects = $pft$object_selections [] THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
            'No object selections specified.', status);
      RETURN; {----->
    IFEND;
    IF (pfc$free_object IN valid_objects) AND (access_kind = pfc$read_access) THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
            'Free object selected with read access.', status);
      RETURN; {----->
    IFEND;

    last_catalog_index := UPPERBOUND (path) - 1;
    PUSH p_parent_path: [1 .. last_catalog_index];
    FOR path_index := 1 TO last_catalog_index DO
      p_parent_path^ [path_index] := path [path_index];
    FOREND;

    catalog_locator.attached := FALSE;
    osp$establish_condition_handler (^access_object_handler, {block_exit} TRUE);

    pfp$get_catalog (p_parent_path^, access_kind, authority, internal_path, parent_charge_id, permit_entry,
          catalog_locator, status);
    IF status.normal THEN
      pfp$access_last_object (path, authority, valid_objects, catalog_locator, permit_entry,
            p_physical_object, internal_path [UPPERBOUND (internal_path)], status);
      IF NOT status.normal THEN
        catalog_locator.flush_catalog_pages := FALSE;
        pfp$return_catalog (catalog_locator, ignore_status);
        pfp$process_unexpected_status (ignore_status);
      IFEND;
    ELSEIF (status.condition = pfe$unknown_last_subcatalog) AND
          ((pfc$free_object IN valid_objects) OR (pfc$catalog_object IN valid_objects) OR
          (pfc$purged_catalog_object IN valid_objects)) THEN
      variant_path.complete_path := TRUE;
      variant_path.p_complete_path := p_parent_path;
      pfp$set_status_abnormal (variant_path, pfe$unknown_nth_subcatalog, status);
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND pfp$access_object;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$build_permit_selections_str', EJECT ??

  PROCEDURE [XDCL] pfp$build_permit_selections_str
    (    permit_selections: pft$permit_selections;
     VAR permit_string: pft$selections_string);

    VAR
      first_match: boolean,
      permit_option: pft$permit_options;

    IF permit_selections = $pft$permit_selections [] THEN
      permit_string.value := 'null set';
      permit_string.size := 8;
    ELSE
      first_match := TRUE;

      FOR permit_option := pfc$read TO pfc$control DO
        IF permit_option IN permit_selections THEN
          IF first_match THEN
            permit_string.value := '[';
            permit_string.size := 1;
            first_match := FALSE;
          ELSE
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  ', ');
          IFEND;

          CASE permit_option OF
          = pfc$read =
            permit_string.value (2, 4) := 'READ';
            permit_string.size := 5;
          = pfc$shorten =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'SHORTEN');
          = pfc$append =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'APPEND');
          = pfc$modify =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'MODIFY');
          = pfc$execute =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'EXECUTE');
          = pfc$cycle =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'CYCLE');
          = pfc$control =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'CONTROL');
          ELSE
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'invalid option');
          CASEND;
        IFEND;
      FOREND;

      STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size), ']');
    IFEND;

  PROCEND pfp$build_permit_selections_str;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$build_share_selections_str', EJECT ??

  PROCEDURE [XDCL] pfp$build_share_selections_str
    (    share_selections: pft$share_selections;
     VAR share_string: pft$selections_string);

    VAR
      first_match: boolean,
      share_option: pft$share_options;

    IF share_selections = $pft$share_selections [] THEN
      share_string.value := 'null set';
      share_string.size := 8;
    ELSE
      first_match := TRUE;

      FOR share_option := pfc$read TO pfc$execute DO
        IF share_option IN share_selections THEN
          IF first_match THEN
            share_string.value := '[';
            share_string.size := 1;
            first_match := FALSE;
          ELSE
            STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size),
                  ', ');
          IFEND;

          CASE share_option OF
          = pfc$read =
            share_string.value (2, 4) := 'READ';
            share_string.size := 5;
          = pfc$shorten =
            STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size),
                  'SHORTEN');
          = pfc$append =
            STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size),
                  'APPEND');
          = pfc$modify =
            STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size),
                  'MODIFY');
          = pfc$execute =
            STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size),
                  'EXECUTE');
          ELSE
            STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size),
                  'invalid option');
          CASEND;
        IFEND;
      FOREND;

      STRINGREP (share_string.value, share_string.size, share_string.value (1, share_string.size), ']');
    IFEND;

  PROCEND pfp$build_share_selections_str;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$determine_new_cycle_number', EJECT ??

  PROCEDURE [XDCL] pfp$determine_new_cycle_number
    (    path: pft$complete_path;
         p_cycle_list: {input} pft$p_cycle_list;
         cycle_selector: pft$cycle_selector;
     VAR new_cycle_number: fst$cycle_number;
     VAR status: ost$status);

    VAR
      fs_path: fst$path,
      fs_path_size: fst$path_size,
      p_cycle: pft$p_cycle;

    CASE cycle_selector.cycle_option OF
    = pfc$lowest_cycle =
      p_cycle := f$lowest_cycle (p_cycle_list);
      IF p_cycle = NIL THEN
        status.normal := TRUE;
        new_cycle_number := pfc$minimum_cycle_number;
      ELSE
        IF p_cycle^.cycle_entry.cycle_number > pfc$minimum_cycle_number THEN
          status.normal := TRUE;
          new_cycle_number := p_cycle^.cycle_entry.cycle_number - 1;
        ELSE
          pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$cycle_underflow,
                fs_path (1, fs_path_size), status);
        IFEND;
      IFEND;

    = pfc$highest_cycle =
      p_cycle := f$highest_cycle (p_cycle_list);
      IF p_cycle = NIL THEN
        status.normal := TRUE;
        new_cycle_number := pfc$minimum_cycle_number;
      ELSE
        IF p_cycle^.cycle_entry.cycle_number < pfc$maximum_cycle_number THEN
          status.normal := TRUE;
          new_cycle_number := p_cycle^.cycle_entry.cycle_number + 1;
        ELSE
          pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$cycle_overflow,
                fs_path (1, fs_path_size), status);
        IFEND;
      IFEND;

    = pfc$specific_cycle =
      pfp$locate_specific_cycle (p_cycle_list, cycle_selector.cycle_number, p_cycle);
      IF p_cycle = NIL THEN
        status.normal := TRUE;
        new_cycle_number := cycle_selector.cycle_number;
      ELSE
        pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$duplicate_cycle,
              fs_path (1, fs_path_size), status);
        osp$append_status_integer (osc$status_parameter_delimiter, cycle_selector.cycle_number, 10, FALSE,
              status);
      IFEND;
    CASEND;

  PROCEND pfp$determine_new_cycle_number;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$establish_free_cycle_entry', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to establish a free cycle entry in a cycle
{   list.
{
{ DESIGN:
{   This is accomplished by either finding an existing free entry or by
{   expanding the cycle list to create a free entry.  If it is necessary to
{   expand the cycle list, a new larger cycle list is created and the old list
{   is copied to the new list.

  PROCEDURE [XDCL] pfp$establish_free_cycle_entry
    (    p_catalog_heap: {output^} pft$p_catalog_heap;
     VAR p_cycle_list: {i/o} pft$p_cycle_list;
     VAR p_new_cycle_list: {output} pft$p_cycle_list;
     VAR new_cycle_list: {output} boolean;
     VAR p_cycle: {output} pft$p_cycle;
     VAR status: ost$status);

    VAR
      cycle_index: pft$cycle_index,
      free_physical_cycle: pft$physical_cycle;

?? NEWTITLE := '[INLINE] LOCATE_FREE_CYCLE_ENTRY', EJECT ??

    PROCEDURE [INLINE] locate_free_cycle_entry
      (    p_cycle_list: {input} pft$p_cycle_list;
       VAR p_cycle: {output} pft$p_cycle);

      VAR
        cycle_index: pft$cycle_index;

      IF p_cycle_list <> NIL THEN
        FOR cycle_index := 1 TO UPPERBOUND (p_cycle_list^) DO
          IF p_cycle_list^ [cycle_index].cycle_entry.entry_type = pfc$free_cycle_entry THEN
            p_cycle := ^p_cycle_list^ [cycle_index];
            RETURN; {----->
          IFEND;
        FOREND;
      IFEND;

      p_cycle := NIL;

    PROCEND locate_free_cycle_entry;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    new_cycle_list := FALSE;

    IF p_cycle_list = NIL THEN
      pfp$allocate_cycle_list (0, p_catalog_heap, p_new_cycle_list, status);
      IF status.normal THEN
        free_physical_cycle.cycle_entry.entry_type := pfc$free_cycle_entry;
        pfp$compute_checksum (#LOC (free_physical_cycle.cycle_entry), #SIZE (pft$cycle_entry),
              free_physical_cycle.checksum);

        FOR cycle_index := 1 TO UPPERBOUND (p_new_cycle_list^) DO
          p_new_cycle_list^ [cycle_index] := free_physical_cycle;
        FOREND;

        p_cycle := ^p_new_cycle_list^ [1];
        new_cycle_list := TRUE;
      IFEND;
    ELSE { A cycle list already exists.
      locate_free_cycle_entry (p_cycle_list, p_cycle);
      IF p_cycle = NIL THEN
        pfp$allocate_cycle_list (UPPERBOUND (p_cycle_list^), p_catalog_heap, p_new_cycle_list, status);
        IF status.normal THEN
          i#move (#LOC (p_cycle_list^), #LOC (p_new_cycle_list^), #SIZE (p_cycle_list^));

          free_physical_cycle.cycle_entry.entry_type := pfc$free_cycle_entry;
          pfp$compute_checksum (#LOC (free_physical_cycle.cycle_entry), #SIZE (pft$cycle_entry),
                free_physical_cycle.checksum);

          FOR cycle_index := UPPERBOUND (p_cycle_list^) + 1 TO UPPERBOUND (p_new_cycle_list^) DO
            p_new_cycle_list^ [cycle_index] := free_physical_cycle;
          FOREND;

          p_cycle := ^p_new_cycle_list^ [UPPERBOUND (p_cycle_list^) + 1];
          new_cycle_list := TRUE;
        IFEND;
      IFEND;
    IFEND;

  PROCEND pfp$establish_free_cycle_entry;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$extract_permit_entry', EJECT ??

  PROCEDURE [XDCL] pfp$extract_permit_entry
    (    p_permit_list: pft$p_permit_list;
         authority: pft$authority;
     VAR permit_entry: pft$permit_entry);

    VAR
      group_not_selected: boolean,
      permit: pft$permit_entry,
      permit_index: pft$permit_index,
      selected_group_type: pft$group_types;

?? NEWTITLE := 'GROUP_APPLIES', EJECT ??

    FUNCTION group_applies
      (    group: pft$group;
           authority: pft$authority): boolean;

      CASE group.group_type OF
      = pfc$public =
        group_applies := TRUE;
      = pfc$family =
        group_applies := group.family_description.family = authority.family;
      = pfc$account =
        group_applies := (group.account_description.family = authority.family) AND
              (group.account_description.account = authority.account);
      = pfc$project =
        group_applies := (group.project_description.family = authority.family) AND
              (group.project_description.account = authority.account) AND
              (group.project_description.project = authority.project);
      = pfc$user =
        group_applies := (group.user_description.family = authority.family) AND
              (group.user_description.user = authority.user);
      = pfc$user_account =
        group_applies := (group.user_account_description.family = authority.family) AND
              (group.user_account_description.account = authority.account) AND
              (group.user_account_description.user = authority.user);
      = pfc$member =
        group_applies := (group.member_description.family = authority.family) AND
              (group.member_description.account = authority.account) AND
              (group.member_description.project = authority.project) AND
              (group.member_description.user = authority.user);
      ELSE
        group_applies := FALSE;
      CASEND;

    FUNCEND group_applies;
?? OLDTITLE ??
?? EJECT ??

    group_not_selected := TRUE;
    permit_entry := null_permit_entry;
    selected_group_type := LOWERVALUE (pft$group_types);

    IF p_permit_list <> NIL THEN
      FOR permit_index := 1 TO UPPERBOUND (p_permit_list^) DO
        permit := p_permit_list^ [permit_index].permit_entry;
        IF (permit.entry_type = pfc$normal_permit_entry) AND
              (group_not_selected OR (permit.group.group_type > selected_group_type)) AND
              group_applies (permit.group, authority) THEN
          permit_entry := permit;
          selected_group_type := permit.group.group_type;
          group_not_selected := FALSE;
        IFEND;
      FOREND;
    IFEND;

  PROCEND pfp$extract_permit_entry;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$get_catalog', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to access the catalog identified by the
{   path.
{
{ NOTE:
{   If the path identifies an internal catalog, then the charge_id may be
{   different than the catalog_locator.queuing_info.charge_id.  The former is
{   the charge_id of the catalog identified by the path and the latter is the
{   charge_id of the last external catalog in the path.

{Get Next Catalog Documentation:

{ PURPOSE:
{   The purpose of this procedure is to traverse the catalog to the next lower
{   catalog.  The result of this procedure is to get the next lower catalog in
{   an attached state and to obtain the permit for that catalog.
{
{ DESIGN:
{   The desired catalog, as designated by the path and search_index, is first
{   looked for in the catalog queue.  If the catalog is not queued, then it
{   becomes necessary to open and search the parent catalog for the desired
{   catalog.  If the catalog is not found or proves to be a file object, a
{   normal status is returned but the object type indicates a non-catalog
{   object.  The caller is responsible for deciding whether or not to set an
{   appropriate condition.
{
{ NOTE:
{   If the path identifies an internal catalog, then the charge_id may be
{   different than the catalog_locator.queuing_info.charge_id.  The former is
{   the charge_id of the catalog identified by the path and the latter is the
{   charge_id of the last external catalog in the path.

  PROCEDURE [XDCL] pfp$get_catalog
    (    path: pft$complete_path;
         access_kind: pft$access_kind;
         authority: pft$authority;
     VAR internal_path: pft$internal_path;
     VAR charge_id: pft$charge_id;
     VAR permit_entry: pft$permit_entry;
     VAR catalog_locator: pft$catalog_locator;
     VAR status: ost$status);

    CONST
      queue_internal_catalogs = TRUE;

    VAR
      catalog_access_queued: boolean,
      catalog_attach_queued: boolean,
      extracted_permit: pft$permit_entry,
      i: 0 .. 255,
      internal_catalog_name: pft$internal_catalog_name,
      last_accessed_catalog_index: 0 .. pfc$maximum_catalog_depth,
      last_external_catalog_index: pft$catalog_path_index,
      local_status: ost$status,
      object_type: pft$object_types,
      p_new_path: ^pft$complete_path,
      p_queued_internal_catalog: ^pft$queued_internal_catalog,
      parent_catalog_internal_name: pft$internal_catalog_name,
      parent_catalog_locator: pft$catalog_locator,
      path_element_count: pft$file_path_index,
      path_index: pft$catalog_path_index,
      process_non_local_exit: boolean,
      search_access_kind: pft$access_kind,
      search_index: pft$catalog_path_index,
      variant_path: pft$variant_path;

?? NEWTITLE := 'GET_CATALOG_CH', EJECT ??

    PROCEDURE get_catalog_ch
      (    condition: pmt$condition;
           p_condition_info: ^pmt$condition_information;
           p_sfsa: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        variant_path: pft$variant_path,
        status_id: ost$status_identifier,
        local_status: ost$status;

      variant_path.complete_path := TRUE;
      variant_path.p_complete_path := ^path;

      IF NOT process_non_local_exit THEN
        pfp$log_ascii ('***PF Condition Handler***', $pmt$ascii_logset [pmc$system_log, pmc$job_log],
              pmc$msg_origin_system, {critical_message} FALSE, local_status);
        pfp$log_path (variant_path, $pmt$ascii_logset [pmc$system_log, pmc$job_log], pmc$msg_origin_system,
              {critical_message} FALSE, local_status);
      IFEND;

      CASE condition.selector OF
      = pmc$system_conditions, pmc$block_exit_processing, mmc$segment_access_condition =
        IF process_non_local_exit THEN
          RETURN; {----->
        IFEND;

        IF catalog_locator.attached THEN
          catalog_locator.abort_catalog_operation := TRUE;
          pfp$return_catalog (catalog_locator, local_status);
          IF NOT local_status.normal THEN
            pfp$report_system_error (local_status);
          IFEND;
        IFEND;

        IF parent_catalog_locator.attached THEN
          parent_catalog_locator.abort_catalog_operation := TRUE;
          pfp$return_catalog (parent_catalog_locator, local_status);
          IF NOT local_status.normal THEN
            pfp$report_system_error (local_status);
          IFEND;
        IFEND;

        osp$set_status_from_condition (status_id, condition, p_sfsa, local_status, handler_status);
        osp$recoverable_system_error ('UNEXPECTED STATUS', ^local_status);

        status := local_status;
        initiate_non_local_exit;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          {syp$invalidate_open_sfid (catalog_locator.system_file_id, local_status);
          initiate_non_local_exit;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      CASEND;

    PROCEND get_catalog_ch;
?? OLDTITLE ??
?? NEWTITLE := 'INITIATE_NON_LOCAL_EXIT', EJECT ??

    PROCEDURE initiate_non_local_exit;

      process_non_local_exit := TRUE;
      #SPOIL (process_non_local_exit);
      EXIT pfp$get_catalog; {----->

    PROCEND initiate_non_local_exit;
?? OLDTITLE ??
?? EJECT ??
    permit_entry := null_permit_entry;
    process_non_local_exit := FALSE;
    catalog_locator.attached := FALSE;
    parent_catalog_locator.attached := FALSE;

  /get_catalog/
    BEGIN
      osp$establish_condition_handler (^get_catalog_ch, {block_exit} TRUE);

      pfp$get_root_attached (path [pfc$set_path_index], catalog_locator, status);
      IF NOT status.normal THEN
        EXIT /get_catalog/; {----->
      IFEND;

      internal_path [pfc$set_path_index] := catalog_locator.internal_catalog_name;
      charge_id.account := osc$null_name;
      charge_id.project := osc$null_name;
      last_external_catalog_index := pfc$set_path_index;
      parent_catalog_internal_name := catalog_locator.internal_catalog_name;
      last_accessed_catalog_index := 0;
      parent_catalog_locator := catalog_locator;
      path_element_count := UPPERBOUND (path);

      { Get the last catalog in an attached state.

    /search_catalogs/
      FOR search_index := pfc$family_path_index TO path_element_count DO
        IF search_index = path_element_count THEN
          search_access_kind := access_kind;
        ELSE
          search_access_kind := pfc$read_access;
        IFEND;

{Get Next Catalog (See Documentation above)
        p_queued_internal_catalog := NIL;
        IF parent_catalog_locator.queuing_info.access_queued THEN

          { Check internal catalog queue.
          {
          p_queued_internal_catalog := locate_internal_catalog
                (path [search_index], parent_catalog_internal_name,
                parent_catalog_locator.queuing_info.p_internal_catalog_list);
        IFEND;

        IF p_queued_internal_catalog <> NIL THEN
          {
          { The internal catalog is queued. The alarm is not set on this catalog.
          { If it were, the parent would be alarmed and not access queued.
          {
          object_type := pfc$catalog_object;
          internal_catalog_name := p_queued_internal_catalog^.internal_catalog_name;
          charge_id := p_queued_internal_catalog^.charge_id;
          extracted_permit := p_queued_internal_catalog^.permit;
          catalog_locator := parent_catalog_locator;
        ELSE
          {
          { Try queued catalog access.
          {
          pfp$get_queued_catalog (path [search_index], parent_catalog_internal_name, catalog_attach_queued,
                catalog_access_queued, catalog_locator, status);
          IF status.normal THEN
            IF catalog_access_queued THEN
              last_external_catalog_index := search_index;
              internal_catalog_name := catalog_locator.internal_catalog_name;
              charge_id := catalog_locator.queuing_info.charge_id;
              extracted_permit := catalog_locator.queuing_info.permit;
              object_type := pfc$catalog_object;
            ELSE
              {
              { Catalog access not queued. Access parent catalog to obtain permit.
              {
              IF NOT parent_catalog_locator.open THEN
                {
                { The parent catalog should always be opened for read access except
                { when it is the next to the last catalog and the last catalog is an
                { internal catalog, in which case the parent catalog would be opened
                { for the same access as the last catalog.  Currently the only
                { internal catalog is the family catalog.  If any additional internal
                { catalogs are created in the future, this code could prove to be a
                { problem.
                {
                IF UPPERBOUND (path) = pfc$family_path_index THEN
                  pfp$open_attached_catalog (search_access_kind, parent_catalog_locator, status);
                ELSE
                  pfp$open_attached_catalog (pfc$read_access, parent_catalog_locator, status);
                IFEND;
                IF status.normal THEN
                  last_accessed_catalog_index := last_external_catalog_index;
                ELSEIF status.condition <> pfe$catalog_access_retry THEN
                  pfp$report_unexpected_status (status);
                IFEND;
              IFEND;

              IF status.normal THEN
                get_next_catalog_from_parent (path, search_index, authority, search_access_kind,
                      queue_internal_catalogs, parent_catalog_internal_name, parent_catalog_locator,
                      last_external_catalog_index, last_accessed_catalog_index, catalog_attach_queued,
                      charge_id, catalog_locator, object_type, internal_catalog_name, extracted_permit,
                      status);
              IFEND;
            IFEND;
          IFEND;
        IFEND;

{End of Get Next Catalog

        IF NOT status.normal THEN
          {
          { Update catalog_locator for cleanup.
          {
          catalog_locator := parent_catalog_locator;
          EXIT /search_catalogs/; {----->
        IFEND;

        p$reduce_permits (permit_entry, extracted_permit, permit_entry);

        CASE object_type OF
        = pfc$catalog_object =
          internal_path [search_index] := internal_catalog_name;
          IF search_index < path_element_count THEN
            parent_catalog_internal_name := internal_catalog_name;
          IFEND;

          IF catalog_locator.internal_catalog_name <> parent_catalog_locator.internal_catalog_name THEN
            {
            { The new catalog represents a different physical catalog. Return the parent.
            {
            pfp$return_catalog (parent_catalog_locator, local_status);
            pfp$process_unexpected_status (local_status);
          IFEND;

          parent_catalog_locator := catalog_locator;

        = pfc$free_object = { Subcatalog not found in parent.
          PUSH p_new_path: [1 .. search_index];
          FOR path_index := 1 TO search_index DO
            p_new_path^ [path_index] := path [path_index];
          FOREND;
          variant_path.complete_path := TRUE;
          variant_path.p_complete_path := p_new_path;

          IF search_index = pfc$family_path_index THEN
            pfp$set_status_abnormal (variant_path, pfe$unknown_family, status);
          ELSEIF search_index = pfc$master_catalog_path_index THEN
            pfp$set_status_abnormal (variant_path, pfe$unknown_master_catalog, status);
          ELSEIF search_index = path_element_count THEN
            pfp$set_status_abnormal (variant_path, pfe$unknown_last_subcatalog, status);
          ELSE
            pfp$set_status_abnormal (variant_path, pfe$unknown_nth_subcatalog, status);
          IFEND;

          EXIT /search_catalogs/; {----->

        ELSE
          PUSH p_new_path: [1 .. search_index];
          FOR path_index := 1 TO search_index DO
            p_new_path^ [path_index] := path [path_index];
          FOREND;
          variant_path.complete_path := TRUE;
          variant_path.p_complete_path := p_new_path;

          IF (authority.ownership = $pft$ownership [])
{       } AND ((permit_entry.entry_type = pfc$free_permit_entry) OR
                (permit_entry.usage_permissions = $pft$permit_selections [])) THEN
            IF search_index = path_element_count THEN
              pfp$set_status_abnormal (variant_path, pfe$unknown_last_subcatalog, status);
            ELSE
              pfp$set_status_abnormal (variant_path, pfe$unknown_nth_subcatalog, status);
            IFEND;

          ELSEIF search_index = path_element_count THEN
            IF osv$catalog_name_security AND (authority.ownership = $pft$ownership []) AND
                  ((permit_entry.entry_type = pfc$free_permit_entry) OR
                  (permit_entry.usage_permissions = $pft$permit_selections [])) THEN
              pfp$set_status_abnormal (variant_path, pfe$unknown_last_subcatalog, status);
            ELSE
              pfp$set_status_abnormal (variant_path, pfe$last_name_not_subcatalog, status);
            IFEND;
          ELSEIF osv$catalog_name_security AND (authority.ownership = $pft$ownership []) AND
                ((permit_entry.entry_type = pfc$free_permit_entry) OR
                (permit_entry.usage_permissions = $pft$permit_selections [])) THEN
            pfp$set_status_abnormal (variant_path, pfe$unknown_nth_subcatalog, status);
          ELSE
            pfp$set_status_abnormal (variant_path, pfe$nth_name_not_subcatalog, status);
          IFEND;

          EXIT /search_catalogs/; {----->
        CASEND;

      FOREND /search_catalogs/;

      IF status.normal AND NOT catalog_locator.open THEN
        pfp$open_attached_catalog (access_kind, catalog_locator, status);
        last_accessed_catalog_index := last_external_catalog_index;
      IFEND;

      IF status.normal AND (last_external_catalog_index < path_element_count) AND
            (last_accessed_catalog_index < path_element_count) THEN
        {
        { The last external catalog must be opened and searched again for this
        { internal catalog. This catalog has already been attached but possibly
        { not accessed; e.g. pfp$get_catalog called with just a family path.
        {
        catalog_attach_queued := FALSE;
        get_next_catalog_from_parent (path, path_element_count, authority, access_kind,
              NOT queue_internal_catalogs, parent_catalog_internal_name, catalog_locator,
              last_external_catalog_index, last_accessed_catalog_index, catalog_attach_queued, charge_id,
              catalog_locator, object_type, internal_catalog_name, extracted_permit, status);
      IFEND;

      IF NOT status.normal THEN
        pfp$return_catalog (catalog_locator, local_status);
        pfp$process_unexpected_status (local_status);
      IFEND;
    END /get_catalog/;

    osp$disestablish_cond_handler;

  PROCEND pfp$get_catalog;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$internal_access_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to establish access to the object
{   specified by the internal path parameter.
{
{ NOTES:
{   The internal path is assumed to start with the unique set name.  This
{   routine is not used to locate cycles.

  PROCEDURE [XDCL] pfp$internal_access_object
    (    set_name: stt$set_name;
         internal_path: pft$internal_path;
         access_kind: pft$access_kind;
         authority: pft$authority;
         extract_permits: boolean;
         catalog_remote: boolean;
     VAR p_object: {output} pft$p_object;
     VAR catalog_locator: pft$catalog_locator;
     VAR permit_entry: pft$permit_entry;
     VAR status: ost$status);

    VAR
      catalog_index: pft$array_index,
      starting_catalog_index: pft$array_index,
      last_catalog_index: pft$array_index,
      file_index: pft$array_index,
      found_catalog_index: pft$array_index,
      local_status: ost$status,
      new_permit_entry: pft$permit_entry,
      p_permit_list: pft$p_permit_list,
      parent_catalog_locator: pft$catalog_locator,
      search_access_kind: pft$access_kind;

    status.normal := TRUE;
    permit_entry := null_permit_entry;
    starting_catalog_index := pfc$set_path_index;
    last_catalog_index := UPPERBOUND (internal_path) - 1;

{ Search for catalog objects.
    IF NOT extract_permits THEN
      {
      { Only need to access the last catalog. Attempt fast access.
      {
      pfp$attach_last_queued_catalog (set_name, internal_path, last_catalog_index, access_kind,
            found_catalog_index, catalog_locator, status);
      IF status.normal THEN
        starting_catalog_index := found_catalog_index + 1;
      ELSEIF (status.condition = pfe$no_queued_catalog_found) THEN
        status.normal := TRUE;
      IFEND;
    IFEND;

    IF status.normal THEN
      IF starting_catalog_index = pfc$set_path_index THEN
        pfp$attach_root_catalog (set_name, pfc$read_access, catalog_locator, status);
        starting_catalog_index := pfc$family_path_index;
      IFEND;
    IFEND;

    IF status.normal THEN

    /search_remaining_catalogs/
      FOR catalog_index := starting_catalog_index TO last_catalog_index DO
        p$internal_locate_object (catalog_locator.object_list_descriptor.p_object_list,
              internal_path [catalog_index], p_object);
        IF p_object = NIL THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
                'NIL catalog object pointer.', status);
          pfp$return_catalog (catalog_locator, local_status);
          pfp$process_unexpected_status (local_status);
          RETURN; {----->
        IFEND;

        IF extract_permits THEN
          pfp$build_permit_list_pointer (p_object^.object_entry.permit_list_locator,
                catalog_locator.p_catalog_file, p_permit_list);
          pfp$extract_permit_entry (p_permit_list, authority, new_permit_entry);
          p$reduce_permits (permit_entry, new_permit_entry, permit_entry);
        IFEND;

        parent_catalog_locator := catalog_locator;
        IF catalog_index = last_catalog_index THEN
          search_access_kind := access_kind;
        ELSE
          search_access_kind := pfc$read_access;
        IFEND;

        pfp$access_next_catalog (search_access_kind, parent_catalog_locator, p_object, catalog_remote,
              catalog_locator, status);
        IF NOT status.normal THEN
          pfp$return_catalog (parent_catalog_locator, local_status);
          pfp$process_unexpected_status (local_status);
          RETURN; {----->
        IFEND;

        IF catalog_locator.object_list_descriptor.catalog_type = pfc$external_catalog THEN
          pfp$return_catalog (parent_catalog_locator, local_status);
          pfp$process_unexpected_status (local_status);
        IFEND;
      FOREND /search_remaining_catalogs/;
      {
      { Search for file object.
      {
      file_index := UPPERBOUND (internal_path);
      p$internal_locate_object (catalog_locator.object_list_descriptor.p_object_list,
            internal_path [file_index], p_object);
      IF p_object = NIL THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_permanent_file, '', status);
        pfp$return_catalog (catalog_locator, local_status);
        pfp$process_unexpected_status (local_status);
        RETURN; {----->
      IFEND;

      IF extract_permits THEN
        pfp$build_permit_list_pointer (p_object^.object_entry.permit_list_locator,
              catalog_locator.p_catalog_file, p_permit_list);
        pfp$extract_permit_entry (p_permit_list, authority, new_permit_entry);
        p$reduce_permits (permit_entry, new_permit_entry, permit_entry);
      IFEND;
    IFEND;

  PROCEND pfp$internal_access_object;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] p$internal_locate_object', EJECT ??

  PROCEDURE [INLINE] p$internal_locate_object
    (    p_object_list: {input} pft$p_object_list;
         internal_object_name: pft$internal_name;
     VAR p_object: {output} pft$p_object);

    VAR
      object_index: pft$object_index;

    IF p_object_list <> NIL THEN
      FOR object_index := 1 TO UPPERBOUND (p_object_list^) DO
        p_object := ^p_object_list^ [object_index];
        IF (p_object^.object_entry.object_type <> pfc$free_object) AND
              (p_object^.object_entry.internal_object_name = internal_object_name) THEN
          RETURN; {----->
        IFEND;
      FOREND;
    IFEND;

    p_object := NIL;

  PROCEND p$internal_locate_object;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$internal_locate_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to search an object list for an object
{   with the specified internal name.  If the object cannot be found, a NIL
{   p_object pointer is returned.

  PROCEDURE [XDCL] pfp$internal_locate_object
    (    p_object_list: {input} pft$p_object_list;
         internal_object_name: pft$internal_name;
     VAR p_object: {output} pft$p_object);

    p$internal_locate_object (p_object_list, internal_object_name, p_object);

  PROCEND pfp$internal_locate_object;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$locate_cycle', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to locate the selected cycle entry for the
{   specified file object.  If the selected cycle cannot be found, an abnormal
{   status is returned.

  PROCEDURE [XDCL] pfp$locate_cycle
    (    path: pft$complete_path;
         p_cycle_list: {input} pft$p_cycle_list;
         cycle_selector: pft$cycle_selector;
     VAR p_cycle: {output} pft$p_cycle;
     VAR status: ost$status);

    VAR
      variant_path: pft$variant_path;

    CASE cycle_selector.cycle_option OF
    = pfc$lowest_cycle =
      p_cycle := f$lowest_cycle (p_cycle_list);
    = pfc$highest_cycle =
      p_cycle := f$highest_cycle (p_cycle_list);
    = pfc$specific_cycle =
      pfp$locate_specific_cycle (p_cycle_list, cycle_selector.cycle_number, p_cycle);
    CASEND;

    IF p_cycle <> NIL THEN
      status.normal := TRUE;
    ELSE
      variant_path.complete_path := TRUE;
      variant_path.p_complete_path := ^path;
      CASE cycle_selector.cycle_option OF
      = pfc$lowest_cycle, pfc$highest_cycle =
        pfp$set_status_abnormal (variant_path, pfe$unknown_permanent_file, status);
      = pfc$specific_cycle =
        pfp$set_status_abnormal (variant_path, pfe$unknown_cycle, status);
        osp$append_status_integer (osc$status_parameter_delimiter, cycle_selector.cycle_number, radix,
              NOT include_radix, status);
      CASEND;
    IFEND;

  PROCEND pfp$locate_cycle;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$locate_log_entry', EJECT ??

  PROCEDURE [XDCL] pfp$locate_log_entry
    (    p_log_list: {input} pft$p_log_list;
         user_id: ost$user_identification;
     VAR p_log: {output} pft$p_log);

    VAR
      log_index: pft$log_index;

    IF p_log_list <> NIL THEN
      FOR log_index := 1 TO UPPERBOUND (p_log_list^) DO
        IF (p_log_list^ [log_index].log_entry.entry_type = pfc$normal_log_entry) AND
              (user_id = p_log_list^ [log_index].log_entry.user_id) THEN
          p_log := ^p_log_list^ [log_index];
          RETURN; {----->
        IFEND;
      FOREND;
    IFEND;

    p_log := NIL;

  PROCEND pfp$locate_log_entry;
?? OLDTITLE ??
?? NEWTITLE := '  [INLINE] p$reduce_permits', EJECT ??

  PROCEDURE [INLINE] p$reduce_permits
    (    high_level_permit_entry: pft$permit_entry;
         low_level_permit_entry: pft$permit_entry;
     VAR reduced_permit_entry: pft$permit_entry);

    IF high_level_permit_entry.entry_type = pfc$normal_permit_entry THEN
      IF low_level_permit_entry.entry_type = pfc$normal_permit_entry THEN
        IF low_level_permit_entry.group.group_type >= high_level_permit_entry.group.group_type THEN
          reduced_permit_entry := low_level_permit_entry;
        ELSE
          reduced_permit_entry := high_level_permit_entry;
        IFEND;
      ELSE
        reduced_permit_entry := high_level_permit_entry;
      IFEND;
    ELSE
      reduced_permit_entry := low_level_permit_entry;
    IFEND;

  PROCEND p$reduce_permits;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$reduce_permits', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to reduce two permit entries into a single
{   entry by picking the one with the more selective group.  In the case of
{   equally selective groups, the low level entry will become the reduced
{   permit entry.

  PROCEDURE [XDCL] pfp$reduce_permits
    (    high_level_permit_entry: pft$permit_entry;
         low_level_permit_entry: pft$permit_entry;
     VAR reduced_permit_entry: pft$permit_entry);

    p$reduce_permits (high_level_permit_entry, low_level_permit_entry, reduced_permit_entry);

  PROCEND pfp$reduce_permits;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$validate_default_password', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to validate a possibly defaulted password.
{
{ DESIGN:
{   If the password selector indicates a default password, then this interface
{   will return normal status for the system, family, and master catalog
{   owners.  For non-owners osc$null_name will be used as the default password.
{   This is not a security violation because the owner may use the
{   DISPLAY_CATALOG_ENTRY command to determine the file password.  If a
{   specific password is specified, the password must pass the rules in
{   pfp$validate_password.

  PROCEDURE [XDCL] pfp$validate_default_password
    (    path: pft$complete_path;
         authority: pft$authority;
         access_password: pft$password_selector;
         p_file_object: {input^} pft$p_object;
     VAR status: ost$status);

    IF access_password.password_specified = pfc$default_password_option THEN
      IF (pfc$master_catalog_owner IN authority.ownership) OR (pfc$family_owner IN authority.ownership) OR
            (pfc$system_owner IN authority.ownership) THEN
        status.normal := TRUE;
      ELSE
        pfp$validate_password (path, authority, osc$null_name, p_file_object, status);
      IFEND;
    ELSE
      pfp$validate_password (path, authority, access_password.password, p_file_object, status);
    IFEND;

  PROCEND pfp$validate_default_password;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$validate_file_permission', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to validate that the file access described
{   by the usage_intentions and share_intentions parameters is permitted by the
{   permit_entry parameter.  If the access is not allowed, an abnormal status
{   is returned.

  PROCEDURE [XDCL] pfp$validate_file_permission
    (    path: pft$complete_path;
         authority: pft$authority;
         permit_entry: pft$permit_entry;
         usage_intentions: pft$permit_selections;
         share_intentions: pft$share_selections;
     VAR status: ost$status);

    VAR
      fs_path: fst$path,
      fs_path_size: fst$path_size,
      selections_string: pft$selections_string;

    IF (pfc$family_owner IN authority.ownership) OR (pfc$system_owner IN authority.ownership) THEN
      status.normal := TRUE;
    ELSEIF (permit_entry.entry_type = pfc$free_permit_entry) OR
          (permit_entry.usage_permissions = $pft$permit_selections []) THEN
      pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_permanent_file,
            fs_path (1, fs_path_size), status);
    ELSEIF usage_intentions <= permit_entry.usage_permissions THEN
      IF share_intentions >= permit_entry.share_requirements THEN
        status.normal := TRUE;
      ELSE
        pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$sharing_not_permitted,
              fs_path (1, fs_path_size), status);
        pfp$build_share_selections_str (permit_entry.share_requirements, selections_string);
        osp$append_status_parameter (osc$status_parameter_delimiter, selections_string.
              value (1, selections_string.size), status);
        pfp$build_share_selections_str (share_intentions, selections_string);
        osp$append_status_parameter (osc$status_parameter_delimiter, selections_string.
              value (1, selections_string.size), status);
      IFEND;
    ELSE
      pfp$convert_pf_path_to_fs_path (path, fs_path, fs_path_size);
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$usage_not_permitted,
            fs_path (1, fs_path_size), status);
      pfp$build_permit_selections_str (permit_entry.usage_permissions, selections_string);
      osp$append_status_parameter (osc$status_parameter_delimiter, selections_string.
            value (1, selections_string.size), status);
      pfp$build_permit_selections_str (usage_intentions, selections_string);
      osp$append_status_parameter (osc$status_parameter_delimiter, selections_string.
            value (1, selections_string.size), status);
    IFEND;

  PROCEND pfp$validate_file_permission;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] pfp$validate_ored_permission', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to validate that at least one of the
{   permit options specified by the usage_intentions parameter is permitted by
{   the permit_entry parameter and that the share_intentions parameter is
{   permitted by the permit_entry parameter.
{
{ DESIGN:
{   If the access is not allowed, an abnormal status is returned.

  PROCEDURE [XDCL] pfp$validate_ored_permission
    (    path: pft$complete_path;
         authority: pft$authority;
         permit_entry: pft$permit_entry;
         usage_intentions: pft$permit_selections;
         share_intentions: pft$share_selections;
     VAR status: ost$status);

    VAR
      fs_path_size: fst$path_size,
      p_fs_path: ^fst$path,
      p_selections_string: ^pft$selections_string;

    IF (pfc$family_owner IN authority.ownership) OR (pfc$system_owner IN authority.ownership) THEN
      status.normal := TRUE;
    ELSEIF (permit_entry.entry_type = pfc$free_permit_entry) OR
          (permit_entry.usage_permissions = $pft$permit_selections []) THEN
      PUSH p_fs_path;
      pfp$convert_pf_path_to_fs_path (path, p_fs_path^, fs_path_size);
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_permanent_file,
            p_fs_path^ (1, fs_path_size), status);
    ELSEIF usage_intentions * permit_entry.usage_permissions = $pft$permit_selections [] THEN
      PUSH p_fs_path;
      pfp$convert_pf_path_to_fs_path (path, p_fs_path^, fs_path_size);
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$usage_not_permitted,
            p_fs_path^ (1, fs_path_size), status);
      PUSH p_selections_string;
      pfp$build_permit_selections_str (permit_entry.usage_permissions, p_selections_string^);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_selections_string^.
            value (1, p_selections_string^.size), status);
      build_ored_permit_string (usage_intentions, p_selections_string^);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_selections_string^.
            value (1, p_selections_string^.size), status);
    ELSEIF permit_entry.share_requirements <= share_intentions THEN
      status.normal := TRUE;
    ELSE
      PUSH p_fs_path;
      pfp$convert_pf_path_to_fs_path (path, p_fs_path^, fs_path_size);
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$sharing_not_permitted,
            p_fs_path^ (1, fs_path_size), status);
      PUSH p_selections_string;
      pfp$build_share_selections_str (permit_entry.share_requirements, p_selections_string^);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_selections_string^.
            value (1, p_selections_string^.size), status);
      pfp$build_share_selections_str (share_intentions, p_selections_string^);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_selections_string^.
            value (1, p_selections_string^.size), status);
    IFEND;

  PROCEND pfp$validate_ored_permission;
?? OLDTITLE ??
?? NEWTITLE := '  access_next_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to establish access to the next object
{   along a path through the catalog tree.  This includes extracting permit
{   information that may apply.

  PROCEDURE access_next_object
    (    object_list_descriptor: pft$object_list_descriptor;
         next_object_name: pft$name;
         valid_objects: pft$object_selections;
         authority: pft$authority;
         p_catalog_file: {input^} pft$p_catalog_file;
     VAR p_next_object: {output} pft$p_object;
     VAR extracted_permit_entry: pft$permit_entry);

    VAR
      p_permit_list: pft$p_permit_list;

    pfp$locate_object (next_object_name, valid_objects, object_list_descriptor, p_next_object);
    IF p_next_object = NIL THEN
      extracted_permit_entry := null_permit_entry;
    ELSE
      pfp$build_permit_list_pointer (p_next_object^.object_entry.permit_list_locator, p_catalog_file,
            p_permit_list);
      pfp$extract_permit_entry (p_permit_list, authority, extracted_permit_entry);
    IFEND;

  PROCEND access_next_object;
?? OLDTITLE ??
?? NEWTITLE := '  build_ored_permit_string', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to build a string containing each of the
{   permit options, specified by the permit_selections parameter, as an
{   individual set, with each set separated by an "or".

  PROCEDURE build_ored_permit_string
    (    permit_selections: pft$permit_selections;
     VAR permit_string: pft$selections_string);

    VAR
      first_match: boolean,
      permit_option: pft$permit_options;

    IF permit_selections = $pft$permit_selections [] THEN
      permit_string.value := 'null set';
      permit_string.size := 8;
    ELSE
      first_match := TRUE;

      FOR permit_option := pfc$read TO pfc$control DO
        IF permit_option IN permit_selections THEN
          IF first_match THEN
            permit_string.value := '';
            permit_string.size := 0;
            first_match := FALSE;
          ELSE
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  ' or ');
          IFEND;

          CASE permit_option OF
          = pfc$read =
            permit_string.value (1, 6) := '[READ]';
            permit_string.size := 6;
          = pfc$shorten =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  '[SHORTEN]');
          = pfc$append =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  '[APPEND]');
          = pfc$modify =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  '[MODIFY]');
          = pfc$execute =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  '[EXECUTE]');
          = pfc$cycle =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  '[CYCLE]');
          = pfc$control =
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  '[CONTROL]');
          ELSE
            STRINGREP (permit_string.value, permit_string.size, permit_string.value (1, permit_string.size),
                  'invalid option');
          CASEND;
        IFEND;
      FOREND;
    IFEND;

  PROCEND build_ored_permit_string;
?? OLDTITLE ??
?? NEWTITLE := '  get_next_catalog_from_parent', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to search the parent catalog looking for
{   the search catalog.  As a result of this procedure, the desired catalog
{   will be in an attached state and the permit information for the desired
{   catalog will have been obtained fresh from the parent.
{
{ DESIGN:
{   The search begins with the currently accessed catalog and continues through
{   all internal catalogs to the desired catalog.  When the desired catalog is
{   found, an attempt will be made to queue the access, so subsequent accesses,
{   to the return catalog, will not have to re-access the catalog.
{
{ NOTE:
{   If the path identifies an internal catalog, then the charge_id may be
{   different than the catalog_locator.queuing_info.charge_id.  The former is
{   the charge_id of the catalog identified by the path and the latter is the
{   charge_id of the last external catalog in the path.

  PROCEDURE get_next_catalog_from_parent
    (    path: pft$complete_path;
         search_index: pft$catalog_path_index;
         authority: pft$authority;
         search_access_kind: pft$access_kind;
         queue_internal_catalogs: boolean;
         parent_catalog_name: pft$internal_catalog_name;
     VAR parent_catalog_locator: {i/o} pft$catalog_locator;
     VAR last_external_catalog_index: {i/o} pft$catalog_path_index;
     VAR last_accessed_catalog_index: {i/o} 0 .. pfc$maximum_catalog_depth;
     VAR catalog_attach_queued: {i/o} boolean;
     VAR charge_id: {i/o} pft$charge_id;
     VAR catalog_locator: {i(if catalog_attach_queued)/o} pft$catalog_locator;
     VAR object_type: pft$object_types;
     VAR internal_catalog_name: pft$internal_catalog_name;
     VAR extracted_permit: pft$permit_entry;
     VAR status: ost$status);

    VAR
      catalog_index: pft$catalog_path_index,
      p_physical_fmd: ^pft$physical_fmd,
      p_physical_object: ^pft$physical_object,
      parent_catalog_internal_name: pft$internal_catalog_name,
      return_status: ost$status;

    status.normal := TRUE;
    parent_catalog_internal_name := parent_catalog_name;

    FOR catalog_index := last_accessed_catalog_index + 1 TO search_index DO
      access_next_object (parent_catalog_locator.object_list_descriptor, path [catalog_index],
            $pft$object_selections [pfc$catalog_object, pfc$file_object], authority,
            parent_catalog_locator.p_catalog_file, p_physical_object, extracted_permit);
      IF p_physical_object = NIL THEN
        object_type := pfc$free_object;
      ELSE
        object_type := p_physical_object^.object_entry.object_type;
      IFEND;

      IF object_type <> pfc$catalog_object THEN
        IF catalog_attach_queued THEN
          catalog_attach_queued := FALSE;
          pfp$return_catalog (catalog_locator, status);
        IFEND;
        catalog_locator := parent_catalog_locator;
        RETURN; {----->
      IFEND;

      { Found a desired catalog along the way.
      {
      internal_catalog_name := p_physical_object^.object_entry.internal_object_name;
      IF p_physical_object^.object_entry.catalog_object_locator.catalog_type = pfc$internal_catalog THEN
        {
        { Build the new internal object list pointer.
        {
        pfp$access_next_catalog (search_access_kind, parent_catalog_locator, p_physical_object,
              (path [pfc$family_path_index] <> osv$system_family_name), parent_catalog_locator, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        last_accessed_catalog_index := catalog_index;
        IF catalog_index = search_index THEN
          {
          { Found the desired catalog.
          {
          charge_id := p_physical_object^.object_entry.charge_id;
          IF parent_catalog_locator.queuing_info.access_queued AND queue_internal_catalogs THEN
            insert_internal_catalog (parent_catalog_internal_name, path [catalog_index],
                  internal_catalog_name, charge_id, extracted_permit,
                  parent_catalog_locator.queuing_info.p_internal_catalog_list);
          IFEND;
          catalog_locator := parent_catalog_locator;
        ELSE
          parent_catalog_internal_name := internal_catalog_name;
        IFEND;
      ELSE {external catalog}
        IF catalog_attach_queued THEN
          IF internal_catalog_name <> catalog_locator.internal_catalog_name THEN
            {
            { Wrong catalog found. This can happen when a delete catalog is
            { followed by a create catalog of the same external name from a
            { different job.
            {
            catalog_locator.queuing_info.attach_queued := FALSE;
            catalog_attach_queued := FALSE;
            catalog_locator.queuing_info.set_catalog_alarm := TRUE;
            pfp$return_catalog (catalog_locator, return_status);
            pfp$process_unexpected_status (return_status);
          IFEND;

          IF p_physical_object^.object_entry.catalog_object_locator.global_file_name <>
                catalog_locator.global_file_name THEN
            {
            { This catalog was moved by a MOVE_CLASSES command executed in a differnet
            { job while the catalog was attached and queued in this job.
            {
            catalog_locator.queuing_info.attach_queued := FALSE;
            catalog_attach_queued := FALSE;
            catalog_locator.queuing_info.set_catalog_alarm := TRUE;
            pfp$return_catalog (catalog_locator, return_status);
            pfp$process_unexpected_status (return_status);
          IFEND;
        IFEND;

        last_external_catalog_index := catalog_index;
        IF NOT catalog_attach_queued THEN
          pfp$build_fmd_pointer (p_physical_object^.object_entry.catalog_object_locator.fmd_locator,
                parent_catalog_locator.p_catalog_file, p_physical_fmd);
          IF p_physical_fmd = NIL THEN
            osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
                  ' NIL catalog FMD in get_next_catalog_from_parent', status);
          ELSE
            pfp$physically_attach_catalog (parent_catalog_locator.set_name, internal_catalog_name,
                  p_physical_object^.object_entry.catalog_object_locator.global_file_name,
                  ^p_physical_fmd^.fmd, (path [pfc$family_path_index] <> osv$system_family_name),
                  catalog_locator, status);
          IFEND;
          IF status.normal THEN
            charge_id := p_physical_object^.object_entry.charge_id;
            {
            { Build locator fields to make the attach and access queuable.
            {
            catalog_locator.queuing_info.set_catalog_alarm := FALSE;
            catalog_locator.queuing_info.attach_queued := TRUE;
            catalog_locator.queuing_info.parent_catalog_internal_name := parent_catalog_internal_name;
            catalog_locator.queuing_info.external_catalog_name := path [catalog_index];
            catalog_locator.queuing_info.charge_id := charge_id;
            catalog_locator.queuing_info.access_queued := TRUE;
            catalog_locator.queuing_info.p_internal_catalog_list := NIL;
            catalog_locator.queuing_info.permit := extracted_permit;
          IFEND;
        IFEND;
      IFEND;

      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    FOREND;

  PROCEND get_next_catalog_from_parent;
?? OLDTITLE ??
?? NEWTITLE := '  [INLINE] insert_internal_catalog', EJECT ??

  PROCEDURE [INLINE] insert_internal_catalog
    (    parent_catalog_name: pft$internal_catalog_name;
         external_catalog_name: pft$name;
         internal_catalog_name: pft$internal_catalog_name;
         charge_id: pft$charge_id;
         permit_entry: pft$permit_entry;
     VAR p_internal_catalog: {i/o} ^pft$queued_internal_catalog);

    VAR
      p_old_internal_catalog: ^pft$queued_internal_catalog;

    p_old_internal_catalog := p_internal_catalog;

    ALLOCATE p_internal_catalog IN pfv$p_p_job_heap^^;
    IF p_internal_catalog <> NIL THEN
      p_internal_catalog^.parent_catalog_name := parent_catalog_name;
      p_internal_catalog^.external_catalog_name := external_catalog_name;
      p_internal_catalog^.internal_catalog_name := internal_catalog_name;
      p_internal_catalog^.charge_id := charge_id;
      p_internal_catalog^.permit := permit_entry;
      p_internal_catalog^.p_next_internal_catalog := p_old_internal_catalog;
    IFEND;

  PROCEND insert_internal_catalog;
?? OLDTITLE ??
MODEND pfm$catalog_access_methods;
