?? RIGHT := 110 ??
MODULE dfm$driver_test_utility;
{
{   This module contains subcommands for testing the file server.
{

?? PUSH (LISTEXT := ON) ??
*copyc amp$close
*copyc amp$fetch
*copyc amp$get_next
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$put_next
*copyc clp$convert_integer_to_string
*copyc clp$end_scan_command_file
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$pop_utility
*copyc clp$push_parameters
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc cmt$element_definition
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dft$rpc_buffer_header
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfp$fetch_qit
*copyc dfp$file_server_display
*copyc dfp$flush_served_family_table
*copyc dfp$log_side_door_port_status
*copyc dfp$verify_system_administrator
*copyc dfs$server_wired
*copyc dft$assign_queue_entry_status
*copyc dft$cpu_queue
*copyc dft$poll_header
*copyc dft$rpc_test_request_header
*copyc dft$queue_entry_type
*copyc dfv$server_wired_heap
*copyc fsp$close_file
*copyc fsp$open_file
*copyc jmp$convert_date_time_to_clock
*copyc osp$clear_locked_variable
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$fetch_locked_variable
*copyc osp$reset_heap
*copyc osp$set_status_abnormal
*copyc oss$job_paged_literal
*copyc osv$page_size
*copyc osv$task_private_heap
*copyc pmp$compute_date_time
*copyc pmp$convert_binary_unique_name
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pmp$get_compact_date_time
*copyc syp$increment_server_file_count
*copyc syp$decrement_server_file_count
?? POP ??



{ table file_server_commands type=command  sn=oss$job_paged_literal
{ command (activate_pp actpp) dfp$activate_pp_command xref
{ command (display_operator_display, disod) dfp$display_operator_display   ..
{       local
{ command (display_queue, disqe, disq) dfp$display_queue local
{ command (display_queue_header, disqh) dfp$display_queue_header local
{ command (display_server_state, disss) dfp$display_server_state local
{ command (display_transfer_rate, distr) dfp$display_transfer_rate local
{ command (end_client, endc) dfp$end_client xref
{ command (end_server, ends) dfp$end_server xref
{ command (execute_cdcnet_driver, execd) dfp$execute_cdcnet_driver cm=xref
{ command (flush_served_family_table, flusft) flush_family_table local
{ command (get_client_mainframe_file, getcmf)       ..
{   dfp$get_client_mainframe_file cm=xref
{ command (initiate_pp inipp) dfp$store_p_qit xref
{ command (initiate_test_driver, initd) dfp$initiate_test_driver xref
{ command (log_side_door_port_status, logsdps) log_side_door_port local
{ command (quit, qui) quit_command local
{ command (reset_transfer_rate, restr) dfp$reset_transfer_rate local
{ command (send_poll, senp) dfp$manage_server_connection xref
{ command (send_remote_command_line, senrcl) dfp$send_remote_command_line  ..
{        xref
{ command (send_remote_message, senrm) dfp$send_remote_message xref
{ command (send_test, sent) dfp$send_test_command xref
{ command (set_queue_location, setql) dfp$set_queue_location local
{ command (test_application_support, tesas) dfp$client_test_app_sup_r3 xref
{ command (test_remote_procedure_call, tesrpc)       ..
{   dfp$test_remote_procedure_call xref
{ command (terminate_client_job, tercj) dfp$terminate_client_job xref
{ command (verify_client_jobs, vercj) dfp$verify_client_jobs xref
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  file_server_commands: [STATIC, READ, oss$job_paged_literal]
      ^clt$command_table := ^file_server_commands_entries,

  file_server_commands_entries: [STATIC, READ, oss$job_paged_literal]
      array [1 .. 51] of clt$command_table_entry := [
  {} ['ACTIVATE_PP                    ', clc$nominal_entry,
        clc$normal_usage_entry, 1, clc$automatically_log, clc$linked_call,
        ^dfp$activate_pp_command],
  {} ['ACTPP                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 1, clc$automatically_log, clc$linked_call,
        ^dfp$activate_pp_command],
  {} ['DISOD                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 2, clc$automatically_log, clc$linked_call,
        ^dfp$display_operator_display],
  {} ['DISPLAY_OPERATOR_DISPLAY       ', clc$nominal_entry,
        clc$normal_usage_entry, 2, clc$automatically_log, clc$linked_call,
        ^dfp$display_operator_display],
  {} ['DISPLAY_QUEUE                  ', clc$nominal_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^dfp$display_queue],
  {} ['DISPLAY_QUEUE_HEADER           ', clc$nominal_entry,
        clc$normal_usage_entry, 4, clc$automatically_log, clc$linked_call,
        ^dfp$display_queue_header],
  {} ['DISPLAY_SERVER_STATE           ', clc$nominal_entry,
        clc$normal_usage_entry, 5, clc$automatically_log, clc$linked_call,
        ^dfp$display_server_state],
  {} ['DISPLAY_TRANSFER_RATE          ', clc$nominal_entry,
        clc$normal_usage_entry, 6, clc$automatically_log, clc$linked_call,
        ^dfp$display_transfer_rate],
  {} ['DISQ                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^dfp$display_queue],
  {} ['DISQE                          ', clc$alias_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^dfp$display_queue],
  {} ['DISQH                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 4, clc$automatically_log, clc$linked_call,
        ^dfp$display_queue_header],
  {} ['DISSS                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 5, clc$automatically_log, clc$linked_call,
        ^dfp$display_server_state],
  {} ['DISTR                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 6, clc$automatically_log, clc$linked_call,
        ^dfp$display_transfer_rate],
  {} ['ENDC                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 7, clc$automatically_log, clc$linked_call,
        ^dfp$end_client],
  {} ['ENDS                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 8, clc$automatically_log, clc$linked_call,
        ^dfp$end_server],
  {} ['END_CLIENT                     ', clc$nominal_entry,
        clc$normal_usage_entry, 7, clc$automatically_log, clc$linked_call,
        ^dfp$end_client],
  {} ['END_SERVER                     ', clc$nominal_entry,
        clc$normal_usage_entry, 8, clc$automatically_log, clc$linked_call,
        ^dfp$end_server],
  {} ['EXECD                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 9, clc$automatically_log, clc$linked_call,
        ^dfp$execute_cdcnet_driver],
  {} ['EXECUTE_CDCNET_DRIVER          ', clc$nominal_entry,
        clc$normal_usage_entry, 9, clc$automatically_log, clc$linked_call,
        ^dfp$execute_cdcnet_driver],
  {} ['FLUSFT                         ', clc$abbreviation_entry,
        clc$normal_usage_entry, 10, clc$automatically_log, clc$linked_call,
        ^flush_family_table],
  {} ['FLUSH_SERVED_FAMILY_TABLE      ', clc$nominal_entry,
        clc$normal_usage_entry, 10, clc$automatically_log, clc$linked_call,
        ^flush_family_table],
  {} ['GETCMF                         ', clc$abbreviation_entry,
        clc$normal_usage_entry, 11, clc$automatically_log, clc$linked_call,
        ^dfp$get_client_mainframe_file],
  {} ['GET_CLIENT_MAINFRAME_FILE      ', clc$nominal_entry,
        clc$normal_usage_entry, 11, clc$automatically_log, clc$linked_call,
        ^dfp$get_client_mainframe_file],
  {} ['INIPP                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 12, clc$automatically_log, clc$linked_call,
        ^dfp$store_p_qit],
  {} ['INITD                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 13, clc$automatically_log, clc$linked_call,
        ^dfp$initiate_test_driver],
  {} ['INITIATE_PP                    ', clc$nominal_entry,
        clc$normal_usage_entry, 12, clc$automatically_log, clc$linked_call,
        ^dfp$store_p_qit],
  {} ['INITIATE_TEST_DRIVER           ', clc$nominal_entry,
        clc$normal_usage_entry, 13, clc$automatically_log, clc$linked_call,
        ^dfp$initiate_test_driver],
  {} ['LOGSDPS                        ', clc$abbreviation_entry,
        clc$normal_usage_entry, 14, clc$automatically_log, clc$linked_call,
        ^log_side_door_port],
  {} ['LOG_SIDE_DOOR_PORT_STATUS      ', clc$nominal_entry,
        clc$normal_usage_entry, 14, clc$automatically_log, clc$linked_call,
        ^log_side_door_port],
  {} ['QUI                            ', clc$abbreviation_entry,
        clc$normal_usage_entry, 15, clc$automatically_log, clc$linked_call,
        ^quit_command],
  {} ['QUIT                           ', clc$nominal_entry,
        clc$normal_usage_entry, 15, clc$automatically_log, clc$linked_call,
        ^quit_command],
  {} ['RESET_TRANSFER_RATE            ', clc$nominal_entry,
        clc$normal_usage_entry, 16, clc$automatically_log, clc$linked_call,
        ^dfp$reset_transfer_rate],
  {} ['RESTR                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 16, clc$automatically_log, clc$linked_call,
        ^dfp$reset_transfer_rate],
  {} ['SEND_POLL                      ', clc$nominal_entry,
        clc$normal_usage_entry, 17, clc$automatically_log, clc$linked_call,
        ^dfp$manage_server_connection],
  {} ['SEND_REMOTE_COMMAND_LINE       ', clc$nominal_entry,
        clc$normal_usage_entry, 18, clc$automatically_log, clc$linked_call,
        ^dfp$send_remote_command_line],
  {} ['SEND_REMOTE_MESSAGE            ', clc$nominal_entry,
        clc$normal_usage_entry, 19, clc$automatically_log, clc$linked_call,
        ^dfp$send_remote_message],
  {} ['SEND_TEST                      ', clc$nominal_entry,
        clc$normal_usage_entry, 20, clc$automatically_log, clc$linked_call,
        ^dfp$send_test_command],
  {} ['SENP                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 17, clc$automatically_log, clc$linked_call,
        ^dfp$manage_server_connection],
  {} ['SENRCL                         ', clc$abbreviation_entry,
        clc$normal_usage_entry, 18, clc$automatically_log, clc$linked_call,
        ^dfp$send_remote_command_line],
  {} ['SENRM                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 19, clc$automatically_log, clc$linked_call,
        ^dfp$send_remote_message],
  {} ['SENT                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 20, clc$automatically_log, clc$linked_call,
        ^dfp$send_test_command],
  {} ['SETQL                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 21, clc$automatically_log, clc$linked_call,
        ^dfp$set_queue_location],
  {} ['SET_QUEUE_LOCATION             ', clc$nominal_entry,
        clc$normal_usage_entry, 21, clc$automatically_log, clc$linked_call,
        ^dfp$set_queue_location],
  {} ['TERCJ                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 24, clc$automatically_log, clc$linked_call,
        ^dfp$terminate_client_job],
  {} ['TERMINATE_CLIENT_JOB           ', clc$nominal_entry,
        clc$normal_usage_entry, 24, clc$automatically_log, clc$linked_call,
        ^dfp$terminate_client_job],
  {} ['TESAS                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 22, clc$automatically_log, clc$linked_call,
        ^dfp$client_test_app_sup_r3],
  {} ['TESRPC                         ', clc$abbreviation_entry,
        clc$normal_usage_entry, 23, clc$automatically_log, clc$linked_call,
        ^dfp$test_remote_procedure_call],
  {} ['TEST_APPLICATION_SUPPORT       ', clc$nominal_entry,
        clc$normal_usage_entry, 22, clc$automatically_log, clc$linked_call,
        ^dfp$client_test_app_sup_r3],
  {} ['TEST_REMOTE_PROCEDURE_CALL     ', clc$nominal_entry,
        clc$normal_usage_entry, 23, clc$automatically_log, clc$linked_call,
        ^dfp$test_remote_procedure_call],
  {} ['VERCJ                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 25, clc$automatically_log, clc$linked_call,
        ^dfp$verify_client_jobs],
  {} ['VERIFY_CLIENT_JOBS             ', clc$nominal_entry,
        clc$normal_usage_entry, 25, clc$automatically_log, clc$linked_call,
        ^dfp$verify_client_jobs]];

  PROCEDURE [XREF] dfp$activate_pp_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$client_test_app_sup_r3
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$end_client
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$end_server
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$execute_cdcnet_driver
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$get_client_mainframe_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$initiate_test_driver
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$manage_server_connection
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$send_remote_command_line
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$send_remote_message
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$send_test_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$store_p_qit
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$terminate_client_job
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$test_remote_procedure_call
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] dfp$verify_client_jobs
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? POP ??



*IF $variable(dfv$compile_mock_code,declared)<>'UNKNOWN'

  VAR
    osv$job_pageable_heap: [XDCL] ^ost$heap;

  VAR
    osv$task_shared_heap: [XDCL] ^ost$heap;

*ELSE
*copyc osv$job_pageable_heap
*copyc osv$task_shared_heap
*IFEND

  TYPE
    outline_string_type = record
      size: 0 .. max_page_width,
      value: string (max_page_width),
    recend,

    output_id = record
      outline: outline_string_type,
      output_file_name: amt$local_file_name,
      page_width: amt$page_width,
      output_open: boolean,
      output_file_fid: amt$file_identifier,
      case alternate_output_open: boolean of
      = TRUE =
        save_output_fid: amt$file_identifier,
        save_page_width: amt$page_width,
      casend,
    recend;



  VAR
    last_queue_entry_index: dft$queue_entry_index := 1,
    p_output_id: ^output_id := NIL,
    selected_queue_index: 1 .. dfc$max_number_of_queues := 1,
    selected_queue_interface_table: dft$p_queue_interface_table := NIL;

  CONST
    default_page_width = 79,
    min_page_width = 50,
    max_page_width = 90,
    utility_name = 'FILE_SERVER_TEST_UTILITY       ';

?? TITLE := '   dfp$driver_test_utility ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$driver_test_utility
    (    ppp: clt$parameter_list;
     VAR status: ost$status);

{ pdt test_utility_pdt (
{   listing, list, l : file =$OUTPUT
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      test_utility_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^test_utility_pdt_names, ^test_utility_pdt_params];

    VAR
      test_utility_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
            clt$parameter_name_descriptor := [['LISTING', 1], ['LIST', 1], ['L', 1], ['STATUS', 2]];

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

{ LISTING LIST L }
      [[clc$optional_with_default, ^test_utility_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$file_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
      test_utility_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??

?? NEWTITLE := '    abort_handler', EJECT ??

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

      clean_up;
      handler_status.normal := TRUE;

    PROCEND abort_handler;

?? TITLE := '       clean_up', EJECT ??

    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF recovery_inhibited THEN
        recovery_inhibited := FALSE;
*IF NOT $variable(dfv$compile_mock_code,declared)<>'UNKNOWN'
        syp$decrement_server_file_count;
*IFEND
        #SPOIL (recovery_inhibited);
      IFEND;

      IF p_output_id^.output_open THEN
        fsp$close_file (p_output_id^.output_file_fid, ignore_status);
        #SPOIL (p_output_id^.output_open);
        p_output_id^.output_open := FALSE;
        #SPOIL (p_output_id^.output_open);
      IFEND;

      IF p_output_id^.alternate_output_open THEN {base output fid saved in p_output_id^.save_output_fid
        fsp$close_file (p_output_id^.save_output_fid, ignore_status);
        #SPOIL (p_output_id^.output_open);
        p_output_id^.output_open := FALSE;
        #SPOIL (p_output_id^.output_open);
      IFEND;

    PROCEND clean_up;


    VAR
      command_file: amt$local_file_name,
      local_status: ost$status,
      recovery_inhibited: boolean,
      value: clt$value;

    PUSH p_output_id;
    dfp$verify_system_administrator ('DRIVER_TEST_UTILITY', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    status.normal := TRUE;
    last_queue_entry_index := 1;

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

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

    recovery_inhibited := FALSE;
    p_output_id^.output_open := FALSE;
    p_output_id^.alternate_output_open := FALSE;
    #SPOIL (recovery_inhibited, p_output_id^.output_open, p_output_id^.alternate_output_open);
    osp$establish_block_exit_hndlr (^abort_handler);

    open_output_file (p_output_id^.output_file_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    display (' Welcome to the file server ');

*IF $variable(dfv$compile_mock_code,declared)<>'UNKNOWN'
    create_heap ('DFV$SERVER_WIRED_HEAP          ', dfv$server_wired_heap, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    create_heap ('OSV$TASK_SHARED_HEAP           ', osv$task_shared_heap, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    create_heap ('OSV$JOB_PAGEABLE_HEAP          ', osv$job_pageable_heap, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
*ELSE
    syp$increment_server_file_count;
    #SPOIL (recovery_inhibited);
    recovery_inhibited := TRUE;
    #SPOIL (recovery_inhibited);
*IFEND

    clp$push_utility (utility_name, clc$global_command_search, file_server_commands, NIL, status);
    IF status.normal THEN
      command_file := '$COMMAND';
      clp$scan_command_file (command_file, utility_name, 'DFU', status);
      clp$pop_utility (local_status);
    IFEND;

    IF status.normal THEN
      fsp$close_file (p_output_id^.output_file_fid, status);
    ELSE
      fsp$close_file (p_output_id^.output_file_fid, local_status);
    IFEND;
  PROCEND dfp$driver_test_utility;
?? EJECT ??
  { Provide a short easy to type alias.

  PROCEDURE [XDCL, #GATE] dftu
    (    ppp: clt$parameter_list;
     VAR status: ost$status);

    dfp$driver_test_utility (ppp, status);
  PROCEND dftu;
?? EJECT ??

  PROCEDURE create_heap
    (    heap_file_name: amt$local_file_name;
     VAR heap_pointer: ^ost$heap;
     VAR status: ost$status);

    VAR
      file_identifier: amt$file_identifier,
      segment_pointer: amt$segment_pointer;

    amp$open (heap_file_name, amc$segment, NIL, file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$cell_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    heap_pointer := segment_pointer.cell_pointer;
    osp$reset_heap (heap_pointer, #SIZE (heap_pointer^), FALSE, 1);
  PROCEND create_heap;
?? EJECT ??

  PROCEDURE quit_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt quit_pdt ()

?? PUSH (LISTEXT := ON) ??

    VAR
      quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

    clp$scan_parameter_list (parameter_list, quit_pdt, status);

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_scan_command_file (utility_name, status);
  PROCEND quit_command;

?? TITLE := '  add_integer_to_line', EJECT ??

  PROCEDURE [INLINE] add_integer_to_line
    (    int: integer);

    VAR
      ignore_status: ost$status,
      int_string: ost$string;

    clp$convert_integer_to_string (int, 10, FALSE, int_string, ignore_status);
    add_to_line (int_string.value (1, int_string.size));

  PROCEND add_integer_to_line;

?? TITLE := '  add_hex_to_line', EJECT ??

  PROCEDURE [INLINE] add_hex_to_line
    (    int: integer;
         add_radix: boolean);

    VAR
      ignore_status: ost$status,
      int_string: ost$string;

    clp$convert_integer_to_string (int, 16, FALSE, int_string, ignore_status);
    add_to_line (int_string.value (1, int_string.size));
    IF add_radix THEN
      add_to_line ('(16)');
    IFEND;

  PROCEND add_hex_to_line;

?? TITLE := '  add_to_line', EJECT ??

  PROCEDURE add_to_line
    (    str: string ( * ));

    VAR
      size: 0 .. osc$max_string_size + 1;

    size := STRLENGTH (str);
    IF (p_output_id^.outline.size + size) <= p_output_id^.page_width THEN
      p_output_id^.outline.value (p_output_id^.outline.size + 1, size) := str;
      p_output_id^.outline.size := p_output_id^.outline.size + size;
      RETURN;
    IFEND;

    IF p_output_id^.outline.value (1) = '{' THEN
      flush_line;
      start_line ('  {');
      IF str = '  ' THEN
        RETURN;
      IFEND;
      p_output_id^.outline.value (p_output_id^.outline.size + 1, size) := str;
      p_output_id^.outline.size := p_output_id^.outline.size + size;
      RETURN;
    IFEND;

    flush_line;
    start_line ('      ');
    p_output_id^.outline.value (p_output_id^.outline.size + 1, size) := str;
    p_output_id^.outline.size := p_output_id^.outline.size + size;

  PROCEND add_to_line;

?? TITLE := '  end_line_with_boolean', EJECT ??

  PROCEDURE [INLINE] end_line_with_boolean
    (    bool: boolean);

    IF bool THEN
      add_to_line ('TRUE');
    ELSE
      add_to_line ('FALSE');
    IFEND;
    flush_line;

  PROCEND end_line_with_boolean;

?? TITLE := '  flush_line', EJECT ??

  PROCEDURE [INLINE] flush_line;

    IF p_output_id^.outline.size > 0 THEN
      put_line (p_output_id^.outline.value (1, p_output_id^.outline.size));
    IFEND;

  PROCEND flush_line;

?? TITLE := '  put_line', EJECT ??

  PROCEDURE put_line
    (    line: string ( * ));

    VAR
      status: ost$status,
      ignore_byte_address: amt$file_byte_address;

    amp$put_next (p_output_id^.output_file_fid, ^line, STRLENGTH (line), ignore_byte_address, status);
    IF NOT status.normal THEN
      {???????????????????
    IFEND;
    p_output_id^.outline.size := 0;
    p_output_id^.outline.value := '';

  PROCEND put_line;

?? TITLE := '  start_line', EJECT ??

  PROCEDURE [INLINE] start_line
    (    str: string ( * ));

    p_output_id^.outline.value := str;
    p_output_id^.outline.size := STRLENGTH (str);

  PROCEND start_line;

?? TITLE := '  open_output_file', EJECT ??

  PROCEDURE open_output_file
    (    file_name: amt$local_file_name;
     VAR status: ost$status);

    VAR
      file_attachment: array [1 .. 3] of fst$attachment_option,
      file_creation: array [1 .. 1] of fst$file_cycle_attribute,
      local_status: ost$status,
      output_file_attributes: array [1 .. 1] of amt$fetch_item;

    IF p_output_id^.output_open THEN {alternate output file
      p_output_id^.save_output_fid := p_output_id^.output_file_fid;
      p_output_id^.save_page_width := p_output_id^.page_width;
    IFEND;

    file_attachment [1].selector := fsc$access_and_share_modes;
    file_attachment [1].access_modes.selector := fsc$specific_access_modes;
    file_attachment [1].access_modes.value := $fst$file_access_options [fsc$append, fsc$shorten];
    file_attachment [1].share_modes.selector := fsc$specific_share_modes;
    file_attachment [1].share_modes.value := $fst$file_access_options [];
    file_attachment [2].selector := fsc$access_and_share_modes;
    file_attachment [2].access_modes.selector := fsc$specific_access_modes;
    file_attachment [2].access_modes.value := $fst$file_access_options [fsc$append];
    file_attachment [2].share_modes.selector := fsc$specific_share_modes;
    file_attachment [2].share_modes.value := $fst$file_access_options [];
    file_attachment [3].selector := fsc$open_share_modes;
    file_attachment [3].open_share_modes := -$fst$file_access_options [];

    file_creation [1].selector := fsc$ring_attributes;
    file_creation [1].ring_attributes.r1 := 11;
    file_creation [1].ring_attributes.r2 := 11;
    file_creation [1].ring_attributes.r3 := 11;

    fsp$open_file (file_name, amc$record, ^file_attachment, ^file_creation,
         NIL, NIL, NIL, p_output_id^.output_file_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF p_output_id^.output_open THEN
      #SPOIL (p_output_id^.alternate_output_open);
      p_output_id^.alternate_output_open := TRUE;
      #SPOIL (p_output_id^.alternate_output_open);
    ELSE
      #SPOIL (p_output_id^.output_open);
      p_output_id^.output_open := TRUE;
      #SPOIL (p_output_id^.output_open);
    IFEND;

    output_file_attributes [1].key := amc$page_width;
    amp$fetch (p_output_id^.output_file_fid, output_file_attributes, status);
    IF NOT status.normal THEN
      fsp$close_file (p_output_id^.output_file_fid, local_status);
      RETURN;
    IFEND;

    p_output_id^.page_width := default_page_width;
    IF (output_file_attributes [1].source <> amc$undefined_attribute) AND
          (output_file_attributes [1].source <> amc$access_method_default) THEN
      p_output_id^.page_width := output_file_attributes [1].page_width;
    ELSE
      p_output_id^.page_width := default_page_width;
    IFEND;

    IF p_output_id^.page_width < min_page_width THEN
      p_output_id^.page_width := min_page_width;
    ELSEIF p_output_id^.page_width > max_page_width THEN
      p_output_id^.page_width := max_page_width;
    IFEND;

  PROCEND open_output_file;

?? TITLE := '  dfp$set_queue_location', EJECT ??

  PROCEDURE dfp$set_queue_location
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{  pdt set_queue_location_pdt (
{   connection_type, ct: key stornet, cdcnet, mock = $required
{   element_name, en, driver_name, dn, send_channel_name, scn: name
{   queue_index, qi: integer 1 .. dfc$max_number_of_queues = $REQUIRED
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    set_queue_location_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
      ^set_queue_location_pdt_names, ^set_queue_location_pdt_params];

  VAR
    set_queue_location_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 11] of
      clt$parameter_name_descriptor := [['CONNECTION_TYPE', 1], ['CT', 1], ['ELEMENT_NAME', 2], ['EN', 2], [
      'DRIVER_NAME', 2], ['DN', 2], ['SEND_CHANNEL_NAME', 2], ['SCN', 2], ['QUEUE_INDEX', 3], ['QI', 3], [
      'STATUS', 4]];

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

{ CONNECTION_TYPE CT }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^set_queue_location_pdt_kv1, clc$keyword_value
      ]],

{ ELEMENT_NAME EN DRIVER_NAME DN SEND_CHANNEL_NAME SCN }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ QUEUE_INDEX QI }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1,
      dfc$max_number_of_queues]],

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

  VAR
    set_queue_location_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of ost$name := [
      'STORNET','CDCNET','MOCK'];

?? POP ??

    VAR
      l: integer,
      q_string: string (2),
      value: clt$value;

    clp$scan_parameter_list (parameter_list, set_queue_location_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CONNECTION_TYPE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('ELEMENT_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    dfp$fetch_qit (value.name.value, selected_queue_interface_table, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('QUEUE_INDEX', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF selected_queue_interface_table^.queue_directory.number_of_queues < value.int.value THEN
      STRINGREP (q_string, l, selected_queue_interface_table^.queue_directory.number_of_queues);
      osp$set_status_abnormal (dfc$file_server_id, dfe$queue_index_exceeded, q_string (1, l), status);
    ELSEIF selected_queue_interface_table^.queue_directory.driver_queue_pva_directory [value.int.value].
          p_driver_queue = NIL THEN
      STRINGREP (q_string, l, value.int.value);
      osp$set_status_abnormal (dfc$file_server_id, dfe$queue_index_invalid, q_string (1, l), status);
      RETURN;
    ELSE
      selected_queue_index := value.int.value;
    IFEND;

  PROCEND dfp$set_queue_location;
?? TITLE := ' [XDCL] dfp$get_test_queue_location ', EJECT ??

  PROCEDURE [XDCL] dfp$get_test_queue_location
    (VAR queue_interface_table: ^dft$queue_interface_table;
     VAR queue_index: dft$queue_index);

    queue_interface_table := selected_queue_interface_table;
    queue_index := selected_queue_index;
  PROCEND dfp$get_test_queue_location;


?? TITLE := '  dfp$reset_transfer_rate', EJECT ??

  PROCEDURE dfp$reset_transfer_rate
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  pdt reset_transfer_rate_pdt  (
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      reset_transfer_rate_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^reset_transfer_rate_pdt_names, ^reset_transfer_rate_pdt_params];

    VAR
      reset_transfer_rate_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
            clt$parameter_name_descriptor := [['STATUS', 1]];

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

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

?? POP ??

    VAR
      io_types: dft$monitor_io_types,
      p_transaction_data: ^dft$transaction_data,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, reset_transfer_rate_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF selected_queue_interface_table = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$must_execute_setql, 'RESET_TRANSFER_RATE', status);
      RETURN;
    IFEND;

    p_transaction_data := ^selected_queue_interface_table^.queue_directory.
          cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header.transaction_data;
    pmp$get_compact_date_time (p_transaction_data^.transaction_start_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    osp$clear_locked_variable (p_transaction_data^.total_transaction_count, 0);
    osp$clear_locked_variable (p_transaction_data^.total_buffer_length_sent, 0);
    osp$clear_locked_variable (p_transaction_data^.total_data_pages_sent, 0);
    osp$clear_locked_variable (p_transaction_data^.total_buffer_length_received, 0);
    osp$clear_locked_variable (p_transaction_data^.total_data_pages_received, 0);
    FOR io_types := dfc$monitor_io TO dfc$monitor_allocate DO
       osp$clear_locked_variable (
          selected_queue_interface_table^.queue_directory.
          cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header.
          monitor_io[io_types].number_of_requests, 0);
       osp$clear_locked_variable (
          selected_queue_interface_table^.queue_directory.
          cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header.
          monitor_io[io_types].total_request_time, 0);
       osp$clear_locked_variable (
          selected_queue_interface_table^.queue_directory.
          cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header.
          monitor_io[io_types].max_request_time, 0);
    FOREND;
    display ('  Transaction counters reset ');

  PROCEND dfp$reset_transfer_rate;

?? TITLE := '  dfp$display_operator_display ', EJECT ??

  PROCEDURE dfp$display_operator_display
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ pdt disp_operator_display (
{    output, o: file
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      disp_operator_display: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^disp_operator_display_names, ^disp_operator_display_params];

    VAR
      disp_operator_display_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

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

{ OUTPUT O }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

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

?? POP ??

    VAR
      file_name: amt$local_file_name,
      name: ost$name,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, disp_operator_display, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.kind <> clc$unknown_value THEN
      file_name := value.file.local_file_name;
    ELSE
      file_name := p_output_id^.output_file_name;
    IFEND;
    dfp$file_server_display (0, name, file_name, TRUE, status);

  PROCEND dfp$display_operator_display;

?? TITLE := '  dfp$display_server_state', EJECT ??

  PROCEDURE dfp$display_server_state
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  pdt disp_server_state_pdt (
{    output, o: file
{    status)

?? PUSH (LISTEXT := ON) ??

  VAR
    disp_server_state_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
      ^disp_server_state_pdt_names, ^disp_server_state_pdt_params];

  VAR
    disp_server_state_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

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

{ OUTPUT O }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

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

?? POP ??


    VAR
      alternate_output_name: amt$local_file_name,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, disp_server_state_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF selected_queue_interface_table = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$must_execute_setql, 'DISPLAY_SERVER_STATE', status);
      RETURN;
    IFEND;

    IF value.kind <> clc$unknown_value THEN
      alternate_output_name := value.file.local_file_name;
      IF alternate_output_name <> p_output_id^.output_file_name THEN
        open_output_file (alternate_output_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    p_cpu_queue_header := ^selected_queue_interface_table^.queue_directory.
          cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header;

    flush_line;
    start_line ('   Queue_Number:  ');
    add_integer_to_line (selected_queue_index);
    flush_line;
    start_line ('   Partner_Status:');
    flush_line;
    start_line ('       Terminate_Partner........');
    end_line_with_boolean (p_cpu_queue_header^.partner_status.terminate_partner);
    start_line ('       Users wait on terminated.');
    end_line_with_boolean (p_cpu_queue_header^.partner_status.terminate_partner);
    flush_line;

    start_line ('       Deactivate complete  ');
    end_line_with_boolean (p_cpu_queue_header^.partner_status.deactivate_complete);

    start_line ('       Server_State.............');
    CASE p_cpu_queue_header^.partner_status.server_state OF
    = dfc$active =
      add_to_line ('dfc$active');
      flush_line;
      start_line ('         Verify_Family.............');
      end_line_with_boolean (p_cpu_queue_header^.partner_status.verify_family);
      start_line ('         Send_Deactivate_Partner...');
      end_line_with_boolean (p_cpu_queue_header^.partner_status.send_deactivate_partner);
      start_line ('         Job_reconcilliation_completed ');
      end_line_with_boolean (p_cpu_queue_header^.partner_status.job_reconcilliation_completed);
    = dfc$inactive, dfc$terminated, dfc$awaiting_recovery =
      CASE p_cpu_queue_header^.partner_status.server_state OF
      = dfc$inactive =
        add_to_line ('dfc$inactive');
      = dfc$terminated =
        add_to_line ('dfc$terminated');
      = dfc$awaiting_recovery =
         add_to_line ('dfc$awaiting_recovery');
      ELSE
      CASEND;
      flush_line;
      start_line ('         Verify_Queue..............');
      end_line_with_boolean (p_cpu_queue_header^.partner_status.verify_queue);
      start_line ('         Server_pages_saved........');
      end_line_with_boolean (p_cpu_queue_header^.partner_status.server_pages_saved);
    = dfc$deactivated =
      add_to_line ('dfc$deactivated');
      flush_line;
    = dfc$recovering =
      add_to_line ('dfc$recovering');
      flush_line;
      start_line ('         Recovery complete ........');
      end_line_with_boolean (p_cpu_queue_header^.partner_status.recovery_complete);
    ELSE
      add_to_line ('UNKNOWN STATE');
      flush_line;
    CASEND;
    flush_line;
    start_line ('       Server_Lifetime..........');
    add_integer_to_line (p_cpu_queue_header^.server_lifetime);
    flush_line;
    start_line ('       Server_Birthdate.........');
    add_integer_to_line (p_cpu_queue_header^.server_birthdate);
    flush_line;

    IF p_output_id^.alternate_output_open THEN
      fsp$close_file (p_output_id^.output_file_fid, status);
      p_output_id^.output_file_fid := p_output_id^.save_output_fid;
      p_output_id^.page_width := p_output_id^.save_page_width;
      p_output_id^.alternate_output_open := FALSE;
    IFEND;

  PROCEND dfp$display_server_state;

?? TITLE := '  dfp$display_transfer_rate', EJECT ??

  PROCEDURE dfp$display_transfer_rate
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  pdt disp_transfer_rate_pdt (
{    output, o: file
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      disp_transfer_rate_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^disp_transfer_rate_pdt_names, ^disp_transfer_rate_pdt_params];

    VAR
      disp_transfer_rate_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

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

{ OUTPUT O }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

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

?? POP ??

    CONST
      mps = 1000000; {microseconds per second

    VAR
      alternate_output_name: amt$local_file_name,
      base_date_time: ost$date_time,
      base_micros: jmt$clock_time,
      current_date_time: ost$date_time,
      current_micros: jmt$clock_time,
      formatted_time: ost$time,
      increment: jmt$clock_time,
      p_transaction_data: ^dft$transaction_data,
      rate: integer,
      temp: integer,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, disp_transfer_rate_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF selected_queue_interface_table = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$must_execute_setql, 'DISPLAY_TRANSFER_RATE', status);
      RETURN;
    IFEND;

    IF value.kind <> clc$unknown_value THEN
      alternate_output_name := value.file.local_file_name;
      IF alternate_output_name <> p_output_id^.output_file_name THEN
        open_output_file (alternate_output_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    p_transaction_data := ^selected_queue_interface_table^.queue_directory.
          cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header.transaction_data;

    base_date_time := p_transaction_data^.transaction_start_time;

    pmp$get_compact_date_time (current_date_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$format_compact_time (base_date_time, osc$millisecond_time, formatted_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    start_line (' Initial time .......................');
    add_to_line (formatted_time.millisecond);
    flush_line;

    pmp$format_compact_time (current_date_time, osc$millisecond_time, formatted_time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    start_line (' Current time .......................');
    add_to_line (formatted_time.millisecond);
    flush_line;

    jmp$convert_date_time_to_clock (base_date_time, base_micros);

    jmp$convert_date_time_to_clock (current_date_time, current_micros);

    increment := current_micros - base_micros;

    start_line (' Elapsed time .......................');
    add_integer_to_line (increment);
    add_to_line (' Microseconds');
    flush_line;

    start_line (' Transaction count ..................');
    osp$fetch_locked_variable (p_transaction_data^.total_transaction_count, temp);
    add_integer_to_line (temp);
    add_to_line ('    Units per second = ');
    temp := temp * mps;
    rate := temp DIV increment;
    add_integer_to_line (rate);
    flush_line;

    start_line (' buffer_length_sent .................');
    osp$fetch_locked_variable (p_transaction_data^.total_buffer_length_sent, temp);
    add_integer_to_line (temp);
    add_to_line ('    Units per second = ');
    temp := temp * mps;
    rate := temp DIV increment;
    add_integer_to_line (rate);
    flush_line;

    start_line (' buffer_length_received .............');
    osp$fetch_locked_variable (p_transaction_data^.total_buffer_length_received, temp);
    add_integer_to_line (temp);
    add_to_line ('    Units per second = ');
    temp := temp * mps;
    rate := temp DIV increment;
    add_integer_to_line (rate);
    flush_line;

    start_line (' data_pages_sent ....................');
    osp$fetch_locked_variable (p_transaction_data^.total_data_pages_sent, temp);
    add_integer_to_line (temp);
    add_to_line ('    Units per second = ');
    temp := temp * mps;
    rate := temp DIV increment;
    add_integer_to_line (rate);
    flush_line;

    start_line (' data_pages_received ................');
    osp$fetch_locked_variable (p_transaction_data^.total_data_pages_received, temp);
    add_integer_to_line (temp);
    add_to_line ('    Units per second = ');
    temp := temp * mps;
    rate := temp DIV increment;
    add_integer_to_line (rate);
    flush_line;

    IF p_output_id^.alternate_output_open THEN
      fsp$close_file (p_output_id^.output_file_fid, status);
      p_output_id^.output_file_fid := p_output_id^.save_output_fid;
      p_output_id^.page_width := p_output_id^.save_page_width;
      #SPOIL (p_output_id^.alternate_output_open);
      p_output_id^.alternate_output_open := FALSE;
      #SPOIL (p_output_id^.alternate_output_open);
    IFEND;


  PROCEND dfp$display_transfer_rate;

?? TITLE := '  dfp$display_queue_header', EJECT ??

  PROCEDURE dfp$display_queue_header
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{   pdt disp_queue_header_pdt (
{      display_options, display_option, do: list of key request_buffer, ..
{          rb, stornet, directory, driver, cpu, all = all
{     output, o: file
{     status)

?? PUSH (LISTEXT := ON) ??

    VAR
      disp_queue_header_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^disp_queue_header_pdt_names, ^disp_queue_header_pdt_params];

    VAR
      disp_queue_header_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
            clt$parameter_name_descriptor := [['DISPLAY_OPTIONS', 1], ['DISPLAY_OPTION', 1], ['DO', 1],
            ['OUTPUT', 2], ['O', 2], ['STATUS', 3]];

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

{ DISPLAY_OPTIONS DISPLAY_OPTION DO }
      [[clc$optional_with_default, ^disp_queue_header_pdt_dv1], 1, clc$max_value_sets, 1, 1,
            clc$value_range_not_allowed, [^disp_queue_header_pdt_kv1, clc$keyword_value]],

{ OUTPUT O }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_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
      disp_queue_header_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
            ost$name := ['REQUEST_BUFFER', 'RB', 'STORNET', 'DIRECTORY', 'DRIVER', 'CPU', 'ALL'];

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

?? POP ??

    VAR
      alternate_output_name: amt$local_file_name,
      assignments: string (dfc$queue_assignment_strng_size),
      average: integer,
      formatted_date: ost$date,
      formatted_time: ost$time,
      header_line_displayed: boolean,
      i: 0 .. clc$max_value_sets,
      inquiry_request: boolean,
      j: integer,
      previous_processed: boolean,
      p_cpu_queue_header: ^dft$cpu_queue_header,
      p_driver_queue_header: ^dft$driver_queue_header,
      p_esm_base_addresses: ^dft$esm_base_addresses,
      p_queue_directory: ^dft$queue_directory,
      p_request_buffer_directory: ^dft$request_buffer_directory,
      p_request_buffer: ^dft$request_buffer,
      q_count: 0 .. dfc$queue_assignment_strng_size,
      q_index: 0 .. dfc$queue_assignment_strng_size,
      qei: 0 .. 0FF(16),
      qi: 0 .. 0FF(16),
      temp: integer,
      value_set_count: 0 .. clc$max_value_sets,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, disp_queue_header_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF selected_queue_interface_table = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$must_execute_setql, 'DISPLAY_QUEUE_HEADER', status);
      RETURN;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.kind <> clc$unknown_value THEN
      alternate_output_name := value.file.local_file_name;
      IF alternate_output_name <> p_output_id^.output_file_name THEN
        open_output_file (alternate_output_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;


    clp$get_set_count ('DISPLAY_OPTIONS', value_set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR i := 1 TO value_set_count DO
      clp$get_value ('DISPLAY_OPTIONS', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (value.name.value = 'REQUEST_BUFFER') OR (value.name.value = 'RB') OR
            ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN
        p_request_buffer_directory := ^selected_queue_interface_table^.request_buffer_directory;
        start_line (' Request Buffer Directory   ');
        add_pva_to_line (p_request_buffer_directory);
        flush_line;
        start_line ('   Inn ...................................');
        add_integer_to_line (p_request_buffer_directory^.inn);
        flush_line;
        start_line ('   Out ...................................');
        add_integer_to_line (p_request_buffer_directory^.out);
        flush_line;
        start_line ('   Limit .................................');
        add_integer_to_line (p_request_buffer_directory^.limit);
        flush_line;
        start_line ('   Request_buffer_rma ....................');
        add_hex_to_line (p_request_buffer_directory^.request_buffer_rma, TRUE);
        flush_line;
        header_line_displayed := FALSE;
        p_request_buffer := p_request_buffer_directory^.p_request_buffer;
        FOR j := 1 TO (p_request_buffer_directory^.limit DIV 8) DO
          inquiry_request := p_request_buffer^.request_buffer_entries [j].flags.inquiry;
          previous_processed := p_request_buffer^.request_buffer_entries [j].flags.previously_processed;
          qi := p_request_buffer^.request_buffer_entries [j].queue_index;
          qei := p_request_buffer^.request_buffer_entries [j].queue_entry_index;
          IF previous_processed OR (qi <> 0) OR (qei <> 0) THEN
            IF NOT header_line_displayed THEN
              header_line_displayed := TRUE;
              start_line ('     ENTRY   PREV P.   TYPE    Q.I.    Q.E.I.');
              flush_line;
            IFEND;
            start_line ('       ');
            add_integer_to_line ((j - 1) * 8);
            p_output_id^.outline.size := 14;
            IF previous_processed THEN
              add_to_line ('TRUE');
            ELSE
              add_to_line ('FALSE');
            IFEND;
            p_output_id^.outline.size := 24;
            IF inquiry_request THEN
              add_to_line ('INQM');
            ELSE
              add_to_line ('NORM');
            IFEND;
            p_output_id^.outline.size := 32;
            add_integer_to_line (qi);
            p_output_id^.outline.size := 40;
            add_integer_to_line (qei);
            flush_line;
          IFEND;
        FOREND;
      IFEND;

      IF (value.name.value = 'STORNET') OR ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN
        p_esm_base_addresses := ^selected_queue_interface_table^.esm_base_addresses;
        start_line (' ESM Base Addresses         ');
        add_pva_to_line (p_esm_base_addresses);
        flush_line;
        start_line ('   number_of_mainframes...................');
        add_integer_to_line (p_esm_base_addresses^.number_of_mainframes);
        flush_line;
        start_line ('   divisions_per_mainframe................');
        add_integer_to_line (p_esm_base_addresses^.divisions_per_mainframe);
        flush_line;
        start_line ('   esm_flag_base .........................');
        add_hex_to_line (p_esm_base_addresses^.esm_flag_base, TRUE);
        flush_line;
        start_line ('   esm_memory_base .......................');
        add_hex_to_line (p_esm_base_addresses^.esm_memory_base, TRUE);
        flush_line;
        start_line ('   esm_division_size .....................');
        add_hex_to_line (p_esm_base_addresses^.esm_division_size, TRUE);
        flush_line;
        start_line ('   esm_divsiz_12bit_cw ...................');
        add_hex_to_line (p_esm_base_addresses^.esm_divsiz_12bit_cw, TRUE);
        flush_line;
        start_line ('   esm_divsiz_16bit_cw ...................');
        add_hex_to_line (p_esm_base_addresses^.esm_divsiz_16bit_cw, TRUE);
        flush_line;
      IFEND;
      IF (value.name.value = 'DIRECTORY') OR ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN
        start_line (' Maximum Data Bytes ......................');
        add_integer_to_line (selected_queue_interface_table^.maximum_data_bytes);
        flush_line;

        p_queue_directory := ^selected_queue_interface_table^.queue_directory;
        start_line (' Queue Directory   ');
        add_pva_to_line (p_queue_directory);
        flush_line;
        start_line ('   Use DMA Adaptor On Send Channel .......');
        IF p_queue_directory^.dma_adapter.use_on_send_channel THEN
          add_to_line ('TRUE');
        ELSE
          add_to_line ('FALSE');
        IFEND;
        flush_line;
        start_line ('   Use DMA Adaptor On Receive Channel ....');
        IF p_queue_directory^.dma_adapter.use_on_recv_channel THEN
          add_to_line ('TRUE');
        ELSE
          add_to_line ('FALSE');
        IFEND;
        flush_line;
        start_line ('   Machine IOU is I0 model (CY930) .......');
        IF p_queue_directory^.dma_adapter.iou_i0_model THEN
          add_to_line ('TRUE');
        ELSE
          add_to_line ('FALSE');
        IFEND;
        flush_line;
        start_line ('   Send PP Number ........................');
        add_integer_to_line (p_queue_directory^.send_pp_number);
        flush_line;
        start_line ('   Receive PP Number .....................');
        add_integer_to_line (p_queue_directory^.receive_pp_number);
        flush_line;
        start_line ('   Source ID Number ......................');
        add_integer_to_line (p_queue_directory^.source_id_number);
        flush_line;
        start_line ('   Number of Queues ......................');
        add_integer_to_line (p_queue_directory^.number_of_queues);
        flush_line;
        {?????!! directory addresses ????
      IFEND;
      IF (value.name.value = 'DRIVER') OR ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN
        p_driver_queue_header := ^selected_queue_interface_table^.queue_directory.
              driver_queue_pva_directory [selected_queue_index].p_driver_queue^.queue_header;
        start_line (' Driver Queue ');
        add_integer_to_line (selected_queue_index);
        add_to_line ('  HEADER  ');
        add_pva_to_line (p_driver_queue_header);
        flush_line;
        start_line ('   flags.idle ............................');
        IF p_driver_queue_header^.flags.idle THEN
          add_to_line ('TRUE');
        ELSE
          add_to_line ('FALSE');
        IFEND;
        flush_line;
        {????!! interrupt ???
        start_line ('   Number of Queue Entries ...............');
        add_integer_to_line (p_driver_queue_header^.number_of_queue_entries);
        flush_line;
        start_line ('   Connection Descriptor');
        flush_line;
        start_line ('     Source');
        flush_line;
        start_line ('       flags.server_to_client ............');
        IF p_driver_queue_header^.connection_descriptor.source.flags.server_to_client THEN
          add_to_line ('TRUE');
        ELSE
          add_to_line ('FALSE');
        IFEND;
        flush_line;
        start_line ('       id_number .........................');
        add_integer_to_line (p_driver_queue_header^.connection_descriptor.source.id_number);
        flush_line;
        start_line ('       queue_index .......................');
        add_integer_to_line (p_driver_queue_header^.connection_descriptor.source.queue_index);
        flush_line;
        start_line ('       queue_entry_index .................');
        add_integer_to_line (p_driver_queue_header^.connection_descriptor.source.queue_entry_index);
        flush_line;
        start_line ('     Destination');
        flush_line;
        start_line ('       flags.server_to_client ............');
        IF p_driver_queue_header^.connection_descriptor.destination.flags.server_to_client THEN
          add_to_line ('TRUE');
        ELSE
          add_to_line ('FALSE');
        IFEND;
        flush_line;
        start_line ('       id_number .........................');
        add_integer_to_line (p_driver_queue_header^.connection_descriptor.destination.id_number);
        flush_line;
        start_line ('       queue_index .......................');
        add_integer_to_line (p_driver_queue_header^.connection_descriptor.destination.queue_index);
        flush_line;
        start_line ('       queue_entry_index .................');
        add_integer_to_line (p_driver_queue_header^.connection_descriptor.destination.queue_entry_index);
        flush_line;
      IFEND;
      IF (value.name.value = 'CPU') OR ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN
        p_cpu_queue_header := ^selected_queue_interface_table^.queue_directory.
              cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_header;
        start_line (' CPU Queue ');
        add_integer_to_line (selected_queue_index);
        add_to_line ('  HEADER  ');
        add_pva_to_line (p_cpu_queue_header);
        flush_line;
        start_line ('   Number of Monitor Queue Entries .......');
        add_integer_to_line (p_cpu_queue_header^.number_of_monitor_queue_entries);
        flush_line;
        start_line ('   Number of Task Queue Entries ..........');
        add_integer_to_line (p_cpu_queue_header^.number_of_task_queue_entries);
        flush_line;
        put_line ('   Queue_entry_assignment_table:');
        assignments := p_cpu_queue_header^.queue_entry_assignment_table;
{       Provide for 1st entry being assigned to Poll Task.
        q_count := 1 + p_cpu_queue_header^.number_of_monitor_queue_entries +
              p_cpu_queue_header^.number_of_task_queue_entries;
        FOR q_index := 1 TO q_count DO
          IF assignments (q_index) = ' ' THEN
            assignments (q_index) := 'x';
          IFEND;
        FOREND;
        start_line ('     Poll Task: ');
        add_to_line (assignments (1, 1));
        start_line ('     Monitor: ');
        q_index := p_cpu_queue_header^.number_of_monitor_queue_entries;
        q_count := q_index;
        IF q_count > 50 THEN
          q_count := 50;
        IFEND;
        add_to_line (assignments (2, q_count));
        IF q_index > 50 THEN
          add_to_line (' ..');
        IFEND;
        flush_line;
        start_line ('     Task: ');
        q_count := p_cpu_queue_header^.number_of_task_queue_entries;
        IF q_count > 50 THEN
          q_count := 50;
        IFEND;
{       Provide 1 entry for Poll Task.
        add_to_line (assignments (q_index + 1 + 1, q_count));
        IF p_cpu_queue_header^.number_of_task_queue_entries > 50 THEN
          add_to_line (' ..');
        IFEND;
        flush_line;
        start_line ('   Connection Type .......................');
        CASE p_cpu_queue_header^.connection_type OF
        = dfc$esm_connection =
          add_to_line ('STORNET');
        = dfc$cdcnet_connection =
          add_to_line ('CDCNET');
        = dfc$mock_connection =
          add_to_line ('MOCK');
        ELSE
        CASEND;
        flush_line;
        start_line ('   Destination Mainframe ID Model Number .');
        add_integer_to_line (p_cpu_queue_header^.destination_mainframe_id.model_number);
        flush_line;
        start_line ('   Destination Mainframe ID Serial Number.');
        add_integer_to_line (p_cpu_queue_header^.destination_mainframe_id.serial_number);
        flush_line;
        start_line ('   Destination Mainframe Name ........... ');
        add_to_line (p_cpu_queue_header^.destination_mainframe_name);
        flush_line;
        start_line ('   Leveler Status........................ ');
        CASE p_cpu_queue_header^.leveler_status.leveler_state OF
        = jmc$jl_leveler_enabled =
          add_to_line ('ENABLED');
        = jmc$jl_leveler_disabled =
          add_to_line ('DISABLED');
        = jmc$jl_server_profile_mismatch =
          add_to_line ('PROFILE MISMATCH');
        ELSE
          add_to_line ('UNKNOWN');
        CASEND;
        flush_line;
        start_line ('   Server Lifetime....................... ');
        add_integer_to_line (p_cpu_queue_header^.server_lifetime);
        flush_line;
        start_line ('   Server Birthdate...................... ');
        add_integer_to_line (p_cpu_queue_header^.server_birthdate);
        flush_line;
        start_line ('   Timeout Interval...................... ');
        add_integer_to_line (p_cpu_queue_header^.timeout_interval);
        flush_line;
        start_line ('   Max Request Timout Count.............. ');
        add_integer_to_line (p_cpu_queue_header^.maximum_request_timeout_count);
        flush_line;
        start_line ('   Max Retransmission Count.............. ');
        add_integer_to_line (p_cpu_queue_header^.maximum_retransmission_count);
        flush_line;
        start_line ('   Number of last monitor IO requests ...... ');
        add_integer_to_line (p_cpu_queue_header^.monitor_io [dfc$monitor_io].number_of_requests);
        flush_line;
        start_line ('   Max last monitor IO request time ........ ');
        add_integer_to_line (p_cpu_queue_header^.monitor_io [dfc$monitor_io].max_request_time);
        flush_line;
        start_line ('   Total last monitor IO request time ...... ');
        add_integer_to_line (p_cpu_queue_header^.monitor_io [dfc$monitor_io].total_request_time);
        flush_line;
        IF p_cpu_queue_header^.monitor_io [dfc$monitor_io].number_of_requests > 0 THEN
          average := p_cpu_queue_header^.monitor_io [dfc$monitor_io].total_request_time DIV
                p_cpu_queue_header^.monitor_io [dfc$monitor_io].number_of_requests;
          start_line ('       Average = .... ');
          add_integer_to_line (average);
          flush_line;
        IFEND;
        start_line ('   Number of monitor allocate requests ..... ');
        add_integer_to_line (p_cpu_queue_header^.monitor_io [dfc$monitor_allocate].number_of_requests);
        flush_line;
        start_line ('   Max monitor allocate request time ....... ');
        add_integer_to_line (p_cpu_queue_header^.monitor_io [dfc$monitor_allocate].max_request_time);
        flush_line;
        start_line ('   Total monitor allocate request time ..... ');
        add_integer_to_line (p_cpu_queue_header^.monitor_io [dfc$monitor_allocate].total_request_time);
        flush_line;
        IF p_cpu_queue_header^.monitor_io [dfc$monitor_allocate].number_of_requests > 0 THEN
          average := p_cpu_queue_header^.monitor_io [dfc$monitor_allocate].total_request_time DIV
                p_cpu_queue_header^.monitor_io [dfc$monitor_allocate].number_of_requests;
          start_line ('       Average = .... ');
          add_integer_to_line (average);
          flush_line;
        IFEND;
        start_line ('   Transaction Data');
        flush_line;
        start_line ('     transaction_start_time ..............');
        pmp$format_compact_date (p_cpu_queue_header^.transaction_data.transaction_start_time, osc$iso_date,
              formatted_date, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        add_to_line (formatted_date.iso);
        add_to_line ('  ');
        pmp$format_compact_time (p_cpu_queue_header^.transaction_data.transaction_start_time,
              osc$millisecond_time, formatted_time, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        add_to_line (formatted_time.hms);
        flush_line;
        start_line ('     total_transaction_count .............');
        osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_transaction_count, temp);
        add_integer_to_line (temp);
        flush_line;
        start_line ('     total_buffer_length_sent ............');
        osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_buffer_length_sent, temp);
        add_integer_to_line (temp);
        flush_line;
        start_line ('     total_data_pages_sent ...............');
        osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_data_pages_sent, temp);
        add_integer_to_line (temp);
        flush_line;
        start_line ('     total_buffer_length_received ........');
        osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_buffer_length_received, temp);
        add_integer_to_line (temp);
        flush_line;
        start_line ('     total_data_pages_received ...........');
        osp$fetch_locked_variable (p_cpu_queue_header^.transaction_data.total_data_pages_received, temp);
        add_integer_to_line (temp);
        flush_line;
        start_line ('   p_allocated_data_rma_list............. ');
        add_pva_to_line (p_cpu_queue_header^.p_allocated_data_rma_list);
        flush_line;
      IFEND;
    FOREND;

    IF p_output_id^.alternate_output_open THEN
      fsp$close_file (p_output_id^.output_file_fid, status);
      p_output_id^.output_file_fid := p_output_id^.save_output_fid;
      p_output_id^.page_width := p_output_id^.save_page_width;
      #SPOIL (p_output_id^.alternate_output_open);
      p_output_id^.alternate_output_open := FALSE;
      #SPOIL (p_output_id^.alternate_output_open);
    IFEND;

  PROCEND dfp$display_queue_header;
?? EJECT ??
  PROCEDURE add_pva_to_line
    (    address: ^cell);

    add_to_line (' PVA=');
    add_hex_to_line (#RING (address), FALSE);
    add_to_line ('  ');
    add_hex_to_line (#SEGMENT (address), FALSE);
    add_to_line ('  ');
    add_hex_to_line (#OFFSET (address), TRUE);
  PROCEND add_pva_to_line;
?? TITLE := '  dfp$display_queue', EJECT ??

  PROCEDURE dfp$display_queue
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt display_queue_pdt (
{    queue_entry_index, qei: integer 1 .. 127 or key all, last = last
{    display_options, display_option, do: list of key driver, cpu, buffer, ..
{       all = all
{    output, o : file
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_queue_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^display_queue_pdt_names, ^display_queue_pdt_params];

    VAR
      display_queue_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
            clt$parameter_name_descriptor := [['QUEUE_ENTRY_INDEX', 1], ['QEI', 1], ['DISPLAY_OPTIONS', 2],
            ['DISPLAY_OPTION', 2], ['DO', 2], ['OUTPUT', 3], ['O', 3], ['STATUS', 4]];

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

{ QUEUE_ENTRY_INDEX QEI }
      [[clc$optional_with_default, ^display_queue_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^display_queue_pdt_kv1, clc$integer_value, 1, 127]],

{ DISPLAY_OPTIONS DISPLAY_OPTION DO }
      [[clc$optional_with_default, ^display_queue_pdt_dv2], 1, clc$max_value_sets, 1, 1,
            clc$value_range_not_allowed, [^display_queue_pdt_kv2, clc$keyword_value]],

{ OUTPUT O }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_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
      display_queue_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of ost$name := ['ALL',
            'LAST'];

    VAR
      display_queue_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
            ost$name := ['DRIVER', 'CPU', 'BUFFER', 'ALL'];

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

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

?? POP ??

    VAR
      actual_length: 0 .. 0FFFF(16),
      alternate_output_name: amt$local_file_name,
      current_last: dft$queue_entry_index,
      first: dft$queue_entry_index,
      gfn: ost$name,
      index: integer,
      l: integer,
      last: dft$queue_entry_index,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_driver_queue_header: ^dft$driver_queue_header,
      p_mtr_status: ^syt$monitor_status,
      p_os_status: ^ost$status,
      p_poll_header: ^dft$poll_header,
      p_receive_buffer: dft$p_command_buffer,
      p_receive_buffer_header: ^dft$buffer_header,
      p_rpc_buffer_header: ^dft$rpc_buffer_header,
      p_rpc_response_buffer_header: ^dft$rpc_response_buffer_header,
      p_rpc_test_header: ^dft$rpc_test_request_header,
      p_send_buffer: dft$p_command_buffer,
      p_send_buffer_header: ^dft$buffer_header,
      q_string: string (4),
      queue_entry_index: dft$queue_entry_index,
      value_set_count: 0 .. clc$max_value_sets,
      value_set_index: 0 .. clc$max_value_sets,
      value: clt$value;

    clp$scan_parameter_list (parameter_list, display_queue_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF selected_queue_interface_table = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$must_execute_setql, 'DISPLAY_QUEUE', status);
      RETURN;
    IFEND;

    clp$get_value ('QUEUE_ENTRY_INDEX', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    current_last := selected_queue_interface_table^.queue_directory.
          driver_queue_pva_directory [selected_queue_index].p_driver_queue^.queue_header.
          number_of_queue_entries;
    IF value.kind = clc$integer_value THEN
      IF current_last < value.int.value THEN
        STRINGREP (q_string, l, current_last);
        osp$set_status_abnormal (dfc$file_server_id, dfe$queue_entry_index_exceeded, q_string (1, l), status);
        RETURN;
      IFEND;
      first := value.int.value;
      current_last := first;
    ELSEIF value.name.value = 'LAST' THEN
      first := last_queue_entry_index;
      current_last := first;
    ELSE
      first := 1;
    IFEND;

    clp$get_set_count ('DISPLAY_OPTIONS', value_set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.kind <> clc$unknown_value THEN
      alternate_output_name := value.file.local_file_name;
      IF alternate_output_name <> p_output_id^.output_file_name THEN
        open_output_file (alternate_output_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    FOR value_set_index := 1 TO value_set_count DO

      clp$get_value ('DISPLAY_OPTIONS', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value = 'DRIVER') OR ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN

        FOR queue_entry_index := first TO current_last DO
          p_driver_queue_entry := ^selected_queue_interface_table^.queue_directory.
                driver_queue_pva_directory [selected_queue_index].
                p_driver_queue^.queue_entries [queue_entry_index];
          start_line (' Driver Queue ');
          add_integer_to_line (selected_queue_index);
          add_to_line (',   Entry Index=');
          add_integer_to_line (queue_entry_index);
          add_pva_to_line (p_driver_queue_entry);
          flush_line;
          display_flags (p_driver_queue_entry^.flags);
          start_line ('   error_condition ......... ');
          add_integer_to_line (p_driver_queue_entry^.error_condition);
          flush_line;
          start_line ('   held_over_cm_word_count . ');
          add_integer_to_line (p_driver_queue_entry^.held_over_cm_word_count);
          flush_line;
          start_line ('   held_over_esm_div_numb .. ');
          add_integer_to_line (p_driver_queue_entry^.held_over_esm_division_number);
          flush_line;

          start_line ('   send_buffer_descriptor    ');
          flush_line;
          start_line ('     indirect_address ...... ');
          end_line_with_boolean (p_driver_queue_entry^.send_buffer_descriptor.indirect_address);
          start_line ('     actual_length ......... ');
          add_integer_to_line (p_driver_queue_entry^.send_buffer_descriptor.actual_length);
          flush_line;
          start_line ('     address ............... ');
          add_hex_to_line (p_driver_queue_entry^.send_buffer_descriptor.address, TRUE);
          flush_line;

          start_line ('   receive_buffer_descriptor    ');
          flush_line;
          start_line ('     indirect_address ...... ');
          end_line_with_boolean (p_driver_queue_entry^.receive_buffer_descriptor.indirect_address);
          start_line ('     actual_length ......... ');
          add_integer_to_line (p_driver_queue_entry^.receive_buffer_descriptor.actual_length);
          flush_line;
          start_line ('     address ............... ');
          add_hex_to_line (p_driver_queue_entry^.receive_buffer_descriptor.address, TRUE);
          flush_line;

          start_line ('   data_descriptor    ');
          flush_line;
          start_line ('     indirect_address ...... ');
          end_line_with_boolean (p_driver_queue_entry^.data_descriptor.indirect_address);
          start_line ('     actual_length ......... ');
          actual_length := p_driver_queue_entry^.data_descriptor.actual_length;
          add_integer_to_line (actual_length);
          flush_line;
          start_line ('     address ............... ');
          add_hex_to_line (p_driver_queue_entry^.data_descriptor.address, TRUE);
          flush_line;
          IF actual_length > (selected_queue_interface_table^.maximum_data_bytes DIV osv$page_size) * 8 THEN
            start_line ('     NOTE ACTUAL_LENGTH GREATER THAN ALLOCATED LENGTH.');
            flush_line;
            actual_length := (selected_queue_interface_table^.maximum_data_bytes DIV osv$page_size) * 8;
          IFEND;
          FOR index := 1 TO (actual_length DIV 8) DO
            start_line ('        rma(');
            add_integer_to_line (index);
            add_to_line (') ..... ');
            p_cpu_queue_entry := ^selected_queue_interface_table^.queue_directory.
                  cpu_queue_pva_directory [selected_queue_index].
                  p_cpu_queue^.queue_entries [queue_entry_index];
            add_hex_to_line (p_cpu_queue_entry^.p_data_rma_list^ [index].rma, TRUE);
            flush_line;
          FOREND;
        FOREND;
      IFEND;
      IF (value.name.value = 'CPU') OR ((value.name.value = 'ALL') AND (value_set_count = 1)) THEN

        FOR queue_entry_index := first TO current_last DO
          p_cpu_queue_entry := ^selected_queue_interface_table^.queue_directory.
                cpu_queue_pva_directory [selected_queue_index].p_cpu_queue^.queue_entries [queue_entry_index];
          start_line (' CPU Queue ');
          add_integer_to_line (selected_queue_index);
          add_to_line (',   Entry Index=');
          add_integer_to_line (queue_entry_index);
          add_pva_to_line (p_cpu_queue_entry);
          flush_line;

          start_line ('   transaction_count .......... ');
          add_integer_to_line (p_cpu_queue_entry^.transaction_count);
          flush_line;

          display_transaction_state (p_cpu_queue_entry^.transaction_state);

          start_line ('   request_timeout_count ...... ');
          add_integer_to_line (p_cpu_queue_entry^.request_timeout_count);
          flush_line;

          start_line ('   retransmission_count ....... ');
          add_integer_to_line (p_cpu_queue_entry^.retransmission_count);
          flush_line;

          start_line ('   global_task_id ............. ');
          add_integer_to_line (p_cpu_queue_entry^.global_task_id.index);
          add_to_line (', ');
          add_integer_to_line (p_cpu_queue_entry^.global_task_id.seqno);
          flush_line;
          p_send_buffer := p_cpu_queue_entry^.p_send_buffer;
          start_line ('   p_send_buffer .............. ');
          add_pva_to_line (p_send_buffer);
          flush_line;

          RESET p_send_buffer;
          NEXT p_send_buffer_header IN p_send_buffer;
          p_receive_buffer := p_cpu_queue_entry^.p_receive_buffer;
          RESET p_receive_buffer;
          NEXT p_receive_buffer_header IN p_receive_buffer;

          start_line ('     version ............... ');
          add_to_line (p_send_buffer_header^.version);
          flush_line;
          start_line ('     transaction_count ..... ');
          add_integer_to_line (p_send_buffer_header^.transaction_count);
          flush_line;
          start_line ('     retransmission_count .. ');
          add_integer_to_line (p_send_buffer_header^.retransmission_count);
          flush_line;
          start_line ('     remote_processor ...... ');
          add_integer_to_line ($INTEGER (p_send_buffer_header^.remote_processor));
          flush_line;
          start_line ('     buffer_length_sent .... ');
          add_integer_to_line (p_send_buffer_header^.buffer_length_sent);
          flush_line;
          start_line ('     data_length_sent ...... ');
          add_integer_to_line (p_send_buffer_header^.data_length_sent);
          flush_line;
          IF (p_send_buffer_header^.version = dfc$poll_task_version) THEN
            NEXT p_poll_header IN p_send_buffer;
            start_line ('     poll_mainframe......... ');
            add_to_line (p_poll_header^.mainframe_name);
            flush_line;
            display_poll_type (p_poll_header^.poll_type);
          ELSEIF (p_send_buffer_header^.version = dfc$rpc_request_buffer_version) THEN
            NEXT p_rpc_buffer_header IN p_send_buffer;
            display_rpc_buffer_header (p_rpc_buffer_header^);
            IF (p_send_buffer_header^.remote_processor = dfc$rpc_restartable_test) OR
                  (p_send_buffer_header^.remote_processor = dfc$rpc_unrestartable_test) THEN
              NEXT p_rpc_test_header IN p_send_buffer;
              display_rpc_test_header (p_rpc_test_header^);
            IFEND;
          ELSEIF (p_send_buffer_header^.version = dfc$status_buffer_version) THEN
            { On server side
            NEXT p_mtr_status IN p_send_buffer;
            IF p_mtr_status^.normal THEN
              add_to_line ('        ......Normal status');
              flush_line;
            ELSE
              NEXT p_os_status IN p_send_buffer;
              display_status (p_os_status^);
            IFEND;
            IF p_receive_buffer_header^.version = dfc$rpc_request_buffer_version THEN
              NEXT p_rpc_response_buffer_header IN p_send_buffer;
              display_rpc_response_header (p_rpc_response_buffer_header^);
              IF (p_send_buffer_header^.remote_processor = dfc$rpc_restartable_test) OR
                    (p_send_buffer_header^.remote_processor = dfc$rpc_unrestartable_test) THEN
                NEXT p_rpc_test_header IN p_send_buffer;
                display_rpc_test_header (p_rpc_test_header^);
              IFEND;
            IFEND;
          IFEND;

          start_line ('   p_receive_buffer ........... ');
          add_pva_to_line (p_receive_buffer);
          flush_line;
          start_line ('     version ............... ');
          add_to_line (p_receive_buffer_header^.version);
          flush_line;
          start_line ('     transaction_count ..... ');
          add_integer_to_line (p_receive_buffer_header^.transaction_count);
          flush_line;
          start_line ('     retransmission_count .. ');
          add_integer_to_line (p_receive_buffer_header^.retransmission_count);
          flush_line;
          start_line ('     remote_processor ...... ');
          add_integer_to_line ($INTEGER (p_receive_buffer_header^.remote_processor));
          flush_line;
          start_line ('     buffer_length_sent .... ');
          add_integer_to_line (p_receive_buffer_header^.buffer_length_sent);
          flush_line;
          start_line ('     data_length_sent ...... ');
          add_integer_to_line (p_receive_buffer_header^.data_length_sent);
          flush_line;

          IF (p_receive_buffer_header^.version = dfc$poll_task_version) THEN
            NEXT p_poll_header IN p_receive_buffer;
            start_line ('     rec_poll_mainframe..... ');
            add_to_line (p_poll_header^.mainframe_name);
            flush_line;
            start_line ('     rec_poll_type.......... ');
            display_poll_type (p_poll_header^.poll_type);
            flush_line;
          ELSEIF (p_receive_buffer_header^.version = 'STATUS') THEN
            NEXT p_mtr_status IN p_receive_buffer;
            IF p_mtr_status^.normal THEN
              add_to_line ('    ..    Normal status');
              flush_line;
            ELSE
              NEXT p_os_status IN p_receive_buffer;
              display_status (p_os_status^);
            IFEND;
            IF p_send_buffer_header^.version = dfc$rpc_request_buffer_version THEN
              NEXT p_rpc_response_buffer_header IN p_receive_buffer;
              display_rpc_response_header (p_rpc_response_buffer_header^);
              IF (p_receive_buffer_header^.remote_processor = dfc$rpc_restartable_test) OR
                    (p_receive_buffer_header^.remote_processor = dfc$rpc_unrestartable_test) THEN
                NEXT p_rpc_test_header IN p_receive_buffer;
                display_rpc_test_header (p_rpc_test_header^);
              IFEND;
            IFEND;
          ELSEIF (p_receive_buffer_header^.version = dfc$rpc_request_buffer_version) THEN
            NEXT p_rpc_buffer_header IN p_receive_buffer;
            display_rpc_buffer_header (p_rpc_buffer_header^);
            IF (p_receive_buffer_header^.remote_processor = dfc$rpc_restartable_test) OR
                  (p_receive_buffer_header^.remote_processor = dfc$rpc_unrestartable_test) THEN
              NEXT p_rpc_test_header IN p_receive_buffer;
              display_rpc_test_header (p_rpc_test_header^);
            IFEND;
          IFEND;

          flush_line;
          start_line ('   p_data_rma_list ............ ');
          add_pva_to_line (p_cpu_queue_entry^.p_data_rma_list);
          flush_line;

          start_line ('   data_pages_locked .........  ');
          end_line_with_boolean (p_cpu_queue_entry^.data_pages_locked);

          start_line ('   processor_type ............. ');
          IF queue_entry_index = 1 THEN
            add_to_line ('POLL');
            flush_line;
          ELSEIF p_cpu_queue_entry^.processor_type = dfc$task_services THEN
            add_to_line (' TASK ');
            flush_line;
            put_pva_line ('      p_send_data ..........', p_cpu_queue_entry^.p_send_data);
            put_pva_line ('      p_receive_data........', p_cpu_queue_entry^.p_receive_data);
            put_integer_line ('    total data to receive...... ', p_cpu_queue_entry^.total_data_to_receive);
            display_call_progress (p_cpu_queue_entry^.call_progress);
            IF p_cpu_queue_entry^.server_to_client THEN
              IF p_cpu_queue_entry^.remote_procedure_called THEN
                start_line ('     remote_procedure_called = TRUE ');
              ELSE
                start_line ('     remote_procedure_called = FALSE ');
              IFEND;
              flush_line;
              put_pva_line ('      p_last_wired_data.....', p_cpu_queue_entry^.p_last_wired_data);
              put_integer_line ('      last_wired_length.....', p_cpu_queue_entry^.last_wired_length);
            ELSE
              put_line ('     Server_to_client = FALSE');
              put_integer_line ('       maximum_data_sent ', p_cpu_queue_entry^.maximum_data_sent);
              put_integer_line ('       maximum_data_received ', p_cpu_queue_entry^.maximum_data_received);
            IFEND;
          ELSEIF p_cpu_queue_entry^.processor_type = dfc$monitor THEN
            add_to_line ('MONITOR');
            flush_line;
            start_line ('   io_id ...................... ');
            flush_line;
            start_line ('     specified ................ ');
            end_line_with_boolean (p_cpu_queue_entry^.io_id.specified);
            start_line ('     io_function .............. ');
            add_integer_to_line ($INTEGER (p_cpu_queue_entry^.io_id.io_function));
            flush_line;
            IF (p_cpu_queue_entry^.io_id.io_function >= ioc$read_for_server) AND
                  (p_cpu_queue_entry^.io_id.io_function <= ioc$allocate) THEN
              start_line ('     queue_entry_location:      ');
              flush_line;
              start_line ('       directory_index ........ ');
              add_integer_to_line (p_cpu_queue_entry^.io_id.queue_entry_location.directory_index);
              flush_line;
              start_line ('       queue_index ............ ');
              add_integer_to_line (p_cpu_queue_entry^.io_id.queue_entry_location.queue_index);
              flush_line;
              start_line ('       queue_entry_index ...... ');
              add_integer_to_line (p_cpu_queue_entry^.io_id.queue_entry_location.queue_entry_index);
              flush_line;
            ELSEIF p_cpu_queue_entry^.io_id.io_function = ioc$read_ahead_on_server THEN
              start_line ('       read_ahead_iocb_index .. ');
              add_integer_to_line (p_cpu_queue_entry^.io_id.read_ahead_iocb_index);
              flush_line;
            IFEND;
            start_line ('   ajlo ....................... ');
            add_integer_to_line ($INTEGER (p_cpu_queue_entry^.ajlo));
            flush_line;
            start_line ('   io_type .................... ');
            add_integer_to_line ($INTEGER (p_cpu_queue_entry^.io_type));
            flush_line;
            display_sfid (p_cpu_queue_entry^.sfid);
            start_line ('   p_server_iocb ............... ');
            IF p_cpu_queue_entry^.p_server_iocb = NIL THEN
              add_to_line ('NIL');
              flush_line;
            ELSE
              add_pva_to_line (p_cpu_queue_entry^.p_server_iocb);
              flush_line;
              start_line ('     global_file_name ... ');
              pmp$convert_binary_unique_name (p_cpu_queue_entry^.p_server_iocb^.global_file_name, gfn,
                    status);
              add_to_line (gfn);
              flush_line;

              display_server_state (p_cpu_queue_entry^.p_server_iocb^.server_state);

              display_sfid (p_cpu_queue_entry^.p_server_iocb^.sfid);

              start_line ('     offset ............. ');
              add_integer_to_line (p_cpu_queue_entry^.p_server_iocb^.offset);
              flush_line;
              start_line ('     length ............. ');
              add_integer_to_line (p_cpu_queue_entry^.p_server_iocb^.length);
              flush_line;
              start_line ('     eoi ................ ');
              add_integer_to_line (p_cpu_queue_entry^.p_server_iocb^.eoi);
              flush_line;
              start_line ('     sub_reqcode ........ ');
              CASE p_cpu_queue_entry^.p_server_iocb^.sub_reqcode OF
              = mmc$iorc_read_pages =
                add_to_line ('read_pages');
              = mmc$iorc_write_pages =
                add_to_line ('write_pages');
              = mmc$iorc_await_io_completion =
                add_to_line ('await_io_completion');
              ELSE
                add_to_line ('unknown subreq');
              CASEND;
              flush_line;
              display_server_iocb_condition (p_cpu_queue_entry^.p_server_iocb^.condition);
              flush_line;
              start_line ('     io_already_active... ');
              end_line_with_boolean (p_cpu_queue_entry^.p_server_iocb^.io_already_active);
              start_line ('     active_io_count .... ');
              add_integer_to_line (p_cpu_queue_entry^.p_server_iocb^.active_io_count);
              flush_line;
              start_line ('     reissue_request .... ');
              end_line_with_boolean (p_cpu_queue_entry^.p_server_iocb^.reissue_request);
              start_line ('     restart_count ...... ');
              add_integer_to_line (p_cpu_queue_entry^.p_server_iocb^.restart_count);

            IFEND;
            start_line ('   current_request_type ......... ');
            IF p_cpu_queue_entry^.current_request_type = dfc$monitor_io THEN
              add_to_line (' IO');
            ELSE
              add_to_line (' ALLOCATE');
            IFEND;
            flush_line;
            start_line ('   current_request_time ......... ');
            add_integer_to_line (p_cpu_queue_entry^.current_request_time);
            flush_line;
          ELSE
            add_to_line ('TASK');
            flush_line;
          IFEND;
        FOREND;
      IFEND;
    FOREND;

    IF p_output_id^.alternate_output_open THEN
      fsp$close_file (p_output_id^.output_file_fid, status);
      p_output_id^.output_file_fid := p_output_id^.save_output_fid;
      p_output_id^.page_width := p_output_id^.save_page_width;
      #SPOIL (p_output_id^.alternate_output_open);
      p_output_id^.alternate_output_open := FALSE;
      #SPOIL (p_output_id^.alternate_output_open);
    IFEND;

  PROCEND dfp$display_queue;
?? EJECT ??

  PROCEDURE display_server_state
    (    server_state: mmt$server_state);

    start_line ('     server_state ....... ');
    CASE server_state OF
    = mmc$ss_queue_initialized =
      add_to_line ('queue_initialized');
    = mmc$ss_waiting =
      add_to_line ('waiting');
    = mmc$ss_reading_from_disk =
      add_to_line ('reading_from_disk');
    = mmc$ss_read_disk_error =
      add_to_line ('read_disk_error');
    = mmc$ss_writing_to_esm =
      add_to_line ('writing_to_esm');
    = mmc$ss_write_esm_error =
      add_to_line ('write_esm_error');
    = mmc$ss_reading_from_esm =
      add_to_line ('reading_from_esm');
    = mmc$ss_read_esm_error =
      add_to_line ('read_esm_error');
    = mmc$ss_writing_to_disk =
      add_to_line ('writing_to_disk');
    = mmc$ss_write_disk_error =
      add_to_line ('write_disk_error');
    = mmc$ss_sending_write_response =
      add_to_line ('sending_write_response');
    = mmc$ss_sending_write_resp_error =
      add_to_line ('send_write_response_error');
    = mmc$ss_allocating_space =
      add_to_line ('allocating_space');
    = mmc$ss_allocate_space_error =
      add_to_line ('allocate_space_error');
    = mmc$ss_send_allocate_response =
      add_to_line ('sending_allocate_response');
    = mmc$ss_send_allocate_resp_error =
      add_to_line ('send_allocate_response_error');
    = mmc$ss_reading_pages_ahead =
      add_to_line ('reading_pages_ahead');
    ELSE
      add_integer_to_line ($INTEGER (server_state));
    CASEND;
  PROCEND display_server_state;
?? EJECT ??

  PROCEDURE display_sfid
    (    sfid: gft$system_file_identifier);

    flush_line;
    start_line ('     sfid ............... ');
    flush_line;
    start_line ('       file_entry_index . ');
    add_integer_to_line (sfid.file_entry_index);
    flush_line;
    start_line ('       residence ........ ');
    CASE sfid.residence OF
    = gfc$tr_job =
      add_to_line ('job');
    = gfc$tr_system =
      add_to_line ('system');
    = gfc$tr_null_residence =
      add_to_line ('null_residence');
    = gfc$tr_system_wait_recovery =
      add_to_line ('system_wait_recovery');

    ELSE
      add_to_line ('unknown file location');
    CASEND;
    flush_line;
    start_line ('       file_hash ........ ');
    add_integer_to_line (sfid.file_hash);
    flush_line;
  PROCEND display_sfid;
?? EJECT ??

  PROCEDURE display_server_iocb_condition
    (    condition: dft$server_iocb_error_condition);

    start_line ('     condition .......... ');
    CASE condition OF
    = dfc$null_server_condition =
      add_to_line ('null_server_condition');
    = dfc$reissued_rq_no_memory =
      add_to_line ('reissued_rq_no_memory');
    = dfc$reissued_rq_low_on_memory =
      add_to_line ('reissued_rq_low_on_memory');
    = dfc$reissued_rq_pt_full =
      add_to_line ('reissued_rq_pt_full');
    = dfc$reissued_rq_io_temp_reject =
      add_to_line ('reissued_rq_io_temp_reject');
    = dfc$reissu_rq_temp_rej_fde_lock =
      add_to_line ('reissued_rq_temp_reject_fde_locked');
    = dfc$reissued_rq_temp_rej_q_full =
      add_to_line ('reissued_rq_temp_reject_queue_full');
    = dfc$reissued_rq_io_still_active =
      add_to_line ('reissued_rq_io_still_active');
    = dfc$reissued_rq_task_queued =
      add_to_line ('reissued_rq_task_queued');
    = dfc$reissue_rq_client_locked_pg =
      add_to_line ('reissue_rq_client_locked_pg');
    = dfc$server_page_locked =
      add_to_line ('server_page_locked');
    = dfc$server_read_beyond_eoi =
      add_to_line ('server_read_beyond_eoi');
    = dfc$server_beyond_file_limit =
      add_to_line ('server_beyond_file_limit');
    = dfc$server_no_extend_permission =
      add_to_line ('server_no_extend_permission');
    = dfc$server_signal_select_on_pf =
      add_to_line ('server_signal_select_on_pf');
    = dfc$server_beyond_tape_window =
      add_to_line ('server_beyond_tape_window');
    = dfc$server_io_already_active =
      add_to_line ('server_io_already_active');
    = dfc$server_io_not_active =
      add_to_line ('server_io_not_active');
    = dfc$server_pages_not_available =
      add_to_line ('server_pages_not_available');
    = dfc$server_write_client_error =
      add_to_line ('server_write_client_error');
    = dfc$unrecovered_disk_error =
      add_to_line ('unrecovered_disk_error');
    = dfc$pp_not_configured =
      add_to_line ('pp_not_configured');
    = dfc$pp_interlock_set =
      add_to_line ('pp_interlock_set');
    = dfc$no_space_to_allocate =
      add_to_line ('no_space_to_allocate');
    = dfc$invalid_image_request =
      add_to_line ('invalid_image_request');
    = dfc$invalid_disk_type =
      add_to_line ('invalid_disk_type');
    = dfc$disk_media_error =
      add_to_line ('disk_media_error');
    = dfc$requests_full =
      add_to_line ('requests_full');
    = dfc$unable_to_build_io_request =
      add_to_line ('unable_to_build_io_request');
    = dfc$free_failure =
      add_to_line ('free_failure');
    = dfc$address_error =
      add_to_line ('address_error');
    = dfc$unable_to_unlock_rma_list =
      add_to_line ('unable_to_unlock_rma_list');
    = dfc$unable_to_set_system_flag =
      add_to_line ('unable_to_set_system_flag');
    = dfc$allocation_failure =
      add_to_line ('allocation_failure');
    = dfc$unable_to_queue_io_request =
      add_to_line ('unable_to_queue_io_request');
    = dfc$unable_to_destroy_io_req =
      add_to_line ('unable_to_destroy_io_req');
    = dfc$io_completion_table_error =
      add_to_line ('io_completion_table_error');
    = dfc$unsupported_monitor_request =
      add_to_line ('unsupported_monitor_request');
    = dfc$request_id_mismatch =
      add_to_line ('request_id_mismatch');
    = dfc$io_request_error =
      add_to_line ('io_request_error');
    = dfc$ssiot_recovery_required =
      add_to_line ('ssiot_recovery_required');
    ELSE
      add_integer_to_line ($INTEGER (condition));
    CASEND;
  PROCEND display_server_iocb_condition;
?? EJECT ??

  PROCEDURE display_flags
    (    flags: dft$queue_entry_flags);

    start_line ('  Flags:');
    flush_line;
    start_line ('     active_entry .......... ');
    end_line_with_boolean (flags.active_entry);
    start_line ('     driver_action ......... ');
    end_line_with_boolean (flags.driver_action);
    start_line ('     subsystem_action ...... ');
    end_line_with_boolean (flags.subsystem_action);
    start_line ('     driver_error_alert .... ');
    end_line_with_boolean (flags.driver_error_alert);
    start_line ('     send_command .......... ');
    end_line_with_boolean (flags.send_command);
    start_line ('     send_data ............. ');
    end_line_with_boolean (flags.send_data);
    start_line ('     send_ready_for_data ... ');
    end_line_with_boolean (flags.send_ready_for_data);
    start_line ('     buffer_sent ........... ');
    end_line_with_boolean (flags.buffer_sent);
    start_line ('     data_sent ............. ');
    end_line_with_boolean (flags.data_sent);
    start_line ('     buffer_received ....... ');
    end_line_with_boolean (flags.buffer_received);
    start_line ('     data_received ......... ');
    end_line_with_boolean (flags.data_received);
    start_line ('     ready_for_data_sent ... ');
    end_line_with_boolean (flags.ready_for_data_sent);
    start_line ('     ready_for_data_received ');
    end_line_with_boolean (flags.ready_for_data_received);
    start_line ('     process_response ...... ');
    end_line_with_boolean (flags.process_response);
  PROCEND display_flags;
?? EJECT ??

  PROCEDURE display_transaction_state
    (    transaction_state: dft$transaction_state);

    start_line ('   transaction_state .......... ');
    CASE transaction_state OF
    = dfc$null_state =
      add_to_line ('null_state');
    = dfc$queue_entry_available =
      add_to_line ('queue_entry_available');
    = dfc$queue_entry_assigned =
      add_to_line ('queue_entry_assigned');
    = dfc$request_queued =
      add_to_line ('request_queued');
    = dfc$request_sent =
      add_to_line ('request_sent');
    = dfc$server_must_read_page_data =
      add_to_line ('server_must_read_page_data');
    = dfc$server_received_request =
      add_to_line ('server_received_request');
    = dfc$server_sent_response =
      add_to_line ('server_sent_response');
    = dfc$client_must_read_page_data =
      add_to_line ('client_must_read_page_data');
    = dfc$response_received =
      add_to_line ('response_received');
    = dfc$media_error =
      add_to_line ('media_error');
    = dfc$message_content_error =
      add_to_line ('message_content_error');
    = dfc$server_waiting_request =
      add_to_line ('server_waiting_request');
    ELSE
      add_integer_to_line ($INTEGER (transaction_state));
    CASEND;
    flush_line;
  PROCEND display_transaction_state;
?? EJECT ??

  PROCEDURE display_poll_type
    (    poll_type: dft$poll_type);

    start_line ('     poll_type.............. ');
    CASE poll_type OF
    = dfc$normal_poll =
      add_to_line ('dfc$normal_poll');
    = dfc$verify_served_family =
      add_to_line ('dfc$verify_served_family');
    = dfc$verify_queue =
      add_to_line ('dfc$verify_queue');
    = dfc$deactivate_server =
      add_to_line ('dfc$deactivate_server');
    = dfc$deactivate_complete =
      add_to_line ('dfc$deactivate_complete');
    = dfc$poll_reply =
      add_to_line ('dfc$poll_reply');
    = dfc$recovery_complete_reply =
      add_to_line ('dfc$recovery_complete_reply');
    = dfc$verify_family_reply =
      add_to_line ('dfc$verify_family_reply');
    = dfc$verify_queue_reply =
      add_to_line ('dfc$verify_queue_reply');
    = dfc$deactivate_reply =
      add_to_line ('dfc$deactivate_reply');
    = dfc$req_verify_served_family =
      add_to_line ('dfc$req_verify_served_family');
    ELSE
      add_to_line (' Unknown poll type ');
    CASEND;
    flush_line;
  PROCEND display_poll_type;
?? EJECT ??

  PROCEDURE display_rpc_test_header
    (    test_header: dft$rpc_test_request_header);

    put_line ('  --------- RPC TEST HEADER ');
    put_integer_line ('     compute_checksum ', $INTEGER (test_header.compute_checksum));
    put_integer_line ('     start_time ', test_header.start_time);
    put_integer_line ('     send_buffer_size ', test_header.send_buffer_size);
    put_integer_line ('     receive_buffer_size ', test_header.receive_buffer_size);
    put_integer_line ('     send_buffer_starting_char ', $INTEGER (test_header.send_buffer_starting_char));
    put_integer_line ('     buffer_checksum ', test_header.buffer_checksum);
    put_integer_line ('     send_data_size ', test_header.send_data_size);
    put_integer_line ('     receive_data_size ', test_header.receive_data_size);
    put_integer_line ('     data_starting_char ', $INTEGER (test_header.data_starting_char));
    put_integer_line ('     data_checksum ', test_header.data_checksum);
  PROCEND display_rpc_test_header;

?? EJECT ??

  PROCEDURE display_rpc_buffer_header
    (    rpc_buffer_header: dft$rpc_buffer_header);

    start_line ('   Rpc_buffer_header .......... ');
    flush_line;
    start_line ('   system_supplied_job_name ... ');
    add_to_line (rpc_buffer_header.system_supplied_job_name);
    flush_line;
    start_line ('   procedure_version .......... ');
    add_to_line (rpc_buffer_header.procedure_version);
    flush_line;
    put_integer_line ('   procedure_version .......... ', rpc_buffer_header.procedure_name_checksum);
    CASE rpc_buffer_header.procedure_class OF
    = dfc$permanent_file_call =
      put_line ('   procedure_class............. dfc$permanent_file_call');
      put_integer_line ('   client_job_id.job_list_pointer_index ',
            rpc_buffer_header.client_job_id.job_list_pointer_index);
      put_integer_line ('   client_job_id.job_list_index ', rpc_buffer_header.client_job_id.job_list_index);
    = dfc$system_core_call =
      put_line ('   procedure_class............. dfc$system_core_call');
    ELSE
      put_line ('   procedure_class............. Unknown  ');
    CASEND;
    display_call_progress (rpc_buffer_header.call_progress);

  PROCEND display_rpc_buffer_header;
?? EJECT ??

  PROCEDURE display_rpc_response_header
    (    rpc_response_buffer_header: dft$rpc_response_buffer_header);

    put_line (' Remote procedure call response ');
    display_call_progress (rpc_response_buffer_header.call_progress);
  PROCEND display_rpc_response_header;
?? EJECT ??

  PROCEDURE display_call_progress
    (    call_progress: dft$rpc_progress_record);

    put_line ('   Call progress...............');
    put_integer_line ('   transaction_per_rpc_request.', call_progress.transaction_per_rpc_request);
    put_integer_line ('   total_data_sent.............', call_progress.total_data_sent);
    put_integer_line ('   total_data_received.........', call_progress.total_data_received);
    put_integer_line ('   user_buffer_length_sent.....', call_progress.user_buffer_length_sent);
    put_integer_line ('   user_data_length_sent.......', call_progress.user_data_length_sent);

  PROCEND display_call_progress;
?? EJECT ??
  PROCEDURE flush_family_table
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt quit_pdt ()

?? PUSH (LISTEXT := ON) ??

    VAR
      quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

    clp$scan_parameter_list (parameter_list, quit_pdt, status);

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$flush_served_family_table (status);
  PROCEND flush_family_table;
?? EJECT ??
  PROCEDURE log_side_door_port
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);



{   pdt lsdp_pdt (status)

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

  VAR
    lsdp_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
  ^lsdp_pdt_names, ^lsdp_pdt_params];

  VAR
    lsdp_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1]
  of clt$parameter_name_descriptor := [['STATUS', 1]];

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

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

?? FMT (FORMAT := ON) ??
?? POP ??
    clp$scan_parameter_list (parameter_list, lsdp_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$log_side_door_port_status (dfc$sdp_top_of_hour, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND log_side_door_port;
?? EJECT ??
  PROCEDURE put_pva_line
    (    descr: string ( * );
         p_cell: ^cell);

    VAR
      length: integer,
      pva_string: string (20);

    start_line (descr);
    IF p_cell = NIL THEN
      add_to_line (' NIL ');
    ELSE
      STRINGREP (pva_string, length, p_cell);
      add_to_line (pva_string (1, length));
    IFEND;
    flush_line;
  PROCEND put_pva_line;

?? EJECT ??

  PROCEDURE put_integer_line
    (    descr: string ( * );
         int: integer);

    start_line (descr);
    add_integer_to_line (int);
    flush_line;
  PROCEND put_integer_line;

MODEND dfm$driver_test_utility;


