?? RIGHT := 110 ??
*copyc osd$default_pragmats
MODULE dfm$performance_test_utility;

{ PURPOSE:
{    The purpose of this module is to provide timing statistics for io
{    operations (read, write) upon a file of a specified size and using
{    a selected io mode (normal, sequential, advised).
{
{    Although this module was written to generate timings for operations upon
{    served files, the specified file need not be a served file.

?? NEWTITLE := '    Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc ost$name
*copyc ost$status
?? POP ??
*copyc amp$fetch_access_information
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$put_next
*copyc amp$return
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc dfi$display
*copyc i#current_sequence_position
*copyc i#ptr
*copyc mmp$advise_in
*copyc mmp$advise_out
*copyc mmp$advise_out_in
*copyc mmp$free_pages
*copyc mmp$write_modified_pages
*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter
*copyc pfp$attach
*copyc pmp$get_legible_date_time
*copyc pmp$get_task_cp_time

*copyc dfi$fsp_open_close

?? OLDTITLE ??
?? TITLE := '    [INLINE] min ', EJECT ??

  FUNCTION [INLINE] min
    (    number_one: integer;
         number_two: integer): integer;

    IF number_one < number_two THEN
      min := number_one;
    ELSE
      min := number_two;
    IFEND;
  FUNCEND min;

?? TITLE := '  performance test utility', EJECT ??

  PROGRAM dfp$ptu
    (    ppp: clt$parameter_list;
     VAR status: ost$status);


{ pdt ptu_pdt (
{ file_name,fn,f: file = $required
{ io_operation,io: key read,r ,write, w = read
{ mode,m: key normal, n, sequential, s, advise, a = n
{ size, s: integer
{ retry_count,rc, number, n: integer = 1
{ bite_size,bs: integer = 4096
{ advise_look_ahead, ala: integer = 3
{ advise_size, as : integer = 14000(16)
{ minimum_advise_size, mas: integer = 4000(16)
{ write_modified_pages, wmp: boolean = TRUE
{ free_pages, fp: boolean = TRUE
{ report_file_name, rfn: file = $user.ptu_report
{ open: key fsp$open_file, amp$open = fsp$open_file
{ status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    ptu_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^ptu_pdt_names, ^ptu_pdt_params];

  VAR
    ptu_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 29] of
  clt$parameter_name_descriptor := [['FILE_NAME', 1], ['FN', 1], ['F', 1], ['IO_OPERATION', 2], ['IO', 2], [
  'MODE', 3], ['M', 3], ['SIZE', 4], ['S', 4], ['RETRY_COUNT', 5], ['RC', 5], ['NUMBER', 5], ['N', 5], [
  'BITE_SIZE', 6], ['BS', 6], ['ADVISE_LOOK_AHEAD', 7], ['ALA', 7], ['ADVISE_SIZE', 8], ['AS', 8], [
  'MINIMUM_ADVISE_SIZE', 9], ['MAS', 9], ['WRITE_MODIFIED_PAGES', 10], ['WMP', 10], ['FREE_PAGES', 11], ['FP'
  , 11], ['REPORT_FILE_NAME', 12], ['RFN', 12], ['OPEN', 13], ['STATUS', 14]];

  VAR
    ptu_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 14] of clt$parameter_descriptor := [

{ FILE_NAME FN F }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ IO_OPERATION IO }
    [[clc$optional_with_default, ^ptu_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [^ptu_pdt_kv2,
  clc$keyword_value]],

{ MODE M }
    [[clc$optional_with_default, ^ptu_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [^ptu_pdt_kv3,
  clc$keyword_value]],

{ SIZE S }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, clc$min_integer,
  clc$max_integer]],

{ RETRY_COUNT RC NUMBER N }
    [[clc$optional_with_default, ^ptu_pdt_dv5], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ BITE_SIZE BS }
    [[clc$optional_with_default, ^ptu_pdt_dv6], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ ADVISE_LOOK_AHEAD ALA }
    [[clc$optional_with_default, ^ptu_pdt_dv7], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ ADVISE_SIZE AS }
    [[clc$optional_with_default, ^ptu_pdt_dv8], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ MINIMUM_ADVISE_SIZE MAS }
    [[clc$optional_with_default, ^ptu_pdt_dv9], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ WRITE_MODIFIED_PAGES WMP }
    [[clc$optional_with_default, ^ptu_pdt_dv10], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ FREE_PAGES FP }
    [[clc$optional_with_default, ^ptu_pdt_dv11], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ REPORT_FILE_NAME RFN }
    [[clc$optional_with_default, ^ptu_pdt_dv12], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value
  ]],

{ OPEN }
    [[clc$optional_with_default, ^ptu_pdt_dv13], 1, 1, 1, 1, clc$value_range_not_allowed, [^ptu_pdt_kv13,
  clc$keyword_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
  clc$array_not_allowed, clc$status_value]]];

  VAR
    ptu_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['READ','R','WRITE',
  'W'];

  VAR
    ptu_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := ['NORMAL','N',
  'SEQUENTIAL','S','ADVISE','A'];

  VAR
    ptu_pdt_kv13: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of ost$name := ['FSP$OPEN_FILE',
  'AMP$OPEN'];

  VAR
    ptu_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'read';

  VAR
    ptu_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := 'n';

  VAR
    ptu_pdt_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '1';

  VAR
    ptu_pdt_dv6: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := '4096';

  VAR
    ptu_pdt_dv7: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '3';

  VAR
    ptu_pdt_dv8: [STATIC, READ, cls$pdt_names_and_defaults] string (9) := '14000(16)';

  VAR
    ptu_pdt_dv9: [STATIC, READ, cls$pdt_names_and_defaults] string (8) := '4000(16)';

  VAR
    ptu_pdt_dv10: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'TRUE';

  VAR
    ptu_pdt_dv11: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'TRUE';

  VAR
    ptu_pdt_dv12: [STATIC, READ, cls$pdt_names_and_defaults] string (16) := '$user.ptu_report';

  VAR
    ptu_pdt_dv13: [STATIC, READ, cls$pdt_names_and_defaults] string (13) := 'fsp$open_file';

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      advise_inc: amt$file_byte_address,
      advise_look_ahead: integer,
      advise_size: amt$working_storage_length,
      ap: ^array [ * ] of char,
      buffer_required: boolean,
      byte_size: amt$file_byte_address,
      byte_address_specified: boolean,
      c: char,
      command_name: ost$name,
      count: integer,
      cp_time_begin: pmt$task_cp_time,
      cp_time_end: pmt$task_cp_time,
      cp_time_elapsed: pmt$task_cp_time,
      display_file_id: amt$file_identifier,
      display_file_name: amt$local_file_name,
      elapsed_time: integer,
      eoi: amt$file_byte_address,
      fetch_access_selections: array [1 .. 1] of amt$access_info,
      file_id: amt$file_identifier,
      file_position: amt$file_position,
      free_pages: boolean,
      local_file_name: amt$local_file_name,
      minimum_advise_size: amt$working_storage_length,
      mode_name: ost$name,
      p_times: ^array [ * ] of record
        task: integer,
        monitor: integer,
      recend,
      read_count: amt$file_byte_address,
      read_not_write: boolean,
      retry_count: integer,
      report_file_name: amt$local_file_name,
      segment_pointer: amt$segment_pointer,
      seqp: ^SEQ ( * ),
      specified_size: amt$file_byte_address,
      start_time: integer,
      total_monitor: integer,
      total_task: integer,
      use_fsp$open_file: boolean,
      value: clt$value,
      write_modified_pages: boolean;

    clp$scan_parameter_list (ppp, ptu_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('FILE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    local_file_name := value.file.local_file_name;

    clp$get_value ('IO_OPERATION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    read_not_write := value.name.value (1) = 'R';

    clp$get_value ('MODE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    mode_name := value.name.value;

    clp$get_value ('BITE_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    byte_size := value.int.value;

    clp$get_value ('SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$integer_value THEN
      specified_size := value.int.value;
    ELSEIF NOT read_not_write THEN
      osp$set_status_abnormal ('DF', 999, ' SIZE must specified for WRITE.', status);
      RETURN;
    IFEND;
    clp$get_value ('RETRY_COUNT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    retry_count := value.int.value;

    clp$get_value ('ADVISE_LOOK_AHEAD', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    advise_look_ahead := value.int.value;

    clp$get_value ('ADVISE_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    advise_size := value.int.value;

    clp$get_value ('MINIMUM_ADVISE_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    minimum_advise_size := value.int.value;

    clp$get_value ('REPORT_FILE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    report_file_name := value.file.local_file_name;

    clp$get_value ('WRITE_MODIFIED_PAGES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    write_modified_pages := value.bool.value;

    clp$get_value ('FREE_PAGES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    free_pages := value.bool.value;

    clp$get_value ('OPEN', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    use_fsp$open_file := value.name.value (1) = 'F';

    PUSH p_times: [1 .. retry_count];


    elapsed_time := 0;
    FOR count := 1 TO retry_count DO

      IF use_fsp$open_file THEN
        IF (mode_name = 'S') OR (mode_name = 'SEQUENTIAL') THEN
          dfp$fsp_open (local_file_name,  amc$segment, read_not_write, {open_for_attach} TRUE,
                {seq_and_free_behind} TRUE , 'PTU',  file_id, seqp, eoi, status);
        ELSE
          dfp$fsp_open (local_file_name,  amc$segment, read_not_write, {open_for_attach} FALSE,
                {seq_and_free_behind} FALSE, 'PTU',  file_id, seqp, eoi, status);
        IFEND;
      ELSE
        amp$open (local_file_name, amc$segment, NIL, file_id, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        seqp := segment_pointer.sequence_pointer;
        fetch_access_selections [1].key := amc$eoi_byte_address;
        amp$fetch_access_information (file_id, fetch_access_selections, status);
        IF NOT status.normal THEN
          RETURN;
         IFEND;
        eoi := fetch_access_selections [1].eoi_byte_address;
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF NOT read_not_write THEN
        eoi := specified_size;
      IFEND;

      RESET seqp;
      read_count := 0;

      start_time := #free_running_clock (0);
      pmp$get_task_cp_time (cp_time_begin, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (mode_name (1) = 'A') THEN
        advised_io (seqp, byte_size, eoi, minimum_advise_size, advise_size, advise_look_ahead,
             read_not_write, status);
      ELSE
        WHILE read_count < eoi DO
          IF (read_count + byte_size <= eoi) THEN
            NEXT ap: [1 .. byte_size] IN seqp;
          ELSE
            NEXT ap: [1 .. (eoi - read_count)] IN seqp
          IFEND;
          IF ap <> NIL THEN
            IF read_not_write THEN
              c := ap^ [1];
            ELSE
              ap^ [1] := mode_name (1);
            IFEND;
          IFEND;
          read_count := read_count + 4096;
        WHILEND;
      IFEND;

      IF (NOT read_not_write) AND write_modified_pages THEN
        RESET seqp;
        mmp$write_modified_pages (seqp,eoi, osc$wait, status);
      IFEND;

      pmp$get_task_cp_time (cp_time_end, status);
      elapsed_time := elapsed_time + #free_running_clock (0) - start_time;

      IF (NOT read_not_write) AND free_pages THEN
        RESET seqp;
        mmp$free_pages (seqp, eoi, osc$wait, status);
      IFEND;

      IF status.normal THEN
        dfp$fsp_close (file_id, seqp, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF status.normal THEN
        cp_time_elapsed.task_time := cp_time_end.task_time - cp_time_begin.task_time;
        cp_time_elapsed.monitor_time := cp_time_end.monitor_time - cp_time_begin.monitor_time;
{       display_integer (' TASK elapsed time = ', cp_time_elapsed.task_time);
{       display_integer (' MONITOR elapsed time = ', cp_time_elapsed.monitor_time);
      IFEND;

      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_times^ [count].task := cp_time_elapsed.task_time;
      p_times^ [count].monitor := cp_time_elapsed.monitor_time;


    FOREND;

    IF retry_count > 1 THEN
      total_monitor := 0;
      total_task := 0;
      {Throw away first sample
      FOR count := 2 TO retry_count DO
        total_monitor := total_monitor + p_times^ [count].monitor;
        total_task := total_task + p_times^ [count].task;
      FOREND;

      cp_time_elapsed.monitor_time := total_monitor DIV (retry_count - 1);
      cp_time_elapsed.task_time := total_task DIV (retry_count - 1);

      display_integer ('   Average task time = ',
           cp_time_elapsed.task_time);
      display_integer ('   Average monitor time = ',
           cp_time_elapsed.monitor_time);
    IFEND;

    report (local_file_name, retry_count, eoi, read_not_write, mode_name,
         elapsed_time div retry_count, cp_time_elapsed, advise_size,
         advise_look_ahead, minimum_advise_size, report_file_name, status);

  PROCEND dfp$ptu;

?? TITLE := '    advised_io', EJECT ??

  PROCEDURE advised_io
    (VAR seqp: ^SEQ ( * );
         byte_size: amt$file_byte_address;
         wsl: amt$working_storage_length;
         minimum_size_to_advise: amt$working_storage_length;
         advise_size: amt$working_storage_length;
         advise_look_ahead: integer;
         read_not_write: boolean;
     VAR status: ost$status);

    VAR
      advise_in_length: integer,
      advise_in_wsa: ^cell,
      ap: ^array [ * ] of char,
      c: char,
      ignored_status: ost$status,
      incr: amt$file_byte_address,
      move_wsa: ^cell,
      move_wsl: integer,
      next_move_wsa: ^cell,
      next_move_wsl: integer,
      remains: integer,
      total_advised_in: integer,
      total_wsl_moved: integer,
      wsa: ^cell;

    wsa := seqp;
    total_wsl_moved := 0;
    IF wsl <= advise_size THEN
      move_wsl := wsl;
    ELSE
      move_wsl := advise_size;
    IFEND;
    move_wsa := wsa;

    { compute initial advise in amount
    advise_in_length := min ((wsl - total_wsl_moved), (advise_size * advise_look_ahead));
    advise_in_wsa := wsa;
    IF read_not_write THEN
      mmp$advise_in (advise_in_wsa, advise_in_length, status);
      IF NOT status.normal THEN
        {?     display_status (status);
        RETURN;
      IFEND;
    IFEND;
    total_advised_in := advise_in_length;

    next_move_wsl := move_wsl;
    REPEAT
      remains := move_wsl;
      WHILE remains > 0 DO
        IF move_wsl >= byte_size THEN
          incr := byte_size;
        ELSE
          incr := move_wsl;
        IFEND;
        NEXT ap: [1 .. incr] IN seqp;
        IF ap <> NIL THEN
          IF read_not_write THEN
            c := ap^ [1];
          ELSE
            ap^ [1] := 'A'
          IFEND;
        IFEND;
        remains := remains - incr;
      WHILEND;

      total_wsl_moved := total_wsl_moved + move_wsl;
      next_move_wsa := i#ptr (total_wsl_moved, wsa);
      IF (total_wsl_moved + next_move_wsl) >= wsl THEN
        next_move_wsl := wsl - total_wsl_moved;
      IFEND;
      advise_in_wsa := i#ptr (total_advised_in, wsa);
      advise_in_length := min ((wsl - total_advised_in), advise_size);
 {    display_integer (' mmp$advise_out_in   out:', move_wsl);
 {    display_integer ('     in: ', advise_in_length);
      IF read_not_write THEN
        mmp$advise_out_in (move_wsa, move_wsl, advise_in_wsa, advise_in_length, status);
      ELSE
        mmp$advise_out (move_wsa, move_wsl, status);
      IFEND;
      IF NOT status.normal THEN
        display_status (status);
        RETURN;
      IFEND;
      total_advised_in := total_advised_in + advise_in_length;
      move_wsa := next_move_wsa;
      move_wsl := next_move_wsl;
    UNTIL (total_wsl_moved >= wsl);

  PROCEND advised_io;

?? TITLE := '    report', EJECT ??

  PROCEDURE report
      (    lfn: amt$local_file_name;
           count: integer;
           file_size: amt$file_byte_address;
           read_not_write: boolean;
           mode_name: ost$name;
           wall_elapsed_time: integer;
           cp_elapsed_time: pmt$task_cp_time;
           advise_size: amt$working_storage_length;
           advise_look_ahead: integer;
           minimum_advise_size: amt$working_storage_length;
           report_file_name: amt$local_file_name;
       VAR status: ost$status);

    VAR
      byte_address: amt$file_byte_address,
      date_string: ost$date,
      eoi: amt$file_byte_address,
      file_id: amt$file_identifier,
      ignore_status: ost$status,
      io_string: string (5),
      line: string (100),
      line_size: integer,
      mode_string: string (6),
      real_monitor: real,
      real_task: real,
      real_wall: real,
      seqp: ^SEQ ( * ),
      time_string: ost$time;

   CONST
     real_mics_to_seconds = 1.0e6;


    pmp$get_legible_date_time (osc$mdy_date, date_string, osc$hms_time, time_string,
      status);

    dfp$fsp_open (report_file_name, amc$record, {read_not_write} FALSE,
          {open_for_attach} TRUE, {seq_and_free_behind} FALSE,   'PTU', file_id, seqp, eoi, status);
    IF not status.normal THEN
      RETURN;
    IFEND;

    line := '';
    amp$put_next (file_id, ^line, 2, byte_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    stringrep (line, line_size, ' ptu#date=''', date_string.mdy,
               ''';ptu#time=''', time_string.hms, '''');
    amp$put_next (file_id, ^line, line_size, byte_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF read_not_write THEN
      io_string := 'READ';
    ELSE
      io_string := 'WRITE';
    IFEND;
    CASE mode_name (1) OF
    = 'A' =
      mode_string := 'ADVISE';
    = 'N' =
      mode_string := 'NORMAL';
    = 'S' =
      mode_string := 'SEQUEN';
    ELSE
      mode_string := '??????';
    CASEND;

    stringrep (line, line_size, ' ptu#file_size=', file_size,
       ';ptu#io_access=''', io_string,
       ''';ptu#mode=''', mode_string, ''';ptu#retry_count=',count);
    amp$put_next (file_id, ^line, line_size, byte_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

     real_wall := $real(wall_elapsed_time) / real_mics_to_seconds;
     real_monitor := $real(cp_elapsed_time.monitor_time) / real_mics_to_seconds;
     real_task := $real(cp_elapsed_time.task_time) / real_mics_to_seconds;
    stringrep (line, line_size, '  ptu#elapsed_time=''',
      real_wall:9:3, ''';ptu#mon_time=''', real_monitor:9:3,
      ''';ptu#task_time=''', real_task:9:3, '''');
    amp$put_next (file_id, ^line, line_size, byte_address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF mode_name (1) = 'A' THEN
     {output advise parameters
    IFEND;

     dfp$fsp_close ( file_id, seqp, status);

  PROCEND report;

MODEND dfm$performance_test_utility;
