?? RIGHT := 110 ??
?? TITLE := 'NOS/VE Permanent Files : Object List Management' ??
MODULE pfm$object_list_manager;

{ PURPOSE:
{   This module contains the procedures to maintain the object list in a
{   catalog.  This includes:
{       changing the name of an object
{       contracting the object list
{       deleting objects
{       expanding the object list
{       locating objects
{       sorting the object list

?? NEWTITLE := '  Global Declarations Referenced by this module' ??
?? PUSH (LISTEXT := ON) ??
*copyc pfe$error_condition_codes
*copyc pft$delete_option
*copyc pft$object_name_list
*copyc pft$object_selections
?? POP ??
?? EJECT ??
*copyc dmp$destroy_permanent_file
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$file_access_condition
*copyc osp$prevalidate_free
*copyc osp$recoverable_system_error
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$set_status_from_condition
*copyc osv$system_family_name
*copyc pfp$access_next_catalog
*copyc pfp$build_cycle_list_pointer
*copyc pfp$build_fmd_pointer
*copyc pfp$build_log_list_pointer
*copyc pfp$build_object_list_locator
*copyc pfp$build_permit_list_pointer
*copyc pfp$compute_checksum
*copyc pfp$destroy_catalog
*copyc pfp$detach_unavail_queued_cat
*copyc pfp$log_ascii
*copyc pfp$log_path
*copyc pfp$object_contraction_count
*copyc pfp$object_expansion_size
*copyc pfp$process_unexpected_status
*copyc pfp$release_locked_apfid
*copyc pfp$report_invalid_free
*copyc pfp$report_system_error
*copyc pfp$return_catalog
*copyc pfp$set_status_abnormal
*copyc pfv$binary_catalog_search
*copyc pfv$locked_apfid
*copyc pmp$continue_to_cause
*copyc pmp$get_unique_name

?? TITLE := '  [XDCL] pfp$change_object_name', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to change the name of an object.
{ If the object list is sorted and the object resides in the sorted portion
{ of the object list, the object will be moved to the unsorted portion of the
{ object list and the original object will be converted to a free object.

  PROCEDURE [XDCL] pfp$change_object_name
    (    p_path: ^pft$complete_path;
         new_object_name: pft$name;
         p_catalog_file: {output^} ^pft$catalog_file;
     VAR p_object: {i/o} ^pft$physical_object;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor;
     VAR status: ost$status);

    VAR
      object_index: pft$object_index,
      original_object_name: pft$name,
      p_found_object: ^pft$physical_object,
      p_free_object: ^pft$physical_object,
      update_catalog: boolean;

    status.normal := TRUE;

  /change_object_name/
    BEGIN
      IF object_list_descriptor.sorted_object_count = 0 THEN
        {
        { Object list is not sorted.
        {
        p_object^.object_entry.external_object_name := new_object_name;
        pfp$compute_checksum (^p_object^.object_entry, #SIZE (pft$object_entry), p_object^.checksum);
      ELSE
        original_object_name := p_object^.object_entry.external_object_name;
        locate_sorted_object (original_object_name, $pft$object_selections
              [pfc$file_object, pfc$catalog_object], object_list_descriptor, p_found_object, object_index);
        IF (p_found_object = NIL) OR (object_index > object_list_descriptor.sorted_object_count) THEN
          {
          { Object located in unsorted portion of sorted object list.
          {
          p_object^.object_entry.external_object_name := new_object_name;
          pfp$compute_checksum (^p_object^.object_entry, #SIZE (pft$object_entry), p_object^.checksum);
        ELSE
          {
          { Object found in sorted portion of sorted object_list.
          {
          pfp$establish_free_object_entry (p_path, p_catalog_file, object_list_descriptor, p_free_object,
                status);
          IF status.normal THEN
            {
            { Must locate the object again.
            { The location of the object in the object list may have changed if the object list
            { was expanded by pfp$establish_free_object_entry.
            {
            locate_sorted_object (original_object_name, $pft$object_selections
                  [pfc$file_object, pfc$catalog_object], object_list_descriptor, p_found_object,
                  object_index);
            IF p_found_object = NIL THEN
              osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
                   'pfp$change_object_name - Unable to locate object.', status);
              EXIT /change_object_name/;
            IFEND;
            p_free_object^ := p_found_object^;
            p_free_object^.object_entry.external_object_name := new_object_name;
            p_object := p_free_object;
            pfp$compute_checksum (^p_free_object^.object_entry, #SIZE (pft$object_entry),
                  p_free_object^.checksum);
            p_found_object^.object_entry.object_type := pfc$free_object;
            pfp$compute_checksum (^p_found_object^.object_entry, #SIZE (pft$object_entry),
                  p_found_object^.checksum);
            object_list_descriptor.free_sorted_object_count :=
                  object_list_descriptor.free_sorted_object_count + 1;
            pfp$update_object_list_locator (p_path, {p_new_object_list} NIL, p_catalog_file,
                  object_list_descriptor);
          IFEND;
        IFEND;
      IFEND;
    END /change_object_name/;
  PROCEND pfp$change_object_name;

?? TITLE := '  [XDCL] pfp$delete_catalog_object', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to delete a catalog object from the
{   specified object list.  If the catalog does not exist, an abnormal status
{   is returned.
{
{ DESIGN:
{   The object list is contracted if necessary.

  PROCEDURE [XDCL] pfp$delete_catalog_object
    (    path: pft$complete_path;
         delete_option: pft$delete_option;
     VAR p_catalog_object: {i^/o^} ^pft$physical_object;
     VAR parent_catalog_locator: {i/o} pft$catalog_locator;
     VAR status: ost$status);

    PROCEDURE delete_catalog_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 delete_catalog_handler;

    PROCEDURE initiate_non_local_exit;

      process_non_local_exit := TRUE;
      #SPOIL (process_non_local_exit);
      EXIT pfp$delete_catalog_object;
    PROCEND initiate_non_local_exit;

    CONST
      critical_message = TRUE;

    VAR
      all_objects_purged: boolean,
      ascii_log_text_length: integer,
      catalog_active: boolean,
      catalog_locator: pft$catalog_locator,
      empty_object_list: boolean,
      local_status: ost$status,
      p_ascii_log_text: ^string (7 {lines} * (108 - 21) {max characters/line} ),
      p_permit_list: ^pft$permit_list,
      p_physical_fmd: ^pft$physical_fmd,
      prevalidate_free_result: ost$prevalidate_free_result,
      process_non_local_exit: boolean,
      unique_name: ost$name,
      variant_path: pft$variant_path;


    PROCEDURE [INLINE] test_object_list
      (    p_object_list: {input} ^pft$object_list;
       VAR empty_object_list: boolean;
       VAR all_objects_purged: boolean);

      VAR
        object_index: pft$object_index;

      empty_object_list := TRUE;
      all_objects_purged := TRUE;

      IF p_object_list <> NIL THEN
        FOR object_index := 1 TO UPPERBOUND (p_object_list^) DO
          CASE p_object_list^ [object_index].object_entry.object_type OF
          = pfc$free_object =
            ;

          = pfc$purged_file_object, pfc$purged_catalog_object =
            empty_object_list := FALSE;

          = pfc$file_object, pfc$catalog_object =
            empty_object_list := FALSE;
            all_objects_purged := FALSE;
            RETURN;
          CASEND;
        FOREND;
      IFEND;
    PROCEND test_object_list;

  /delete_catalog_object/
    BEGIN
      catalog_active := FALSE;
      process_non_local_exit := FALSE;
      #SPOIL (process_non_local_exit);
      status.normal := TRUE;
      {
      { The parent catalog must have been locked.
      {
      pfp$access_next_catalog (pfc$read_access, parent_catalog_locator, p_catalog_object,
            {catalog_remote} (path [pfc$family_path_index] <> osv$system_family_name),
            catalog_locator, status);
      catalog_active := status.normal;
      osp$establish_condition_handler (^delete_catalog_handler, {block_exit} TRUE);
      IF NOT status.normal THEN
        IF osp$file_access_condition (status) AND (delete_option = pfc$catalog_and_contents) THEN
          delete_inaccessible_catalog (path, catalog_locator, p_catalog_object,
                parent_catalog_locator, status);
        IFEND;
        EXIT /delete_catalog_object/;
      IFEND;

      test_object_list (catalog_locator.object_list_descriptor.p_object_list, empty_object_list,
            all_objects_purged);

      IF empty_object_list THEN
        delete_object (^path, p_catalog_object, parent_catalog_locator.p_catalog_file,
              parent_catalog_locator.object_list_descriptor);
        {
        { Free all space allocated for the catalog entry.
        {
        pfp$build_permit_list_pointer (p_catalog_object^.object_entry.permit_list_locator,
              parent_catalog_locator.p_catalog_file, p_permit_list);
        IF p_permit_list <> NIL THEN
          osp$prevalidate_free ((#OFFSET(p_permit_list) -
                #OFFSET(^parent_catalog_locator.p_catalog_file^.catalog_heap) - 16),
                ^parent_catalog_locator.p_catalog_file^.catalog_heap, prevalidate_free_result);
          IF prevalidate_free_result = osc$heap_free_valid THEN
            FREE p_permit_list IN parent_catalog_locator.p_catalog_file^.catalog_heap;
          ELSE
            pfp$report_invalid_free (^path, {p_cycle_number} NIL, 'PERMIT_LIST', 'catalog',
                  prevalidate_free_result, #OFFSET(p_permit_list));
            p_permit_list := NIL;
          IFEND;
        IFEND;

        IF catalog_locator.object_list_descriptor.catalog_type = pfc$external_catalog THEN
          pfp$build_fmd_pointer (p_catalog_object^.object_entry.catalog_object_locator.fmd_locator,
                parent_catalog_locator.p_catalog_file, p_physical_fmd);

          pfp$destroy_catalog (catalog_locator, status);
          catalog_active := (NOT status.normal);
          pfp$process_unexpected_status (status);

          IF p_physical_fmd <> NIL THEN
            osp$prevalidate_free ((#OFFSET(p_physical_fmd) -
                  #OFFSET(^parent_catalog_locator.p_catalog_file^.catalog_heap) - 16),
                  ^parent_catalog_locator.p_catalog_file^.catalog_heap, prevalidate_free_result);
            IF prevalidate_free_result = osc$heap_free_valid THEN
              FREE p_physical_fmd IN parent_catalog_locator.p_catalog_file^.catalog_heap;
            ELSE
              pfp$report_invalid_free (^path, {p_cycle_number} NIL, 'FILE_MEDIA_DESCRIPTOR', 'catalog',
                    prevalidate_free_result, #OFFSET(p_physical_fmd));
              p_physical_fmd := NIL;
            IFEND;
          IFEND;
        ELSE {internal catalog}
          IF catalog_locator.object_list_descriptor.p_object_list <> NIL THEN
            osp$prevalidate_free ((#OFFSET(catalog_locator.object_list_descriptor.p_object_list) -
                  #OFFSET(^parent_catalog_locator.p_catalog_file^.catalog_heap) - 16),
                  ^parent_catalog_locator.p_catalog_file^.catalog_heap, prevalidate_free_result);
            IF prevalidate_free_result = osc$heap_free_valid THEN
              FREE catalog_locator.object_list_descriptor.p_object_list IN
                    parent_catalog_locator.p_catalog_file^.catalog_heap;
            ELSE
              pfp$report_invalid_free (^path, {p_cycle_number} NIL, 'OBJECT_LIST_DESCRIPTOR',
                    'the catalog containing the object', prevalidate_free_result,
                    #OFFSET(catalog_locator.object_list_descriptor.p_object_list));
              catalog_locator.object_list_descriptor.p_object_list := NIL;
            IFEND;
          IFEND;
          parent_catalog_locator.queuing_info.set_catalog_alarm := TRUE;
        IFEND;

        contract_object_list (^path, parent_catalog_locator.p_catalog_file,
              parent_catalog_locator.object_list_descriptor, status);
      ELSE {catalog not empty}
        IF all_objects_purged THEN
          IF catalog_locator.object_list_descriptor.catalog_type = pfc$external_catalog THEN
            catalog_locator.queuing_info.set_catalog_alarm := TRUE;
          ELSE
            parent_catalog_locator.queuing_info.set_catalog_alarm := TRUE;
          IFEND;

          pmp$get_unique_name (unique_name, local_status);
          pfp$change_object_name (^path, unique_name, parent_catalog_locator.p_catalog_file, p_catalog_object,
                parent_catalog_locator.object_list_descriptor, status);

          p_catalog_object^.object_entry.object_type := pfc$purged_catalog_object;
          pfp$compute_checksum (#LOC (p_catalog_object^.object_entry), #SIZE (pft$object_entry),
                p_catalog_object^.checksum);
        ELSE { Catalog contains valid files or subcatalogs.
          variant_path.complete_path := TRUE;
          variant_path.p_complete_path := ^path;
          pfp$set_status_abnormal (variant_path, pfe$catalog_not_empty, status);
        IFEND;

        IF catalog_locator.object_list_descriptor.catalog_type = pfc$external_catalog THEN
          pfp$return_catalog (catalog_locator, local_status);
          pfp$process_unexpected_status (local_status);
        IFEND;
      IFEND;
    END /delete_catalog_object/;

    osp$disestablish_cond_handler;
    IF catalog_active THEN
      IF catalog_locator.object_list_descriptor.catalog_type = pfc$external_catalog THEN
        pfp$return_catalog (catalog_locator, local_status);
        pfp$process_unexpected_status (local_status);
      IFEND;
    IFEND;
  PROCEND pfp$delete_catalog_object;

?? TITLE := '  [XDCL] pfp$delete_file_object', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to delete a specific permanent file entry
{   from an object list.
{
{ DESIGN:
{   If no cycles exist for the file, the object entry for the file is deleted
{   from the object list and the object list is contracted.  If only purged
{   cycles exist for the file, the object type is changed to a purged file
{   type.  If any normal cycles still exist for the file, no action is taken
{   and normal status is returned.

  PROCEDURE [XDCL] pfp$delete_file_object
    (    p_path: ^pft$complete_path;
         p_catalog_file: {i^/o^} pft$p_catalog_file;
     VAR p_file_object: {i/o^} pft$p_object;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor;
     VAR status: ost$status);

    VAR
      all_cycles_purged: boolean,
      cycle_index: pft$cycle_index,
      empty_cycle_list: boolean,
      local_status: ost$status,
      p_cycle_list: ^pft$cycle_list,
      p_log_list: ^pft$log_list,
      p_permit_list: ^pft$permit_list,
      prevalidate_free_result: ost$prevalidate_free_result,
      unique_name: ost$name;


    PROCEDURE [INLINE] test_cycle_list
      (    p_cycle_list: {input} ^pft$cycle_list;
       VAR empty_cycle_list: boolean;
       VAR all_cycles_purged: boolean);

      VAR
        cycle_index: pft$cycle_index;

      empty_cycle_list := TRUE;
      all_cycles_purged := TRUE;

      IF p_cycle_list <> NIL THEN
        FOR cycle_index := 1 TO UPPERBOUND (p_cycle_list^) DO
          CASE p_cycle_list^ [cycle_index].cycle_entry.entry_type OF
          = pfc$normal_cycle_entry =
            empty_cycle_list := FALSE;
            all_cycles_purged := FALSE;
            RETURN;

          = pfc$purged_cycle_entry =
            empty_cycle_list := FALSE;

          ELSE {pfc$free_cycle_entry}
            ;
          CASEND;
        FOREND;
      IFEND;
    PROCEND test_cycle_list;


    status.normal := TRUE;

    IF (p_file_object <> NIL) AND (p_file_object^.object_entry.object_type IN
          $pft$object_selections [pfc$file_object, pfc$purged_file_object]) THEN
      pfp$build_cycle_list_pointer (p_file_object^.object_entry.cycle_list_locator, p_catalog_file,
            p_cycle_list);
      test_cycle_list (p_cycle_list, empty_cycle_list, all_cycles_purged);
      IF empty_cycle_list THEN
        pfp$build_permit_list_pointer (p_file_object^.object_entry.permit_list_locator, p_catalog_file,
              p_permit_list);
        pfp$build_log_list_pointer (p_file_object^.object_entry.log_list_locator, p_catalog_file, p_log_list);
        delete_object (p_path, p_file_object, p_catalog_file, object_list_descriptor);
        {
        { Free all space allocated for items owned by the file object.
        {
        IF p_cycle_list <> NIL THEN
          osp$prevalidate_free ((#OFFSET(p_cycle_list) - #OFFSET(^p_catalog_file^.catalog_heap) - 16),
                ^p_catalog_file^.catalog_heap, prevalidate_free_result);
          IF prevalidate_free_result = osc$heap_free_valid THEN
            FREE p_cycle_list IN p_catalog_file^.catalog_heap;
          ELSE
            pfp$report_invalid_free (p_path, {p_cycle_number} NIL, 'CYCLE_LIST', 'file',
                  prevalidate_free_result, #OFFSET(p_cycle_list));
            p_cycle_list := NIL;
          IFEND;
        IFEND;

        IF p_log_list <> NIL THEN
          osp$prevalidate_free ((#OFFSET(p_log_list) - #OFFSET(^p_catalog_file^.catalog_heap) - 16),
                ^p_catalog_file^.catalog_heap, prevalidate_free_result);
          IF prevalidate_free_result = osc$heap_free_valid THEN
            FREE p_log_list IN p_catalog_file^.catalog_heap;
          ELSE
            pfp$report_invalid_free (p_path, {p_cycle_number} NIL, 'LOG_LIST', 'file',
                  prevalidate_free_result, #OFFSET(p_log_list));
            p_log_list := NIL;
          IFEND;
        IFEND;

        IF p_permit_list <> NIL THEN
          osp$prevalidate_free ((#OFFSET(p_permit_list) - #OFFSET(^p_catalog_file^.catalog_heap) - 16),
                ^p_catalog_file^.catalog_heap, prevalidate_free_result);
          IF prevalidate_free_result = osc$heap_free_valid THEN
            FREE p_permit_list IN p_catalog_file^.catalog_heap;
          ELSE
            pfp$report_invalid_free (p_path, {p_cycle_number} NIL, 'PERMIT_LIST', 'file',
                  prevalidate_free_result, #OFFSET(p_permit_list));
            p_permit_list := NIL;
          IFEND;
        IFEND;

        contract_object_list (p_path, p_catalog_file, object_list_descriptor, status);
      ELSEIF all_cycles_purged THEN
        pmp$get_unique_name (unique_name, local_status);
        pfp$change_object_name (p_path, unique_name, p_catalog_file, p_file_object, object_list_descriptor,
              status);
        p_file_object^.object_entry.object_type := pfc$purged_file_object;
        pfp$compute_checksum (#LOC (p_file_object^.object_entry), #SIZE (pft$object_entry),
              p_file_object^.checksum);
      IFEND;
    IFEND;
  PROCEND pfp$delete_file_object;

?? TITLE := '  [XDCL] pfp$establish_free_object_entry', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to establish a free object entry in an
{ object list.  This is accomplished by either finding an existing free entry
{ or by expanding the object list to create a free entry.  If it is necessary
{ to expand the object list, a new larger object list is created and the old
{ list is copied to the new list.
{   If expanding the object list causes the number of objects to equal or
{ exceed the value, pfc$object_sort_threshold, the entire object list will
{ be sorted prior to copying to the new object list.
{   If a sorted object list is expanded the unsorted portion of the object
{ list is sorted and merged with the sorted portion while copying to the
{ new object list. Free objects will be removed from the sorted portion of
{ the object list.

  PROCEDURE [XDCL] pfp$establish_free_object_entry
    (    p_path: ^pft$complete_path;
         p_catalog_file: {output^} ^pft$catalog_file;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor;
     VAR p_object: {output} ^pft$physical_object;
     VAR status: ost$status);

    VAR
      new_object_count: pft$object_count,
      new_sorted_object_count: pft$object_count,
      new_valid_object_count: pft$object_count,
      object_index: pft$object_index,
      p_new_object_list: ^pft$object_list,
      p_object_list: ^pft$object_list,
      p_object_name_list: ^pft$object_name_list;

    PROCEDURE [INLINE] locate_free_object_entry
      (    object_list_descriptor: pft$object_list_descriptor;
       VAR p_object: {output} ^pft$physical_object);

      VAR
        object_index: pft$object_index,
        p_object_list: ^pft$object_list;

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

      p_object := NIL;
    PROCEND locate_free_object_entry;


    status.normal := TRUE;

    locate_free_object_entry (object_list_descriptor, p_object);
    IF p_object = NIL THEN
      IF object_list_descriptor.p_object_list = NIL THEN
        new_object_count := 0;
        merge_object_list ({p_object_name_list} NIL, new_object_count, {p_object_list} NIL, p_catalog_file,
              object_list_descriptor, p_new_object_list, new_valid_object_count, status);
        IF status.normal THEN
          new_sorted_object_count := 0;
          p_object := ^p_new_object_list^ [1];
        IFEND;
      ELSE { An old object list currently exists.
        p_object_list := object_list_descriptor.p_object_list;
        new_object_count := UPPERBOUND (p_object_list^) + pfp$object_expansion_size (p_object_list);
        IF object_list_descriptor.sorted_object_count > 0 THEN
          new_object_count := new_object_count - object_list_descriptor.free_sorted_object_count;
        IFEND;

        IF new_object_count >= pfc$object_sort_threshold THEN
          IF object_list_descriptor.sorted_object_count > 0 THEN
            PUSH p_object_name_list: [1 .. UPPERBOUND (p_object_list^) -
                  object_list_descriptor.sorted_object_count];
          ELSE
            PUSH p_object_name_list: [1 .. new_object_count];
          IFEND;

          build_object_name_list (object_list_descriptor, p_object_name_list, new_object_count);
          heap_sort (new_object_count, p_object_name_list);
          merge_object_list (p_object_name_list, new_object_count, p_object_list, p_catalog_file,
                object_list_descriptor, p_new_object_list, new_valid_object_count, status);
          IF status.normal THEN
            new_sorted_object_count := new_valid_object_count;
            p_object := ^p_new_object_list^ [new_valid_object_count + 1];
          IFEND;
        ELSE
          PUSH p_object_name_list: [1 .. new_object_count];
          build_object_name_list (object_list_descriptor, p_object_name_list, new_object_count);
          merge_object_list (p_object_name_list, new_object_count, p_object_list, p_catalog_file,
                object_list_descriptor, p_new_object_list, new_valid_object_count, status);
          IF status.normal THEN
            new_sorted_object_count := 0;
            p_object := ^p_new_object_list^ [new_valid_object_count + 1];
          IFEND;
        IFEND;
      IFEND;

      IF status.normal THEN
        object_list_descriptor.free_sorted_object_count := 0;
        object_list_descriptor.sorted_object_count := new_sorted_object_count;
        pfp$update_object_list_locator (p_path, p_new_object_list, p_catalog_file, object_list_descriptor);
      IFEND;
    IFEND;
  PROCEND pfp$establish_free_object_entry;

?? TITLE := '  [XDCL] pfp$get_sorted_object_name_list', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to generate an array containing an
{ entry for each non-free object in the unsorted portion of the specified
{ object list. Each entry will contain the objects external name and its
{ index in the object list. This array will then be sorted rather than
{ sorting the object list itself. Each element of an object list is 262 bytes,
{ while each object of this list is 35 bytes.

  PROCEDURE [XDCL] pfp$get_sorted_object_name_list
    (    object_list_descriptor: pft$object_list_descriptor;
         p_object_name_list: ^pft$object_name_list;
     VAR object_name_count: pft$object_count);

    build_object_name_list (object_list_descriptor, p_object_name_list, object_name_count);
    heap_sort (object_name_count, p_object_name_list);
  PROCEND pfp$get_sorted_object_name_list;

?? TITLE := '  [XDCL] pfp$locate_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to search an object list for an object
{ with the specified name.  If the object cannot be found or the object type
{ is not included in the specified valid_objects, a NIL pointer is returned
{ for p_object.
{   The sorted portion of the object list is searched first using a binary
{ search and the unsorted portion of the object list is then searched using
{ a linear search.
{  The system attribute, BINARY_CATALOG_SEARCH, establishes the value of the
{ variable pfv$binary_catalog_search. If set to FALSE a linear search will be
{ performed on the entire catalog to locate the specified object.

  PROCEDURE [XDCL] pfp$locate_object
    (    object_name: pft$name;
         valid_objects: pft$object_selections;
         object_list_descriptor: pft$object_list_descriptor;
     VAR p_object: {output} ^pft$physical_object);

    VAR
      new_valid_objects: pft$object_selections,
      object_index: pft$object_index;

    p_object := NIL;
    IF (object_list_descriptor.sorted_object_count <> 0) AND pfv$binary_catalog_search THEN
      locate_sorted_object (object_name, valid_objects, object_list_descriptor, p_object, object_index);
    IFEND;

    IF p_object = NIL THEN
      locate_unsorted_object (object_name, valid_objects, object_list_descriptor, p_object, object_index);
    IFEND;

  PROCEND pfp$locate_object;

?? TITLE := '  [XDCL] pfp$sort_object_list', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to unconditionally sort the old object
{ list and place the results in the new object list. The old object list is
{ assumed to be unsorted. The new object list is assumed to have been allocated
{ by the caller and be large enough to hold all non-free objects in the old
{ object list.

  PROCEDURE [XDCL] pfp$sort_object_list
    (    p_object_list: {input} ^pft$object_list;
         p_new_object_list: {i/o} ^pft$object_list;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor);

    VAR
      free_object_index: pft$object_index,
      free_physical_object: pft$physical_object,
      new_object_count: pft$object_count,
      object_index: pft$object_index,
      p_object_name_list: ^pft$object_name_list;

  /sort_object_list/
    BEGIN
      IF p_object_list = NIL THEN
        EXIT /sort_object_list/;
      IFEND;

      free_physical_object.object_entry.object_type := pfc$free_object;
      free_physical_object.object_entry.external_object_name := osc$null_name;
      pfp$compute_checksum (^free_physical_object.object_entry, #SIZE (pft$object_entry),
            free_physical_object.checksum);

      object_list_descriptor.p_object_list := p_object_list;
      object_list_descriptor.sorted_object_count := 0;
      PUSH p_object_name_list: [1 .. UPPERBOUND (p_object_list^)];
      build_object_name_list (object_list_descriptor, p_object_name_list, new_object_count);
      heap_sort (new_object_count, p_object_name_list);

      IF new_object_count > 0 THEN
        FOR object_index := 1 to new_object_count DO
          p_new_object_list^[object_index] := p_object_list^[p_object_name_list^[object_index].object_index];
        FOREND;
        free_object_index := new_object_count + 1;
      ELSE
        free_object_index := 1;
      IFEND;

      FOR object_index := free_object_index TO UPPERBOUND(p_new_object_list^) DO
        p_new_object_list^[object_index] := free_physical_object;
      FOREND;

      object_list_descriptor.p_object_list := p_new_object_list;
      object_list_descriptor.sorted_object_count := new_object_count;
      IF UPPERBOUND(p_new_object_list^) < pfc$object_sort_threshold THEN
        object_list_descriptor.sorted_object_count := 0;
      IFEND;
      object_list_descriptor.free_sorted_object_count := 0;

    END /sort_object_list/;
  PROCEND pfp$sort_object_list;

?? TITLE := '  [XDCL] pfp$update_obj_list_descriptor', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to determine if the specified object is
{ located in the sorted portion of the specified object list and if so,
{ increment the free_sorted_object_count field in the object_list_descriptor.
{ This procedure is intended for use by routines that are deleting objects
{ from object lists.

  PROCEDURE [XDCL] pfp$update_obj_list_descriptor
    (    p_object: ^pft$physical_object;
     VAR object_list_descriptor: pft$object_list_descriptor);

    VAR
      object_index: pft$object_index,
      p_found_object: ^pft$physical_object;

    IF object_list_descriptor.sorted_object_count > 0 THEN
      locate_sorted_object (p_object^.object_entry.external_object_name,
            $pft$object_selections [pfc$file_object, pfc$catalog_object, pfc$purged_catalog_object,
            pfc$purged_file_object], object_list_descriptor, p_found_object, object_index);
      IF (p_found_object <> NIL) AND (object_index <= object_list_descriptor.sorted_object_count) THEN
        object_list_descriptor.free_sorted_object_count :=
              object_list_descriptor.free_sorted_object_count + 1;
      IFEND;
    IFEND;
  PROCEND pfp$update_obj_list_descriptor;

?? TITLE := '  [XDCL] pfp$update_object_list_locator', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to update the object_list_locator in
{ the specified catalog with information from the specified
{ object_list_descriptor and p_new_object_list.

  PROCEDURE [XDCL] pfp$update_object_list_locator
    (    p_path: ^pft$complete_path;
         p_new_object_list: {input} pft$p_object_list;
         p_catalog_file: {i^/o^} pft$p_catalog_file;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor);

    VAR
      object_list_locator: pft$object_list_locator,
      prevalidate_free_result: ost$prevalidate_free_result;

    IF p_new_object_list = NIL THEN
      pfp$build_object_list_locator (object_list_descriptor.sorted_object_count,
            object_list_descriptor.free_sorted_object_count, object_list_descriptor.p_object_list,
            p_catalog_file, object_list_locator);
    ELSE
      pfp$build_object_list_locator (object_list_descriptor.sorted_object_count,
            object_list_descriptor.free_sorted_object_count, p_new_object_list, p_catalog_file,
            object_list_locator);
    IFEND;

    IF object_list_descriptor.catalog_type = pfc$internal_catalog THEN
      object_list_descriptor.p_parent_catalog^.object_entry.catalog_object_locator.object_list_locator :=
            object_list_locator;
      pfp$compute_checksum (#LOC (object_list_descriptor.p_parent_catalog^.object_entry),
            #SIZE (pft$object_entry), object_list_descriptor.p_parent_catalog^.checksum);
    ELSE {external catalog}
      object_list_descriptor.p_physical_catalog_header^.catalog_header.object_list_locator :=
            object_list_locator;
      pfp$compute_checksum (#LOC (object_list_descriptor.p_physical_catalog_header^.catalog_header),
            #SIZE (pft$catalog_header), object_list_descriptor.p_physical_catalog_header^.checksum);
    IFEND;
    {
    { Free the old object_list from the catalog.
    {
    IF p_new_object_list <> NIL THEN
      IF object_list_descriptor.p_object_list <> NIL THEN
        osp$prevalidate_free ((#OFFSET(object_list_descriptor.p_object_list) -
              #OFFSET(^p_catalog_file^.catalog_heap) - 16),
              ^p_catalog_file^.catalog_heap, prevalidate_free_result);
        IF prevalidate_free_result = osc$heap_free_valid THEN
          FREE object_list_descriptor.p_object_list IN p_catalog_file^.catalog_heap;
        ELSE
          pfp$report_invalid_free (p_path, {p_cycle_number} NIL, 'OBJECT_LIST_DESCRIPTOR',
                'the catalog containing the object', prevalidate_free_result,
                #OFFSET(object_list_descriptor.p_object_list));
          object_list_descriptor.p_object_list := NIL;
        IFEND;
      IFEND;
      object_list_descriptor.p_object_list := p_new_object_list;
    IFEND;
  PROCEND pfp$update_object_list_locator;

?? TITLE := '  [INLINE] adjust', EJECT ??

  PROCEDURE [INLINE] adjust
    (    p_object_name_list: {i/o} ^pft$object_name_list;
         i: pft$object_index;
         n: pft$object_index);

    VAR
      j: pft$object_index,
      k: pft$object_index,
      r: pft$object_name,
      done: boolean;

    done := FALSE;
    r := p_object_name_list^ [i];
    j := 2 * i;

    WHILE ((j <= n) AND NOT done) DO
      IF j < n THEN
        IF p_object_name_list^ [j].object_name < p_object_name_list^ [j + 1].object_name THEN
          j := j + 1;
        IFEND;
      IFEND;
      IF r.object_name < p_object_name_list^ [j].object_name THEN
        p_object_name_list^ [j DIV 2] := p_object_name_list^ [j];
        j := 2 * j;
      ELSE
        done := TRUE;
      IFEND;
    WHILEND;
    p_object_name_list^ [j DIV 2] := r;
  PROCEND adjust;

?? TITLE := '  [INLINE] build_object_name_list', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to generate an array containing an
{ entry for each non-free object in the unsorted portion of the specified
{ object list. Each entry will contain the objects external name and its
{ index in the object list. This array will then be sorted rather than
{ sorting the object list itself. Each element of an object list is 262 bytes,
{ while each object of this list is 35 bytes.

  PROCEDURE [INLINE] build_object_name_list
    (    object_list_descriptor: pft$object_list_descriptor;
         p_object_name_list: {output} ^pft$object_name_list;
     VAR object_name_count: pft$object_count);

    VAR
      ignore_status: ost$status,
      object_index: pft$object_index,
      p_object_list: ^pft$object_list;

    p_object_list := object_list_descriptor.p_object_list;
    object_name_count := 0;
    FOR object_index := (object_list_descriptor.sorted_object_count + 1) TO UPPERBOUND (p_object_list^) DO
      IF p_object_list^ [object_index].object_entry.object_type <> pfc$free_object THEN
        object_name_count := object_name_count + 1;
        p_object_name_list^ [object_name_count].object_index := object_index;
        p_object_name_list^ [object_name_count].object_name :=
              p_object_list^ [object_index].object_entry.external_object_name;
      IFEND;
    FOREND;
  PROCEND build_object_name_list;

?? TITLE := '  contract_object_list', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to analyze an object list and contract it
{ if necessary. When an object list is contracted the following will occur:
{    o Allocate space in the catalog for the new, smaller, object list.
{    o If required, sort the unsorted portion of the old object list.
{    o Copy the old object list to the new object list removing free objects.
{    o Initialize the remaining objects in the new object list as free objects.
{    o Update the object list locator in the catalog header.
{    o Free the space in the catalog used by the old object list.
{
{ For unsorted object lists the object list will be contracted when the total
{ number of free objects equals or exceeds the value pfp$object_contraction_count.
{ For sorted object lists the object list will be contracted when the number
{ of free objects in the sorted portion of the object list equals or exceeds
{ the value pfp$object_contraction_count.

  PROCEDURE contract_object_list
    (    p_path: ^pft$complete_path;
         p_catalog_file: {output^} ^pft$catalog_file;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor;
     VAR status: ost$status);

    VAR
      high_object_index: pft$object_index,
      new_object_count: pft$object_count,
      new_object_index: pft$object_index,
      new_valid_object_count: pft$object_count,
      object_index: pft$object_index,
      p_found_object: ^pft$physical_object,
      p_new_object_list: ^pft$object_list,
      p_object_list: ^pft$object_list,
      p_object_name_list: ^pft$object_name_list,
      update_catalog: boolean;

    status.normal := TRUE;
    update_catalog := FALSE;
    p_object_list := object_list_descriptor.p_object_list;

  /contract_object_list_block/
    BEGIN
      IF p_object_list = NIL THEN
        EXIT /contract_object_list_block/;
      IFEND;

      IF object_list_descriptor.sorted_object_count > 0 THEN
        p_new_object_list := NIL;

        IF object_list_descriptor.free_sorted_object_count >=
              pfp$object_contraction_count (p_object_list) THEN
          PUSH p_object_name_list: [1 .. UPPERBOUND (p_object_list^) -
                object_list_descriptor.sorted_object_count];
          build_object_name_list (object_list_descriptor, p_object_name_list, new_object_count);
          heap_sort (new_object_count, p_object_name_list);
          merge_object_list (p_object_name_list, new_object_count, p_object_list, p_catalog_file,
                object_list_descriptor, p_new_object_list, new_valid_object_count, status);
          IF status.normal THEN
            update_catalog := TRUE;
            object_list_descriptor.sorted_object_count := new_valid_object_count;
            IF UPPERBOUND (p_new_object_list^) < pfc$object_sort_threshold THEN
              object_list_descriptor.sorted_object_count := 0;
            IFEND;
            object_list_descriptor.free_sorted_object_count := 0;
          IFEND;
        IFEND;
      ELSEIF UPPERBOUND (p_object_list^) >= pfc$object_sort_threshold THEN
        p_new_object_list := NIL;

        PUSH p_object_name_list: [1 .. UPPERBOUND (p_object_list^)];
        build_object_name_list (object_list_descriptor, p_object_name_list, new_object_count);
        heap_sort (new_object_count, p_object_name_list);
        merge_object_list (p_object_name_list, new_object_count, p_object_list, p_catalog_file,
              object_list_descriptor, p_new_object_list, new_valid_object_count, status);
        IF status.normal THEN
          update_catalog := TRUE;
          object_list_descriptor.sorted_object_count := new_valid_object_count;
          IF UPPERBOUND(p_new_object_list^) < pfc$object_sort_threshold THEN
            object_list_descriptor.sorted_object_count := 0;
          IFEND;
          object_list_descriptor.free_sorted_object_count := 0;
        IFEND;
      ELSE
        {
        { Unsorted object_list.
        {
        PUSH p_object_name_list: [1 .. UPPERBOUND (p_object_list^)];
        build_object_name_list (object_list_descriptor, p_object_name_list, new_object_count);
        IF (UPPERBOUND (p_object_list^) - new_object_count) >=
              pfp$object_contraction_count (p_object_list) THEN
          merge_object_list (p_object_name_list, new_object_count, p_object_list, p_catalog_file,
                object_list_descriptor, p_new_object_list, new_valid_object_count, status);
          IF status.normal THEN
            update_catalog := TRUE;
            object_list_descriptor.sorted_object_count := 0;
            object_list_descriptor.free_sorted_object_count := 0;
          IFEND;
        IFEND;
      IFEND;

      IF status.normal THEN
        IF update_catalog THEN
          pfp$update_object_list_locator (p_path, p_new_object_list, p_catalog_file, object_list_descriptor);
        IFEND;
      ELSEIF status.condition = pfe$catalog_full THEN
        status.normal := TRUE;
      IFEND;
    END /contract_object_list_block/;
  PROCEND contract_object_list;

?? TITLE := '  delete_inaccessible_catalog', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to delete a catalog object that resides on
{   an unavailable volume from the specified object list.
{
{ DESIGN:
{   The object list is contracted if necessary.

  PROCEDURE delete_inaccessible_catalog
    (    path: pft$complete_path;
     VAR catalog_locator: {i/o} pft$catalog_locator;
     VAR p_catalog_object: {i^/o^} ^pft$physical_object;
     VAR parent_catalog_locator: {i/o} pft$catalog_locator;
     VAR status: ost$status);

    CONST
      critical_message = TRUE;

    VAR
      all_objects_purged: boolean,
      ascii_log_text_length: integer,
      local_status: ost$status,
      p_ascii_log_text: ^string (7 {lines} * (108 - 21) {max characters/line} ),
      p_permit_list: ^pft$permit_list,
      p_physical_fmd: ^pft$physical_fmd,
      prevalidate_free_result: ost$prevalidate_free_result,
      unique_name: ost$name,
      variant_path: pft$variant_path;

    status.normal := TRUE;

    pfp$detach_unavail_queued_cat (p_catalog_object^.object_entry.internal_object_name, catalog_locator);
    delete_object (^path, p_catalog_object, parent_catalog_locator.p_catalog_file,
          parent_catalog_locator.object_list_descriptor);
    {
    { Free all space allocated for the catalog entry.
    {
    pfp$build_permit_list_pointer (p_catalog_object^.object_entry.permit_list_locator,
          parent_catalog_locator.p_catalog_file, p_permit_list);
    IF p_permit_list <> NIL THEN
      osp$prevalidate_free ((#OFFSET(p_permit_list) -
            #OFFSET(^parent_catalog_locator.p_catalog_file^.catalog_heap) - 16),
            ^parent_catalog_locator.p_catalog_file^.catalog_heap, prevalidate_free_result);
      IF prevalidate_free_result = osc$heap_free_valid THEN
        FREE p_permit_list IN parent_catalog_locator.p_catalog_file^.catalog_heap;
      ELSE
        pfp$report_invalid_free (^path, {p_cycle_number} NIL, 'PERMIT_LIST', 'catalog',
              prevalidate_free_result, #OFFSET(p_permit_list));
        p_permit_list := NIL;
      IFEND;
    IFEND;

    pfp$build_fmd_pointer (p_catalog_object^.object_entry.catalog_object_locator.fmd_locator,
          parent_catalog_locator.p_catalog_file, p_physical_fmd);

    dmp$destroy_permanent_file (p_catalog_object^.object_entry.catalog_object_locator.global_file_name,
          p_physical_fmd^.fmd, status);
    IF status.normal THEN
      PUSH p_ascii_log_text;
      STRINGREP (p_ascii_log_text^, ascii_log_text_length, 'A catalog was deleted which resides on a',
            ' missing or unavailable volume or which contains a subcatalog or file cycle which',
            ' resides on a missing or unavailable volume.  The disk space of the catalog''s subtree',
            ' can only be regained by deleting unreconciled files during a continuation deadstart.',
            '  Refer to the DELETE_UNRECONCILED_FILES system attribute.  The deletion of',
            ' unreconciled files should only be scheduled subsequent to the reinstatement of the',
            ' missing or unavailable volume(s).');
      pfp$log_ascii (p_ascii_log_text^ (1, ascii_log_text_length), $pmt$ascii_logset [pmc$system_log],
            pmc$msg_origin_system, NOT critical_message, local_status);
      STRINGREP (p_ascii_log_text^, ascii_log_text_length, 'You deleted a catalog which resides on a',
            ' missing or unavailable volume or which contains a subcatalog or file cycle which',
            ' resides on a missing or unavailable volume.  The disk space of the catalog''s subtree',
            ' cannot be freed until your site deletes unreconciled files.  Please contact your site',
            ' analyst to regain your space.');
      pfp$log_ascii (p_ascii_log_text^ (1, ascii_log_text_length), $pmt$ascii_logset [pmc$job_log],
            pmc$msg_origin_system, NOT critical_message, local_status);
    IFEND;

    IF p_physical_fmd <> NIL THEN
      osp$prevalidate_free ((#OFFSET(p_physical_fmd) -
            #OFFSET(^parent_catalog_locator.p_catalog_file^.catalog_heap) - 16),
            ^parent_catalog_locator.p_catalog_file^.catalog_heap, prevalidate_free_result);
      IF prevalidate_free_result = osc$heap_free_valid THEN
        FREE p_physical_fmd IN parent_catalog_locator.p_catalog_file^.catalog_heap;
      ELSE
        pfp$report_invalid_free (^path, {p_cycle_number} NIL, 'FILE_MEDIA_DESCRIPTOR', 'catalog',
              prevalidate_free_result, #OFFSET(p_physical_fmd));
        p_physical_fmd := NIL;
      IFEND;
    IFEND;

    contract_object_list (^path, parent_catalog_locator.p_catalog_file,
          parent_catalog_locator.object_list_descriptor, status);
  PROCEND delete_inaccessible_catalog;

?? TITLE := '  delete_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to delete the specified object from the
{ specified object list.  If the object is located in the sorted portion of
{ a sorted object list the free_sorted_object_count field in the
{ object_list_descriptor is incremented.

  PROCEDURE delete_object
    (    p_path: ^pft$complete_path;
         p_object: {i/o} ^pft$physical_object;
         p_catalog_file: {output} ^pft$catalog_file;
     VAR object_list_descriptor: {i/o} pft$object_list_descriptor);

    VAR
      object_index: pft$object_index,
      p_found_object: ^pft$physical_object;

    IF object_list_descriptor.sorted_object_count > 0 THEN
      locate_sorted_object (p_object^.object_entry.external_object_name,
            $pft$object_selections [pfc$file_object, pfc$purged_file_object, pfc$catalog_object,
            pfc$purged_catalog_object], object_list_descriptor, p_found_object, object_index);
      p_object^.object_entry.object_type := pfc$free_object;
      pfp$compute_checksum (^p_object^.object_entry, #SIZE (pft$object_entry), p_object^.checksum);
      IF (p_found_object <> NIL) AND (object_index <= object_list_descriptor.sorted_object_count) THEN
        object_list_descriptor.free_sorted_object_count :=
              object_list_descriptor.free_sorted_object_count + 1;
        pfp$update_object_list_locator (p_path, {p_new_object_list} NIL, p_catalog_file,
              object_list_descriptor);
      IFEND;
    ELSE { Unsorted object list
      p_object^.object_entry.object_type := pfc$free_object;
      pfp$compute_checksum (^p_object^.object_entry, #SIZE (pft$object_entry), p_object^.checksum);
    IFEND;
  PROCEND delete_object;

?? TITLE := '  heap_sort', EJECT ??
{ DESIGN:
{   The following sort algorithm is a nonrecursive heap sort.  There are two
{   phases to the algorithm.  The first phase converts the list to be sorted
{   into a binary tree representation.  The second and main sorting phase of
{   the algorithm iterates through the unsorted portion of the list.  In each
{   iteration the first element and the last element of the unsorted portion
{   are swapped, and adjust is called.  Adjust searches the right and left
{   subtrees for the highest key value, which becomes the root of the tree, and
{   is returned in the first element of the list.  Each call to adjust is
{   passed a tree containing one fewer nodes than the previous call.

  PROCEDURE heap_sort
    (    object_name_count: pft$object_count;
         p_object_name_list {i^/o^} : ^pft$object_name_list);

    VAR
      temp_record: pft$object_name,
      unsorted_object_count: pft$object_count;

    FOR unsorted_object_count := object_name_count DIV 2 DOWNTO 1 DO
      adjust (p_object_name_list, unsorted_object_count, object_name_count);
    FOREND;

    FOR unsorted_object_count := object_name_count - 1 DOWNTO 1 DO
      temp_record := p_object_name_list^ [unsorted_object_count + 1];
      p_object_name_list^ [unsorted_object_count + 1] := p_object_name_list^ [1];
      p_object_name_list^ [1] := temp_record;
      adjust (p_object_name_list, 1, unsorted_object_count);
    FOREND;
  PROCEND heap_sort;

?? TITLE := '  locate_sorted_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to search the sorted portion of a sorted
{ object_list for an object with the specified name.  A binary search is used.
{ If the object cannot be found or the object type is not included in the
{ specified valid objects a NIL pointer is returned for p_object.
{ If binary searching is disabled by the system attribure
{ BINARY_CATALOG_SEARCH a linear search will be used to locate the object.
{ The value returned in the OBJECT_INDEX parameter is only valid if the
{ P_OBJECT parameter is non-NIL (i.e. the object is found).

  PROCEDURE locate_sorted_object
    (    object_name: pft$name;
         valid_objects: pft$object_selections;
         object_list_descriptor: pft$object_list_descriptor;
     VAR p_object: {output} ^pft$physical_object;
     VAR object_index: pft$object_index);

    VAR
      temp: integer,
      high_index: pft$object_count,
      low_index: pft$object_index,
      mid_index: pft$object_index,
      p_object_list: ^pft$object_list;

    IF pfv$binary_catalog_search THEN
      p_object := NIL;
      p_object_list := object_list_descriptor.p_object_list;

      IF (p_object_list <> NIL) AND (object_list_descriptor.sorted_object_count <> 0) THEN
        low_index := LOWERBOUND (p_object_list^);
        high_index := object_list_descriptor.sorted_object_count;

      /binary_search/
        WHILE low_index <= high_index DO
          temp := low_index + high_index;
          mid_index := temp DIV 2;
          IF object_name > p_object_list^ [mid_index].object_entry.external_object_name THEN
            low_index := mid_index + 1;
          ELSEIF object_name < p_object_list^ [mid_index].object_entry.external_object_name THEN
            high_index := mid_index - 1;
          ELSE
            IF p_object_list^ [mid_index].object_entry.object_type IN valid_objects THEN
              p_object := ^p_object_list^ [mid_index];
              object_index := mid_index;
            IFEND;
            EXIT /binary_search/;
          IFEND;
        WHILEND /binary_search/;
      IFEND;
    ELSE {binary search disabled.
      locate_unsorted_object (object_name, valid_objects, object_list_descriptor, p_object, object_index);
    IFEND;
  PROCEND locate_sorted_object;

?? TITLE := '  [INLINE] locate_unsorted_object', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to search the unsorted portion of an
{ object_list for an object with the specified name.  A linear search is used.
{ If the object cannot be found or the object type is not included in the
{ specified valid objects a NIL pointer is returned for p_object.
{ If the object list in not sorted or binary searching is disabled the
{ entire object list is searched for the object. If the object list is sorted
{ and binary searching is enabled only the unsorted portion of the object
{ list is searched.
{ The value returned in the OBJECT_INDEX parameter is only valid if the
{ P_OBJECT parameter is non-NIL (i.e. the object is found).

  PROCEDURE [INLINE] locate_unsorted_object
    (    object_name: pft$name;
         valid_objects: pft$object_selections;
         object_list_descriptor: pft$object_list_descriptor;
     VAR p_object: {output} ^pft$physical_object;
     VAR object_index: pft$object_index);

    VAR
      p_object_list: ^pft$object_list,
      start_object_index: pft$object_index;


    p_object := NIL;
    p_object_list := object_list_descriptor.p_object_list;

    IF p_object_list <> NIL THEN
      IF pfv$binary_catalog_search THEN
        start_object_index  := object_list_descriptor.sorted_object_count + 1;
      ELSE
        start_object_index := LOWERBOUND (p_object_list^);
      IFEND;

    /locate_object/
      FOR object_index := start_object_index TO UPPERBOUND (p_object_list^) DO
        IF (p_object_list^ [object_index].object_entry.external_object_name = object_name) AND
              (p_object_list^ [object_index].object_entry.object_type IN valid_objects) THEN
          p_object := ^p_object_list^ [object_index];
          EXIT /locate_object/;
        IFEND;
      FOREND /locate_object/;
    IFEND;
  PROCEND locate_unsorted_object;

?? TITLE := '  merge_object_list', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to allocate and initialize an object list
{ given an object_name_list and an existing object_list. The object_name_list
{ will contain the object_name and index into the object_list for each object
{ in the unsorted portion of the object_list. The new object list will contain
{ all the non-free objects of the old object list and pfp$object_expansion_size
{ free objects at the end of the object_list.
{ The new object list will be constructed as follows:
{   If (p_object_name_list = NIL) AND (p_object_list = NIL)
{     An object list is allocated with all free objects.
{   If (p_object_name_list <> NIL) AND (p_object_list^ is unsorted)
{      The elements are moved from the old object list to the new object list
{     using the object_name_list to determine their order. The object_name_list
{     will be in sorted order if the new object list is larger than the value
{     pfc$object_sort_threshold. Otherwise it will be in unsorted order.
{   IF (p_object_name_list <> NIL) AND (p_object_list^ is sorted)
{     The elements from the sorted and unsorted portion of the object list
{     are merged into the new object list to create a new sorted object list.

  PROCEDURE merge_object_list
    (    p_object_name_list: ^pft$object_name_list;
         object_name_count: pft$object_count;
         p_object_list: ^pft$object_list;
         p_catalog_file: {output} ^pft$catalog_file;
         object_list_descriptor: pft$object_list_descriptor;
     VAR p_new_object_list: ^pft$object_list;
     VAR new_valid_object_count: pft$object_count;
     VAR status: ost$status);

    VAR
      free_physical_object: pft$physical_object,
      i: pft$object_count,
      new_object_index: pft$object_count,
      max_object_name_index: pft$object_count,
      max_object_index: pft$object_count,
      new_total: pft$object_count,
      object_name_index: pft$object_count,
      object_index: pft$object_count;

    {
    { Compute the size of the new_object_list and allocate.
    {

    new_total := object_list_descriptor.sorted_object_count + object_name_count +
          pfp$object_expansion_size (p_object_list);
    IF object_list_descriptor.sorted_object_count > 0 THEN
      new_total := new_total - object_list_descriptor.free_sorted_object_count;
    IFEND;

    ALLOCATE p_new_object_list: [1 .. new_total] IN p_catalog_file^.catalog_heap;
    IF p_new_object_list <> NIL THEN
      status.normal := TRUE;
    ELSE
      osp$set_status_condition (pfe$catalog_full, status);
      RETURN;
    IFEND;

    IF p_object_name_list = NIL THEN
      object_name_index := 1;
      max_object_name_index := 0;
    ELSE
      object_name_index := LOWERBOUND (p_object_name_list^);
      max_object_name_index := object_name_count;
    IFEND;

    IF p_object_list = NIL THEN
      object_index := 1;
      max_object_index := 0;
    ELSE
      object_index := LOWERBOUND (p_object_list^);
      max_object_index := object_list_descriptor.sorted_object_count;
    IFEND;

    new_object_index := LOWERBOUND (p_new_object_list^);

    {
    { Merge sorted and unsorted portions of object_list into new_object_list.
    {
    WHILE ((object_name_index <= max_object_name_index) AND (object_index <= max_object_index)) DO
      IF p_object_list^ [object_index].object_entry.object_type = pfc$free_object THEN
        { Skip free objects in the sorted portion of the old object list.
        object_index := object_index + 1;
      ELSEIF p_object_name_list^ [object_name_index].object_name <= p_object_list^ [object_index].
            object_entry.external_object_name THEN
        p_new_object_list^ [new_object_index] := p_object_list^
              [p_object_name_list^ [object_name_index].object_index];
        object_name_index := object_name_index + 1;
        new_object_index := new_object_index + 1;
      ELSE
        p_new_object_list^ [new_object_index] := p_object_list^ [object_index];
        object_index := object_index + 1;
        new_object_index := new_object_index + 1;
      IFEND;
    WHILEND;

    {
    { Either the sorted or unsorted portion is exhausted.
    { Move remaining elements into new object_list.
    {
    IF object_name_index > max_object_name_index THEN
      FOR i := object_index TO max_object_index DO
        IF p_object_list^ [i].object_entry.object_type <> pfc$free_object THEN
          p_new_object_list^ [new_object_index] := p_object_list^ [i];
          new_object_index := new_object_index + 1;
        IFEND;
      FOREND;
    ELSE
      FOR i := object_name_index TO max_object_name_index DO
        p_new_object_list^ [new_object_index] := p_object_list^ [p_object_name_list^ [i].object_index];
        new_object_index := new_object_index + 1;
      FOREND;
    IFEND;

    {
    { Initialize remaining objects as free objects.
    {
    free_physical_object.object_entry.object_type := pfc$free_object;
    free_physical_object.object_entry.external_object_name := osc$null_name;
    pfp$compute_checksum (^free_physical_object.object_entry, #SIZE (pft$object_entry),
          free_physical_object.checksum);

    new_valid_object_count := new_object_index - 1;
    FOR i := new_object_index TO UPPERBOUND (p_new_object_list^) DO
      p_new_object_list^ [i] := free_physical_object;
    FOREND;
  PROCEND merge_object_list;

?? OLDTITLE, SKIP := 2 ??
MODEND pfm$object_list_manager;
