?? RIGHT := 110 ??
MODULE mmm$read_write_io_ring_any;

{ This module contains request processors for user read/write requests.

?? PUSH (LISTEXT := ON) ??
*copyc ioe$st_errors
*copyc mmc$move_pages_max_req_length
*copyc mme$condition_codes
*copyc mmt$attribute_keyword
*copyc mmt$io_control_block
*copyc mmt$move_pages_page_count
*copyc mmt$rb_assign_pages
*copyc mmt$rb_free_flush
*copyc mmt$rb_memory_manager_io
*copyc mmt$rb_move_pages
*copyc osc$processor_defined_registers
*copyc osd$conditions
*copyc osd$virtual_address
*copyc ost$caller_identifier
*copyc ost$execution_control_block
*copyc ost$stack_frame_save_area
*copyc ost$status
*copyc pmt$condition
*copyc pmt$condition_information
*copyc syt$monitor_request_code
*copyc syc$monitor_request_codes
?? POP ??

{External procedures used by this module.

*copyc i#call_monitor
*copyc i#disable_traps
*copyc i#move
*copyc i#restore_traps
*copyc ifp$invoke_pause_utility
*copyc mmp$allocate_iocb_r3
*copyc mmp$check_if_pages_in_memory
*copyc mmp$fetch_segment_attributes
*copyc mmp$get_page_size
*copyc mmp$reallocate_file_space
*copyc mmp$verify_access
*copyc mmp$wait_for_iocb_entry
*copyc ofp$display_status_message
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_from_condition
*copyc osp$set_status_from_mtr_status
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$wait_on_condition
*copyc pmp$continue_to_cause
*copyc pmp$cycle
*copyc pmp$delay
*copyc pmp$log
*copyc pmp$long_term_wait
*copyc pmp$wait

  CONST
    max_length = 65536;


?? TITLE := 'MMP$MOVE_PAGES' ??
?? EJECT ??
{--------------------------------------------------------------------------------------------------------
*copyc mmh$move_pages
{--------------------------------------------------------------------------------------------------------
?? EJECT ??

  PROCEDURE [XDCL, #GATE] mmp$move_pages
    (    pva_source: ^cell;
         pva_destination: ^cell;
         length: ost$segment_length;
         modified_bit_option: mmt$modified_bit_option;
         reject_move_if_source_modified: boolean;
     VAR moved_modified_page_count: mmt$move_pages_page_count;
     VAR status: ost$status);

    VAR
      dummy_modified_count: mmt$move_pages_page_count,
      dummy: integer,
      i: integer,
      ignore_status: ost$status,
      number_of_bytes_moved: ost$segment_length,
      number_of_pages_moved: mmt$move_pages_page_count,
      number_of_pages_to_move: mmt$move_pages_page_count,
      offset_pva_destination: integer,
      offset_pva_source: integer,
      page_size: integer,
      rb: mmt$rb_move_pages,
      reference_page: ^array [1..512] of integer,
      xpva_destination: ^cell,
      xlength: ost$segment_length,
      xpva_source: ^cell;


    status.normal := TRUE;

    mmp$get_page_size (page_size);
    offset_pva_source := #offset (pva_source);
    offset_pva_destination := #offset (pva_destination);

{ Verify the length parameter.  Verification of the pva's will be done in monitor
{ mode to prevent duplication of checks.

    IF (length <= 0) OR (length > mmc$move_pages_max_req_length) THEN
      osp$set_status_abnormal ('MM', mme$invalid_length_requested, '', status);
      RETURN;
    IFEND;

    IF (length MOD page_size <> 0) THEN
      osp$set_status_abnormal ('MM', mme$length_not_page_size_mult, '', status);
      RETURN;
    IFEND;

{ Determine the number of pages to move.

    number_of_pages_to_move := length DIV page_size;

    number_of_pages_moved := 0;
    moved_modified_page_count := 0;

{ Issue a monitor request to move the pages.

  /move_pages/

    WHILE (number_of_pages_moved < number_of_pages_to_move) DO
      number_of_bytes_moved := page_size * number_of_pages_moved;
      xpva_source := #address (1, #segment (pva_source), (offset_pva_source + number_of_bytes_moved));
      xpva_destination := #address (1, #segment (pva_destination),
            (offset_pva_destination + number_of_bytes_moved));
      xlength := length - number_of_bytes_moved;

{ Reference each source page so that it is in memory.

      reference_page := xpva_source;
      FOR i := (number_of_pages_moved + 1) TO number_of_pages_to_move  DO
        dummy := reference_page^ [1];
        reference_page := #address (1, #segment (xpva_source), (#offset (xpva_source) + page_size));
      FOREND;

      rb.reqcode := syc$rc_move_pages;
      rb.pva_source := xpva_source;
      rb.pva_destination := xpva_destination;
      rb.length := xlength;
      rb.modified_bit_option := modified_bit_option;
      rb.reject_move_if_source_modified := reject_move_if_source_modified;

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

      number_of_pages_moved := number_of_pages_moved + rb.number_of_pages_moved;
      moved_modified_page_count := moved_modified_page_count + rb.moved_modified_page_count;

      IF NOT rb.status.normal THEN
        IF (rb.status.condition = mme$source_page_not_in_memory) THEN
          { do nothing, at the beginning of the loop each page is referenced to get it in memory

        ELSEIF (rb.status.condition = mme$dm_assign_active) THEN

{ Do nothing.  In monitor, a flag was set which should have gotten the job to trap to process the extension
{ for the destination page's segment.  By the time the job gets here, the allocation should have been done.

        ELSEIF (rb.status.condition = mme$io_active_on_move_page) THEN
          pmp$delay (20, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        ELSEIF (rb.status.condition = mme$page_table_full) THEN
          { give up the CPU so memory manager can rectify the condition
          pmp$cycle (ignore_status);

        ELSEIF (rb.status.condition = mme$modified_source_page_reject) THEN
          { put any pages that have been moved back where they were
          IF number_of_pages_moved > 0 THEN
            mmp$move_pages (pva_destination, pva_source, (number_of_pages_moved * page_size),
                  mmc$mp_clear_modified, FALSE, dummy_modified_count, status);
            IF NOT status.normal THEN
              osp$system_error ('Unable to back out of mmp$move_pages upon modified reject', ^status);
            IFEND;
          IFEND;
          moved_modified_page_count := 0;
          osp$set_status_abnormal ('MM', mme$modified_source_page_reject, '', status);
          RETURN;

        ELSE
          osp$set_status_from_mtr_status (rb.status, status);
          RETURN;
        IFEND;
      IFEND;
    WHILEND /move_pages/;

  PROCEND mmp$move_pages;

?? TITLE := 'mmp$read' ??
?? EJECT ??
{--------------------------------------------------------------------------------------------------------
*copyc mmh$read
{--------------------------------------------------------------------------------------------------------

  PROCEDURE [XDCL, #GATE] mmp$read (pva: ^cell;
        length: ost$segment_length;
        iostatus_p: ^mmt$io_status;
        wait: ost$wait;
    VAR status: ost$status);

    VAR
      pages_in_memory: boolean,
      done: boolean,
      rb: mmt$rb_memory_manager_io;

    IF length > max_length THEN
      osp$set_status_abnormal ('MM', mme$request_length_too_long, ' ', status);
      RETURN;
    IFEND;

    IF #offset (pva) + length > osc$max_segment_length THEN
      osp$set_status_abnormal ('MM', mme$invalid_pva_formed, ' ', status);
      RETURN;
    IFEND;

    REPEAT
{Set up the request block and call monitor.

      status.normal := TRUE;

      done := TRUE;

      rb.reqcode := syc$rc_memory_manager_io;
      rb.status.normal := TRUE;
      rb.condition := 0;
      rb.active_io_count := 0;
      rb.pva := pva;
      rb.length := length;
      rb.stat_p := iostatus_p;
      rb.waitopt := wait;
      rb.sub_reqcode := mmc$iorc_read_pages;
      i#call_monitor (#LOC (rb), #SIZE (rb));
      osp$set_status_from_mtr_status (rb.status, status);

      IF NOT rb.status.normal THEN
        IF rb.status.condition = mme$nil_io_control_block THEN
          mmp$allocate_iocb_r3;
          done := FALSE;
        ELSEIF rb.status.condition = mme$full_io_control_block THEN
          mmp$wait_for_iocb_entry (status);
          IF status.normal THEN
            done := FALSE;
          IFEND;
        ELSEIF rb.status.condition = mme$page_found_in_memory THEN
          status.normal := TRUE;
          mmp$check_if_pages_in_memory (rb.pva, rb.length, pages_in_memory);
          IF pages_in_memory THEN
            iostatus_p^.request_status := mmc$irs_complete;
            iostatus_p^.condition := 0;
          ELSE
            done := FALSE;
          IFEND;
        ELSEIF rb.status.condition = mme$volume_unavailable THEN
          done := FALSE;
          osp$wait_on_condition (rb.status.condition);
        ELSE
          iostatus_p^.request_status := mmc$irs_none;
        IFEND;
      ELSE
        IF wait = osc$wait THEN
          iostatus_p^.request_status := mmc$irs_complete;
          iostatus_p^.condition := rb.condition;
          IF rb.condition = 0 THEN
            mmp$check_if_pages_in_memory (rb.pva, rb.length, pages_in_memory);
            IF NOT pages_in_memory THEN
              done := FALSE;
            IFEND;
          IFEND;
        ELSE
          iostatus_p^.request_status := mmc$irs_active;
        IFEND;
      IFEND;
    UNTIL done;

  PROCEND mmp$read;

?? TITLE := 'mmp$write' ??
?? EJECT ??
{--------------------------------------------------------------------------------------------------------
*copyc mmh$write
{--------------------------------------------------------------------------------------------------------

  PROCEDURE [XDCL, #GATE] mmp$write (pva: ^cell;
        length: ost$segment_length;
        remove_pages: boolean;
        iostatus_p: ^mmt$io_status;
        wait: ost$wait;
    VAR status: ost$status);

    VAR
      reallocate_count: integer,
      rb: mmt$rb_memory_manager_io;

    IF length > max_length THEN
      osp$set_status_abnormal ('MM', mme$request_length_too_long, ' ', status);
      RETURN;
    IFEND;

    IF #offset (pva) + length > osc$max_segment_length THEN
      osp$set_status_abnormal ('MM', mme$invalid_pva_formed, ' ', status);
      RETURN;
    IFEND;

{Set up the request block and call monitor.

    status.normal := TRUE;

    reallocate_count := 0;
  /reallocate/
    WHILE TRUE DO

    rb.reqcode := syc$rc_memory_manager_io;
    rb.status.normal := TRUE;
    rb.condition := 0;
    rb.active_io_count := 0;
    rb.pva := pva;
    rb.length := length;
    rb.stat_p := iostatus_p;
    rb.waitopt := wait;

{   Mmp$mtr_write will modify rb.init_new_io to FALSE if call is reissued for the wait option.

    rb.init_new_io := TRUE;
    rb.sub_reqcode := mmc$iorc_write_pages;
    rb.remove_pages := remove_pages;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    osp$set_status_from_mtr_status (rb.status, status);

    IF NOT rb.status.normal THEN
      IF rb.status.condition = mme$nil_io_control_block THEN
        mmp$allocate_iocb_r3;
        mmp$write (pva, length, remove_pages, iostatus_p, wait, status);
      ELSEIF rb.status.condition = mme$full_io_control_block THEN
        mmp$wait_for_iocb_entry (status);
        IF status.normal THEN
          mmp$write (pva, length, remove_pages, iostatus_p, wait, status);
        IFEND;
      ELSEIF rb.status.condition = ioc$disk_media_error THEN
        iostatus_p^.request_status := mmc$irs_complete;
        iostatus_p^.condition := rb.status.condition;
        status.normal := TRUE;
      ELSEIF rb.status.condition = mme$volume_unavailable THEN
        iostatus_p^.request_status := mmc$irs_complete;
        iostatus_p^.condition := rb.status.condition;
        status.normal := TRUE;
      ELSEIF rb.status.condition = mme$write_status_complete THEN
        iostatus_p^.request_status := mmc$irs_complete;
        iostatus_p^.condition := 0;
        status.normal := TRUE;
      ELSE
        iostatus_p^.request_status := mmc$irs_none;
      IFEND;
    ELSE
      IF wait = osc$wait THEN
        iostatus_p^.request_status := mmc$irs_complete;
        iostatus_p^.condition := rb.condition;
      ELSE
        iostatus_p^.request_status := mmc$irs_active;
      IFEND;
    IFEND;

    IF iostatus_p^.request_status = mmc$irs_complete THEN
      IF iostatus_p^.condition = ioc$disk_media_error THEN
        reallocate_count := reallocate_count + 1;
        IF reallocate_count < 4 THEN
          mmp$reallocate_file_space (pva, status);
          IF status.normal THEN
            CYCLE /reallocate/;
          ELSE
            status.normal := TRUE;
          IFEND;
        ELSE
          status.normal := TRUE;
        IFEND;
      ELSEIF iostatus_p^.condition = mme$volume_unavailable THEN
        osp$wait_on_condition (iostatus_p^.condition);
        CYCLE /reallocate/;
      IFEND;
    IFEND;

    EXIT /reallocate/;
    WHILEND /reallocate/;

  PROCEND mmp$write;

?? TITLE := 'MMP$ASSIGN_PAGES', EJECT ??

*copyc mmh$assign_pages

  PROCEDURE [XDCL, #GATE] mmp$assign_pages (pva: ^cell;
        length: ost$segment_length;
        preset_pages: boolean;
        wait: ost$wait;
    VAR status: ost$status);

    CONST
      word_size = 8;

    VAR
      caller_id: ost$caller_identifier,
      dummy: pmt$initialization_value,
      full_page_between: boolean,
      i: integer,
      offset_pva: integer,
      p_first_partial_page: ^array [1 .. 2048] of pmt$initialization_value,
      p_last_partial_page: ^array [1 .. 2048] of pmt$initialization_value,
      p_last_word: ^array [1 .. 1] of integer,
      p_preset: ^array [1 .. 1] of pmt$initialization_value,
      page_size: integer,
      partial_first_page: boolean,
      partial_first_page_bytes: integer,
      partial_first_word_bytes: 0..7fffffff(16),
      partial_first_page_word_count: integer,
      partial_first_word: boolean,
      partial_last_page: boolean,
      partial_last_page_bytes: integer,
      partial_last_word_bytes: 0..7fffffff(16),
      partial_last_page_word_count: integer,
      partial_last_word: boolean,
      part_last_word_in_1st_page: boolean,
      preset_value: pmt$initialization_value,
      rb: mmt$rb_assign_pages,
      rb_c: mmt$rb_assign_pages,
      segment_pva: 0..0ffff(16),
      seg_attributes: array [1..1] of mmt$attribute_descriptor,
      te: 0..3,
      try: boolean,
      xlength: ost$segment_length,
      xpva: ^cell,
      ucr: record
        case 0..1 of
        = 0 =
          register: integer,
        = 1 =
          fill: 0 .. 0ffffffffffff(16),
          user_mask: ost$user_conditions,
        casend,
        recend;

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

    PROCEDURE ch (condition: pmt$condition;
          condition_info: ^pmt$condition_information;
          save_area: ^ost$stack_frame_save_area;
      VAR handler_status: ost$status);

      VAR
        local_status: ost$status;

      handler_status.normal := TRUE;
      local_status.normal := TRUE;
      CASE condition.selector OF
      = ifc$interactive_condition =
        IF condition.interactive_condition <> ifc$terminate_break THEN
          IF condition.interactive_condition = ifc$pause_break THEN
            ifp$invoke_pause_utility (local_status);
            RETURN;
          ELSE
            pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
            RETURN;
          IFEND;
        IFEND;
        ofp$display_status_message (' Terminate break received while requesting to assign memory.',
              local_status);
        pmp$log (' Terminate break received while requesting to assign memory.', local_status);
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
        osp$set_status_from_condition ('MM', condition, save_area, status, local_status);
        IF NOT local_status.normal THEN
          status := local_status;
        IFEND;
        EXIT mmp$assign_pages;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, local_status);
      CASEND;

    PROCEND ch;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    rb.status.normal := TRUE;

    offset_pva := #offset (pva);
    segment_pva := #segment (pva);

    IF offset_pva + length > osc$max_segment_length THEN
      osp$set_status_abnormal ('MM', mme$invalid_pva_formed, ' ', status);
      RETURN;
    IFEND;

    IF length <= 0 THEN
      osp$set_status_abnormal ('MM', mme$length_must_be_positive, ' ', status);
      RETURN;
    IFEND;

    osp$establish_condition_handler(^ch, TRUE);

    partial_first_page := FALSE;
    partial_first_word := FALSE;
    partial_last_page := FALSE;
    partial_last_word := FALSE;
    part_last_word_in_1st_page := FALSE;
    full_page_between := FALSE;

    mmp$get_page_size (page_size);

{ Round up and down so that the monitor request is for full pages only.  The variables XPVA
{ and XLENGTH are used for the rounding calculations and issued to the monitor request.
{ Partial pages are referenced to read them into memory.  In order to preset partial pages, it is
{ necessary to determine where the request begins and ends with respect to partial first
{ and last pages and words and whether the request is wholly contained within one page.

    xpva := pva;

{ Determine where the request begins

    IF ((offset_pva MOD page_size) <> 0) OR (length < page_size) THEN

{ The request does not begin on a page boundary or is for less than one full page.

      xpva := #address (1, segment_pva, (((offset_pva DIV page_size)
             * page_size) + page_size));
      partial_first_page := TRUE;
      partial_first_page_bytes := (page_size - (offset_pva MOD page_size));
      IF length > partial_first_page_bytes THEN
        xlength := length - partial_first_page_bytes;
      ELSE   { The request is for less than one page }
        xlength := 0;
        partial_first_page_bytes := length;
      IFEND;
      partial_first_word_bytes := word_size - (offset_pva MOD word_size);
      IF partial_first_word_bytes <> word_size THEN
        partial_first_word := TRUE;
        IF (offset_pva + partial_first_word_bytes) <> page_size THEN
          { The new address will be in the same page.
          p_first_partial_page := #address (1, segment_pva, (offset_pva + partial_first_word_bytes));
        ELSE
          p_first_partial_page := pva;
        IFEND;
        IF (offset_pva + length) <= word_size THEN
          {The request is contained in one word.
          p_first_partial_page := pva;
          partial_first_word_bytes := length;
        IFEND;
        partial_first_page_word_count := (partial_first_page_bytes - partial_first_word_bytes) DIV
              word_size;
      ELSE
        partial_first_word_bytes := 0;
        p_first_partial_page := pva;
        partial_first_page_word_count := partial_first_page_bytes DIV word_size;
      IFEND;

{ IF xlength is 0 then the request is contained in one page; determine if there is a partial last word.

      IF xlength = 0 THEN
        partial_last_word_bytes := (partial_first_page_bytes - partial_first_word_bytes) MOD word_size;
        IF partial_last_word_bytes <> 0 THEN
          part_last_word_in_1st_page := TRUE;
          p_last_word := #address (1, segment_pva, (#offset (p_first_partial_page) +
                (partial_first_page_word_count * word_size)));
        IFEND;
      IFEND;
    ELSE

{ The request begins on a page boundary and is for at least one complete page.

      xlength := length;
    IFEND;

{ Determine where the request ends

    partial_last_page_bytes := (xlength MOD page_size);
    IF partial_last_page_bytes  <> 0 THEN
      partial_last_page := TRUE;
      xlength := xlength - partial_last_page_bytes;
      partial_last_word_bytes := partial_last_page_bytes MOD word_size;
      partial_last_page_word_count := (partial_last_page_bytes - partial_last_word_bytes) DIV word_size;
      p_last_partial_page := #address (1, #segment (xpva), (#offset (xpva) + xlength));
      IF partial_last_word_bytes <> 0 THEN
        partial_last_word := TRUE;
        p_last_word := #address (1, segment_pva, (offset_pva + length - partial_last_word_bytes));
      IFEND;
    IFEND;

    IF xlength > 0 THEN
      full_page_between := TRUE;
      p_preset := xpva;
    IFEND;

    try := false;

    REPEAT
      i#disable_traps (te);

      REPEAT
        status.normal := TRUE;

        { Reference partial pages (if there are any) so they will be read into memory.
        IF partial_first_page THEN
          dummy := p_first_partial_page^ [1];
        IFEND;

        IF partial_last_page THEN
          dummy := p_last_partial_page^ [1];
        IFEND;

        { Issue a monitor request to assign full pages.
        IF full_page_between THEN
          rb.reqcode := syc$rc_assign_pages;
          rb.status.normal := TRUE;
          rb.sub_reqcode := mmc$aprc_assign;
          rb.pva := xpva;
          rb.length := xlength;
          rb.preset_pages := preset_pages;
          rb.waitopt := wait;
          i#call_monitor (#LOC (rb), #SIZE (rb));
        IFEND;
        ucr.register := #read_register (osc$pr_user_condition_reg);

        IF NOT rb.status.normal THEN
          IF (rb.status.condition = mme$memory_not_avail_for_assign) AND (NOT try) THEN
            try := true;
            pmp$wait (1000, 1000);
          ELSEIF rb.status.condition = mme$wait_so_other_tasks_can_run THEN
            pmp$wait (1000, 1000);
          ELSEIF (rb.status.condition <> mme$dm_assign_active) AND
                (rb.status.condition <> mme$temporary_reject) AND
                (rb.status.condition <> mme$page_table_full) AND
                (((rb.status.condition = mme$memory_not_avail_for_assign) AND
                (rb.waitopt = osc$nowait)) OR
                (rb.status.condition <> mme$memory_not_avail_for_assign)) THEN
            osp$set_status_from_mtr_status (rb.status, status);
            rb.status.normal := TRUE;
          IFEND;
        IFEND;

      UNTIL (rb.status.normal) OR (osc$free_flag IN ucr.user_mask);

      IF (osc$free_flag IN ucr.user_mask) THEN

{ Before handling interrupts, cancel any reserve requests the job has so that memory is
{ not reserved indefinitely.

        rb_c.reqcode := syc$rc_assign_pages;
        rb_c.status.normal := TRUE;
        rb_c.sub_reqcode := mmc$aprc_cancel_reserve;
        i#call_monitor (#LOC (rb_c), #SIZE (rb_c));
      IFEND;

      i#restore_traps (te);

{ Call long term wait to force a task switch, which causes signals to be processed, if the free flag was set.
      IF (osc$free_flag IN ucr.user_mask) THEN
        #CALLER_ID (caller_id);
        IF caller_id.ring <= osc$tsrv_ring THEN
          pmp$long_term_wait (0,0);
        IFEND;
      IFEND;

    UNTIL rb.status.normal;

    IF status.normal AND preset_pages AND (partial_first_page OR partial_last_page) THEN

{ Preset partial pages.  If a full page was assigned, then that page can be read to determine
{ the preset value; otherwise the preset value must be determined from the segment attributes.
{ NOTE:  The fastest way to preset the a partial page is to treat the page as an array of words.
{ The starting address and number of words have been determined earlier.

      IF NOT full_page_between THEN
        seg_attributes [1].keyword := mmc$kw_preset_value;
        mmp$fetch_segment_attributes (pva, seg_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        preset_value := seg_attributes [1].preset_value;
      ELSE
        preset_value := p_preset^ [1];
      IFEND;

{ Preset partial first page.

      IF partial_first_page THEN
        FOR i := 1 TO partial_first_page_word_count DO
          p_first_partial_page^ [i] := preset_value;
        FOREND;
        IF partial_first_word THEN
          i#move (^preset_value, pva, partial_first_word_bytes);
        IFEND;
        IF part_last_word_in_1st_page THEN
          i#move (^preset_value, p_last_word, partial_last_word_bytes);
        IFEND;
      IFEND;

{ Preset partial last page.

      IF partial_last_page THEN
        FOR i := 1 TO partial_last_page_word_count DO
          p_last_partial_page^ [i] := preset_value;
        FOREND;
        IF partial_last_word THEN
          i#move (^preset_value, p_last_word, partial_last_word_bytes);
        IFEND;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND mmp$assign_pages;

?? TITLE := 'MMP$CONDITIONAL_FREE' ??
?? EJECT ??

*copyc mmh$conditional_free

  PROCEDURE [XDCL, #GATE] mmp$conditional_free ( pva: ^cell;
        length: ost$segment_length;
    VAR status: ost$status);

    VAR
      page_size: integer,
      rb: mmt$rb_free_flush,
      xlength: ost$segment_length,
      xpva: ^cell;

    status.normal := TRUE;

    IF #offset (pva) + length > osc$max_segment_length THEN
      osp$set_status_abnormal ('MM', mme$invalid_pva_formed, ' ', status);
      RETURN;
    IFEND;

    IF length <= 0 THEN
      osp$set_status_abnormal ('MM', mme$length_must_be_positive, ' ', status);
      RETURN;
    IFEND;

    mmp$get_page_size (page_size);

    { Round up and down so that the monitor request is for full pages only.
    xpva := pva;
    IF (#offset (pva) MOD page_size) <> 0 THEN
      xpva := #address (#ring (pva), #segment (pva), (((#offset (pva) DIV page_size)
            * page_size) + page_size));
      xlength := length - (page_size - (#offset (pva) MOD page_size));
    ELSE
      xlength := length;
    IFEND;
    IF ((#offset (xpva) + xlength) MOD page_size) <> 0 THEN
      xlength := xlength - (xlength MOD page_size);
    IFEND;

    rb.reqcode := syc$rc_conditional_free;
    rb.pva := xpva;
    rb.length := xlength;
    rb.waitopt := osc$nowait;
    i#call_monitor (#LOC (rb), #SIZE(rb));
    osp$set_status_from_mtr_status (rb.status, status);

  PROCEND mmp$conditional_free;

MODEND mmm$read_write_io_ring_any;
