?? RIGHT := 110, LEFT := 1 ??
MODULE mmm$memory_mgr_request_procs {MMREQS} ;

?? SKIP := 3 ??

{
{  PURPOSE:
{     This module contains request processors for job mode mem mgr requests.
{

?? PUSH (LISTEXT := ON) ??
*copyc mmt$rb_advise
*copyc mmt$rb_wait_io_completion
*copyc mmt$rb_lock_unlock_segment
*copyc osd$virtual_address
*copyc osc$purge_map_and_cache
*copyc ost$caller_identifier
*copyc mmt$rb_segment_request
*copyc mme$condition_codes
*copyc mmt$rb_fetch_pva_unwritten_pgs
*copyc mmt$rb_free_flush
*copyc mmt$rb_lock_unlock_pages
*copyc ost$status
*copyc ost$hardware_subranges
*copyc ost$wait
?? POP ??


{External procedures used by this module.

*copyc i#call_monitor
*copyc mmp$assign_device_to_segment
*copyc mmp$get_page_size
*copyc osp$set_status_abnormal
*copyc syp$set_status_from_mtr_status
*copyc mmp$reallocate_file_space
  ?? SKIP := 3 ??
{  Define global type definitions for offset arrays used in 'mmp$fetch_pva_unwritten pages'.  If
{  'sort_offset_arrays' was a nested procedure would not be necessary.

  TYPE
    offset_array_control_record = record
      offset_array_p: ^offset_array,
      next_offset_control_record_p: ^offset_array_control_record,
      offset_count: integer,
    recend,

    offset_array = array [1 .. * ] of ost$byte_count;

{  Internal procedures used by this module.

?? TITLE := 'LOCK_UNLOCK_PAGES' ??
?? EJECT ??

  PROCEDURE lock_unlock_pages (lock_page_type: mmt$locked_page;
        pva: ^cell;
        length: ost$byte_count;
        request_code: syt$monitor_request_code;
    VAR status: ost$status);


{
{   The purpose of this procedure is to issue the monitor function to lock or unlock pages.
{ Monitor status is also returned in the status variable.
{


    VAR
      rb: mmt$rb_lock_unlock_pages;


    rb.reqcode := request_code;
    rb.lock_page_type := lock_page_type;
    rb.pva := pva;
    rb.length := length;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);

  PROCEND lock_unlock_pages;
?? TITLE := 'SORT_OFFSET_ARRAYS' ??
?? EJECT ??

  PROCEDURE sort_offset_arrays (first_oacr_p: ^offset_array_control_record);

{
{   The purpose of this procedure is to sort the offsets in the offset arrays in ascending order.
{  This procedure should be nested within 'mmp$fetch_pva_unwritten_pva' but because of
{  a CYBIL bug with 'PUSH' statement and then a call to a nested procedure it is
{  done this way.
{

    VAR
      i: integer,
      next_oa_p: ^offset_array,
      oa_p: ^offset_array,
      oacr_p: ^offset_array_control_record,
      offset: ost$byte_count,
      offsets_swapped: boolean;


    offsets_swapped := TRUE;

  /sort_offsets/
    WHILE offsets_swapped = TRUE DO
      oacr_p := first_oacr_p;
      oa_p := oacr_p^.offset_array_p;
      offsets_swapped := FALSE;

      REPEAT
        FOR i := 1 TO (oacr_p^.offset_count - 1) DO
          IF oa_p^ [i] > oa_p^ [i + 1] THEN
            offset := oa_p^ [i];
            oa_p^ [i] := oa_p^ [i + 1];
            oa_p^ [i + 1] := offset;
            offsets_swapped := TRUE;
          IFEND;
        FOREND;


{  Check if have to swap offsets between two arrays.

        oacr_p := oacr_p^.next_offset_control_record_p;
        IF oacr_p <> NIL THEN
          next_oa_p := oacr_p^.offset_array_p;
          IF oa_p^ [i + 1] > next_oa_p^ [LOWERBOUND (next_oa_p^)] THEN
            offset := oa_p^ [i + 1];
            oa_p^ [i + 1] := next_oa_p^ [LOWERBOUND (next_oa_p^)];
            next_oa_p^ [LOWERBOUND (next_oa_p^)] := offset;
            offsets_swapped := TRUE;
          IFEND;
          oa_p := next_oa_p;
        IFEND;
      UNTIL oacr_p = NIL;
    WHILEND /sort_offsets/;

  PROCEND sort_offset_arrays;
?? TITLE := 'MMP$ADVISE_IN' ??
?? EJECT ??
*copyc mmh$advise_in

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

    VAR
      rb: mmt$rb_advise;

    status.normal := TRUE;


    rb.reqcode := syc$rc_advise_in;
    rb.in_pva := pva;
    rb.in_length := length;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);

  PROCEND mmp$advise_in;
?? TITLE := 'MMP$ADVISE_OUT' ??
?? EJECT ??
*copyc mmh$advise_out

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

    VAR
      rb: mmt$rb_advise;

    status.normal := TRUE;


    rb.reqcode := syc$rc_advise_out;
    rb.out_pva := pva;
    rb.out_length := length;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);
    IF NOT status.normal AND (status.condition = mme$segment_not_assigned_device) THEN
      status.normal := TRUE;
    IFEND;

  PROCEND mmp$advise_out;
?? TITLE := 'MMP$ADVISE_OUT_IN' ??
?? EJECT ??
*copyc mmh$advise_out_in

  PROCEDURE [XDCL, #GATE] mmp$advise_out_in (out_pva: ^cell;
        out_length: ost$byte_count;
        in_pva: ^cell;
        in_length: ost$byte_count;
    VAR status: ost$status);

    VAR
      rb: mmt$rb_advise;

    status.normal := TRUE;


    rb.reqcode := syc$rc_advise_out_in;
    rb.in_pva := in_pva;
    rb.in_length := in_length;
    rb.out_pva := out_pva;
    rb.out_length := out_length;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);
    IF NOT status.normal AND (status.condition = mme$segment_not_assigned_device) THEN
      status.normal := TRUE;
    IFEND;

  PROCEND mmp$advise_out_in;
?? TITLE := 'MMP$FETCH_PVA_UNWRITTEN_PAGES' ??
?? EJECT ??
{--------------------------------------------------------------------------------------------------------
*copyc mmh$fetch_pva_unwritten_pages
{--------------------------------------------------------------------------------------------------------


  PROCEDURE [XDCL, #GATE] mmp$fetch_pva_unwritten_pages (segment_p: ^cell;
        starting_pva: ^cell;
    VAR pva_list: array [ * ] OF ^cell;
    VAR list_overflow: boolean;
    VAR status: ost$status);


    TYPE
      offset_array_control_record = record
        offset_array_p: ^offset_array,
        next_offset_control_record_p: ^offset_array_control_record,
        offset_count: integer,
      recend,

      offset_array = array [1 .. * ] of ost$byte_count;

    VAR
      first_oacr_p: ^offset_array_control_record,
      i: integer,
      oa_p: ^offset_array,
      oacr_p: ^offset_array_control_record,
      offset_array_index: integer,
      offset_count: integer,
      previous_oacr_p: ^offset_array_control_record,
      request_block: mmt$rb_fetch_pva_unwritten_pgs;


    status.normal := TRUE;
    request_block.reqcode := syc$rc_fetch_pva_unwritten_pgs;
    request_block.subsequent_request_for_same_pva := FALSE;
    request_block.offset_list_overflow := TRUE;
    IF starting_pva = NIL THEN
      request_block.pva := #address (#ring (segment_p), #segment (segment_p), 0);
      request_block.starting_with_first_page := TRUE;
    ELSE
      request_block.pva := starting_pva;
      request_block.starting_with_first_page := FALSE;
    IFEND;


{  Issue monitor function to return unwritten PVAs and save these pva lists on the stack.

    first_oacr_p := NIL;
    oacr_p := NIL;
    oa_p := NIL;

  /fetch_unwritten_pva/
    WHILE request_block.offset_list_overflow = TRUE DO
      i#call_monitor (#LOC (request_block), #SIZE (request_block));
      syp$set_status_from_mtr_status (request_block.status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF request_block.offsets_returned <> 0 THEN
        previous_oacr_p := oacr_p;
        PUSH oacr_p;

        IF first_oacr_p = NIL THEN
          first_oacr_p := oacr_p;
        IFEND;

        IF previous_oacr_p <> NIL THEN
          previous_oacr_p^.next_offset_control_record_p := oacr_p;
        IFEND;

        oacr_p^.offset_count := request_block.offsets_returned;
        oacr_p^.next_offset_control_record_p := NIL;

        PUSH oa_p: [1 .. request_block.offsets_returned];
        IF oa_p = NIL THEN
          osp$set_status_abnormal ('MM', mme$stack_overflow_on_push, '', status);
          RETURN;
        IFEND;

        oacr_p^.offset_array_p := oa_p;

        FOR i := 1 TO request_block.offsets_returned DO
          oa_p^ [i] := request_block.offset_list [i];
        FOREND;

        request_block.subsequent_request_for_same_pva := TRUE;
      IFEND;
    WHILEND /fetch_unwritten_pva/;

    list_overflow := FALSE;
    IF first_oacr_p <> NIL THEN
      sort_offset_arrays (first_oacr_p);


{  Form PVAs from offsets in linked offset arrays and move to caller's pva list.  If caller's
{  pva list not filled up the remaining pva list entries are set to NIL.  If all
{  PVAs do not fit in the pva list the list overflow is set to TRUE.

      oacr_p := first_oacr_p;
      offset_count := oacr_p^.offset_count;
      oa_p := oacr_p^.offset_array_p;
      offset_array_index := LOWERBOUND (oa_p^);

    /return_pva_to_caller/
      FOR i := LOWERBOUND (pva_list) TO UPPERBOUND (pva_list) DO
        IF offset_array_index > offset_count THEN
          oacr_p := oacr_p^.next_offset_control_record_p;
          IF oacr_p <> NIL THEN
            offset_count := oacr_p^.offset_count;
            oa_p := oacr_p^.offset_array_p;
            offset_array_index := LOWERBOUND (oa_p^);
          ELSE
            offset_array_index := LOWERBOUND (oa_p^);
            offset_count := offset_array_index;
          IFEND;
        IFEND;

        IF oacr_p <> NIL THEN
          pva_list [i] := #address (#ring (segment_p), #segment (segment_p), oa_p^ [offset_array_index]);
          offset_array_index := offset_array_index + 1;
        ELSE
          pva_list [i] := NIL;
        IFEND;
      FOREND /return_pva_to_caller/;

      IF (oacr_p <> NIL) OR ((offset_array_index > offset_count) AND (oacr_p^.next_offset_control_record_p <>
            NIL)) THEN
        list_overflow := TRUE;
      IFEND;
    ELSE
      FOR i := LOWERBOUND (pva_list) TO UPPERBOUND (pva_list) DO
        pva_list [i] := NIL;
      FOREND;
    IFEND;

  PROCEND mmp$fetch_pva_unwritten_pages;
?? TITLE := 'MMP$FREE_PAGES' ??
?? EJECT ??
*copyc mmh$free_pages

  PROCEDURE [XDCL, #GATE] mmp$free_pages (pva: ^cell;
        length: ost$byte_count;
        waitopt: ost$wait;
    VAR status: ost$status);

    VAR
      rb: mmt$rb_free_flush;

    status.normal := TRUE;


    rb.reqcode := syc$rc_free_pages;
    rb.pva := pva;
    rb.length := length;
    rb.waitopt := waitopt;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);

  PROCEND mmp$free_pages;
?? TITLE := 'MMP$LOCK_PAGES' ??
?? EJECT ??
{--------------------------------------------------------------------------------------------------------
*copyc mmh$lock_pages
{--------------------------------------------------------------------------------------------------------


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

    status.normal := TRUE;

    lock_unlock_pages (mmc$lp_aging_lock, pva, length, syc$rc_lock_pages, status);
    WHILE (status.normal = FALSE) AND ((status.condition = mme$page_not_in_page_table) OR (status.condition =
          mme$not_valid_in_page_table)) DO
      mmp$advise_in (pva, length, status);
      IF status.normal THEN
        lock_unlock_pages (mmc$lp_aging_lock, pva, length, syc$rc_lock_pages, status);
      IFEND;
    WHILEND;

  PROCEND mmp$lock_pages;
?? TITLE := 'MMP$UNLOCK_PAGES' ??
?? EJECT ??
{--------------------------------------------------------------------------------------------------------
*copy mmh$unlock_pages
{--------------------------------------------------------------------------------------------------------


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

    status.normal := TRUE;

    lock_unlock_pages (mmc$lp_aging_lock, pva, length, syc$rc_unlock_pages, status);

  PROCEND mmp$unlock_pages;
?? TITLE := 'MMP$WRITE_MODIFIED_PAGES' ??
?? EJECT ??
*copyc mmh$write_modified_pages

  PROCEDURE [XDCL, #GATE] mmp$write_modified_pages (pva: ^cell;
        length: ost$byte_count;
        waitopt: ost$wait;
    VAR status: ost$status);

    VAR
      local_status: ost$status,
      count: integer,
      rb: mmt$rb_free_flush;

    status.normal := TRUE;


    rb.reqcode := syc$rc_write_modified_pages;
    rb.pva := pva;
    rb.length := length;
    rb.waitopt := waitopt;

{   Mmp$process_wmp_status (mtr) will set init_new_io to FALSE if the call is reissued for the wait option.

    rb.init_new_io := TRUE;
    FOR count := 1 TO 4 DO
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);
    IF NOT status.normal THEN
      IF status.condition = mme$segment_not_assigned_device THEN
        mmp$assign_device_to_segment (pva, local_status);
        IF NOT local_status.normal THEN
          RETURN;
        IFEND;
      ELSEIF status.condition = mme$io_write_error THEN
        IF count = 4 THEN
          RETURN;
        IFEND;
        mmp$reallocate_file_space (pva, local_status);
        IF NOT local_status.normal THEN
          RETURN;
        IFEND;
        rb.init_new_io := TRUE;
      ELSE
        RETURN;
      IFEND;
    ELSE
      RETURN;
    IFEND;
    FOREND;

  PROCEND mmp$write_modified_pages;
?? TITLE := 'mmp$check_if_pages_in_memory' ??
?? EJECT ??
*copyc mmh$check_if_pages_in_memory

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

    VAR
      page_count: integer,
      page_size: integer,
      i: integer,
      rma: integer;

    in_memory := TRUE;

    mmp$get_page_size (page_size);

    page_count := (#offset (pva) + length - 1) DIV page_size - (#offset (pva) DIV page_size) + 1;

    FOR i := 0 TO page_count - 1 DO
      #real_memory_address (#address (1, #segment (pva), #offset (pva) + i * page_size), rma);
      IF rma < 0 THEN
        in_memory := FALSE;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mmp$check_if_pages_in_memory;
?? TITLE := 'mmp$lock_catalog_segment' ??
?? EJECT ??
*copyc mmh$lock_catalog_segment

  PROCEDURE [XDCL, #GATE] mmp$lock_catalog_segment (p: ^cell;
        access: mmt$lus_lock_type;
        wait: ost$wait;
    VAR status: ost$status);

    VAR
      rb: mmt$rb_lock_unlock_segment;

    status.normal := TRUE;
    rb.reqcode := syc$rc_lock_unlock_segment;
    rb.request := mmc$lus_lock_segment;
    rb.access := access;
    {
    { Until a method of preventing jobs with catalog segment locks from
    { being swapped this interface will behave exactly like mmp$lock_segment.
    { rb.catalog_segment := TRUE;
    {
    rb.catalog_segment := FALSE;
    rb.wait := wait;
    rb.pva := p;
    REPEAT
      i#call_monitor (#LOC (rb), #SIZE (rb));
    UNTIL rb.status.normal OR (wait = osc$nowait) OR (rb.status.condition <> mme$segment_locked_another_task);
    #purge_buffer (osc$pva_purge_segment_cache, p);
    syp$set_status_from_mtr_status (rb.status, status);

  PROCEND mmp$lock_catalog_segment;
?? TITLE := 'mmp$lock_segment' ??
?? EJECT ??
*copyc mmh$lock_segment

  PROCEDURE [XDCL, #GATE] mmp$lock_segment (p: ^cell;
        access: mmt$lus_lock_type;
        wait: ost$wait;
    VAR status: ost$status);

    VAR
      rb: mmt$rb_lock_unlock_segment;

    status.normal := TRUE;
    rb.reqcode := syc$rc_lock_unlock_segment;
    rb.request := mmc$lus_lock_segment;
    rb.access := access;
    rb.catalog_segment := FALSE;
    rb.wait := wait;
    rb.pva := p;
    REPEAT
      i#call_monitor (#LOC (rb), #SIZE (rb));
    UNTIL rb.status.normal OR (wait = osc$nowait) OR (rb.status.condition <> mme$segment_locked_another_task);
    #purge_buffer (osc$pva_purge_segment_cache, p);
    syp$set_status_from_mtr_status (rb.status, status);

  PROCEND mmp$lock_segment;
?? TITLE := 'mmp$unlock_segment' ??
?? EJECT ??
*copyc mmh$unlock_segment

  PROCEDURE [XDCL, #GATE] mmp$unlock_segment (p: ^cell;
        page_disposition: mmt$lus_page_disposition;
        wait: ost$wait;
    VAR status: ost$status);

    VAR
      local_status: ost$status,
      count: integer,
      rb: mmt$rb_lock_unlock_segment;

    status.normal := TRUE;
    rb.reqcode := syc$rc_lock_unlock_segment;
    rb.request := mmc$lus_unlock_segment;
    rb.page_disposition := page_disposition;
    rb.wait := wait;

{   Mmp$process_wmp_status (mtr) will set init_new_io to FALSE if the call is reissued for the wait option.

    rb.init_new_io := TRUE;
    rb.pva := p;
    FOR count := 1 TO 4 DO
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);
    IF NOT status.normal THEN
      IF status.condition = mme$io_write_error THEN
        IF count = 4 THEN
          RETURN;
        IFEND;
        mmp$reallocate_file_space (p, local_status);
        IF NOT local_status.normal THEN
          RETURN;
        IFEND;
        rb.init_new_io := TRUE;
      ELSE
        RETURN;
      IFEND;
    ELSE
      RETURN;
    IFEND;
    FOREND;

  PROCEND mmp$unlock_segment;
  ?? TITLE := 'MMP$WAIT_IO_COMPLETION', EJECT ??
*copyc mmh$wait_io_completion


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

    VAR
      rb: mmt$rb_wait_io_completion;

    status.normal := TRUE;
    rb.reqcode := syc$rc_wait_io_completion;
    rb.pva := pva;
    i#call_monitor (#LOC (rb), #SIZE (rb));
    syp$set_status_from_mtr_status (rb.status, status);

  PROCEND mmp$wait_io_completion;



MODEND mmm$memory_mgr_request_procs;

