?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Deadstart : Test Resource Requests' ??
MODULE dsm$test_resource_request_cmds;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains a utility that is used at system core command time during deadstart to test
{   the resource requests.
{ DESIGN:
{   This utility is used during deadstart when the operator is asked to enter system core commands.  The
{   utility is entered by the command 'TESRR'.  A directory of the commands is displayed by typing in the
{   command 'HELP'.  The utility is used for debug purposes only, in some cases memory may be reserved but
{   never released because the user may want to observe the memory on a dump.  It was never the intention
{   of this utility to be anything but a debug tool for requesting resources.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$mainframe_paged_literal
*copyc syt$value_kinds
?? POP ??
*copyc dpp$put_next_line
*copyc dsp$format_resource_table
*copyc dsp$get_pp_registers
*copyc dsp$idle_pp
*copyc dsp$load_pp
*copyc dsp$request_resources
*copyc dsp$resume_pp
*copyc dsp$retrieve_channel_type
*copyc dsp$retrieve_iou_information
*copyc dsp$update_hardware_date_time
*copyc ofp$display_resource_table
*copyc syp$binary_to_ascii
*copyc syp$crack_command
*copyc syp$process_core_commands
*copyc i#real_memory_address

  PROCEDURE [XREF] dsp$display_resource_table_item
    (    iou: dst$number_of_ious;
         resource: dst$physical_resource_number;
         selected_protocol_types: t$channel_protocol_types;
         wid: dpt$window_id;
     VAR status: ost$status);

  TYPE
    t$channel_protocol_types = set of dst$channel_protocol_type;

?? EJECT ??
*copyc osv$mainframe_wired_heap
?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    output_line_length = 70;

  TYPE
    command_list = (display_resource_table_cmd, display_resource_tbl_entry_cmd, get_any_pp_cmd,
          get_channel_cmd, get_channel_type_cmd, get_equipment_cmd, get_pp_cmd, get_pp_registers_cmd,
          idle_pp_cmd, load_pp_cmd, resume_pp_cmd, return_channel_cmd, return_equipment_cmd, return_pp_cmd,
          write_time_cmd),

    output_line_type = string (output_line_length);

?? EJECT ??
  { Parameter Description Tables for commands in this module.

  VAR
    channel_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'CHANNEL ', syc$integer_value, 0, 0, 33(8)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE]],


    disrte_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor := [
{       } [FALSE, 1, 'CHANNEL ', syc$integer_value, 0, 0, 33(8)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'TYPES   ', syc$integer_value, 0, 0, 2]],

    get_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 5] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'CHANNEL ', syc$integer_value, 0, 0, 33(8)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'DRIVER  ', syc$boolean_value, TRUE],
{       } [FALSE, 1, 'PARTNER ', syc$boolean_value, FALSE],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE]],

    get_pp_registers_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 3] of
          syt$parameter_descriptor := [
{       } [TRUE, 1, 'PP      ', syc$integer_value, 0, 0, 31(8)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE]],

    help_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{       } [FALSE, 1, 'COMMAND ', syc$name_value, 'NONE']],

    idle_pp_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 5] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'PP      ', syc$integer_value, 0, 0, 31(8)],
{       } [TRUE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'DUMP_PP ', syc$boolean_value, FALSE],
{       } [FALSE, 1, 'REG_ONLY', syc$boolean_value, FALSE],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE]],

    load_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 5] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'NAME    ', syc$name_value, 'ABCDEFG'],
{       } [TRUE, 1, 'PP      ', syc$integer_value, 0, 0, 31(8)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE],
{       } [FALSE, 1, 'RMA     ', syc$integer_value, 0, 0, 0fffffff(16)]],

    path_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 5] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'CHANNEL ', syc$integer_value, 0, 0, 33(8)],
{       } [TRUE, 1, 'EQUIP   ', syc$integer_value, 0, 0, 7],
{       } [TRUE, 1, 'UNIT    ', syc$integer_value, 0, 0, 63],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE]],

    pp_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 4] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'PP      ', syc$integer_value, 0, 0, 31(8)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE],
{       } [FALSE, 1, 'PP      ', syc$integer_value, 30, 0, 31(8)]],

    resume_pp_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 4] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'PP      ', syc$integer_value, 0, 0, 31(8)],
{       } [TRUE, 1, 'START_P ', syc$integer_value, 0, 0, 0ffff(16)],
{       } [FALSE, 1, 'IOU     ', syc$integer_value, 0, 0, 1],
{       } [FALSE, 1, 'CIO     ', syc$boolean_value, FALSE]],

    time_pdt: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 5] of syt$parameter_descriptor := [
{       } [TRUE, 1, 'YEARS   ', syc$integer_value, 0, 0, 255],
{       } [TRUE, 1, 'MONTHS  ', syc$integer_value, 0, 0, 12],
{       } [TRUE, 1, 'DAYS    ', syc$integer_value, 0, 0, 31],
{       } [TRUE, 1, 'HOURS   ', syc$integer_value, 0, 0, 60],
{       } [TRUE, 1, 'MINUTES ', syc$integer_value, 0, 0, 60]];

?? EJECT ??
  { Command Table for commands in this module.

  VAR
    command_table: [STATIC, READ, oss$mainframe_paged_literal] array [1 .. 16] of syt$command_table_entry := [
{          } ['DISRT', 'DISPLAY_RESOURCE_TABLE', FALSE, ^display_resource_table],
{          } ['DISRTE', 'DISPLAY_RESOURCE_TABLE_ENTRY', FALSE, ^display_resource_table_entry],
{          } ['GETAP', 'GET_ANY_PP', FALSE, ^get_any_pp],
{          } ['GETC', 'GET_CHANNEL', FALSE, ^get_channel],
{          } ['GETCT', 'GET_CHANNEL_TYPE', FALSE, ^get_channel_type],
{          } ['GETE', 'GET_EQUIPMENT', FALSE, ^get_equipment],
{          } ['GETP', 'GET_PP', FALSE, ^get_pp],
{          } ['GETPR', 'GET_PP_REGISTERS', FALSE, ^get_pp_registers],
{          } ['HELP', 'HELP', FALSE, ^help],
{          } ['IDLP', 'IDLE_PP', FALSE, ^idle_pp],
{          } ['LOAP', 'LOAD_PP', FALSE, ^load_pp],
{          } ['RESP', 'RESUME_PP', FALSE, ^resume_pp],
{          } ['RETC', 'RETURN_CHANNEL', FALSE, ^return_channel],
{          } ['RETE', 'RETURN_EQUIPMENT', FALSE, ^return_equipment],
{          } ['RETP', 'RETURN_PP', FALSE, ^return_pp],
{          } ['WRIT', 'WRITE_TIME', FALSE, ^write_time]];

?? EJECT ??
  { Variables containing help displays.

  VAR
    help_command_display: array [command_list] of output_line_type := [
{       } 'DISPLAY_RESOURCE_TABLE, DISRT',
{       } 'DISPLAY_RESOURCE_TABLE_ENTRY, DISRTE',
{       } 'GET_ANY_PP, GETAP',
{       } 'GET_CHANNEL, GETC',
{       } 'GET_CHANNEL_TYPE, GETCT',
{       } 'GET_EQUIPMENT, GETE',
{       } 'GET_PP, GETP',
{       } 'GET_PP_REGISTERS, GETPR',
{       } 'IDLE_PP, IDLP',
{       } 'LOAD_PP, LOAP',
{       } 'RESUME_PP, RESP',
{       } 'RETURN_CHANNEL, RETC',
{       } 'RETURN_EQUIPMENT, RETE',
{       } 'RETURN_PP, RETP',
{       } 'WRITE_TIME, WRIT'],

    help_displays: array [command_list] of array [1 .. 6] of output_line_type := [
{      } ['command:  DISPLAY_RESOURCE_TABLE_ENTRY alias: DISRTE',
{       } '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  TYPE = 0..2, 0=all, 1 = cio, 2 = nio', ' ', ' '],

{      } ['command:  DISPLAY_RESOURCE_TABLE alias: DISRT',
{       } '  parameter:  NONE', ' ', ' ', ' ', ' '],

{      } ['command:  GET_ANY_PP  alias: GETAP',
{       } '  parameter:  NONE', ' ', ' ', ' ', ' '],

{      } ['command:  GET_CHANNEL  alias: GETC',
{       } '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio', ' ', ' '],

{      } ['command:  GET_CHANNEL_TYPE  alias: GETCT',
{       } '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio', ' ', ' '],

{      } ['command:  GET_EQUIPMENT   alias: GETE',
{       } '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  EQUIPMENT = equipment number, range = 0 .. 7',
{       } '  parameter:  UNIT = unit number, range = 0 .. 63',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio'],

{      } ['command:  GET_PP   alias: GETP',
{       } '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  DRIVER = boolean, TRUE = driver, FALSE = nondriver',
{       } '  parameter:  PARTNER = boolean, TRUE = partner, FALSE = single',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio'],
{       }
{      } ['command:  GET_PP_REGISTERS alias: GETPR',
{       } '  parameter:  PP = pp number, range = 0 .. 31(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio', ' ', ' '],
{       }
{      } ['command:  IDLE_PP   alias: IDLP',
{       } '  parameter:  PP = pp number, range = 0 .. 31(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  DUMP_PP = boolean, TRUE = dump pp, FALSE = no dump',
{       } '  parameter:  REGISTER_ONLY = boolean, TRUE = registers only, FALSE = --',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio'],
{       }
{      } ['command:  LOAD_PP   alias: LOAP',
{       } '  parameter:  NAME = name of the pp to be loaded',
{       } '  parameter:  PP = pp number, range = 0 .. 31(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio',
{       } '  parameter:  RMA = rma of the pp table, range = 0 .. 0FFFFFFFF(16)'],

{      } ['command:  RESUME_PP   alias: RESP',
{       } '  parameter:  PP = pp number, range = 0 .. 31(8)',
{       } '  parameter:  START_PP = pp start address, range = 0 .. 0FFFF(16)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio', ' '],

{      } ['command:  RETURN_CHANNEL  alias: RETC',
          '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio', ' ', ' '],

{      } ['command:  RETURN_EQUIPMENT   alias: RETE',
          '  parameter:  CHANNEL = channel number, range = 0 .. 33(8)',
{       } '  parameter:  EQUIPMENT = equipment number, range = 0 .. 7',
{       } '  parameter:  UNIT = unit number, range = 0 .. 63',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio'],

{      } ['command:  RETURN_PP   alias: RETP',
{       } '  parameter:  PP = pp number, range = 0 .. 31(8)',
{       } '  parameter:  IOU = iou number, range = 0 .. 1',
{       } '  parameter:  CIO = boolean, TRUE = cio, FALSE = nio',
{       } '  parameter:  PP = pp number, range = 0 .. 31(8)', ' '],

{      } ['command:  WRITE_TIME   alias: WRIT',
{       } '  parameter:  YEARS = year number, range = 0 .. 255',
{       } '  parameter:  MONTHS = month number, range = 0 .. 12',
{       } '  parameter:  DAYS = day number, range = 0 .. 31',
{       } '  parameter:  HOURS = hour number, range = 0 .. 60',
{       } '  parameter:  MINUTES = minute number, range = 0 .. 60']];

?? OLDTITLE ??
?? NEWTITLE := 'DISPLAY_RESOURCE_TABLE', EJECT ??

{ PURPOSE:
{   This procedure processes the command DISPLAY_RESOURCE_TABLE.  It dumps out the resource
{   table stored in the SSR.

  PROCEDURE display_resource_table
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    CONST
      c$seq_size = 2 {= #size(t$count)} + (60 {high value of channels} * (1 + 80 {max estimated line size} ));

    TYPE
      t$count = 0 .. 0ffff(16),
      t$line_size = 0 .. 0ff(16),
      t$line = string ( * <= 0ff(16));

    VAR
      count_p: ^t$count,
      i: integer,
      ignore_status: ost$status,
      line_p: ^t$line,
      line_size_p: ^t$line_size,
      output_line: output_line_type,
      seq_p: ^SEQ ( * );

    status.normal := TRUE;
    PUSH seq_p: [[REP c$seq_size OF cell]];
    dsp$format_resource_table (seq_p, status);
    IF NOT status.normal THEN
      output_line := 'The display_resource_table request failed.';
      dpp$put_next_line (id, output_line, ignore_status);
      RETURN; {----->
    IFEND;

    RESET seq_p;
    NEXT count_p IN seq_p;
    IF count_p = NIL THEN
      RETURN; {----->
    IFEND;

    FOR i := 1 TO count_p^ DO
      NEXT line_size_p IN seq_p;
      IF line_size_p = NIL THEN
        RETURN; {----->
      IFEND;

      NEXT line_p: [line_size_p^] IN seq_p;
      IF line_p = NIL THEN
        RETURN; {----->
      IFEND;

      dpp$put_next_line (id, line_p^, ignore_status);
      IF NOT ignore_status.normal THEN
        RETURN; {----->
      IFEND;
    FOREND;

  PROCEND display_resource_table;
?? OLDTITLE ??
?? NEWTITLE := 'DISPLAY_RESOURCE_TABLE_ENTRY', EJECT ??

{ PURPOSE:
{   This procedure processes the command DISPLAY_RESOURCE_TABLE_ENTRY.  It dumps out
{   the resource for a particulay channel of the resource table stored in the SSR.

  PROCEDURE display_resource_table_entry
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      iou: dst$number_of_ious,
      resource: dst$physical_resource_number,
      selected_protocol_types: t$channel_protocol_types,
      parameters: array [1 .. 3] of syt$parameter_value;

    status.normal := TRUE;
    syp$crack_command (disrte_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    resource := parameters [1].int;
    iou := parameters [2].int;
    CASE parameters [3].int OF
    = 1 =
      selected_protocol_types := $t$channel_protocol_types [dsc$cpt_cio];
    = 2 =
      selected_protocol_types := $t$channel_protocol_types [dsc$cpt_nio];
    ELSE
      selected_protocol_types := -$t$channel_protocol_types [];
    CASEND;

    dsp$display_resource_table_item (iou, resource, selected_protocol_types, id, status);

    IF NOT status.normal THEN
      output_line := 'The display_resource_table request failed.';
      dpp$put_next_line (id, output_line, ignore_status);
    IFEND;

  PROCEND display_resource_table_entry;
?? TITLE := 'get_any_pp', EJECT ??

{ PURPOSE:
{   This procedure processes the command GET_ANY_PP.  It retrieves any PP.

  PROCEDURE get_any_pp
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ascii_number: string (5),
      ignore_status: ost$status,
      ious_in_configuration: dst$iou_information_table,
      number_of_ious: dst$number_of_ious,
      output_line: output_line_type,
      request: dst$resource_request;

    status.normal := TRUE;

    dsp$retrieve_iou_information (number_of_ious, ious_in_configuration);
    request.channel.number := 15; { dummy channel value
    request.channel.channel_protocol := dsc$cpt_nio;
    request.channel.iou_number := ious_in_configuration [1].physical_iou_number;
    request.resource_request_type := dsc$rrt_get_pp;
    request.options := $dst$resource_request_options [dsc$rro_any_pp];

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The get_any_pp request failed.';
      dpp$put_next_line (id, output_line, ignore_status);
      RETURN; {----->
    IFEND;

    ascii_number := '  ';
    syp$binary_to_ascii (request.primary_pp.number, ascii_number, 10, 5);
    output_line := 'PP number = ';
    output_line (13, 5) := ascii_number;
    output_line (18, 6) := '(10), ';
    output_line (24, 19) := 'channel protocol = ';
    IF request.primary_pp.channel_protocol = dsc$cpt_nio THEN
      output_line (43, 5) := 'NIO, ';
    ELSE
      output_line (43, 5) := 'CIO, ';
    IFEND;
    output_line (48, 6) := 'IOU = ';
    ascii_number := '  ';
    syp$binary_to_ascii (request.primary_pp.iou_number, ascii_number, 10, 5);
    output_line (54, 5) := ascii_number;
    output_line (59, 5) := '(10).';

    dpp$put_next_line (id, output_line, status);

  PROCEND get_any_pp;
?? TITLE := 'get_channel', EJECT ??

{ PURPOSE:
{   This procedure processes the command GET_CHANNEL.  It retrieves a channel.

  PROCEDURE get_channel
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 3] of syt$parameter_value,
      request: dst$resource_request;

    status.normal := TRUE;
    syp$crack_command (channel_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    request.resource_request_type := dsc$rrt_get_channel;
    request.channel.number := parameters [1].int;
    request.channel.iou_number := parameters [2].int;
    IF parameters [3].bool THEN
      request.channel.channel_protocol := dsc$cpt_cio;
    ELSE
      request.channel.channel_protocol := dsc$cpt_nio;
    IFEND;

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The get_channel request failed.';
    ELSE
      output_line := 'The get_channel request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND get_channel;
?? TITLE := 'get_channel_type', EJECT ??

{ PURPOSE:
{   This procedure processes the command GET_CHANNEL_TYPE.  It retrieves the type of the indicated channel.

  PROCEDURE get_channel_type
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      channel: dst$iou_resource,
      channel_type: cmt$channel_type,
      found: boolean,
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 3] of syt$parameter_value;

    status.normal := TRUE;
    syp$crack_command (channel_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    channel.number := parameters [1].int;
    channel.iou_number := parameters [2].int;
    IF parameters [3].bool THEN
      channel.channel_protocol := dsc$cpt_cio;
    ELSE
      channel.channel_protocol := dsc$cpt_nio;
    IFEND;

    dsp$retrieve_channel_type (channel, channel_type, found);
    IF NOT found THEN
      output_line := 'The get_channel_type request failed.';
    ELSE
      output_line := 'The get_channel_type request completed normally; type = ';
      CASE channel_type OF
      = cmc$170_channel =
        output_line (57, 4) := '170.';
      = cmc$ici_channel =
        output_line (57, 4) := 'ICI.';
      = cmc$isi_channel =
        output_line (57, 4) := 'ISI.';
      = cmc$ipi_channel =
        output_line (57, 4) := 'IPI.';
      ELSE
      CASEND;
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND get_channel_type;
?? TITLE := 'get_equipment', EJECT ??

{ PURPOSE:
{   This procedure processes the command GET_EQUIPMENT.  It retrieves the desired equipment.

  PROCEDURE get_equipment
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 5] of syt$parameter_value,
      request: dst$resource_request;

    status.normal := TRUE;
    syp$crack_command (path_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    request.resource_request_type := dsc$rrt_get_equipment;
    request.channel.number := parameters [1].int;
    request.channel.iou_number := parameters [4].int;
    IF parameters [5].bool THEN
      request.channel.channel_protocol := dsc$cpt_cio;
    ELSE
      request.channel.channel_protocol := dsc$cpt_nio;
    IFEND;
    request.equipment_number := parameters [2].int;
    request.unit_number := parameters [3].int;

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The get_equipment request failed.';
    ELSE
      output_line := 'The get_equipment request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND get_equipment;
?? TITLE := 'get_pp', EJECT ??

{ PURPOSE:
{   This procedure processes the command GET_PP.  It retrieves a PP.

  PROCEDURE get_pp
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ascii_number: string (5),
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 5] of syt$parameter_value,
      request: dst$resource_request;

    status.normal := TRUE;
    syp$crack_command (get_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    request.resource_request_type := dsc$rrt_get_pp;
    request.channel.number := parameters [1].int;
    request.channel.iou_number := parameters [2].int;
    IF parameters [5].bool THEN
      request.channel.channel_protocol := dsc$cpt_cio;
    ELSE
      request.channel.channel_protocol := dsc$cpt_nio;
    IFEND;
    IF parameters [3].bool THEN
      request.options := $dst$resource_request_options [dsc$rro_driver_pp];
    IFEND;
    IF parameters [4].bool THEN
      request.options := request.options + $dst$resource_request_options [dsc$rro_partner_pp];
    IFEND;

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The get_pp request failed.';
      dpp$put_next_line (id, output_line, ignore_status);
      RETURN; {----->
    IFEND;

    ascii_number := '  ';
    syp$binary_to_ascii (request.primary_pp.number, ascii_number, 10, 5);
    output_line := 'The primary PP number = ';
    output_line (25, 5) := ascii_number;
    output_line (30, 5) := '(10).';
    dpp$put_next_line (id, output_line, status);
    IF parameters [4].bool THEN
      ascii_number := '  ';
      syp$binary_to_ascii (request.secondary_pp.number, ascii_number, 10, 5);
      output_line := 'The secondary PP number = ';
      output_line (27, 5) := ascii_number;
      output_line (32, 5) := '(10).';
      dpp$put_next_line (id, output_line, status);
    IFEND;

  PROCEND get_pp;
?? TITLE := 'get_pp_registers', EJECT ??

{ PURPOSE:
{   This procedure processes the command GET_PP_REGISTERS.  It retrieves the desired PP registers.

  PROCEDURE get_pp_registers
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ascii_number: string (12),
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 3] of syt$parameter_value,
      pp: dst$iou_resource,
      pp_registers: dst$dft_pp_registers;

    status.normal := TRUE;
    syp$crack_command (get_pp_registers_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pp.number := parameters [1].int;
    pp.iou_number := parameters [2].int;
    IF parameters [3].bool THEN
      pp.channel_protocol := dsc$cpt_cio;
    ELSE
      pp.channel_protocol := dsc$cpt_nio;
    IFEND;

    dsp$get_pp_registers (pp, pp_registers, status);
    IF NOT status.normal THEN
      output_line := 'The get_pp_registers request failed.';
      dpp$put_next_line (id, output_line, ignore_status);
      RETURN; {----->
    IFEND;

    output_line := 'Displaying the registers of ';
    IF parameters [2].bool THEN
      output_line (29, 7) := 'CIO PP ';
    ELSE
      output_line (29, 7) := 'NIO PP ';
    IFEND;
    syp$binary_to_ascii (parameters [1].int, ascii_number, 10, 12);
    output_line (37, 12) := ascii_number;
    output_line (50, 5) := '(10).';
    dpp$put_next_line (id, output_line, status);

    { Display pp registers.

    output_line := '    P=       , Q=      , K=      , A=      .';
    syp$binary_to_ascii (pp_registers.p_register, output_line, 8, 13);
    syp$binary_to_ascii (pp_registers.q_register, output_line, 8, 23);
    syp$binary_to_ascii (pp_registers.k_register, output_line, 8, 33);
    syp$binary_to_ascii (pp_registers.a_register, output_line, 8, 43);
    dpp$put_next_line (id, output_line, status);

  PROCEND get_pp_registers;
?? TITLE := 'help', EJECT ??

{ PURPOSE:
{   This procedure processes the command HELP.  It displays the commands available through this utility.
{   It also is capable of displaying each command and its parameters individually.

  PROCEDURE help
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      command_type: command_list,
      display_command_index: command_list,
      display_line_index: 1 .. 6,
      output_line: output_line_type,
      parameters: array [1 .. 1] of syt$parameter_value;

    status.normal := TRUE;
    syp$crack_command (help_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF parameters [1].name = 'NONE' THEN
      FOR display_command_index := LOWERBOUND (help_command_display) TO UPPERBOUND (help_command_display) DO
        output_line := help_command_display [display_command_index];
        dpp$put_next_line (id, output_line, status);
      FOREND;
      RETURN; {----->
    ELSEIF (parameters [1].name = 'DISRT') OR (parameters [1].name = 'DISPLAY_RESOURCE_TABLE') THEN
      command_type := display_resource_table_cmd;
    ELSEIF (parameters [1].name = 'DISRTE') OR (parameters [1].name = 'DISPLAY_RESOURCE_TABLE_ENTRY') THEN
      command_type := display_resource_tbl_entry_cmd;
    ELSEIF (parameters [1].name = 'GETAP') OR (parameters [1].name = 'GET_ANY_PP') THEN
      command_type := get_any_pp_cmd;
    ELSEIF (parameters [1].name = 'GETC') OR (parameters [1].name = 'GET_CHANNEL') THEN
      command_type := get_channel_cmd;
    ELSEIF (parameters [1].name = 'GETCT') OR (parameters [1].name = 'GET_CHANNEL_TYPE') THEN
      command_type := get_channel_type_cmd;
    ELSEIF (parameters [1].name = 'GETE') OR (parameters [1].name = 'GET_EQUIPMENT') THEN
      command_type := get_equipment_cmd;
    ELSEIF (parameters [1].name = 'GETP') OR (parameters [1].name = 'GET_PP') THEN
      command_type := get_pp_cmd;
    ELSEIF (parameters [1].name = 'GETPR') OR (parameters [1].name = 'GET_PP_REGISTERS') THEN
      command_type := get_pp_registers_cmd;
    ELSEIF (parameters [1].name = 'IDLP') OR (parameters [1].name = 'IDLE_PP') THEN
      command_type := idle_pp_cmd;
    ELSEIF (parameters [1].name = 'LOAP') OR (parameters [1].name = 'LOAD_PP') THEN
      command_type := load_pp_cmd;
    ELSEIF (parameters [1].name = 'RESP') OR (parameters [1].name = 'RESUME_PP') THEN
      command_type := resume_pp_cmd;
    ELSEIF (parameters [1].name = 'RETC') OR (parameters [1].name = 'RETURN_CHANNEL') THEN
      command_type := return_channel_cmd;
    ELSEIF (parameters [1].name = 'RETE') OR (parameters [1].name = 'RETURN_EQUIPMENT') THEN
      command_type := return_equipment_cmd;
    ELSEIF (parameters [1].name = 'RETP') OR (parameters [1].name = 'RETURN_PP') THEN
      command_type := return_pp_cmd;
    ELSEIF (parameters [1].name = 'WRIT') OR (parameters [1].name = 'WRITE_TIME') THEN
      command_type := write_time_cmd;
    ELSE
      output_line := 'ERROR -- bad command name or command not supported by HELP.';
      dpp$put_next_line (id, output_line, status);
      RETURN; {----->
    IFEND;

    FOR display_line_index := 1 TO 6 DO
      output_line := help_displays [command_type] [display_line_index];
      IF output_line = ' ' THEN
        RETURN; {----->
      IFEND;
      dpp$put_next_line (id, output_line, status);
    FOREND;

  PROCEND help;
?? TITLE := 'idle_pp', EJECT ??

{ PURPOSE:
{   This procedure processes the command IDLE_PP.  It idles and possibly dumps the desired PP.

  PROCEDURE idle_pp
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ascii_number: string (8),
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 5] of syt$parameter_value,
      pp: dst$iou_resource,
      pp_dump_seq_p: ^SEQ ( * ),
      rma: integer;

    status.normal := TRUE;
    syp$crack_command (idle_pp_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pp.number := parameters [1].int;
    pp.iou_number := parameters [2].int;
    IF parameters [5].bool THEN
      pp.channel_protocol := dsc$cpt_cio;
    ELSE
      pp.channel_protocol := dsc$cpt_nio;
    IFEND;
    IF parameters [3].bool THEN
      ALLOCATE pp_dump_seq_p: [[REP (16 * 1024 * 2) OF cell]] IN osv$mainframe_wired_heap^;
      RESET pp_dump_seq_p;
    ELSE
      pp_dump_seq_p := NIL;
    IFEND;

    dsp$idle_pp (pp, parameters [4].bool, parameters [3].bool, pp_dump_seq_p, status);
    IF NOT status.normal THEN
      output_line := 'The idle_pp request failed.';
      dpp$put_next_line (id, output_line, ignore_status);
      RETURN; {----->
    IFEND;

    output_line := 'The idle_pp request completed normally.';
    dpp$put_next_line (id, output_line, status);

    IF parameters [3].bool THEN
      output_line := 'The rma address of the dumped pp in memory is ';
      i#real_memory_address (pp_dump_seq_p, rma);
      syp$binary_to_ascii (rma, ascii_number, 16, 8);
      output_line (47, 8) := ascii_number;
      dpp$put_next_line (id, output_line, status);
    IFEND;

  PROCEND idle_pp;
?? TITLE := 'load_pp', EJECT ??

{ PURPOSE:
{   This procedure processes the command LOAD_PP.  It loads the desired PP.

  PROCEDURE load_pp
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 5] of syt$parameter_value,
      pp: dst$iou_resource;

    status.normal := TRUE;
    syp$crack_command (load_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pp.number := parameters [2].int;
    pp.iou_number := parameters [3].int;
    IF parameters [4].bool THEN
      pp.channel_protocol := dsc$cpt_cio;
    ELSE
      pp.channel_protocol := dsc$cpt_nio;
    IFEND;

    dsp$load_pp (dsc$load_pp_by_name, pp, NIL, parameters [1].name (1, 7), parameters [4].int, status);
    IF NOT status.normal THEN
      output_line := 'The load_pp request failed.';
    ELSE
      output_line := 'The load_pp request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND load_pp;
?? TITLE := 'resume_pp', EJECT ??

{ PURPOSE:
{   This procedure processes the command RESUME_PP.  It resumes the desired PP.

  PROCEDURE resume_pp
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 4] of syt$parameter_value,
      pp: dst$iou_resource;

    status.normal := TRUE;
    syp$crack_command (resume_pp_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pp.number := parameters [1].int;
    pp.iou_number := parameters [3].int;
    IF parameters [4].bool THEN
      pp.channel_protocol := dsc$cpt_cio;
    ELSE
      pp.channel_protocol := dsc$cpt_nio;
    IFEND;

    dsp$resume_pp (pp, parameters [2].int, status);
    IF NOT status.normal THEN
      output_line := 'The resume_pp request failed.';
    ELSE
      output_line := 'The resume_pp request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND resume_pp;
?? TITLE := 'return_channel', EJECT ??

{ PURPOSE:
{   This procedure processes the command RETURN_CHANNEL.  It returns the desired channel.

  PROCEDURE return_channel
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 3] of syt$parameter_value,
      request: dst$resource_request;

    status.normal := TRUE;
    syp$crack_command (channel_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    request.resource_request_type := dsc$rrt_return_channel;
    request.channel.number := parameters [1].int;
    request.channel.iou_number := parameters [2].int;
    IF parameters [3].bool THEN
      request.channel.channel_protocol := dsc$cpt_cio;
    ELSE
      request.channel.channel_protocol := dsc$cpt_nio;
    IFEND;

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The return_channel request failed.';
    ELSE
      output_line := 'The return_channel request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND return_channel;
?? TITLE := 'return_equipment', EJECT ??

{ PURPOSE:
{   This procedure processes the command RETURN_EQUIPMENT.  It returns the desired equipment.

  PROCEDURE return_equipment
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 5] of syt$parameter_value,
      request: dst$resource_request;

    status.normal := TRUE;
    syp$crack_command (path_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    request.resource_request_type := dsc$rrt_return_equipment;
    request.channel.number := parameters [1].int;
    request.channel.iou_number := parameters [4].int;
    IF parameters [5].bool THEN
      request.channel.channel_protocol := dsc$cpt_cio;
    ELSE
      request.channel.channel_protocol := dsc$cpt_nio;
    IFEND;
    request.equipment_number := parameters [2].int;
    request.unit_number := parameters [3].int;

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The return_equipment request failed.';
    ELSE
      output_line := 'The return_equipment request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND return_equipment;
?? TITLE := 'return_pp', EJECT ??

{ PURPOSE:
{   This procedure processes the command RETURN_PP.  It returns the desired PP.

  PROCEDURE return_pp
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 4] of syt$parameter_value,
      request: dst$resource_request;

    status.normal := TRUE;
    syp$crack_command (pp_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    request.resource_request_type := dsc$rrt_return_pp;
    request.primary_pp.number := parameters [1].int;
    request.primary_pp.iou_number := parameters [2].int;
    request.channel.number := 0;
    request.channel.iou_number := parameters [2].int;
    IF parameters [3].bool THEN
      request.primary_pp.channel_protocol := dsc$cpt_cio;
      request.channel.channel_protocol := dsc$cpt_cio;
    ELSE
      request.primary_pp.channel_protocol := dsc$cpt_nio;
      request.channel.channel_protocol := dsc$cpt_nio;
    IFEND;
    IF parameters [4].int < 30 THEN
      request.secondary_pp := request.primary_pp;
      request.secondary_pp.number := parameters [4].int;
      request.options := $dst$resource_request_options [dsc$rro_partner_pp];
    ELSE
      request.options := $dst$resource_request_options [];
    IFEND;

    dsp$request_resources (request, status);
    IF NOT status.normal THEN
      output_line := 'The return_pp request failed.';
    ELSE
      output_line := 'The return_pp request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND return_pp;
?? TITLE := 'write_time', EJECT ??

{ PURPOSE:
{   This procedure processes the command WRITE_TIME.  It writes the hardware clock.

  PROCEDURE write_time
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      date_time: ost$date_time,
      ignore_status: ost$status,
      output_line: output_line_type,
      parameters: array [1 .. 5] of syt$parameter_value;

    status.normal := TRUE;
    syp$crack_command (time_pdt, text, parameters, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    date_time.year := parameters [1].int;
    date_time.month := parameters [2].int;
    date_time.day := parameters [3].int;
    date_time.hour := parameters [4].int;
    date_time.minute := parameters [5].int;

    dsp$update_hardware_date_time (0, date_time, status);
    IF NOT status.normal THEN
      output_line := 'The write_time request failed.';
    ELSE
      output_line := 'The write_time request completed normally.';
    IFEND;
    dpp$put_next_line (id, output_line, ignore_status);

  PROCEND write_time;
?? TITLE := 'dsp$test_resource_request', EJECT ??

{ PURPOSE:
{   This procedure is the starting procedure for the utility.

  PROCEDURE [XDCL] dsp$test_resource_requests
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    status.normal := TRUE;
    dpp$put_next_line (id, 'Begin resource request testing utility', status);

    syp$process_core_commands (id, 'QUIT', ^command_table, status);

  PROCEND dsp$test_resource_requests;
MODEND dsm$test_resource_request_cmds;
