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

{ PURPOSE:
{   This module is responsible for allocating backing store to a segment.
{
{ DESIGN:
{   Available space from the volume is maintained in the mainframe
{   allocation table and is assigned, as necessary, to NOS/VE segments.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$mainframe_wired
*copyc oss$mainframe_wired_literal
*copyc rmd$volume_declarations
*copyc amt$file_byte_address
*copyc dmt$active_volume_table
*copyc dmt$allocation_log
*copyc dmt$allocation_size
*copyc dmt$assigned_ms_vol_attributes
*copyc dmt$device_allocation_unit
*copyc dmt$device_position
*copyc dmt$error_condition_codes
*copyc dmt$file_allocation_descriptor
*copyc dmt$file_allocation_status
*copyc dmt$file_descriptor_entry
*copyc dmt$internal_vsn
*copyc dmt$mainframe_allocation_table
*copyc dmt$mat_change_list
*copyc dmt$mat_change_request
*copyc dmt$monitor_request_blocks
*copyc gft$locked_file_desc_entry_p
*copyc jmt$ijl_ordinal
*copyc pmt$processor_serial_number
*copyc syt$monitor_request_code
*copyc tmt$task_status
?? POP ??
*copyc fip#addl_initialize
*copyc fip#addl_string

*copyc dmp$get_active_vol_attributes
*copyc dmp$get_disk_file_descriptor_p
*copyc dmf$disk_file_descriptor_p
*copyc dmf$level_2_ptr
*copyc dmp$get_fau_entry
*copyc dmp$get_fmd_by_index
*copyc dmp$get_level_1_ptr
*copyc dmp$get_mat_pointer
*copyc dmp$get_next_fmd_fau
*copyc dmp$get_previous_fau_entry
*copyc dpp$convert_int_to_str_hex
*copyc dpp$display_error
*copyc mmp$modify_pages
*copyc mtp$error_stop
*copyc mtp$set_status_abnormal
*copyc osp$fetch_locked_variable
*copyc osp$increment_locked_variable
*copyc sfp$mtr_accumulate_file_space
*copyc tmp$monitor_ready_system_task
*copyc dmv$active_volume_table
*copyc dmv$null_vsn
*copyc sfv$dynamic_file_space_limits
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

  TYPE
    dmt$dau_release_failure = record
      case mau_release_failure: boolean of
      = FALSE =
        ,
      = TRUE =
        avt_index: dmt$active_volume_table_index,
        failing_mau_count: integer,
        first_failing_mau: dmt$dau_address,
        last_failing_mau: dmt$dau_address,
      casend,
    recend;

  VAR
    dmv$default_fau_entry: [XDCL, #GATE, STATIC, READ, oss$mainframe_wired_literal]
          dmt$file_allocation_unit :=
{DAU_ADDRESS  } [0,
{STATE        } dmc$fau_free,
{FAD_INDEX    } 0];


  VAR
    dmv$permanent_file_overflow: [XDCL, #GATE, STATIC, oss$mainframe_wired] boolean := TRUE,
    dmv$temporary_file_overflow: [XDCL, #GATE, STATIC, oss$mainframe_wired] boolean := TRUE;

  VAR
    dmv$allocation_log: [XDCL, STATIC, #GATE, oss$mainframe_wired] dmt$allocation_log_info,

    dmv$split_al_initiated: [XDCL, STATIC, #GATE, oss$mainframe_wired] boolean := FALSE,

    dmv$administer_log_initiated: [XDCL, STATIC, #GATE, oss$mainframe_wired] boolean := FALSE,

    dmv$vol_space_manage_initiated: [XDCL, STATIC, #GATE, oss$mainframe_wired] boolean := FALSE;

  VAR
    dmv$volume_selector: [XDCL, STATIC, #GATE, oss$mainframe_wired] integer := 0;

  VAR
    dmv$pf_sparse: [XDCL, #GATE] boolean := FALSE;

  VAR
    dmv$require_cylinders: [XDCL, #GATE] boolean := TRUE;

  VAR
    dmv$mat_change_count_max: [XDCL, #GATE, oss$mainframe_wired] integer := 64, {1000,
    dmv$mat_change_list: [XDCL, #GATE, oss$mainframe_wired] dmt$mat_change_list := [
{ LOCK               } [0],
{ LIST_SIZE_USED_MAX } 0, { Statistic value, may be removed in the future
{ VALUES             } [REP dmc$mat_change_count_in_use_max of [dmc$acyl, 0]]];

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

{Is it worth to put this into the monitor code? Or do we never see this error anyway?
{There must have been a problem. Otherwise there would not have been the PSR NV10114!

  PROCEDURE p$issue_dau_release_failure_msg
    (    dau_release_failure: dmt$dau_release_failure;
         p_fde: gft$locked_file_desc_entry_p);

    VAR
      name: ost$name,
      str: ost$string;

?? NEWTITLE := 'P$CONVERT_BINARY_UNIQUE_NAME', EJECT ??

{This is a copy from PMM$GET_UNIQUE_NAME

    PROCEDURE p$convert_binary_unique_name
      (    binary_name: ost$binary_unique_name;
       VAR name: ost$name);

      TYPE
        pmt_unique_name = record
          case boolean of
          = TRUE =
            value: ost$name,
          = FALSE =
            dollar_sign: string (1),
            sequence_number: string (7),
            processor_model_number: string (2),
            s: string (1),
            processor_serial_number: string (pmc$processor_serial_num_size),
            d: string (1),
            year: string (4),
            month: string (2),
            day: string (2),
            t: string (1),
            hour: string (2),
            minute: string (2),
            second: string (2),
          casend,
        recend,

        pmt_conversion_mask = record
          case boolean of
          = TRUE =
            integer_value: ost$processor_serial_number,
          = FALSE =
            bcd_value: packed array [1 .. pmc$processor_serial_num_size] of 0 .. 0f(16),
          casend,
        recend;

      VAR
        digits: [STATIC, READ, oss$mainframe_wired_literal] array [0 .. 15] of char := ['0', '1', '2', '3',
              '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'];

      VAR
        converter: pmt_conversion_mask,
        generated_name: pmt_unique_name,
        index: ost$string_index,
        number: integer;

      generated_name.dollar_sign := '$';

      number := binary_name.sequence_number;
      FOR index := STRLENGTH (generated_name.sequence_number) DOWNTO 1 DO
        generated_name.sequence_number (index) := digits [number MOD 10];
        number := number DIV 10;
      FOREND;

      generated_name.processor_model_number (1) := digits [binary_name.model_number DIV 16];
      generated_name.processor_model_number (2) := digits [binary_name.model_number MOD 16];

      generated_name.s := 'S';

      converter.integer_value := binary_name.serial_number;
      FOR index := 1 TO pmc$processor_serial_num_size DO
        generated_name.processor_serial_number (index) := digits [converter.bcd_value [index]];
      FOREND;

      generated_name.d := 'D';

      number := binary_name.year;
      FOR index := STRLENGTH (generated_name.year) DOWNTO 1 DO
        generated_name.year (index) := digits [number MOD 10];
        number := number DIV 10;
      FOREND;

      generated_name.month (1) := digits [binary_name.month DIV 10];
      generated_name.month (2) := digits [binary_name.month MOD 10];

      generated_name.day (1) := digits [binary_name.day DIV 10];
      generated_name.day (2) := digits [binary_name.day MOD 10];

      generated_name.t := 'T';

      generated_name.hour (1) := digits [binary_name.hour DIV 10];
      generated_name.hour (2) := digits [binary_name.hour MOD 10];

      generated_name.minute (1) := digits [binary_name.minute DIV 10];
      generated_name.minute (2) := digits [binary_name.minute MOD 10];

      generated_name.second (1) := digits [binary_name.second DIV 10];
      generated_name.second (2) := digits [binary_name.second MOD 10];

      name := generated_name.value;

    PROCEND p$convert_binary_unique_name;
?? OLDTITLE ??
?? EJECT ??

    IF p_fde = NIL THEN
      fip#addl_initialize (str, 'Add MAT Space Error: Count= ');
      dpp$convert_int_to_str_hex (8, dau_release_failure.failing_mau_count, str.value (str.size + 1, 8));
      str.size := str.size + 8;
      fip#addl_string (str, '(16), VSN=');
      fip#addl_string (str, dmv$active_volume_table.table_p^ [dau_release_failure.avt_index].mass_storage.
            recorded_vsn);
    ELSE
      fip#addl_initialize (str, 'Allocation Unit Release Error: Count= ');
      dpp$convert_int_to_str_hex (8, dau_release_failure.failing_mau_count, str.value (str.size + 1, 8));
      str.size := str.size + 8;
      fip#addl_string (str, '(16), VSN=');
      fip#addl_string (str, dmv$active_volume_table.table_p^ [dau_release_failure.avt_index].mass_storage.
            recorded_vsn);
      dpp$display_error (str.value (1, str.size));

      p$convert_binary_unique_name (p_fde^.global_file_name, name);
      fip#addl_initialize (str, ' Data-Name: ');
      fip#addl_string (str, name);
    IFEND;
    dpp$display_error (str.value (1, str.size));

    fip#addl_initialize (str, '   First AU= ');
    dpp$convert_int_to_str_hex (8, dau_release_failure.first_failing_mau, str.value (str.size + 1, 8));
    str.size := str.size + 8;
    fip#addl_string (str, '(16)');

    fip#addl_string (str, ' Last AU= ');
    dpp$convert_int_to_str_hex (8, dau_release_failure.last_failing_mau, str.value (str.size + 1, 8));
    str.size := str.size + 8;
    fip#addl_string (str, '(16)');
    dpp$display_error (str.value (1, str.size));

  PROCEND p$issue_dau_release_failure_msg;
?? OLDTITLE ??
?? NEWTITLE := '  dmp$allocate_file_space', EJECT ??
*copy dmh$allocate_file_space

  PROCEDURE [XDCL] dmp$allocate_file_space
    (    p_fde: gft$locked_file_desc_entry_p;
         initial_byte_address: amt$file_byte_address;
         bytes_to_allocate: amt$file_byte_address;
         file_space_limit: sft$file_space_limit_kind;
     VAR allocation_units_obtained: amt$file_byte_address;
     VAR overflow: boolean;
     VAR file_allocation_status: dmt$file_allocation_status);

    VAR
      allocate_byte_address: amt$file_byte_address,
      end_of_allocation: amt$file_byte_address,
      p_dfd: ^dmt$disk_file_descriptor,
      p_previous_fau_entry: ^dmt$file_allocation_unit,
      able_to_log: boolean,
      allocation_allowed: boolean,
      allocation_style: dmt$allocation_styles,
      allocation_unit_found: boolean,
      al_entry: dmt$al_entry,
      avt_index: dmt$active_volume_table_index,
      bytes_per_allocation: dmt$bytes_per_allocation,
      bytes_per_position: dmt$bytes_per_allocation,
      current_fmd_index: dmt$fmd_index,
      dat_empty: boolean,
      dau_address: dmt$dau_address,
      dau_release_failure: dmt$dau_release_failure,
      daus_per_allocation_unit: dmt$daus_per_position,
      file_kind: gft$file_kind,
      incomplete_allocation: boolean,
      logging_required_for_file_type: boolean,
      p_existing_fmd: ^dmt$file_medium_descriptor,
      p_mat: ^dmt$mainframe_allocation_table,
      p_fau_entry: ^dmt$file_allocation_unit,
      previous_dau_address: dmt$dau_address,
      space_limit_exceeded: boolean;

    overflow := FALSE;
    dau_release_failure.mau_release_failure := FALSE;
    allocation_units_obtained := 0;
    allocate_byte_address := initial_byte_address;
    end_of_allocation := allocate_byte_address + bytes_to_allocate;
    file_allocation_status := dmc$fas_file_allocated;

    p_dfd := dmf$disk_file_descriptor_p (p_fde);
    current_fmd_index := p_dfd^.current_fmd_index;
    dmp$get_fmd_by_index (p_dfd, current_fmd_index, p_existing_fmd);
    IF NOT p_existing_fmd^.volume_assigned THEN
      file_allocation_status := dmc$fas_job_mode_work_required;
      RETURN; {----->
    IFEND;

    file_kind := p_fde^.file_kind;
    avt_index := p_existing_fmd^.avt_index;
    logging_required_for_file_type := (file_kind <= gfc$fk_last_permanent_file);

    allocation_allowed := dmv$active_volume_table.table_p^ [avt_index].mass_storage.allocation_allowed AND
          NOT dmv$active_volume_table.table_p^ [avt_index].mass_storage.volume_unavailable;

    IF NOT allocation_allowed THEN
      file_allocation_status := dmc$fas_job_mode_work_required;
      overflow := TRUE;
      RETURN; {----->
    IFEND;

    dmp$get_mat_pointer (avt_index, p_mat);

    allocation_style := p_existing_fmd^.allocation_style;
    daus_per_allocation_unit := p_mat^.daus_per_allocation_unit [allocation_style];
    bytes_per_allocation := p_mat^.bytes_per_dau * daus_per_allocation_unit;
    allocate_byte_address := allocate_byte_address DIV bytes_per_allocation * bytes_per_allocation;

    IF initial_byte_address > p_dfd^.highest_offset_allocated THEN
      IF (p_fde^.file_kind <= gfc$fk_last_permanent_file) AND (NOT dmv$pf_sparse) THEN
        allocate_byte_address := p_dfd^.highest_offset_allocated;
      IFEND;
    IFEND;

{ allocate space
    allocation_unit_found := TRUE; {allocation_allowed is always TRUE, here.
    able_to_log := TRUE;
    al_entry.kind := dmc$al_allocate;
    al_entry.avt_index := avt_index;
    al_entry.allocate_block.global_file_name := p_fde^.global_file_name;
    al_entry.allocate_block.dfl_index := p_existing_fmd^.dfl_index;
    al_entry.allocate_block.daus_per_allocation := daus_per_allocation_unit;


    IF p_dfd^.requested_allocation_size > p_dfd^.bytes_per_allocation THEN
      {Assume cylinder allocation
      {Get as many allocation units of the correct style as needed/possible
      {May run out of table space in the middle
      {Desire is that they will reside on the same cylinder
      bytes_per_position := (p_mat^.daus_per_position * p_mat^.bytes_per_dau) DIV bytes_per_allocation *
            bytes_per_allocation;
      allocate_byte_address := allocate_byte_address DIV bytes_per_position * bytes_per_position;
    IFEND;

  /allocate_space/
    WHILE (allocate_byte_address < end_of_allocation) AND allocation_unit_found AND able_to_log DO
      dmp$get_fau_entry (p_dfd, allocate_byte_address, p_fau_entry);
      IF p_fau_entry = NIL THEN
        {Ran out of table space in the middle!
        file_allocation_status := dmc$fas_job_mode_work_required;
        EXIT /allocate_space/; {----->
      IFEND;
      IF p_fau_entry^.state <> dmc$fau_free THEN
        allocate_byte_address := allocate_byte_address + bytes_per_allocation;
        CYCLE /allocate_space/; {----->
      IFEND;
      {The following must be inside the loop to find the previous dau for sparse allocates
      dmp$get_previous_fau_entry (p_dfd, allocate_byte_address, current_fmd_index, p_previous_fau_entry);
      IF p_previous_fau_entry <> NIL THEN
        previous_dau_address := p_previous_fau_entry^.dau_address;
      ELSE
        previous_dau_address := 0;
      IFEND;

      assign_allocation_unit (p_mat, allocation_style, previous_dau_address, dau_address,
            allocation_unit_found);
      IF allocation_unit_found THEN
        IF logging_required_for_file_type THEN
          al_entry.allocate_block.dau_address := dau_address;
          IF (previous_dau_address = 0) THEN
            al_entry.allocate_block.allocate_flags := dmc$dl_first_allocation;
          ELSE
            al_entry.allocate_block.allocate_flags := dmc$dl_continued_allocation;
          IFEND;
          al_entry.allocate_block.previous_dau_address := previous_dau_address;
          dmp$mtr_log (al_entry, able_to_log);
          IF NOT able_to_log THEN
            release_allocation_unit (p_mat, allocation_style, dau_address, dau_release_failure);
            EXIT /allocate_space/; {----->
          IFEND;
        IFEND;
        p_fau_entry^.dau_address := dau_address;
        p_fau_entry^.state := dmc$fau_invalid_data;
        allocation_units_obtained := allocation_units_obtained + 1;
        p_dfd^.dfd_modified := TRUE;
        p_fau_entry^.fmd_index := current_fmd_index;
        allocate_byte_address := allocate_byte_address + bytes_per_allocation;
      IFEND;
    WHILEND /allocate_space/;

    IF dau_release_failure.mau_release_failure THEN
      p$issue_dau_release_failure_msg (dau_release_failure, p_fde);
    IFEND;

{ Support for Dynamic File Space Limits
    IF sfv$dynamic_file_space_limits AND (file_space_limit <> sfc$no_limit) THEN
      sfp$mtr_accumulate_file_space (file_space_limit, allocation_units_obtained * bytes_per_allocation,
            space_limit_exceeded);
      IF space_limit_exceeded THEN
        file_allocation_status := dmc$fas_account_limit_exceeded;
      IFEND;
    IFEND;

    { Update fmd allocated length

    p_existing_fmd^.fmd_allocated_length := p_existing_fmd^.fmd_allocated_length + allocation_units_obtained *
          bytes_per_allocation;

    { Update dfd highest_offset_allocated
    {Note: Used for sequential allocation only

{
{  IS THIS RIGHT?   DID WE POSSIBLY NOT ALLOCATE ANY SPACE?
{
    IF allocate_byte_address > p_dfd^.highest_offset_allocated THEN
      p_dfd^.highest_offset_allocated := allocate_byte_address;
    IFEND;

    p_mat^.allocated_space [file_kind] := (p_mat^.allocated_space [file_kind] +
          (daus_per_allocation_unit * allocation_units_obtained)) MOD (dmc$max_dau_address + 1);

    incomplete_allocation := (allocate_byte_address < end_of_allocation);

    IF incomplete_allocation AND (file_allocation_status = dmc$fas_file_allocated) THEN

      dat_empty := p_mat^.available_dat_space <= p_mat^.dat_threshold;
      overflow := dat_empty AND able_to_log;

      IF overflow THEN
        file_allocation_status := dmc$fas_job_mode_work_required;
      ELSE
        file_allocation_status := dmc$fas_temp_reject;
      IFEND;

    IFEND;

    update_volume_status (p_mat);

  PROCEND dmp$allocate_file_space;
?? TITLE := '  dmp$apply_mat_changes', EJECT ??

  PROCEDURE [XDCL] dmp$apply_mat_changes
    (VAR mat_change_request: dmt$mat_change_request);

    VAR
      p_mat: ^dmt$mainframe_allocation_table,
      p_mat_changes: ^dmt$mat_changes,
      mat_change_type: dmt$mat_change_type,
      mat_change_count: dmt$mat_change_count;

    dmp$get_mat_pointer (mat_change_request.avt_index, p_mat);
    mat_change_type := mat_change_request.mat_change_type;

    CASE mat_change_type OF

    = dmc$change_dat_threshold =
      p_mat^.dat_threshold := mat_change_request.dat_threshold DIV p_mat^.daus_per_position *
            p_mat^.daus_per_position;

    = dmc$add_mat_space, dmc$remove_mat_space =
      p_mat_changes := mat_change_request.p_mat_changes;
      p_mat^.available_dat_space := mat_change_request.available_dat_space;

      IF (mat_change_type = dmc$add_mat_space) THEN
        mat_change_count := mat_change_request.mat_change_count;
        add_mat_space (p_mat, p_mat_changes, mat_change_count);
      ELSE
        remove_mat_space (p_mat, p_mat_changes, mat_change_count);
        mat_change_request.mat_change_count := mat_change_count;
      IFEND;
    ELSE
      mtp$error_stop ('Invalid MAT change type.');
    CASEND;

    update_volume_status (p_mat);
  PROCEND dmp$apply_mat_changes;
?? TITLE := '  dmp$deallocate_file_space', EJECT ??
*copy dmh$deallocate_file_space

  PROCEDURE [XDCL] dmp$deallocate_file_space
    (    p_fde: gft$locked_file_desc_entry_p;
         initial_release_byte_address: amt$file_byte_address;
         initial_bytes_to_release: integer);

    VAR
      avt_index: dmt$active_volume_table_index,
      bytes_per_allocation: dmt$bytes_per_allocation,
      bytes_per_level_2: amt$file_byte_address,
      bytes_to_release: integer,
      dau_release_failure: dmt$dau_release_failure,
      final_release_address: amt$file_byte_address,
      fmd_index: dmt$fmd_index,
      level_1_end: dmt$level_1_index,
      level_1_index: dmt$level_1_index,
      level_1_start: dmt$level_1_index,
      level_2_end: dmt$level_2_index,
      level_2_index: dmt$level_2_index,
      level_2_start: dmt$level_2_index,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fmd: ^dmt$file_medium_descriptor,
      p_level_1: ^dmt$level_1_table,
      p_level_2: ^dmt$level_2_table,
      p_mat: ^dmt$mainframe_allocation_table,
      release_byte_address: amt$file_byte_address;

    dau_release_failure.mau_release_failure := FALSE;
    p_dfd := dmf$disk_file_descriptor_p (p_fde);
    bytes_per_allocation := p_dfd^.bytes_per_allocation;
    bytes_per_level_2 := p_dfd^.bytes_per_level_2;

    {Round up to next AU
    release_byte_address := ((initial_release_byte_address + bytes_per_allocation - 1) DIV
          bytes_per_allocation) * bytes_per_allocation;

    {Round down to next AU
    bytes_to_release := initial_bytes_to_release - (release_byte_address - initial_release_byte_address);
    bytes_to_release := bytes_to_release DIV bytes_per_allocation * bytes_per_allocation;
    IF bytes_to_release <= 0 THEN
      RETURN; {----->
    IFEND;

    final_release_address := release_byte_address + bytes_to_release - 1;
    IF (final_release_address >= p_dfd^.highest_offset_allocated) THEN
      final_release_address := p_dfd^.highest_offset_allocated - 1;
    IFEND;

    level_1_start := release_byte_address DIV bytes_per_level_2;
    level_1_end := final_release_address DIV bytes_per_level_2;

    level_2_start := release_byte_address MOD bytes_per_level_2 DIV bytes_per_allocation;
    level_2_end := bytes_per_level_2 DIV bytes_per_allocation - 1;

    fmd_index := 0;
    p_mat := NIL;

    dmp$get_level_1_ptr (p_dfd, p_level_1);
    IF p_level_1 <> NIL THEN
      FOR level_1_index := level_1_start TO level_1_end DO
        IF (level_1_index = level_1_end) THEN
          level_2_end := final_release_address MOD bytes_per_level_2 DIV bytes_per_allocation;
        IFEND;

        p_level_2 := dmf$level_2_ptr (^p_level_1^ [level_1_index]);
        IF p_level_2 <> NIL THEN
          FOR level_2_index := level_2_start TO level_2_end DO
            IF (p_level_2^ [level_2_index].state <> dmc$fau_free) THEN
              IF p_level_2^ [level_2_index].fmd_index <> fmd_index THEN
                IF p_mat <> NIL THEN
                  update_volume_status (p_mat);
                IFEND;
                fmd_index := p_level_2^ [level_2_index].fmd_index;
                dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);
                avt_index := p_fmd^.avt_index;
                dmp$get_mat_pointer (avt_index, p_mat);
              IFEND;
              release_allocation_unit (p_mat, p_fmd^.allocation_style, p_level_2^ [level_2_index].dau_address,
                    dau_release_failure);
              p_level_2^ [level_2_index].state := dmc$fau_free;
              p_fmd^.fmd_allocated_length := p_fmd^.fmd_allocated_length - bytes_per_allocation;
            IFEND;
          FOREND;
        IFEND;
        level_2_start := 0;
      FOREND;

      IF dau_release_failure.mau_release_failure THEN
        p$issue_dau_release_failure_msg (dau_release_failure, p_fde);
      IFEND;

      p_dfd^.dfd_modified := TRUE;
      IF p_mat <> NIL THEN
        update_volume_status (p_mat);
      IFEND;
    IFEND;

    {Note: p_dfd^.highest_offset_allocated no longer correct!
    {Depend on dmp$trim_file to correct it.

  PROCEND dmp$deallocate_file_space;
?? TITLE := '  [XDCL] dmp$mtr_log', EJECT ??

  PROCEDURE [XDCL] dmp$mtr_log
    (    entry: dmt$al_entry;
     VAR able_to_log: boolean);

    VAR
      current_value: integer,
      final_value: integer,
      local_status: syt$monitor_status;

    able_to_log := TRUE;

    osp$fetch_locked_variable (dmv$allocation_log.number, current_value);

    IF (current_value = dmc$max_allocation_log_entries)
{ } OR ((entry.kind = dmc$al_allocate) AND (current_value >= dmc$al_reject_alloc_threshold)) THEN
      able_to_log := FALSE;
      RETURN; {----->
    IFEND;

    CASE entry.kind OF
    = dmc$al_allocate, dmc$al_initialize, dmc$al_return_dau, dmc$al_software_flawed, dmc$al_reallocate,
          dmc$al_trim_file =
      dmv$allocation_log.entries [dmv$allocation_log.last] := entry;
      dmv$allocation_log.last := (dmv$allocation_log.last + 1) MOD dmc$max_allocation_log_entries;

      osp$increment_locked_variable (dmv$allocation_log.number, current_value, final_value);

      IF (final_value >= dmc$al_trigger_update_threshold) AND dmv$split_al_initiated THEN
        tmp$monitor_ready_system_task (tmc$stid_dm_split_al, local_status);
      IFEND;
    ELSE
      mtp$error_stop ('Invalid allocation log entry.');
    CASEND;

  PROCEND dmp$mtr_log;
?? TITLE := '  add_mat_space', EJECT ??

  PROCEDURE [INLINE] add_mat_space
    (    p_mat: ^dmt$mainframe_allocation_table;
         p_mat_changes: ^dmt$mat_changes;
         mat_change_count: dmt$mat_change_count);

    VAR
      allocation_style: dmt$allocation_styles,
      dau_address: dmt$dau_address,
      dau_release_failure: dmt$dau_release_failure,
      change_count: dmt$mat_change_count,
      change_index: dmt$mat_change_count;

    dau_release_failure.mau_release_failure := FALSE;
    change_count := mat_change_count;
    IF (p_mat_changes = NIL) THEN
      change_count := 0;
    ELSEIF change_count > dmv$mat_change_count_max THEN
      change_count := dmv$mat_change_count_max;
    IFEND;

    FOR change_index := 1 TO change_count DO
      allocation_style := p_mat_changes^ [change_index].style;
      dau_address := p_mat_changes^ [change_index].dau_address;
      release_allocation_unit (p_mat, allocation_style, dau_address, dau_release_failure);
    FOREND;

    IF dau_release_failure.mau_release_failure THEN
      p$issue_dau_release_failure_msg (dau_release_failure, NIL);
    IFEND;

  PROCEND add_mat_space;
?? TITLE := '  assign_allocation_unit', EJECT ??

  PROCEDURE assign_allocation_unit
    (    p_mat: ^dmt$mainframe_allocation_table;
         allocation_style: dmt$allocation_styles;
         previous_dau: dmt$dau_address;
     VAR assigned_dau: dmt$dau_address;
     VAR allocation_unit_found: boolean);

    VAR
      position: dmt$position_link,
      previous_position: dmt$device_position;

    previous_position := previous_dau DIV p_mat^.daus_per_position;

    allocation_unit_found := (p_mat^.mat_entries [previous_position].allocation_style = allocation_style) AND
          (p_mat^.mat_entries [previous_position].available_allocation_units > 0);

    IF allocation_unit_found THEN
      assign_from_position (p_mat, previous_position, assigned_dau);
    ELSE
      find_closest_position (p_mat, allocation_style, previous_position, position);
      allocation_unit_found := (position <> dmc$nil_position_link);
      IF allocation_unit_found THEN
        assign_from_position (p_mat, position, assigned_dau);
      ELSE
        create_allocation_style (p_mat, allocation_style, previous_position, position);
        allocation_unit_found := (position <> dmc$nil_position_link);
        IF allocation_unit_found THEN
          assign_from_position (p_mat, position, assigned_dau);
        IFEND;
      IFEND;
    IFEND;

  PROCEND assign_allocation_unit;
?? TITLE := '  assign_from_position', EJECT ??

  PROCEDURE assign_from_position
    (    p_mat: ^dmt$mainframe_allocation_table;
         position: dmt$device_position;
     VAR dau_address: dmt$dau_address);

    VAR
      allocation_style: dmt$allocation_styles,
      daus_per_position: dmt$daus_per_position,
      daus_per_allocation_unit: dmt$daus_per_position,
      p_position_entry: ^dmt$mat_entry,
      dau: dmt$dau_address,
      next_allocation_unit_dau: dmt$dau_address,
      next_position_dau: dmt$dau_address;

    daus_per_position := p_mat^.daus_per_position;
    p_position_entry := ^p_mat^.mat_entries [position];
    allocation_style := p_position_entry^.allocation_style;
    daus_per_allocation_unit := p_mat^.daus_per_allocation_unit [allocation_style];
    dau := position * daus_per_position;
    next_position_dau := dau + daus_per_position;

    REPEAT
      next_allocation_unit_dau := dau + daus_per_allocation_unit;
      IF p_mat^.p_available_daus^ [dau] THEN
        dau_address := dau;
        REPEAT
          dau := dau + 1;
        UNTIL (dau = next_allocation_unit_dau) OR NOT p_mat^.p_available_daus^ [dau];

        IF (dau = next_allocation_unit_dau) THEN
          FOR dau := dau_address TO (next_allocation_unit_dau - 1) DO
            p_mat^.p_available_daus^ [dau] := FALSE;
          FOREND;
          p_mat^.available_space := p_mat^.available_space - daus_per_allocation_unit;
          p_mat^.available_allocation_units [allocation_style] :=
                p_mat^.available_allocation_units [allocation_style] - 1;
          p_position_entry^.available_allocation_units := p_position_entry^.available_allocation_units - 1;
          IF (p_position_entry^.available_allocation_units = 0) THEN
            delink_position (p_mat, position);
          IFEND;

          RETURN; {----->

        IFEND;
      IFEND;
      dau := next_allocation_unit_dau;
    UNTIL (dau >= next_position_dau);

    mtp$error_stop ('Unable to assign from position.');

  PROCEND assign_from_position;
?? TITLE := '  create_allocation_style', EJECT ??

  PROCEDURE [INLINE] create_allocation_style
    (    p_mat: ^dmt$mainframe_allocation_table;
         allocation_style: dmt$allocation_styles;
         previous_position: dmt$device_position;
     VAR position: dmt$position_link);

    VAR
      leftover_space: dmt$dau_address,
      daus_per_position: dmt$daus_per_position,
      daus_per_allocation_unit: dmt$daus_per_position,
      allocation_units_per_position: dmt$daus_per_position;

    find_closest_position (p_mat, dmc$acyl, previous_position, position);

    IF (position <> dmc$nil_position_link) THEN
      p_mat^.available_allocation_units [dmc$acyl] := p_mat^.available_allocation_units [dmc$acyl] - 1;
      delink_position (p_mat, position);

      daus_per_position := p_mat^.daus_per_position;
      daus_per_allocation_unit := p_mat^.daus_per_allocation_unit [allocation_style];
      allocation_units_per_position := daus_per_position DIV daus_per_allocation_unit;

      leftover_space := daus_per_position MOD daus_per_allocation_unit;
      p_mat^.leftover_space := p_mat^.leftover_space + leftover_space;
      p_mat^.available_space := p_mat^.available_space - leftover_space;

      p_mat^.available_allocation_units [allocation_style] :=
            p_mat^.available_allocation_units [allocation_style] + allocation_units_per_position;
      p_mat^.mat_entries [position].allocation_style := allocation_style;
      p_mat^.mat_entries [position].available_allocation_units := allocation_units_per_position;
      link_position (p_mat, position);
    IFEND;

  PROCEND create_allocation_style;
?? TITLE := '  delink_position', EJECT ??

  PROCEDURE [INLINE] delink_position
    (    p_mat: ^dmt$mainframe_allocation_table;
         position: dmt$device_position);

    VAR
      allocation_style: dmt$allocation_styles,
      previous_position: dmt$position_link,
      next_position: dmt$position_link,
      p_position_entry: ^dmt$mat_entry;

    p_position_entry := ^p_mat^.mat_entries [position];
    allocation_style := p_position_entry^.allocation_style;
    next_position := p_position_entry^.forward_link;
    previous_position := p_position_entry^.backward_link;

    p_position_entry^.backward_link := dmc$nil_position_link;
    p_position_entry^.forward_link := dmc$nil_position_link;

    IF (previous_position = dmc$nil_position_link) THEN
      p_mat^.allocation_chains [allocation_style] := next_position;
    ELSE
      p_mat^.mat_entries [previous_position].forward_link := next_position;
    IFEND;

    IF (next_position <> dmc$nil_position_link) THEN
      p_mat^.mat_entries [next_position].backward_link := previous_position;
    IFEND;

  PROCEND delink_position;
?? TITLE := '  find_adjacent_positions', EJECT ??

  PROCEDURE [INLINE] find_adjacent_positions
    (    p_mat: ^dmt$mainframe_allocation_table;
         allocation_style: dmt$allocation_styles;
         position: dmt$device_position;
     VAR previous_position: dmt$position_link;
     VAR next_position: dmt$position_link);

    previous_position := dmc$nil_position_link;
    next_position := p_mat^.allocation_chains [allocation_style];

    WHILE (next_position <> dmc$nil_position_link) AND (next_position < position) DO
      previous_position := next_position;
      next_position := p_mat^.mat_entries [previous_position].forward_link;
    WHILEND;

  PROCEND find_adjacent_positions;
?? TITLE := '  find_closest_position', EJECT ??

  PROCEDURE [INLINE] find_closest_position
    (    p_mat: ^dmt$mainframe_allocation_table;
         allocation_style: dmt$allocation_styles;
         position: dmt$device_position;
     VAR closest_position: dmt$position_link);

    VAR
      use_next: boolean,
      previous_position: dmt$position_link,
      next_position: dmt$position_link;

    find_adjacent_positions (p_mat, allocation_style, position, previous_position, next_position);

    use_next := (previous_position = dmc$nil_position_link) OR
          (next_position <> dmc$nil_position_link) AND ((position - previous_position) >
          (next_position - position));

    IF use_next THEN
      closest_position := next_position;
    ELSE
      closest_position := previous_position;
    IFEND;

  PROCEND find_closest_position;
?? TITLE := '  find_furthest_position', EJECT ??

  PROCEDURE [INLINE] find_furthest_position
    (    p_mat: ^dmt$mainframe_allocation_table;
         allocation_style: dmt$allocation_styles;
         position: dmt$device_position;
     VAR furthest_position: dmt$position_link);

    VAR
      next_position: dmt$position_link,
      last_position: dmt$position_link;

    furthest_position := p_mat^.allocation_chains [allocation_style];

    IF (furthest_position <> dmc$nil_position_link) THEN
      next_position := furthest_position;

      REPEAT
        last_position := next_position;
        next_position := p_mat^.mat_entries [last_position].forward_link;
      UNTIL (next_position = dmc$nil_position_link);

      IF ((position - furthest_position) <= (last_position - position)) THEN
        furthest_position := last_position;
      IFEND;
    IFEND;

  PROCEND find_furthest_position;
?? TITLE := '  link_position', EJECT ??

  PROCEDURE [INLINE] link_position
    (    p_mat: ^dmt$mainframe_allocation_table;
         position: dmt$device_position);

    VAR
      allocation_style: dmt$allocation_styles,
      p_position_entry: ^dmt$mat_entry,
      previous_position: dmt$position_link,
      next_position: dmt$position_link;

    p_position_entry := ^p_mat^.mat_entries [position];
    allocation_style := p_position_entry^.allocation_style;

    find_adjacent_positions (p_mat, allocation_style, position, previous_position, next_position);

    IF (previous_position = dmc$nil_position_link) THEN
      p_mat^.allocation_chains [allocation_style] := position;
    ELSE
      p_mat^.mat_entries [previous_position].forward_link := position;
    IFEND;

    IF (next_position <> dmc$nil_position_link) THEN
      p_mat^.mat_entries [next_position].backward_link := position;
    IFEND;

    p_position_entry^.forward_link := next_position;
    p_position_entry^.backward_link := previous_position;

  PROCEND link_position;
?? TITLE := '  release_allocation_unit', EJECT ??

  PROCEDURE release_allocation_unit
    (    p_mat: ^dmt$mainframe_allocation_table;
         released_style: dmt$allocation_styles;
         dau_address: dmt$dau_address;
     VAR dau_release_failure: {input/output} dmt$dau_release_failure);

    VAR
      additional_allocation_units: dmt$daus_per_position,
      allocation_units_per_position: dmt$daus_per_position,
      dau: dmt$dau_address,
      dau_release_failure_in_proc: boolean,
      daus_per_allocation: dmt$daus_per_position,
      daus_per_position: dmt$daus_per_position,
      daus_released: dmt$daus_per_position,
      leftover_space: dmt$daus_per_position,
      next_allocation_unit_dau: dmt$dau_address,
      next_position_dau: dmt$dau_address,
      p_position_entry: ^dmt$mat_entry,
      position: dmt$device_position,
      position_dau: dmt$dau_address,
      style: dmt$allocation_styles;

    dau_release_failure_in_proc := FALSE;
    daus_released := p_mat^.daus_per_allocation_unit [released_style];
    daus_per_position := p_mat^.daus_per_position;
    position := dau_address DIV daus_per_position;
    p_position_entry := ^p_mat^.mat_entries [position];
    style := p_position_entry^.allocation_style;
    daus_per_allocation := p_mat^.daus_per_allocation_unit [style];
    allocation_units_per_position := daus_per_position DIV daus_per_allocation;

{ Set DAU's available.
    FOR dau := dau_address TO (dau_address + daus_released - 1) DO
      IF p_mat^.p_available_daus^ [dau] THEN
        IF NOT dau_release_failure.mau_release_failure THEN
          dau_release_failure.mau_release_failure := TRUE;
          dau_release_failure.first_failing_mau := dau;
          dau_release_failure.failing_mau_count := 0;
        IFEND;
        dau_release_failure.failing_mau_count := dau_release_failure.failing_mau_count + 1;
        dau_release_failure.last_failing_mau := dau;
        dau_release_failure_in_proc := TRUE;
      IFEND;
      p_mat^.p_available_daus^ [dau] := TRUE;
    FOREND;

{ NOTE: We do not know, if all or only some of the DAUs were already released! But what should we do,
{       when only some of the DAUs get released twice? I mean, we should still halt the system then!
{       We will decide when we should ever see the message.

    IF dau_release_failure_in_proc THEN
      dau_release_failure.avt_index := p_mat^.avt_index;
      RETURN; {----->
    IFEND;

    p_mat^.available_space := p_mat^.available_space + daus_released;

    { Put allocation unit(s) back in MAT.

    IF (released_style = style) THEN
      additional_allocation_units := 1;
    ELSE
      additional_allocation_units := daus_released DIV daus_per_allocation;
      leftover_space := daus_released MOD daus_per_allocation;
      p_mat^.leftover_space := p_mat^.leftover_space + leftover_space;
      p_mat^.available_space := p_mat^.available_space - leftover_space;
      IF (additional_allocation_units = 0) THEN
        position_dau := position * daus_per_position;
        next_position_dau := position_dau + daus_per_position;
        dau := position_dau + (dau_address - position_dau) DIV daus_per_allocation * daus_per_allocation;
        next_allocation_unit_dau := dau + daus_per_allocation;
        IF (next_allocation_unit_dau <= next_position_dau) THEN
          WHILE (dau < next_allocation_unit_dau) AND p_mat^.p_available_daus^ [dau] DO
            dau := dau + 1;
          WHILEND;
          IF (dau = next_allocation_unit_dau) THEN
            p_mat^.leftover_space := p_mat^.leftover_space - daus_per_allocation;
            p_mat^.available_space := p_mat^.available_space + daus_per_allocation;
            additional_allocation_units := 1;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    p_mat^.available_allocation_units [style] := p_mat^.available_allocation_units [style] +
          additional_allocation_units;
    p_position_entry^.available_allocation_units := p_position_entry^.available_allocation_units +
          additional_allocation_units;

    { Convert unused position back to cylinder allocation style.

    IF (p_position_entry^.available_allocation_units = allocation_units_per_position) THEN
      position_dau := position * daus_per_position;
      next_position_dau := position_dau + daus_per_position;
      dau := position_dau + daus_per_allocation * allocation_units_per_position;
      leftover_space := next_position_dau - dau;

      WHILE (dau < next_position_dau) AND p_mat^.p_available_daus^ [dau] DO
        dau := dau + 1;
      WHILEND;

      IF (dau = next_position_dau) THEN {Leftover DAU's are in the MAT}
        IF (p_position_entry^.available_allocation_units > additional_allocation_units) THEN
          delink_position (p_mat, position);
        IFEND;

        p_mat^.available_allocation_units [style] := p_mat^.available_allocation_units [style] -
              allocation_units_per_position;

        p_mat^.leftover_space := p_mat^.leftover_space - leftover_space;
        p_mat^.available_space := p_mat^.available_space + leftover_space;

        p_position_entry^.allocation_style := dmc$acyl;
        p_position_entry^.available_allocation_units := 1;
        p_mat^.available_allocation_units [dmc$acyl] := p_mat^.available_allocation_units [dmc$acyl] + 1;
        additional_allocation_units := 1;
      IFEND;
    IFEND;

    { Link position into allocation chain.

    IF (p_position_entry^.available_allocation_units = additional_allocation_units) AND
          (additional_allocation_units > 0) THEN
      link_position (p_mat, position);
    IFEND;

  PROCEND release_allocation_unit;
?? TITLE := '  remove_mat_space', EJECT ??

  PROCEDURE remove_mat_space
    (    p_mat: ^dmt$mainframe_allocation_table;
         p_mat_changes: ^dmt$mat_changes;
     VAR mat_change_count: dmt$mat_change_count);

    VAR
      daus_per_position: dmt$daus_per_position,
      available_positions: dmt$device_position,
      mat_excess: integer,
      mat_position_excess: dmt$device_position,
      dat_shortage: integer,
      dat_position_shortage: dmt$device_position,
      position: dmt$position_link,
      previous_position: dmt$device_position,
      dau: dmt$dau_address,
      first_dau: dmt$dau_address,
      change_index: dmt$mat_change_count;

    daus_per_position := p_mat^.daus_per_position;
    available_positions := p_mat^.available_allocation_units [dmc$acyl];

    { Compute the number of positions by which the MAT is too full.
    { The MAT must have more than one free cylinder to be considered too full.

    mat_excess := p_mat^.available_space - p_mat^.maximum_space;
    IF (mat_excess <= 0) OR (available_positions <= 1) THEN
      mat_position_excess := 0;
    ELSE
      mat_position_excess := (mat_excess + daus_per_position - 1) DIV daus_per_position;
      IF (mat_position_excess > (available_positions - 1)) THEN
        mat_position_excess := available_positions - 1;
      IFEND;
    IFEND;

    { Compute the number of positions by which the DAT is too empty.
    { The DAT must be a full cylinder below the threshold before it is
    { considerd to be too empty.

    dat_shortage := p_mat^.dat_threshold - p_mat^.available_dat_space;
    IF (dat_shortage <= 0) THEN
      dat_position_shortage := 0;
    ELSE
      dat_position_shortage := dat_shortage DIV daus_per_position;
      IF (dat_position_shortage > available_positions) THEN
        dat_position_shortage := available_positions;
      IFEND;
    IFEND;

    { The position count to be returned to the DAT is the greater of the
    { number of positions by which the MAT is too full and the number of
    { positions by which the DAT is too empty.  This is constrained by
    { the number of changes that will fit in the MAT change list.

    IF (mat_position_excess >= dat_position_shortage) THEN
      mat_change_count := mat_position_excess;
    ELSE
      mat_change_count := dat_position_shortage;
    IFEND;

    IF (p_mat_changes = NIL) THEN
      mat_change_count := 0;
    ELSEIF mat_change_count > dmv$mat_change_count_max THEN
      mat_change_count := dmv$mat_change_count_max;
    IFEND;

    { Remove positions from the MAT and record them in the MAT change list.

    previous_position := 0;

    FOR change_index := 1 TO mat_change_count DO
      find_furthest_position (p_mat, dmc$acyl, previous_position, position);
      delink_position (p_mat, position);

      first_dau := position * daus_per_position;
      FOR dau := first_dau TO (first_dau + daus_per_position - 1) DO
        p_mat^.p_available_daus^ [dau] := FALSE;
      FOREND;

      p_mat^.mat_entries [position].available_allocation_units := 0;
      p_mat^.available_allocation_units [dmc$acyl] := p_mat^.available_allocation_units [dmc$acyl] - 1;
      p_mat^.available_space := p_mat^.available_space - daus_per_position;

      p_mat_changes^ [change_index].style := dmc$acyl;
      p_mat_changes^ [change_index].dau_address := first_dau;
    FOREND;

  PROCEND remove_mat_space;
?? TITLE := '  update_volume_status', EJECT ??

  PROCEDURE update_volume_status
    (    p_mat: ^dmt$mainframe_allocation_table);

    VAR
      available_cylinders: dmt$device_position,
      available_space: dmt$dau_address,
      dat_low: boolean,
      dat_shortage: integer,
      empty_mat: boolean,
      entry_p: ^dmt$ms_active_vol_table_entry,
      fill_dat: boolean,
      fill_mat: boolean,
      free_cylinders: boolean,
      mat_low: boolean,
      multiple_free_cylinders: boolean,
      ready_space_manager: boolean,
      space_gone: boolean,
      space_low: boolean,
      space_was_gone: boolean,
      space_was_low: boolean,
      status: syt$monitor_status,
      usable_mat_space: dmt$dau_address;

    available_cylinders := p_mat^.available_allocation_units [dmc$acyl];
    free_cylinders := available_cylinders > 0;
    multiple_free_cylinders := available_cylinders > 1;

    dat_shortage := p_mat^.dat_threshold - p_mat^.available_dat_space;
    dat_low := dat_shortage >= 0;
    fill_dat := (dat_shortage > p_mat^.daus_per_position) AND free_cylinders;

    usable_mat_space := p_mat^.available_space;
    mat_low := (usable_mat_space < p_mat^.minimum_space) OR NOT free_cylinders;
    fill_mat := mat_low AND NOT dat_low;
    empty_mat := (usable_mat_space > p_mat^.maximum_space) AND multiple_free_cylinders;

    p_mat^.mat_too_full := empty_mat OR fill_dat;

    available_space := p_mat^.available_space + p_mat^.available_dat_space;
    space_low := available_space <= p_mat^.warning_threshold;

    entry_p := ^dmv$active_volume_table.table_p^ [p_mat^.avt_index].mass_storage;
    space_was_low := entry_p^.space_low;
    entry_p^.space_low := space_low;

    IF dmv$require_cylinders THEN
      space_gone := NOT free_cylinders AND dat_low;
    ELSE
      space_gone := dat_low;
    IFEND;
    space_was_gone := entry_p^.space_gone;
    entry_p^.space_gone := space_gone;

    ready_space_manager := fill_mat OR fill_dat OR empty_mat OR (space_low <> space_was_low) OR
          (space_gone <> space_was_gone);

    IF ready_space_manager AND dmv$vol_space_manage_initiated THEN
      tmp$monitor_ready_system_task (tmc$stid_volume_space_managemnt, status);
    IFEND;

  PROCEND update_volume_status;
?? TITLE := '  dmp$mtr_reallocate_file_space', EJECT ??

  PROCEDURE [XDCL] dmp$mtr_reallocate_file_space
    (VAR reallocate_request_block: dmt$monitor_rb_reallocate_space);

    VAR
      able_to_log: boolean,
      al_entry: dmt$al_entry,
      allocation_allowed: boolean,
      allocation_style: dmt$allocation_styles,
      allocation_unit_found: boolean,
      allocation_units_obtained: integer,
      avt_entry_found: boolean,
      avt_index: dmt$active_volume_table_index,
      bytes_per_allocation: dmt$bytes_per_allocation,
      dau_address: dmt$dau_address,
      dau_release_failure: dmt$dau_release_failure,
      daus_per_allocation_unit: dmt$daus_per_position,
      device_file_list_index: dmt$device_file_list_index,
      global_file_name: dmt$global_file_name,
      incomplete_allocation: boolean,
      length: integer,
      logging_required_for_file_type: boolean,
      attributes: array [1 .. 1] of dmt$assigned_ms_vol_attribute,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fau_entry: ^dmt$file_allocation_unit,
      p_fde: ^gft$file_descriptor_entry,
      p_mat: ^dmt$mainframe_allocation_table,
      p_next_fau: ^dmt$file_allocation_unit,
      p_existing_fmd: ^dmt$file_medium_descriptor,
      p_previous_fau_entry: ^dmt$file_allocation_unit,
      previous_dau_address: dmt$dau_address,
      reallocate_byte_address: amt$file_byte_address,
      dmv$reallocations: [XDCL] integer := 0;

    reallocate_request_block.status.normal := TRUE;
    dau_release_failure.mau_release_failure := FALSE;

    p_fde := reallocate_request_block.p_fde;
    reallocate_request_block.allocation_units_obtained := 0;
    reallocate_byte_address := reallocate_request_block.reallocate_byte_address;
    global_file_name := reallocate_request_block.global_file_name;
    logging_required_for_file_type := (p_fde^.file_kind <= gfc$fk_last_permanent_file);
    allocation_units_obtained := 0;

    p_dfd := dmf$disk_file_descriptor_p (p_fde);
    dmp$get_fau_entry (p_dfd, reallocate_byte_address, p_fau_entry);
    IF p_fau_entry = NIL THEN
      mtp$set_status_abnormal (dmc$device_manager_ident, dme$file_alloc_descrip_overflow,
            reallocate_request_block.status);
      mtp$error_stop ('FAD overflow - dmp$reallocate_file_space.');
    IFEND;
    dmp$get_fmd_by_index (p_dfd, p_fau_entry^.fmd_index, p_existing_fmd);
    allocation_style := p_existing_fmd^.allocation_style;
    device_file_list_index := p_existing_fmd^.dfl_index;
    avt_index := p_existing_fmd^.avt_index;

{ get assigned volume information
    attributes [1].keyword := dmc$ms_allocation_allowed;
    dmp$get_active_vol_attributes (dmv$null_vsn, avt_index, attributes, avt_entry_found);
    IF NOT avt_entry_found THEN
      mtp$set_status_abnormal (dmc$device_manager_ident, dme$avt_entry_not_found,
            reallocate_request_block.status);
      RETURN; {----->
    IFEND;

    allocation_allowed := attributes [1].allocation_allowed;
    dmp$get_mat_pointer (avt_index, p_mat);

    IF (p_mat = NIL) THEN
      mtp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
            reallocate_request_block.status);
      RETURN; {----->
    IFEND;

    daus_per_allocation_unit := p_mat^.daus_per_allocation_unit [allocation_style];
    bytes_per_allocation := p_mat^.bytes_per_dau * daus_per_allocation_unit;

    incomplete_allocation := TRUE;

    IF allocation_allowed THEN
      IF (p_fau_entry^.state <> dmc$fau_invalid_and_flawed) AND
            (p_fau_entry^.state <> dmc$fau_initialized_and_flawed) THEN
        {return with normal status - no reallocation is required
        RETURN; {----->
      IFEND;

      IF reallocate_request_block.copy_pages THEN
        length := p_fde^.eoi_byte_address - reallocate_byte_address;
        IF (length > bytes_per_allocation) THEN
          length := bytes_per_allocation;
        IFEND;
      ELSE
        length := 0;
      IFEND;

      IF (length > 0) THEN
        mmp$modify_pages (p_fde, reallocate_byte_address, length, FALSE, reallocate_request_block.status);
        IF NOT reallocate_request_block.status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

      { allocate space

      al_entry.kind := dmc$al_reallocate;
      al_entry.avt_index := avt_index;
      al_entry.reallocate_block.global_file_name := global_file_name;
      al_entry.reallocate_block.dfl_index := device_file_list_index;
      al_entry.reallocate_block.daus_per_allocation := daus_per_allocation_unit;
      al_entry.reallocate_block.old_dau_address := p_fau_entry^.dau_address;

      dmp$get_previous_fau_entry (p_dfd, reallocate_byte_address, p_fau_entry^.fmd_index,
            p_previous_fau_entry);
      IF p_previous_fau_entry <> NIL THEN
        previous_dau_address := p_previous_fau_entry^.dau_address;
      ELSE
        previous_dau_address := 0;
      IFEND;

      dmp$get_next_fmd_fau (p_dfd, reallocate_byte_address, p_fau_entry^.fmd_index, p_next_fau);
      IF (p_next_fau = NIL) OR (p_next_fau^.state = dmc$fau_free) THEN
        IF previous_dau_address = 0 THEN
          al_entry.reallocate_block.allocation_chain_position := dmc$first_and_last_allocation;
        ELSE
          al_entry.reallocate_block.allocation_chain_position := dmc$last_allocation;
        IFEND;
        al_entry.reallocate_block.next_dau_address := 0;
      ELSE
        IF previous_dau_address = 0 THEN
          al_entry.reallocate_block.allocation_chain_position := dmc$first_allocation;
        ELSE
          al_entry.reallocate_block.allocation_chain_position := dmc$middle_allocation;
        IFEND;
        al_entry.reallocate_block.next_dau_address := p_next_fau^.dau_address;
      IFEND;

      assign_allocation_unit (p_mat, allocation_style, previous_dau_address, dau_address,
            allocation_unit_found);
      IF allocation_unit_found THEN
        IF logging_required_for_file_type THEN
          al_entry.reallocate_block.dau_address := dau_address;
          al_entry.reallocate_block.previous_dau_address := previous_dau_address;
          dmp$mtr_log (al_entry, able_to_log);
          IF NOT able_to_log THEN
            release_allocation_unit (p_mat, allocation_style, dau_address, dau_release_failure);
            mtp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
                  reallocate_request_block.status);
            IF dau_release_failure.mau_release_failure THEN
              p$issue_dau_release_failure_msg (dau_release_failure, p_fde);
            IFEND;
            RETURN; {----->
          IFEND;
        IFEND;

        dmv$reallocations := dmv$reallocations + 1;
        p_fau_entry^.dau_address := dau_address;
        p_fau_entry^.state := dmc$fau_invalid_data;
        allocation_units_obtained := allocation_units_obtained + 1;

        IF (length > 0) THEN
          mmp$modify_pages (p_fde, reallocate_byte_address, length, TRUE, reallocate_request_block.status);
        IFEND;
      IFEND;

{ update the request block parameters.
      reallocate_request_block.allocation_units_obtained := allocation_units_obtained;

{ update mat information.
      p_mat^.allocated_space [p_fde^.file_kind] := (p_mat^.allocated_space [p_fde^.file_kind] +
            (daus_per_allocation_unit * allocation_units_obtained)) MOD (dmc$max_dau_address + 1);

      incomplete_allocation := (allocation_units_obtained = 0);
    IFEND;

{ set status to indicate unable to allocate all space from the mat.
    IF incomplete_allocation THEN
      mtp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
            reallocate_request_block.status);
    IFEND;

    update_volume_status (p_mat);

  PROCEND dmp$mtr_reallocate_file_space;
MODEND dmm$monitor_allocator;
