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

{ PURPOSE:
{
{  The purpose of this module is to manage the File Medium Descriptor for
{  files described in the system and job file tables.  This includes creation
{  and deletion of the FMD and the updating of information stored in the FMD.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$mainframe_paged_literal
*copyc mme$condition_codes
*copyc amt$file_byte_address
*copyc dmt$allocation_size
*copyc dmt$assigned_ms_vol_attributes
*copyc dmt$error_condition_codes
*copyc dmt$file_allocation_table
*copyc dmt$file_location
*copyc dmt$file_medium_descriptor
*copyc dmt$fmd_index
*copyc dmt$mainframe_allocation_table
*copyc dmt$monitor_request_blocks
*copyc dmt$ms_device_allocation_table
*copyc dmt$ms_device_file_list_entry
*copyc dmt$stored_fmd
*copyc dmt$stored_fmd_size
*copyc dmt$stored_ms_fmd_header
*copyc ost$status
?? POP ??
*copyc dmp$close_file
*copyc dmp$generate_gfn_hash
*copyc dmf$disk_file_descriptor_p
*copyc dmp$get_fau_entry_and_fmd
*copyc dmp$get_fmd_by_index
*copyc dmf$level_2_ptr
*copyc dmp$get_mat_pointer
*copyc dmp$get_next_fmd_fau
*copyc dmp$get_previous_fau_entry
*copyc dmp$open_dat
*copyc dmp$open_dflt
*copyc dmp$preset_conversion
*copyc dmp$process_device_log_entry
*copyc dmp$search_avt_by_vsn
*copyc dmp$search_fdt_by_gfn
*copyc dmp$set_file_table_locator
*copyc gff$old_file_hash
*copyc gfp$get_fde_p
*copyc gfp$get_locked_fde_p
*copyc gfp$unlock_fde_p
*copyc osp$append_status_parameter
*copyc osp$fatal_system_error
*copyc osp$set_status_abnormal
*copyc pmp$convert_binary_unique_name
*copyc pmp$cycle
*copyc pmp$zero_out_table
*copyc syp$continue_to_cause
*copyc syp$disestablish_cond_handler
*copyc syp$establish_condition_handler
*copyc dmv$active_volume_table
*copyc dmv$default_fau_entry
*copyc osv$deadstart_phase
*copyc osv$job_fixed_heap
*copyc osv$mainframe_wired_heap
*copyc i#call_monitor
*copyc i#move

  VAR
    osv$mw_heap_min_frag_alloc_size: [XREF] integer;

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

  VAR
    v$default_fmd: [STATIC, READ, oss$mainframe_paged_literal] dmt$file_medium_descriptor :=
{ in_use                     } [FALSE,
{ system_file_id             } [0, gfc$tr_null_residence, gfc$null_file_hash],
{ avt_index                  } 0,
{ device_file_list_index     } 0,
{ delete_logging_count       } 0,
{ volume_assigned            } FALSE,
{ fmd_allocated_length       } 0,
{ bytes_per_mau              } dmc$min_bytes_per_mau,
{ daus_per_cylinder          } dmc$min_daus_position,
{ daus_per_allocation_unit   } dmc$min_daus_allocation,
{ internal_vsn               } [0, osc$cyber_180_model_unknown, 1988, 1, 1, 0, 0, 0, 0, 0],
{ maus_per_dau               } dmc$min_maus_per_dau,
{ maus_per_transfer_unit     } dmc$min_maus_per_transfer,
{ p_next_fmd                 } NIL,
{ allocation_style           } dmc$a0];

?? OLDTITLE ??
?? NEWTITLE := 'P$CONVERT_TO_HEX', EJECT ??

  PROCEDURE p$convert_to_hex
    (    p_cell: ^cell;
     VAR str: string ( * <= osc$max_string_size));

    VAR
      digit: 0 .. 15,
      index: 1 .. osc$max_string_size,
      p_digits: ^packed array [1 .. osc$max_string_size] of 0 .. 15;

    p_digits := p_cell;

    FOR index := 1 TO STRLENGTH (str) DO
      digit := p_digits^ [index];
      IF (digit < 10) THEN
        str (index, 1) := $CHAR ($INTEGER ('0') + digit);
      ELSE
        str (index, 1) := $CHAR ($INTEGER ('A') - 10 + digit);
      IFEND;
    FOREND;

  PROCEND p$convert_to_hex;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] DMP$CHANGE_OVERFLOW_ALLOWED', EJECT ??

{   The purpose of this routine is to change whether overflow is allowed
{ for an attached file.  The file must be attached and a permanent file.
{ This will have the effect of causing the catalog to be updated on the
{ next detach of the file.

  PROCEDURE [XDCL, #GATE] dmp$change_overflow_allowed
    (    global_file_name: dmt$global_file_name;
         overflow_allowed: boolean;
     VAR status: ost$status);

    VAR
      existing_fde_entry_found: boolean,
      file_entry_index: gft$file_descriptor_index,
      local_status: ost$status,
      p_fde: gft$file_desc_entry_p,
      p_dfd: ^dmt$disk_file_descriptor,
      system_file_id: gft$system_file_identifier;

    status.normal := TRUE;
    system_file_id.residence := gfc$tr_system;

    dmp$generate_gfn_hash (global_file_name, system_file_id.file_hash);

    dmp$search_fdt_by_gfn (gfc$tr_system, global_file_name, system_file_id.file_entry_index,
          existing_fde_entry_found);
    IF NOT existing_fde_entry_found THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            ' Unable to change overflow allowed ', status);
      RETURN; {----->
    IFEND;

    gfp$get_locked_fde_p (system_file_id, p_fde);

  /fde_locked/
    BEGIN
      existing_fde_entry_found := p_fde^.global_file_name = global_file_name;
      IF NOT existing_fde_entry_found THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
              ' Unable to change overlow allowed - fde wrong state ', status);
        EXIT /fde_locked/; {----->
      IFEND;

      IF p_fde^.media = gfc$fm_served_file THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unexpected_server_file,
              'Server file encountered - dmp$change_overflow_allowed.', status);
        EXIT /fde_locked/; {----->
      IFEND;

      p_dfd := dmf$disk_file_descriptor_p (p_fde);
      IF p_dfd^.purged THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
              'DFD purged - dmp$change_overflow_allowed.', status);
      ELSE
        p_dfd^.overflow_allowed := overflow_allowed;
        p_dfd^.fmd_modified := TRUE;
      IFEND;
    END /fde_locked/;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$change_overflow_allowed;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$BUILD_FMD_FOR_EXISTING_FILE', EJECT ??

  PROCEDURE [XDCL] dmp$build_fmd_for_existing_file
    (    p_fde: gft$file_desc_entry_p;
         p_dfd: ^dmt$disk_file_descriptor;
         system_file_id: gft$system_file_identifier;
     VAR file_damaged: boolean;
     VAR file_flawed: boolean;
     VAR status: ost$status);

    VAR
      avt_index: dmt$active_volume_table_index,
      dat_sfid: gft$system_file_identifier,
      dfl_entry: dmt$ms_device_file_list_entry,
      dfl_gfn_string: ost$name,
      dflt_sfid: gft$system_file_identifier,
      fmd_count: dmt$fmd_index,
      fmd_index: dmt$fmd_index,
      found: boolean,
      initialized_length: integer,
      log_entry: dmt$dl_entry,
      p_dflt: ^dmt$ms_device_file_list_table,
      p_fmd: ^dmt$file_medium_descriptor,
      level_1_start,
      level_1_index: dmt$level_1_index,
      level_2_start,
      level_2_index: dmt$level_2_index,
      p_level_2: ^dmt$level_2_table,
      subfile_flawed: boolean;

?? NEWTITLE := 'DFL_CONDITION_HANDLER', EJECT ??

    PROCEDURE dfl_condition_handler
      (    mf: ost$monitor_fault;
           p_msa: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      VAR
        p_scc: ^syt$system_core_condition,
        p_sac: ^mmt$segment_access_condition;

      IF mf.identifier = mmc$segment_fault_processor_id THEN
        p_sac := #LOC (mf.contents);
        CASE p_sac^.identifier OF
        = mmc$sac_io_read_error =
          osp$set_status_abnormal ('MM', mme$io_read_error,
                'io error referencing DFL - dmp$build_fad_for_existing_file', status);
          EXIT dmp$build_fmd_for_existing_file; {----->
        ELSE
        CASEND;
      ELSEIF mf.identifier = syc$system_core_condition THEN
        p_scc := #LOC (mf.system_core_condition);
        CASE p_scc^.condition OF
        = syc$user_defined_condition =
          IF p_scc^.user_defined_condition = syc$udc_volume_unavailable THEN
            osp$set_status_abnormal ('MM', mme$volume_unavailable,
                  'io error referencing DFL - dmp$build_fmd_for_existing_file', status);
            EXIT dmp$build_fmd_for_existing_file; {----->
          IFEND;
        ELSE
        CASEND;
      IFEND;

      syp$continue_to_cause (mf, p_msa, syc$condition_ignored, continue);

    PROCEND dfl_condition_handler;
?? OLDTITLE ??
?? NEWTITLE := 'P$INVALID_SUBFILE', EJECT ??

    PROCEDURE p$invalid_subfile;

      VAR
        gfn_string: ost$name,
        length: integer,
        msg: string (osc$max_string_size),
        vsn: rmt$recorded_vsn;

      pmp$convert_binary_unique_name (p_fde^.global_file_name, gfn_string, status);
      vsn := dmv$active_volume_table.table_p^ [avt_index].mass_storage.recorded_vsn;
      IF (dfl_entry.flags <> dmc$dfle_assigned_to_file) THEN
        STRINGREP (msg, length, 'Invalid subfile (DFL not file), gfn = ', gfn_string, ', subfile =',
              fmd_index, ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ' - dmp$build_fmd_for_existing_file.')
      ELSE
        pmp$convert_binary_unique_name (dfl_entry.global_file_name, dfl_gfn_string, status);
        STRINGREP (msg, length, 'Invalid subfile (wrong GFN), gfn = ', gfn_string, ', subfile =', fmd_index,
              ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ', dfl_gfn = ', dfl_gfn_string,
              ' - dmp$build_fmd_for_existing_file.');
      IFEND;
      osp$set_status_abnormal (dmc$device_manager_ident, dme$invalid_subfile, msg (1, length), status);

    PROCEND p$invalid_subfile;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    file_flawed := FALSE;
    fmd_count := p_dfd^.number_of_fmds;

    FOR fmd_index := 1 TO fmd_count DO
      dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);

      dmp$search_avt_by_vsn (p_fmd^.internal_vsn, avt_index, found);
      IF NOT found THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$avt_entry_not_found,
              'Volume not in AVT - dmp$build_fmd_for_existing_file.', status);
        RETURN; {----->
      IFEND;

      dflt_sfid := dmv$active_volume_table.table_p^ [avt_index].mass_storage.p_device_file_list_table;
      dat_sfid := dmv$active_volume_table.table_p^ [avt_index].mass_storage.p_device_allocation_table;

      syp$establish_condition_handler (^dfl_condition_handler);

      dmp$open_dflt (dflt_sfid, osc$os_ring_1, osc$tsrv_ring, mmc$sar_read, mmc$as_sequential, p_dflt,
            status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      dfl_entry := p_dflt^.entries [p_fmd^.dfl_index];
      dmp$close_file (p_dflt, status);

      syp$disestablish_cond_handler;

      IF (dfl_entry.flags <> dmc$dfle_assigned_to_file) OR
            (p_fde^.global_file_name <> dfl_entry.global_file_name) THEN
        p$invalid_subfile;
        RETURN; {----->
      IFEND;

      p_fmd^.avt_index := avt_index;

      IF fmd_index = 1 THEN {???? OK ????}
        {Pick up from first subfile
        p_fde^.eoi_byte_address := dfl_entry.end_of_information;
        file_damaged := (dmc$media_image_inconsistent IN dfl_entry.damage);
        p_dfd^.file_damaged := file_damaged;
      IFEND;

      dmp$build_faus_from_dfl_entry (dat_sfid, dfl_entry, p_fmd, p_dfd, system_file_id, fmd_index,
            subfile_flawed, status);
      file_flawed := file_flawed OR subfile_flawed;

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

    IF p_fde^.eoi_byte_address = amc$file_byte_limit THEN

{ This file was attached in write mode during a recovery without image.
{ The eoi and eof must be updated to reflect the reality of ALL fmds.

      level_1_start := p_dfd^.fat_upper_bound;
      level_2_start := p_dfd^.bytes_per_level_2 DIV p_dfd^.bytes_per_allocation - 1;
      initialized_length := 0;

      IF p_dfd^.file_allocation_table <> NIL THEN

      /find_eoi/
        FOR level_1_index := level_1_start DOWNTO 0 DO
          p_level_2 := dmf$level_2_ptr (^p_dfd^.file_allocation_table^ [level_1_index]);
          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_initialized) OR
                    (p_level_2^ [level_2_index].state = dmc$fau_initialized_and_flawed) THEN
                initialized_length := (level_1_index * p_dfd^.bytes_per_level_2) +
                      (level_2_index * p_dfd^.bytes_per_allocation) + p_dfd^.bytes_per_allocation;
                EXIT /find_eoi/; {----->
              IFEND;
            FOREND;
          IFEND;
        FOREND /find_eoi/;
      IFEND;

      p_fde^.eoi_byte_address := initialized_length;

      dmp$get_fmd_by_index (p_dfd, 1, p_fmd);

      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 := initialized_length;

      log_entry.file_length_block.eoi_specified := TRUE;
      log_entry.file_length_block.eoi := initialized_length;

      dmp$process_device_log_entry (p_fmd^.avt_index, log_entry, status);
    IFEND;

  PROCEND dmp$build_fmd_for_existing_file;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$BUILD_FAUS_FROM_DFL_ENTRY', EJECT ??

  PROCEDURE [XDCL] dmp$build_faus_from_dfl_entry
    (    dat_sfid: gft$system_file_identifier;
         dfl_entry: dmt$ms_device_file_list_entry;
         p_fmd: ^dmt$file_medium_descriptor;
         p_dfd: ^dmt$disk_file_descriptor;
         system_file_id: gft$system_file_identifier;
         fmd_index: dmt$fmd_index;
     VAR file_flawed: boolean;
     VAR status: ost$status);

    VAR
      allocation_style: dmt$allocation_styles,
      allocation_style_found: boolean,
      bytes_per_allocation: dmt$bytes_per_allocation,
      dau_address: dmt$dau_address,
      dau_byte_address: amt$file_byte_address,
      dau_entry: dmt$ms_device_allocation_unit,
      end_of_allocation_chain: boolean,
      gfn_string: ost$name,
      length: integer,
      msg: string (osc$max_string_size),
      p_fde: gft$file_desc_entry_p,
      p_dat: ^dmt$ms_device_allocation_table,
      p_fau_entry: ^dmt$file_allocation_unit,
      p_str: ^string ( * <= osc$max_string_size),
      status_p: ^ost$status,
      vsn: rmt$recorded_vsn;

?? NEWTITLE := 'DAT_CONDITION_HANDLER', EJECT ??

    PROCEDURE dat_condition_handler
      (    mf: ost$monitor_fault;
           p_msa: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      VAR
        ignore_status: ost$status,
        p_scc: ^syt$system_core_condition,
        p_sac: ^mmt$segment_access_condition;

      IF mf.identifier = mmc$segment_fault_processor_id THEN
        p_sac := #LOC (mf.contents);
        CASE p_sac^.identifier OF
        = mmc$sac_io_read_error =
          osp$set_status_abnormal ('MM', mme$io_read_error,
                'io error encountered on DAT - dmp$build_faus_from_dfl_entry', status);

          IF p_dat <> NIL THEN
            dmp$close_file (p_dat, ignore_status);
          IFEND;
          EXIT dmp$build_faus_from_dfl_entry; {----->
        ELSE
        CASEND;
      ELSEIF mf.identifier = syc$system_core_condition THEN
        p_scc := #LOC (mf.system_core_condition);
        CASE p_scc^.condition OF
        = syc$user_defined_condition =
          IF p_scc^.user_defined_condition = syc$udc_volume_unavailable THEN
            osp$set_status_abnormal ('MM', mme$volume_unavailable,
                  'io error encountered on DAT - dmp$build_faus_from_dfl_entry', status);
            IF p_dat <> NIL THEN
              dmp$close_file (p_dat, ignore_status);
            IFEND;
            EXIT dmp$build_faus_from_dfl_entry; {----->
          IFEND;
        ELSE
        CASEND;
      IFEND;

      syp$continue_to_cause (mf, p_msa, syc$condition_ignored, continue);

    PROCEND dat_condition_handler;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    file_flawed := FALSE;
    allocation_style_found := FALSE;

    gfp$get_fde_p (system_file_id, p_fde);
    IF p_fde = NIL THEN
      STRINGREP (msg, length, 'SFID ', system_file_id.file_entry_index: #(16),
            system_file_id.residence: #(16), system_file_id.file_hash: #(16),
            '(16) contains bad file residence or file index - dmp$build_faus_from_dfl_entry.');
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde, msg (1, length), status);
      RETURN; {----->
    IFEND;

    syp$establish_condition_handler (^dat_condition_handler);

    p_dat := NIL;
    dmp$open_dat (dat_sfid, osc$os_ring_1, osc$tsrv_ring, mmc$sar_read, mmc$as_sequential, p_dat, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

  /dat_open/
    BEGIN
      bytes_per_allocation := dfl_entry.daus_per_allocation_unit * p_dat^.header.bytes_per_dau;

      p_fmd^.bytes_per_mau := p_dat^.header.bytes_per_mau;
      p_fmd^.daus_per_allocation_unit := dfl_entry.daus_per_allocation_unit;
      p_fmd^.daus_per_cylinder := p_dat^.header.daus_per_position;
      p_fmd^.maus_per_dau := p_dat^.header.maus_per_dau;
      p_fmd^.system_file_id := system_file_id;

      IF p_dat^.header.version_number = dmc$dat_0_0 THEN

      /determine_allocation_style/
        FOR allocation_style := LOWERVALUE (dmt$allocation_styles) TO UPPERVALUE (dmt$allocation_styles) DO
          allocation_style_found := (p_fmd^.daus_per_allocation_unit =
                p_dat^.header.daus_per_allocation_style [allocation_style]);
          IF allocation_style_found THEN
            EXIT /determine_allocation_style/; {----->
          IFEND;
        FOREND /determine_allocation_style/;
      IFEND;

      IF NOT allocation_style_found THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$no_allocation_style_found,
              'File allocation style not found in DAT header - dmp$build_faus_from_dfl_entry.', status);
        EXIT /dat_open/; {----->
      IFEND;

      p_fmd^.allocation_style := allocation_style;

      IF p_dfd^.bytes_per_allocation = 0 THEN
        {Allow any allocation size (including cylinder) to allow upward compatability
        {from r131.  Will only be able to overflow to devices that support the same
        {allocation size.
        {
        {This situation also must occure with some DM deadstart files.

        p_dfd^.bytes_per_allocation := bytes_per_allocation;
        p_fde^.allocation_unit_size := bytes_per_allocation;
        {Force level 2 tables to be "full"
        p_dfd^.bytes_per_level_2 := bytes_per_allocation * (dmc$bytes_per_level_2 DIV 16384);
      ELSEIF p_dfd^.bytes_per_allocation <> bytes_per_allocation THEN
        {Cannot support existing file with subfiles of different allocation sizes
        STRINGREP (msg, length, 'Existing file, SFID ', system_file_id.file_entry_index: #(16),
              system_file_id.residence: #(16), system_file_id.file_hash: #(16),
              '(16), contains subfiles of different allocation sizes - dmp$build_faus_from_dfl_entry.');
        osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_mismatch, msg (1, length), status);
        EXIT /dat_open/; {----->
      IFEND;
      p_fmd^.maus_per_transfer_unit := p_dfd^.bytes_per_allocation DIV p_dat^.header.bytes_per_mau;

      p_fmd^.fmd_allocated_length := 0;
      dau_byte_address := dfl_entry.file_byte_address;

      IF dfl_entry.dau_chain_status = dmc$dau_chain_linked THEN
        dau_address := dfl_entry.first_dau_address;
        end_of_allocation_chain := FALSE;

{ Allocate the complete FAU at once instead of going through it iteractivly
{   We can do it only, when we are on the first FMD and the addresses are not unknown (ex. recovery wo. image)
{   0 Length Files are also missed, but end in one single FAU creation wo. extra overhead.

        IF (fmd_index = 1) AND (dfl_entry.end_of_file > 0) AND (dfl_entry.end_of_file <= 80000000(16)) THEN
          dmp$get_fau_entry (p_dfd, dau_byte_address, p_fau_entry);
          IF p_fau_entry = NIL THEN
            dmp$create_fau_entry (p_dfd, dau_byte_address, dfl_entry.end_of_file - dau_byte_address);
          IFEND;
        IFEND;

      /build_aus_from_dat/
        REPEAT
          dau_entry := p_dat^.body [dau_address];
          IF ((dau_entry.dau_status <> dmc$dau_assigned_to_file) AND
                (dau_entry.dau_status <> dmc$dau_ass_to_file_swr_flawed)) OR
                ((dau_entry.file_hash <> dfl_entry.file_hash) AND
                (gff$old_file_hash (dau_entry.file_hash) <> gff$old_file_hash (dfl_entry.file_hash))) THEN
            pmp$convert_binary_unique_name (p_fde^.global_file_name, gfn_string, status);
            vsn := dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.recorded_vsn;
            PUSH p_str: [2 * #SIZE (dau_entry)];
            p$convert_to_hex (#LOC (dau_entry), p_str^);
            STRINGREP (msg, length, 'DAT chain broken, gfn = ', gfn_string, ', subfile =', fmd_index,
                  ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ', offset =', p_fmd^.fmd_allocated_length,
                  ', dau =', dau_address, ', dau_entry = ', p_str^, ' - dmp$build_faus_from_dfl_entry.');
            osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken, msg (1, length),
                  status);
            EXIT /dat_open/; {----->
          IFEND;

          dmp$get_fau_entry (p_dfd, dau_byte_address, p_fau_entry);
          IF p_fau_entry = NIL THEN
            dmp$create_fau_entry (p_dfd, dau_byte_address, bytes_per_allocation);
            dmp$get_fau_entry (p_dfd, dau_byte_address, p_fau_entry);

            IF (p_fau_entry = NIL) THEN
              pmp$convert_binary_unique_name (p_fde^.global_file_name, gfn_string, status);
              vsn := dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.recorded_vsn;
              STRINGREP (msg, length, 'Can''t create FAU entry, gfn = ', gfn_string, ', subfile =', fmd_index,
                    ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ', byte =', dau_byte_address,
                    ' - dmp$build_faus_from_dfl_entry.');
              osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken, msg (1, length),
                    status);
              EXIT /dat_open/; {----->
            IFEND;
          IFEND;

          IF (p_fau_entry^.state <> dmc$fau_free) THEN
            pmp$convert_binary_unique_name (p_fde^.global_file_name, gfn_string, status);
            vsn := dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.recorded_vsn;
            STRINGREP (msg, length, 'Duplicate DAT offset, gfn = ', gfn_string, ', subfile =', fmd_index,
                  ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ', byte =', dau_byte_address,
                  ' - dmp$build_faus_from_dfl_entry.');
            osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken, msg (1, length),
                  status);
            EXIT /dat_open/; {----->
          IFEND;

          p_fau_entry^.dau_address := dau_address;
          p_fau_entry^.fmd_index := fmd_index;
          IF dau_entry.dau_status = dmc$dau_assigned_to_file THEN
            IF dau_entry.data_status = dmc$dau_data_initialized THEN
              p_fau_entry^.state := dmc$fau_initialized;
            ELSE
              p_fau_entry^.state := dmc$fau_invalid_data;
            IFEND;
          ELSE
            IF dau_entry.data_status = dmc$dau_data_initialized THEN
              p_fau_entry^.state := dmc$fau_initialized_and_flawed;
            ELSE
              p_fau_entry^.state := dmc$fau_invalid_and_flawed;
            IFEND;
            file_flawed := TRUE;
          IFEND;

          CASE dau_entry.allocation_chain_position OF
          = dmc$first_allocation, dmc$middle_allocation =
            IF (dau_entry.next_allocation_unit_dau < p_dat^.header.number_of_entries) THEN
              dau_address := dau_entry.next_allocation_unit_dau;
            ELSE
              pmp$convert_binary_unique_name (p_fde^.global_file_name, gfn_string, status);
              vsn := dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.recorded_vsn;
              PUSH p_str: [2 * #SIZE (dau_entry)];
              p$convert_to_hex (#LOC (dau_entry), p_str^);
              STRINGREP (msg, length, 'DAT chain broken, gfn = ', gfn_string, ', subfile =', fmd_index,
                    ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ', offset =', p_fmd^.fmd_allocated_length,
                    ', dau =', dau_address, ', dau_entry = ', p_str^, ' - dmp$build_faus_from_dfl_entry.');
              osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken, msg (1, length),
                    status);
              EXIT /dat_open/; {----->
            IFEND;
          ELSE
            end_of_allocation_chain := TRUE;
          CASEND;

          p_fmd^.fmd_allocated_length := p_fmd^.fmd_allocated_length + bytes_per_allocation;
          dau_byte_address := dau_byte_address + bytes_per_allocation;

        UNTIL end_of_allocation_chain;
      IFEND;

      IF (dau_byte_address >= p_dfd^.highest_offset_allocated) THEN
        p_dfd^.highest_offset_allocated := dau_byte_address;
        p_dfd^.current_fmd_index := fmd_index;
      IFEND;

      IF (p_fmd^.fmd_allocated_length <> dfl_entry.fmd_length) THEN
        p_dfd^.dfd_modified := TRUE;
        IF (p_fmd^.fmd_allocated_length < dfl_entry.fmd_length) AND
              (osv$deadstart_phase <> osc$recovery_deadstart) THEN
          pmp$convert_binary_unique_name (p_fde^.global_file_name, gfn_string, status);
          vsn := dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.recorded_vsn;
          STRINGREP (msg, length, 'DAT chain length (', p_fmd^.fmd_allocated_length,
                ') less than DFL length (', dfl_entry.fmd_length, '), gfn = ', gfn_string, ', subfile =',
                fmd_index, ', vsn = ', vsn, ', dfl =', p_fmd^.dfl_index, ' - dmp$build_faus_from_dfl_entry.');
          osp$set_status_abnormal (dmc$device_manager_ident, dme$incorrect_num_alloc_units, msg (1, length),
                status);
        IFEND;
      IFEND;
    END /dat_open/;

    IF status.normal THEN
      status_p := ^status;
    ELSE
      PUSH status_p;
    IFEND;

    dmp$close_file (p_dat, status_p^);

    syp$disestablish_cond_handler;

  PROCEND dmp$build_faus_from_dfl_entry;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] DMP$BUILD_STORED_FMD', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$build_stored_fmd
    (    p_fde: gft$file_desc_entry_p;
     VAR p_stored_fmd: ^dmt$stored_fmd;
     VAR status: ost$status);

    VAR
      avt_index: dmt$active_volume_table_index,
      byte_address: amt$file_byte_address,
      fmd_count: dmt$fmd_index,
      fmd_index: dmt$fmd_index,
      found: boolean,
      p_fmd: ^dmt$file_medium_descriptor,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fmd_header: ^dmt$stored_ms_fmd_header,
      p_fmd_version: ^dmt$stored_ms_version_number,
      p_stored_subfile: ^dmt$stored_ms_fmd_subfile;

    status.normal := TRUE;
    RESET p_stored_fmd;

    NEXT p_fmd_version IN p_stored_fmd;
    IF (p_fmd_version = NIL) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_too_small,
            'FMD too small - dmp$build_stored_fmd.', status);
      RETURN; {----->
    IFEND;

    p_fmd_version^ := dmc$current_fmd_version;

    NEXT p_fmd_header: [dmc$current_fmd_version] IN p_stored_fmd;
    IF (p_fmd_header = NIL) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_too_small,
            'FMD too small - dmp$build_stored_fmd.', status);
      RETURN; {----->
    IFEND;

    IF (p_fde^.media = gfc$fm_served_file) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unexpected_server_file,
            'Unexpected Server File - dmp$build_stored_fmd.', status);
      RETURN; {----->
    IFEND;

    p_dfd := dmf$disk_file_descriptor_p (p_fde);
    IF (p_dfd = NIL) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_not_created_for_file,
            'No DFD for file - dmp$build_stored_fmd.', status);
      RETURN; {----->
    IFEND;

{ CLEAR_SPACE and LOCKED_FILE have been removed from the tables, the following
{ references have been left to maintain compatibility.

    p_fmd_header^.version_0_0.clear_space := TRUE;
    p_fmd_header^.version_0_0.file_hash := p_fde^.file_hash;
    p_fmd_header^.version_0_0.file_limit := p_fde^.file_limit;
    p_fmd_header^.version_0_0.file_kind := p_fde^.file_kind;
    p_fmd_header^.version_0_0.locked_file.required := FALSE;
    p_fmd_header^.version_0_0.number_fmds := 0;
    p_fmd_header^.version_0_0.overflow_allowed := p_dfd^.overflow_allowed;
    p_fmd_header^.version_0_0.preset_value := dmp$preset_conversion (p_fde^.preset_value);
    p_fmd_header^.version_0_0.requested_allocation_size := p_dfd^.requested_allocation_size;
    p_fmd_header^.version_0_0.requested_class := p_dfd^.requested_class;
    p_fmd_header^.version_0_0.requested_class_ordinal := p_dfd^.requested_class_ordinal;
    p_fmd_header^.version_0_0.requested_transfer_size := p_dfd^.requested_transfer_size;
    p_fmd_header^.version_0_0.requested_volume := p_dfd^.requested_volume;

    {Sparse allocation requires that the fmds be returned in order from
    {1 to max so that the first fmd will be the first fmd on the next attach.

    {Manufacture correct byte address for backward compatibility

    byte_address := 0;
    fmd_count := 0;
    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
        dmp$search_avt_by_vsn (p_fmd^.internal_vsn, avt_index, found);
        IF found THEN
          NEXT p_stored_subfile: [dmc$current_fmd_version] IN p_stored_fmd;
          IF (p_stored_subfile = NIL) THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_too_small,
                  'FMD too small - dmp$build_stored_fmd.', status);
            RETURN; {----->
          IFEND;

          p_stored_subfile^.version_0_0.stored_byte_address := byte_address DIV dmc$byte_address_converter;
          p_stored_subfile^.version_0_0.device_file_list_index := p_fmd^.dfl_index;
          p_stored_subfile^.version_0_0.internal_vsn := p_fmd^.internal_vsn;
          p_stored_subfile^.version_0_0.recorded_vsn := dmv$active_volume_table.table_p^ [avt_index].
                mass_storage.recorded_vsn;
          fmd_count := fmd_count + 1;
        IFEND;
        byte_address := byte_address + p_fmd^.fmd_allocated_length;
      IFEND;
    FOREND;

    p_fmd_header^.version_0_0.number_fmds := fmd_count;

  PROCEND dmp$build_stored_fmd;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$CREATE_FMDS', EJECT ??

  PROCEDURE [XDCL] dmp$create_fmds
    (    file_locator: dmt$file_location;
         number_fmds: dmt$fmd_index;
     VAR dfd: dmt$disk_file_descriptor);

    VAR
      fmd_index: dmt$fmd_index,
      fmd_pp: ^^dmt$file_medium_descriptor;

    fmd_pp := ^dfd.p_fmd;

    FOR fmd_index := 1 TO number_fmds DO
      ALLOCATE fmd_pp^ IN file_locator^;
      fmd_pp^^ := v$default_fmd;
      fmd_pp := ^fmd_pp^^.p_next_fmd;
    FOREND;

    dfd.number_of_fmds := number_fmds;

  PROCEND dmp$create_fmds;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$FREE_FMDS', EJECT ??

  PROCEDURE [XDCL] dmp$free_fmds
    (    p_dfd: ^dmt$disk_file_descriptor;
         fmd_locator: dmt$file_location;
         number_of_fmds: dmt$fmd_index;
     VAR fmds_released: boolean);

    VAR
      fmd_index: dmt$fmd_index,
      p_fmd: ^dmt$file_medium_descriptor,
      p_next_fmd: ^dmt$file_medium_descriptor;

    fmd_index := 0;

    dmp$get_fmd_by_index (p_dfd, 1, p_fmd);
    IF p_fmd <> NIL THEN
      REPEAT
        p_next_fmd := p_fmd^.p_next_fmd;
        FREE p_fmd IN fmd_locator^;
        p_fmd := p_next_fmd;
        fmd_index := fmd_index + 1;
      UNTIL (p_fmd = NIL) OR (fmd_index >= number_of_fmds);
    IFEND;

    fmds_released := (p_fmd = NIL);
    IF fmds_released AND (fmd_index = number_of_fmds) THEN
      p_dfd^.number_of_fmds := 0;
    IFEND;

  PROCEND dmp$free_fmds;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] DMP$GET_STORED_FMD', EJECT ??
*copy dmh$get_stored_fmd

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

    VAR
      p_fde: ^gft$file_descriptor_entry,
      p_stored_fmd: ^dmt$stored_fmd;

    status.normal := TRUE;
    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$get_stored_fmd.', status);
    ELSE
      p_stored_fmd := ^stored_fmd;
      dmp$build_stored_fmd (p_fde, p_stored_fmd, status);
      gfp$unlock_fde_p (p_fde);
    IFEND;

  PROCEND dmp$get_stored_fmd;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] DMP$GET_STORED_FMD_SIZE', EJECT ??
*copy dmh$get_stored_fmd_size

  PROCEDURE [XDCL, #GATE] dmp$get_stored_fmd_size
    (    system_file_id: gft$system_file_identifier;
     VAR size_of_stored_fmd: dmt$stored_fmd_size;
     VAR status: ost$status);

    VAR
      fmd_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;
    size_of_stored_fmd := #SIZE (dmt$stored_ms_version_number) + #SIZE (dmt$stored_ms_fmd_header);

    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$get_stored_fmd_size.', status);
      RETURN; {----->
    IFEND;

    IF (p_fde^.media = gfc$fm_served_file) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unexpected_server_file,
            'Unexpected Server File - dmp$get_stored_fmd_size.', status);
    ELSE
      p_dfd := dmf$disk_file_descriptor_p (p_fde);
      IF (p_dfd = NIL) THEN
        osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_not_created_for_file,
              'No DFD for file - dmp$get_stored_fmd_size.', status);
      ELSE
        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
            size_of_stored_fmd := size_of_stored_fmd + #SIZE (dmt$stored_ms_fmd_subfile);
          IFEND;
        FOREND;
      IFEND;
    IFEND;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$get_stored_fmd_size;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$INCREASE_FMD_COUNT', EJECT ??

  PROCEDURE [XDCL] dmp$increase_fmd_count
    (    system_file_id: gft$system_file_identifier;
         p_dfd: ^dmt$disk_file_descriptor;
     VAR status: ost$status);

    VAR
      fmd_count: dmt$fmd_index,
      fmd_locator: dmt$file_location,
      p_fmd: ^dmt$file_medium_descriptor,
      p_last_fmd: ^dmt$file_medium_descriptor;

    status.normal := TRUE;

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

    fmd_count := p_dfd^.number_of_fmds;
    IF (fmd_count >= UPPERVALUE (fmd_count)) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_overflow,
            'Maximum fmd count exceeded - dmp$increase_fmd_count.', status);
      RETURN; {----->
    IFEND;

    ALLOCATE p_fmd IN fmd_locator^;

    p_fmd^ := v$default_fmd;

    IF (fmd_count = 0) THEN
      p_dfd^.p_fmd := p_fmd;
    ELSE
      dmp$get_fmd_by_index (p_dfd, fmd_count, p_last_fmd);
      p_last_fmd^.p_next_fmd := p_fmd;
    IFEND;
    p_dfd^.number_of_fmds := fmd_count + 1;

  PROCEND dmp$increase_fmd_count;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$CREATE_FAU_ENTRY', EJECT ??

{   The purpose of this routine is to create FAU entries for the range of byte addresses
{ specified.  This routine limits the level one FAT to dmc$level_1_table_size and therefore
{ limits the maximum byte address.  The level one FAT size has been chosen to support the
{ maximum hardware segment size.  If a caller exceeds the maximum size, it may well hang
{ trying to access/create an FAU entry beyond what this routine will create.

{ This procedure assumes that the fde is locked

  PROCEDURE [XDCL] dmp$create_fau_entry
    (    p_dfd: ^dmt$disk_file_descriptor;
         byte_address: amt$file_byte_address;
         requested_allocation: amt$file_byte_address);

    VAR
      heap_min_allocation_bytes: integer,

      entry_size: integer,
      first: integer,
      index: dmt$level_1_index,
      last: integer,
      level_2: ^dmt$level_2_adapt,
      level_2_upper: dmt$level_2_index,
      locator: dmt$file_location,
      new_level_1: ^dmt$level_1_adapt,
      new_size: integer,
      old_level_1: ^dmt$level_1_table,
      old_size: integer,
      request: dmt$monitor_rb_allocate_space;

    IF #SEGMENT (p_dfd) = osc$segnum_mainframe_wired THEN
      locator := osv$mainframe_wired_heap;
    ELSE
      locator := osv$job_fixed_heap;
    IFEND;

{ Allocate level one table space.
    first := byte_address DIV p_dfd^.bytes_per_level_2;
    last := (byte_address + requested_allocation - 1) DIV p_dfd^.bytes_per_level_2;

{ In order to make maximum use of allocated memory, the following code determines the largest level one size
{ that fits in a block required to hold enough level one entries for the highest address being allocated.

    heap_min_allocation_bytes := osv$mw_heap_min_frag_alloc_size * 16;
    entry_size := #SIZE (amt$file_byte_address);
    new_size := (((last + 1) * entry_size + 16 {linkage} + heap_min_allocation_bytes {round} - 1) DIV
          heap_min_allocation_bytes * heap_min_allocation_bytes - 16) DIV entry_size;

    IF (new_size > dmc$level_1_table_size) THEN
      new_size := dmc$level_1_table_size;
    IFEND;

    old_size := p_dfd^.fat_upper_bound + 1;
    old_level_1 := p_dfd^.file_allocation_table;

    IF (old_level_1 = NIL) OR (new_size > old_size) THEN
      ALLOCATE new_level_1: [0 .. (new_size - 1)] IN locator^;
      pmp$zero_out_table (new_level_1, #SIZE (new_level_1^));

      { If an old level 1 pointer exists, it is necessary to update to the new pointer in monitor mode
      { to prevent the update from occurring while another CPU is using the old pointer in monitor mode.
      { If the old level 1 pointer does not exist, it should be safe and faster to update it directly.

      IF (old_level_1 = NIL) THEN
        p_dfd^.file_allocation_table := #LOC (new_level_1^);
        p_dfd^.fat_upper_bound := new_size - 1;
      ELSE
        i#move (old_level_1, new_level_1, old_size * entry_size);

        request.request_code := syc$rc_allocate_front_end;
        request.update_fat_pointer := TRUE;
        request.p_dfd := p_dfd;
        request.p_fat := #LOC (new_level_1^);
        request.fat_upper_bound := new_size - 1;
        i#call_monitor (#LOC (request), #SIZE (request));

        FREE old_level_1 IN locator^;
      IFEND;
    IFEND;

{ Allocate level two tables.
    IF (last > p_dfd^.fat_upper_bound) THEN
      last := p_dfd^.fat_upper_bound;
    IFEND;

    level_2_upper := (p_dfd^.bytes_per_level_2 DIV p_dfd^.bytes_per_allocation) - 1;

    FOR index := first TO last DO
      IF (p_dfd^.file_allocation_table^ [index] = 0) THEN
        ALLOCATE level_2: [0 .. level_2_upper] IN locator^;
        pmp$zero_out_table (level_2, #SIZE (level_2^)); { The value of dmc$fau_free must be zero.
        p_dfd^.file_allocation_table^ [index] := #OFFSET (level_2);
      IFEND;
    FOREND;

  PROCEND dmp$create_fau_entry;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate]  DMP$R2_INCREASE_FAU_COUNT', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$r2_increase_fau_count
    (    system_file_id: gft$system_file_identifier;
         number_faus_needed: dmt$fau_entries;
         byte_address: amt$file_byte_address;
     VAR status: ost$status);

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

    status.normal := TRUE;
    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$r2_increase_fau_count.', status);
      RETURN; {----->
    IFEND;

    p_dfd := dmf$disk_file_descriptor_p (p_fde);
    dmp$create_fau_entry (p_dfd, byte_address, number_faus_needed * p_dfd^.bytes_per_allocation);

  PROCEND dmp$r2_increase_fau_count;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$DEALLOCATE_FILE_SPACE_R1', EJECT ??

  PROCEDURE [XDCL] dmp$deallocate_file_space_r1
    (    system_file_id: gft$system_file_identifier;
         release_byte_address: amt$file_byte_address;
         bytes_to_release: integer;
         p_fde: gft$file_desc_entry_p;
     VAR status: ost$status);

    VAR
      dmv$mau_release_failure: [XREF] boolean,
      dmv$failing_mau: [XREF] dmt$dau_address,
      dmv$failing_mau_count: [XREF] integer;

    VAR
      able_to_release_faus: boolean,
      bytes_per_allocation: amt$file_byte_address,
      fmd_count: dmt$fmd_index,
      fau_index: dmt$fau_entries,
      ignore_status: ost$status,
      local_file: boolean,
      log_entry: dmt$dl_entry,
      level_1_index: dmt$level_1_index,
      level_1_start: dmt$level_1_index,
      level_2_index: dmt$level_2_index,
      level_2_start: dmt$level_2_index,
      monitor_request_block: dmt$monitor_rb_deallocate_space,
      number_of_faus: dmt$fau_entries,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fau_entry: ^dmt$file_allocation_unit,
      p_fmd: ^dmt$file_medium_descriptor,
      p_level_2: ^dmt$level_2_table,
      p_previous_fau_entry: ^dmt$file_allocation_unit,
      space_released: boolean,
      temp_bytes_to_release: integer,
      temp_release_address: amt$file_byte_address;

    status.normal := TRUE;
    p_dfd := dmf$disk_file_descriptor_p (p_fde);

    bytes_per_allocation := p_dfd^.bytes_per_allocation;
    {Round up to next AU
    temp_release_address := ((release_byte_address + bytes_per_allocation - 1) DIV bytes_per_allocation) *
          bytes_per_allocation;
    {Round down to next AU
    temp_bytes_to_release := bytes_to_release - (temp_release_address - release_byte_address);
    temp_bytes_to_release := temp_bytes_to_release DIV bytes_per_allocation * bytes_per_allocation;
    IF temp_bytes_to_release < 0 THEN
      RETURN; {----->
    IFEND;

    local_file := system_file_id.residence = gfc$tr_job;

    IF local_file THEN
      monitor_request_block.request_code := syc$rc_deallocate_front_end;
      monitor_request_block.system_file_id := system_file_id;
      monitor_request_block.status.normal := TRUE;
      monitor_request_block.monitor_request := dmc$deallocate_space;
      monitor_request_block.release_byte_address := temp_release_address;
      monitor_request_block.bytes_to_release := temp_bytes_to_release;
      monitor_request_block.able_to_release_all_space := TRUE;
      i#call_monitor (#LOC (monitor_request_block), #SIZE (monitor_request_block));

    ELSE {Not a local file - issue trim function

      {Must issue a trim file for each fmd
      {Can have partial or complete allocation in each fmd
      {Note that trim releases space to end of fmd (not sparse deallocate)

      space_released := FALSE;
      FOR fmd_count := 1 TO p_dfd^.number_of_fmds DO
        {p_fau_entry is the first fau to free
        dmp$get_fau_entry_and_fmd (p_dfd, temp_release_address, p_fau_entry, p_fmd);
        IF (p_fau_entry = NIL) OR (p_fmd = NIL) OR (p_fau_entry^.fmd_index <> fmd_count) THEN
          {If temp_release_address does not point to an AU belonging to this fmd
          {  get the next higher (byte address) AU for this fmd
          dmp$get_next_fmd_fau (p_dfd, temp_release_address, fmd_count, p_fau_entry);
        IFEND;

        IF (p_fau_entry <> NIL) AND (p_fau_entry^.state <> dmc$fau_free) THEN
          {p_previous_fau is the new last fau for the fmd
          dmp$get_previous_fau_entry (p_dfd, temp_release_address, fmd_count, p_previous_fau_entry);
          IF (p_previous_fau_entry <> NIL) AND (p_previous_fau_entry^.state <> dmc$fau_free) THEN
            {Fmd partial trim - see else below
            dmp$get_fmd_by_index (p_dfd, fmd_count, p_fmd);
            monitor_request_block.request_code := syc$rc_deallocate_front_end;
            monitor_request_block.system_file_id := system_file_id;
            monitor_request_block.status.normal := TRUE;
            monitor_request_block.monitor_request := dmc$trim_file_space;
            monitor_request_block.avt_index := p_fmd^.avt_index;
            monitor_request_block.global_file_name := p_fde^.global_file_name;
            monitor_request_block.dfl_index := p_fmd^.dfl_index;
            monitor_request_block.dau_address := p_previous_fau_entry^.dau_address;
            monitor_request_block.dau_of_fragment := p_fau_entry^.dau_address;
            REPEAT
              i#call_monitor (#LOC (monitor_request_block), #SIZE (monitor_request_block));
              IF NOT monitor_request_block.status.normal THEN { allocation log was full, cycle and try again
                pmp$cycle (ignore_status);
              IFEND;
            UNTIL status.normal;

          ELSE
            {Want to trim entire fmd (fmd allocated length will be zero)
            {Rely on caller to purge fmd
            {This code currently only invoked by trim
          IFEND;
          space_released := TRUE;
        ELSE
          {Nothing to trim at temp_release_address or above for this fmd
        IFEND;
      FOREND;

      {Update file allocation table to reflect trim

      IF space_released THEN
        p_dfd^.dfd_modified := TRUE;
        level_1_start := temp_release_address DIV p_dfd^.bytes_per_level_2;
        level_2_start := temp_release_address MOD p_dfd^.bytes_per_level_2 DIV bytes_per_allocation;
        IF p_dfd^.file_allocation_table <> NIL THEN
          FOR level_1_index := level_1_start TO p_dfd^.fat_upper_bound DO
            p_level_2 := dmf$level_2_ptr (^p_dfd^.file_allocation_table^ [level_1_index]);
            IF p_level_2 <> NIL THEN
              FOR level_2_index := level_2_start TO (p_dfd^.bytes_per_level_2 DIV bytes_per_allocation - 1) DO
                IF p_level_2^ [level_2_index].state <> dmc$fau_free THEN
                  dmp$get_fmd_by_index (p_dfd, p_level_2^ [level_2_index].fmd_index, p_fmd);
                  p_level_2^ [level_2_index].state := dmc$fau_free;
                  p_fmd^.fmd_allocated_length := p_fmd^.fmd_allocated_length - p_dfd^.bytes_per_allocation;
                IFEND;
              FOREND;
            IFEND;
            level_2_start := 0;
          FOREND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND dmp$deallocate_file_space_r1;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$RESERVE_FMD', EJECT ??

  PROCEDURE [XDCL] dmp$reserve_fmd
    (    p_dfd: ^dmt$disk_file_descriptor;
     VAR fmd_index: dmt$fmd_index;
     VAR able_to_reserve_fmd: boolean);

    VAR
      number_of_fmds: dmt$fmd_index,
      p_fmd: ^dmt$file_medium_descriptor;

    able_to_reserve_fmd := FALSE;

    number_of_fmds := 0;
    IF p_dfd <> NIL THEN
      number_of_fmds := p_dfd^.number_of_fmds;
    IFEND;

    FOR fmd_index := 1 TO number_of_fmds DO
      dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
      IF (p_fmd <> NIL) AND (NOT p_fmd^.in_use) THEN
        p_fmd^.in_use := TRUE;
        able_to_reserve_fmd := TRUE;
        RETURN; {----->
      IFEND;
    FOREND;

  PROCEND dmp$reserve_fmd;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DMP$STORE_EXISTING_DF_FAT', EJECT ??

  PROCEDURE [XDCL] dmp$store_existing_df_fat
    (    system_file_id: gft$system_file_identifier;
         p_existing_fat: ^dmt$stored_ms_device_file_fat;
     VAR status: ost$status);

    VAR
      bytes_per_allocation: amt$file_byte_address,
      byte_address: amt$file_byte_address,
      existing_fau_index: dmt$fau_entries,
      fau_index: dmt$fau_entries,
      number_fau_entries: dmt$fau_entries,
      p_fmd: ^dmt$file_medium_descriptor,
      p_fau_entry: ^dmt$file_allocation_unit,
      p_fde: gft$file_desc_entry_p,
      p_dfd: ^dmt$disk_file_descriptor;

    status.normal := TRUE;

    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 file residence or file index.', status);
      RETURN; {----->
    IFEND;

    p_dfd := dmf$disk_file_descriptor_p (p_fde);

    {Only 1 fmd for device files
    dmp$get_fmd_by_index (p_dfd, 1, p_fmd);

    number_fau_entries := p_existing_fat^.header.number_faus;

    p_fmd^.allocation_style := p_existing_fat^.header.allocation_style;
    p_fmd^.bytes_per_mau := p_existing_fat^.header.bytes_per_mau;
    p_fmd^.daus_per_allocation_unit := p_existing_fat^.header.daus_per_allocation_unit;
    p_fmd^.daus_per_cylinder := p_existing_fat^.header.daus_per_cylinder;
    p_fmd^.maus_per_dau := p_existing_fat^.header.maus_per_dau;
    p_fmd^.maus_per_transfer_unit := p_existing_fat^.header.maus_per_transfer_unit;
    p_fmd^.system_file_id := system_file_id;

    bytes_per_allocation := p_fmd^.daus_per_allocation_unit * p_fmd^.maus_per_dau * p_fmd^.bytes_per_mau;
    p_dfd^.bytes_per_allocation := bytes_per_allocation;
    p_fde^.allocation_unit_size := bytes_per_allocation;
    p_dfd^.current_fmd_index := 1;
    IF (dmc$bytes_per_level_2 MOD p_dfd^.bytes_per_allocation) <> 0 THEN
      {Round up to next allocation unit
      p_dfd^.bytes_per_level_2 := (dmc$bytes_per_level_2 + p_dfd^.bytes_per_allocation - 1) DIV
            p_dfd^.bytes_per_allocation * p_dfd^.bytes_per_allocation;
    ELSE
      p_dfd^.bytes_per_level_2 := dmc$bytes_per_level_2;
    IFEND;

    dmp$create_fau_entry (p_dfd, 0, bytes_per_allocation * number_fau_entries);

    existing_fau_index := LOWERBOUND (p_existing_fat^.file_allocation_units);

    {Assume sequential allocation
    byte_address := 0;
    FOR fau_index := 1 TO number_fau_entries DO
      dmp$get_fau_entry (p_dfd, byte_address, p_fau_entry);
      p_fau_entry^.dau_address := p_existing_fat^.file_allocation_units [existing_fau_index].dau_address;
      p_fau_entry^.state := p_existing_fat^.file_allocation_units [existing_fau_index].state;
      p_fau_entry^.fmd_index := 1;
      existing_fau_index := existing_fau_index + 1;
      byte_address := byte_address + bytes_per_allocation;
    FOREND;
    p_dfd^.highest_offset_allocated := byte_address;
    p_fmd^.fmd_allocated_length := byte_address;
    p_fmd^.volume_assigned := TRUE;

  PROCEND dmp$store_existing_df_fat;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] DMP$STORE_VALID_CLASS_IN_FMD', EJECT ??

  PROCEDURE [XDCL, #GATE] dmp$store_valid_class_in_fmd
    (    system_file_id: gft$system_file_identifier;
         class: dmt$class_member;
     VAR status: ost$status);

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

    status.normal := TRUE;
    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$store_valid_class_in_fmd.', status);
      RETURN; {----->
    IFEND;

    p_dfd := dmf$disk_file_descriptor_p (p_fde);
    IF p_dfd = NIL THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_not_created_for_file,
            'No DFD for file - dmp$store_valid_class_in_fmd.', status);
    ELSE
      p_dfd^.requested_class := class;
    IFEND;

    gfp$unlock_fde_p (p_fde);

  PROCEND dmp$store_valid_class_in_fmd;
?? OLDTITLE ??
MODEND dmm$fmd_manager;

