?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Deadstart : Resource Support for PPs' ??
MODULE dsm$load_ppu;

{ PURPOSE:
{   This module contains procedures that are used to support requests for IOU resources.
{ DESIGN:
{   The structures used in this module are protected by two interlocks.  The PP buffer
{   and the IOU resource table, both of which are in the SSR, must be interlocked each
{   time they are used to prevent two users from accessing the areas at the same time.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dse$error_codes
*copyc dst$dft_pp_registers
*copyc dst$driver_name
*copyc dst$iou_resource
*copyc dst$rb_logging_request
*copyc dst$resource_name
*copyc dst$resource_request
*copyc ost$hardware_subranges
*copyc ost$physical_pp_number
*copyc ost$pp_size
?? POP ??
*copyc clp$convert_integer_to_string
*copyc cmp$check_dual_pp_system_disk
*copyc cmp$update_dft_sci_location
*copyc dpp$put_critical_message
*copyc dsp$close_ssr
*copyc dsp$fetch_pp_image
*copyc dsp$get_data_from_ssr
*copyc dsp$get_ssr_data_seq_ptr
*copyc dsp$open_ssr
*copyc dsp$process_pp_function
*copyc dsp$read_cda_program
*copyc dsp$retrieve_iou_information
*copyc dsp$send_170_resource_request
*copyc dsp$store_data_in_ssr
*copyc i#move
*copyc osp$clear_mainframe_sig_lock
*copyc osp$initialize_signature_lock
*copyc osp$set_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc pmp$delay
?? EJECT ??
*copyc dsv$cpu_pp_communication_block
*copyc dsv$dftb_data
*copyc dsv$mainframe_type
*copyc osv$mainframe_wired_heap
*copyc osv$170_os_type
?? TITLE := 'Global Declarations Declared by This Module', EJECT ??
  TYPE
    t$pp_size_array = ARRAY [dst$iou_model_types] OF ARRAY [dst$channel_protocol_type] OF ost$pp_byte_size,

    { This table is used to keep track of the IOU resource availability.  If the first bit of table entry is
    { set then the channel or pp is owned by NOS/VE.  The channel number plus the NOS/VE owned resource bit
    { is placed in the channel or pp slot in the appropriate spot in the arrays.  This table is in the SSR
    { (VEPP).

    t$iou_resource_table_entry = 0 .. 0ff(16),

    t$iou_resource_table = ARRAY [0 .. *] OF
          ARRAY [dst$channel_protocol_type] OF
          ARRAY [dst$physical_resource_number] OF RECORD
            channel: t$iou_resource_table_entry,
            pp: t$iou_resource_table_entry,
          RECEND;
?? EJECT ??
  CONST

    { The S0 has two groups of PPs.  The first group contains PP0-PP4.  The second group contains PP20-PP24.
    { The I4C has four groups of PPs.  The first group contains PP0-PP4.  The second group contains PP5-PP11.
    { The third group contains PP20-PP24.  The fourth group contains PP25-PP31.

    c$first_set_first_pp = 0,
    c$first_set_pp_4 = 4,
    c$first_set_pp_5 = 5,
    c$first_set_last_pp = 11(8),

    c$second_set_first_pp = 20(8),
    c$second_set_pp_24 = 24(8),
    c$second_set_pp_25 = 25(8),
    c$second_set_last_pp = 31(8),

    c$number_of_pps_in_set = 12(8),
    c$number_of_pps_in_cio_set = 5,
    c$number_of_pps_in_s0_set = 5,

    { This constant is used to define a resource owned by NOS/VE.

    c$nosve_owned_resource = 80(16),

    { This constant is used to define a PP that is available in the IOU resource table.

    c$available_pp = 0,

    { PP sizes are in units of PP words (16 bits per PP word).

    c$pp_size_0k = 0,
    c$pp_size_4k = 4 * 1024,
    c$pp_size_8k = 8 * 1024,
    c$pp_size_16k = 16 * 1024;

  VAR
    v$dft_sci_location: cmt$sci_dft_pp,

    v$pp_size: [READ, STATIC] t$pp_size_array := [[c$pp_size_0k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_0k],
                                                  [c$pp_size_4k,  c$pp_size_8k],
                                                  [c$pp_size_4k,  c$pp_size_8k],
                                                  [c$pp_size_8k,  c$pp_size_8k],
                                                  [c$pp_size_8k,  c$pp_size_8k],
                                                  [c$pp_size_16k, c$pp_size_0k]],

    v$ssr_iou_resource_table_lock: ost$signature_lock,
    v$ssr_pp_buffer_interlock: ost$signature_lock;
?? TITLE := 'assign_any_pp', EJECT ??

{ PURPOSE:
{   This procedure searches for ANY available PP.  The search pattern depends on how many IOUs
{   are on the system and whether the IOUs contain NIO, CIO or both types of PPs.

  PROCEDURE assign_any_pp
    (    iou_resource_table_p: ^t$iou_resource_table;
     VAR primary_pp: dst$iou_resource;
     VAR pp_found: boolean;
     VAR status: ost$status);

    TYPE
      t$iou_data_type = ARRAY [dst$iou_number] OF RECORD
        exists: boolean,
        model_type: dst$iou_model_types,
        contains_channel_protocol: ARRAY [dst$channel_protocol_type] OF boolean,
      RECEND;

    VAR
      channel_protocol: dst$channel_protocol_type,
      ignore_partner: dst$iou_resource,
      iou_data: t$iou_data_type,
      iou_index: dst$number_of_ious,
      iou_information_table: dst$iou_information_table,
      iou_number: dst$iou_number,
      number_of_ious: dst$number_of_ious,
      pp: dst$iou_resource,
      request: dst$resource_request;

    status.normal := TRUE;
    pp_found := FALSE;

    { Create a list of available IOUs and whether the IOU has NIO and/or CIO PPs.
    { This list will be searched to find the available PP for the ANY PP request.

    FOR iou_number := LOWERBOUND (iou_data) TO UPPERBOUND (iou_data) DO
      iou_data [iou_number].exists := FALSE;
    FOREND;

    dsp$retrieve_iou_information (number_of_ious, iou_information_table);
    FOR iou_index := 1 TO number_of_ious DO
      iou_number := iou_information_table [iou_index].physical_iou_number;
      iou_data [iou_number].exists := TRUE;
      iou_data [iou_number].model_type := iou_information_table [iou_index].model_type;
      CASE iou_data [iou_number].model_type OF
      = dsc$imn_i4_40_model, dsc$imn_i4_42_model =
        iou_data [iou_number].contains_channel_protocol [dsc$cpt_nio] := TRUE;
        iou_data [iou_number].contains_channel_protocol [dsc$cpt_cio] := TRUE;
      = dsc$imn_i4_44_model, dsc$imn_i4_46_model =
        iou_data [iou_number].contains_channel_protocol [dsc$cpt_nio] := FALSE;
        iou_data [iou_number].contains_channel_protocol [dsc$cpt_cio] := TRUE;
      ELSE
        iou_data [iou_number].contains_channel_protocol [dsc$cpt_nio] := TRUE;
        iou_data [iou_number].contains_channel_protocol [dsc$cpt_cio] := FALSE;
      CASEND;
    FOREND;

    { The search begins with NIO PPs in the highest available IOU.  IF no PPs are available then the
    { next highest IOU is searched until no more IOUs exist.  If still no PP is available then the
    { search continues for CIO PPs in the highest available IOU and so on.

    FOR channel_protocol := LOWERVALUE (dst$channel_protocol_type) TO
          UPPERVALUE (dst$channel_protocol_type) DO
      FOR iou_number := UPPERVALUE (dst$iou_number) DOWNTO LOWERVALUE (dst$iou_number) DO
        IF (iou_data [iou_number].exists) AND
              (iou_data [iou_number].contains_channel_protocol [channel_protocol]) THEN
          pp.iou_number := iou_number;
          pp.channel_protocol := channel_protocol;
          pp.number := 15;
          IF (iou_number > 0) OR (osv$170_os_type = osc$ot7_none) OR
                (iou_data [iou_number].model_type = dsc$imn_i4_44_model) OR
                (iou_data [iou_number].model_type = dsc$imn_i4_46_model) THEN
            find_available_pp (LOWERVALUE (ost$physical_pp_number), UPPERVALUE (ost$physical_pp_number),
                  iou_resource_table_p, FALSE, pp, ignore_partner, pp_found);
            IF pp_found THEN
              primary_pp := pp;
              RETURN;
            IFEND;
          ELSE   {Send the request to the 170 side.
            request.channel := pp;
            request.resource_request_type := dsc$rrt_get_pp;
            request.options := $dst$resource_request_options [ ];
            request.primary_pp := pp;
            request.secondary_pp := pp;
            IF channel_protocol = dsc$cpt_cio THEN
              request.channel.number := 0;
              dsp$send_170_resource_request (request, status);
              IF NOT status.normal THEN
                request.channel.number := 5;
                dsp$send_170_resource_request (request, status);
              IFEND;
            ELSE
              dsp$send_170_resource_request (request, status);
            IFEND;
            IF status.normal THEN
              pp_found := TRUE;
              primary_pp := request.primary_pp;
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      FOREND;
    FOREND;

  PROCEND assign_any_pp;
?? TITLE := 'assign_cio_pp', EJECT ??

{ PURPOSE:
{   This procedure searches for a CIO PP.  CIO PPs must be retrieved from the same set that the
{   channel being used can access.  The PPs are searched from the lowest numbered PP to the highest
{   number PP in the set.

  PROCEDURE assign_cio_pp
    (    model_type: dst$iou_model_types;
         iou_resource_table_p: ^t$iou_resource_table;
     VAR request: dst$resource_request;
     VAR pp_found: boolean);

    VAR
      first_pp_number: ost$physical_pp_number,
      last_pp_found: boolean,
      last_pp_number: ost$physical_pp_number,
      partner_pp: dst$iou_resource,
      pp: dst$iou_resource;

    pp_found := FALSE;

    { Set up the PP number range to be searched for an available PP.

    IF dsc$rro_specific_pp IN request.options THEN
      first_pp_number := request.primary_pp.number;
      last_pp_number := first_pp_number;
    ELSE
      last_pp_found := FALSE;
      CASE model_TYPE OF
      = dsc$imn_i4_44_model =
        IF request.channel.number >= c$second_set_pp_25 THEN
          first_pp_number := c$second_set_pp_25;
        ELSEIF request.channel.number >= c$second_set_first_pp THEN
          first_pp_number := c$second_set_first_pp;
        ELSEIF request.channel.number >= c$first_set_pp_5 THEN
          first_pp_number := c$first_set_pp_5;
        ELSE
          first_pp_number := c$first_set_first_pp;
        IFEND;
      = dsc$imn_i4_46_model =
        IF request.channel.number >= 32(8) THEN
          first_pp_number := c$first_set_first_pp;
          last_pp_number := c$first_set_last_pp;
          last_pp_found := TRUE;
        ELSEIF request.channel.number >= c$second_set_pp_25 THEN
          first_pp_number := c$second_set_pp_25;
        ELSEIF request.channel.number >= c$second_set_first_pp THEN
          first_pp_number := c$second_set_first_pp;
        ELSEIF request.channel.number >= c$first_set_pp_5 THEN
          first_pp_number := c$first_set_pp_5;
        ELSE
          first_pp_number := c$first_set_first_pp;
        IFEND;
      = dsc$imn_i4_42_model =
        first_pp_number := c$first_set_first_pp;
        last_pp_number := c$first_set_pp_4;
        last_pp_found := TRUE;
      ELSE  { I4_40 }
        IF request.channel.number >= c$first_set_pp_5 THEN
          first_pp_number := c$first_set_pp_5;
        ELSE
          first_pp_number := c$first_set_first_pp;
        IFEND;
      CASEND;
      IF NOT last_pp_found THEN
        last_pp_number := first_pp_number + (c$number_of_pps_in_cio_set - 1);
      IFEND;
    IFEND;

    { Search the PP number range for an available PP.

    pp := request.primary_pp;
    partner_pp := request.secondary_pp;

    find_available_pp (first_pp_number, last_pp_number, iou_resource_table_p,
          (dsc$rro_partner_pp IN request.options), pp, partner_pp, pp_found);

    IF pp_found THEN
      request.primary_pp := pp;
      request.secondary_pp := partner_pp;
    IFEND;

  PROCEND assign_cio_pp;
?? TITLE := 'assign_nio_pp', EJECT ??

{ PURPOSE:
{   This procedure searches for a NIO PP.
{     search for SPECIFIC PP: Search for only the specified PP.
{     search for DRIVER PP:   Search PPs 20(8) - 31(8) If not found then search PPs 0 - 11(8).
{     search for PARTNER PPs: Search PPs 0(8) - 11(8) (The partner pp is then the corresponding
{                             pp in PPs 20 - 31(8) example: PP24(8) goes with PP4(8))  If not able
{                             to find a PP search for ANY two in PPs 0 - 31(8).
{     search for OTHER PP:    Search PPs 0 - 31(8)

  PROCEDURE assign_nio_pp
    (    iou_resource_table_p: ^t$iou_resource_table;
     VAR request: dst$resource_request;
     VAR pp_found: boolean);

    VAR
      first_pp_number: ost$physical_pp_number,
      ignore_pp: dst$iou_resource,
      last_pp_number: ost$physical_pp_number,
      partner_pp: dst$iou_resource,
      partner_pp_number: ost$physical_pp_number,
      pp: dst$iou_resource;

    pp_found := FALSE;

    pp := request.primary_pp;
    partner_pp := request.secondary_pp;

    IF dsc$rro_specific_pp IN request.options THEN
      find_available_pp (request.primary_pp.number, request.primary_pp.number, iou_resource_table_p,
            FALSE, pp, ignore_pp, pp_found);

    ELSEIF dsc$rro_partner_pp IN request.options THEN

      { First, an attempt is made to find a PP in the upper range and the corresponding PP in the lower range.

      first_pp_number := c$first_set_first_pp;
      last_pp_number := c$first_set_last_pp;
      pp_found := FALSE;

     /search_for_pps/
      WHILE NOT pp_found DO
        find_available_pp (first_pp_number, last_pp_number, iou_resource_table_p, FALSE, pp,
              ignore_pp, pp_found);
        IF NOT pp_found THEN
          EXIT /search_for_pps/;
        IFEND;

        partner_pp_number := pp.number + c$second_set_first_pp;
        find_available_pp (partner_pp_number, partner_pp_number, iou_resource_table_p, FALSE, partner_pp,
              ignore_pp, pp_found);
        IF pp_found THEN
          EXIT /search_for_pps/;
        IFEND;

        IF pp.number <> last_pp_number THEN
          first_pp_number := pp.number + 1;
        ELSE
          EXIT /search_for_pps/;
        IFEND;
      WHILEND /search_for_pps/;

      { Second, any two PPs are taken.

      IF NOT pp_found THEN
        find_available_pp (LOWERVALUE (ost$physical_pp_number), UPPERVALUE (ost$physical_pp_number),
              iou_resource_table_p, TRUE, pp, partner_pp, pp_found);
      IFEND;

    ELSEIF dsc$rro_driver_pp IN request.options THEN
      find_available_pp (c$second_set_first_pp, c$second_set_last_pp, iou_resource_table_p, FALSE,
            pp, ignore_pp, pp_found);

      IF NOT pp_found THEN
        find_available_pp (c$first_set_first_pp, c$first_set_last_pp, iou_resource_table_p, FALSE,
              pp, ignore_pp, pp_found);
      IFEND;

    ELSE  { request.options is a NULL set.
      find_available_pp (c$first_set_first_pp, c$second_set_last_pp, iou_resource_table_p, FALSE,
            pp, ignore_pp, pp_found);

    IFEND;

    IF pp_found THEN
      request.primary_pp := pp;
      request.secondary_pp := partner_pp;
    IFEND;

  PROCEND assign_nio_pp;
?? TITLE := 'assign_pp', EJECT ??

{ PURPOSE:
{   This procedure assigns a single or partner PP(s) to the requestor.

  PROCEDURE assign_pp
    (VAR request: dst$resource_request;
     VAR iou_resource_table_p: ^t$iou_resource_table;
     VAR status: ost$status);

    VAR
      integer_string: ost$string,
      model_type: dst$iou_model_types,
      pp_found: boolean,
      size: ost$string_size,
      text: string (osc$max_string_size);

    status.normal := TRUE;

    IF dsc$rro_any_pp IN request.options THEN
      assign_any_pp (iou_resource_table_p, request.primary_pp, pp_found, status);
    ELSE
      retrieve_iou_model_type (request.channel.iou_number, model_type, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      { Initialize the primary pp and the secondary pp with the channel data.  It is possible to have
      { NIO channels on an I4CE, however, make sure the PP channel protocol is CIO.

      IF NOT (dsc$rro_specific_pp IN request.options) THEN
        request.primary_pp := request.channel;
        request.secondary_pp := request.channel;
        IF model_type = dsc$imn_i4_46_model THEN
          request.primary_pp.channel_protocol := dsc$cpt_cio;
          request.secondary_pp.channel_protocol := dsc$cpt_cio;
        IFEND;
      IFEND;

      IF (osv$170_os_type = osc$ot7_none) OR (request.channel.iou_number > 0) OR
            (model_type = dsc$imn_i4_44_model) OR (model_type = dsc$imn_i4_46_model) THEN
        IF model_type = dsc$imn_i0_5x_model THEN
          assign_s0_pp (iou_resource_table_p, request, pp_found);
        ELSEIF (request.channel.channel_protocol = dsc$cpt_cio) OR (model_type = dsc$imn_i4_46_model) THEN
          assign_cio_pp (model_type, iou_resource_table_p, request, pp_found);
        ELSE
          assign_nio_pp (iou_resource_table_p, request, pp_found);
        IFEND;
      ELSE
        dsp$send_170_resource_request (request, status);
        pp_found := status.normal;
      IFEND;
    IFEND;

    IF NOT pp_found AND status.normal THEN
      text := ' ';
      size := 1;
      IF NOT (dsc$rro_any_pp IN request.options) THEN
        text (size, 30) := 'Unable to assign requested IOU ';
        size := size + 30;
        clp$convert_integer_to_string (request.primary_pp.iou_number, 10, FALSE, integer_string, status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        IF request.channel.channel_protocol = dsc$cpt_cio THEN
          text (size, 3) := 'CPP';
          size := size + 3;
        ELSE
          text (size, 2) := 'PP';
          size := size + 2;
        IFEND;
        IF dsc$rro_specific_pp IN request.options THEN
          clp$convert_integer_to_string (request.primary_pp.number, 10, FALSE, integer_string, status);
          text (size, integer_string.size) := integer_string.value (1, integer_string.size);
          size := size + integer_string.size;
          text (size, 1) := '.';
          size := size + 1;
        ELSE
          text (size, 3) := '.  ';
          size := size + 3;
        IFEND;
      IFEND;
      IF NOT (dsc$rro_specific_pp IN request.options) THEN
        text (size, 38) := 'There are no PPs available for NOS/VE.';
        size := size + 38;
      IFEND;
      osp$set_status_abnormal (dsc$display_processor_id, dse$pp_not_available_to_ve, text, status);
    IFEND;

  PROCEND assign_pp;
?? TITLE := 'assign_s0_pp', EJECT ??

{ PURPOSE:
{   This procedure searches for an S0 PP.  S0 PPs must be retrieved from the same set that the
{   channel being used can access.  If there are no PPs in the set desired then an attempt is
{   made to relocate DFT and/or SCI and try again.

  PROCEDURE assign_s0_pp
    (VAR iou_resource_table_p: ^t$iou_resource_table;
     VAR request: dst$resource_request;
     VAR pp_found: boolean);

    VAR
      dft_sci_relocated: boolean,
      first_pp_number: ost$physical_pp_number,
      last_pp_number: ost$physical_pp_number,
      partner_pp: dst$iou_resource,
      pp: dst$iou_resource;

    pp_found := FALSE;

    { Set up the PP number range to be searched for an available PP.

    IF dsc$rro_specific_pp IN request.options THEN
      first_pp_number := request.primary_pp.number;
      last_pp_number := first_pp_number;
    ELSE
      IF request.channel.number >= c$second_set_first_pp THEN
        first_pp_number := c$second_set_first_pp;
      ELSE
        first_pp_number := c$first_set_first_pp;
      IFEND;
      last_pp_number := first_pp_number + (c$number_of_pps_in_s0_set - 1);
    IFEND;

    { Search the PP number range for an available PP.

    pp := request.primary_pp;
    partner_pp := request.secondary_pp;
    REPEAT
      dft_sci_relocated := FALSE;
      find_available_pp (first_pp_number, last_pp_number, iou_resource_table_p,
            (dsc$rro_partner_pp IN request.options), pp, partner_pp, pp_found);
      IF NOT pp_found THEN
        relocate_dft_sci (request.channel, iou_resource_table_p, dft_sci_relocated);
      IFEND;
    UNTIL NOT dft_sci_relocated;

    IF pp_found THEN
      request.primary_pp := pp;
      request.secondary_pp := partner_pp;
    IFEND;

  PROCEND assign_s0_pp;
?? TITLE := 'check_channel_pp_number', EJECT ??

{ PURPOSE:
{   This procedure checks that the channel or PP number sent with the IOU resource request is valid.

  PROCEDURE check_channel_pp_number
    (    resource_type: (c$channel_resource, c$pp_resource);
         resource: dst$iou_resource;
     VAR status: ost$status);

    VAR
      last_pp_set_1: ost$physical_pp_number,
      last_pp_set_2: ost$physical_pp_number,
      model_type: dst$iou_model_types;

    status.normal := TRUE;

    retrieve_iou_model_type (resource.iou_number, model_type, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (model_type <> dsc$imn_i0_5x_model) AND (resource.channel_protocol <> dsc$cpt_cio) THEN
      RETURN;
    IFEND;

    IF model_type = dsc$imn_i0_5x_model THEN
      IF resource_type = c$channel_resource THEN
        last_pp_set_1 := c$first_set_pp_4 + 1;
        last_pp_set_2 := c$second_set_pp_24 + 1;
      ELSE
        last_pp_set_1 := c$first_set_pp_4;
        last_pp_set_2 := c$second_set_pp_24;
      IFEND;
      IF ((resource.number >= c$first_set_first_pp) AND (resource.number <= last_pp_set_1)) OR
            ((resource.number >= c$second_set_first_pp) AND (resource.number <= last_pp_set_2)) THEN
        RETURN;
      IFEND;
    IFEND;

    IF resource.channel_protocol = dsc$cpt_cio THEN
      IF (model_type = dsc$imn_i4_44_model) OR (model_type = dsc$imn_i4_46_model) THEN
        IF ((resource.number >= c$first_set_first_pp) AND (resource.number <= c$first_set_last_pp)) OR
              ((resource.number >= c$second_set_first_pp) AND (resource.number <= c$second_set_last_pp)) THEN
          RETURN;
        IFEND;
      ELSE
        IF ((resource.number >= c$first_set_first_pp) AND (resource.number <= c$first_set_last_pp)) THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    IF resource_type = c$channel_resource THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$invalid_number,
            'The channel number is invalid.', status);
    ELSE
      osp$set_status_abnormal (dsc$display_processor_id, dse$invalid_number,
            'The pp number is invalid.', status);
    IFEND;

  PROCEND check_channel_pp_number;
?? TITLE := 'check_for_assigned_pp', EJECT ??

{ PURPOSE:
{   This procedure checks to see if the given PP is assigned to VE.

  PROCEDURE check_for_assigned_pp
    (    pp: dst$iou_resource;
     VAR status: ost$status);

    VAR
      integer_string: ost$string,
      iou_information_table: dst$iou_information_table,
      number_of_ious: dst$number_of_ious,
      iou_resource_table_p: ^t$iou_resource_table,
      iou_resource_table_seq_p: ^SEQ ( * ),
      size: ost$string_size,
      text: string (osc$max_string_size);

    status.normal := TRUE;

    osp$set_mainframe_sig_lock (v$ssr_iou_resource_table_lock);
    dsp$retrieve_iou_information (number_of_ious, iou_information_table);

    PUSH iou_resource_table_p: [0 .. (number_of_ious - 1)];
    iou_resource_table_seq_p := #SEQ (iou_resource_table_p^);
    dsp$get_data_from_ssr (dsc$ssr_resource_assignment, iou_resource_table_seq_p);
    IF iou_resource_table_p^ [pp.iou_number] [pp.channel_protocol] [pp.number].pp <
          c$nosve_owned_resource THEN
      text := 'IOU ';
      size := 4;
      clp$convert_integer_to_string (pp.iou_number, 10, FALSE, integer_string, status);
      text (size, integer_string.size) := integer_string.value (1, integer_string.size);
      size := size + integer_string.size + 1;
      IF pp.channel_protocol = dsc$cpt_cio THEN
        text (size, 5) := ' CPP ';
        size := size + 5;
      ELSE
        text (size, 4) := ' PP ';
        size := size + 4;
      IFEND;
      clp$convert_integer_to_string (pp.number, 10, TRUE, integer_string, status);
      text (size, integer_string.size) := integer_string.value (1, integer_string.size);
      size := size + integer_string.size + 1;
      text (size, 37) := ' is not currently assigned to NOS/VE.';
      size := size + 37;
      osp$set_status_abnormal (dsc$display_processor_id,
            dse$pp_not_assigned_to_ve, text (1, size), status);
    IFEND;
    osp$clear_mainframe_sig_lock (v$ssr_iou_resource_table_lock);

  PROCEND check_for_assigned_pp;
?? TITLE := 'check_for_partner_pps', EJECT ??

{ PURPOSE:
{   This procedure checks to see if the given PP and possibly a partner PP is assigned to VE.

  PROCEDURE check_for_partner_pps
    (    pp: dst$iou_resource;
     VAR status: ost$status);

    VAR
      partner_pp: dst$iou_resource,
      partner_pp_exists: boolean;

    status.normal := TRUE;

    check_for_assigned_pp (pp, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { If the PP is the system device PP then it must be checked to see if it has a partner PP.  If the system
    { device has a partner PP then that partner PP must be checked to see if it is assigned to NOS/VE.

    cmp$check_dual_pp_system_disk (pp, partner_pp_exists, partner_pp);
    IF partner_pp_exists THEN
      check_for_assigned_pp (partner_pp, status);
    IFEND;

  PROCEND check_for_partner_pps;
?? TITLE := 'check_for_valid_request', EJECT ??

{ PURPOSE:
{   This procedure checks the validity of the IOU resource request.

  PROCEDURE check_for_valid_request
    (    request: dst$resource_request;
         iou_resource_table_p: ^t$iou_resource_table;
     VAR status: ost$status);

    VAR
      condition_code: ost$status_condition_code,
      integer_string: ost$string,
      channel_pp_number: t$iou_resource_table_entry,
      options: dst$resource_request_options,
      partner_pp_number: t$iou_resource_table_entry,
      size: ost$string_size,
      text: string (osc$max_string_size),
      unused_status: ost$status;

    status.normal := TRUE;
    text (1, *) := ' ';
    size := 1;

    { Check the validity of the IOU number that is associated with the channel.

    check_iou_number (request.channel.iou_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE request.resource_request_type OF
    = dsc$rrt_get_pp =
      options := request.options;
      IF dsc$rro_driver_pp IN options THEN
        options := options - $dst$resource_request_options [dsc$rro_driver_pp];
      ELSEIF dsc$rro_partner_pp IN options THEN
        options := options - $dst$resource_request_options [dsc$rro_partner_pp];
      ELSEIF dsc$rro_specific_pp IN options THEN
        options := options - $dst$resource_request_options [dsc$rro_specific_pp];
      ELSEIF dsc$rro_any_pp IN options THEN
        options := options - $dst$resource_request_options [dsc$rro_any_pp];
      IFEND;
      IF options <> $dst$resource_request_options [ ] THEN
        osp$set_status_abnormal (dsc$display_processor_id, dse$invalid_request_options, '', status);
        RETURN;
      IFEND;
      IF dsc$rro_specific_pp IN request.options THEN
        check_iou_number (request.primary_pp.iou_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        check_channel_pp_number (c$pp_resource, request.primary_pp, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    = dsc$rrt_return_pp =
      check_iou_number (request.primary_pp.iou_number, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      channel_pp_number := iou_resource_table_p^ [request.primary_pp.iou_number]
            [request.primary_pp.channel_protocol] [request.primary_pp.number].pp;

      IF dsc$rro_partner_pp IN request.options THEN
        check_iou_number (request.secondary_pp.iou_number, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        partner_pp_number := iou_resource_table_p^ [request.secondary_pp.iou_number]
              [request.secondary_pp.channel_protocol] [request.secondary_pp.number].pp;
      IFEND;

      IF (channel_pp_number < c$nosve_owned_resource) OR ((dsc$rro_partner_pp IN request.options) AND
            (partner_pp_number < c$nosve_owned_resource)) THEN
        text (size, 18) := 'Cannot return IOU ';
        size := size + 18;
        clp$convert_integer_to_string (request.primary_pp.iou_number, 10, FALSE, integer_string, status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        IF request.primary_pp.channel_protocol = dsc$cpt_cio THEN
          text (size, 5) := ' CPP ';
          size := size + 5;
        ELSE
          text (size, 4) := ' PP ';
          size := size + 4;
        IFEND;
        IF channel_pp_number < c$nosve_owned_resource THEN
          clp$convert_integer_to_string (request.primary_pp.number, 10,
                TRUE, integer_string, unused_status);
          text (size, integer_string.size) := integer_string.value (1, integer_string.size);
          size := size + integer_string.size + 1;
          text (size, 12) := '(Primary PP)';
          size := size + 12;
        ELSE
          clp$convert_integer_to_string (request.secondary_pp.number, 10,
                TRUE, integer_string, unused_status);
          text (size, integer_string.size) := integer_string.value (1, integer_string.size);
          size := size + integer_string.size + 1;
          text (size, 12) := '(Partner PP)';
          size := size + 12;
        IFEND;
        text (size, 42) := '.  It is not currently assigned to NOS/VE.';
        size := size + 42;
        osp$set_status_abnormal (dsc$display_processor_id,
              dse$cannot_return_resource, text (1, size), status);
        RETURN;
      IFEND;

    = dsc$rrt_get_channel =
      check_channel_pp_number (c$channel_resource, request.channel, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      channel_pp_number := iou_resource_table_p^ [request.channel.iou_number]
            [request.channel.channel_protocol] [request.channel.number].channel;
      IF channel_pp_number > 0 THEN
        text (size, 4) := 'IOU ';
        size := size + 4;
        clp$convert_integer_to_string (request.channel.iou_number, 10, FALSE, integer_string, status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        IF request.channel.channel_protocol = dsc$cpt_cio THEN
          text (size, 5) := ' CCH ';
          size := size + 5;
        ELSE
          text (size, 4) := ' CH ';
          size := size + 4;
        IFEND;
        clp$convert_integer_to_string (request.channel.number, 10,
              TRUE, integer_string, unused_status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        IF channel_pp_number < c$nosve_owned_resource THEN
          condition_code := dse$ch_not_available_to_ve;
          text (size, 38) := ' is not currently available to NOS/VE.';
          size := size + 38;
        ELSE
          condition_code := dse$ch_assigned_to_ve;
          text (size, 33) := ' is currently assigned to NOS/VE.';
          size := size + 33;
        IFEND;
        osp$set_status_abnormal (dsc$display_processor_id, condition_code, text (1, size), status);
        RETURN;
      IFEND;

    = dsc$rrt_return_channel =
      IF iou_resource_table_p^ [request.channel.iou_number] [request.channel.channel_protocol]
            [request.channel.number].channel < c$nosve_owned_resource THEN
        text (size, 18) := 'Cannot return IOU ';
        size := size + 18;
        clp$convert_integer_to_string (request.channel.iou_number, 10, FALSE, integer_string, status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        IF request.channel.channel_protocol = dsc$cpt_cio THEN
          text (size, 5) := ' CCH ';
          size := size + 5;
        ELSE
          text (size, 4) := ' CH ';
          size := size + 4;
        IFEND;
        clp$convert_integer_to_string (request.channel.number, 10,
              TRUE, integer_string, unused_status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        text (size, 42) := '.  It is not currently assigned to NOS/VE.';
        size := size + 42;
        osp$set_status_abnormal (dsc$display_processor_id,
              dse$cannot_return_resource, text (1, size), status);
        RETURN;
      IFEND;

    = dsc$rrt_get_equipment =
      channel_pp_number := iou_resource_table_p^ [request.channel.iou_number]
            [request.channel.channel_protocol] [request.channel.number].channel;
      IF (channel_pp_number < c$nosve_owned_resource) AND (channel_pp_number > 0) THEN
        text (size, 36) := 'Cannot get requested equipment, IOU ';
        size := size + 36;
        clp$convert_integer_to_string (request.channel.iou_number, 10, FALSE, integer_string, status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        IF request.channel.channel_protocol = dsc$cpt_cio THEN
          text (size, 5) := ' CCH ';
          size := size + 5;
        ELSE
          text (size, 4) := ' CH ';
          size := size + 4;
        IFEND;
        clp$convert_integer_to_string (request.channel.number, 10,
              TRUE, integer_string, unused_status);
        text (size, integer_string.size) := integer_string.value (1, integer_string.size);
        size := size + integer_string.size + 1;
        text (size, 38) := ' is not currently available to NOS/VE.';
        size := size + 38;
        osp$set_status_abnormal (dsc$display_processor_id,
              dse$eq_not_available_to_ve, text (1, size), status);
        RETURN;
      IFEND;

    ELSE
    CASEND;

  PROCEND check_for_valid_request;
?? TITLE := 'check_iou_number', EJECT ??

{ PURPOSE:
{   This procedure checks that the IOU number sent with the IOU resource request is valid.

  PROCEDURE check_iou_number
    (    iou_number: dst$iou_number;
     VAR status: ost$status);

    VAR
      iou_index: dst$number_of_ious,
      iou_information_table: dst$iou_information_table,
      number_of_ious: dst$number_of_ious;

    status.normal := TRUE;

    dsp$retrieve_iou_information (number_of_ious, iou_information_table);
    FOR iou_index := 1 TO number_of_ious DO
      IF iou_number = iou_information_table [iou_index].physical_iou_number THEN
        RETURN;
      IFEND;
    FOREND;
    osp$set_status_abnormal (dsc$display_processor_id, dse$invalid_number,
          'The IOU number is invalid.', status);

  PROCEND check_iou_number;
?? TITLE := 'find_available_pp', EJECT ??

{ PURPOSE:
{   This procedure searches the IOU resource table for an available PP.

  PROCEDURE find_available_pp
    (    first_pp_number: ost$physical_pp_number;
         last_pp_number: ost$physical_pp_number;
         iou_resource_table_p: ^t$iou_resource_table;
         search_for_partner_pp: boolean;
     VAR pp: dst$iou_resource;
     VAR partner_pp: dst$iou_resource;
     VAR pp_found: boolean);

    VAR
      partner_pp_number: ost$physical_pp_number,
      pp_number: ost$physical_pp_number;

    pp_found := FALSE;

   /search_for_pp/
    FOR pp_number := first_pp_number TO last_pp_number DO
      IF iou_resource_table_p^ [pp.iou_number] [pp.channel_protocol] [pp_number].pp = c$available_pp THEN
        pp.number := pp_number;
        pp_found := TRUE;
        EXIT /search_for_pp/;
      IFEND;
    FOREND /search_for_pp/;

    IF NOT pp_found OR NOT search_for_partner_pp THEN
      RETURN;
    IFEND;

    { Search for a partner PP.

    pp_found := FALSE;
    IF pp.number <> last_pp_number THEN
      FOR partner_pp_number := (pp.number + 1) TO last_pp_number DO
        IF iou_resource_table_p^ [partner_pp.iou_number] [partner_pp.channel_protocol]
              [partner_pp_number].pp = c$available_pp THEN
          partner_pp.number := partner_pp_number;
          pp_found := TRUE;
          RETURN;
        IFEND;
      FOREND;
    IFEND;

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

{ PURPOSE:
{   This procedure idles the given PP.  Available options are to dump the PP which includes
{   the PP registers or dump only the PP registers or only idle the PP.

  PROCEDURE idle_pp
    (    subfunction: dst$dft_puf_subfunctions;
         pp: dst$iou_resource;
         ssr_segment_number: ost$segment;
     VAR dump_area_p: ^SEQ (*);
     VAR status: ost$status);

    VAR
      dump_data_seq_p: ^SEQ ( * ),
      lock_set: boolean,
      model_type: dst$iou_model_types,
      pp_length: ost$pp_byte_size,
      ssr_data_seq_p: ^SEQ ( * ),
      ssr_ppbf_seq_p: ^SEQ ( * );

    status.normal := TRUE;
    pp_length := 0;
    ssr_ppbf_seq_p := NIL;
    lock_set := FALSE;

  /pp_idle/
    BEGIN

      CASE subfunction OF
      = dsc$dpuf_idle_dump_pp, dsc$dpuf_idle_dump_registers =
        IF dump_area_p = NIL THEN
          osp$set_status_abnormal (dsc$display_processor_id, dse$nil_caller_ptr, '', status);
          EXIT /pp_idle/;
        IFEND;

        IF subfunction = dsc$dpuf_idle_dump_pp THEN
          retrieve_iou_model_type (pp.iou_number, model_type, status);
          IF NOT status.normal THEN
            EXIT /pp_idle/;
          IFEND;
          pp_length := v$pp_size [model_type] [pp.channel_protocol] * 2;
        ELSE
          pp_length := #SIZE (dst$dft_pp_registers);
        IFEND;

        osp$set_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
        lock_set := TRUE;
        dsp$get_ssr_data_seq_ptr (dsc$ssr_pp_controlware_buf, ssr_segment_number, ssr_ppbf_seq_p);
        IF #SEGMENT (dump_area_p) = #SEGMENT (ssr_ppbf_seq_p) THEN
          osp$set_status_abnormal (dsc$display_processor_id, dse$cant_store_pp_in_ssr, '', status);
          EXIT /pp_idle/;
        IFEND;
      ELSE
      CASEND;

      { Make the request to idle the PP.

      dsp$process_pp_function (subfunction, pp, 0, pp_length, ssr_ppbf_seq_p, status);
      IF NOT status.normal OR (subfunction = dsc$dpuf_idle_pp) THEN
        EXIT /pp_idle/;
      IFEND;

      { Move the dumped PP information from the SSR to the caller's area.

      RESET dump_area_p;
      NEXT dump_data_seq_p: [[REP pp_length OF cell]] IN dump_area_p;
      RESET ssr_ppbf_seq_p;
      NEXT ssr_data_seq_p: [[REP pp_length OF cell]] IN ssr_ppbf_seq_p;
      dump_data_seq_p^ := ssr_data_seq_p^;
      RESET dump_area_p;
    END /pp_idle/;

    IF lock_set THEN
      osp$clear_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
    IFEND;

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

{ PURPOSE:
{   This procedure attempts to relocate DFT or SCI on an S0.

  PROCEDURE relocate_dft_sci
    (VAR channel: dst$iou_resource;
     VAR iou_resource_table_p: ^t$iou_resource_table;
     VAR dft_sci_relocated: boolean);

    CONST
      c$first_cluster = 0,
      c$second_cluster = 2;

    VAR
      current_dft_cluster: c$first_cluster .. c$second_cluster,
      current_sci_cluster: c$first_cluster .. c$second_cluster,
      first_pp_number: ost$physical_pp_number,
      ignore_partner: dst$iou_resource,
      ignore_status: ost$status,
      last_pp_number: ost$physical_pp_number,
      old_pp_number: ost$physical_pp_number,
      pp: dst$iou_resource,
      pp_found: boolean,
      requested_cluster: c$first_cluster .. c$second_cluster;

    dft_sci_relocated := FALSE;

    { Find the number of the cluster in which DFT and SCI reside.

    IF dsv$cpu_pp_communication_block.relocation.dft_pp_number < c$second_set_first_pp THEN
      current_dft_cluster := c$first_cluster;
    ELSE
      current_dft_cluster := c$second_cluster;
    IFEND;
    IF dsv$cpu_pp_communication_block.relocation.sci_pp_number < c$second_set_first_pp THEN
      current_sci_cluster := c$first_cluster;
    ELSE
      current_sci_cluster := c$second_cluster;
    IFEND;

    { Set up search parameters for a free PP in the cluster NOT requested.

    IF channel.number >= c$second_set_first_pp THEN
      requested_cluster := c$second_cluster;
      first_pp_number := c$first_set_first_pp;
    ELSE
      requested_cluster := c$first_cluster;
      first_pp_number := c$second_set_first_pp;
    IFEND;
    last_pp_number := first_pp_number + (c$number_of_pps_in_s0_set - 1);

    { Check if DFT or SCI resides in the requested cluster.

    IF (requested_cluster <> current_dft_cluster) AND (requested_cluster <> current_sci_cluster) THEN
      RETURN;
    IFEND;

    { Attempt to find a free PP in the non-requested cluster in which to move DFT or SCI.  If the requested
    { cluster is the first cluster then SCI will be the first PP selected to be moved to the second cluster.
    { If the requested cluster is the second cluster then DFT will be the first PP selected to be moved
    { to the first cluster.  The goal is to keep DFT in the first cluster as much as possible.  DFT can only
    { access the common disk area from the first cluster.

    pp := channel;
    find_available_pp (first_pp_number, last_pp_number, iou_resource_table_p, FALSE, pp,
          ignore_partner, pp_found);
    IF NOT pp_found THEN
      RETURN;
    IFEND;

    IF requested_cluster = c$first_cluster THEN
      IF requested_cluster = current_sci_cluster THEN
        old_pp_number := dsv$cpu_pp_communication_block.relocation.sci_pp_number;
        dsv$cpu_pp_communication_block.relocation.sci_pp_number := pp.number;
        dsv$cpu_pp_communication_block.relocation.sci_idle_pending := TRUE;
        REPEAT
          #spoil (dsv$cpu_pp_communication_block);
          pmp$delay (250, ignore_status);
        UNTIL NOT dsv$cpu_pp_communication_block.relocation.sci_idle_pending;
        dpp$put_critical_message ('SCI RELOCATED', ignore_status);
      ELSE  { requested_cluster = current_dft_cluster }
        old_pp_number := dsv$cpu_pp_communication_block.relocation.dft_pp_number;
        dsv$cpu_pp_communication_block.relocation.dft_pp_number := pp.number;
        dsv$cpu_pp_communication_block.relocation.dft_idle_pending := TRUE;
        REPEAT
          #spoil (dsv$cpu_pp_communication_block);
          pmp$delay (250, ignore_status);
        UNTIL NOT dsv$cpu_pp_communication_block.relocation.dft_idle_pending;
        dpp$put_critical_message ('DFT RELOCATED', ignore_status);
      IFEND;
    ELSE  { requested_cluster = c$second_cluster }
      IF requested_cluster = current_dft_cluster THEN
        old_pp_number := dsv$cpu_pp_communication_block.relocation.dft_pp_number;
        dsv$cpu_pp_communication_block.relocation.dft_pp_number := pp.number;
        dsv$cpu_pp_communication_block.relocation.dft_idle_pending := TRUE;
        REPEAT
          #spoil (dsv$cpu_pp_communication_block);
          pmp$delay (250, ignore_status);
        UNTIL NOT dsv$cpu_pp_communication_block.relocation.dft_idle_pending;
        dpp$put_critical_message ('DFT RELOCATED', ignore_status);
      ELSE  { requested_cluster = current_sci_cluster }
        old_pp_number := dsv$cpu_pp_communication_block.relocation.sci_pp_number;
        dsv$cpu_pp_communication_block.relocation.sci_pp_number := pp.number;
        dsv$cpu_pp_communication_block.relocation.sci_idle_pending := TRUE;
        REPEAT
          #spoil (dsv$cpu_pp_communication_block);
          pmp$delay (250, ignore_status);
        UNTIL NOT dsv$cpu_pp_communication_block.relocation.sci_idle_pending;
        dpp$put_critical_message ('SCI RELOCATED', ignore_status);
      IFEND;
    IFEND;

    { Change the resource assignment table in the SSR to reflect the PP change.

    iou_resource_table_p^ [pp.iou_number] [pp.channel_protocol] [pp.number].pp :=
          iou_resource_table_p^ [pp.iou_number] [pp.channel_protocol] [old_pp_number].pp;
    iou_resource_table_p^ [pp.iou_number] [pp.channel_protocol] [old_pp_number].pp := 0;
    dsp$store_data_in_ssr (dsc$ssr_resource_assignment, #SEQ (iou_resource_table_p^));

    { Notify CM about the PP change.

    v$dft_sci_location.primary_dft_pp.number := dsv$cpu_pp_communication_block.relocation.dft_pp_number;
    v$dft_sci_location.sci_pp.number := dsv$cpu_pp_communication_block.relocation.sci_pp_number;
    cmp$update_dft_sci_location (v$dft_sci_location);

    dft_sci_relocated := TRUE;

  PROCEND relocate_dft_sci;
?? TITLE := 'retrieve_iou_model_type', EJECT ??

{ PURPOSE:
{   This procedure retrieves the IOU model type.

  PROCEDURE retrieve_iou_model_type
    (    iou_number: dst$iou_number;
     VAR model_type: dst$iou_model_types;
     VAR status: ost$status);

    VAR
      iou_index: dst$number_of_ious,
      iou_information_table: dst$iou_information_table,
      number_of_ious: dst$number_of_ious;

    status.normal := TRUE;

    dsp$retrieve_iou_information (number_of_ious, iou_information_table);
    FOR iou_index := 1 TO number_of_ious DO
      IF iou_number = iou_information_table [iou_index].physical_iou_number THEN
        model_type := iou_information_table [iou_index].model_type;
        RETURN;
      IFEND;
    FOREND;
    osp$set_status_abnormal (dsc$display_processor_id, dse$invalid_number,
          'The IOU number is invalid.', status);

  PROCEND retrieve_iou_model_type;
?? TITLE := 'dsp$fetch_controlware', EJECT ??

{ PURPOSE:
{   This procedure retrieves the controlware from the CIP device.
{ NOTES:
{   The caller must specify a NIL pointer for the controlware.  Space will be allocated
{   in the mainframe wired heap to hold the controlware.  The caller has the responsibility
{   to free the space when the caller is finished using the space.

  PROCEDURE [XDCL] dsp$fetch_controlware
    (    controlware_name: dst$resource_name;
     VAR controlware_seq_p: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      controlware_length: integer,
      ssr_controlware_data_p: ^SEQ ( * ),
      ssr_ppbf_seq_p: ^SEQ ( * ),
      ssr_segment_number: ost$segment,
      unused_status: ost$status;

    status.normal := TRUE;

    { The caller must send a NIL pointer.  Space for this pointer will be allocated in the mainframe
    { wired heap.

    IF controlware_seq_p <> NIL THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$nil_caller_ptr, '', status);
      RETURN;
    IFEND;

    { Add the SSR to the caller's segment table.

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$set_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
    dsp$get_ssr_data_seq_ptr (dsc$ssr_pp_controlware_buf, ssr_segment_number, ssr_ppbf_seq_p);

  /fetch_controlware/
    BEGIN

      { Retrieve the controlware from the CIP device.

      dsp$read_cda_program (controlware_name, ssr_ppbf_seq_p, controlware_length, status);
      IF NOT status.normal THEN
        EXIT /fetch_controlware/;
      IFEND;

      { Move the controlware from PPBF in the SSR to the mainframe wired heap.

      ALLOCATE controlware_seq_p: [[REP controlware_length OF cell]] IN osv$mainframe_wired_heap^;
      RESET controlware_seq_p;
      RESET ssr_ppbf_seq_p;
      NEXT ssr_controlware_data_p: [[REP controlware_length OF cell]] IN ssr_ppbf_seq_p;
      RESET ssr_controlware_data_p;
      controlware_seq_p^ := ssr_controlware_data_p^;
    END /fetch_controlware/;

    osp$clear_mainframe_sig_lock (v$ssr_pp_buffer_interlock );
    dsp$close_ssr (ssr_segment_number, unused_status);

  PROCEND dsp$fetch_controlware;
?? TITLE := 'dsp$get_pp_registers', EJECT ??

{ PURPOSE:
{   This procedure retrieves the PP registers of a specific PP.

  PROCEDURE [XDCL] dsp$get_pp_registers
    (    pp: dst$iou_resource;
     VAR registers: dst$dft_pp_registers;
     VAR status: ost$status);

    VAR
      registers_p: ^dst$dft_pp_registers,
      registers_size: ost$pp_byte_size,
      ssr_ppbf_seq_p: ^SEQ ( * ),
      ssr_segment_number: ost$segment,
      unused_status: ost$status;

    status.normal := TRUE;

    { Check for a valid IOU number.

    check_iou_number (pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Add the SSR to the caller's segment table.

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Lock and use the PP controlware buffer in the SSR to retrieve the PP registers.

    osp$set_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
    dsp$get_ssr_data_seq_ptr (dsc$ssr_pp_controlware_buf, ssr_segment_number, ssr_ppbf_seq_p);

  /get_pp_registers/
    BEGIN

      { Check the resource assignment table in the SSR to see if the PP is indeed assigned to NOS/VE.

      check_for_assigned_pp (pp, status);
      IF NOT status.normal THEN
        EXIT /get_pp_registers/;
      IFEND;

      registers_size := #SIZE (registers);
      dsp$process_pp_function (dsc$dpuf_dump_pp_registers, pp, 0, registers_size, ssr_ppbf_seq_p, status);
      IF NOT status.normal THEN
        EXIT /get_pp_registers/;
      IFEND;

      RESET ssr_ppbf_seq_p;
      NEXT registers_p IN ssr_ppbf_seq_p;
      registers := registers_p^;
    END /get_pp_registers/;

    osp$clear_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
    dsp$close_ssr (ssr_segment_number, unused_status);

  PROCEND dsp$get_pp_registers;
?? TITLE := 'dsp$idle_pp', EJECT ??

{ PURPOSE:
{   This procedure idles the given PP.  Available options are to dump the PP which includes
{   the PP registers or dump only the PP registers or only idle the PP.

  PROCEDURE [XDCL] dsp$idle_pp
    (    pp: dst$iou_resource;
         dump_registers_only: boolean;
         dump_pp: boolean;
     VAR dump_area_p: ^SEQ (*);
     VAR status: ost$status);

    VAR
      ssr_segment_number: ost$segment,
      subfunction: dst$dft_puf_subfunctions,
      unused_status: ost$status;

    status.normal := TRUE;

    { Check for a valid IOU number.

    check_iou_number (pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Add the SSR to the caller's segment table.

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /pp_idle/
    BEGIN

      { Check the resource assignment table in the SSR to see if the PP is indeed assigned to NOS/VE.

      check_for_assigned_pp (pp, status);
      IF NOT status.normal THEN
        EXIT /pp_idle/;
      IFEND;

      IF dump_pp THEN
        subfunction := dsc$dpuf_idle_dump_pp;
      ELSEIF dump_registers_only THEN
        subfunction := dsc$dpuf_idle_dump_registers;
      ELSE
        subfunction := dsc$dpuf_idle_pp;
      IFEND;

      idle_pp (subfunction, pp, ssr_segment_number, dump_area_p, status);
    END /pp_idle/;

    dsp$close_ssr (ssr_segment_number, unused_status);

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

{ PURPOSE:
{   This procedure loads a PP image into a PP.
{ DESIGN:
{   The actual PP image may be sent to the procedure OR the PP name may be sent to the
{   procedure in which case the PP image is acquired from the PP library.

  PROCEDURE [XDCL] dsp$load_pp
    (    type_of_pp_load: (dsc$load_pp_image, dsc$load_pp_by_name);
         pp: dst$iou_resource;
         image_p: ^SEQ ( * );
         name: dst$driver_name;
         table_rma: ost$real_memory_address;
     VAR status: ost$status);

    VAR
      pp_length: ost$pp_byte_size,
      ssr_pp_image_p: ^ARRAY [ost$pp_size] OF ost$pp_byte_size,
      ssr_ppbf_seq_p: ^SEQ ( * ),
      ssr_segment_number: ost$segment,
      unused_status: ost$status;

    status.normal := TRUE;

    { Check for a valid IOU number.

    check_iou_number (pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Add the SSR to the caller's segment table.

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Lock and use the PP controlware buffer in the SSR to hold the PP image.

    osp$set_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
    dsp$get_ssr_data_seq_ptr (dsc$ssr_pp_controlware_buf, ssr_segment_number, ssr_ppbf_seq_p);

  /load_pp/
    BEGIN

      { Check the resource assignment table in the SSR to see if the PP(s) is/are indeed assigned to NOS/VE.

      check_for_partner_pps (pp, status);
      IF NOT status.normal THEN
        EXIT /load_pp/;
      IFEND;

      { Move the PP image to the SSR area.

      CASE type_of_pp_load OF
      = dsc$load_pp_image =
        IF #SEGMENT (image_p) = #SEGMENT (ssr_ppbf_seq_p) THEN
          osp$set_status_abnormal (dsc$display_processor_id, dse$cant_store_pp_in_ssr, '', status);
        ELSE
          pp_length := #SIZE (image_p^);
          i#move (image_p, ssr_ppbf_seq_p, pp_length);
        IFEND;
      = dsc$load_pp_by_name =
        dsp$fetch_pp_image (name, dsc$fpio_fetch_base_overlay, pp_length, ssr_ppbf_seq_p, status);
      ELSE
      CASEND;
      IF NOT status.normal THEN
        EXIT /load_pp/;
      IFEND;

      { The words 72(8) and 73(8) of the PP image must contain the RMA to the PP interface table.  This
      { allows the PP to access various things in this table.

      RESET ssr_ppbf_seq_p;
      NEXT ssr_pp_image_p IN ssr_ppbf_seq_p;
      ssr_pp_image_p^ [72(8)] := table_rma DIV 10000(16);
      ssr_pp_image_p^ [73(8)] := table_rma MOD 10000(16);
      RESET ssr_ppbf_seq_p;

      { Make the request to load the PP.

      dsp$process_pp_function (dsc$dpuf_load_pp, pp, 0, pp_length, ssr_ppbf_seq_p, status);
      IF NOT status.normal THEN
        EXIT /load_pp/;
      IFEND;

      { Wait for the pp to read the program.

      pmp$delay (1000, status);
    END /load_pp/;

    osp$clear_mainframe_sig_lock (v$ssr_pp_buffer_interlock);
    dsp$close_ssr (ssr_segment_number, unused_status);

  PROCEND dsp$load_pp;
?? TITLE := 'dsp$request_resources', EJECT ??

{ PURPOSE:
{   This procedure directs the resource requests from the system.  It attempts to get or return
{   the requested resource.  If the request fails, an appropriate message is returned.
{ DESIGN:
{   A request to DFT is made to obtain the resource in standalone mode or for requests for
{   an IOU other then IOU0 or for requests to an I4C.  Otherwise, the request is made to the
{   170 operating system.

  PROCEDURE [XDCL] dsp$request_resources
    (VAR request: dst$resource_request;
     VAR status: ost$status);

    VAR
      iou_information_table: dst$iou_information_table,
      iou_resource_table_p: ^t$iou_resource_table,
      iou_resource_table_seq_p: ^SEQ ( * ),
      model_type: dst$iou_model_types,
      no_dump_p: ^SEQ ( * ),
      number_of_ious: dst$number_of_ious,
      ssr_segment_number: ost$segment,
      unused_status: ost$status;

    status.normal := TRUE;

    { Add the SSR to the caller's segment table.

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Get a pointer to the resource assignment area in the SSR.

    osp$set_mainframe_sig_lock (v$ssr_iou_resource_table_lock);
    dsp$retrieve_iou_information (number_of_ious, iou_information_table);
    PUSH iou_resource_table_p: [0 .. (number_of_ious - 1)];
    iou_resource_table_seq_p := #SEQ (iou_resource_table_p^);
    dsp$get_data_from_ssr (dsc$ssr_resource_assignment, iou_resource_table_seq_p);

  /request_resources/
    BEGIN

      { Check the validity of the request.

      check_for_valid_request (request, iou_resource_table_p, status);
      IF NOT status.normal THEN
        EXIT /request_resources/;
      IFEND;

      CASE request.resource_request_type OF
      = dsc$rrt_get_pp =
        assign_pp (request, iou_resource_table_p, status);
        IF NOT status.normal THEN
          EXIT /request_resources/;
        IFEND;
      ELSE

        { If returning the PP, attempt to idle the PP.

        IF request.resource_request_type = dsc$rrt_return_pp THEN
          no_dump_p := NIL;
          idle_pp (dsc$dpuf_idle_pp, request.primary_pp, ssr_segment_number, no_dump_p, status);
          IF (dsc$rro_partner_pp IN request.options) THEN
            idle_pp (dsc$dpuf_idle_pp, request.secondary_pp, ssr_segment_number, no_dump_p, status);
          IFEND;
        IFEND;

        { Make the request to the appropriate operating system.

        retrieve_iou_model_type (request.channel.iou_number, model_type, status);
        IF NOT status.normal THEN
          EXIT /request_resources/;
        IFEND;
        IF (request.channel.iou_number = 0) AND (osv$170_os_type <> osc$ot7_none) AND
              (model_type <> dsc$imn_i4_44_model) AND (model_type <> dsc$imn_i4_46_model) THEN
          dsp$send_170_resource_request (request, status);
          IF NOT status.normal THEN
            IF status.condition = dse$resource_does_not_exist THEN

              { Attempted to request/release an equipment that is not defined in the EST.  If it is not
              { defined in the EST then it is assumed that NOS/VE can safely use the equipment, just
              { request/release the channel.

              CASE request.resource_request_type OF
              = dsc$rrt_get_equipment =
                request.resource_request_type := dsc$rrt_get_channel;
                dsp$send_170_resource_request (request, status);
                request.resource_request_type := dsc$rrt_get_equipment;
              = dsc$rrt_return_equipment =
                request.resource_request_type := dsc$rrt_return_channel;
                dsp$send_170_resource_request (request, status);
                request.resource_request_type := dsc$rrt_return_equipment;
              ELSE
              CASEND;
            IFEND;
            IF NOT status.normal THEN
              EXIT /request_resources/;
            IFEND;
          IFEND;
        IFEND;
      CASEND;

      { Update the resource assignment table in the SSR.

      CASE request.resource_request_type OF
      = dsc$rrt_get_pp =
        iou_resource_table_p^ [request.primary_pp.iou_number] [request.primary_pp.channel_protocol]
              [request.primary_pp.number].pp := request.channel.number + c$nosve_owned_resource;
        IF (dsc$rro_partner_pp IN request.options) THEN
          iou_resource_table_p^ [request.secondary_pp.iou_number] [request.secondary_pp.channel_protocol]
                [request.secondary_pp.number].pp := request.channel.number + c$nosve_owned_resource;
        IFEND;

      = dsc$rrt_return_pp =
        iou_resource_table_p^ [request.primary_pp.iou_number] [request.primary_pp.channel_protocol]
              [request.primary_pp.number].pp := 0;
        IF (dsc$rro_partner_pp IN request.options) THEN
          iou_resource_table_p^ [request.primary_pp.iou_number] [request.secondary_pp.channel_protocol]
                [request.secondary_pp.number].pp := 0;
        IFEND;

      = dsc$rrt_get_channel =
        iou_resource_table_p^ [request.channel.iou_number] [request.channel.channel_protocol]
              [request.channel.number].channel := request.channel.number + c$nosve_owned_resource;

      = dsc$rrt_return_channel =
        iou_resource_table_p^ [request.channel.iou_number] [request.channel.channel_protocol]
              [request.channel.number].channel := 0;

      = dsc$rrt_get_equipment =
        iou_resource_table_p^ [request.channel.iou_number] [request.channel.channel_protocol]
              [request.channel.number].channel := request.channel.number + c$nosve_owned_resource;

      ELSE
      CASEND;
      dsp$store_data_in_ssr (dsc$ssr_resource_assignment, #SEQ (iou_resource_table_p^));
    END /request_resources/;

    osp$clear_mainframe_sig_lock (v$ssr_iou_resource_table_lock);
    dsp$close_ssr (ssr_segment_number, unused_status);

  PROCEND dsp$request_resources;
?? TITLE := 'dsp$resume_pp', EJECT ??

{ PURPOSE:
{   This procedure resumes the given PP at the given address minus one.

  PROCEDURE [XDCL] dsp$resume_pp
    (    pp: dst$iou_resource;
         resume_address: dst$dft_resume_address;
     VAR status: ost$status);

    VAR
      actual_resume_address: dst$dft_resume_address,
      model_type: dst$iou_model_types,
      ssr_segment_number: ost$segment,
      unused_pp_data_seq_p: ^SEQ ( * ),
      unused_pp_length: ost$pp_byte_size,
      unused_status: ost$status;

    status.normal := TRUE;

    { Check for a valid IOU number.

    check_iou_number (pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Check for a valid resume address.

    IF resume_address <= 1 THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$resume_address_too_small, '', status);
      RETURN;
    IFEND;

    retrieve_iou_model_type (pp.iou_number, model_type, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF resume_address > v$pp_size [model_type] [pp.channel_protocol] THEN
      osp$set_status_abnormal (dsc$display_processor_id, dse$resume_address_too_large, '', status);
      RETURN;
    IFEND;

    { The actual resume address sent to DFT is the resume address minus one.

    actual_resume_address := resume_address - 1;

    { Add the SSR to the caller's segment table and interlock the SSR from other user jobs.

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /resume_pp/
    BEGIN

      { Check the resource assignment table in the SSR to see if the PP is indeed assigned to NOS/VE.

      check_for_assigned_pp (pp, status);
      IF NOT status.normal THEN
        EXIT /resume_pp/;
      IFEND;

      unused_pp_length := 0;
      unused_pp_data_seq_p := NIL;
      dsp$process_pp_function (dsc$dpuf_resume_pp, pp, actual_resume_address, unused_pp_length,
            unused_pp_data_seq_p, status);
    END /resume_pp/;

    dsp$close_ssr (ssr_segment_number, unused_status);

  PROCEND dsp$resume_pp;
?? TITLE := 'dsp$setup_load_ppu_interlocks', EJECT ??

{ PURPOSE:
{   This procedure is called to initialize interlocks that this module uses.

  PROCEDURE [XDCL] dsp$setup_load_ppu_interlocks;

    VAR
      dfts_buffer: dst$ssr_dfts_buffer,
      dfts_buffer_seq_p: ^SEQ ( * ),
      dfts_control_word: dst$dftb_control_word,
      local_status: ost$status,
      model_type: dst$iou_model_types,
      rb: dst$rb_logging_request;

    osp$initialize_signature_lock (v$ssr_pp_buffer_interlock, local_status);
    IF NOT local_status.normal THEN
      osp$system_error (' Error in setting the PPBF interlock.', ^local_status);
    IFEND;

    osp$initialize_signature_lock (v$ssr_iou_resource_table_lock, local_status);
    IF NOT local_status.normal THEN
      osp$system_error (' Error in setting the VEPP interlock.', ^local_status);
    IFEND;

    { Inform CM in which PPs DFT, SCI, and the secondary DFT reside.

    IF NOT dsv$cpu_pp_communication_block.relocation.initialized THEN
      osp$system_error ('The DFT_SCI_relocation_word is not initialized', NIL);
    IFEND;

    retrieve_iou_model_type (0, model_type, local_status);
    IF NOT local_status.normal THEN
      osp$system_error ('Error in retrieving IOU model type', ^local_status);
    IFEND;

    v$dft_sci_location.sci_pp.iou_number := 0;
    v$dft_sci_location.sci_pp.number := dsv$cpu_pp_communication_block.relocation.sci_pp_number;

    IF (model_type = dsc$imn_i4_44_model) OR (model_type = dsc$imn_i4_46_model) THEN
      v$dft_sci_location.sci_pp.channel_protocol := dsc$cpt_cio;
    ELSE
      v$dft_sci_location.sci_pp.channel_protocol := dsc$cpt_nio;
    IFEND;

    IF dsv$mainframe_type <> dsc$mt_2000_mainframe THEN
      v$dft_sci_location.primary_dft_available := TRUE;
      v$dft_sci_location.primary_dft_pp.iou_number := 0;
      v$dft_sci_location.primary_dft_pp.number := dsv$cpu_pp_communication_block.relocation.dft_pp_number;
      IF (model_type = dsc$imn_i4_44_model) OR (model_type = dsc$imn_i4_46_model) THEN
        v$dft_sci_location.primary_dft_pp.channel_protocol := dsc$cpt_cio;
      ELSE
        v$dft_sci_location.primary_dft_pp.channel_protocol := dsc$cpt_nio;
      IFEND;
    ELSE
      v$dft_sci_location.primary_dft_pp.iou_number := 0;
      v$dft_sci_location.primary_dft_pp.channel_protocol := dsc$cpt_nio;
      v$dft_sci_location.primary_dft_pp.number := 0;
    IFEND;

    IF dsv$dftb_data.revision_level <= dsc$dftb_revision_level_5 THEN
      dfts_buffer_seq_p := #SEQ (dfts_buffer);
      dsp$get_data_from_ssr (dsc$ssr_secondary_dft_block, dfts_buffer_seq_p);
      dfts_control_word := dfts_buffer.control_word;
      v$dft_sci_location.secondary_dft_available := dfts_control_word.dft_verification;
    ELSE
      rb.reqcode := syc$rc_logging_request;
      rb.action := dsc$rla_dft_retrieve_dfts_cw;
      i#call_monitor (#LOC (rb), #SIZE (rb));
      dfts_control_word := rb.dftb_dfts_control_word;
      v$dft_sci_location.secondary_dft_available := dfts_control_word.dft_verification;
    IFEND;
    IF v$dft_sci_location.secondary_dft_available THEN
      retrieve_iou_model_type (1, model_type, local_status);
      IF NOT local_status.normal THEN
        osp$system_error ('Error in retrieving IOU model type', ^local_status);
      IFEND;
      v$dft_sci_location.secondary_dft_pp.iou_number := 1;
      v$dft_sci_location.secondary_dft_pp.number := dfts_control_word.dft_pp_number;
      IF (model_type = dsc$imn_i4_44_model) OR (model_type = dsc$imn_i4_46_model) THEN
        v$dft_sci_location.secondary_dft_pp.channel_protocol := dsc$cpt_cio;
      ELSE
        v$dft_sci_location.secondary_dft_pp.channel_protocol := dsc$cpt_nio;
      IFEND;
    ELSE
      v$dft_sci_location.secondary_dft_pp.iou_number := 0;
      v$dft_sci_location.secondary_dft_pp.channel_protocol := dsc$cpt_nio;
      v$dft_sci_location.secondary_dft_pp.number := 0;
    IFEND;

    cmp$update_dft_sci_location (v$dft_sci_location);

  PROCEND dsp$setup_load_ppu_interlocks;
MODEND dsm$load_ppu;
