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

{ PURPOSE:
{    The purpose of this module is to attempt to maximize the transaction
{    rate between client and server mainframes. It is intended for use by
{    project members to determine the effect of modifications or different
{    configurations upon the transaction rate displayed by the VED FS
{    operator command.
{
{ NOTES:
{
{    The file is written and then read the specified number_of_passes times.
{
{    Maximization is sought by reading from the server directly into memory.
{
{    It is expected that this program will be driven by a command sequence
{    such as:
{
{         FOR i = 1 TO 16 DO
{           JOB sm='?'
{             create_variable ign kind=status
{             setcl a=$system.osf$builtin_library status=ign
{             setpa al=cyf$run_time_library status=ign
{             dfp$ptu $fname(':testing.$system.test_'//'?$STRREP(i)?')
{           JOBEND
{         FOREND
{


?? 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$put_next
*copyc amp$return
*copyc amp$set_segment_position
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#current_sequence_position
*copyc i#ptr
*copyc mmp$free_pages
*copyc mmp$set_access_selections
*copyc mmp$write_modified_pages
*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter


  CONST
    clc$input_buffer_size = 8192;

  TYPE
    clt$get_control_record = record
      access_level: amt$access_level,
      file_id: amt$file_identifier,
      sequence_pointer: ^SEQ ( * ),
      sequence_size: amt$file_byte_address,
      bytes_remaining: amt$file_byte_address,
      file_position: amt$file_position,
      buffer_first_byte_address: integer,
      buffer_last_byte_address: integer,
    recend;

?? TITLE := '    open_it', EJECT ??

  PROCEDURE open_it
    (    local_file_name: amt$local_file_name;
         command_name: string ( * <= osc$max_name_size);
         read_not_write: boolean;
     VAR file_open: boolean;
     VAR file_position: amt$file_position;
     VAR get_control: clt$get_control_record;
     VAR status: ost$status);

{ NOTES:
{    1. This procedure originated from the SCL clp$dump_file_command, so
{       it may be a bit more restrictive than required here. The original
{       code was copied then somewhat modified so any errors are of a local
{       origin.

    VAR
      file_attachment: array [1 .. 3] of fst$attachment_option,
      device_assigned: boolean,
      fetch_access_selections: array [1 .. 2] of amt$access_info,
      attribute_override: array [1 .. 3] of fst$file_cycle_attribute,
      file_organization_selector: [STATIC, READ, oss$job_paged_literal] array [boolean] of
            amt$file_organization := [amc$sequential, amc$byte_addressable],
      ignore_status: ost$status,
      segment_pointer: amt$segment_pointer;

    file_attachment [1].selector := fsc$access_and_share_modes;
    file_attachment [1].access_modes.selector := fsc$specific_access_modes;
    file_attachment [1].share_modes.selector := fsc$specific_share_modes;
    file_attachment [2].selector := fsc$open_share_modes;
    IF read_not_write THEN
      file_attachment [1].access_modes.value := $fst$file_access_options [fsc$read];
      file_attachment [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
      file_attachment [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    ELSE
      file_attachment [1].access_modes.value := $fst$file_access_options [fsc$read, fsc$append, fsc$shorten];
      file_attachment [1].share_modes.value := $fst$file_access_options [];
      file_attachment [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    IFEND;
    file_attachment [3].selector := fsc$create_file;
    file_attachment [3].create_file := TRUE;

    attribute_override [1].selector := fsc$block_type;
    attribute_override [1].block_type := amc$system_specified;
    attribute_override [2].selector := fsc$record_type;
    attribute_override [2].record_type := amc$undefined;
    attribute_override [3].selector := fsc$file_organization;
    attribute_override [3].file_organization := amc$sequential;
    get_control.access_level := amc$segment;

    fsp$open_file (local_file_name, get_control.access_level, ^file_attachment, NIL, NIL, NIL,
          ^attribute_override, get_control.file_id, status);
    IF NOT status.normal AND (read_not_write) THEN
      IF status.condition = ame$new_file_requires_append THEN
        osp$set_status_abnormal ('CL', cle$file_never_opened, local_file_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, command_name, status);
      IFEND;
      RETURN;
    IFEND;
    file_open := TRUE;

    fetch_access_selections [1].key := amc$file_position;
    fetch_access_selections [2].key := amc$eoi_byte_address;
    amp$fetch_access_information (get_control.file_id, fetch_access_selections, status);
    IF NOT status.normal THEN
      fsp$close_file (get_control.file_id, ignore_status);
      file_open := FALSE;
      RETURN;
    IFEND;
    IF fetch_access_selections [1].item_returned THEN
      file_position := fetch_access_selections [1].file_position;
    ELSE
      file_position := amc$boi;
    IFEND;
    amp$get_segment_pointer (get_control.file_id, amc$sequence_pointer, segment_pointer, status);
    IF status.normal THEN
      get_control.sequence_pointer := segment_pointer.sequence_pointer;
      get_control.bytes_remaining := fetch_access_selections [2].eoi_byte_address -
            i#current_sequence_position (get_control.sequence_pointer);
    ELSEIF status.condition = ame$read_of_empty_segment THEN
      status.normal := TRUE;
      get_control.sequence_pointer := NIL;
      get_control.bytes_remaining := 0;
    ELSE
      fsp$close_file (get_control.file_id, ignore_status);
      file_open := FALSE;
      RETURN;
    IFEND;


    get_control.file_position := file_position;

  PROCEND open_it;

?? TITLE := '    close_for_get', EJECT ??

  PROCEDURE close_for_get
    (VAR get_control: clt$get_control_record;
     VAR status: ost$status);

    VAR
      segment_pointer: amt$segment_pointer;

    IF (get_control.access_level = amc$segment) AND (get_control.sequence_pointer <> NIL) THEN
      segment_pointer.kind := amc$sequence_pointer;
      segment_pointer.sequence_pointer := get_control.sequence_pointer;
      amp$set_segment_position (get_control.file_id, segment_pointer, status);
    IFEND;

    fsp$close_file (get_control.file_id, status);

  PROCEND close_for_get;
?? 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 := '  Maximize transaction rate', EJECT ??

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

{ pdt mtr_pdt (
{ file_name,fn,f: file = $required
{ size, s: integer = 409600
{ mode, m: key normal, n, sequential, s = n
{ number_of_passes, nop, number, n: integer = 1000
{ status)

?? PUSH (LISTEXT := ON) ??

  VAR
    mtr_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^mtr_pdt_names, ^mtr_pdt_params];

  VAR
    mtr_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 12] of
      clt$parameter_name_descriptor := [['FILE_NAME', 1], ['FN', 1], ['F', 1], ['SIZE', 2], ['S', 2], ['MODE'
      , 3], ['M', 3], ['NUMBER_OF_PASSES', 4], ['NOP', 4], ['NUMBER', 4], ['N', 4], ['STATUS', 5]];

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

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

{ SIZE S }
    [[clc$optional_with_default, ^mtr_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, clc$min_integer, clc$max_integer]],

{ MODE M }
    [[clc$optional_with_default, ^mtr_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [^mtr_pdt_kv3,
      clc$keyword_value]],

{ NUMBER_OF_PASSES NOP NUMBER N }
    [[clc$optional_with_default, ^mtr_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, clc$min_integer, clc$max_integer]],

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

  VAR
    mtr_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['NORMAL','N',
      'SEQUENTIAL','S'];

  VAR
    mtr_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (6) := '409600';

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

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

?? POP ??

    VAR
      ap: ^array [ * ] of char,
      byte_size: amt$file_byte_address,
      byte_address_specified: boolean,
      c: char,
      command_name: ost$name,
      count: integer,
      eoi: amt$file_byte_address,
      file_id: amt$file_identifier,
      file_open: boolean,
      file_position: amt$file_position,
      get_control: clt$get_control_record,
      local_file_name: amt$local_file_name,
      mode_name: ost$name,
      number_of_passes: integer,
      read_count: amt$file_byte_address,
      seqp: ^SEQ ( * ),
      specified_size: amt$file_byte_address,
      value: clt$value,
      write_count: amt$file_byte_address;

    clp$scan_parameter_list (ppp, mtr_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 ('SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    specified_size := value.int.value;

    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 ('NUMBER_OF_PASSES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    number_of_passes := value.int.value;

    byte_size := 4096;

    open_it (local_file_name, 'MAX_TRANS_RATE', FALSE, file_open, file_position,
          get_control, status);
    IF (NOT status.normal) OR (NOT file_open) THEN
      RETURN;
    IFEND;

    file_id := get_control.file_id;
    seqp := get_control.sequence_pointer;
    eoi := specified_size;

    RESET seqp;
    write_count := 0;

    WHILE write_count < eoi DO
      IF (write_count + byte_size <= eoi) THEN
        NEXT ap: [1 .. byte_size] IN seqp;
      ELSE
        NEXT ap: [1 .. (eoi - write_count)] IN seqp
      IFEND;
      IF ap <> NIL THEN
        ap^ [1] := mode_name (1);
      IFEND;
      write_count := write_count + byte_size;
    WHILEND;

    RESET seqp;
    mmp$write_modified_pages (seqp, eoi, osc$wait, status);

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF status.normal THEN
      close_for_get (get_control, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    {  Open for write to free pages.
    open_it (local_file_name, 'PTU', FALSE, file_open, file_position, get_control, status);
    IF (NOT status.normal) OR (NOT file_open) THEN
      RETURN;
    IFEND;

    file_id := get_control.file_id;
    seqp := get_control.sequence_pointer;
    eoi := get_control.bytes_remaining;

    IF (mode_name (1) = 'S') THEN
      mmp$set_access_selections (seqp, mmc$as_sequential, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    FOR count := 1 TO number_of_passes DO

      RESET seqp;
      read_count := 0;

      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
          c := ap^ [1];
        IFEND;
        read_count := read_count + 4096;
      WHILEND;

      RESET seqp;
      mmp$free_pages (seqp, eoi, osc$wait, status);

      IF NOT status.normal THEN
        RETURN;
      IFEND;

    FOREND;
    close_for_get (get_control, status);

  PROCEND dfp$mtr;

MODEND dfm$maximize_transaction_rate;

