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

{ This test measures the page fault overheads under various conditions.
{ The tests were run in a normal closed shop environment BUT with
{ job priority set to P8.
{
{   to run,
{      GETS PTM$PF_TEST s=s e=true pn=performance_tools
{      CYBIL i=s l=l opt=high
{      SETMO p=p1
{      LGO


?? PUSH (LISTEXT := ON) ??
*copyc gft$system_file_identifier
*copyc osc$processor_defined_registers
*copyc pmt$program_parameters
*copyc tmt$rb_ready_task
?? POP ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$put_next
*copyc clp$evaluate_parameters
*copyc i#call_monitor
*copyc i#move
*copyc i#real_memory_address
*copyc clp$put_job_command_response
*copyc fsp$open_file
*copyc mmp$advise_in
*copyc mmp$advise_out
*copyc mmp$advise_out_in
*copyc mmp$assign_pages
*copyc mmp$assign_contiguous_memory
*copyc mmp$change_stack_attribute
*copyc mmp$check_if_pages_in_memory
*copyc mmp$check_io_status
*copyc mmp$conditional_free
*copyc mmp$create_scratch_segment
*copyc mmp$create_segment
*copyc mmp$create_shadow_segment
*copyc mmp$create_user_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$delete_segment
*copyc mmp$delete_user_segment
*copyc mmp$fetch_pva_unwritten_pages
*copyc mmp$fetch_segment_attributes
*copyc mmp$free_pages
*copyc mmp$get_segment_length
*copyc mmp$initiate_debug_shadowing
*copyc mmp$initiate_shadowing
*copyc mmp$lock_pages
*copyc mmp$lock_segment
*copyc mmp$move_pages
*copyc mmp$preallocate_file_space
*copyc mmp$read
*copyc mmp$reserve_segment_number
*copyc mmp$set_access_selections
*copyc mmp$set_segment_length
*copyc mmp$store_segment_attributes
*copyc mmp$terminate_shadowing
*copyc mmp$unlock_pages
*copyc mmp$unlock_segment
*copyc mmp$verify_access
*copyc mmp$wait_io_completion
*copyc mmp$write
*copyc mmp$write_modified_pages
*copyc osp$set_status_abnormal
*copyc pfp$purge
*copyc pmp$cycle
*copyc pmp$execute
*copyc pmp$exit
*copyc pmp$get_program_description
*copyc pmp$get_program_size
*copyc pmp$wait


  TYPE
    statistic = record
      tmin,
      tsum,
      tcount,
      taver: integer,
    recend,
    task2_function = (idle, run, quit),
    shared_info = record
      func: ALIGNED [0 MOD 16384] task2_function,
      t1: integer,
      t2: integer,
      t1_last: integer,
      t1_changed: integer,
      page: ALIGNED [0 MOD 16384] integer,
    recend;

{ Global variables - used by Task 1 (primary task) ONLY.

  VAR
    pa: ^array [0 .. 1000000] of 0 .. 255 := NIL,
    p: ^integer := NIL,
    p2a: ^array [0 .. 1000000] of 0 .. 255 := NIL,
    p2: ^integer := NIL,
    data_p: ^shared_info,
    page_size: integer,
    scale: integer,
    task_switch_time: integer,
    ofid: amt$file_identifier,
    skip_shadow_tests: boolean,
    status: ost$status,
    file_id1,
    file_id2: amt$file_identifier,
    scratch_files: boolean,
    cyc: pft$cycle_selector := [pfc$lowest_cycle],
    ba: amt$file_byte_address,
    pfn1: [STATIC] array [1 .. 3] of pft$name := [' ', ' ', 'ZZZSCR1'],
    pfn2: [STATIC] array [1 .. 3] of pft$name := [' ', ' ', 'ZZZSCR2'],
    password: ost$name := '                               ',
    s,
    ss: string (100),
    sl: integer,
    s1,
    s2,
    s3: statistic;

?? EJECT ??
{-----------------------------------------------------------------------

  PROCEDURE set_task2_function
    (    func: task2_function);

    VAR
      t2f: integer;

    t2f := data_p^.t2;
    data_p^.func := func;
    REPEAT
      pmp$cycle (status);
    UNTIL (data_p^.t2 <> t2f) OR (func <> run);
  PROCEND set_task2_function;

  PROCEDURE check_status
    (VAR status: ost$status);

    IF NOT status.normal THEN
      pmp$exit (status);
    IFEND;
  PROCEND check_status;

  PROCEDURE reset_statistic
    (VAR s: statistic);

    s.tmin := 999999999999;
    s.tsum := 0;
    s.tcount := 0;
    s.taver := 0;
  PROCEND reset_statistic;

  PROCEDURE record_statistic
    (    t1,
         t2: integer;
     VAR s: statistic);

    VAR
      t: integer;

    t := t2 - t1;
    IF t < s.tmin THEN
      s.tmin := t;
    IFEND;
    s.tsum := s.tsum + t;
    s.tcount := s.tcount + 1;
  PROCEND record_statistic;

  PROCEDURE display_statistic
    (    str: string ( * <= 50);
         sub: integer;
     VAR stat: statistic);

    IF stat.tcount > 0 THEN
      stat.taver := (stat.tsum DIV stat.tcount) - sub;
    ELSE
      stat.tmin := 0;
    IFEND;
    STRINGREP (s, sl, ' ', str: 50, stat.tmin: 10, stat.taver: 10);
    writeout;
  PROCEND display_statistic;

  PROCEDURE writeout;

    amp$put_next (ofid, ^s, sl, ba, status);
    check_status (status);
  PROCEND writeout;

{-------------------------------------------------------------------

  PROCEDURE create_new_segment;

    VAR
      pva: amt$segment_pointer;

    IF p <> NIL THEN
      pva.cell_pointer := p;
      IF scratch_files THEN
        mmp$delete_scratch_segment (pva, status);
      ELSE
        amp$close (file_id1, status);
        check_status (status);
        pfp$purge (pfn1, cyc, password, status);
      IFEND;
      check_status (status);
    IFEND;

    IF scratch_files THEN
      mmp$create_scratch_segment (amc$cell_pointer, mmc$as_random, pva, status);
    ELSE
      fsp$open_file ('$user.zzzscr1', amc$segment, NIL, NIL, NIL, NIL, NIL, file_id1, status);
      check_status (status);
      amp$get_segment_pointer (file_id1, amc$cell_pointer, pva, status);
    IFEND;

    check_status (status);
    pa := pva.cell_pointer;
    p := pva.cell_pointer;

  PROCEND create_new_segment;

  PROCEDURE create_new_segment2;

    VAR
      pva: amt$segment_pointer;

    IF p2 <> NIL THEN
      pva.cell_pointer := p2;
      IF scratch_files THEN
        mmp$delete_scratch_segment (pva, status);
      ELSE
        amp$close (file_id2, status);
        check_status (status);
        pfp$purge (pfn2, cyc, password, status);
      IFEND;
      check_status (status);
    IFEND;

    IF scratch_files THEN
      mmp$create_scratch_segment (amc$cell_pointer, mmc$as_random, pva, status);
    ELSE
      fsp$open_file ('$user.zzzscr2', amc$segment, NIL, NIL, NIL, NIL, NIL, file_id2, status);
      check_status (status);
      amp$get_segment_pointer (file_id2, amc$cell_pointer, pva, status);
    IFEND;

    check_status (status);
    p2a := pva.cell_pointer;
    p2 := pva.cell_pointer;

  PROCEND create_new_segment2;

{-----------------------------------------------------------------------

?? EJECT ??

  PROCEDURE [XDCL] mm_path_test2
    (    parameters: pmt$program_parameters);


    VAR
      ba: amt$file_byte_address,
      second_task_parameters: ^pmt$program_parameters, { Pointer to the parameter list passed to the task
      shared_segment_name: ^amt$local_file_name, { File name of the segment to be shared
      shared_segment_id: amt$file_identifier,
      shared_segment_pointer: amt$segment_pointer;

    second_task_parameters := ^parameters;

    RESET second_task_parameters;

{ Open and get a pointer to the segment that is to be shared by the two asynchronous tasks.

    NEXT shared_segment_name IN second_task_parameters;
    amp$open (shared_segment_name^, amc$segment, NIL, shared_segment_id, status);
    check_status (status);

    amp$get_segment_pointer (shared_segment_id, amc$cell_pointer, shared_segment_pointer, status);
    check_status (status);

    data_p := shared_segment_pointer.cell_pointer;
    data_p^.t2 := #FREE_RUNNING_CLOCK (0);

    REPEAT
      WHILE data_p^.func = run DO
        IF data_p^.t1 <> data_p^.t1_last THEN
          data_p^.t1_last := data_p^.t1;
          data_p^.t1_changed := #FREE_RUNNING_CLOCK (0);
        IFEND;
        data_p^.t2 := #FREE_RUNNING_CLOCK (0);
      WHILEND;
      pmp$wait (100, 100);
    UNTIL data_p^.func = quit;

    amp$close (shared_segment_id, status);

  PROCEND mm_path_test2;
?? EJECT ??

{-------------------------------------------------------------------

  PROCEDURE test_advisein
    (    op: (ai_new, ai_reclaim, ai_disk, ai_null));

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$advise_out (p, page_size, status);
      check_status (status);
      FOR i := 1 TO 50 DO
        mmp$write_modified_pages (p, page_size, osc$wait, status);
        mmp$advise_out (p, page_size, status);
        check_status (status);
        IF op = ai_new THEN
          mmp$set_segment_length (p, 1, 0, status);
        ELSEIF op = ai_disk THEN
          mmp$free_pages (p, page_size, osc$wait, status);
          check_status (status);
        ELSEIF op = ai_null THEN
          p^ := 6;
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$advise_in (p, page_size, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        p^ := 6;
      FOREND
    FOREND;
    IF op = ai_new THEN
      display_statistic ('Advise In - new', 0, s1);
    ELSEIF op = ai_reclaim THEN
      display_statistic ('Advise In - reclaim', 0, s1);
    ELSEIF op = ai_disk THEN
      display_statistic ('Advise In - disk', 0, s1);
    ELSE
      display_statistic ('Advise In - null', 0, s1);
    IFEND;
  PROCEND test_advisein;

{-------------------------------------------------------------------

  PROCEDURE test_adviseout
    (    modified: boolean);

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 25 DO
        IF modified THEN
          p^ := 1;
        ELSE
          k := p^;
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$advise_out (p, 1, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND
    FOREND;
    IF modified THEN
      display_statistic ('Advise Out modified page', 0, s1);
    ELSE
      display_statistic ('Advise Out unmodified page', 0, s1);
    IFEND;
  PROCEND test_adviseout;

{-------------------------------------------------------------------

  PROCEDURE test_adviseoutin
    (    ondisk: boolean;
         modified: boolean);

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      create_new_segment2;
      p^ := 1;
      mmp$write_modified_pages (p, page_size, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 20 DO
        p2^ := 8;
        mmp$write_modified_pages (p2, page_size, osc$wait, status);
        mmp$advise_out (p2, page_size, status);
        check_status (status);
        IF ondisk THEN
          mmp$free_pages (p2, page_size, osc$wait, status);
          check_status (status);
        IFEND;
        #PURGE_BUFFER (4, p);
        k := p^;
        IF modified THEN
          p^ := 9;
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$advise_out_in (p, page_size, p2, page_size, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        mmp$wait_io_completion (p, status);
      FOREND
    FOREND;
    IF ondisk THEN
      IF modified THEN
        display_statistic ('Advise Out In - mod/disk', 0, s1);
      ELSE
        display_statistic ('Advise Out In  - not mod/disk', 0, s1);
      IFEND;
    ELSE
      IF modified THEN
        display_statistic ('Advise Out In - mod/reclaim', 0, s1);
      ELSE
        display_statistic ('Advise Out In  - not mod/reclaim', 0, s1);
      IFEND;
    IFEND;
  PROCEND test_adviseoutin;

{-------------------------------------------------------------------

  PROCEDURE test_assign
    (    n: integer);

    VAR
      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 5;
      mmp$write_modified_pages (p, page_size, osc$wait, status);
      check_status (status);
      mmp$free_pages (p, page_size, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 25 DO
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$assign_pages (p, page_size * n, TRUE, osc$wait, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$free_pages (p, page_size * n, osc$wait, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s2);
        IFEND;
      FOREND
    FOREND;
    STRINGREP (s, sl, 'Assign Pages ', n: 3, ' pages ');
    display_statistic (s (1, sl), 0, s1);
    STRINGREP (s, sl, ' Free Pages ', n: 3, ' pages ');
    display_statistic (s (1, sl), 0, s2);
  PROCEND test_assign;

{-------------------------------------------------------------------

  PROCEDURE test_assign_contiguous_memory
    (    n: integer);

    VAR
      attr: [STATIC] array [1 .. 1] of mmt$attribute_descriptor := [[mmc$kw_wired_segment, 1000000, FALSE]],
      pva: mmt$segment_pointer,
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 20 * scale DO
      mmp$create_segment (^attr, mmc$cell_pointer, 11, pva, status);
      check_status (status);
      FOR i := 1 TO 50 DO
        mmp$free_pages (pva.cell_pointer, n, osc$wait, status);
        check_status (status);
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$assign_contiguous_memory (pva.cell_pointer, n, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
      mmp$delete_segment (pva, 11, status);
      check_status (status);
    FOREND;

    STRINGREP (s, sl, 'Assign contiguous memory - ', n, ' bytes');
    display_statistic (s (1, sl), 0, s1);

  PROCEND test_assign_contiguous_memory;

{-------------------------------------------------------------------

  PROCEDURE test_change_stack_attribute;

    VAR

      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      FOR i := 1 TO 200 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$change_stack_attribute (TRUE, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Change stack attributes', 0, s1);
  PROCEND test_change_stack_attribute;

{-------------------------------------------------------------------

  PROCEDURE test_check_io_status
    (    active: boolean);

    VAR
      iostatus: mmt$io_status,
      iostatus_p: array [1 .. 1] of ^mmt$io_status,
      t1,
      t2: integer,
      index: integer,
      i,
      j: integer;

    reset_statistic (s1);
    iostatus_p [1] := ^iostatus;
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 30 DO
        p^ := 1;
        mmp$write (p, 1, FALSE, ^iostatus, osc$nowait, status);
        check_status (status);
        IF NOT active THEN
          mmp$wait_io_completion (p, status);
          check_status (status);
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$check_io_status (iostatus_p, 0, index, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    IF active THEN
      display_statistic ('Check IO status - active', 0, s1);
    ELSE
      display_statistic ('Check IO status - not active', 0, s1);
    IFEND;
  PROCEND test_check_io_status;

{-------------------------------------------------------------------

  PROCEDURE test_conditional_free
    (    assigned: boolean);

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 5 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      mmp$free_pages (p, page_size, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 500 DO
        IF assigned THEN
          p^ := 6;
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$conditional_free (p, page_size, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND
    FOREND;
    IF assigned THEN
      display_statistic ('Conditional Free - page', 0, s1);
    ELSE
      display_statistic ('Conditional Free - no page', 0, s1);
    IFEND;
  PROCEND test_conditional_free;

{-------------------------------------------------------------------

  PROCEDURE test_copy
    (    pages: 1 .. 10;
         reclaim: boolean);

    VAR

      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      create_new_segment2;
      p^ := 1;
      p2^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      mmp$write_modified_pages (p2, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 20 DO
        FOR k := 0 TO pages - 1 DO
          pa^ [k * page_size] := 1;
          p2a^ [k * page_size] := 1;
        FOREND;
        IF reclaim THEN
          mmp$write_modified_pages (p2, 10000000, osc$wait, status);
          check_status (status);
          mmp$advise_out (p2, 10000000, status);
          check_status (status);
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        i#move (p, p2, pages * page_size);
        t2 := #FREE_RUNNING_CLOCK (0);
        IF i > 2 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    IF reclaim THEN
      ss := 'reclaim dest';
    ELSE
      ss := 'no dest pf';
    IFEND;
    STRINGREP (s, sl, 'Copy ', pages: 3, ' pages - ', ss (1, 12));
    display_statistic (s (1, sl), 0, s1);
  PROCEND test_copy;

{-------------------------------------------------------------------

  PROCEDURE test_create_scratch_segment;

    VAR

      t1,
      t2: integer,
      pva: amt$segment_pointer,
      p: ^integer,
      i: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR i := 1 TO 100 * scale DO
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$create_scratch_segment (amc$cell_pointer, mmc$as_random, pva, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
      p := pva.cell_pointer;
      p^ := 6;
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$delete_scratch_segment (pva, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s2);
      IFEND;
    FOREND;
    display_statistic ('Create scratch segment', 0, s1);
    display_statistic (' Delete scratch segment', 0, s2);
  PROCEND test_create_scratch_segment;

{-------------------------------------------------------------------

  PROCEDURE test_create_segment;

    VAR
      attr: [STATIC] array [1 .. 3] of mmt$attribute_descriptor :=
            [[mmc$kw_ring_numbers, 11, 11], [mmc$kw_preset_value, pmc$initialize_to_zero],
            [mmc$kw_max_segment_length, 1000000]],
      t1,
      t2: integer,
      p: ^integer,
      pva: mmt$segment_pointer,
      i: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR i := 1 TO 100 * scale DO
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$create_segment (^attr, mmc$cell_pointer, 11, pva, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
      p := pva.cell_pointer;
      p^ := 6;
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$delete_segment (pva, 1, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s2);
      IFEND;
    FOREND;
    display_statistic ('Create segment', 0, s1);
    display_statistic (' Delete segment', 0, s2);
  PROCEND test_create_segment;

{-------------------------------------------------------------------

  PROCEDURE test_create_shadow_segment;

    VAR
      ch_p: ^char,
      t1,
      t2: integer,
      pva: amt$segment_pointer,
      pva2: amt$segment_pointer,
      pva3: mmt$segment_pointer,
      i: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    mmp$create_scratch_segment (amc$cell_pointer, mmc$as_random, pva, status);
    check_status (status);
    ch_p := pva.cell_pointer;
    ch_p^ := 'k';
    mmp$write_modified_pages (ch_p, 1, osc$wait, status);
    check_status (status);
    IF NOT skip_shadow_tests THEN
      FOR i := 1 TO 100 * scale DO
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$create_shadow_segment (pva.cell_pointer, 0, 1638400, amc$cell_pointer, pva2, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        ch_p := pva2.cell_pointer;
        ch_p^ := 'k';
        pva3.cell_pointer := pva2.cell_pointer;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$delete_segment (pva3, 1, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s2);
        IFEND;
      FOREND;
    IFEND;
    display_statistic ('Create shadow segment', 0, s1);
    display_statistic (' Delete shadow segment', 0, s2);
  PROCEND test_create_shadow_segment;

{-------------------------------------------------------------------

  PROCEDURE test_create_user_segment;

    VAR

      t1,
      t2: integer,
      attr: [STATIC] array [1 .. 2] of mmt$user_attribute_descriptor :=
            [[mmc$ua_ring_numbers, 11, 11], [mmc$ua_max_segment_length, 1000000]],
      p: ^integer,
      pva: amt$segment_pointer,
      i: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR i := 1 TO 100 * scale DO
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$create_user_segment (^attr, amc$cell_pointer, mmc$as_random, pva, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
      p := pva.cell_pointer;
      p^ := 6;
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$delete_user_segment (pva, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s2);
      IFEND;
    FOREND;
    display_statistic ('Create user segment', 0, s1);
    display_statistic (' Delete user segment', 0, s2);
  PROCEND test_create_user_segment;

{-------------------------------------------------------------------

  PROCEDURE test_delete_scratch_segment
    (    op: (noasid, nopages, pages, diskfile));

    VAR

      t1,
      t2: integer,
      pva: amt$segment_pointer,
      p: ^integer,
      i: integer;

    reset_statistic (s1);
    FOR i := 1 TO 100 * scale DO
      mmp$create_scratch_segment (amc$cell_pointer, mmc$as_random, pva, status);
      IF op <> noasid THEN
        p := pva.cell_pointer;
        p^ := 6;
      IFEND;
      IF op = nopages THEN
        mmp$free_pages (p, 1000000, osc$wait, status);
        check_status (status);
      ELSEIF op = diskfile THEN
        mmp$write_modified_pages (p, 1000000, osc$wait, status);
        check_status (status);
      IFEND;
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$delete_scratch_segment (pva, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    IF op = noasid THEN
      display_statistic ('Delete segment - never referenced', 0, s1);
    ELSEIF op = nopages THEN
      display_statistic ('Delete segment - no pages', 0, s1);
    ELSEIF op = pages THEN
      display_statistic ('Delete segment - 1 page, no disk file', 0, s1);
    ELSE
      display_statistic ('Delete segment - 1 page, disk file', 0, s1);
    IFEND;
  PROCEND test_delete_scratch_segment;

{-------------------------------------------------------------------

  PROCEDURE test_fetch_pva_unwritten_pages;

    VAR
      arr: array [1 .. 100] of ^cell,
      overflow: boolean,
      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      FOR i := 1 TO 200 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$fetch_pva_unwritten_pages (p, p, arr, overflow, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Fetch PVA unwritten pages', 0, s1);
  PROCEND test_fetch_pva_unwritten_pages;

{-------------------------------------------------------------------

  PROCEDURE test_fetch_segment_attributes;

    VAR
      attr: [STATIC] array [1 .. 1] of mmt$attribute_descriptor := [[mmc$kw_max_segment_length, 1000000]],
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      FOR i := 1 TO 250 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$fetch_segment_attributes (p, attr, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND
    FOREND;
    display_statistic ('Store segment attributes', 0, s1);
  PROCEND test_fetch_segment_attributes;

{-------------------------------------------------------------------

  PROCEDURE test_get_segment_length
    (    fuzzy: boolean);

    VAR
      t1,
      t2: integer,
      length: ost$segment_length,
      i,
      k: integer;

    reset_statistic (s1);
    FOR i := 1 TO 20 * scale DO
      create_new_segment;
      mmp$set_access_selections (p, mmc$as_sequential, status);
      check_status (status);
      IF fuzzy THEN
        FOR k := 0 TO 10 DO
          pa^ [k * page_size] := 6;
        FOREND;
      IFEND;
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$get_segment_length (p, 1, length, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    IF fuzzy THEN
      display_statistic ('Get segment length - fuzzy EOI', 0, s1);
    ELSE
      display_statistic ('Get segment length - exact EOI', 0, s1);
    IFEND;
  PROCEND test_get_segment_length;

{-------------------------------------------------------------------

  PROCEDURE test_initiate_debug_shadowing;

    VAR
      attr: [STATIC] array [1 .. 1] of mmt$attribute_descriptor :=
            [[mmc$kw_segment_access_control, [FALSE, osc$non_privileged, osc$read_uncontrolled,
            osc$non_writable]]],
      pva: amt$segment_pointer,
      t1,
      t2: integer,
      i,
      k: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR i := 1 TO 20 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$store_segment_attributes (p, 1, attr, status);
      check_status (status);
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$initiate_debug_shadowing (p, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
      pva.cell_pointer := p;
      p := NIL;
      t1 := #FREE_RUNNING_CLOCK (0);
      IF scratch_files THEN
        mmp$delete_scratch_segment (pva, status);
      ELSE
        amp$close (file_id1, status);
        check_status (status);
        pfp$purge (pfn1, cyc, password, status);
      IFEND;
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s2);
      IFEND;
    FOREND;
    display_statistic ('Initiate debug shadowing', 0, s1);
    display_statistic ('  Delete segment', 0, s2);
  PROCEND test_initiate_debug_shadowing;

{-------------------------------------------------------------------

  PROCEDURE test_initiate_shadowing;

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    IF NOT skip_shadow_tests THEN
      FOR j := 1 TO 2 * scale DO
        create_new_segment;
        FOR i := 1 TO 100 DO
          p^ := 1;
          mmp$write_modified_pages (p, page_size, osc$wait, status);
          check_status (status);
          t1 := #FREE_RUNNING_CLOCK (0);
          mmp$initiate_shadowing (p, status);
          t2 := #FREE_RUNNING_CLOCK (0);
          check_status (status);
          IF i > 4 THEN
            record_statistic (t1, t2, s1);
          IFEND;
          p^ := 1;
          mmp$write_modified_pages (p, page_size, osc$wait, status);
          check_status (status);
          t1 := #FREE_RUNNING_CLOCK (0);
          mmp$terminate_shadowing (p, TRUE, status);
          t2 := #FREE_RUNNING_CLOCK (0);
          check_status (status);
          IF i > 4 THEN
            record_statistic (t1, t2, s2);
          IFEND;
        FOREND;
      FOREND;
    IFEND;
    display_statistic ('Initiate shadowing', 0, s1);
    display_statistic (' Terminate shadowing', 0, s2);
  PROCEND test_initiate_shadowing;

{-------------------------------------------------------------------

  PROCEDURE test_lock_pages;

    VAR

      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      FOR i := 1 TO 50 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$lock_pages (p, page_size, status);
        ;
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$unlock_pages (p, page_size, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s2);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Lock pages', 0, s1);
    display_statistic (' Unock pages', 0, s2);
  PROCEND test_lock_pages;

{-------------------------------------------------------------------

  PROCEDURE test_lock_segment;

    VAR

      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    reset_statistic (s2);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      FOR i := 1 TO 50 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$lock_segment (p, mmc$lus_lock_for_read, osc$wait, status);
        ;
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$unlock_segment (p, mmc$lus_none, osc$wait, status);
        ;
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s2);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Lock_segment', 0, s1);
    display_statistic (' Unlock_segment', 0, s2);
  PROCEND test_lock_segment;

{-------------------------------------------------------------------

  PROCEDURE test_move
    (    pages: 1 .. 10);

    VAR

      t1,
      t2: integer,
      i,
      j,
      k: integer,
      move_count: mmt$move_pages_page_count;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      create_new_segment2;
      p^ := 1;
      p2^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      mmp$write_modified_pages (p2, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 15 DO
        FOR k := 0 TO pages - 1 DO
          pa^ [k * page_size] := 1;
        FOREND;
        mmp$free_pages (p2, 1000000, osc$wait, status);
        check_status (status);
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$move_pages (p, p2, pages * page_size, mmc$mp_set_modified, FALSE, move_count, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 2 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    STRINGREP (s, sl, 'Move ', pages: 3, 'pages');
    display_statistic (s (1, sl), 0, s1);
  PROCEND test_move;

{-------------------------------------------------------------------

  PROCEDURE test_null;

    VAR
      t1,
      t2: integer,
      rb: tmt$rb_ready_task,
      i: integer;

    reset_statistic (s1);
    rb.reqcode := syc$rc_ready_task;
    rb.task_id.index := 0;
    FOR i := 1 TO 800 * scale DO
      t1 := #FREE_RUNNING_CLOCK (0);
      i#call_monitor (#LOC (rb), #SIZE (rb));
      t2 := #FREE_RUNNING_CLOCK (0);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    display_statistic ('Null monitor request', 0, s1);
  PROCEND test_null;

{-------------------------------------------------------------------

  PROCEDURE test_pf_disk;

    VAR
      i: integer;

    reset_statistic (s1);
    set_task2_function (run);
    FOR i := 1 TO 50 * scale DO
      create_new_segment;
      data_p^.page := 1;
      mmp$write_modified_pages (^data_p^.page, 1, osc$wait, status);
      check_status (status);
      mmp$free_pages (^data_p^.page, page_size, osc$wait, status);
      check_status (status);
      data_p^.t1 := #FREE_RUNNING_CLOCK (0);
      data_p^.page := 4;
      check_status (status);
      IF i > 4 THEN
        record_statistic (data_p^.t1_last, data_p^.t1_changed, s1);
      IFEND;
    FOREND;
    set_task2_function (idle);
    display_statistic ('Page fault for page on disk + taskswitch', 0, s1);
  PROCEND test_pf_disk;


{-------------------------------------------------------------------

  PROCEDURE test_pf_new_file_alloc;

    VAR

      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR i := 1 TO 40 * scale DO
      create_new_segment;
      pa^ [0] := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      t1 := #FREE_RUNNING_CLOCK (0);
      j := pa^ [16384];
      t2 := #FREE_RUNNING_CLOCK (0);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    display_statistic ('Page fault new page, file, space not allocated', 0, s1);
  PROCEND test_pf_new_file_alloc;

{-------------------------------------------------------------------

  PROCEDURE test_pf_new_file_no_alloc;

    VAR

      t1,
      t2: integer,
      i,
      k: integer;

    reset_statistic (s1);
    FOR i := 1 TO 40 * scale DO
      create_new_segment;
      pa^ [0] := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      t1 := #FREE_RUNNING_CLOCK (0);
      k := pa^ [8192];
      t2 := #FREE_RUNNING_CLOCK (0);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    display_statistic ('Page fault new page, file, space already allocated', 0, s1);
  PROCEND test_pf_new_file_no_alloc;

{-------------------------------------------------------------------

  PROCEDURE test_pf_new_no_file;

    VAR

      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 10 * scale DO
      create_new_segment;
      FOR i := 1 TO 50 DO
        t1 := #FREE_RUNNING_CLOCK (0);
        k := p^;
        t2 := #FREE_RUNNING_CLOCK (0);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        mmp$free_pages (p, page_size, osc$wait, status);
      FOREND;
    FOREND;
    display_statistic ('Page fault new page, no file', 0, s1);
  PROCEND test_pf_new_no_file;

{-------------------------------------------------------------------

  PROCEDURE test_pf_reclaim;

    VAR

      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      FOR i := 1 TO 50 DO
        p^ := 1;
        mmp$write_modified_pages (p, 1, osc$wait, status);
        check_status (status);
        mmp$advise_out (p, 16384, status);
        check_status (status);
        t1 := #FREE_RUNNING_CLOCK (0);
        p^ := 4;
        t2 := #FREE_RUNNING_CLOCK (0);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Page fault, reclaim page from available queue', 0, s1);
  PROCEND test_pf_reclaim;

{-------------------------------------------------------------------

  PROCEDURE test_preallocate_file_space
    (    n: integer);

    VAR
      pva: amt$segment_pointer,
      t1,
      t2: integer,
      i,
      k: integer;

    reset_statistic (s1);
    FOR i := 1 TO 2 DO {!!! no scale because its too slow}
      create_new_segment;
      pa^ [0] := 1;
      pva.kind := amc$cell_pointer;
      pva.cell_pointer := p;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$preallocate_file_space (pva, n + 16384, TRUE, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      check_status (status);
      IF i > 1 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    STRINGREP (s, sl, 'Preallocate file space - ', n, ' bytes');
    display_statistic (s (1, sl), 0, s1);
  PROCEND test_preallocate_file_space;

{-------------------------------------------------------------------

  PROCEDURE test_pioc;

    VAR
      t0,
      t1,
      t2,
      t3: integer,
      i,
      j,
      k,
      rma: integer;

    create_new_segment;
    reset_statistic (s1);
    p^ := 1;
    mmp$write_modified_pages (p, 1, osc$wait, status);
    check_status (status);
    i := 0;
    WHILE i < 20 * scale DO
      mmp$free_pages (p, page_size, osc$wait, status);
      check_status (status);
      t0 := #FREE_RUNNING_CLOCK (0);
      mmp$advise_in (p, 1, status);
      check_status (status);
      REPEAT
        t3 := #FREE_RUNNING_CLOCK (0);
        i#real_memory_address (p, rma);
        IF rma < 0 THEN
          t1 := t3;
        IFEND;
      UNTIL (rma > 0) OR ((t1 - t0) > 5000000);
      t2 := #FREE_RUNNING_CLOCK (0);
      IF (t2 - t1 > 60) THEN
        IF i > 5 THEN
          record_statistic (t1, t2, s1);
        IFEND;
        i := i + 1;
      IFEND;
    WHILEND;

    display_statistic ('Process disk IO completion', 0, s1);

  PROCEND test_pioc;

{-------------------------------------------------------------------

  PROCEDURE test_read;

    VAR
      iostatus: mmt$io_status,
      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 100 DO
        mmp$free_pages (p, page_size, osc$wait, status);
        check_status (status);
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$read (p, 1, ^iostatus, osc$nowait, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        mmp$wait_io_completion (p, status);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Read', 0, s1);
  PROCEND test_read;

{-------------------------------------------------------------------

  PROCEDURE test_set_access_selections;

    VAR
      arr: array [1 .. 100] of ^cell,
      overflow: boolean,
      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 8 * scale DO
      create_new_segment;
      FOR i := 1 TO 200 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$set_access_selections (p, mmc$as_random, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Set access selections', 0, s1);
  PROCEND test_set_access_selections;

{-------------------------------------------------------------------

  PROCEDURE test_set_segment_length;

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      FOR i := 1 TO 25 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$set_segment_length (p, 1, 1600, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        mmp$free_pages (p, page_size, osc$wait, status);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND
    FOREND;
    display_statistic ('Set segment length', 0, s1);
  PROCEND test_set_segment_length;

{-------------------------------------------------------------------

  PROCEDURE test_store_segment_attributes;

    VAR
      attr: [STATIC] array [1 .. 1] of mmt$attribute_descriptor := [[mmc$kw_max_segment_length, 1000000]],
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      FOR i := 1 TO 250 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$store_segment_attributes (p, 1, attr, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND
    FOREND;
    display_statistic ('Store segment attributes', 0, s1);
  PROCEND test_store_segment_attributes;

{-------------------------------------------------------------------

  PROCEDURE test_task_switch;

    VAR

      last_t1_changed: integer,
      i: integer;

    reset_statistic (s1);
    set_task2_function (run);
    FOR i := 1 TO 20 * scale DO
      last_t1_changed := data_p^.t1_changed;
      WHILE data_p^.t1_changed = last_t1_changed DO
        #SPOIL (data_p^);
        data_p^.t1 := #FREE_RUNNING_CLOCK (0);
      WHILEND;
      IF i > 10 THEN
        record_statistic (data_p^.t1_last, data_p^.t1_changed, s1);
      IFEND;
    FOREND;
    set_task2_function (idle);
    display_statistic ('Task switch (caused by SIT) ', 0, s1);
    task_switch_time := s1.taver
  PROCEND test_task_switch;


{-------------------------------------------------------------------

  PROCEDURE test_verify_access;

    VAR
      bool: boolean,
      cp: ^cell,
      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 4 * scale DO
      create_new_segment;
      FOR i := 1 TO 200 DO
        p^ := 1;
        cp := p;
        t1 := #FREE_RUNNING_CLOCK (0);
        bool := mmp$verify_access (^cp, mmc$va_read);
        t2 := #FREE_RUNNING_CLOCK (0);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    display_statistic ('Verify access', 0, s1);
  PROCEND test_verify_access;


{-------------------------------------------------------------------

  PROCEDURE test_wait_io_completion;

    VAR
      t1,
      t2: integer,
      i,
      j,
      k: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 25 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$wait_io_completion (p, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND
    FOREND;
    display_statistic ('Wait IO completion - no IO active', 0, s1);
  PROCEND test_wait_io_completion;

{-------------------------------------------------------------------

  PROCEDURE test_write
    (    remove: boolean);

    VAR
      iostatus: mmt$io_status,
      t1,
      t2: integer,
      i,
      j: integer;

    reset_statistic (s1);
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      p^ := 1;
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      FOR i := 1 TO 100 DO
        p^ := 1;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$write (p, 1, remove, ^iostatus, osc$nowait, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        mmp$wait_io_completion (p, status);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    IF remove THEN
      display_statistic ('Write - remove page', 0, s1);
    ELSE
      display_statistic ('Write - dont remove page', 0, s1);
    IFEND;
  PROCEND test_write;

{-------------------------------------------------------------------

  PROCEDURE test_write_mod_pages
    (    nwrite,
         nmod: integer);

    VAR
      len: integer,
      t1,
      t2: integer,
      i,
      j,
      k: integer,
      id: string (50);

    reset_statistic (s1);
    len := page_size * nwrite;
    FOR j := 1 TO 2 * scale DO
      create_new_segment;
      FOR i := 1 TO 30 DO
        FOR k := 0 TO nmod - 1 DO
          pa^ [k * page_size] := 1;
        FOREND;
        t1 := #FREE_RUNNING_CLOCK (0);
        mmp$write_modified_pages (p, len, osc$nowait, status);
        t2 := #FREE_RUNNING_CLOCK (0);
        check_status (status);
        mmp$write_modified_pages (p, len, osc$wait, status);
        check_status (status);
        IF i > 4 THEN
          record_statistic (t1, t2, s1);
        IFEND;
      FOREND;
    FOREND;
    STRINGREP (id, sl, 'Write mod pages ', nwrite, ' pages, ', nmod, ' actually modified');
    display_statistic (id (1, sl), 0, s1);
  PROCEND test_write_mod_pages;

{-------------------------------------------------------------------

  PROCEDURE test_write_mod_pages_no_file;

    VAR
      t1,
      t2: integer,
      i,
      k: integer;

    reset_statistic (s1);
    FOR i := 1 TO 40 * scale DO
      create_new_segment;
      pa^ [0] := 1;
      t1 := #FREE_RUNNING_CLOCK (0);
      mmp$write_modified_pages (p, 1, osc$nowait, status);
      t2 := #FREE_RUNNING_CLOCK (0);
      mmp$write_modified_pages (p, 1, osc$wait, status);
      check_status (status);
      IF i > 4 THEN
        record_statistic (t1, t2, s1);
      IFEND;
    FOREND;
    display_statistic ('Write mod pages, assign file to trans seg', 0, s1);
  PROCEND test_write_mod_pages_no_file;

?? EJECT ??

  PROGRAM [XDCL, #GATE] mm_path_test
    (    parameters: pmt$program_parameters);

*copyc mmd$pdt_mm_path_test

    VAR
      output_a_segment: [STATIC] amt$local_file_name := 'OUT',
      key_p: ^clt$data_value,
      key: ost$name,
      shared_segment_id: amt$file_identifier,
      shared_segment_pointer: amt$segment_pointer,
      shared_segment_name: [STATIC] amt$local_file_name := 'READY_SEGMENT',
      second_task_id: pmt$task_id,
      second_task_status: pmt$task_status,
      i: integer;

    clp$evaluate_parameters (parameters, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;



{ Create a segment used to store information on each task's access.

    amp$open (shared_segment_name, amc$segment, NIL, shared_segment_id, status);
    check_status (status);


    amp$get_segment_pointer (shared_segment_id, amc$cell_pointer, shared_segment_pointer, status);
    check_status (status);

    fsp$open_file (pvt [p$output].value^.file_value^, amc$record, NIL, NIL, NIL, NIL, NIL, ofid, status);
    check_status (status);
    data_p := shared_segment_pointer.cell_pointer;

    data_p^.func := idle;
    execute_task_2 (shared_segment_name, second_task_id, second_task_status, status);
    check_status (status);

    page_size := 512 * (128 - #READ_REGISTER (osc$pr_page_size_mask));
    STRINGREP (s, sl, ' Page Size = ', page_size);
    writeout;
    s := ' TEST                                                  Min us   Aver us';
    sl := 71;
    writeout;

    key_p := pvt [p$name].value;
    scale := pvt [p$scale].value^.integer_value.value;
    skip_shadow_tests := pvt [p$skip_shadow_tests].value^.boolean_value.value;
    scratch_files := pvt [p$file_type].value^.keyword_value = 'TRANSIENT';
    WHILE key_p <> NIL DO
      key := key_p^.element_value^.keyword_value;
      IF (key = 'ALL') OR (key = 'ADVISE_IN') THEN
        test_advisein (ai_null);
        test_advisein (ai_reclaim);
        test_advisein (ai_new);
        test_advisein (ai_disk);
      IFEND;
      IF (key = 'ALL') OR (key = 'ADVISE_OUT') THEN
        test_adviseout (FALSE);
        test_adviseout (TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'ADVISE_OUT_IN') THEN
        test_adviseoutin (FALSE, FALSE);
        test_adviseoutin (TRUE, FALSE);
        test_adviseoutin (FALSE, TRUE);
        test_adviseoutin (TRUE, TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'ASSIGN_CONTIGUOUS_MEMORY') THEN
        test_assign_contiguous_memory (16384);
        test_assign_contiguous_memory (65536);
      IFEND;
      IF (key = 'ALL') OR (key = 'ASSIGN_PAGES') THEN
        test_assign (1);
        test_assign (2);
        test_assign (4);
        test_assign (8);
      IFEND;
      IF (key = 'ALL') OR (key = 'CHANGE_STACK_ATTRIBUTE') THEN
        test_change_stack_attribute;
      IFEND;
      IF (key = 'ALL') OR (key = 'CHECK_IO_STATUS') THEN
        test_check_io_status (FALSE);
        test_check_io_status (TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'CONDITIONAL_FREE') THEN
        test_conditional_free (FALSE);
        test_conditional_free (TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'COPY_PAGES') THEN
        test_copy (1, FALSE);
        test_copy (2, FALSE);
        test_copy (4, FALSE);
        test_copy (1, TRUE);
        test_copy (2, TRUE);
        test_copy (4, TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'CREATE_SCRATCH_SEGMENT') THEN
        test_create_scratch_segment;
      IFEND;
      IF (key = 'ALL') OR (key = 'CREATE_SEGMENT') THEN
        test_create_segment;
      IFEND;
      IF (key = 'ALL') OR (key = 'CREATE_SHADOW_SEGMENT') THEN
        test_create_shadow_segment;
      IFEND;
      IF (key = 'ALL') OR (key = 'CREATE_USER_SEGMENT') THEN
        test_create_user_segment;
      IFEND;
      IF (key = 'ALL') OR (key = 'DELETE_SEGMENT') THEN
        test_delete_scratch_segment (noasid);
        test_delete_scratch_segment (nopages);
        test_delete_scratch_segment (pages);
        test_delete_scratch_segment (diskfile);
      IFEND;
      IF (key = 'ALL') OR (key = 'FETCH_PVA_UNWRITTEN_PAGES') THEN
        test_fetch_pva_unwritten_pages;
      IFEND;
      IF (key = 'ALL') OR (key = 'FETCH_SEGMENT_ATTRIBUTES') THEN
        test_fetch_segment_attributes;
      IFEND;
      IF (key = 'ALL') OR (key = 'GET_SEGMENT_LENGTH') THEN
        test_get_segment_length (FALSE);
        test_get_segment_length (TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'INITIATE_DEBUG_SHADOWING') THEN
        test_initiate_debug_shadowing;
      IFEND;
      IF (key = 'ALL') OR (key = 'INITIATE_SHADOWING') THEN
        test_initiate_shadowing;
      IFEND;
      IF (key = 'ALL') OR (key = 'LOCK_PAGES') THEN
        test_lock_pages;
      IFEND;
      IF (key = 'ALL') OR (key = 'LOCK_SEGMENT') THEN
        test_lock_segment;
      IFEND;
      IF (key = 'ALL') OR (key = 'MOVE_PAGES') THEN
        test_move (1);
        test_move (2);
        test_move (4);
      IFEND;
      IF (key = 'ALL') OR (key = 'NULL_MONITOR_REQUEST') THEN
        test_null;
      IFEND;
      IF (key = 'ALL') OR (key = 'PF_DISK') THEN
        test_pf_disk;
      IFEND;
      IF (key = 'ALL') OR (key = 'PF_NEW_FILE_ALLOC') THEN
        test_pf_new_file_alloc;
      IFEND;
      IF (key = 'ALL') OR (key = 'PF_NEW_FILE_NO_ALLOC') THEN
        test_pf_new_file_no_alloc;
      IFEND;
      IF (key = 'ALL') OR (key = 'PF_NEW_NO_FILE') THEN
        test_pf_new_no_file;
      IFEND;
      IF (key = 'ALL') OR (key = 'PF_RECLAIM') THEN
        test_pf_reclaim;
      IFEND;
      IF (key = 'ALL') OR (key = 'PREALLOCATE_FILE_SPACE') THEN
        test_preallocate_file_space (16384);
        test_preallocate_file_space (16384 * 100);
        test_preallocate_file_space (16384 * 1000);
      IFEND;
      IF (key = 'ALL') OR (key = 'PROCESS_IO_COMPLETION') THEN
        test_pioc;
      IFEND;
      IF (key = 'ALL') OR (key = 'READ') THEN
        test_read;
      IFEND;
      IF (key = 'ALL') OR (key = 'SET_ACCESS_SELECTIONS') THEN
        test_set_access_selections;
      IFEND;
      IF (key = 'ALL') OR (key = 'SET_SEGMENT_LENGTH') THEN
        test_set_segment_length;
      IFEND;
      IF (key = 'ALL') OR (key = 'STORE_SEGMENT_ATTRIBUTES') THEN
        test_store_segment_attributes;
      IFEND;
      IF (key = 'ALL') OR (key = 'TASK_SWITCH') THEN
        test_task_switch;
      IFEND;
      IF (key = 'ALL') OR (key = 'VERIFY_ACCESS') THEN
        test_verify_access;
      IFEND;
      IF (key = 'ALL') OR (key = 'WAIT_IO_COMPLETION') THEN
        test_wait_io_completion;
      IFEND;
      IF (key = 'ALL') OR (key = 'WRITE') THEN
        test_write (FALSE);
        test_write (TRUE);
      IFEND;
      IF (key = 'ALL') OR (key = 'WRITE_MODIFIED_PAGES') THEN
        test_write_mod_pages (1, 0);
        test_write_mod_pages (1, 1);
        test_write_mod_pages (1, 2);
        test_write_mod_pages (1, 4);
        test_write_mod_pages (2, 2);
        test_write_mod_pages (2, 4);
        test_write_mod_pages (4, 4);
        test_write_mod_pages (8, 8);
        test_write_mod_pages (16, 16);
      IFEND;
      IF (key = 'ALL') OR (key = 'WRITE_MODIFIED_PAGES_NO_FILE') THEN
        test_write_mod_pages_no_file;
      IFEND;
      key_p := key_p^.link;
    WHILEND;

    set_task2_function (quit);
    amp$close (shared_segment_id, status);
    amp$close (ofid, status);

  PROCEND mm_path_test;
?? EJECT ??

  PROCEDURE execute_task_2
    (    shared_segment_name: amt$local_file_name;
     VAR task_id: pmt$task_id;
     VAR task_status: pmt$task_status;
     VAR status: ost$status);

    VAR
      number_of_object_files: pmt$number_of_object_files,
      number_of_modules: pmt$number_of_modules,
      number_of_libraries: pmt$number_of_libraries,
      second_task: ^pmt$program_description,
      second_task_attributes: ^pmt$program_attributes,
      second_task_parameters: ^pmt$program_parameters,
      shared_segment_name_param: ^amt$local_file_name;

{ Build the program description of the second task using the program
{ description of the first task as a base.

    pmp$get_program_size (number_of_object_files, number_of_modules, number_of_libraries, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Allocate a sequence long enough for the program attributes variable,
{ the object file list, the module list, and the object library list.

    PUSH second_task: [[REP (#SIZE (pmt$program_attributes) +
          (number_of_object_files * #SIZE (amt$local_file_name)) +
          (number_of_modules * #SIZE (pmt$program_name)) + (number_of_libraries *
          #SIZE (amt$local_file_name))) OF cell]];

{ Get the program description of the first task.

    pmp$get_program_description (second_task^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET second_task;
    NEXT second_task_attributes IN second_task;
    second_task_attributes^.contents := second_task_attributes^.contents +
          $pmt$prog_description_contents [pmc$starting_proc_specified];

    second_task_attributes^.starting_procedure := 'MM_PATH_TEST2';

{ Build the second task parameter list:
{   Shared segment local file name

    PUSH second_task_parameters: [[REP 1 OF amt$local_file_name, REP 1 OF integer]];
    RESET second_task_parameters;
    NEXT shared_segment_name_param IN second_task_parameters;
    shared_segment_name_param^ := shared_segment_name;

{ Start the second task.  The osc$nowait parameter indicates that both tasks
{ are to execute at the same time.

    pmp$execute (second_task^, second_task_parameters^, osc$nowait, task_id, task_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
  PROCEND execute_task_2;

MODEND mmm$mm_path_test
