?? RIGHT := 110 ??
*copy osd$default_pragmats
?? NEWTITLE := 'NOSVE Device Management' ??
MODULE dmm$job_allocator;
?? RIGHT := 110 ??

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$mainframe_paged_literal
*copyc dmc$default_transfer_sizes
*copyc rmc$mass_storage_class
*copyc syc$monitor_request_codes
*copyc cyd$cybil_structure_definitions
*copyc osd$virtual_address
*copyc amt$access_level
*copyc amt$attribute_source
*copyc amt$average_record_length
*copyc amt$block_type
*copyc amt$collate_table
*copyc amt$collation_value
*copyc amt$data_padding
*copyc amt$error_exit_procedure
*copyc amt$error_limit
*copyc amt$estimated_record_count
*copyc amt$file_access_selections
*copyc amt$file_attribute_keys
*copyc amt$file_attributes
*copyc amt$file_byte_address
*copyc amt$file_identifier
*copyc amt$file_length
*copyc amt$file_limit
*copyc amt$file_organization
*copyc amt$file_position
*copyc amt$forced_write
*copyc amt$global_file_position
*copyc amt$index_padding
*copyc amt$internal_code
*copyc amt$key_length
*copyc amt$key_position
*copyc amt$key_type
*copyc amt$label_exit_procedure
*copyc amt$label_options
*copyc amt$label_type
*copyc amt$local_file_name
*copyc amc$mau_length
*copyc amt$max_block_length
*copyc amt$max_record_length
*copyc amt$message_control
*copyc amt$min_block_length
*copyc amt$min_record_length
*copyc amt$padding_character
*copyc amt$record_limit
*copyc amt$record_type
*copyc amt$records_per_block
*copyc amt$return_option
*copyc amt$user_info
*copyc amt$vertical_print_density
*copyc ost$status
*copyc rmd$volume_declarations
*copyc mme$condition_codes
*copyc amt$file_byte_address
*copyc dmt$active_volume_table_index
*copyc dmt$allocation_size
*copyc dmt$assigned_ms_vol_attributes
*copyc dmt$chapter_number
*copyc dmt$device_allocation_unit
*copyc dmt$device_file_list_index
*copyc dmt$df_allocate_file_space
*copyc dmt$df_reallocate_file_space
*copyc dmt$error_condition_codes
*copyc dmt$file_allocation_descriptor
*copyc dmt$file_attributes
*copyc dmt$file_location
*copyc dmt$file_medium_descriptor
*copyc dmt$file_share_history
*copyc dmt$internal_vsn
*copyc dmt$mainframe_allocation_table
*copyc dmt$mat_converter
*copyc dmt$monitor_request_blocks
*copyc dmt$monitor_requests
*copyc dmt$ms_device_allocation_table
*copyc dmt$ms_device_file_list_entry
*copyc dmt$overflow_allowed
*copyc dmt$segment_file_information
*copyc dmt$server_file_output
*copyc mmt$segment_descriptor_table_ex
*copyc ost$signature_lock
*copyc ost$status
*copyc ost$wait
*copyc syt$monitor_status
?? POP ??
*copyc gff$old_file_hash
*copyc dfp$begin_remote_core_call
*copyc dfp$end_remote_core_call
*copyc dfp$get_served_file_desc_p
*copyc dfp$send_remote_core_call
*copyc dfp$uncomplement_gfn
*copyc dmp$add_class_to_volume
*copyc dmp$analyze_dat_position
*copyc dmp$build_fmd_for_existing_file
*copyc dmp$close_file
*copyc dmp$create_fau_entry
*copyc dmp$fetch_eoi
*copyc dmp$get_active_vol_attributes
*copyc dmp$get_disk_file_descriptor_p
*copyc dmp$get_fau_entry
*copyc dmp$get_fmd_by_index
*copyc dmp$get_level_2_ptr
*copyc dmp$get_mat_pointer
*copyc dmp$get_total_allocated_length
*copyc dmp$get_unused_mfl_entry
*copyc dmp$increase_fmd_count
*copyc dmp$open_dat
*copyc dmp$open_dflt
*copyc dmp$process_device_log_entry
*copyc dmp$reserve_fmd
*copyc dmp$set_eoi
*copyc dmp$split_allocation_log
*copyc gfp$get_locked_fde_p
*copyc gfp$unlock_fde_p
*copyc iop$mass_storage_io
*copyc mmp$close_device_file
*copyc mmp$fetch_offset_mod_pages_r1
*copyc mmp$open_file_by_sfid
*copyc mmp$write_modified_pages
*copyc osp$append_status_parameter
*copyc osp$clear_mainframe_sig_lock
*copyc osp$fatal_system_error
*copyc osp$get_locked_variable_value
*copyc osp$increment_locked_variable
*copyc osp$initialize_sig_lock
*copyc osp$set_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$test_set_main_sig_lock
*copyc osp$unpack_status_identifier
*copyc pmp$cycle
*copyc pmp$delay
*copyc pmp$get_executing_task_gtid
*copyc pmp$zero_out_table
*copyc sfp$accumulate_file_space
*copyc syp$continue_to_cause
*copyc syp$disestablish_cond_handler
*copyc syp$establish_condition_handler
*copyc dmv$active_volume_table
*copyc dmv$idle_system
*copyc dmv$internal_tasks_initiated
*copyc dmv$permanent_file_overflow
*copyc dmv$system_class
*copyc dmv$system_device_information
*copyc dmv$temporary_file_overflow
*copyc dmv$volume_selector
*copyc gfv$null_sfid
*copyc mmv$max_pages_no_file
*copyc osv$mainframe_wired_heap
*copyc osv$page_size
*copyc i#call_monitor
*copyc i#fill
*copyc i#move

  VAR
    dmv$pf_sparse: [XREF] boolean;

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

  TYPE
    t$allocation_list = array [1 .. * ] of dmt$dau_address,

    t$volume_selector = record
      class: dmt$class_member,
      class_ordinal: dmt$class_ordinal,
      recorded_vsn: rmt$recorded_vsn,
      set_name: stt$set_name,
      force_allocation_size: boolean,
      allocation_size: dmt$allocation_size,
    recend;

  VAR
    allocator_delay_time: [XDCL] integer := 5000;

  VAR
    dmv$q_devices_added: [XDCL, #GATE] integer := 0,
    dmv$q_add_lock: [XDCL, #GATE] ost$signature_lock,
    dmv$quick_deadstart: [XDCL] boolean := TRUE;

  VAR
    dmv$deadstart_disk_space: [XDCL] integer := 10 * 9175040 {Bytes} ;

  VAR
    mmv$create_sparse: [XDCL] integer := 0,
    dmv$maximum_allocation_size: [XDCL] integer := 256 * 1024;

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

  PROCEDURE [XDCL] dmp$dat_purge_file
    (    gfn: dmt$global_file_name;
         dfl_index: dmt$device_file_list_index;
         avt_index: dmt$active_volume_table_index;
     VAR status: ost$status);

    VAR
      dat_chain: boolean,
      dat_sfid: gft$system_file_identifier,
      daus_per_allocation: dmt$daus_per_allocation,
      dfl_sfid: gft$system_file_identifier,
      file_found: boolean,
      file_hash: dmt$file_hash,
      first_dau: dmt$dau_address,
      local_status: ost$status,
      p_dfl: ^dmt$ms_device_file_list_table,
      volume_entry_p: ^dmt$ms_active_vol_table_entry,
      dfl_entry_p: ^dmt$ms_device_file_list_entry;

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

    dmp$open_dflt (dfl_sfid, osc$os_ring_1, osc$tsrv_ring, mmc$sar_write_extend, mmc$as_sequential, p_dfl,
          status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    osp$set_mainframe_sig_lock (volume_entry_p^.update_lock);

    dfl_entry_p := ^p_dfl^.entries [dfl_index];
    file_found := (dfl_entry_p^.flags = dmc$dfle_assigned_to_file) AND (dfl_entry_p^.global_file_name = gfn);

    IF file_found THEN
      dat_chain := (dfl_entry_p^.dau_chain_status = dmc$dau_chain_linked);
      first_dau := dfl_entry_p^.first_dau_address;
      daus_per_allocation := dfl_entry_p^.daus_per_allocation_unit;
      file_hash := dfl_entry_p^.file_hash;
      dfl_entry_p^.flags := dmc$dfle_available;

      mmp$write_modified_pages (p_dfl, #SIZE (p_dfl^), osc$wait, local_status);
      dat_chain := dat_chain AND local_status.normal;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unknown_file, '', status);
      dat_chain := FALSE;
    IFEND;

    osp$clear_mainframe_sig_lock (volume_entry_p^.update_lock);

    dmp$close_file (p_dfl, local_status);

    IF dat_chain THEN
      dat_deallocate (dat_sfid, file_hash, daus_per_allocation, first_dau, avt_index, local_status);
    IFEND;

  PROCEND dmp$dat_purge_file;
?? TITLE := '  dmp$df_client_allocate_space_r1', EJECT ??
*copyc dmh$df_client_allocate_space_r1

  PROCEDURE [XDCL] dmp$df_client_allocate_space_r1
    (    fde_p: ^gft$file_descriptor_entry;
         system_file_id: gft$system_file_identifier;
         initial_byte_address: amt$file_byte_address;
         requested_bytes_to_allocate: amt$file_byte_address;
         file_space_limit: sft$file_space_limit_kind;
     VAR status: ost$status);

    VAR
      byte_offset: amt$file_byte_address,
      bytes_to_allocate: amt$file_byte_address,
      local_fde_p: ^gft$file_descriptor_entry,
      p_receive_from_server_params: dft$p_receive_parameters,
      p_receive_parameters: ^dmt$df_allocate_file_space_inp,
      p_send_parameters: ^dmt$df_allocate_file_space_inp,
      p_send_to_server_params: dft$p_send_parameters,
      p_server_descriptor: dmt$p_server_descriptor,
      queue_entry_location: dft$rpc_queue_entry_location,
      remote_sfid: gft$system_file_identifier,
      served_family_table_index: dft$served_family_table_index,
      status_p: ^ost$status;

    status.normal := TRUE;
    dfp$get_served_file_desc_p (fde_p, p_server_descriptor);
    IF (p_server_descriptor^.header.file_state = dfc$awaiting_recovery) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dfe$server_not_active, '', status);
      gfp$unlock_fde_p (fde_p);
      RETURN; {----->
    ELSEIF (p_server_descriptor^.header.file_state = dfc$terminated) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dfe$server_has_terminated, '', status);
      gfp$unlock_fde_p (fde_p);
      RETURN; {----->
    IFEND;
    served_family_table_index := p_server_descriptor^.header.served_family_table_index;
    remote_sfid := p_server_descriptor^.header.remote_sfid;
    byte_offset := p_server_descriptor^.header.total_allocated_length;
    IF p_server_descriptor^.header.allocation_info.allocation_needed_on_server THEN
      bytes_to_allocate := p_server_descriptor^.header.allocation_info.bytes_to_allocate;

    ELSEIF (initial_byte_address + requested_bytes_to_allocate) >
          p_server_descriptor^.header.total_allocated_length THEN
      byte_offset := initial_byte_address;
      bytes_to_allocate := requested_bytes_to_allocate;

    ELSE

{ This instance of an allocation has already been processed by another request.
      gfp$unlock_fde_p (fde_p);
      RETURN; {----->
    IFEND;

    gfp$unlock_fde_p (fde_p);

    dfp$begin_remote_core_call (served_family_table_index, { Allowed when deactive } TRUE,
          queue_entry_location, p_send_to_server_params, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    NEXT p_send_parameters IN p_send_to_server_params;
    p_send_parameters^.sfid := remote_sfid;
    p_send_parameters^.byte_offset := byte_offset;
    p_send_parameters^.bytes_to_allocate := bytes_to_allocate;
    p_send_parameters^.total_allocated_length := byte_offset;

    dfp$send_remote_core_call (queue_entry_location, dfc$r1_df_server_allocate_space,
          #SIZE (p_send_parameters^), p_receive_from_server_params, status);

    IF status.normal THEN
      gfp$get_locked_fde_p (system_file_id, local_fde_p);

      RESET p_receive_from_server_params;
      NEXT p_receive_parameters IN p_receive_from_server_params;
      IF p_server_descriptor^.header.total_allocated_length <
            p_receive_parameters^.total_allocated_length THEN
        IF file_space_limit <> sfc$no_limit THEN
          sfp$accumulate_file_space (file_space_limit, p_receive_parameters^.total_allocated_length -
                p_server_descriptor^.header.total_allocated_length);
        IFEND;
        p_server_descriptor^.header.total_allocated_length := p_receive_parameters^.total_allocated_length;
      IFEND;
      p_server_descriptor^.header.allocation_info.allocation_needed_on_server := FALSE;
      p_server_descriptor^.header.allocation_info.invalid_data := 0;
      gfp$unlock_fde_p (local_fde_p);

      status_p:= ^status;
    ELSE
      PUSH status_p;
    IFEND;

    dfp$end_remote_core_call (queue_entry_location, status_p^);

  PROCEND dmp$df_client_allocate_space_r1;
?? TITLE := '  dmp$allocate_file_space_r1', EJECT ??
*copy dmh$allocate_file_space_r1

  PROCEDURE [XDCL, #GATE] dmp$allocate_file_space_r1
    (    system_file_id: gft$system_file_identifier;
         initial_byte_address: amt$file_byte_address;
         bytes_to_allocate: amt$file_byte_address;
         chapter_number: dmt$chapter_number; {*** CAN THIS GO? ***}
         wait_option: ost$wait;
         file_space_limit: sft$file_space_limit_kind;
     VAR status: ost$status);

    VAR
      able_to_reserve_fmd: boolean,
      allocation_end: amt$file_byte_address,
      allow_overflow: boolean,
      avt_index: dmt$active_volume_table_index,
      byte_address: amt$file_byte_address,
      bytes_per_allocation: dmt$bytes_per_allocation,
      bytes_per_position: dmt$bytes_per_allocation,
      fmd_index: dmt$fmd_index,
      file_allows_overflow: boolean,
      fmd_locator: dmt$file_location,
      dfd_pointer: ost$relative_pointer,
      internal_vsn: dmt$internal_vsn,
      local_status: ost$status,
      maximum_size: amt$file_byte_address,
      monitor_request_block: dmt$monitor_rb_allocate_space,
      overflow: boolean,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fau: ^dmt$file_allocation_unit,
      p_fde: ^gft$file_descriptor_entry,
      p_file_attributes: ^array [ * ] of dmt$file_attribute,
      p_fmd: ^dmt$file_medium_descriptor,
      p_mat: ^dmt$mainframe_allocation_table,
      volume_attributes: array [1 .. 1] of dmt$assigned_ms_vol_attribute,
      requested_allocation: amt$file_byte_address,
      requested_allocation_end: amt$file_byte_address,
      temporary_file: boolean,
      volume_found: boolean,
      vsn: rmt$recorded_vsn;

    IF dmv$idle_system THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
            'cannot allocate due to idle system - dmp$allocate_file_space_r1', status);
      RETURN; {----->
    IFEND;

    status.normal := TRUE;

    p_file_attributes := NIL;
    byte_address := initial_byte_address;
    IF bytes_to_allocate > 0 THEN
      requested_allocation := bytes_to_allocate;
    ELSE
      {If you dislike this code, then you take it out.
      {Go ahead - take it out.
      {Make my day.
      requested_allocation := 1;
    IFEND;
    requested_allocation_end := byte_address + requested_allocation;

  /process_request/
    BEGIN
      gfp$get_locked_fde_p (system_file_id, p_fde);
      IF p_fde = NIL THEN
        EXIT /process_request/; {----->
      IFEND;

    /file_descriptor_locked/
      BEGIN
        IF p_fde^.media = gfc$fm_served_file THEN
          dmp$df_client_allocate_space_r1 (p_fde, system_file_id, initial_byte_address, requested_allocation,
                file_space_limit, status);
{         File_Descriptor_Entry (FDE) lock has been cleared by the callee.
          EXIT /process_request/; {----->
        IFEND;

        dmp$get_disk_file_descriptor_p (p_fde, p_dfd);
        IF p_dfd = NIL THEN
          EXIT /file_descriptor_locked/; {----->
        IFEND;

{  *** STILL NEED TO BE ABLE TO ADD SUBFILES, FOR REASSIGN_FILE ***

        dmp$get_fmd_by_index (p_dfd, p_dfd^.current_fmd_index, p_fmd);
        IF p_fmd = NIL THEN
          dmp$increase_fmd_count (system_file_id, p_dfd, status);
          IF NOT status.normal THEN
            EXIT /file_descriptor_locked/; {----->
          IFEND;
          dmp$reserve_fmd (p_dfd, fmd_index, able_to_reserve_fmd);
          IF NOT able_to_reserve_fmd THEN
            osp$fatal_system_error ('Unable to reserve a FMD - dmp$allocate_file_space_r1', NIL);
          IFEND;
          p_dfd^.current_fmd_index := fmd_index;
        IFEND;

        file_allows_overflow := p_dfd^.overflow_allowed;
        temporary_file := p_fde^.file_kind >= gfc$fk_first_temporary_file;

        monitor_request_block.request_code := syc$rc_allocate_front_end;
        monitor_request_block.system_file_id := system_file_id;
        monitor_request_block.update_fat_pointer := FALSE;

      /allocate_loop/
        WHILE TRUE DO
          dmp$get_fmd_by_index (p_dfd, p_dfd^.current_fmd_index, p_fmd);
{
{             check to see if a volume must be assigned to the fmd
{
          IF NOT p_fmd^.volume_assigned THEN
            IF (p_fde^.file_kind = gfc$fk_device_file) THEN
              avt_index := 0;
              vsn := p_dfd^.requested_volume.recorded_vsn;
              volume_attributes [1].keyword := dmc$ms_device_log;
              dmp$get_active_vol_attributes (vsn, avt_index, volume_attributes, volume_found);
              IF volume_found AND (volume_attributes [1].p_dlog = gfv$null_sfid) THEN
                unlogged_assign_volume (system_file_id, p_fde, p_dfd, p_fmd, requested_allocation, vsn,
                      status);
                EXIT /file_descriptor_locked/; {----->
              IFEND;
            IFEND;

            assign_volume (system_file_id, p_fde, p_dfd, p_fmd, status);
            IF NOT status.normal THEN
              EXIT /file_descriptor_locked/; {----->
            IFEND;
          IFEND;

          IF dmv$active_volume_table.table_p^ [p_fmd^.avt_index].mass_storage.volume_unavailable THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
                  'volume unavailable - dmp$allocate_file_space_r1', status);
            EXIT /file_descriptor_locked/; {----->
          IFEND;

          {The following must be done AFTER a volume is assigned
          { so that p_fde^.bytes_per_allocation has been set.

          bytes_per_allocation := p_dfd^.bytes_per_allocation;
          byte_address := byte_address DIV bytes_per_allocation * bytes_per_allocation;
          allocation_end := (requested_allocation_end + bytes_per_allocation - 1) DIV bytes_per_allocation *
                bytes_per_allocation;

          { Force sequential allocation for permanent files.

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

          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
            {Desire is that they will reside on the same cylinder

            dmp$get_mat_pointer (p_fmd^.avt_index, p_mat);
            bytes_per_position := (p_mat^.daus_per_position * p_mat^.bytes_per_dau) DIV bytes_per_allocation *
                  bytes_per_allocation;
            byte_address := byte_address DIV bytes_per_position * bytes_per_position;
            maximum_size := dmc$level_1_table_size * p_dfd^.bytes_per_level_2;

            IF (allocation_end < maximum_size) THEN
              allocation_end := (allocation_end + bytes_per_position - 1) DIV bytes_per_position *
                    bytes_per_position;
              IF (allocation_end > maximum_size) THEN
                allocation_end := maximum_size;
              IFEND;
            IFEND;
          IFEND;

          requested_allocation := allocation_end - byte_address;

          dmp$create_fau_entry (p_dfd, byte_address, requested_allocation);

          monitor_request_block.requested_allocation := requested_allocation;
          monitor_request_block.allocate_byte_address := byte_address;
          monitor_request_block.file_space_limit := file_space_limit;

          i#call_monitor (#LOC (monitor_request_block), #SIZE (monitor_request_block));

          byte_address := byte_address + monitor_request_block.allocation_units_obtained *
                bytes_per_allocation;

          IF (monitor_request_block.status = dmc$fas_file_allocated) OR
                (monitor_request_block.status = dmc$fas_account_limit_exceeded) OR
                (byte_address >= allocation_end) THEN
            status.normal := TRUE;
            EXIT /allocate_loop/; {----->
          ELSE
            osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space, '', status);
          IFEND;

          IF NOT dmv$vol_space_manage_initiated THEN
            EXIT /allocate_loop/; {----->
          IFEND;

          { If some space was obtained and volume overflow was not indicated, try again after calling
          { pmp$cycle to allow other Device Manager tasks to run. The allocation may have been incomplete
          { because the allocation log was full. If so, the allocation log splitting task will have run
          { and additional allocation will be obtained on the next try.

          IF (monitor_request_block.allocation_units_obtained > 0) AND
                NOT monitor_request_block.overflow_indicator THEN
            pmp$cycle (local_status);
            CYCLE /allocate_loop/; {----->
          IFEND;

{         Unable to allocate all space from the assigned volume's mainframe allocation table.
{         This situation can occur for one of two reasons :
{           1.  The mainframe has run out of space and must get more space from the volume,
{           2.  The mainframe has run out of space and cannot get more space because the volume is out
{               of space (overflow situation).
{
{         IF an overflow situation exists and the file is allowed to overflow, overflow processing
{         proceeds. IF an overflow situation exists and the file is not allowed to overflow, the wait
{         option is processed.

          IF temporary_file THEN
            allow_overflow := file_allows_overflow AND dmv$temporary_file_overflow;
          ELSE
            allow_overflow := file_allows_overflow AND dmv$permanent_file_overflow;
          IFEND;

          IF monitor_request_block.overflow_indicator AND allow_overflow THEN
            overflow_volume (system_file_id, p_fde, p_dfd, status);
            IF status.normal THEN
              CYCLE /allocate_loop/; {----->
            IFEND;
          IFEND;

          IF (wait_option <> osc$wait) THEN
            EXIT /allocate_loop/; {----->
          IFEND;

          gfp$unlock_fde_p (p_fde);

          pmp$delay (allocator_delay_time {milliseconds} , status);

          gfp$get_locked_fde_p (system_file_id, p_fde);
          IF p_fde = NIL THEN
            EXIT /process_request/; {----->
          IFEND;

        WHILEND /allocate_loop/;
      END /file_descriptor_locked/;

      gfp$unlock_fde_p (p_fde);

    END /process_request/;

    IF NOT status.normal THEN
      IF (status.condition = dme$fmd_overflow) THEN {max fmds has been reached...}
        osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space, status.text.value,
              status);
      IFEND;
    IFEND;

  PROCEND dmp$allocate_file_space_r1;
?? TITLE := '  dmp$create_mat', EJECT ??
{
{    The purpose of this request is to create a mainframe allocation table
{  (MAT) for a mass storage volume.
{
{        DMP$CREATE_MAT (AVT_INDEX, DAT_SFID, P_MAT, STATUS)
{
{  AVT_INDEX: (input)  This parameter specifies the active volume table index
{                      assigned to the mass storage volume.
{
{  DAT_SFID: (input)  This parameter specifies the SFID of the DAT for the
{                     mass storage volume.
{
{  P_MAT: (output)  This parameter returns a generic adaptable array pointer
{                   to the mainframe allocation table created for the mass
{                   storage volume.
{
{  STATUS: (output)  This parameter returns the request status.
{

  PROCEDURE [XDCL] dmp$create_mat
    (    avt_index: dmt$active_volume_table_index;
         dat_sfid: gft$system_file_identifier;
     VAR p_mat: cyt$adaptable_array_pointer;
     VAR status: ost$status);

    VAR
      converter: dmt$mat_converter,
      p_dat: ^dmt$ms_device_allocation_table;

    dmp$open_dat (dat_sfid, osc$os_ring_1, osc$tsrv_ring, mmc$sar_write_extend, mmc$as_sequential, p_dat,
          status);

    IF status.normal THEN
      osp$set_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);

      create_mat (p_dat, avt_index, converter.p_mat);
      p_mat := converter.p_adaptable;

      osp$clear_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);
      dmp$close_file (p_dat, status);
    IFEND;

  PROCEND dmp$create_mat;
?? TITLE := '  dmp$delete_mat', EJECT ??
{
{   The purpose of this request is to delete a mainframe allocation table (MAT)
{ and its suborinate tables. The MAT pointer is checked for NIL on input and
{ set to NIL on output.
{
{       DMP$DELETE_MAT (P_MAT)
{
{ P_MAT: (input, output)  This parameter is a generic adaptable array pointer identifying the MAT to
{         be deleted. If it is NIL, no operation is performed. This parameter is set to NIL on output.

  PROCEDURE [XDCL] dmp$delete_mat
    (VAR p_mat {input, output} : cyt$adaptable_array_pointer);

    VAR
      converter: dmt$mat_converter;

    converter.p_adaptable := p_mat;
    IF (converter.p_mat <> NIL) THEN
      IF (converter.p_mat^.p_available_daus <> NIL) THEN
        FREE converter.p_mat^.p_available_daus IN osv$mainframe_wired_heap^;
      IFEND;
      FREE converter.p_mat IN osv$mainframe_wired_heap^;
      p_mat := converter.p_adaptable;
    IFEND;

  PROCEND dmp$delete_mat;
?? TITLE := '  assign_volume', EJECT ??

  PROCEDURE assign_volume
    (    system_file_id: gft$system_file_identifier;
         p_fde: ^gft$file_descriptor_entry;
         p_dfd: ^dmt$disk_file_descriptor;
         p_fmd: ^dmt$file_medium_descriptor;
     VAR status: ost$status);

    VAR
      allocation_style: dmt$allocation_styles,
      avt_index: dmt$active_volume_table_index,
      bytes_per_allocation_unit: dmt$bytes_per_allocation,
      byte_address: amt$file_byte_address,
      dfl_index: dmt$device_file_list_index,
      exact_style: boolean,
      file_kind: gft$file_kind,
      p_mat: ^dmt$mainframe_allocation_table,
      log_entry: dmt$dl_entry,
      requested_bytes_per_allocation: dmt$allocation_size,
      requested_daus_per_transfer: dmt$daus_per_transfer,
      transfer_style: dmt$allocation_styles,
      volume_selector: t$volume_selector;

    status.normal := TRUE;

    dfl_index := 0;

  /assign_volume_to_file/
    BEGIN
      file_kind := p_fde^.file_kind;

      {The following limits the maximum allocation size.  This is done in an attempt
      {to allow most devices to be candidates for creation of overflow of large
      {allocation size files.  Only 844 and 834 devices are excluded from use by
      {the default maximum of 256K.  The default allocation size of 16384 works
      {on all devices.  A file can overflow only to devices that allow the same
      {allocation size.  Depending on the value of dmv$maximum_allocation_size
      {there can be some wasted space at the end of a cylinder.  There is no waste
      {with 16384 allocation.  Unless dmv$maximum_allocation_size is changed it is
      {no longer possible to use all of a cylinder (e.g. not waste space).  However,
      {if it is changed to allow full cylinder allocation, then the devices that can
      {be used for overflow are restricted.

      IF p_dfd^.bytes_per_allocation = 0 THEN
        {Limit file creation allocations to a setsa controlled value
        IF p_dfd^.requested_allocation_size > dmv$maximum_allocation_size THEN
          requested_bytes_per_allocation := dmv$maximum_allocation_size;
        ELSE
          requested_bytes_per_allocation := p_dfd^.requested_allocation_size;
        IFEND;
      ELSE
        {Limit file overflow allocation to equal current allocation
        requested_bytes_per_allocation := p_dfd^.bytes_per_allocation;
      IFEND;

{ build volume selector
      volume_selector.class := p_dfd^.requested_class;
      volume_selector.class_ordinal := p_dfd^.requested_class_ordinal;

      volume_selector.recorded_vsn := p_dfd^.requested_volume.recorded_vsn;
      volume_selector.set_name := p_dfd^.requested_volume.setname;

      volume_selector.force_allocation_size := (p_dfd^.bytes_per_allocation <> 0);
      volume_selector.allocation_size := requested_bytes_per_allocation;

{If all volumes that support the current size of a file are out of space, then the allocate
{will hang waiting for space.  Cannot overflow to different allocation size.

      select_volume (volume_selector, avt_index, status);
      IF status.normal = FALSE THEN
        EXIT /assign_volume_to_file/; {----->
      IFEND;

      dmp$get_mat_pointer (avt_index, p_mat);

{ reserve device file list entry, if necessary.
      IF (file_kind <= gfc$fk_last_permanent_file) THEN
        dmp$get_unused_mfl_entry (avt_index, dfl_index, status);
        IF NOT status.normal THEN
          EXIT /assign_volume_to_file/; {----->
        IFEND;
      IFEND;

      p_fmd^.dfl_index := dfl_index;
      p_fmd^.internal_vsn := dmv$active_volume_table.table_p^ [avt_index].mass_storage.internal_vsn;
      p_fmd^.avt_index := avt_index;
      p_dfd^.dfd_modified := TRUE;
      p_dfd^.fmd_modified := TRUE;

      determine_allocation_style (p_mat, requested_bytes_per_allocation, allocation_style, exact_style);

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

      p_dfd^.bytes_per_allocation := bytes_per_allocation_unit;

{Force level 2 tables to be "full" - actually, convert to real allocation size
      p_dfd^.bytes_per_level_2 := bytes_per_allocation_unit * (dmc$bytes_per_level_2 DIV 16384);

      IF (p_dfd^.requested_transfer_size = dmc$unspecified_transfer_size) THEN
        p_dfd^.requested_transfer_size := p_mat^.default_transfer_size;
      IFEND;

      IF (file_kind <= gfc$fk_last_permanent_file) THEN
        dmp$get_total_allocated_length (p_fde, byte_address);
        log_entry.kind := dmc$dl_create;
        log_entry.create_block.global_file_name := p_fde^.global_file_name;
        log_entry.create_block.dfl_index := dfl_index;
        log_entry.create_block.mainframe_assigned := dmv$active_volume_table.table_p^ [avt_index].
              mass_storage.mainframe_assigned;
        log_entry.create_block.daus_per_allocation := p_mat^.daus_per_allocation_unit [allocation_style];
        log_entry.create_block.file_kind := p_fde^.file_kind;
        log_entry.create_block.fmd_byte_address := byte_address;
        dmp$process_device_log_entry (avt_index, log_entry, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

      p_fmd^.system_file_id := system_file_id;
      p_fmd^.bytes_per_mau := p_mat^.bytes_per_mau;
      p_fmd^.daus_per_cylinder := p_mat^.daus_per_position;
      p_fmd^.maus_per_dau := p_mat^.maus_per_dau;
      p_fmd^.daus_per_allocation_unit := (p_dfd^.bytes_per_allocation DIV p_fmd^.bytes_per_mau) DIV
            p_fmd^.maus_per_dau;
      p_fmd^.allocation_style := allocation_style;
      requested_daus_per_transfer := requested_bytes_per_allocation DIV
            (p_fmd^.bytes_per_mau * p_fmd^.maus_per_dau);

    /transfer_style_search/
      FOR transfer_style := dmc$a0 TO allocation_style DO
        IF requested_daus_per_transfer < p_mat^.daus_per_allocation_unit [transfer_style] THEN
          EXIT /transfer_style_search/; {----->
        IFEND;
      FOREND /transfer_style_search/;

      p_fmd^.maus_per_transfer_unit := p_mat^.daus_per_allocation_unit [transfer_style] * p_fmd^.maus_per_dau;

      p_fmd^.volume_assigned := TRUE;
      p_fde^.allocation_unit_size := p_dfd^.bytes_per_allocation;
      p_fde^.transfer_unit_size := p_dfd^.requested_transfer_size;

    END /assign_volume_to_file/;

  PROCEND assign_volume;
?? TITLE := '  create_dfl_entry', EJECT ??

  PROCEDURE create_dfl_entry
    (    first_dau_address: dmt$dau_address;
         dflt_sfid: gft$system_file_identifier;
         global_file_name: ost$binary_unique_name,
         file_hash: dmt$file_hash;
         allocated_length: amt$file_byte_address;
         daus_per_allocation: dmt$daus_per_allocation;
         avt_index: dmt$active_volume_table_index;
     VAR dfl_index: dmt$device_file_list_index;
     VAR status: ost$status);

    VAR
      p_dflt: ^dmt$ms_device_file_list_table,
      available_dfl_entry_index: dmt$device_file_list_index,
      status_p: ^ost$status;

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

  /dflt_open/
    BEGIN
      osp$set_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);

    /dflt_locked/
      BEGIN
        available_dfl_entry_index := 0;

      /find_available_dfl_entry/
        FOR dfl_index := 1 TO UPPERBOUND (p_dflt^.entries) DO
          IF p_dflt^.entries [dfl_index].flags = dmc$dfle_available THEN
            available_dfl_entry_index := dfl_index;
            EXIT /find_available_dfl_entry/; {----->
          IFEND;
        FOREND /find_available_dfl_entry/;

        dfl_index := available_dfl_entry_index;

        IF dfl_index = 0 THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$no_dfl_entries_available, '', status);
        ELSE
          p_dflt^.entries [dfl_index].flags := dmc$dfle_assigned_to_file;
          p_dflt^.entries [dfl_index].dau_chain_status := dmc$dau_chain_linked;
          p_dflt^.entries [dfl_index].file_byte_address := 0;
          p_dflt^.entries [dfl_index].file_hash := file_hash;
          p_dflt^.entries [dfl_index].file_kind := gfc$fk_device_file;
          p_dflt^.entries [dfl_index].global_file_name := global_file_name;
          p_dflt^.entries [dfl_index].end_of_information := allocated_length;
          p_dflt^.entries [dfl_index].end_of_file := allocated_length;
          p_dflt^.entries [dfl_index].login_set := $dmt$dfl_login_set [];
          p_dflt^.entries [dfl_index].first_dau_address := first_dau_address;
          p_dflt^.entries [dfl_index].daus_per_allocation_unit := daus_per_allocation;
          p_dflt^.entries [dfl_index].fmd_length := allocated_length;
          p_dflt^.entries [dfl_index].logical_length := allocated_length;
        IFEND;

      END /dflt_locked/;

      osp$clear_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);
      mmp$write_modified_pages (p_dflt, #SIZE (p_dflt^), osc$wait, status);
    END /dflt_open/;

    if status.normal then
      status_p:= ^status;
    else
      push status_p;
    ifend;

    dmp$close_file (p_dflt, status_p^);

  PROCEND create_dfl_entry;
?? TITLE := '  create_mat', EJECT ??

  PROCEDURE create_mat
    (    p_dat: ^dmt$ms_device_allocation_table;
         avt_index: dmt$active_volume_table_index;
     VAR p_mat: ^dmt$mainframe_allocation_table);

    VAR
      mat_entry: dmt$mat_entry,
      p_available_daus: ^dmt$available_daus,
      position: dmt$device_position,
      positions_per_device: dmt$device_position,
      daus_per_position: dmt$daus_per_position,
      daus_per_device: dmt$dau_address,
      minimum_threshold: dmt$dau_address,
      dau: dmt$dau_address,
      last_dau: dmt$dau_address,
      bytes_per_dau: dmt$bytes_per_dau,
      bytes_per_position: dmt$bytes_per_allocation,
      file_kind: gft$file_kind,
      dau_status_counts: dmt$dau_status_counts,
      allocation_style: dmt$allocation_styles;

    positions_per_device := p_dat^.header.positions_per_device;
    daus_per_position := p_dat^.header.daus_per_position;
    daus_per_device := positions_per_device * daus_per_position;
    bytes_per_dau := p_dat^.header.bytes_per_dau;

    ALLOCATE p_mat: [0 .. positions_per_device - 1] IN osv$mainframe_wired_heap^;

    p_mat^.avt_index := avt_index;
    p_mat^.bytes_per_dau := bytes_per_dau;
    p_mat^.bytes_per_mau := p_dat^.header.bytes_per_mau;
    p_mat^.maus_per_dau := p_dat^.header.maus_per_dau;
    p_mat^.daus_per_position := daus_per_position;
    p_mat^.positions_per_device := positions_per_device;
    p_mat^.starting_position_number := 0;
    p_mat^.starting_search_position := 0;
    p_mat^.daus_per_allocation_unit := p_dat^.header.daus_per_allocation_style;

    IF (p_dat^.header.default_allocation_size = dmc$unspecified_allocation_size) THEN {upgrade 1.3.1}
      p_mat^.default_allocation_size := dmc$default_req_alloc_size;
    ELSE
      p_mat^.default_allocation_size := p_dat^.header.default_allocation_size;
    IFEND;

    IF (p_dat^.header.default_transfer_size = dmc$unspecified_transfer_size) THEN {upgrade 1.3.1}
      IF p_dat^.header.positions_per_device = 884 THEN {temporary kludge for HYDRA}
        p_mat^.default_transfer_size := dmc$default_transfer_size_887;
      ELSE
        p_mat^.default_transfer_size := dmc$default_req_transfer_size;
      IFEND;
    ELSE
      p_mat^.default_transfer_size := p_dat^.header.default_transfer_size;
    IFEND;

    FOR allocation_style := LOWERVALUE (allocation_style) TO UPPERVALUE (allocation_style) DO
      p_mat^.available_allocation_units [allocation_style] := 0;
      p_mat^.allocation_chains [allocation_style] := dmc$nil_position_link;
    FOREND;

    p_mat^.minimum_space := daus_per_device DIV 4;
    p_mat^.maximum_space := 3 * p_mat^.minimum_space;
    p_mat^.available_space := 0;
    p_mat^.leftover_space := 0;

    FOR file_kind := LOWERVALUE (file_kind) TO UPPERVALUE (file_kind) DO
      p_mat^.allocated_space [file_kind] := 0;
    FOREND;

    p_mat^.mat_too_full := FALSE;
    p_mat^.available_dat_space := p_dat^.header.available;
    p_mat^.dat_threshold := 0;
    p_mat^.recovery_threshold := p_dat^.header.recovery_threshold;
    p_mat^.warning_threshold := p_dat^.header.warning_threshold;

{ Make sure the MAT recovery threshold for the system device is enough to support deadstart.

    IF (dmv$active_volume_table.table_p^ [avt_index].logical_unit_number = dmv$system_device_lun) THEN
      bytes_per_position := bytes_per_dau * daus_per_position;
      minimum_threshold := (dmv$deadstart_disk_space + bytes_per_position - 1) DIV bytes_per_position *
            daus_per_position;
      IF (p_mat^.recovery_threshold < minimum_threshold) THEN
        p_mat^.recovery_threshold := minimum_threshold;
      IFEND;
    IFEND;

    last_dau := daus_per_device - 1;
    ALLOCATE p_available_daus: [0 .. last_dau] IN osv$mainframe_wired_heap^;
    p_mat^.p_available_daus := p_available_daus;

    i#fill ($CHAR (0), ^p_available_daus^, #SIZE (p_available_daus^));

    mat_entry.available_allocation_units := 0;
    mat_entry.backward_link := dmc$nil_position_link;
    mat_entry.forward_link := dmc$nil_position_link;

    FOR position := 0 TO positions_per_device - 1 DO
      dmp$analyze_dat_position (p_dat, position, mat_entry.allocation_style, dau_status_counts);
      p_mat^.mat_entries [position] := mat_entry;
    FOREND;

  PROCEND create_mat;
?? TITLE := '  dat_allocate', EJECT ??

  PROCEDURE dat_allocate
    (    avt_index: dmt$active_volume_table_index;
         dat_sfid: gft$system_file_identifier;
         file_hash: dmt$file_hash;
         dfl_index: dmt$device_file_list_index;
         daus_per_allocation: dmt$daus_per_allocation;
         p_allocation_list: ^t$allocation_list;
     VAR status: ost$status);

    VAR
      allocation_chain_position: dmt$allocation_chain_position,
      dau: dmt$dau_address,
      daus_allocated: dmt$dau_address,
      first_dau: dmt$dau_address,
      high_index: integer,
      index: integer,
      last_dau: dmt$dau_address,
      low_index: integer,
      next_dau: dmt$dau_address,
      p_dat: ^dmt$ms_device_allocation_table,
      status_p: ^ost$status;

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

    osp$set_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);

    low_index := LOWERBOUND (p_allocation_list^);
    high_index := UPPERBOUND (p_allocation_list^);
    next_dau := 0;

    FOR index := high_index DOWNTO low_index DO
      allocation_chain_position := dmc$middle_allocation;
      first_dau := p_allocation_list^ [index];
      FOR dau := first_dau TO first_dau + daus_per_allocation - 1 DO
        p_dat^.body [dau].dau_status := dmc$dau_assigned_to_file;
        p_dat^.body [dau].file_hash := file_hash;
        p_dat^.body [dau].data_status := dmc$dau_data_initialized;
        p_dat^.body [dau].allocation_chain_position := allocation_chain_position;
        IF (allocation_chain_position = dmc$middle_allocation) THEN
          p_dat^.body [dau].next_allocation_unit_dau := next_dau;
        IFEND;
        allocation_chain_position := dmc$part_of_allocation_unit;
      FOREND;
      next_dau := first_dau;
    FOREND;

    first_dau := p_allocation_list^ [low_index];
    last_dau := p_allocation_list^ [high_index];
    IF (first_dau = last_dau) THEN
      p_dat^.body [last_dau].allocation_chain_position := dmc$first_and_last_allocation;
    ELSE
      p_dat^.body [first_dau].allocation_chain_position := dmc$first_allocation;
      p_dat^.body [last_dau].allocation_chain_position := dmc$last_allocation;
    IFEND;
    p_dat^.body [last_dau].high_dfl_index := dfl_index DIV dmc$dfl_index_converter;
    p_dat^.body [last_dau].low_dfl_index := dfl_index MOD dmc$dfl_index_converter;

    daus_allocated := (high_index - low_index + 1) * daus_per_allocation;
    p_dat^.header.available := p_dat^.header.available - daus_allocated;

    osp$clear_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);
    mmp$write_modified_pages (p_dat, #SIZE (p_dat^), osc$wait, status);

    if status.normal then
      status_p:= ^status;
    else
      push status_p;
    ifend;

    dmp$close_file (p_dat, status_p^);

  PROCEND dat_allocate;
?? TITLE := '  dat_deallocate', EJECT ??

  PROCEDURE dat_deallocate
    (    dat_sfid: gft$system_file_identifier;
         file_hash: dmt$file_hash;
         daus_per_allocation_unit: dmt$daus_per_allocation;
         first_dau_address: dmt$dau_address;
         avt_index: dmt$active_volume_table_index;
     VAR status: ost$status);

    VAR
      p_dat: ^dmt$ms_device_allocation_table,
      dau_offset: dmt$daus_per_allocation,
      dau_count: dmt$dau_address,
      deallocate_complete: boolean,
      next_allocation_unit_dau: dmt$dau_address,
      current_allocation_unit_dau: dmt$dau_address,
      dau_index: dmt$dau_address,
      status_p: ^ost$status;

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

    osp$set_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);

  /device_file_deallocate/
    BEGIN

      dau_count := 0;
      deallocate_complete := FALSE;
      next_allocation_unit_dau := first_dau_address;

      REPEAT

        current_allocation_unit_dau := next_allocation_unit_dau;

        FOR dau_offset := 1 TO daus_per_allocation_unit DO
          dau_index := current_allocation_unit_dau + dau_offset - 1;

          IF p_dat^.body [dau_index].dau_status <> dmc$dau_assigned_to_file THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken,
                  'dau not assigned to file - dat_deallocate', status);
            EXIT /device_file_deallocate/; {----->
          IFEND;

          IF (p_dat^.body [dau_index].file_hash <> file_hash)
{       } AND (gff$old_file_hash (p_dat^.body [dau_index].file_hash) <> gff$old_file_hash (file_hash)) THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken,
                  'dau/file hash mismatch - dat_deallocate', status);
            EXIT /device_file_deallocate/; {----->
          IFEND;

          CASE p_dat^.body [dau_index].allocation_chain_position OF
          = dmc$first_and_last_allocation, dmc$last_allocation =
            IF dau_offset <> 1 THEN
              osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken,
                    '1st & last dau_offset <> 1 - dat_deallocate', status);
              EXIT /device_file_deallocate/; {----->
            IFEND;
            deallocate_complete := TRUE;
          = dmc$first_allocation, dmc$middle_allocation =
            IF dau_offset <> 1 THEN
              osp$set_status_abnormal (dmc$device_manager_ident, dme$allocation_chain_broken,
                    '1st dau_offset <> 1 - dat_deallocate', status);
              EXIT /device_file_deallocate/; {----->
            IFEND;
            next_allocation_unit_dau := p_dat^.body [dau_index].next_allocation_unit_dau;
          = dmc$part_of_allocation_unit =
            ;
          CASEND;

          p_dat^.body [dau_index].dau_status := dmc$dau_usable;
          dau_count := dau_count + 1;

        FOREND;

      UNTIL deallocate_complete;

    END /device_file_deallocate/;

    p_dat^.header.available := p_dat^.header.available + dau_count;

    osp$clear_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);

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

    mmp$write_modified_pages (p_dat, #SIZE (p_dat^), osc$wait, status_p^);
    IF NOT status.normal THEN {The status was aready bad or it's now from above.
      PUSH status_p; {If everything went wrong, we might push status_p twice. Bug who cares then?
    IFEND;

    dmp$close_file (p_dat, status_p^);

  PROCEND dat_deallocate;
?? TITLE := '  delete_dfl_entry', EJECT ??

  PROCEDURE delete_dfl_entry
    (    dflt_sfid: gft$system_file_identifier;
         dfl_index: dmt$device_file_list_index;
         avt_index: dmt$active_volume_table_index;
     VAR status: ost$status);

    VAR
      p_dflt: ^dmt$ms_device_file_list_table,
      status_p: ^ost$status;

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

      osp$set_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);

      p_dflt^.entries [dfl_index].flags := dmc$dfle_available;

      osp$clear_mainframe_sig_lock (dmv$active_volume_table.table_p^ [avt_index].mass_storage.update_lock);
      mmp$write_modified_pages (p_dflt, #SIZE (p_dflt^), osc$wait, status);

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

    dmp$close_file (p_dflt, status_p^);

  PROCEND delete_dfl_entry;
?? TITLE := '  determine_allocation_style', EJECT ??

  PROCEDURE [INLINE] determine_allocation_style
    (    p_mat: ^dmt$mainframe_allocation_table;
         allocation_size: dmt$allocation_size;
     VAR allocation_style: dmt$allocation_styles;
     VAR exact_style: boolean);

    VAR
      bytes_per_allocation: dmt$allocation_size,
      bytes_per_dau: dmt$bytes_per_dau,
      daus_per_allocation: dmt$daus_per_allocation,
      style: dmt$allocation_styles;

    allocation_style := LOWERVALUE (style);
    bytes_per_dau := p_mat^.bytes_per_dau;

    IF (allocation_size = dmc$unspecified_allocation_size) THEN
      bytes_per_allocation := p_mat^.default_allocation_size;
    ELSE
      bytes_per_allocation := allocation_size;
    IFEND;

    IF (bytes_per_allocation < dmc$default_req_alloc_size) THEN
      bytes_per_allocation := dmc$default_req_alloc_size;
    IFEND;

    daus_per_allocation := (bytes_per_allocation + bytes_per_dau - 1) DIV bytes_per_dau;

    FOR style := LOWERVALUE (style) TO UPPERVALUE (style) DO
      IF (daus_per_allocation >= p_mat^.daus_per_allocation_unit [style]) THEN
        allocation_style := style;
      IFEND;
    FOREND;

    bytes_per_allocation := p_mat^.daus_per_allocation_unit [allocation_style] * bytes_per_dau;
    exact_style := (allocation_size = bytes_per_allocation);
  PROCEND determine_allocation_style;
?? TITLE := '  find_allocation', EJECT ??

  PROCEDURE find_allocation
    (    dat_sfid: gft$system_file_identifier;
         p_mat: ^dmt$mainframe_allocation_table;
         allocation_style: dmt$allocation_styles;
         daus_per_allocation: dmt$daus_per_allocation;
         p_allocation_list: ^t$allocation_list;
     VAR status: ost$status);

    VAR
      allocation_found: boolean,
      assigned_style: dmt$allocation_styles,
      bytes_found: integer,
      bytes_needed: integer,
      bytes_per_allocation: dmt$allocation_size,
      dau: dmt$dau_address,
      dau_limit: dmt$dau_address,
      dau_status_counts: dmt$dau_status_counts,
      daus_per_position: dmt$daus_per_position,
      first_dau: dmt$dau_address,
      high_index: integer,
      index: integer,
      low_index: integer,
      msg: string (80),
      msgl: integer,
      next_dau: dmt$dau_address,
      p_dat: ^dmt$ms_device_allocation_table,
      position: dmt$device_position,
      position_dau_limit: dmt$dau_address,
      positions_per_device: dmt$device_position,
      verify_index: integer,
      vsn: rmt$recorded_vsn;

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

    low_index := LOWERBOUND (p_allocation_list^);
    index := low_index;
    verify_index := low_index;
    high_index := UPPERBOUND (p_allocation_list^);
    positions_per_device := p_mat^.positions_per_device;
    daus_per_position := p_mat^.daus_per_position;
    position_dau_limit := daus_per_position DIV daus_per_allocation * daus_per_allocation;
    position := 0;

    REPEAT
      dmp$analyze_dat_position (p_dat, position, assigned_style, dau_status_counts);

      IF (dau_status_counts [dmc$dau_usable] <> 0) AND ((assigned_style = allocation_style) OR
            (assigned_style = dmc$acyl)) THEN
        dau := position * daus_per_position;
        dau_limit := dau + position_dau_limit;

        REPEAT
          first_dau := dau;
          next_dau := first_dau + daus_per_allocation;

          REPEAT
            allocation_found := (p_dat^.body [dau].dau_status = dmc$dau_usable);
            dau := dau + 1;
          UNTIL NOT allocation_found OR (dau >= next_dau);

          IF allocation_found THEN
            p_allocation_list^ [index] := first_dau;
            index := index + 1;
            IF (index > high_index) THEN
              verify_allocation (p_mat, daus_per_allocation, p_allocation_list, verify_index, index);
              verify_index := index;
            IFEND;
          IFEND;

          dau := next_dau;
        UNTIL (dau >= dau_limit) OR (index > high_index);
      IFEND;

      position := position + 1;
    UNTIL (index > high_index) OR (position >= p_mat^.positions_per_device);

    dmp$close_file (p_dat, status);

    IF (index <= high_index) THEN
      vsn := dmv$active_volume_table.table_p^ [p_mat^.avt_index].mass_storage.recorded_vsn;
      bytes_per_allocation := p_mat^.bytes_per_dau * daus_per_allocation;
      bytes_needed := (high_index - low_index + 1) * bytes_per_allocation;
      bytes_found := (index - low_index) * bytes_per_allocation;
      STRINGREP (msg, msgl, 'Volume ', vsn, ' out of space (need', bytes_needed, ' bytes, found', bytes_found,
            ').');
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space, msg (1, msgl),
            status);
    IFEND;

  PROCEND find_allocation;
?? TITLE := '  get_volume_list', EJECT ??

  PROCEDURE get_volume_list
    (    volume_selector: t$volume_selector;
         p_volume_list: ^array [1 .. * ] of dmt$active_volume_table_index;
     VAR volume_count: dmt$active_volume_table_index);

    VAR
      any_set: boolean,
      avt_index: dmt$active_volume_table_index,
      bytes: amt$file_byte_address,
      candidate: boolean,
      check_style: boolean,
      cylinders: dmt$dau_address,
      daus_per_unit: dmt$dau_address,
      exact_style: boolean,
      last_try: boolean,
      maximum_bytes: amt$file_byte_address,
      normal: boolean,
      p_avt: ^dmt$active_volume_table_entries,
      p_mat: ^dmt$mainframe_allocation_table,
      set_name: stt$set_name,
      style: dmt$allocation_styles,
      units: dmt$dau_address,
      units_per_cylinder: dmt$dau_address;

    volume_count := 0;
    maximum_bytes := 1;
    set_name := volume_selector.set_name;
    any_set := (set_name = osc$null_name);
    last_try := TRUE;
    p_avt := dmv$active_volume_table.table_p;

    REPEAT
      last_try := NOT last_try;
      check_style := volume_selector.force_allocation_size OR last_try;
      FOR avt_index := LOWERBOUND (p_avt^) TO UPPERBOUND (p_avt^) DO
        candidate := NOT p_avt^ [avt_index].entry_available

        AND p_avt^ [avt_index].mass_storage.allocation_allowed AND
              NOT p_avt^ [avt_index].mass_storage.volume_unavailable

        AND (volume_selector.class IN p_avt^ [avt_index].mass_storage.class)

        AND (any_set OR (set_name = p_avt^ [avt_index].mass_storage.set_name));

        IF candidate THEN
          normal := NOT p_avt^ [avt_index].mass_storage.space_gone AND
                NOT p_avt^ [avt_index].mass_storage.space_low;
          candidate := normal OR last_try;
        IFEND;

        IF candidate AND check_style THEN
          dmp$get_mat_pointer (avt_index, p_mat);
          determine_allocation_style (p_mat, volume_selector.allocation_size, style, exact_style);
          candidate := NOT volume_selector.force_allocation_size OR exact_style;
          IF candidate AND last_try THEN
            daus_per_unit := p_mat^.daus_per_allocation_unit [style];
            cylinders := p_mat^.available_allocation_units [dmc$acyl];
            units_per_cylinder := p_mat^.daus_per_position DIV daus_per_unit;
            units := p_mat^.available_allocation_units [style] + cylinders * units_per_cylinder;
            bytes := units * daus_per_unit * p_mat^.bytes_per_dau;
            candidate := (bytes >= maximum_bytes);
            IF (bytes > maximum_bytes) THEN
              maximum_bytes := bytes;
              volume_count := 0;
            IFEND;
          IFEND;
        IFEND;

        IF candidate THEN
          volume_count := volume_count + 1;
          p_volume_list^ [volume_count] := avt_index;
        IFEND;
      FOREND;
    UNTIL (volume_count > 0) OR last_try;
  PROCEND get_volume_list;
?? TITLE := '  overflow_volume', EJECT ??

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

    VAR
      able_to_reserve_fmd: boolean,
      fmd_index: dmt$fmd_index,
      p_fmd: ^dmt$file_medium_descriptor;

    status.normal := TRUE;

  /process_request/
    BEGIN
      dmp$reserve_fmd (p_dfd, fmd_index, able_to_reserve_fmd);
      IF NOT able_to_reserve_fmd THEN
        dmp$increase_fmd_count (sfid, p_dfd, status);
        IF NOT status.normal THEN
          EXIT /process_request/; {----->
        IFEND;
        dmp$reserve_fmd (p_dfd, fmd_index, able_to_reserve_fmd);
        IF NOT able_to_reserve_fmd THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$fmd_overflow,
                'Unable to obtain a free FMD - overflow_volume.', status);
          EXIT /process_request/; {----->
        IFEND;
      IFEND;
      p_dfd^.current_fmd_index := fmd_index;

      p_dfd^.requested_volume.recorded_vsn := '      ';

      dmp$get_fmd_by_index (p_dfd, fmd_index, p_fmd);

      assign_volume (sfid, p_fde, p_dfd, p_fmd, status);

    END /process_request/;

  PROCEND overflow_volume;
?? TITLE := '  select_best_volume', EJECT ??

  PROCEDURE select_best_volume
    (    volume_selector: t$volume_selector;
     VAR avt_index: dmt$active_volume_table_index;
     VAR status: ost$status);

    VAR
      selector: t$volume_selector,
      volume_count: dmt$active_volume_table_index,
      p_volume_list: ^array [1 .. * ] of dmt$active_volume_table_index,
      class_ordinal: dmt$class_ordinal,
      index: dmt$active_volume_table_index,
      system_class: dmt$system_class,
      able_to_lock: boolean,
      able_to_clear: boolean,
      class_count: integer,
      low_class_count: integer,
      selected_index: dmt$active_volume_table_index;

    status.normal := TRUE;
    class_ordinal := volume_selector.class_ordinal;

    PUSH p_volume_list: [1 .. UPPERBOUND (dmv$active_volume_table.table_p^)];

    get_volume_list (volume_selector, p_volume_list, volume_count);

    { The following block of code is part of the DISTRIBUTE FILES feature.  It
    { is an attempt to evenly distribute files on the volumes by selecting the
    { volume with the lowest system_class_activity.

    IF (volume_selector.class IN dmv$system_class) AND (class_ordinal = 0) AND (volume_count > 0) THEN
      system_class := dmv$system_class_conversion [volume_selector.class];
      low_class_count := UPPERVALUE (low_class_count);

      FOR index := LOWERBOUND (p_volume_list^) TO volume_count DO
        avt_index := p_volume_list^ [index];

        osp$get_locked_variable_value (dmv$active_volume_table.table_p^ [avt_index].mass_storage.
              system_class_activity [system_class], dmv$active_volume_table.table_p^ [avt_index].mass_storage.
              system_class_activity [system_class], class_count);
        IF (class_count <= low_class_count) THEN
          p_volume_list^ [1] := avt_index;
          low_class_count := class_count;
        IFEND;
      FOREND;

      volume_count := 1;
      avt_index := p_volume_list^ [volume_count];
      osp$increment_locked_variable (dmv$active_volume_table.table_p^ [avt_index].mass_storage.
            system_class_activity [system_class], low_class_count, class_count);
    IFEND;

{Add a critical device if necessary
    IF (volume_count = 0) AND (volume_selector.class = rmc$msc_system_critical_files) THEN
      osp$test_set_main_sig_lock (dmv$q_add_lock, able_to_lock);
      IF able_to_lock THEN
        selector := volume_selector;
        selector.class := dmc$default_class;
        get_volume_list (selector, p_volume_list, volume_count);

        IF (volume_count > 0) THEN
          avt_index := p_volume_list^ [1];
          dmp$add_class_to_volume (avt_index, $dmt$class [rmc$msc_system_critical_files] +
                dmv$active_volume_table.table_p^ [avt_index].mass_storage.class, status);
          IF status.normal THEN
            dmv$q_devices_added := dmv$q_devices_added + 1;
            volume_count := 1;
          ELSE
            volume_count := 0;
          IFEND;
        IFEND;
        osp$clear_mainframe_sig_lock (dmv$q_add_lock);
      IFEND;
    IFEND;

    {select a volume from the volume list

    IF (volume_count > 0) THEN
      IF (class_ordinal = 0) THEN
        selected_index := (dmv$volume_selector MOD volume_count) + 1;
      ELSE
        selected_index := 1 + ((class_ordinal - 1) MOD volume_count);
      IFEND;

      avt_index := p_volume_list^ [selected_index];
      dmv$volume_selector := dmv$volume_selector + 1;
    ELSE
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
            'No volume for file - select_best_volume.', status);
    IFEND;
  PROCEND select_best_volume;
?? TITLE := '  select_volume', EJECT ??

  PROCEDURE select_volume
    (    volume_selector: t$volume_selector;
     VAR avt_index: dmt$active_volume_table_index;
     VAR status: ost$status);

    VAR
      avt_entry_found: boolean,
      external_setname: stt$set_name,
      recorded_vsn: rmt$recorded_vsn,
      setname_supplied: boolean,
      recorded_vsn_supplied: boolean,
      allocation_allowed: boolean,
      selected_vol_attributes: array [1 .. 3] of dmt$assigned_ms_vol_attribute;

    status.normal := TRUE;

    avt_index := 0;

    external_setname := volume_selector.set_name;
    setname_supplied := (external_setname <> osc$null_name);

    recorded_vsn := volume_selector.recorded_vsn;
    recorded_vsn_supplied := (recorded_vsn <> '      ');

  /process_request/
    BEGIN
      IF recorded_vsn_supplied THEN
        selected_vol_attributes [1].keyword := dmc$ms_allocation_allowed;
        selected_vol_attributes [2].keyword := dmc$ms_volume_unavailable;
        selected_vol_attributes [3].keyword := dmc$avt_index;

        dmp$get_active_vol_attributes (recorded_vsn, avt_index, selected_vol_attributes, avt_entry_found);

        IF avt_entry_found THEN
          avt_index := selected_vol_attributes [3].index;
        ELSE
          osp$set_status_abnormal (dmc$device_manager_ident, dme$avt_entry_not_found,
                'AVT entry not found - select_volume.', status);
          osp$append_status_parameter (' ', recorded_vsn, status);
          EXIT /process_request/; {----->
        IFEND;

        IF setname_supplied THEN
          IF (external_setname <> dmv$active_volume_table.table_p^ [avt_index].mass_storage.set_name) THEN
            osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
                  'Volume not part of set - select_volume.', status);
            osp$append_status_parameter (' ', recorded_vsn, status);
            osp$append_status_parameter (' ', external_setname, status);
            EXIT /process_request/; {----->
          IFEND;
        IFEND;

        IF NOT (volume_selector.class IN dmv$active_volume_table.table_p^ [avt_index].mass_storage.class) THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$file_class_not_valid,
                'File class not valid on volume - select_volume.', status);
          osp$append_status_parameter (' ', recorded_vsn, status);
          EXIT /process_request/; {----->
        IFEND;

{       check volume_unavailable before allocation_allowed
        IF selected_vol_attributes [2].volume_unavailable THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$volume_unavailable, recorded_vsn, status);
          EXIT /process_request/; {----->
        IFEND;

        allocation_allowed := selected_vol_attributes [1].allocation_allowed;
        IF NOT allocation_allowed THEN
          osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_alloc_all_space,
                'Allocation not allowed on volume - select_volume.', status);
          osp$append_status_parameter (' ', recorded_vsn, status);
          EXIT /process_request/; {----->
        IFEND;

      ELSE
        select_best_volume (volume_selector, avt_index, status);
      IFEND;
    END /process_request/;

  PROCEND select_volume;
?? TITLE := '  unlogged_assign_volume', EJECT ??

  PROCEDURE unlogged_assign_volume
    (    sfid: gft$system_file_identifier;
         p_fde: ^gft$file_descriptor_entry;
         p_dfd: ^dmt$disk_file_descriptor;
         p_fmd: ^dmt$file_medium_descriptor;
         byte_address: amt$file_byte_address;
         vsn: rmt$recorded_vsn;
     VAR status: ost$status);

    VAR
      allocated_length: amt$file_byte_address,
      allocation_style: dmt$allocation_styles,
      avt_index: dmt$active_volume_table_index,
      bytes_per_allocation: dmt$allocation_size,
      bytes_per_dau: dmt$bytes_per_dau,
      dat_sfid: gft$system_file_identifier,
      daus_per_allocation: dmt$daus_per_allocation,
      dfl_index: dmt$device_file_list_index,
      dfl_sfid: gft$system_file_identifier,
      file_damaged: boolean,
      file_flawed: boolean,
      first_dau: dmt$dau_address,
      internal_vsn: dmt$internal_vsn,
      local_status: ost$status,
      number_of_aus: amt$file_byte_address,
      number_of_daus: amt$file_byte_address,
      p_allocation_list: ^t$allocation_list,
      attributes: array [1 .. 4] of dmt$assigned_ms_vol_attribute,
      p_mat: ^dmt$mainframe_allocation_table,
      volume_found: boolean;

    status.normal := TRUE;

    attributes [1].keyword := dmc$avt_index;
    attributes [2].keyword := dmc$ms_internal_vsn;
    attributes [3].keyword := dmc$ms_device_allocation_table;
    attributes [4].keyword := dmc$ms_device_file_list_table;
    avt_index := 0;

    dmp$get_active_vol_attributes (vsn, avt_index, attributes, volume_found);
    IF NOT volume_found THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dme$avt_entry_not_found, vsn, status);
      RETURN; {----->
    IFEND;

    avt_index := attributes [1].index;
    internal_vsn := attributes [2].internal_vsn;
    dat_sfid := attributes [3].p_dat;
    dfl_sfid := attributes [4].p_dflt;

    dmp$get_mat_pointer (avt_index, p_mat);

  /update_lock/
    BEGIN

      bytes_per_allocation := p_dfd^.requested_allocation_size;
      bytes_per_dau := p_mat^.bytes_per_dau;
      number_of_daus := (bytes_per_allocation + bytes_per_dau - 1) DIV bytes_per_dau;

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

      daus_per_allocation := p_mat^.daus_per_allocation_unit [allocation_style];
      bytes_per_allocation := bytes_per_dau * daus_per_allocation;
      number_of_aus := (byte_address + 1 + bytes_per_allocation - 1) DIV bytes_per_allocation;
      allocated_length := number_of_aus * bytes_per_allocation;

      PUSH p_allocation_list: [1 .. number_of_aus];
      find_allocation (dat_sfid, p_mat, allocation_style, daus_per_allocation, p_allocation_list, status);
      IF NOT status.normal THEN
        EXIT /update_lock/; {----->
      IFEND;

      first_dau := p_allocation_list^ [1];
      create_dfl_entry (first_dau, dfl_sfid, p_fde^.global_file_name, sfid.file_hash, allocated_length,
            daus_per_allocation, avt_index, dfl_index, status);
      IF NOT status.normal THEN
        EXIT /update_lock/; {----->
      IFEND;

    /dfl_created/
      BEGIN

        dat_allocate (avt_index, dat_sfid, sfid.file_hash, dfl_index, daus_per_allocation, p_allocation_list,
              status);
        IF NOT status.normal THEN
          EXIT /dfl_created/; {----->
        IFEND;

      /allocate_file/
        BEGIN
          p_fmd^.internal_vsn := internal_vsn;
          p_fmd^.dfl_index := dfl_index;
          p_fmd^.volume_assigned := TRUE;

          dmp$build_fmd_for_existing_file (p_fde, p_dfd, sfid, file_damaged, file_flawed, status);
          IF status.normal THEN
            EXIT /update_lock/; {----->
          IFEND;

        END /allocate_file/;

        dat_deallocate (dat_sfid, sfid.file_hash, daus_per_allocation, first_dau, avt_index, local_status);

      END /dfl_created/;

      delete_dfl_entry (dfl_sfid, dfl_index, avt_index, local_status);

    END /update_lock/;

  PROCEND unlogged_assign_volume;
?? TITLE := '  verify_allocation', EJECT ??

  PROCEDURE verify_allocation
    (    p_mat: ^dmt$mainframe_allocation_table;
         daus_per_allocation: dmt$daus_per_allocation;
         p_allocation_list: ^t$allocation_list;
         start_index: integer;
     VAR new_index: integer);

    VAR
      dau_count: dmt$dau_address,
      daus_per_position: dmt$daus_per_position,
      first_dau: dmt$dau_address,
      index: integer,
      isolation_index: integer,
      last_index: integer,
      limit_dau: dmt$dau_address,
      next_dau: dmt$dau_address,
      next_index: integer,
      verified: boolean;

    daus_per_position := p_mat^.daus_per_position;
    index := start_index;
    new_index := start_index;
    isolation_index := start_index;
    last_index := UPPERBOUND (p_allocation_list^);

    WHILE (index <= last_index) DO
      first_dau := p_allocation_list^ [index];
      next_dau := first_dau;
      next_index := index;
      IF (index < isolation_index) THEN
        limit_dau := first_dau + daus_per_allocation;
      ELSE
        limit_dau := first_dau DIV daus_per_position * daus_per_position + daus_per_position;
      IFEND;
      REPEAT
        next_dau := next_dau + daus_per_allocation;
        next_index := next_index + 1;
      UNTIL (next_index > last_index) OR (next_dau <> p_allocation_list^ [next_index]) OR
            (next_dau >= limit_dau);
      dau_count := next_dau - first_dau;

      verify_device_space (p_mat, daus_per_allocation, dau_count, first_dau, verified);

      IF verified THEN
        IF (index = new_index) THEN
          index := next_index;
          new_index := next_index;
        ELSE
          REPEAT
            p_allocation_list^ [new_index] := p_allocation_list^ [index];
            index := index + 1;
            new_index := new_index + 1;
          UNTIL (index >= next_index);
        IFEND;
      ELSEIF (dau_count = daus_per_allocation) THEN
        index := next_index;
      ELSE
        isolation_index := next_index;
      IFEND;
    WHILEND;

  PROCEND verify_allocation;
?? TITLE := '  verify_device_space', EJECT ??

  PROCEDURE verify_device_space
    (    p_mat: ^dmt$mainframe_allocation_table;
         daus_per_allocation_unit: dmt$daus_per_allocation;
         number_of_consecutive_daus: dmt$dau_address;
         first_dau_address: dmt$dau_address;
     VAR verified: boolean);


    VAR
      dau_index: dmt$dau_address,
      device_address: dmt$ms_logical_device_address,
      excess_verify_units: dmt$dau_address,
      p_completion_status: ^iot$completion_status,
      p_read_buffer: ^SEQ ( * ),
      status: ost$status,
      verify_units: dmt$dau_address;

    status.normal := TRUE;
    IF dmv$quick_deadstart THEN
      verified := TRUE;
      RETURN; {----->
    IFEND;

    verify_units := number_of_consecutive_daus DIV daus_per_allocation_unit;
    verified := FALSE;

    device_address.maus_per_position := p_mat^.maus_per_dau * p_mat^.daus_per_position;
    device_address.logical_unit_number := dmv$active_volume_table.table_p^ [p_mat^.avt_index].
          logical_unit_number;
    device_address.transfer_length := p_mat^.maus_per_dau * daus_per_allocation_unit;
    device_address.transfer_mau_offset := 0;
    device_address.au_was_previously_written := FALSE;
    device_address.maus_per_allocation_unit := p_mat^.maus_per_dau * daus_per_allocation_unit;
    device_address.preset_value := 0;

    PUSH p_read_buffer: [[REP p_mat^.bytes_per_dau * 4 OF cell]];

    RESET p_read_buffer;
    pmp$zero_out_table (p_read_buffer, #SIZE (p_read_buffer^));

    device_address.write_translation := TRUE;

    FOR dau_index := 1 TO verify_units DO
      device_address.allocation_unit_mau_address := ((dau_index - 1) *
            daus_per_allocation_unit + first_dau_address) * p_mat^.maus_per_dau;

      iop$mass_storage_io (NIL, 0, ioc$write_mass_storage, device_address, TRUE, p_completion_status, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    FOREND;

{
{          read verify the allocation units.
{
    device_address.write_translation := FALSE;
    device_address.transfer_length := p_mat^.maus_per_dau * 4;
    device_address.maus_per_allocation_unit := p_mat^.maus_per_dau * 4;

    verify_units := number_of_consecutive_daus DIV 4;
    excess_verify_units := number_of_consecutive_daus MOD 4;

    FOR dau_index := 1 TO verify_units DO
      device_address.allocation_unit_mau_address := ((dau_index - 1) * 4 + first_dau_address) *
            p_mat^.maus_per_dau;

      iop$mass_storage_io (p_read_buffer, p_mat^.bytes_per_dau, ioc$read_mass_storage, device_address, TRUE,
            p_completion_status, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    FOREND;

    IF excess_verify_units > 0 THEN
      device_address.maus_per_allocation_unit := p_mat^.maus_per_dau * excess_verify_units;
      device_address.allocation_unit_mau_address := (verify_units * 4 + first_dau_address) *
            p_mat^.maus_per_dau;
      device_address.transfer_length := p_mat^.maus_per_dau * excess_verify_units;

      iop$mass_storage_io (p_read_buffer, p_mat^.bytes_per_dau, ioc$read_mass_storage, device_address, TRUE,
            p_completion_status, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    verified := TRUE;

  PROCEND verify_device_space;
?? TITLE := '[xdcl, #gate] dmp$reallocate_file_space', EJECT ??

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

    VAR
      fau_entry: dmt$fau_entries,
      ignore_status: ost$status,
      identifier: ost$status_identifier,
      level_1_index: dmt$level_1_index,
      level_2_index: dmt$level_2_index,
      monitor_request_block: dmt$monitor_rb_reallocate_space,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fau: ^dmt$file_allocation_unit,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor,
      p_level_2: ^dmt$level_2_table,
      p_previous_fau: ^dmt$file_allocation_unit;

?? NEWTITLE := 'REALLOCATE_FAU', EJECT ??

    PROCEDURE reallocate_fau;

      VAR
        after_eoi: amt$file_byte_address,
        before_eoi: amt$file_byte_address,
        fau_offset: integer,
        fau_size: integer,
        seg: ost$segment,
        p_data: ^cell,
        p_save: ^array [1 .. * ] of cell,
        status_p: ^ost$status;

?? NEWTITLE := 'CH', EJECT ??

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

        VAR
          p_sac: ^mmt$segment_access_condition,
          ignore: ost$status;

        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,
                  'Cannot reallocate file space - dmp$reallocate_file_space', status);
          ELSE
            osp$set_status_abnormal ('MM', mme$io_read_error,
                  'Cannot reallocate file space - dmp$reallocate_file_space', status);
          CASEND;
          mmp$close_device_file (seg, ignore);
          {dmp$reallocate_file_space expects fde to be locked
          gfp$get_locked_fde_p (system_file_id, p_fde);
          EXIT reallocate_fau; {----->
        IFEND;

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

      PROCEND ch;
?? OLDTITLE ??
?? EJECT ??
      IF copy_pages THEN
        mmp$open_file_by_sfid (system_file_id, 1, 1, mmc$as_random, mmc$sar_write_extend, seg, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

      fau_size := p_dfd^.bytes_per_allocation;
      fau_offset := (level_1_index * p_dfd^.bytes_per_level_2) + (level_2_index * fau_size);
      p_data := #ADDRESS (1, seg, fau_offset);
      PUSH p_save: [1 .. fau_size];

      monitor_request_block.request_code := syc$rc_reallocate_front_end;
      monitor_request_block.system_file_id := system_file_id;
      monitor_request_block.allocation_units_obtained := 0;
      monitor_request_block.reallocate_byte_address := fau_offset;
      monitor_request_block.copy_pages := copy_pages;

    /reallocate_loop/
      WHILE TRUE DO

        IF copy_pages THEN

          dmp$fetch_eoi (system_file_id, before_eoi, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;

          gfp$unlock_fde_p (p_fde);

          syp$establish_condition_handler (^ch);

          {Touch pages -
          {This allows detection of any read i/o errors
          {MUST BE DONE WITH FDE UNLOCKED TO ALLOW PAGE FAULTS TO WORK!
          i#move (p_data, p_save, fau_size);

          IF p_dfd^.damaged_detection_enabled THEN
            mmp$write_modified_pages (p_data, fau_size, osc$wait, status);
          IFEND;

          syp$disestablish_cond_handler;

          gfp$get_locked_fde_p (system_file_id, p_fde);

          dmp$fetch_eoi (system_file_id, after_eoi, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;

          IF after_eoi > before_eoi THEN
            IF after_eoi = (fau_offset + fau_size) THEN
              {Reallocation changed eoi to end of the last AU
              dmp$set_eoi (system_file_id, before_eoi, status);
            IFEND;
          IFEND;

        IFEND;

        i#call_monitor (#LOC (monitor_request_block), #SIZE (monitor_request_block));

        IF NOT monitor_request_block.status.normal THEN
          osp$unpack_status_identifier (monitor_request_block.status.condition, identifier);
          osp$set_status_abnormal (identifier, monitor_request_block.status.condition,
                'Monitor reallocate reject - dmp$reallocate_file_space', status);

          { It's best not to hang in ring 1 waiting for disk space.  Until something better
          { can be done, just ignore disk full.

          IF (status.condition = dme$unable_to_alloc_all_space) THEN
            status.normal := TRUE;
          IFEND;
        ELSE
          status.normal := TRUE;
        IFEND;

        IF status.normal OR (status.condition <> mme$page_not_in_page_table) THEN
          EXIT /reallocate_loop/; {----->
        IFEND;

        gfp$unlock_fde_p (p_fde);

        pmp$delay (allocator_delay_time {milliseconds} , status);

        gfp$get_locked_fde_p (system_file_id, p_fde);

      WHILEND /reallocate_loop/;

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

        mmp$close_device_file (seg, status_p^);
      IFEND;

    PROCEND reallocate_fau;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;
    gfp$get_locked_fde_p (system_file_id, p_fde);
    IF p_fde <> NIL THEN
      IF p_fde^.media = gfc$fm_served_file THEN
        dmp$df_client_reallocate_space (p_fde, system_file_id, status);
{ File_Descriptor_Entry (FDE) lock has been cleared by the callee.
        RETURN; {----->
      IFEND;

      dmp$get_disk_file_descriptor_p (p_fde, p_dfd);

      IF (p_dfd <> NIL) THEN
        FOR level_1_index := LOWERVALUE (level_1_index) TO p_dfd^.fat_upper_bound DO
          dmp$get_level_2_ptr (^p_dfd^.file_allocation_table^ [level_1_index], p_level_2);
          IF p_level_2 <> NIL THEN
            FOR level_2_index := LOWERVALUE (level_2_index) TO
                  (p_dfd^.bytes_per_level_2 DIV p_dfd^.bytes_per_allocation - 1) DO
              IF (p_level_2^ [level_2_index].state = dmc$fau_invalid_and_flawed) OR
                    (p_level_2^ [level_2_index].state = dmc$fau_initialized_and_flawed) THEN
                reallocate_fau;
              IFEND;
            FOREND;
          IFEND;
        FOREND;

        IF p_dfd^.damaged_detection_enabled THEN
          dmp$split_allocation_log ({flush_device_log_pages} TRUE, ignore_status);
        IFEND;
      IFEND;

      gfp$unlock_fde_p (p_fde);
    ELSE {not found
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unable_to_locate_fde,
            ' Invalid SFID - dmp$reallocate_file_space', status);
    IFEND;

  PROCEND dmp$reallocate_file_space;
?? TITLE := '  dmp$df_client_reallocate_space', EJECT ??

  PROCEDURE [XDCL] dmp$df_client_reallocate_space
    (    fde_p: ^gft$file_descriptor_entry;
         system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      global_file_name: ost$binary_unique_name,
      p_receive_from_server_params: dft$p_receive_parameters,
      p_send_parameters: ^dmt$df_reallocate_filespace_inp,
      p_send_to_server_params: dft$p_send_parameters,
      p_server_descriptor: dmt$p_server_descriptor,
      queue_entry_location: dft$rpc_queue_entry_location,
      remote_sfid: gft$system_file_identifier,
      served_family_table_index: dft$served_family_table_index,
      status_p: ^ost$status;

    status.normal := TRUE;
    global_file_name := fde_p^.global_file_name;
    dfp$get_served_file_desc_p (fde_p, p_server_descriptor);
    IF (p_server_descriptor^.header.file_state = dfc$awaiting_recovery) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dfe$server_not_active, '', status);
      gfp$unlock_fde_p (fde_p);
      RETURN; {----->
    ELSEIF (p_server_descriptor^.header.file_state = dfc$terminated) THEN
      osp$set_status_abnormal (dmc$device_manager_ident, dfe$server_has_terminated, '', status);
      gfp$unlock_fde_p (fde_p);
      RETURN; {----->
    IFEND;
    served_family_table_index := p_server_descriptor^.header.served_family_table_index;
    remote_sfid := p_server_descriptor^.header.remote_sfid;
    gfp$unlock_fde_p (fde_p);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    dfp$begin_remote_core_call (served_family_table_index, { Allowed when deactive } TRUE,
          queue_entry_location, p_send_to_server_params, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    NEXT p_send_parameters IN p_send_to_server_params;
    p_send_parameters^.sfid := remote_sfid;
    dfp$uncomplement_gfn (global_file_name, p_send_parameters^.global_file_name);
    dfp$send_remote_core_call (queue_entry_location, dfc$r1_df_server_reallocate, #SIZE (p_send_parameters^),
          p_receive_from_server_params, status);

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

    dfp$end_remote_core_call (queue_entry_location, status_p^);

  PROCEND dmp$df_client_reallocate_space;

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

  PROCEDURE [XDCL] dmp$sparse_allocate
    (    sfid: gft$system_file_identifier;
         offset_requiring_allocation: amt$file_byte_address;
         file_space_limit: sft$file_space_limit_kind;
     VAR status: ost$status);

    VAR
      pages: ^array [ * ] of ost$segment_offset,
      able: boolean,
      p_dfd: ^dmt$disk_file_descriptor,
      p_fde: ^gft$file_descriptor_entry,
      p_fmd: ^dmt$file_medium_descriptor,
      p_fau: ^dmt$file_allocation_unit,
      i,
      max_pages_no_file,
      number_of_pages: integer;

    gfp$get_fde_p (sfid, p_fde);
    dmp$get_disk_file_descriptor_p (p_fde, p_dfd);

    IF p_dfd^.file_allocation_table <> NIL THEN
{       mmc$assign_active_escaped is a flag indicating escaped allocation -
{       must process all modified pages
      IF offset_requiring_allocation < mmc$assign_active_null THEN
        dmp$allocate_file_space_r1 (sfid, offset_requiring_allocation, 1, 0, osc$nowait, file_space_limit,
              status);
        RETURN; {----->
      IFEND;
    IFEND;

    number_of_pages := mmv$max_pages_no_file;
    IF number_of_pages < 0 THEN
      number_of_pages := -number_of_pages;
    IFEND;
    number_of_pages := number_of_pages + 50;

    REPEAT
      max_pages_no_file := number_of_pages;
      PUSH pages: [1 .. max_pages_no_file];
      mmp$fetch_offset_mod_pages_r1 (0 {segment_number} , sfid, TRUE {return_unallocated_offsets} , pages,
            number_of_pages, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    UNTIL number_of_pages <= max_pages_no_file;

    IF number_of_pages = 0 THEN
      {If no modified pages and fat not assigned, must force allocation
      dmp$allocate_file_space_r1 (sfid, 0, 1, 0, osc$nowait, file_space_limit, status);
      RETURN; {----->
    IFEND;

    mmv$create_sparse := mmv$create_sparse + 1;

    FOR i := 1 TO number_of_pages DO
      dmp$get_fau_entry (p_dfd, pages^ [i], p_fau);
      IF (p_fau = NIL) OR (p_fau^.state = dmc$fau_free) THEN
        dmp$allocate_file_space_r1 (sfid, pages^ [i], 1, 0, osc$nowait, file_space_limit, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;
    FOREND;

  PROCEND dmp$sparse_allocate;
MODEND dmm$job_allocator;

