?? NEWTITLE := 'NOS/VE Device Management' ??
MODULE dmm$file_table_manager;
?? RIGHT := 110 ??

{
{ PURPOSE:
{
{  The purpose of this module is to manage the system and job file tables from
{  job mode.  This includes creation of the file table, creation and deletion
{  of entries in the table, fetching and updating information stored in the
{  table and locking and unlocking entries in the table.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_fixed
*copyc oss$mainframe_pageable
*copyc mmc$null_shared_queue
*copyc dmd$null_global_file_name
*copyc osd$virtual_address
*copyc dfe$error_condition_codes
*copyc dmt$active_volume_table_index
*copyc dmt$assigned_ms_vol_attributes
*copyc dmt$device_log_entries
*copyc dmt$df_return_file_info_option
*copyc dmt$disk_file_descriptor
*copyc dmt$error_condition_codes
*copyc dmt$existing_sft_entry
*copyc dmt$file_attributes
*copyc dmt$file_information
*copyc dmt$file_location
*copyc dmt$file_share_history
*copyc dmt$fmd_index
*copyc dmt$segment_file_information
*copyc gft$locked_file_desc_entry_p
*copyc gft$system_file_identifier
*copyc mmt$rb_set_get_segment_length
*copyc ost$caller_identifier
*copyc ost$processor_model_number
*copyc ost$status
*copyc ost$wait
?? POP ??
*copyc dfp$get_served_file_desc_p
*copyc dfp$release_server_descriptor
*copyc dmp$allocate_file_space_r1
*copyc dmp$change_dfl_damage
*copyc dmp$deallocate_file_space_r1
*copyc dmp$decrement_class_activity
*copyc dmp$free_fmds
*copyc dmp$generate_gfn_hash
*copyc dmp$get_active_vol_attributes
*copyc dmp$get_disk_file_descriptor_p
*copyc dmp$get_fmd_by_index
*copyc dmp$get_level_2_ptr
*copyc dmp$process_device_log_entry
*copyc dmp$search_avt_by_vsn
*copyc dmp$set_file_residence
*copyc dmp$set_file_table_locator
*copyc gfp$assign_fde
*copyc gfp$free_fde
*copyc gfp$get_eoi_from_fde
*copyc gfp$get_fde_p
*copyc gfp$get_locked_fde_p
*copyc gfp$get_sfid_from_fde_p
*copyc gfp$lock_fde
*copyc gfp$unlock_fde_p
*copyc gfp$verify_get_fde_p
*copyc mmp$close_device_file
*copyc mmp$issue_ring1_segment_request
*copyc mmp$open_file_by_sfid
*copyc mmp$preset_conversion
*copyc osp$append_status_parameter
*copyc osp$clear_mainframe_sig_lock
*copyc osp$fatal_system_error
*copyc osp$initialize_sig_lock
*copyc osp$set_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc osp$test_set_main_sig_lock
*copyc osp$test_sig_lock
*copyc osp$unpack_status_identifier
*copyc pmp$cycle
*copyc pmp$delay
*copyc pmp$get_system_time
*copyc sfp$accumulate_file_space
*copyc syp$set_status_from_mtr_status
*copyc dmv$active_volume_table
*copyc gfv$null_sfid
*copyc dmv$trim_files
*copyc jmv$jcb
*copyc osv$deadstart_phase
*copyc osv$page_size
*copyc i#call_monitor
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??
?? FMT (FORMAT := OFF) ??

  VAR
    default_disk_file_descriptor: [STATIC,READ] dmt$disk_file_descriptor :=
      {read_write_count:=}           [0,
      {delete_count:=}                0,
      {purged:=}                      FALSE,
      {restricted_attach:=}           FALSE,
      {bytes_per_allocation:=}        0,
      {file_allocation_table:=}       NIL,
      {fat_upper_bound:=}             0,
      {current_fad_index:=}           0,
      {highest_offset_allocated:=}    0,
      {bytes_per_level_2:=}           0,
      {dfd_modified:=}                FALSE,
      {overflow_allowed:=}            TRUE,
      {requested_allocation_size:=}   dmc$unspecified_allocation_size,
      {requested_class:=}             dmc$default_class,
      {requested_class_ordinal:=}     dmc$default_class_ordinal,
      {requested_transfer_size:=}     dmc$unspecified_transfer_size,
      {requested_volume:=}            ['    ','    '],
      {number_of_fads:=}              0,
      {p_fmd:=}                       NIL,
      {file_damaged:=}                FALSE,
      {damaged_detection_enabled:=}   FALSE,
      {fmd_modified:=}                FALSE];
?? FMT (FORMAT := ON) ??

  VAR
    file_hash_threads: [STATIC, oss$mainframe_pageable] dmt$active_file_hash_threads :=
          [REP dmc$max_file_hash + 1 of NIL];

  VAR
    master_attach_lock: [STATIC, oss$mainframe_pageable] dmt$active_fde_lock;

  VAR
    dmv$last_file_reassigned: [XDCL, STATIC, oss$mainframe_pageable] gft$system_file_identifier;

?? TITLE := '  dmp$change_file_damaged', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$change_file_damaged
    (    sfid: gft$system_file_identifier;
         file_damaged: boolean;
         global_file_name: dmt$global_file_name;
     VAR status: ost$status);

    VAR
      p_dfd: ^dmt$disk_file_descriptor,
      p_fmd: ^dmt$file_medium_descriptor,
      p_fde: ^gft$file_descriptor_entry;

    status.normal := TRUE;

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$change_file_damaged.', status);
      RETURN; {----->
    IFEND;

    IF p_fde^.global_file_name = global_file_name THEN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      p_dfd^.file_damaged := file_damaged;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'GFN or SFID is incorrect - dmp$change_file_damaged.', status);
    IFEND;

    IF status.normal THEN
      dmp$get_fmd_by_index (p_dfd, 1, p_fmd);

      IF (file_damaged = TRUE) THEN
        dmp$change_dfl_damage (p_fmd^.avt_index, $dmt$file_damage [dmc$media_image_inconsistent],
              $dmt$file_damage [], p_fmd^.dfl_index, {flush_device_log =} TRUE, p_fde^.global_file_name,
              status);
      ELSE
        dmp$change_dfl_damage (p_fmd^.avt_index, $dmt$file_damage [],
              $dmt$file_damage [dmc$media_image_inconsistent], p_fmd^.dfl_index, {flush_device_log =} FALSE,
              p_fde^.global_file_name, status);
      IFEND;
    IFEND;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$change_file_damaged;
?? TITLE := '  dmp$change_sft_damage_detection', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$change_sft_damage_detection
    (    sfid: gft$system_file_identifier;
         damage_detection: boolean;
         global_file_name: dmt$global_file_name;
     VAR status: ost$status);

    VAR
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry;

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$change_sft_damage_detection.', status);
      RETURN; {----->
    IFEND;

    IF p_fde^.global_file_name = global_file_name THEN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      p_dfd^.damaged_detection_enabled := damage_detection;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'GFN or SFID is incorrect - dmp$change_sft_damage_detection.', status);
    IFEND;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$change_sft_damage_detection;
?? TITLE := '  dmp$change_sft_file_damaged', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$change_sft_file_damaged
    (    sfid: gft$system_file_identifier;
         file_damaged: boolean;
         global_file_name: dmt$global_file_name;
     VAR status: ost$status);

    VAR
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry;

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$change_sft_file_damaged.', status);
      RETURN; {----->
    IFEND;

    IF p_fde^.global_file_name = global_file_name THEN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      p_dfd^.file_damaged := file_damaged;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'GFN or SFID is incorrect - dmp$change_sft_file_damaged.', status);
    IFEND;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$change_sft_file_damaged;
?? TITLE := '  dmp$clear_master_attach_lock', EJECT ??

  PROCEDURE [XDCL] dmp$clear_master_attach_lock
    (    system_file_id: gft$system_file_identifier);

    osp$clear_mainframe_sig_lock (master_attach_lock [system_file_id.file_hash]);

  PROCEND dmp$clear_master_attach_lock;
?? TITLE := '  dmp$close_file', EJECT ??
*copy dmh$close_file

  PROCEDURE [XDCL, #GATE] dmp$close_file
    (    pva: ^cell;
     VAR status: ost$status);

    mmp$close_device_file (#SEGMENT (pva), status);

  PROCEND dmp$close_file;
?? TITLE := '  dmp$complete_sft_delete', EJECT ??

  PROCEDURE [XDCL] dmp$complete_sft_delete
    (    sfid: gft$system_file_identifier;
         fmd_index: dmt$fmd_index;
     VAR status: ost$status);

    VAR
      inactive_file: boolean,
      index: dmt$fmd_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor;

    status.normal := TRUE;

    osp$set_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$complete_sft_delete.', status);
    ELSE
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
      p_fmd^.delete_logging_count := p_fmd^.delete_logging_count - 1;

      inactive_file := (p_fde^.open_count = 0) AND (p_fde^.attach_count = 0) AND (p_dfd^.delete_count = 0);
      FOR index := 1 TO p_dfd^.number_of_fmds DO
        dmp$get_fmd_by_index (p_dfd, index, p_fmd);
        inactive_file := inactive_file AND (p_fmd^.delete_logging_count = 0);
      FOREND;

      gfp$unlock_fde_p (p_fde);

      IF inactive_file THEN
        free_file_tables (sfid, status);
      IFEND;
    IFEND;

    osp$clear_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

  PROCEND dmp$complete_sft_delete;
?? TITLE := '  dmp$create_disk_file_descriptor', EJECT ??

  PROCEDURE [XDCL] dmp$create_disk_file_descriptor
    (    file_kind: gft$file_kind;
         file_locator: dmt$file_location;
         p_file_attributes: ^array [1 .. * ] of dmt$file_attribute;
     VAR p_disk_file_descriptor: ost$relative_pointer);

    VAR
      allocation_size_specified: boolean,
      attribute_p: ^dmt$file_attribute,
      keyword_index: integer,
      p_dfd: ^dmt$disk_file_descriptor,
      requested_allocation_size: dmt$allocation_size,
      requested_transfer_size: dmt$transfer_size,
      transfer_size_specified: boolean;

    allocation_size_specified := FALSE;
    transfer_size_specified := FALSE;
    p_disk_file_descriptor := -1;

    ALLOCATE p_dfd IN file_locator^;
    p_disk_file_descriptor := #OFFSET (p_dfd);

    p_dfd^ := default_disk_file_descriptor;

    FOR keyword_index := LOWERBOUND (p_file_attributes^) TO UPPERBOUND (p_file_attributes^) DO
      attribute_p := ^p_file_attributes^ [keyword_index];
      CASE attribute_p^.keyword OF
      = dmc$class =
        p_dfd^.requested_class := attribute_p^.class;

      = dmc$class_ordinal =
        p_dfd^.requested_class_ordinal := attribute_p^.ordinal;

      = dmc$overflow =
        p_dfd^.overflow_allowed := attribute_p^.overflow_allowed;

      = dmc$requested_allocation_size =
        requested_allocation_size := attribute_p^.requested_allocation_size;
        IF requested_allocation_size > dmc$max_bytes_per_allocation THEN
          requested_allocation_size := dmc$max_bytes_per_allocation;
        IFEND;
        allocation_size_specified := TRUE;
        p_dfd^.requested_allocation_size := requested_allocation_size;

      = dmc$requested_transfer_size =
        transfer_size_specified := TRUE;
        p_dfd^.requested_transfer_size := attribute_p^.requested_transfer_size;

      = dmc$requested_volume =
        p_dfd^.requested_volume := attribute_p^.requested_volume;
      ELSE
      CASEND;
    FOREND;

    IF NOT allocation_size_specified THEN
      IF (file_kind = gfc$fk_catalog) OR (file_kind = gfc$fk_device_file) THEN
        p_dfd^.requested_allocation_size := dmc$default_req_alloc_size;
      ELSE
        p_dfd^.requested_allocation_size := dmc$unspecified_allocation_size;
      IFEND;
    IFEND;

    IF NOT transfer_size_specified THEN
      IF (file_kind = gfc$fk_catalog) OR (file_kind = gfc$fk_device_file) THEN
        p_dfd^.requested_transfer_size := dmc$default_req_transfer_size;
      ELSE
        p_dfd^.requested_transfer_size := dmc$unspecified_transfer_size;
      IFEND;
    IFEND;

{ Inhibit overflow for catalog and device files.
    IF (file_kind = gfc$fk_catalog) OR (file_kind = gfc$fk_device_file) THEN
      p_dfd^.overflow_allowed := FALSE;
    IFEND;

  PROCEND dmp$create_disk_file_descriptor;

?? TITLE := '  dmp$create_fd_entry', EJECT ??

  PROCEDURE [XDCL] dmp$create_fd_entry
    (    p_file_attributes: ^array [1 .. * ] of dmt$file_attribute;
     VAR system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

{Note:
{  - How can the file table locator be bad here? It's already checked by all callers!
{  - How can p_file_descriptor_entry be NIL after it was just assigned before?
{  And, in any of the above cases, we would end up with a reserved FDE.

    VAR
      attribute_p: ^dmt$file_attribute,
      dfd_pointer: ost$relative_pointer,
      file_entry_index: gft$file_descriptor_index,
      file_kind: gft$file_kind,
      file_locator: dmt$file_location,
      ignore_segment_number: ost$segment,
      keyword_index: integer,
      p_dfd: ^dmt$disk_file_descriptor,
      p_file_descriptor_entry: ^gft$file_descriptor_entry,
      preset_value: pmt$initialization_value,
      queue_status_was_specified: boolean;

    status.normal := TRUE;
    queue_status_was_specified := FALSE;
    file_entry_index := 0;

    gfp$assign_fde (system_file_id.residence, ignore_segment_number, system_file_id, p_file_descriptor_entry);

    dmp$set_file_table_locator (system_file_id.residence, file_locator, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    gfp$get_locked_fde_p (system_file_id, p_file_descriptor_entry);
    IF p_file_descriptor_entry = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$create_fd_entry', status);
      RETURN; {----->
    IFEND;

{ set supplied values in file descriptor
    FOR keyword_index := LOWERBOUND (p_file_attributes^) TO UPPERBOUND (p_file_attributes^) DO
      attribute_p := ^p_file_attributes^ [keyword_index];
      CASE attribute_p^.keyword OF
      = dmc$eoi_byte_address =
        p_file_descriptor_entry^.eoi_byte_address := attribute_p^.eoi_address;

      = dmc$file_hash =
        p_file_descriptor_entry^.file_hash := attribute_p^.file_hash;
        system_file_id.file_hash := attribute_p^.file_hash;

      = dmc$file_limit =
        p_file_descriptor_entry^.file_limit := attribute_p^.limit;

      = dmc$file_kind =
        p_file_descriptor_entry^.file_kind := attribute_p^.file_kind;

      = dmc$global_file_name =
        p_file_descriptor_entry^.global_file_name := attribute_p^.global_file_name;

      = dmc$preset_value =
        mmp$preset_conversion (attribute_p^.preset_value, preset_value);
        p_file_descriptor_entry^.preset_value := preset_value;

      = dmc$write_mode =
        IF attribute_p^.attached_in_write_mode THEN
          p_file_descriptor_entry^.attached_in_write_count := 1;
        ELSE
          p_file_descriptor_entry^.attached_in_write_count := 0;
        IFEND;

      = dmc$queue_status =
        queue_status_was_specified := TRUE;
        p_file_descriptor_entry^.queue_status := attribute_p^.queue_status;

      ELSE
        IF (attribute_p^.keyword < LOWERVALUE (dmt$file_attribute_keywords))
{       } OR (attribute_p^.keyword > UPPERVALUE (dmt$file_attribute_keywords)) THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$unrecognizable_case_select,
                'Bad case selector, p_file_attributes - dmp$create_fd_entry.', status);
          gfp$unlock_fde_p (p_file_descriptor_entry);
          RETURN; {----->
        IFEND;
      CASEND;
    FOREND;

    IF (NOT queue_status_was_specified) AND ((p_file_descriptor_entry^.file_kind = gfc$fk_job_local_file) OR
          (p_file_descriptor_entry^.file_kind = gfc$fk_unnamed_file)) THEN
      p_file_descriptor_entry^.queue_status := gfc$qs_job_working_set;
    IFEND;

    IF p_file_descriptor_entry^.file_kind = gfc$fk_device_file THEN
      p_file_descriptor_entry^.queue_status := gfc$qs_global_shared;
    IFEND;

    dmp$create_disk_file_descriptor (p_file_descriptor_entry^.file_kind, file_locator, p_file_attributes,
          dfd_pointer);

    p_file_descriptor_entry^.media := gfc$fm_mass_storage_file;
    p_file_descriptor_entry^.disk_file_descriptor_p := dfd_pointer;
    p_file_descriptor_entry^.attach_count := p_file_descriptor_entry^.attach_count + 1;

    dmp$get_disk_file_descriptor_p (p_file_descriptor_entry, p_dfd);
    IF (p_dfd^.requested_transfer_size <> dmc$unspecified_transfer_size) THEN
      p_file_descriptor_entry^.transfer_unit_size := p_dfd^.requested_transfer_size;
    IFEND;

    gfp$unlock_fde_p (p_file_descriptor_entry);

    IF (p_file_descriptor_entry^.file_kind <= gfc$fk_last_permanent_file) OR
          (p_file_descriptor_entry^.media = gfc$fm_served_file) THEN
      p_file_descriptor_entry^.file_hash_thread := file_hash_threads [system_file_id.file_hash];
      file_hash_threads [system_file_id.file_hash] := p_file_descriptor_entry;
    IFEND;

  PROCEND dmp$create_fd_entry;

?? TITLE := '  dmp$delete_disk_file_descriptor', EJECT ??

  PROCEDURE [XDCL] dmp$delete_disk_file_descriptor
    (    system_file_id: gft$system_file_identifier;
         p_fde: gft$locked_file_desc_entry_p;
         dfd_locator: dmt$file_location;
     VAR status: ost$status);

    VAR
      fmd_index: dmt$fmd_index,
      fmds_released: boolean,
      level_1_index: dmt$level_1_index,
      number_of_fmds: dmt$fmd_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fmd: ^dmt$file_medium_descriptor,
      p_level_2: ^dmt$level_2_table;

    status.normal := TRUE;

    dmp$get_disk_file_descriptor_p (p_fde, p_dfd);

    number_of_fmds := p_dfd^.number_of_fmds;

    IF p_dfd^.file_allocation_table <> NIL THEN
      dmp$deallocate_file_space_r1 (system_file_id, 0, amc$file_byte_limit, p_fde, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    IF p_dfd^.file_allocation_table <> NIL THEN
      FOR level_1_index := p_dfd^.fat_upper_bound DOWNTO 0 DO
        dmp$get_level_2_ptr (^p_dfd^.file_allocation_table^ [level_1_index], p_level_2);
        IF p_level_2 <> NIL THEN
          FREE p_level_2 IN dfd_locator^;
        IFEND;
      FOREND;
      FREE p_dfd^.file_allocation_table IN dfd_locator^;
    IFEND;
    p_dfd^.fat_upper_bound := 0;

    dmp$free_fmds (p_dfd, dfd_locator, number_of_fmds, fmds_released);
    IF NOT fmds_released THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_free_fads,
            'Unable to free FMDS - dmp$delete_disk_file_descriptor.', status);
    ELSE
      FREE p_dfd IN dfd_locator^;
    IFEND;

  PROCEND dmp$delete_disk_file_descriptor;

?? TITLE := '  dmp$delete_file_descriptor', EJECT ??
*copy dmh$delete_file_descriptor

  PROCEDURE [XDCL, #GATE] dmp$delete_file_descriptor
    (    sfid: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      inactive_file: boolean,
      logging_performed: boolean,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry;

    status.normal := TRUE;

{ Set the Master Attach lock.
    osp$set_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

{ Lock the FDE entry.
    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$delete_file_descriptor.', status);
    ELSE
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      p_dfd^.delete_count := p_dfd^.delete_count - 1;
      inactive_file := (p_fde^.open_count = 0) AND (p_fde^.attach_count = 0) AND (p_dfd^.delete_count = 0);

      { If the file is inactive (not attached and the last delete is being
      { processed) then log the delete to the device log.

      IF inactive_file THEN
        log_sft_delete (sfid, p_fde, logging_performed, status);
      ELSE
        osp$set_status_abnormal (dmc$device_manager_ident, dme$file_descriptor_not_deleted,
              'File descriptor not deleted - dmp$delete_file_descriptor.', status);
      IFEND;
      gfp$unlock_fde_p (p_fde);
    IFEND;

{ If logging was not performed to delete the file, delete it now.
    IF status.normal AND NOT logging_performed THEN
      free_file_tables (sfid, status);
    IFEND;

    osp$clear_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

  PROCEND dmp$delete_file_descriptor;

?? TITLE := '  dmp$destroy_file', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copy dmh$destroy_file
?? POP ??

  PROCEDURE [XDCL, #GATE] dmp$destroy_file
    (VAR system_file_id: gft$system_file_identifier;
         file_space_limit: sft$file_space_limit_kind;
     VAR status: ost$status);

    VAR
      file_locator: dmt$file_location,
      p_fde: ^gft$file_descriptor_entry,
      p_dfd: ^dmt$disk_file_descriptor,
      p_rb_ring1_segment_request: ^mmt$rb_ring1_segment_request,
      outstanding_io_on_file: boolean,
      total_allocated_length: amt$file_byte_address;

    dmp$set_file_table_locator (system_file_id.residence, file_locator, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    gfp$get_locked_fde_p (system_file_id, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$illegal_file_index_in_sfid,
            'Unable to locate FDE - dmp$destroy_file.', status);
      RETURN; {----->
    IFEND;

  /fde_locked/
    BEGIN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      IF p_dfd = NIL THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_not_created_for_file,
              'No FMD for file - dmp$destroy_file.', status);
        EXIT /fde_locked/; {----->
      IFEND;

      IF (p_fde^.file_kind <= gfc$fk_last_permanent_file) THEN
        p_dfd^.purged := TRUE;

        IF (p_fde^.attach_count > 0) THEN
          p_fde^.attach_count := p_fde^.attach_count - 1;
        IFEND;

        IF (p_fde^.attach_count <> 0) OR (p_fde^.open_count <> 0) OR (p_dfd^.delete_count <> 0) THEN
          EXIT /fde_locked/ { file still in use } ; {----->
        IFEND;

        p_dfd^.delete_count := 1;
        gfp$unlock_fde_p (p_fde);

        dmp$delete_file_descriptor (system_file_id, status);

        RETURN; {----->
      IFEND;

      IF p_fde^.asti <> 0 THEN
        PUSH p_rb_ring1_segment_request;
        p_rb_ring1_segment_request^.reqcode := syc$rc_ring1_segment_request;
        p_rb_ring1_segment_request^.status.normal := TRUE;
        p_rb_ring1_segment_request^.request := mmc$sr1_delete_seg_sfid;
        p_rb_ring1_segment_request^.sfid := system_file_id;

        mmp$issue_ring1_segment_request (p_rb_ring1_segment_request^);
        syp$set_status_from_mtr_status (p_rb_ring1_segment_request^.status, status);
        IF NOT status.normal THEN
          EXIT /fde_locked/; {----->
        IFEND;
      IFEND;

      REPEAT
        outstanding_io_on_file := (p_dfd^.read_write_count > 0);
        IF outstanding_io_on_file THEN
          pmp$delay (50, status);
        IFEND;
      UNTIL NOT outstanding_io_on_file;

      p_dfd^.purged := TRUE;

      dmp$get_total_allocated_length (p_fde, total_allocated_length);

      dmp$decrement_class_activity (p_dfd);

      dmp$delete_disk_file_descriptor (system_file_id, p_fde, file_locator, status);
      IF NOT status.normal THEN
        EXIT /fde_locked/; {----->
      IFEND;

      p_fde^.global_file_name := dmv$null_global_file_name;

      gfp$unlock_fde_p (p_fde);
      gfp$free_fde (p_fde, system_file_id);

      IF file_space_limit <> sfc$no_limit THEN
        sfp$accumulate_file_space (file_space_limit, -total_allocated_length);
      IFEND;

      RETURN; {----->
    END /fde_locked/;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$destroy_file;

?? TITLE := '  dmp$detach_device_file', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$detach_device_file
    (    system_file_id: gft$system_file_identifier;
     VAR file_modified: boolean;
     VAR fmd_modified: boolean;
     VAR status: ost$status);

    VAR
      ignore_file_info: dmt$file_information;

    dmp$detach_file (system_file_id, {access_allowed} TRUE, {flush_pages} TRUE, dmc$df_ignore_file_info,
          file_modified, fmd_modified, ignore_file_info, status);
    IF status.normal THEN
      dmp$delete_file_descriptor (system_file_id, status);
      IF NOT status.normal THEN
        IF status.condition = dme$file_descriptor_not_deleted THEN
          status.condition := 0;
          status.normal := TRUE;
        IFEND;
      IFEND;
    IFEND;

  PROCEND dmp$detach_device_file;

?? TITLE := '  dmp$detach_file', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dmh$detach_file
?? POP ??

  PROCEDURE [XDCL, #GATE] dmp$detach_file
    (    system_file_id: gft$system_file_identifier;
         access_allowed: boolean;
         flush_pages: boolean;
         return_file_info_option: dmt$df_return_file_info_option;
     VAR file_modified: boolean;
     VAR fmd_modified: boolean;
     VAR file_info: dmt$file_information;
     VAR status: ost$status);

    VAR
      avt_entry_found: boolean,
      avt_index: dmt$active_volume_table_index,
      detach_allowed: ost$status,
      dmv$await_io_completion: [STATIC, XDCL] boolean := FALSE,
      entry_to_be_processed: boolean,
      fmd_number: dmt$fmd_index,
      identifier: ost$status_identifier,
      length: 8 .. 120,
      log_entry: dmt$dl_entry,
      new_total_allocated_length: amt$file_byte_address,
      number_of_fmds: dmt$fmd_index,
      old_total_allocated_length: amt$file_byte_address,
      active_vol_attributes: array [1 .. 1] of dmt$assigned_ms_vol_attribute,
      p_fmd: ^dmt$file_medium_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_dfd: ^dmt$disk_file_descriptor,
      p_rb_ring1_segment_request: ^mmt$rb_ring1_segment_request,
      recorded_vsn: rmt$recorded_vsn,
      trim_status: ost$status,
      xcb_p: ^ost$execution_control_block;

    status.normal := TRUE;
    trim_status.normal := TRUE;
    detach_allowed.normal := TRUE;
    old_total_allocated_length := 0;
    new_total_allocated_length := 0;
    file_modified := FALSE; {This parameter was never seriously used, it should be deleted}

  /process_request/
    BEGIN
      gfp$get_fde_p (system_file_id, p_fde);
      IF p_fde = NIL THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
              'Bad SFID - dmp$detach_file.', status);
        EXIT /process_request/; {----->
      IFEND;

      IF access_allowed THEN
        IF (flush_pages) AND (p_fde^.queue_status <> gfc$qs_job_shared) AND (p_fde^.asti <> 0) THEN
          {
          { Flush pages when pages are in the jobs working set or in the global
          { shared queue (i.e. file attached in write mode).
          {

          PUSH p_rb_ring1_segment_request;
          p_rb_ring1_segment_request^.reqcode := syc$rc_ring1_segment_request;
          p_rb_ring1_segment_request^.request := mmc$sr1_detach_file;
          p_rb_ring1_segment_request^.sfid := system_file_id;
          p_rb_ring1_segment_request^.wait_for_io_complete := TRUE;
          p_rb_ring1_segment_request^.status.normal := TRUE;

          mmp$issue_ring1_segment_request (p_rb_ring1_segment_request^);
          IF NOT p_rb_ring1_segment_request^.status.normal THEN
            osp$unpack_status_identifier (p_rb_ring1_segment_request^.status.condition, identifier);
            osp$set_status_abnormal (identifier, p_rb_ring1_segment_request^.status.condition,
                  'Bad status from monitor - dmp$detach_file.', status);
            detach_allowed := status;
          IFEND;
        ELSEIF (p_fde^.queue_status <> gfc$qs_global_shared) THEN
          {
          { In cases where flushing is not requested and the pages are in the
          { working set the pages must be removed from the working set.
          {
          PUSH p_rb_ring1_segment_request;
          p_rb_ring1_segment_request^.reqcode := syc$rc_ring1_segment_request;
          p_rb_ring1_segment_request^.request := mmc$sr1_remove_detached_pages;
          p_rb_ring1_segment_request^.sfid := system_file_id;
          p_rb_ring1_segment_request^.status.normal := TRUE;

          mmp$issue_ring1_segment_request (p_rb_ring1_segment_request^);

        IFEND;
      IFEND;

      gfp$lock_fde (p_fde);

    /file_descriptor_locked/
      BEGIN
        IF return_file_info_option = dmc$df_return_file_info THEN
          dmp$get_total_allocated_length (p_fde, old_total_allocated_length);
        IFEND;

        p_fde^.attach_count := p_fde^.attach_count - 1;
        dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
        p_dfd^.delete_count := p_dfd^.delete_count + 1;
        file_modified := p_fde^.flags.eoi_modified;

        dmp$get_fmd_by_index (p_dfd, 1, p_fmd);

        avt_index := p_fmd^.avt_index;
        recorded_vsn := dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.recorded_vsn;

        IF (p_fde^.attached_in_write_count > 0) AND (p_fde^.attach_count = 0) THEN
          active_vol_attributes [1].keyword := dmc$ms_mainframe_assigned;

          dmp$get_active_vol_attributes (recorded_vsn, avt_index, active_vol_attributes, avt_entry_found);
          IF NOT avt_entry_found THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$avt_entry_not_found,
                  'Unable to locate AVT entry - dmp$detach_file.', status);
            osp$append_status_parameter (' ', recorded_vsn, status);
            EXIT /file_descriptor_locked/; {----->
          IFEND;

          IF detach_allowed.normal THEN
            log_entry.kind := dmc$dl_detach_file;
            log_entry.attach_file_block.global_file_name := p_fde^.global_file_name;
            log_entry.attach_file_block.dfl_index := p_fmd^.dfl_index;
            log_entry.attach_file_block.mainframe_assigned := active_vol_attributes [1].mainframe_assigned;

            dmp$process_device_log_entry (avt_index, log_entry, status);
            IF NOT status.normal THEN
              EXIT /file_descriptor_locked/; {----->
            IFEND;

            IF p_dfd^.damaged_detection_enabled THEN
              p_dfd^.damaged_detection_enabled := FALSE;
              IF NOT p_dfd^.file_damaged THEN
                log_entry.kind := dmc$dl_file_damaged;
                log_entry.file_damaged_block.global_file_name := p_fde^.global_file_name;
                log_entry.file_damaged_block.dfl_index := p_fmd^.dfl_index;
                log_entry.file_damaged_block.add_damage := $dmt$file_damage [];
                log_entry.file_damaged_block.remove_damage := $dmt$file_damage [dmc$media_image_inconsistent];

                dmp$process_device_log_entry (avt_index, log_entry, status);
                IF NOT status.normal THEN
                  EXIT /file_descriptor_locked/; {----->
                IFEND;
              IFEND;
            IFEND;
          ELSE

            {The pages could not be flushed to disk.  Issue the remove_job_shared_pages request
            {to move all pages to a global shared queue.  Pages CANNOT be left in a JWS after a file
            {has been detached.  Pass in segment number 0; this will prevent the monitor code from
            {trying to store the ASID in the job's segment table.

            p_rb_ring1_segment_request^.reqcode := syc$rc_ring1_segment_request;
            p_rb_ring1_segment_request^.request := mmc$sr1_remove_job_shared_pages;
            p_rb_ring1_segment_request^.sfid := system_file_id;
            p_rb_ring1_segment_request^.segment_number := 0;
            p_rb_ring1_segment_request^.server_file := FALSE;
            p_rb_ring1_segment_request^.status.normal := TRUE;

            mmp$issue_ring1_segment_request (p_rb_ring1_segment_request^);

            {FDE will never be deleted, so the queue status will never be updated
            {by attach, so we must keep the queue status as global!
            {The monitor request has changed AST queued_id to global shared.
            p_fde^.queue_status := gfc$qs_global_shared;

            {Usage count must stay non zero to prevent the fde from being deleted
            p_fde^.attach_count := 1;

          IFEND;
        IFEND;

        IF dmv$trim_files AND (p_fde^.attach_count = 0) THEN
          IF p_fde^.eoi_byte_address = 0 THEN { save 1 fmd for perm files
            dmp$trim_file (system_file_id, p_fde^.eoi_byte_address + 1, trim_status);
          ELSE
            dmp$trim_file (system_file_id, p_fde^.eoi_byte_address, trim_status);
          IFEND;
          IF NOT trim_status.normal THEN
            CASE trim_status.condition OF
            = dme$io_active, dme$untrimmable_file_type, dme$outstanding_log_entries =
              { these errors are non-destructive, and we've only missed a bit of deallocation
              trim_status.normal := TRUE;
            ELSE
            CASEND;
          IFEND;
        IFEND;

        fmd_modified := p_dfd^.fmd_modified;
        p_dfd^.fmd_modified := FALSE;

        IF (p_dfd^.dfd_modified) OR (p_fde^.flags.eoi_modified) THEN
          update_dfl_file_length (p_fde, p_dfd, status);
        IFEND;

        IF return_file_info_option <> dmc$df_ignore_file_info THEN
          dmp$get_total_allocated_length (p_fde, new_total_allocated_length);

          file_info.eoi_byte_address := gfp$get_eoi_from_fde (p_fde);
          IF p_fde^.queue_ordinal > mmc$pq_shared_last_sys THEN
            file_info.shared_queue := p_fde^.queue_ordinal - mmc$pq_shared_last_sys;
          ELSE
            file_info.shared_queue := mmc$null_shared_queue;
          IFEND;
          file_info.file_kind := p_fde^.file_kind;
          file_info.time_last_modified := p_fde^.time_last_modified;
          file_info.total_allocated_length := new_total_allocated_length;
          file_info.trimmed_length := 0;
          IF return_file_info_option = dmc$df_return_file_info THEN
            file_info.trimmed_length := old_total_allocated_length - new_total_allocated_length;
          IFEND;
        IFEND;

      END /file_descriptor_locked/;

      gfp$unlock_fde_p (p_fde);

    END /process_request/;

    IF status.normal THEN
      IF NOT detach_allowed.normal THEN
        status := detach_allowed;
      ELSEIF NOT trim_status.normal THEN
        status := trim_status;
      IFEND;
    IFEND;

  PROCEND dmp$detach_file;

?? TITLE := '  dmp$detach_server_file ', EJECT ??

*copyc dmv$await_io_completion
*copyc dmp$release_server_descriptor
*copyc dmh$detach_server_file

  PROCEDURE [XDCL, #GATE] dmp$detach_server_file
    (    system_file_id: gft$system_file_identifier;
         flush_pages: boolean;
         unconditional_detach: boolean;
     VAR attached_for_write: boolean;
     VAR eoi_byte_address: amt$file_byte_address;
     VAR remote_sfid: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      flush_status: ost$status,
      lock_status: ost$status,
      p_fde: ^gft$file_descriptor_entry,
      p_server_descriptor: ^dmt$server_descriptor,
      rb_ring1_segment_request: mmt$rb_ring1_segment_request,
      terminated_server: boolean,
      wait_on_io: boolean;

    status.normal := TRUE;
    flush_status.normal := TRUE;
    terminated_server := FALSE;
    gfp$get_fde_p (system_file_id, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'bad sfid in dmp$detach_server_file ', status);
      RETURN; {----->
    IFEND;

    IF p_fde^.media <> gfc$fm_served_file THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$expecting_server_file,
            'bad file type dmp$detach_server_file ', status);
      RETURN; {----->
    IFEND;

    IF flush_pages AND (p_fde^.asti <> 0) THEN
      wait_on_io := dmv$await_io_completion OR ((p_fde^.attach_count = 1) AND
            (p_fde^.attached_in_write_count > 0));
      rb_ring1_segment_request.reqcode := syc$rc_ring1_segment_request;
      rb_ring1_segment_request.sfid := system_file_id;
      rb_ring1_segment_request.wait_for_io_complete := wait_on_io;
      rb_ring1_segment_request.status.normal := TRUE;
      rb_ring1_segment_request.request := mmc$sr1_detach_file;
      mmp$issue_ring1_segment_request (rb_ring1_segment_request);
      syp$set_status_from_mtr_status (rb_ring1_segment_request.status, status);
      IF NOT status.normal THEN
        IF status.condition = dfe$server_has_terminated THEN
          terminated_server := TRUE;
          status.normal := TRUE;
        ELSE {any other condition}
          flush_status := status;
        IFEND;
      IFEND;
    IFEND;

{ Update FDE entry.

    osp$set_mainframe_sig_lock (master_attach_lock [system_file_id.file_hash]);

  /master_attach_lock_set/
    BEGIN

      gfp$lock_fde (p_fde);

    /fde_locked/
      BEGIN
        IF NOT flush_status.normal AND (p_fde^.attach_count = 1) THEN

{ The pages could not be flushed to disk.  Issue the remove_job_shared_pages request
{ to move all pages to a global shared queue.  Pages CANNOT be left in a JWS after a file
{ has been detached.  Pass in segment number 0; this will prevent the monitor code from
{ trying to store the ASID in the job's segment table.

          rb_ring1_segment_request.reqcode := syc$rc_ring1_segment_request;
          rb_ring1_segment_request.request := mmc$sr1_remove_job_shared_pages;
          rb_ring1_segment_request.sfid := system_file_id;
          rb_ring1_segment_request.segment_number := 0;
          rb_ring1_segment_request.server_file := TRUE;
          rb_ring1_segment_request.status.normal := TRUE;

          mmp$issue_ring1_segment_request (rb_ring1_segment_request);

{ FDE will never be deleted, so the queue status will never be updated
{ by attach, so we must keep the queue status as global!
{ The monitor request has changed AST queued_id to global shared.

          p_fde^.queue_status := gfc$qs_global_shared;
          EXIT /fde_locked/; {----->
        IFEND;

        dfp$get_served_file_desc_p (p_fde, p_server_descriptor);
        IF (p_server_descriptor^.header.file_state = dfc$awaiting_recovery) AND NOT unconditional_detach THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_active, ' file awaiting recovery ',
                status);
          EXIT /fde_locked/; {----->
        IFEND;

        attached_for_write := (p_fde^.attached_in_write_count > 0);
        eoi_byte_address := gfp$get_eoi_from_fde (p_fde);
        remote_sfid := p_server_descriptor^.header.remote_sfid;
        p_fde^.attach_count := p_fde^.attach_count - 1;

{ Like dmp$delete_file_descriptor, except
{  1. No file medium descriptor, or logging
{  2. Does not return abnormal status if file still active.
{  3. Makes fde available, rather than making it inactive.

        IF (p_fde^.open_count = 0) AND (p_fde^.attach_count = 0) THEN
          WHILE (p_server_descriptor^.header.read_write_count <> 0) DO

{ Outstanding I/O on file.  READ_WRITE_COUNT is incremented in monitor when making a server request on the
{ client, and is decremented in monitor when completing a server request on the client.

            pmp$delay (1000, status);
          WHILEND;

{ The file is now inactive.  Issue request to free pages and delete the ASID associated with the file.

          IF p_fde^.asti <> 0 THEN
            rb_ring1_segment_request.reqcode := syc$rc_ring1_segment_request;
            rb_ring1_segment_request.status.normal := TRUE;
            rb_ring1_segment_request.request := mmc$sr1_delete_seg_sfid;
            rb_ring1_segment_request.sfid := system_file_id;
            mmp$issue_ring1_segment_request (rb_ring1_segment_request);
            syp$set_status_from_mtr_status (rb_ring1_segment_request.status, status);
          IFEND;

{ Remove the system file table entry.

          IF status.normal THEN
            remove_fde_active_thread (system_file_id, p_fde, status);
            p_server_descriptor^.header.purged := TRUE;
            dfp$release_server_descriptor (p_fde);
            p_fde^.global_file_name := dmv$null_global_file_name;
            gfp$unlock_fde_p (p_fde);
            gfp$free_fde (p_fde, system_file_id);
            EXIT /master_attach_lock_set/; {----->
          IFEND;
        IFEND;
      END /fde_locked/;

      gfp$unlock_fde_p (p_fde);

    END /master_attach_lock_set/;

    osp$clear_mainframe_sig_lock (master_attach_lock [system_file_id.file_hash]);

    IF status.normal AND terminated_server THEN
      { File manager will remove the file table entry despite this status.
      osp$set_status_abnormal (dfc$file_server_id, dfe$server_has_terminated, '', status);
    IFEND;

  PROCEND dmp$detach_server_file;

?? TITLE := '  dmp$enable_damage_detection', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$enable_damage_detection
    (    sfid: gft$system_file_identifier;
         global_file_name: dmt$global_file_name;
     VAR status: ost$status);

    VAR
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor;

    status.normal := TRUE;

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$enable_damage_detection.', status);
    ELSE
      IF p_fde^.global_file_name = global_file_name THEN
        dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
        p_dfd^.damaged_detection_enabled := TRUE;
      ELSE
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
              'GFN or SFID is incorrect - dmp$change_file_damaged.', status);
      IFEND;

      IF status.normal THEN
        dmp$get_fmd_by_index (p_dfd, 1, p_fmd);

        dmp$change_dfl_damage (p_fmd^.avt_index, $dmt$file_damage [dmc$media_image_inconsistent],
              $dmt$file_damage [], p_fmd^.dfl_index, TRUE {flush_device_log =} , p_fde^.global_file_name,
              status);
      IFEND;
      gfp$unlock_fde_p (p_fde);
    IFEND;

  PROCEND dmp$enable_damage_detection;
?? TITLE := '  dmp$fetch_eoi', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$fetch_eoi
    (    system_file_id: gft$system_file_identifier;
     VAR eoi: amt$file_byte_address;
     VAR status: ost$status);

    VAR
      p_fde: ^gft$file_descriptor_entry;

    gfp$verify_get_fde_p (system_file_id, p_fde, status);
    IF status.normal THEN
      eoi := gfp$get_eoi_from_fde (p_fde);
    IFEND;

  PROCEND dmp$fetch_eoi;
?? TITLE := '  dmp$fetch_segment_file_info', EJECT ??
*copy dmh$fetch_segment_file_info

  PROCEDURE [XDCL, #GATE] dmp$fetch_segment_file_info
    (    system_file_id: gft$system_file_identifier;
         chapter_number: dmt$chapter_number;
     VAR info: dmt$segment_file_info;
     VAR status: ost$status);

{
{  This procedure is currently used only by one PF procedure to obtain
{  usage count. This interface should be eliminated as a cleanup activity.
{  (11/89)
{

    VAR
      p_fde: ^gft$file_descriptor_entry,
      p_dfd: ^dmt$disk_file_descriptor,
      p_server_descriptor: ^dmt$server_descriptor;

    status.normal := TRUE;

    gfp$get_locked_fde_p (system_file_id, p_fde);

    info.chapter_limit := p_fde^.file_limit;
    IF info.chapter_limit > osc$maximum_offset THEN
      info.chapter_limit := osc$maximum_offset;
    IFEND;
    info.usage_count := p_fde^.attach_count;
    info.transfer_size := p_fde^.transfer_unit_size;
    info.allocation_size := p_fde^.allocation_unit_size;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$fetch_segment_file_info;

?? TITLE := '  dmp$file_on_down_volume', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$file_on_down_volume
    (    system_file_id: gft$system_file_identifier;
     VAR file_on_down_volume: boolean);

    VAR
      fmd_index: dmt$fmd_index,
      number_of_fmds: dmt$fmd_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor;

    file_on_down_volume := FALSE;

    gfp$get_fde_p (system_file_id, p_fde);
    IF p_fde <> NIL THEN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      number_of_fmds := p_dfd^.number_of_fmds;
      FOR fmd_index := 1 TO number_of_fmds DO
        dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
        IF p_fmd^.in_use AND p_fmd^.volume_assigned THEN
          IF dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.volume_unavailable THEN
            file_on_down_volume := TRUE;
            RETURN; {----->
          IFEND;
        IFEND;
      FOREND;
    IFEND;

  PROCEND dmp$file_on_down_volume;
?? TITLE := '  dmp$fixup_fmd_allocated_length', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$fixup_fmd_allocated_length
    (    system_file_id: gft$system_file_identifier;
         fmd_index: dmt$fmd_index;
         allocated_length: amt$file_byte_address;
     VAR status: ost$status);

{
{  Used only during recovery, so a lock is not set.
{

    VAR
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor;

    status.normal := TRUE;

    gfp$get_fde_p (system_file_id, p_fde);

    IF p_fde <> NIL THEN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      p_dfd^.dfd_modified := TRUE;

      dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
      p_fmd^.fmd_allocated_length := allocated_length;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$fixup_fmd_allocated_length.', status);
    IFEND;
  PROCEND dmp$fixup_fmd_allocated_length;

?? TITLE := '  dmp$free_server_file_tables', EJECT ??

*copy dmh$free_server_file_tables

  PROCEDURE [XDCL, #GATE] dmp$free_server_file_tables
    (    system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      p_fde: ^gft$file_descriptor_entry,
      p_server_descriptor: ^dmt$server_descriptor,
      rb_ring1_segment_request: mmt$rb_ring1_segment_request;

    osp$set_mainframe_sig_lock (master_attach_lock [system_file_id.file_hash]);

  /master_attach_lock_set/
    BEGIN

      gfp$get_locked_fde_p (system_file_id, p_fde);
      IF p_fde = NIL THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
              'bad sfid in dmp$free_server_file_tables', status);
        EXIT /master_attach_lock_set/; {----->
      IFEND;

    /fde_locked/
      BEGIN
        dfp$get_served_file_desc_p (p_fde, p_server_descriptor);
        IF p_server_descriptor^.header.file_state = dfc$awaiting_recovery THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$server_not_active, ' file awaiting recovery ',
                status);
          EXIT /fde_locked/; {----->
        IFEND;

        IF (p_fde^.open_count = 0) AND (p_fde^.attach_count = 0) THEN
          WHILE (p_server_descriptor^.header.read_write_count <> 0) DO

{ Outstanding I/O on file.  READ_WRITE_COUNT is incremented in monitor when making a server request on the
{ client, and is decremented in monitor when completing a server request on the client.

            pmp$delay (1000, status);
          WHILEND;

          IF p_fde^.asti <> 0 THEN
            rb_ring1_segment_request.reqcode := syc$rc_ring1_segment_request;
            rb_ring1_segment_request.status.normal := TRUE;
            rb_ring1_segment_request.request := mmc$sr1_delete_seg_sfid;
            rb_ring1_segment_request.sfid := system_file_id;
            mmp$issue_ring1_segment_request (rb_ring1_segment_request);
            syp$set_status_from_mtr_status (rb_ring1_segment_request.status, status);
          IFEND;

          { Remove the system file table entry.
          IF status.normal THEN
            remove_fde_active_thread (system_file_id, p_fde, status);
            p_server_descriptor^.header.purged := TRUE;
            dfp$release_server_descriptor (p_fde);
            p_fde^.global_file_name := dmv$null_global_file_name;
            gfp$unlock_fde_p (p_fde);
            gfp$free_fde (p_fde, system_file_id);
            EXIT /master_attach_lock_set/; {----->
          IFEND;
        IFEND;
      END /fde_locked/;

      gfp$unlock_fde_p (p_fde);

    END /master_attach_lock_set/;

    osp$clear_mainframe_sig_lock (master_attach_lock [system_file_id.file_hash]);

  PROCEND dmp$free_server_file_tables;

?? TITLE := '  dmp$get_total_allocated_length', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$get_total_allocated_length
    (    p_fde: gft$locked_file_desc_entry_p;
     VAR total_allocated_length: amt$file_byte_address);

    VAR
      fmd_index: dmt$fmd_index,
      number_of_fmds: dmt$fmd_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fmd: ^dmt$file_medium_descriptor,
      p_server_descriptor: dmt$p_server_descriptor;

    total_allocated_length := 0;
    IF p_fde^.media = gfc$fm_served_file THEN
      dfp$get_served_file_desc_p (p_fde, p_server_descriptor);
      total_allocated_length := p_server_descriptor^.header.total_allocated_length;
    ELSE
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      number_of_fmds := p_dfd^.number_of_fmds;
      FOR fmd_index := 1 TO number_of_fmds DO
        dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
        total_allocated_length := total_allocated_length + p_fmd^.fmd_allocated_length;
      FOREND;
    IFEND;

  PROCEND dmp$get_total_allocated_length;

?? TITLE := '  dmp$locate_existing_sft_entry', EJECT ??
*copy dmh$locate_existing_sft_entry

  PROCEDURE [XDCL, #GATE] dmp$locate_existing_sft_entry
    (    global_file_name: dmt$global_file_name;
         file_kind: gft$file_kind;
     VAR existing_sft_entry: dmt$existing_sft_entry;
     VAR file_info: dmt$file_information;
     VAR status: ost$status);

    VAR
      file_found: boolean,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      sfid: gft$system_file_identifier;

    existing_sft_entry := dmc$entry_not_found;
    dmp$generate_gfn_hash (global_file_name, sfid.file_hash);

    osp$set_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

    dmp$set_file_residence (file_kind, sfid.residence, status);

    IF status.normal THEN
      dmp$search_fdt_by_gfn (sfid.residence, global_file_name, sfid.file_entry_index, file_found);

      IF file_found THEN
        gfp$get_locked_fde_p (sfid, p_fde);

        IF (p_fde <> NIL) THEN
          dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
          file_found := (p_dfd <> NIL) AND NOT p_dfd^.purged AND (p_fde^.attach_count <> 0);

          IF file_found THEN
            IF p_dfd^.restricted_attach THEN
              existing_sft_entry := dmc$restricted_attach_entry;
            ELSE
              existing_sft_entry := dmc$normal_entry;
            IFEND;

            file_info.eoi_byte_address := gfp$get_eoi_from_fde (p_fde);
            IF p_fde^.queue_ordinal > mmc$pq_shared_last_sys THEN
              file_info.shared_queue := p_fde^.queue_ordinal - mmc$pq_shared_last_sys;
            ELSE
              file_info.shared_queue := mmc$null_shared_queue;
            IFEND;
            file_info.file_kind := p_fde^.file_kind;
            file_info.time_last_modified := p_fde^.time_last_modified;
            dmp$get_total_allocated_length (p_fde, file_info.total_allocated_length);
            file_info.trimmed_length := 0;
          IFEND;
          gfp$unlock_fde_p (p_fde);
        IFEND;
      IFEND;
    IFEND;

    osp$clear_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);
  PROCEND dmp$locate_existing_sft_entry;

?? TITLE := '  dmp$mm_log_sft_delete', EJECT ??

*copy dmh$mm_log_sft_delete

  PROCEDURE [XDCL, #GATE] dmp$mm_log_sft_delete
    (    sfid: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      inactive_file: boolean,
      logging_performed: boolean,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry;

    status.normal := TRUE;

    { Set the Master Attach lock.

    osp$set_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

    { Lock the FDE entry.

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$delete_file_descriptor.', status);
    ELSE
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      inactive_file := (p_fde^.open_count = 0) AND (p_fde^.attach_count = 0) AND (p_dfd^.delete_count = 0);

      { If the file is inactive (not attached and the last delete is being
      { processed) then log the delete to the device log.

      IF inactive_file THEN
        log_sft_delete (sfid, p_fde, logging_performed, status);
      ELSE
        osp$set_status_abnormal (dmc$device_manager_ident, dme$file_descriptor_not_deleted,
              'File descriptor not deleted - dmp$delete_file_descriptor.', status);
      IFEND;
      gfp$unlock_fde_p (p_fde);
    IFEND;


    { If logging was not performed to delete the file, delete it now.

    IF status.normal AND NOT logging_performed THEN
      free_file_tables (sfid, status);
    IFEND;

    osp$clear_mainframe_sig_lock (master_attach_lock [sfid.file_hash]);

  PROCEND dmp$mm_log_sft_delete;

?? TITLE := '  dmp$open_file', EJECT ??
*copy dmh$open_file

  PROCEDURE [XDCL, #GATE] dmp$open_file
    (    sfid: gft$system_file_identifier;
         ring1: ost$valid_ring;
         ring2: ost$valid_ring;
         access_rights: mmt$segment_access_rights;
         access_selections: mmt$access_selections;
     VAR pointer: mmt$segment_pointer;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      entry_to_be_processed: boolean,
      fmd_index: dmt$fmd_index,
      heap_pointer: ^ost$adaptable_heap_pointer,
      number_of_fmds: dmt$fmd_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor,
      p_segment_pva: ^cell,
      segment_number: ost$segment,
      seq_pointer: ^ost$sequence_pointer;

    #CALLER_ID (caller_id);

    status.normal := TRUE;

    IF caller_id.ring > osc$tsrv_ring THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$illegal_caller,
            'Ring number of caller > osc$tsrv_ring - dmp$open_file.', status);
      RETURN; {----->
    IFEND;

    gfp$get_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$open_file.', status);
    ELSE
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      number_of_fmds := p_dfd^.number_of_fmds;
      FOR fmd_index := 1 TO number_of_fmds DO
        dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
        entry_to_be_processed := p_fmd^.in_use AND p_fmd^.volume_assigned;
        IF entry_to_be_processed THEN
          IF dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.volume_unavailable THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$volume_unavailable,
                  'volume unavailable - dmp$open_file', status);
            RETURN; {----->
          IFEND;
        IFEND;
      FOREND;

      mmp$open_file_by_sfid (sfid, ring1, ring2, access_selections, access_rights, segment_number, status);
      IF status.normal THEN
        p_segment_pva := #ADDRESS (caller_id.ring, segment_number, 0);

        CASE pointer.kind OF
        = mmc$cell_pointer =
          pointer.cell_pointer := p_segment_pva;
        = mmc$sequence_pointer =
          seq_pointer := #LOC (pointer.seq_pointer);
          seq_pointer^.pva := p_segment_pva;
          IF p_fde^.file_limit <= osc$maximum_offset THEN
            seq_pointer^.length := p_fde^.file_limit;
          ELSE
            seq_pointer^.length := osc$maximum_offset;
          IFEND;
          seq_pointer^.nextt := 0;
        = mmc$heap_pointer =
          heap_pointer := #LOC (pointer.heap_pointer);
          heap_pointer^.length := p_fde^.file_limit;
        ELSE

        CASEND;
      IFEND;
    IFEND;

  PROCEND dmp$open_file;

?? TITLE := '  dmp$reassign_file', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copy dmh$reassign_file
?? POP ??

  PROCEDURE [XDCL, #GATE] dmp$reassign_file
    (    system_file_id: gft$system_file_identifier;
         bytes_to_allocate: amt$file_byte_address;
     VAR status: ost$status);

    VAR
      p_fde: ^gft$file_descriptor_entry;

    gfp$get_locked_fde_p (system_file_id, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID  - dmp$reassign_file.', status);
      RETURN; {----->
    IFEND;

    dmp$trim_file (system_file_id, 0, status);
    IF status.normal THEN
      p_fde^.eoi_byte_address := 0;
      dmp$allocate_file_space_r1 (system_file_id, 0, bytes_to_allocate, 0, osc$nowait, sfc$no_limit, status);
      dmv$last_file_reassigned := system_file_id;
    IFEND;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$reassign_file;

?? TITLE := '  dmp$search_fdt_by_gfn', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$search_fdt_by_gfn
    (    file_table_residence: gft$table_residence;
         global_file_name: dmt$global_file_name;
     VAR file_entry_index: gft$file_descriptor_index;
     VAR existing_fde_found: boolean);

    VAR
      file_hash: dmt$file_hash,
      p_fde: ^gft$file_descriptor_entry,
      system_file_id: gft$system_file_identifier;

    dmp$generate_gfn_hash (global_file_name, file_hash);

    existing_fde_found := FALSE;
    p_fde := file_hash_threads [file_hash];

    WHILE p_fde <> NIL DO
      IF (p_fde^.global_file_name = global_file_name) THEN
        existing_fde_found := TRUE;
        gfp$get_sfid_from_fde_p (p_fde, system_file_id);
        file_entry_index := system_file_id.file_entry_index;
        RETURN; {----->
      IFEND;
      p_fde := p_fde^.file_hash_thread;
    WHILEND;

  PROCEND dmp$search_fdt_by_gfn;

?? TITLE := '  dmp$set_eoi', EJECT ??
*copy dmh$set_eoi

  PROCEDURE [XDCL, #GATE] dmp$set_eoi
    (    system_file_id: gft$system_file_identifier;
         eoi: amt$file_byte_address;
     VAR status: ost$status);

    VAR
      request_block: mmt$rb_set_get_segment_length,
      p_fde: ^gft$file_descriptor_entry;

    gfp$verify_get_fde_p (system_file_id, p_fde, status);

    IF status.normal THEN
      request_block.request_code := syc$rc_set_get_segment_length;
      request_block.subfunction_code := mmc$sf_set_segment_length_fde_p;
      request_block.segment_length := eoi;
      request_block.fde_p := p_fde;
      i#call_monitor (#LOC (request_block), #SIZE (request_block));
    IFEND;

  PROCEND dmp$set_eoi;

?? TITLE := '  dmp$set_file_limit', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$set_file_limit
    (    sfid: gft$system_file_identifier;
         limit: 0 .. amc$file_byte_limit;
     VAR status: ost$status);

    VAR
      p_fde: ^gft$file_descriptor_entry;

    status.normal := TRUE;

    gfp$get_locked_fde_p (sfid, p_fde);
    IF p_fde = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Bad SFID - dmp$set_file_limit.', status);
    ELSE
      p_fde^.file_limit := limit;
      gfp$unlock_fde_p (p_fde);
    IFEND;

  PROCEND dmp$set_file_limit;

?? TITLE := '  dmp$set_master_attach_lock', EJECT ??

  PROCEDURE [XDCL] dmp$set_master_attach_lock
    (    system_file_id: gft$system_file_identifier);

    osp$set_mainframe_sig_lock (master_attach_lock [system_file_id.file_hash]);

  PROCEND dmp$set_master_attach_lock;

?? TITLE := '  dmp$trim_file', EJECT ??

  PROCEDURE [XDCL] dmp$trim_file
    (    sfid: gft$system_file_identifier;
         byte_address: amt$file_byte_address;
     VAR status: ost$status);

{ This procedure will trim, or deallocate, file space assigned to a file beyond the allocation unit which
{ contains the input parameter byte_address.
{ The general algorithm is:
{  1. determine whether or not the file is an acceptable candidate for trimming.
{  2. log fad purges for fads beyond the one which contains byte_address, and free the memory
{     tables which represent those fads.
{  3. "free" all file allocation units in memory tables which are beyond the FAU containing byte_address,
{     and call monitor to log an entry to the allocation log which will (when processed) cause the
{     DAT to be updated to reflect memory tables.

    TYPE
      untrimmed_reasons = (no_fde, purged, io_active, wrong_type, no_fmd, no_fads, log_entries_pending);

    VAR
      last_sfid_trimmed: [STATIC] gft$system_file_identifier,
      total_files_trimmed: [STATIC] integer := 0,
      total_files_untrimmed: [STATIC] integer := 0,
      untrimmed_files: [STATIC] array [untrimmed_reasons] of integer := [0, 0, 0, 0, 0, 0, 0];

    VAR
      fde_locked: boolean,
      fmd_index: dmt$fmd_index,
      file_locator: dmt$file_location,
      file_was_trimmed: boolean,
      first_byte_address: amt$file_byte_address,
      new_allocated_length: amt$file_byte_address,
      number_of_fmds: dmt$fmd_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_first_fau: ^dmt$file_allocation_unit,
      p_fmd: ^dmt$file_medium_descriptor,
      p_previous_fmd: ^dmt$file_medium_descriptor,
      trimming_appropriate: boolean;

    status.normal := TRUE;
    file_was_trimmed := FALSE;
    trimming_appropriate := TRUE;
    fde_locked := FALSE;

    { Determine whether or not the file is a candidate for trimming

    gfp$get_fde_p (sfid, p_fde);
    IF p_fde <> NIL THEN
      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      IF p_dfd^.purged THEN
        trimming_appropriate := FALSE;
        untrimmed_files [purged] := untrimmed_files [purged] + 1;
      ELSEIF p_dfd^.read_write_count <> 0 THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$io_active,
              'Cannot trim when I/O outstanding - dmp$trim_file.', status);
        untrimmed_files [io_active] := untrimmed_files [io_active] + 1;
      ELSEIF (p_fde^.file_kind <> gfc$fk_job_permanent_file) AND (p_fde^.file_kind <> gfc$fk_catalog) THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$untrimmable_file_type,
              'Can only trim permanent or catalog files - dmp$trim_file.', status);
        untrimmed_files [wrong_type] := untrimmed_files [wrong_type] + 1;
      IFEND;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            'Cannot get file descriptor - dmp$trim_file.', status);
      untrimmed_files [no_fde] := untrimmed_files [no_fde] + 1;
    IFEND;

    IF status.normal AND trimming_appropriate THEN
      dmp$set_file_table_locator (sfid.residence, file_locator, status);
    IFEND;

    IF status.normal AND trimming_appropriate THEN
      gfp$get_locked_fde_p (sfid, p_fde);
      IF p_fde <> NIL THEN
        fde_locked := TRUE;
        dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
      IFEND;
    IFEND;

    IF status.normal AND trimming_appropriate THEN
      number_of_fmds := p_dfd^.number_of_fmds;
      IF number_of_fmds <= 0 THEN
        trimming_appropriate := FALSE;
        untrimmed_files [no_fads] := untrimmed_files [no_fads] + 1;
      IFEND;
    IFEND;

    IF status.normal AND trimming_appropriate THEN

      {  must reject the request if delete_logging_count <> 0, as (if not) the logger will
      {  soon reference fmds to determine if it's OK to delete file tables for the file

      FOR fmd_index := 1 TO number_of_fmds DO
        dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
        IF p_fmd^.in_use AND (p_fmd^.delete_logging_count <> 0) THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$outstanding_log_entries,
                'cannot trim with pending log entries - dmp$trim_file', status);
          untrimmed_files [log_entries_pending] := untrimmed_files [log_entries_pending] + 1;
        IFEND;
      FOREND;
    IFEND;

    { Determine whether or not there are any "excess" fmds.  If so, log a purge for each of them
    { and clean up memory tables.

    IF status.normal AND trimming_appropriate THEN
      IF byte_address < p_dfd^.highest_offset_allocated THEN
        dmp$deallocate_file_space_r1 (sfid, byte_address, amc$file_byte_limit, p_fde, status);

        IF status.normal THEN
          calculate_allocated_length (p_dfd, fmd_index, new_allocated_length);
          p_dfd^.highest_offset_allocated := new_allocated_length;
          p_dfd^.current_fmd_index := fmd_index;

          fmd_index := number_of_fmds;
          dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
          WHILE (p_fmd <> NIL) AND (p_fmd^.fmd_allocated_length = 0) DO
            dmp$get_fmd_by_index (p_dfd, fmd_index - 1, p_previous_fmd);
            log_fmd_purge (p_fde^.global_file_name, p_fmd, status);

            IF p_previous_fmd <> NIL THEN
              p_previous_fmd^.p_next_fmd := NIL;
            ELSE { this was the first fmd, so
              p_dfd^.p_fmd := NIL;
            IFEND;

            FREE p_fmd IN file_locator^;
            p_dfd^.number_of_fmds := p_dfd^.number_of_fmds - 1;
            p_dfd^.dfd_modified := TRUE;
            p_dfd^.fmd_modified := TRUE;

            p_fmd := p_previous_fmd;
            fmd_index := fmd_index - 1;
          WHILEND;
          file_was_trimmed := TRUE;
          IF (p_dfd^.dfd_modified) OR (p_fde^.flags.eoi_modified) THEN
            update_dfl_file_length (p_fde, p_dfd, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    { All done.  Clean up and exit.

    IF fde_locked THEN
      gfp$unlock_fde_p (p_fde);
    IFEND;

    IF file_was_trimmed THEN
      last_sfid_trimmed := sfid;
      total_files_trimmed := total_files_trimmed + 1;
    ELSE
      total_files_untrimmed := total_files_untrimmed + 1;
    IFEND;

  PROCEND dmp$trim_file;
?? TITLE := '  calculate_allocated_length', EJECT ??

  PROCEDURE calculate_allocated_length
    (    p_dfd: ^dmt$disk_file_descriptor;
     VAR fmd_index: dmt$fmd_index;
     VAR new_allocated_length: amt$file_byte_address);

    VAR
      level_1_index: dmt$level_1_index,
      level_2_start,
      level_2_index: dmt$level_2_index,
      p_level_2: ^dmt$level_2_table;

    new_allocated_length := 0;
    fmd_index := 0;
    level_2_start := p_dfd^.bytes_per_level_2 DIV p_dfd^.bytes_per_allocation - 1;

    IF p_dfd^.file_allocation_table <> NIL THEN

    /find_eof/
      FOR level_1_index := p_dfd^.fat_upper_bound DOWNTO 0 DO
        dmp$get_level_2_ptr (^p_dfd^.file_allocation_table^ [level_1_index], p_level_2);
        IF p_level_2 <> NIL THEN
          FOR level_2_index := level_2_start DOWNTO 0 DO
            IF p_level_2^ [level_2_index].state > dmc$fau_free THEN
              new_allocated_length := (level_1_index * p_dfd^.bytes_per_level_2) +
                    (level_2_index * p_dfd^.bytes_per_allocation) + p_dfd^.bytes_per_allocation;
              fmd_index := p_level_2^ [level_2_index].fmd_index;
              EXIT /find_eof/; {----->
            IFEND;
          FOREND;
        IFEND;
      FOREND /find_eof/;
    IFEND;

  PROCEND calculate_allocated_length;
?? TITLE := '  free_file_tables', EJECT ??

  PROCEDURE free_file_tables
    (    system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      able_to_release_fmd: boolean,
      avt_index: dmt$active_volume_table_index,
      file_locator: dmt$file_location,
      fmd_index: dmt$fmd_index,
      length: 8 .. 120,
      log_entry_to_purge_file: boolean,
      number_of_fmds: dmt$fmd_index,
      outstanding_io_on_file: boolean,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor,
      p_rb_ring1_segment_request: ^mmt$rb_ring1_segment_request;

    status.normal := TRUE;

  /main_program/
    BEGIN
      dmp$set_file_table_locator (system_file_id.residence, file_locator, status);
      IF NOT status.normal THEN
        EXIT /main_program/; {----->
      IFEND;

      gfp$get_locked_fde_p (system_file_id, p_fde);
      IF p_fde = NIL THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
              'Bad SFID - free_file_tables.', status);
        EXIT /main_program/; {----->
      IFEND;

    /fde_locked/
      BEGIN
        dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
        IF p_dfd = NIL THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_not_created_for_file,
                'Nil FMD pointer - free_file_tables.', status);
          EXIT /fde_locked/; {----->
        IFEND;

        log_entry_to_purge_file := p_dfd^.purged AND (p_fde^.file_kind <= gfc$fk_last_permanent_file);

        REPEAT
          outstanding_io_on_file := (p_dfd^.read_write_count <> 0);
          IF outstanding_io_on_file THEN
            pmp$delay (1000, status);
          IFEND;
        UNTIL NOT outstanding_io_on_file;

        remove_fde_active_thread (system_file_id, p_fde, status);
        number_of_fmds := p_dfd^.number_of_fmds;
        p_dfd^.purged := TRUE;

        IF log_entry_to_purge_file THEN
          FOR fmd_index := 1 TO number_of_fmds DO
            dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
            log_fmd_purge (p_fde^.global_file_name, p_fmd, status);
            IF NOT status.normal THEN
              EXIT /fde_locked/; {----->
            IFEND;
          FOREND;
        IFEND;

        IF p_fde^.asti <> 0 THEN
          PUSH p_rb_ring1_segment_request;
          p_rb_ring1_segment_request^.reqcode := syc$rc_ring1_segment_request;
          p_rb_ring1_segment_request^.status.normal := TRUE;
          p_rb_ring1_segment_request^.request := mmc$sr1_delete_seg_sfid;
          p_rb_ring1_segment_request^.sfid := system_file_id;

          mmp$issue_ring1_segment_request (p_rb_ring1_segment_request^);
          syp$set_status_from_mtr_status (p_rb_ring1_segment_request^.status, status);
          IF NOT status.normal THEN
            EXIT /fde_locked/; {----->
          IFEND;
        IFEND;

        dmp$delete_disk_file_descriptor (system_file_id, p_fde, file_locator, status);
        IF status.normal THEN
          p_fde^.global_file_name := dmv$null_global_file_name;
          gfp$unlock_fde_p (p_fde);
          gfp$free_fde (p_fde, system_file_id);
          EXIT /main_program/; {----->
        IFEND;

      END /fde_locked/;

      gfp$unlock_fde_p (p_fde);

    END /main_program/;

  PROCEND free_file_tables;

?? TITLE := '  log_fmd_purge ', EJECT ??

  PROCEDURE log_fmd_purge
    (    global_file_name: dmt$global_file_name;
         p_fmd: ^dmt$file_medium_descriptor;
     VAR status: ost$status);

    VAR
      avt_index: dmt$active_volume_table_index,
      log_entry: dmt$dl_entry,
      volume_found: boolean;

    status.normal := TRUE;

    IF p_fmd <> NIL THEN
      IF p_fmd^.in_use AND p_fmd^.volume_assigned THEN

        dmp$search_avt_by_vsn (p_fmd^.internal_vsn, avt_index, volume_found);

        IF volume_found THEN
          log_entry.kind := dmc$dl_purge_file;
          log_entry.purge_file_block.global_file_name := global_file_name;
          log_entry.purge_file_block.file_byte_address := 0;
          log_entry.purge_file_block.dfl_index := p_fmd^.dfl_index;
          avt_index := p_fmd^.avt_index;

          dmp$process_device_log_entry (avt_index, log_entry, status);

        IFEND;
      IFEND;
    IFEND;

  PROCEND log_fmd_purge;

?? TITLE := '  log_sft_delete', EJECT ??

  PROCEDURE log_sft_delete
    (    sfid: gft$system_file_identifier;
         p_fde: ^gft$file_descriptor_entry;
     VAR logging_performed: boolean;
     VAR status: ost$status);

    VAR
      avt_index: dmt$active_volume_table_index,
      fmd_index: dmt$fmd_index,
      logging_active: boolean,
      log_entry: dmt$dl_entry,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fmd: ^dmt$file_medium_descriptor;

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

    { Issue a dmc$dl_first_sft_delete log entry for each fad residing
    { on a volume for which logging is active.  If an error is encountered
    { while processing the log entry for a fad, no additional fads
    { are processed.  The delete_logging_count for the fad encountering
    { the error will prevent the file from being deleted, avoiding the
    { danger of the file being re-attached while there is outstanding log
    { activity.

    dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
    log_entry.kind := dmc$dl_first_sft_delete;
    log_entry.sft_delete_block.global_file_name := p_fde^.global_file_name;
    log_entry.sft_delete_block.sfid := sfid;

    FOR fmd_index := 1 TO p_dfd^.number_of_fmds DO
      dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
      IF p_fmd^.in_use AND p_fmd^.volume_assigned THEN
        avt_index := p_fmd^.avt_index;
        logging_active := NOT dmv$active_volume_table.table_p^ [avt_index].mass_storage.logged_in_for_recovery
              AND (dmv$active_volume_table.table_p^ [avt_index].mass_storage.p_device_log <> gfv$null_sfid);
        IF logging_active THEN
          logging_performed := TRUE;
          p_fmd^.delete_logging_count := p_fmd^.delete_logging_count + 1;
          log_entry.sft_delete_block.dfl_index := p_fmd^.dfl_index;
          log_entry.sft_delete_block.fmd_index := fmd_index;
          dmp$process_device_log_entry (avt_index, log_entry, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
      IFEND;
    FOREND;

  PROCEND log_sft_delete;

?? TITLE := '  remove_fde_active_thread', EJECT ??

  PROCEDURE remove_fde_active_thread
    (    system_file_id: gft$system_file_identifier;
         p_fde: gft$file_desc_entry_p;
     VAR status: ost$status);

    VAR
      p_previous_fde: gft$file_desc_entry_p,
      entry_found: boolean,
      file_hash: dmt$file_hash;

    status.normal := TRUE;

    entry_found := FALSE;
    file_hash := system_file_id.file_hash;

    IF file_hash_threads [file_hash] = p_fde THEN
      file_hash_threads [file_hash] := p_fde^.file_hash_thread;
      p_fde^.file_hash_thread := NIL;
      RETURN; {----->
    IFEND;

    p_previous_fde := file_hash_threads [file_hash];

  /search_for_entry/
    WHILE (p_previous_fde <> NIL) DO
      IF p_previous_fde^.file_hash_thread = p_fde THEN
        p_previous_fde^.file_hash_thread := p_fde^.file_hash_thread;
        entry_found := TRUE;
        EXIT /search_for_entry/; {----->
      ELSE
        p_previous_fde := p_previous_fde^.file_hash_thread;
      IFEND;
    WHILEND /search_for_entry/;

    IF NOT entry_found THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$fde_queuing_error,
            'Trying to remove FDE not in active queue - remove_fde_active_thread.', status);
      RETURN; {----->
    IFEND;

    p_fde^.file_hash_thread := NIL;

  PROCEND remove_fde_active_thread;

?? TITLE := '  update_dfl_file_length', EJECT ??

  PROCEDURE update_dfl_file_length
    (    p_fde: ^gft$file_descriptor_entry;
         p_dfd: ^dmt$disk_file_descriptor;
     VAR status: ost$status);

    VAR
      avt_index: dmt$active_volume_table_index,
      entry_to_be_processed: boolean,
      fmd_number: dmt$fmd_index,
      log_entry: dmt$dl_entry,
      p_fmd: ^dmt$file_medium_descriptor,
      number_of_fmds: dmt$fmd_index;

    status.normal := TRUE;
    dmp$get_fmd_by_index (p_dfd, 1, p_fmd);

    IF p_fmd = NIL THEN
      RETURN; {----->
    IFEND;
    avt_index := p_fmd^.avt_index;

    log_entry.kind := dmc$dl_update_file_length;
    log_entry.file_length_block.global_file_name := p_fde^.global_file_name;
    log_entry.file_length_block.dfl_index := p_fmd^.dfl_index;
    log_entry.file_length_block.eof_specified := TRUE;
    log_entry.file_length_block.eof := (p_fde^.eoi_byte_address + p_dfd^.bytes_per_allocation - 1) DIV
          p_dfd^.bytes_per_allocation * p_dfd^.bytes_per_allocation;
    log_entry.file_length_block.eoi_specified := TRUE;
    log_entry.file_length_block.eoi := gfp$get_eoi_from_fde (p_fde);

    dmp$process_device_log_entry (avt_index, log_entry, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    number_of_fmds := p_dfd^.number_of_fmds;

    log_entry.kind := dmc$dl_update_fmd_length;
    log_entry.fmd_length_block.global_file_name := p_fde^.global_file_name;
    log_entry.fmd_length_block.fmd_length_specified := TRUE;
    log_entry.fmd_length_block.logical_length_specified := TRUE;

    FOR fmd_number := 1 TO number_of_fmds DO
      dmp$get_fmd_by_index (p_dfd, fmd_number, p_fmd);
      entry_to_be_processed := p_fmd^.in_use AND p_fmd^.volume_assigned;

      IF entry_to_be_processed THEN
        avt_index := p_fmd^.avt_index;
        log_entry.fmd_length_block.dfl_index := p_fmd^.dfl_index;
        log_entry.fmd_length_block.fmd_length := p_fmd^.fmd_allocated_length;
        log_entry.fmd_length_block.logical_length := p_fmd^.fmd_allocated_length;

        dmp$process_device_log_entry (avt_index, log_entry, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;
    FOREND;

    p_dfd^.dfd_modified := FALSE;
    p_fde^.flags.eoi_modified := FALSE;

  PROCEND update_dfl_file_length;
?? OLDTITLE ??
MODEND dmm$file_table_manager;
