MODULE iom$queue_request;
?? RIGHT := 110 ??

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$mainframe_wired
*copyc oss$mainframe_wired_cb
*copyc oss$mainframe_wired_literal
*copyc cmc$logical_unit_constants
*copyc gfc$constants
*copyc mtc$job_fixed_segment
*copyc dfd$file_server_info
*copyc osd$cybil_structure_definitions
*copyc osd$default_pragmats
*copyc osd$virtual_address
*copyc ioe$st_errors
*copyc amt$file_byte_address
*copyc amt$preset_value
*copyc cmt$element_access
*copyc cmt$element_capabilities
*copyc dct$disk_cache_info
*copyc dmt$chapter_number
*copyc dmt$disk_file_descriptor
*copyc dmt$error_condition_codes
*copyc dmt$minimum_allocation_unit
*copyc dmt$ms_logical_device_address
*copyc gft$file_desc_entry_p
*copyc gft$locked_file_desc_entry_p
*copyc gft$system_file_identifier
*copyc iot$command
*copyc iot$cylinder
*copyc iot$device_table
*copyc iot$disk_request
*copyc iot$disk_type_table
*copyc iot$io_function
*copyc iot$io_request
*copyc iot$io_request_type
*copyc iot$lockword
*copyc iot$logical_unit
*copyc iot$pp_interface_table
*copyc iot$request_heap_map
*copyc iot$request_recovery
*copyc iot$unit_interface_table
*copyc iot$unit_type
*copyc iot$vsn
*copyc jmt$ijl_ordinal
*copyc mmt$buffer_descriptor
*copyc mmt$io_identifier
*copyc mmt$rma_list
*copyc ost$cpu_state_table
*copyc ost$hardware_subranges
*copyc ost$page_size
*copyc syt$monitor_request_code
?? POP ??
*copyc dmp$read
*copyc dmp$transfer_unit_completed
*copyc dmp$write
*copyc dpp$convert_int_to_str_octal
*copyc dpp$display_error
*copyc dsp$mtr_dft_puf_request
*copyc gfp$mtr_get_sfid_from_fde_p
*copyc iop$clear_queue_lockword
*copyc iop$process_disk_response
*copyc iop$process_io_completions
*copyc iop$set_queue_lockword
*copyc mmp$build_lock_rma_list
*copyc mtp$error_stop
*copyc cmv$logical_pp_table_p
*copyc cmv$logical_unit_table
*copyc iov$disk_type_table_xdcl
*copyc mmv$min_avail_pages
*copyc mmv$reassignable_page_frames

*if false
*copyc osv$simulated_disk_fault
*ifend
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

{NOTE: The Logical Unit Table cannot be bigger than the maximum number of stream request entries!

  CONST
    c$stream_request_count_max = 300;

  VAR
    iov$actual_requests_resolved: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 0,
    iov$command_heap: [XDCL, STATIC, oss$mainframe_wired_cb] iot$command_heap,


    iov$command_heap_map: [XDCL, STATIC, oss$mainframe_wired] iot$command_heap_map :=
          [REP ioc$command_map_count + 1 of FALSE],
    iov$empty_request_count: [XDCL, STATIC, oss$mainframe_wired] integer := ioc$request_heap_count + 1,

    iov$empty_requests: [XDCL, STATIC, oss$mainframe_wired] ^iot$io_request := NIL,
    iov$empty_requests_end: [XDCL, STATIC, oss$mainframe_wired] ^^iot$io_request := ^iov$empty_requests,
    iov$enforce_read_priority: [XDCL, #GATE, STATIC, oss$mainframe_wired] boolean := FALSE,
    iov$read_priority_invoked: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 0,
    iov$total_queue_calls: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 0,
    iov$queue_count_max: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 100,

    iov$reject_address_buffer_full: [#GATE, XDCL, STATIC, oss$mainframe_wired] integer := 0,
    iov$reject_down_unit: [#GATE, XDCL, STATIC, oss$mainframe_wired] integer := 0,
    iov$reject_element_access: [#GATE, XDCL, STATIC, oss$mainframe_wired] integer := 0,
    iov$reject_interlock_set: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 0,
    iov$reject_requests_full: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 0,
    iov$reject_unit_queue_limit: [XDCL, #GATE, STATIC, oss$mainframe_wired] integer := 0,

    iov$request_heap: [XDCL, STATIC, oss$mainframe_wired_cb] iot$request_heap,

    iov$request_heap_map: [XDCL, STATIC, oss$mainframe_wired] iot$request_heap_map :=
          [REP ioc$request_heap_count + 1 of FALSE],

    iov$stream_requests: [XREF] array [0 .. c$stream_request_count_max] of ^iot$io_request,
    iov$stream_requests_end: [XREF] array [0 .. c$stream_request_count_max] of ^^iot$io_request,
    iov$stream_requests_search: [XDCL, STATIC, oss$mainframe_wired] integer := 0;

?? OLDTITLE ??
?? NEWTITLE := 'iop$pager_io', EJECT ??

  PROCEDURE [XDCL] iop$pager_io
    (    fde_p: gft$locked_file_desc_entry_p;
         chapter_offset: ost$segment_offset;
         buffer_descriptor: mmt$buffer_descriptor;
         length: ost$byte_count;
         io_function: iot$io_function;
         io_identifier: mmt$io_identifier;
     VAR status: syt$monitor_status);

    VAR
      v$initial_request_info: [READ, oss$mainframe_wired_literal] iot$request_info := [
{ PRESET_VALUE               } 0,
{ COMMAND_INDEX              } 0,
{ COMMAND_GROUP_COUNT        } 0,
{ LIST_LENGTH                } 0,
{ IO_FUNCTION                } ioc$read_page,
{ REQUEST_TYPE               } ioc$pager_io,
{ JOB_ID                     } [0, 0],
{ SYSTEM_FILE_ID             } [0, gfc$tr_job, 0],
{ BYTE_ADDRESS               } 0,
{ AU_WAS_PREVIOUSLY_WRITTEN  } FALSE,
{ LIST_P                     } NIL,
{ COMPLETION                 } NIL,
{ NEXT_TRACK                 } 0,
{ NEXT_SECTOR                } 0,
{ DATA_MAUS                  } 0,
{ TIME                       } 0,
{ IO_IDENTIFIER              } [
{   SPECIFIED                  } FALSE,
{   IO_FUNCTION                } ioc$read_page,
{   TASKID                     } [0, 0],
{   IOCB_INDEX                 } 0]];

    VAR
      device_address: dmt$ms_logical_device_address,
      ijl_ordinal: jmt$ijl_ordinal,
      transfer_length: ost$byte_count,
      index: 1 .. ioc$disk_type_count,
      request_info: iot$request_info,
      system_file_id: gft$system_file_identifier;

    status.normal := TRUE;

    gfp$mtr_get_sfid_from_fde_p (fde_p, system_file_id, ijl_ordinal);

{Call device management to translate the chapter_offset to a device_address.}
    CASE io_function OF
    = ioc$write_page, ioc$write_locked_page, ioc$explicit_write, ioc$compare_swap, ioc$write_verify,
          ioc$write_mass_storage, ioc$swap_out, ioc$keypoint_io, ioc$write_for_server =

      dmp$write (fde_p, chapter_offset, length, io_function, device_address, status);

    = ioc$read_page, ioc$explicit_read, ioc$swap_in, ioc$read_uft, ioc$explicit_read_no_purge,
          ioc$read_mass_storage, ioc$read_for_server, ioc$read_ahead_on_server =

      dmp$read (fde_p, chapter_offset, length, device_address, status);

    ELSE
      mtp$error_stop ('IO14 - invalid io_function');
    CASEND;

    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;


    index := cmv$logical_unit_table^ [device_address.logical_unit_number].unit_interface_table^.unit_type -
          100(16) + 1;
    transfer_length := device_address.transfer_length * iov$disk_type_table [index].bytes_per_mau;

{Calculate physical disk address and queue request.}
    request_info := v$initial_request_info;
    request_info.job_id := ijl_ordinal;
    request_info.system_file_id := system_file_id;
    request_info.byte_address := chapter_offset;
    request_info.io_function := io_function;
    request_info.preset_value := device_address.preset_value;
    request_info.io_identifier := io_identifier;
    iop$disk_request (request_info, buffer_descriptor, transfer_length, device_address, status);

  PROCEND iop$pager_io;
?? TITLE := 'iop$disk_request', EJECT ??

  PROCEDURE [XDCL] iop$disk_request
    (    request_inf: iot$request_info;
         buffer_descriptor: mmt$buffer_descriptor;
         length: ost$byte_count;
         device_address: dmt$ms_logical_device_address;
     VAR status: syt$monitor_status);

    VAR
      cylinder: iot$cylinder,
      disk_type_table_p: ^iot$disk_type_table,
      index: 1 .. ioc$disk_type_count,
      logical_unit: iot$logical_unit,
      mau_count: 0 .. dmc$max_maus_per_transfer, { 3ff(16),
      next_sector_offset: iot$sector, { 0 .. 1280,
      request_info: iot$request_info,
      sector: iot$sector,
      sector_offset_within_cylinder: iot$sector, { 0 .. 1280,
      starting_mau: dmt$mau_address,
      stream_ok: boolean,
      track: iot$track;

    status.normal := TRUE;
    request_info := request_inf;
    logical_unit := device_address.logical_unit_number;

    index := cmv$logical_unit_table^ [logical_unit].unit_interface_table^.unit_type - 100(16) + 1;
    stream_ok := TRUE;
    disk_type_table_p := ^iov$disk_type_table [index];

    request_info.au_was_previously_written := (NOT device_address.write_translation) OR
          device_address.au_was_previously_written;

{Calculate mau count.
    IF length <> 0 THEN
      mau_count := length DIV disk_type_table_p^.bytes_per_mau;
      IF (mau_count * disk_type_table_p^.bytes_per_mau) <> length THEN
        stream_ok := FALSE;
        mau_count := mau_count + 1;
      IFEND;
    ELSE
      mau_count := 0;
    IFEND;
    request_info.data_maus := mau_count;

{Calculate cylinder, track, and sector.}
    cylinder := device_address.allocation_unit_mau_address DIV (device_address.maus_per_position);
    sector_offset_within_cylinder := (device_address.allocation_unit_mau_address -
          (cylinder * device_address.maus_per_position)) * disk_type_table_p^.sectors_per_mau;
    IF request_info.au_was_previously_written THEN
      sector_offset_within_cylinder := sector_offset_within_cylinder + device_address.transfer_mau_offset *
            disk_type_table_p^.sectors_per_mau;
      starting_mau := device_address.allocation_unit_mau_address + device_address.transfer_mau_offset;
    ELSE
      IF length <> 0 THEN
        mau_count := device_address.maus_per_allocation_unit + mau_count - device_address.transfer_length;
      ELSE
        mau_count := device_address.maus_per_allocation_unit;
      IFEND;
      starting_mau := device_address.allocation_unit_mau_address;
    IFEND;
    next_sector_offset := sector_offset_within_cylinder + (mau_count * disk_type_table_p^.sectors_per_mau);
    track := sector_offset_within_cylinder DIV disk_type_table_p^.sectors_per_track;

    sector := sector_offset_within_cylinder - (track * disk_type_table_p^.sectors_per_track);
    IF stream_ok THEN
      request_info.next_track := next_sector_offset DIV disk_type_table_p^.sectors_per_track;
      request_info.next_sector := next_sector_offset - (request_info.next_track *
            disk_type_table_p^.sectors_per_track);
    ELSE
      request_info.next_track := 0ffff(16);
      request_info.next_sector := 0ffff(16);
    IFEND;

{Check for errors in disk address.
*if $true(queue_manager_debug)
    IF sector >= disk_type_table_p^.sectors_per_track THEN
      mtp$error_stop ('IO06 - invalid sector address');
    IFEND;
    IF track >= disk_type_table_p^.tracks_per_cylinder THEN
      mtp$error_stop ('IO07 - invalid track address');
    IFEND;
    IF cylinder >= disk_type_table_p^.cylinders_per_unit THEN
      mtp$error_stop ('IO08 - invalid cylinder address');
    IFEND;
*ifend
{Queue request.}
    iop$queue_request (request_info, buffer_descriptor, length, logical_unit, cylinder, track, sector,
          mau_count, device_address, status);

  PROCEND iop$disk_request;
?? TITLE := 'iop$queue_request', EJECT ??

  PROCEDURE {XDCL} iop$queue_request
    (    request_info: iot$request_info;
         buffer_descriptor: mmt$buffer_descriptor;
         length: ost$byte_count;
         logical_unit: iot$logical_unit;
         cylinder: iot$cylinder;
         track: iot$track;
         sector: iot$sector;
         mau_count: 0 .. dmc$max_maus_per_transfer; { 3ff(16);
         device_address: dmt$ms_logical_device_address;
     VAR status: syt$monitor_status);

    CONST
      ioc$preset_length_in_bytes = dmc$max_bytes_per_mau,
      ioc$preset_length_in_words = ioc$preset_length_in_bytes DIV 8,
      ioc$preset_length = ioc$preset_length_in_bytes;

    TYPE
      t$preset_buffer = packed record
        buffer: ALIGNED [0 MOD 4096] array [1 .. ioc$preset_length_in_words] of integer,
      recend,

      t$preset_buffers = array [boolean] of t$preset_buffer;

    VAR
      v$preset_buffers: [READ, oss$mainframe_wired_literal] t$preset_buffers := [
{ SPECIAL = FALSE } [[REP ioc$preset_length_in_words of 0000000000000000(16)]],
{ SPECIAL = TRUE  } [[REP ioc$preset_length_in_words of 7000000000000000(16)]]];

    TYPE
      t$commands_access = array [iot$io_function] of t$command_access,
      t$command_access = record
        command_code: iot$command_code,
        required_access: cmt$element_access,
      recend;

    VAR
      v$command_access: [READ, oss$mainframe_wired_literal] array [iot$io_function] of t$command_access := [
{IOC$READ_PAGE               } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]],
{IOC$WRITE_PAGE              } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$EXPLICIT_READ           } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]],
{IOC$EXPLICIT_WRITE          } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$SWAP_IN                 } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]],
{IOC$SWAP_OUT                } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$COMPARE_SWAP            } [ioc$cc_compare_swap, $cmt$element_access [cmc$read, cmc$write]],
{IOC$WRITE_VERIFY            } [ioc$cc_write_verify, $cmt$element_access [cmc$read, cmc$write]],
{IOC$READ_UFT                } [ioc$cc_read_flaws, $cmt$element_access []],
{IOC$READ_MASS_STORAGE       } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]],
{IOC$WRITE_MASS_STORAGE      } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$NO_IO                   } [ioc$cc_disable_unit, $cmt$element_access []],
{IOC$WRITE_LOCKED_PAGE       } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$KEYPOINT_IO             } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$INITIALIZE_SECTORS      } [ioc$cc_initialize_sectors, $cmt$element_access []],
{IOC$EXPLICIT_READ_NO_PURGE  } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]],
{IOC$READ_FOR_SERVER         } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]],
{IOC$READ_FROM_CLIENT        } [ioc$cc_disable_unit, $cmt$element_access []],
{IOC$WRITE_FOR_SERVER        } [ioc$cc_write_bytes, $cmt$element_access [cmc$write]],
{IOC$WRITE_TO_CLIENT         } [ioc$cc_disable_unit, $cmt$element_access []],
{IOC$ALLOCATE                } [ioc$cc_disable_unit, $cmt$element_access []],
{IOC$READ_AHEAD_ON_SERVER    } [ioc$cc_read_bytes, $cmt$element_access [cmc$read]]];

    VAR
      v$last_command_index: [STATIC] 0 .. ioc$command_map_count := 0;

    VAR
      address_pair_count: 0 .. mmc$max_rma_list_length,
      cm: 1 .. 3,
      command_code: iot$command_code,
      disk_request_p: ^iot$disk_request,
      enforce_priority: boolean,
      first_preset_count: 0 .. ioc$command_map_count,
      first_preset_length: 0 .. dmc$max_maus_per_transfer * 2048,
      found: boolean,
      gr: 0 .. ioc$command_map_count,
      io_request_p: ^iot$io_request,
      ix: integer,
      j: integer,
      jj: 0 .. 2 * ioc$command_heap_count,
      lock_set: boolean,
      logical_unit_p: ^cmt$logical_unit,
      mau_offset_in_cylinder: dmt$maus_per_position,
      next_io_request: ^iot$io_request,
      next_request: ^iot$disk_request,
      unit_interface_table_p: ^iot$unit_interface_table,
      disk_pp_request_p: ^iot$disk_pp_request,
      previous_request: ^iot$disk_request,
      remaining_preset_count: 0 .. ioc$command_map_count,
      remaining_preset_length: 0 .. dmc$max_maus_per_transfer * 2048,
      request_allocated: boolean,
      rma: integer,
      total_address_pair_count: 0 .. ioc$command_map_count;

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

    PROCEDURE [INLINE] p$build_transfer_lengths
      (    unit_index: 0 .. ioc$disk_type_count;
       VAR address_pair_count: 0 .. mmc$max_rma_list_length;
       VAR total_address_pair_count: 0 .. ioc$command_map_count;
       VAR remaining_preset_count: 0 .. ioc$command_map_count;
       VAR remaining_preset_length: 0 .. dmc$max_maus_per_transfer * 2048;
       VAR first_preset_count: 0 .. ioc$command_map_count;
       VAR first_preset_length: 0 .. dmc$max_maus_per_transfer * 2048);

      IF request_info.au_was_previously_written THEN
        first_preset_length := 0;
        first_preset_count := 0;
        remaining_preset_length := 0;
        remaining_preset_count := 0;
        address_pair_count := buffer_descriptor.page_count; {Length here is always <> 0, see check above
        total_address_pair_count := address_pair_count;

      ELSEIF length = 0 THEN
        first_preset_length := device_address.maus_per_allocation_unit *
              iov$disk_type_table [unit_index].bytes_per_mau;
        first_preset_count := ((first_preset_length - 1) DIV ioc$preset_length) + 1;
        remaining_preset_length := 0;
        remaining_preset_count := 0;

        address_pair_count := 0;
        total_address_pair_count := first_preset_count;

      ELSE
        first_preset_length := device_address.transfer_mau_offset *
              iov$disk_type_table [unit_index].bytes_per_mau;
        IF first_preset_length <> 0 THEN
          first_preset_count := ((first_preset_length - 1) DIV ioc$preset_length) + 1;
        ELSE
          first_preset_count := 0;
        IFEND;

        remaining_preset_length := (device_address.maus_per_allocation_unit -
              (device_address.transfer_mau_offset + device_address.transfer_length)) *
              iov$disk_type_table [unit_index].bytes_per_mau;
        IF remaining_preset_length <> 0 THEN
          remaining_preset_count := ((remaining_preset_length - 1) DIV ioc$preset_length) + 1;
        ELSE
          remaining_preset_count := 0;
        IFEND;

        address_pair_count := buffer_descriptor.page_count;
        total_address_pair_count := address_pair_count + first_preset_count + remaining_preset_count;
      IFEND;

    PROCEND p$build_transfer_lengths;
?? OLDTITLE ??
?? NEWTITLE := 'P$CLEAN_UP', EJECT ??

    PROCEDURE [INLINE] p$clean_up_on_error;

      VAR
        t_status: syt$monitor_status;

      IF request_allocated THEN
        disk_request_p^.link := iov$empty_requests;
        iov$empty_requests := io_request_p;
        IF iov$empty_requests_end = ^iov$empty_requests THEN
          iov$empty_requests_end := ^disk_request_p^.link;
        IFEND;
        iov$request_heap_map [disk_request_p^.request_index] := FALSE;
        iov$empty_request_count := iov$empty_request_count + 1;
      IFEND;

      IF request_info.request_type <> ioc$device_io THEN
        dmp$transfer_unit_completed (request_info.job_id, request_info.system_file_id,
              request_info.byte_address, dmc$tu_not_written, request_info.au_was_previously_written, FALSE
              {media_error} , cylinder, mau_offset_in_cylinder, request_info.io_function, t_status);
      IFEND;

    PROCEND p$clean_up_on_error;
?? OLDTITLE ??
?? NEWTITLE := 'P$FIND_SLOTS', EJECT ??

    PROCEDURE [INLINE] p$find_slots
      (    total_address_pair_count: integer;
       VAR low_index: integer;
       VAR found: boolean);

      VAR
        gr: integer,
        high_index: integer,
        i: integer;

      low_index := v$last_command_index;
      found := FALSE;

    /find_slots/
      FOR i := 0 TO ioc$command_map_count - total_address_pair_count + 1 DO
        low_index := (low_index + 1) MOD (ioc$command_map_count - total_address_pair_count + 2);
        high_index := low_index + total_address_pair_count - 1;

        FOR gr := low_index TO high_index DO
          IF iov$command_heap_map [gr] THEN
            low_index := gr;
            CYCLE /find_slots/; {----->
          IFEND
        FOREND;

        found := TRUE;
        RETURN; {----->

      FOREND /find_slots/;

    PROCEND p$find_slots;
?? OLDTITLE ??
?? NEWTITLE := '[inline] IOP$MAKE_PRESET_COMMAND', EJECT ??

    PROCEDURE [INLINE] iop$make_preset_command
      (    initial_preset_length: 0 .. dmc$max_maus_per_transfer * 2048;
           preset_count: 0 .. ioc$command_map_count;
       VAR command_heap_index: 0 .. 2 * ioc$command_heap_count;
       VAR command: iot$command);

      VAR
        i: 0 .. ioc$command_map_count,
        preset_length: 0 .. dmc$max_maus_per_transfer * 2048,
        rma: integer,
        rma_list_entry_p: ^mmt$rma_list_entry;

      preset_length := initial_preset_length;
      command.command_code := ioc$cc_write_bytes;
      command.flags.indirect_address := TRUE;

      #real_memory_address (#LOC (iov$command_heap [command_heap_index]), rma);
      command.address := rma;
      #real_memory_address (#LOC (v$preset_buffers [request_info.preset_value <> 0]), rma);

      FOR i := 1 TO preset_count DO
        rma_list_entry_p := ^iov$command_heap [command_heap_index];
        rma_list_entry_p^.fill := 0;
        rma_list_entry_p^.rma := rma;
        IF preset_length > ioc$preset_length THEN
          rma_list_entry_p^.length := ioc$preset_length;
          preset_length := preset_length - ioc$preset_length;
        ELSE
          rma_list_entry_p^.length := preset_length;
        IFEND;
        command_heap_index := command_heap_index + 1;
      FOREND;
      command.length := preset_count * 8;

    PROCEND iop$make_preset_command;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    mau_offset_in_cylinder := 0;
    request_allocated := FALSE;
    logical_unit_p := ^cmv$logical_unit_table^ [logical_unit];
    unit_interface_table_p := logical_unit_p^.unit_interface_table;

  /queue_request_error/
    BEGIN
      IF NOT (cmc$io_request_submission IN logical_unit_p^.element_capability) THEN
        iov$reject_down_unit := iov$reject_down_unit + 1;
        status.condition := ioe$unit_disabled;
        EXIT /queue_request_error/; {----->
      IFEND;

      IF iov$empty_request_count <= 10 THEN
        iov$reject_requests_full := iov$reject_requests_full + 1;
        status.condition := ioe$requests_full;
        EXIT /queue_request_error/; {----->
      IFEND;

      IF unit_interface_table_p^.queue_count >= iov$queue_count_max THEN
        iov$reject_unit_queue_limit := iov$reject_unit_queue_limit + 1;
        status.condition := ioe$requests_full;
        EXIT /queue_request_error/; {----->
      IFEND;

{Check for 0 words to transfer.
      IF request_info.au_was_previously_written
{     } AND ((length = 0) OR (device_address.transfer_length = 0)) THEN
        RETURN; {----->
      IFEND;

{Set command_code.
      command_code := v$command_access [request_info.io_function].command_code;
      IF command_code = ioc$cc_disable_unit THEN {Do we really have to do this? I mean, what did it before?
        mtp$error_stop ('IO14 - invalid io_function');
      ELSEIF NOT (v$command_access [request_info.io_function].required_access <=
            logical_unit_p^.element_access) THEN
        iov$reject_element_access := iov$reject_element_access + 1;
        status.condition := ioe$unit_disabled;
        EXIT /queue_request_error/; {----->
      IFEND;

      enforce_priority := (iov$enforce_read_priority) AND (command_code = ioc$cc_read_bytes) AND
            (mmv$reassignable_page_frames.now >= mmv$min_avail_pages);

{ Do we want to go through the request heap for priority reads, when the Q is almost empty?
{ On large writes, a single entry can be big. So what's almost empty? 1 or 10? (Look at commands???)
{ Anyway, shouldn't we better go through the linked disk requests instead of the heap, as we then would
{ only get requests for that particular unit.
{
{ And, the best would be to force read, when we have lot of pages but write, when we run low. Not?
{
{ Another question remains: does it really make sense to move a request to the beginning of the Q?
{ I mean, it makes a greate deal how the PP travels through the Q! (I think, Pico does it cyclic?)

      IF enforce_priority AND (unit_interface_table_p^.queue_count > 10) THEN

{ Check that the disk address we want to read is not already queued for a
{ write, this could result in the read occurring out of order, rendering
{ incorrect data.

      /priority_check/
        FOR j := 0 TO ioc$request_heap_count DO
          IF iov$request_heap_map [j] THEN
            disk_pp_request_p := ^iov$request_heap [j].disk_request.request;

            IF (disk_pp_request_p^.logical_unit = logical_unit)
{          } AND (disk_pp_request_p^.cylinder = cylinder)
{          } AND (disk_pp_request_p^.track = track)
{          } AND (disk_pp_request_p^.sector = sector) THEN

              enforce_priority := FALSE;
              EXIT /priority_check/; {----->
            IFEND;
          IFEND;
        FOREND /priority_check/;
      IFEND;

{Find empty slot for request.}
      iop$find_empty_request (io_request_p, status);
      IF NOT status.normal THEN
        EXIT /queue_request_error/; {----->
      IFEND;

      disk_request_p := io_request_p^.device_request_p;
      iov$request_heap_map [disk_request_p^.request_index] := TRUE;
      iov$empty_request_count := iov$empty_request_count - 1;
      request_allocated := TRUE;


{Prepare request.}
      disk_request_p^.request_info := request_info;
      disk_request_p^.request.logical_unit := logical_unit;
      disk_request_p^.request.cylinder := cylinder;
      disk_request_p^.request.track := track;
      disk_request_p^.request.sector := sector;
      disk_request_p^.request.mau_count := mau_count;
      IF request_info.request_type = ioc$device_io THEN
        disk_request_p^.request.interrupt.value := TRUE;
      IFEND;
      io_request_p^.response_processor_p := ^iop$process_disk_response;

{Compute total number of address_pair_lengths required for command.
      p$build_transfer_lengths (unit_interface_table_p^.unit_type - 100(16) + 1, address_pair_count,
            total_address_pair_count, remaining_preset_count, remaining_preset_length, first_preset_count,
            first_preset_length);

{find empty slot for address_length_pairs.}
      IF total_address_pair_count <> 0 THEN
        p$find_slots (total_address_pair_count, ix, found);

        IF NOT found THEN {reject request.}
          iov$reject_address_buffer_full := iov$reject_address_buffer_full + 1;
          status.condition := ioe$requests_full;
          EXIT /queue_request_error/; {----->
        IFEND;
      IFEND;

      disk_request_p^.request_info.command_group_count := total_address_pair_count;

{Setup first preset commands
      jj := ((ix - 1) * ioc$command_group) + 1;
      cm := 1;

      IF first_preset_length > 0 THEN
        iop$make_preset_command (first_preset_length, first_preset_count, jj,
              disk_request_p^.request.command [cm]);
        disk_request_p^.request.request_length := disk_request_p^.request.request_length + 8;
        cm := cm + 1;
      IFEND;

{Setup remaining preset commands
      IF remaining_preset_length > 0 THEN
        iop$make_preset_command (remaining_preset_length, remaining_preset_count, jj,
              disk_request_p^.request.command [cm + 1]);
        disk_request_p^.request.request_length := disk_request_p^.request.request_length + 8;
      IFEND;


{Set up main command.
      IF length <> 0 THEN
        disk_request_p^.request.command [cm].command_code := command_code;
        disk_request_p^.request.command [cm].flags.indirect_address := TRUE;
        disk_request_p^.request_info.list_p := #LOC (iov$command_heap [jj]);
        disk_request_p^.request_info.list_length := address_pair_count;
        disk_request_p^.request.command [cm].length := address_pair_count * 8;
        #real_memory_address (disk_request_p^.request_info.list_p, rma);
        disk_request_p^.request.command [cm].address := rma;
      ELSE {Note: We always have a first preset command, when length = 0
        disk_request_p^.request.request_length := disk_request_p^.request.request_length - 8;
      IFEND;

{Set unit queue lockword.}
      iop$set_queue_lockword (unit_interface_table_p^.unit_q_lockword, lock_set);

      IF NOT lock_set THEN
        iov$reject_interlock_set := iov$reject_interlock_set + 1;
        status.condition := dme$transient_error;
        EXIT /queue_request_error/; {----->
      IFEND;


{Lock pages.}
      IF length <> 0 THEN
        mmp$build_lock_rma_list (buffer_descriptor, length, request_info.io_function,
              disk_request_p^.request_info.list_p, address_pair_count, status);
        IF NOT status.normal THEN
          iop$clear_queue_lockword (unit_interface_table_p^.unit_q_lockword);

          EXIT /queue_request_error/; {----->
        IFEND;
      IFEND;

{Set flags for space allocated.}
      IF total_address_pair_count <> 0 THEN
        v$last_command_index := ix + total_address_pair_count - 1;
        FOR gr := ix TO v$last_command_index DO
          iov$command_heap_map [gr] := TRUE;
        FOREND;
        disk_request_p^.request_info.command_index := ix;
      IFEND;

{Insert request in queue.}
      next_io_request := unit_interface_table_p^.next_request;
      previous_request := NIL;

      iov$total_queue_calls := iov$total_queue_calls + 1;

    /find_place_in_queue/
      WHILE next_io_request <> NIL DO
        next_request := next_io_request^.device_request_p;
        IF enforce_priority AND (next_request^.request_info.io_function <> ioc$read_page) THEN
          iov$read_priority_invoked := iov$read_priority_invoked + 1;
          EXIT /find_place_in_queue/; {----->
        IFEND;

        IF next_request^.request.cylinder > cylinder THEN
          EXIT /find_place_in_queue/; {----->
        IFEND;

        previous_request := next_request;
        next_io_request := next_request^.request.next_pp_request;
      WHILEND /find_place_in_queue/;

      IF next_io_request <> NIL THEN
        disk_request_p^.request.next_pp_request := next_io_request;

        IF previous_request <> NIL THEN
          disk_request_p^.request.next_pp_request_rma := previous_request^.request.next_pp_request_rma;
        ELSE
          disk_request_p^.request.next_pp_request_rma := unit_interface_table_p^.next_request_rma;
        IFEND;
      IFEND;

      #real_memory_address (#LOC (disk_request_p^.request), rma);
      IF previous_request = NIL THEN
        unit_interface_table_p^.next_request := io_request_p;
        unit_interface_table_p^.next_request_rma := rma;
      ELSE
        previous_request^.request.next_pp_request := io_request_p;
        previous_request^.request.next_pp_request_rma := rma;
      IFEND;

{Increment queue count.}
      unit_interface_table_p^.queue_count := unit_interface_table_p^.queue_count + 1;

{Check if the pp should make an automatic switch to this request.(For streaming data between requests.)}

    /stream_test/
      BEGIN
        IF previous_request <> NIL THEN
          IF (previous_request^.request.cylinder = cylinder) AND
                (previous_request^.request_info.next_track = track) AND
                (previous_request^.request_info.next_sector = sector) THEN
            cm := (previous_request^.request.request_length - ioc$min_request_length + 8) DIV 8;
            CASE previous_request^.request.command [cm].command_code OF
            = ioc$cc_read_bytes =
              IF disk_request_p^.request.command [1].command_code <> ioc$cc_read_bytes THEN
                EXIT /stream_test/; {----->
              IFEND;
            = ioc$cc_write_bytes, ioc$cc_write_initialize =
              IF (disk_request_p^.request.command [1].command_code <> ioc$cc_write_bytes) AND
                    (disk_request_p^.request.command [1].command_code <> ioc$cc_write_initialize) THEN
                EXIT /stream_test/; {----->
              IFEND;
            ELSE
              EXIT /stream_test/; {----->
            CASEND;
            previous_request^.request.pp_switch := TRUE;
            iov$actual_requests_resolved := iov$actual_requests_resolved + 1;
          IFEND;
        IFEND;
      END /stream_test/;

{Clear unit queue lockword.}
      iop$clear_queue_lockword (unit_interface_table_p^.unit_q_lockword);
      disk_request_p^.request_info.time := #FREE_RUNNING_CLOCK (0);

{Normal Exit!
      RETURN; {----->

    END /queue_request_error/;

    status.normal := FALSE;
    p$clean_up_on_error;

  PROCEND iop$queue_request;
?? TITLE := 'iop$find_empty_request', EJECT ??

  PROCEDURE [XDCL] iop$find_empty_request
    (VAR io_request_p: ^iot$io_request;
     VAR status: syt$monitor_status);

    VAR
      dmv$external_interrupt_selector: [XREF] 0 .. 0ff(16),
      osv$external_interrupt_selector: [XREF] 0 .. 0ff(16);

    VAR
      v$initial_pp_request: [READ, oss$mainframe_wired_literal] iot$disk_pp_request := [
{ FILL1                      } 0,
{ NEXT_PP_REQUEST            } NIL,
{ FILL2                      } 0,
{ NEXT_PP_REQUEST_RMA        } 0,
{ REQUEST_LENGTH             } ioc$min_request_length,
{ LOGICAL_UNIT               } 0,
{ RECOVERY                   } ioc$attempt_recovery,
{ INTERRUPT                  } [
{   VALUE                      } FALSE,
{   PORT_NUMBER                } 1],
{ PRIORITY                   } 1,
{ ALERT_CONDITIONS           } [
{   LONG_INPUT_BLOCK           } FALSE,
{   COMPARE_NOT_SATISFIED      } TRUE,
{   PHYSICAL_DELIMITER         } FALSE,
{   LOGICAL_DELIMITER          } FALSE,
{   CHARACTER_FILL             } FALSE,
{   DISABLED_UNIT              } FALSE,
{   FILL                       } 0],
{ PP_SWITCH                  } FALSE,
{   FILL5                      } 0,
{   MAU_COUNT                  } 0,
{   CYLINDER                   } 0,
{   TRACK                      } 0,
{   SECTOR                     } 0,
{ COMMAND                      } [REP ioc$command_count of [
{   COMMAND_CODE                 } 0,
{   FLAGS                        } [
{     STORE_RESPONSE               } TRUE,
{     INDIRECT_ADDRESS             } FALSE,
{     FILL                         } 0],
{   LENGTH                       } 8,
{   ADDRESS                      } 0]]];

    VAR
      v$initialize: [STATIC] boolean := FALSE;

    VAR
      disk_request_p: ^iot$disk_request;

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

    PROCEDURE [INLINE] p$check_stream_requests;

      VAR
        disk_request_p: ^iot$disk_request,
        j: iot$logical_unit,
        logical_unit_p: ^cmt$logical_unit,
        next_io_request: ^iot$io_request,
        next_request: ^iot$disk_request,
        stream_request_pp: ^^iot$io_request;

    /loop/
      FOR j := cmc$job_template_unit_ordinal TO UPPERBOUND (cmv$logical_unit_table^) DO
        logical_unit_p := ^cmv$logical_unit_table^ [j];
        IF (iov$stream_requests [j] <> NIL)
{   } AND (logical_unit_p^.unit_interface_table <> NIL)
{   } AND (logical_unit_p^.configured = TRUE)
{   } AND (logical_unit_p^.unit_interface_table^.unit_type >= 100(16))
{   } AND (logical_unit_p^.unit_interface_table^.unit_type < (ioc$disk_type_count + 100(16))) THEN

          stream_request_pp := ^iov$stream_requests [j];
          next_io_request := logical_unit_p^.unit_interface_table^.next_request;

          WHILE next_io_request <> NIL DO
            IF next_io_request = stream_request_pp^ THEN
              CYCLE /loop/; {----->
            IFEND;
            next_request := next_io_request^.device_request_p;
            next_io_request := next_request^.request.next_pp_request;
          WHILEND;

          iov$stream_requests_search := iov$stream_requests_search + 1;
          iov$empty_requests := stream_request_pp^;
          disk_request_p := stream_request_pp^^.device_request_p;
          stream_request_pp^ := disk_request_p^.link;
          IF stream_request_pp^ = NIL THEN
            iov$stream_requests_end [j] := stream_request_pp;
          IFEND;
          disk_request_p^.link := NIL;
          iov$empty_requests_end := ^disk_request_p^.link;
          EXIT /loop/; {----->
        IFEND;
      FOREND /loop/;

    PROCEND p$check_stream_requests;
?? OLDTITLE ??
?? NEWTITLE := 'p$initialize_requests', EJECT ??

    PROCEDURE p$initialize_requests;

{ PURPOSE:
{   This code intitalizes the request heap & map and the empty request link chain.
{   We run through this code two times, one time in Boot and then when the real Monitor started.

      VAR
        r: 0 .. ioc$request_heap_count,
        ix: 0 .. 2 * ioc$command_map_count,
        jj: 0 .. ioc$command_heap_count,
        i: integer,
        disk_request_p: ^iot$disk_request,
        first_rma: integer,
        last_rma: integer,
        rma: integer;

{Check for any request slots that cross a page boundary.}
      FOR r := 0 TO ioc$request_heap_count DO
        disk_request_p := ^iov$request_heap [r].disk_request;
        disk_request_p^.request_index := r;
        #real_memory_address (#LOC (disk_request_p^.request), first_rma);
        #real_memory_address (#LOC (disk_request_p^.request.command [ioc$command_count]), last_rma);

{set up device_request pointers.
        iov$request_heap [r].io_request.pp_request_p := ^iov$request_heap [r].disk_request.request;
        iov$request_heap [r].io_request.device_request_p := ^iov$request_heap [r].disk_request;

        IF first_rma + ioc$min_request_length + ioc$command_count * 8 - 16 <> last_rma THEN
          iov$request_heap_map [r] := TRUE;
          iov$empty_request_count := iov$empty_request_count - 1;
        ELSE
          iov$empty_requests_end^ := ^iov$request_heap [r].io_request;
          iov$empty_requests_end := ^iov$request_heap [r].disk_request.link;
          iov$empty_requests_end^ := NIL;
        IFEND;
      FOREND;

{Check for any indirect address_length slots that cross a page boundary.}
      #real_memory_address (#LOC (iov$command_heap [1]), first_rma);
      FOR ix := 2 TO ioc$command_map_count DO
        jj := ((ix - 1) * ioc$command_group) + 1;
        #real_memory_address (#LOC (iov$command_heap [jj]), last_rma);
        IF first_rma + (ioc$command_group * 8) <> last_rma THEN
          #real_memory_address (#LOC (iov$command_heap [jj + ioc$command_group - 1]), rma);
          IF last_rma + ((ioc$command_group - 1) * 8) <> rma THEN
            iov$command_heap_map [ix] := TRUE;
          ELSE
            iov$command_heap_map [ix - 1] := TRUE;
          IFEND;
        IFEND;
        first_rma := last_rma;
      FOREND;

{ Initialize iov$stream_requests.
      FOR i := 0 TO c$stream_request_count_max DO
        iov$stream_requests [i] := NIL;
        iov$stream_requests_end [i] := ^iov$stream_requests [i];
      FOREND;

    PROCEND p$initialize_requests;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    IF v$initialize = FALSE THEN
      v$initialize := TRUE;
      p$initialize_requests;
    IFEND;

{ Check if there is an empty request.
    IF iov$empty_requests = NIL THEN
      p$check_stream_requests;
    IFEND;

    io_request_p := iov$empty_requests;
    IF io_request_p = NIL THEN {No more empty request slots. Reject the request.}
      iov$reject_requests_full := iov$reject_requests_full + 1;
      status.normal := FALSE;
      status.condition := ioe$requests_full;

      RETURN; {----->
    IFEND;

{ Delink the request from the beginning of the chain.
    disk_request_p := io_request_p^.device_request_p;
    iov$empty_requests := disk_request_p^.link;
    IF iov$empty_requests = NIL THEN
      iov$empty_requests_end := ^iov$empty_requests;
    IFEND;

{Set up part of the request.}
    disk_request_p^.request := v$initial_pp_request;
    IF dmv$external_interrupt_selector = 1 THEN
      disk_request_p^.request.interrupt.value := TRUE;
      disk_request_p^.request.interrupt.port_number := osv$external_interrupt_selector;
    IFEND;

  PROCEND iop$find_empty_request;
?? TITLE := 'iop$reload_hung_disk_pp', EJECT ??

  PROCEDURE [XDCL] iop$reload_hung_disk_pp
    (    hung_pp: iot$pp_number);

    VAR
      done: boolean,
      first_pp: iot$pp_number,
      first_unit: iot$logical_unit,
      index: integer,
      last_pp: iot$pp_number,
      last_unit: iot$logical_unit,
      partner_pp: iot$pp_number,
      pp: iot$pp_number,
      pp_com_p: ^iot$communication_buffer,
      pp_marks_p: ^array [ * ] of boolean,
      ppit_p: ^iot$pp_interface_table,
      uit_p: ^iot$unit_interface_table,
      unit: iot$logical_unit,
      unit_marks_p: ^array [ * ] of boolean;

    { Initialize marked PP list.

    first_pp := LOWERBOUND (cmv$logical_pp_table_p^);
    last_pp := UPPERBOUND (cmv$logical_pp_table_p^);
    PUSH pp_marks_p: [first_pp .. last_pp];

    FOR pp := first_pp TO last_pp DO
      pp_marks_p^ [pp] := FALSE;
    FOREND;

    { Initialize marked unit list.

    first_unit := LOWERBOUND (cmv$logical_unit_table^);
    last_unit := UPPERBOUND (cmv$logical_unit_table^);
    PUSH unit_marks_p: [first_unit .. last_unit];

    FOR unit := first_unit TO last_unit DO
      unit_marks_p^ [unit] := FALSE;
    FOREND;

    { Mark all PPs and units that are in common with the hung PP.  The goal is
    { to identify all PPs that must be reloaded and all units that must be
    { cleaned up.  A PP is marked for reload if it is the one that is hung or
    { if it shares units with another PP that is to be reloaded.  A unit is
    { marked for cleanup if it can be accessed by a PP that is being reloaded.
    { Note that the marking can ripple from PP to unit to PP to unit etc.,
    { depending on the configuration.

    pp_marks_p^ [hung_pp] := TRUE;
    mark_units (hung_pp, unit_marks_p^);

    REPEAT
      done := TRUE;
      FOR pp := first_pp TO last_pp DO
        IF NOT pp_marks_p^ [pp] AND unit_marked (pp, unit_marks_p^) THEN
          done := FALSE;
          pp_marks_p^ [pp] := TRUE;
          mark_units (pp, unit_marks_p^);
        IFEND;
      FOREND;
    UNTIL done;

    { For each marked PP:
    {   Hardware idle the PP.
    {   Hardware idle the partner PP, if applicable.
    {   Master clear the channel for the PP.
    {   Clear channel locks held by the PP.
    {   Clear the PP hung flag.
    {   Clear the PP communication buffer.
    {   Initialize appropriate fields in the PP interface table.

    FOR pp := first_pp TO last_pp DO
      IF pp_marks_p^ [pp] THEN
        idle_pp (pp);

        partner_pp := cmv$logical_pp_table_p^ [pp].pp_info.logical_partner_pp_index;
        IF (partner_pp <> 0) THEN
          idle_pp (partner_pp);
        IFEND;

        master_clear_channel (pp);

        clear_channel_locks (pp, cmv$logical_pp_table_p^ [pp].pp_info.channel_interlock_p^);

        cmv$logical_pp_table_p^ [pp].flags.pp_hung := FALSE;

        pp_com_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_communication_buffer_p;
        FOR index := LOWERBOUND (pp_com_p^.pp_usage) TO UPPERBOUND (pp_com_p^.pp_usage) DO
          pp_com_p^.pp_usage [index] := 0;
        FOREND;

        empty_response_buffer (pp);

        ppit_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;

        ppit_p^.active_check := FALSE;
        ppit_p^.idle_request := FALSE;
        ppit_p^.resume_request := FALSE;
        ppit_p^.idle_status := FALSE;
        ppit_p^.lock := FALSE;
        ppit_p^.lockword := iov$initial_queue_lock;
      IFEND;
    FOREND;

    { For each marked unit:
    {   Clear unit locks.
    {   Rebuild the unit queue.
    {   Clear the unit communication buffer.

    FOR unit := first_unit TO last_unit DO
      IF unit_marks_p^ [unit] THEN
        uit_p := cmv$logical_unit_table^ [unit].unit_interface_table;
        clear_unit_locks (uit_p^);
        rebuild_unit_queue (uit_p^);
        clear_unit_buffer (cmv$logical_unit_table^ [unit].unit_communication_buffer_pva^);
      IFEND;
    FOREND;

    { For each marked PP:
    {   Reload the PP.
    {   Reload the partner PP, if applicable.

    FOR pp := first_pp TO last_pp DO
      IF pp_marks_p^ [pp] THEN
        reload_pp (pp);

        partner_pp := cmv$logical_pp_table_p^ [pp].pp_info.logical_partner_pp_index;
        IF (partner_pp <> 0) THEN
          reload_pp (partner_pp);
        IFEND;
      IFEND;
    FOREND;
  PROCEND iop$reload_hung_disk_pp;
?? TITLE := 'clear_channel_locks', EJECT ??

  PROCEDURE clear_channel_locks
    (    pp: iot$pp_number;
     VAR chit: iot$channel_interlock_table);

    VAR
      channel: integer,
      count: integer,
      lock: iot$table_lock_entry,
      result: 0 .. 2,
      time: integer,
      timeout: integer,
      unlocked: iot$table_lock_entry;

    unlocked.channel_locked := FALSE;
    unlocked.fill_1 := 0;
    unlocked.ve_need_channel := FALSE;
    unlocked.fill_2 := 0;
    unlocked.maintenance_need_channel := FALSE;
    unlocked.fill_3 := 0;
    unlocked.locking_pp := 0;

    time := #FREE_RUNNING_CLOCK (0);

    FOR channel := LOWERBOUND (chit.channel_table) TO UPPERBOUND (chit.channel_table) DO
      timeout := time + 100000;
      count := 0;
      lock := unlocked;

      REPEAT
        #COMPARE_SWAP (chit.channel_table [channel], lock, unlocked, lock, result);
        IF (result = 1) AND (lock.locking_pp <> pp) THEN
          result := 0;
        IFEND;
        count := count + 1;
        IF (count >= 100) THEN
          count := 0;
          time := #FREE_RUNNING_CLOCK (0);
        IFEND;
      UNTIL (result = 0) OR (time > timeout);
    FOREND;

  PROCEND clear_channel_locks;
?? TITLE := 'clear_unit_buffer', EJECT ??

  PROCEDURE clear_unit_buffer
    (VAR unit_buffer: iot$unit_communication_buffer);

    VAR
      buffer_p: ^array [1 .. * ] of ost$byte,
      index: integer,
      unit_buffer_p: ^iot$unit_communication_buffer;

    unit_buffer_p := ^unit_buffer;
    RESET unit_buffer_p;
    NEXT buffer_p: [1 .. #SIZE (unit_buffer)] IN unit_buffer_p;

    FOR index := LOWERBOUND (buffer_p^) TO UPPERBOUND (buffer_p^) DO
      buffer_p^ [index] := 0;
    FOREND;

  PROCEND clear_unit_buffer;
?? TITLE := 'clear_unit_locks', EJECT ??

  PROCEDURE clear_unit_locks
    (VAR uit: iot$unit_interface_table);

    VAR
      count: integer,
      lock: iot$lockword,
      result: 0 .. 2,
      time: integer,
      timeout: integer;


    { Clear unit lock.
    uit.unit_lockword := iov$initial_queue_lock;

    { Clear unit queue lock.

    time := #FREE_RUNNING_CLOCK (0);
    timeout := time + 100000;
    count := 0;
    lock := iov$initial_queue_lock;

    REPEAT
      #COMPARE_SWAP (uit.unit_q_lockword, lock, iov$initial_queue_lock, lock, result);
      IF (result = 1) AND lock.lock_owner.cpu_lock THEN
        result := 0;
      IFEND;
      count := count + 1;
      IF (count >= 100) THEN
        count := 0;
        time := #FREE_RUNNING_CLOCK (0);
      IFEND;
    UNTIL (result = 0) OR (time > timeout);

    IF (result = 2) THEN

      { The compare swap lock pattern must have been left set by a dead PP
      { or another CPU that died in the middle of a compare swap instruction.
      { In either case, clear the lock.

      uit.unit_q_lockword := iov$initial_queue_lock;
    IFEND;

  PROCEND clear_unit_locks;
?? TITLE := 'empty_response_buffer', EJECT ??

  PROCEDURE empty_response_buffer
    (    pp: iot$pp_number);

    VAR
      msg: string (40),
      ppit_p: ^iot$pp_interface_table;

    ppit_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;

    IF (ppit_p^.inn <> ppit_p^.out) THEN
      msg := 'In <> Out for PP __, IOU _, _CH ___.';
      get_pp_id_string (pp, msg (15, 21));

      dpp$display_error (msg);

      iop$process_io_completions;

      IF (ppit_p^.inn <> ppit_p^.out) THEN
        mtp$error_stop (msg);
      IFEND;
    IFEND;

  PROCEND empty_response_buffer;
?? TITLE := 'get_pp_id_string', EJECT ??

  PROCEDURE get_pp_id_string
    (    pp: iot$pp_number;
     VAR id_string: string (21));

    VAR
      channel: dst$iou_resource,
      physical_pp: dst$iou_resource,
      port: cmt$channel_port;

    channel := cmv$logical_pp_table_p^ [pp].pp_info.channel;
    physical_pp := cmv$logical_pp_table_p^ [pp].pp_info.physical_pp;
    port := cmv$logical_pp_table_p^ [pp].pp_info.channel_port;

    id_string := 'PP __, IOU _,  CH __ ';

    dpp$convert_int_to_str_octal (physical_pp.number, 2, id_string (4, 2));

    dpp$convert_int_to_str_octal (physical_pp.iou_number, 1, id_string (12, 1));

    IF (channel.channel_protocol = dsc$cpt_cio) THEN
      id_string (15, 1) := 'C';
    IFEND;

    dpp$convert_int_to_str_octal (channel.number, 2, id_string (19, 2));

    IF (port = cmc$port_a) THEN
      id_string (21, 1) := 'A';
    ELSEIF (port = cmc$port_b) THEN
      id_string (21, 1) := 'B';
    IFEND;

  PROCEND get_pp_id_string;
?? TITLE := 'idle_pp', EJECT ??

  PROCEDURE idle_pp
    (    pp: iot$pp_number);

    VAR
      msg: string (40),
      seq_p: ^SEQ ( * ),
      status: syt$monitor_status;

    seq_p := NIL;

    dsp$mtr_dft_puf_request (dsc$dpuf_idle_pp, pp, 0, seq_p, status);

    IF NOT status.normal THEN
      msg := 'Idle of PP __, IOU _, _CH ___ failed.';
      get_pp_id_string (pp, msg (9, 21));
      mtp$error_stop (msg);
    IFEND;

  PROCEND idle_pp;
?? TITLE := 'mark_units', EJECT ??

  PROCEDURE mark_units
    (    pp: iot$pp_number;
     VAR unit_marks: array [ * ] of boolean);

    VAR
      ppit_p: ^iot$pp_interface_table,
      unit: iot$logical_unit;

    ppit_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;

    FOR unit := LOWERBOUND (ppit_p^.unit_descriptors) TO UPPERBOUND (ppit_p^.unit_descriptors) DO
      IF (ppit_p^.unit_descriptors [unit].unit_interface_table_rma <> 0) THEN
        unit_marks [unit] := TRUE;
      IFEND;
    FOREND;

  PROCEND mark_units;
?? TITLE := 'master_clear_channel', EJECT ??

  PROCEDURE master_clear_channel
    (    pp: iot$pp_number);

    VAR
      msg: string (50),
      seq_p: ^SEQ ( * ),
      status: syt$monitor_status;

    seq_p := NIL;

    dsp$mtr_dft_puf_request (dsc$dpuf_master_clear_channel, pp, 0, seq_p, status);

    IF NOT status.normal THEN
      msg := 'Master clear of PP __, IOU _, _CH ___ failed.';
      get_pp_id_string (pp, msg (17, 21));
      mtp$error_stop (msg);
    IFEND;

  PROCEND master_clear_channel;
?? TITLE := 'rebuild_unit_queue', EJECT ??

  PROCEDURE rebuild_unit_queue
    (VAR uit: iot$unit_interface_table);

    VAR
      count: integer,
      index: integer,
      msg: string (50),
      lock_set: boolean;

    iop$set_queue_lockword (uit.unit_q_lockword, lock_set);
    IF NOT lock_set THEN
      RETURN; {----->
    IFEND;

{ Rebuild unit queue.
    uit.queue_count := 0;
    uit.next_request := NIL;
    uit.next_request_rma := 0;

    FOR index := LOWERBOUND (iov$request_heap) TO UPPERBOUND (iov$request_heap) DO
      IF iov$request_heap_map [index] AND (uit.logical_unit =
            iov$request_heap [index].disk_request.request.logical_unit) THEN
        requeue_request (iov$request_heap [index], uit);
      IFEND;
    FOREND;

    iop$clear_queue_lockword (uit.unit_q_lockword);

  PROCEND rebuild_unit_queue;
?? TITLE := 'reload_pp', EJECT ??

  PROCEDURE reload_pp
    (    pp: iot$pp_number);

    VAR
      msg: string (40),
      seq_p: ^SEQ ( * ),
      status: syt$monitor_status;

    seq_p := NIL;

    dsp$mtr_dft_puf_request (dsc$dpuf_load_pp, pp, 0, seq_p, status);

    IF status.normal THEN
      msg := 'Reloaded PP __, IOU _, _CH ___.';
      get_pp_id_string (pp, msg (10, 21));
      dpp$display_error (msg);
    ELSE
      msg := 'Reload of PP __, IOU _, _CH ___ failed.';
      get_pp_id_string (pp, msg (11, 21));
      mtp$error_stop (msg);
    IFEND;

  PROCEND reload_pp;
?? TITLE := 'requeue_request', EJECT ??

  PROCEDURE requeue_request
    (VAR request: iot$io_disk_request;
     VAR uit: iot$unit_interface_table);

    VAR
      current_p: ^iot$disk_request,
      cylinder: iot$cylinder,
      insert_p: ^iot$disk_request,
      next_p: ^iot$io_request,
      q_cylinder: iot$cylinder,
      q_time: integer,
      request_pva: ^iot$io_request,
      request_rma: integer,
      time: integer;

    cylinder := request.disk_request.request.cylinder;
    time := request.disk_request.request_info.time;
    request_pva := ^request.io_request;
    #real_memory_address (#LOC (request.disk_request.request), request_rma);

    next_p := uit.next_request;
    insert_p := NIL;

    WHILE (next_p <> NIL) DO
      current_p := next_p^.device_request_p;
      q_cylinder := current_p^.request.cylinder;
      q_time := current_p^.request_info.time;
      IF (cylinder < q_cylinder) OR ((cylinder = q_cylinder) AND (time < q_time)) THEN
        next_p := NIL;
      ELSE
        insert_p := current_p;
        next_p := current_p^.request.next_pp_request;
      IFEND;
    WHILEND;

    IF (insert_p = NIL) THEN
      request.disk_request.request.next_pp_request := uit.next_request;
      request.disk_request.request.next_pp_request_rma := uit.next_request_rma;
      uit.next_request := request_pva;
      uit.next_request_rma := request_rma;
    ELSE
      request.disk_request.request.next_pp_request := insert_p^.request.next_pp_request;
      request.disk_request.request.next_pp_request_rma := insert_p^.request.next_pp_request_rma;
      insert_p^.request.next_pp_request := request_pva;
      insert_p^.request.next_pp_request_rma := request_rma;
    IFEND;

    uit.queue_count := uit.queue_count + 1;

  PROCEND requeue_request;
*if false
?? TITLE := 'simulate_disk_fault', EJECT ??

  PROCEDURE simulate_disk_fault
    (    request_info: iot$request_info;
     VAR status: syt$monitor_status);

    VAR
      disk_fault: integer;

    status.normal := TRUE;
    FOR disk_fault := LOWERBOUND (osv$simulated_disk_fault) TO UPPERBOUND (osv$simulated_disk_fault) DO
      IF osv$simulated_disk_fault [disk_fault].in_use THEN
        IF osv$simulated_disk_fault [disk_fault].sfid = request_info.system_file_id THEN
          IF (osv$simulated_disk_fault [disk_fault].write_fault AND
                ((request_info.io_function = ioc$write_page) OR
                (request_info.io_function = ioc$write_locked_page) OR
                (request_info.io_function = ioc$swap_out) OR (request_info.io_function =
                ioc$write_for_server))) OR (osv$simulated_disk_fault [disk_fault].
                read_fault AND (request_info.io_function = ioc$swap_in)) THEN
            IF (osv$simulated_disk_fault [disk_fault].first_byte <= request_info.byte_address) AND
                  (osv$simulated_disk_fault [disk_fault].last_byte >= request_info.byte_address) THEN
              IF osv$simulated_disk_fault [disk_fault].error_type = ioc$unrecovered_error_unit_down THEN
                IF osv$simulated_disk_fault [disk_fault].skip_count > 0 THEN
                  osv$simulated_disk_fault [disk_fault].skip_count :=
                        osv$simulated_disk_fault [disk_fault].skip_count - 1;
                ELSE
                  IF osv$simulated_disk_fault [disk_fault].count > 0 THEN
                    osv$simulated_disk_fault [disk_fault].count := osv$simulated_disk_fault [disk_fault].
                          count - 1;
                    status.normal := FALSE;
                    status.condition := ioe$unit_disabled;
                    RETURN; {----->
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

  PROCEND simulate_disk_fault;
*ifend
?? TITLE := 'unit_marked', EJECT ??

  FUNCTION unit_marked
    (    pp: iot$pp_number;
         unit_marks: array [ * ] of boolean): boolean;

    VAR
      ppit_p: ^iot$pp_interface_table,
      unit: iot$logical_unit;

    unit_marked := FALSE;

    IF NOT cmv$logical_pp_table_p^ [pp].flags.entry_in_use OR
          NOT cmv$logical_pp_table_p^ [pp].flags.configured OR
          (cmv$logical_pp_table_p^ [pp].pp_info.pp_type <> cmc$lpt_disk_pp_type) THEN
      RETURN; {----->
    IFEND;

    IF (cmv$logical_pp_table_p^ [pp].pp_info.logical_partner_pp_index <> 0) AND
          cmv$logical_pp_table_p^ [pp].pp_info.pp_communication_buffer_p^.slave THEN
      RETURN; {----->
    IFEND;

    ppit_p := cmv$logical_pp_table_p^ [pp].pp_info.pp_interface_table_p;

    FOR unit := LOWERBOUND (ppit_p^.unit_descriptors) TO UPPERBOUND (ppit_p^.unit_descriptors) DO
      IF (ppit_p^.unit_descriptors [unit].unit_interface_table_rma <> 0) AND unit_marks [unit] THEN
        unit_marked := TRUE;
        RETURN; {----->
      IFEND;
    FOREND;

  FUNCEND unit_marked;
MODEND iom$queue_request;

