?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE CM : Manage Element Reservation' ??
MODULE cmm$manage_element_reservation;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains interfaces that allow system reservation and access of elements.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$task_private
*copyc rmc$manual_tape_maintenance
*copyc rmd$volume_declarations
*copyc cme$logical_configuration_mgr
*copyc cme$physical_configuration_mgr
*copyc cme$reserve_element
*copyc dme$tape_errors
*copyc mse$request_maintenance_access
*copyc cmt$element_definition
*copyc cmt$element_descriptor
*copyc cmt$element_name
*copyc cmt$element_reservation
*copyc cmt$pp_memory_length
*copyc cmt$pp_program_description
*copyc cmt$pp_registers
*copyc dmt$message_element
*copyc dst$dft_pp_registers
*copyc dst$iou_number
*copyc dst$iou_resource
*copyc fst$wait_for_attachment
*copyc iot$pp_number
*copyc ost$string
?? POP ??
*copyc clp$convert_integer_to_string
*copyc clp$trimmed_string_size
*copyc cmp$acquire_resources
*copyc cmp$build_pp_table_entry
*copyc cmp$clear_channel_interlock
*copyc cmp$clear_element_lock
*copyc cmp$clear_unit_shared
*copyc cmp$convert_channel_number
*copyc cmp$convert_channel_ordinal
*copyc cmp$convert_iou_name
*copyc cmp$convert_iou_number
*copyc cmp$convert_pp_number
*copyc cmp$convert_pp_ordinal
*copyc cmp$deadstart_pp
*copyc cmp$format_error_message
*copyc cmp$free_pp_request
*copyc cmp$get_channel_definition
*copyc cmp$get_element_definition
*copyc cmp$get_element_name
*copyc cmp$get_iou_definition
*copyc cmp$get_logical_unit_number
*copyc cmp$get_pp_reg
*copyc cmp$hardware_idle_pp
*copyc cmp$hardware_resume_pp
*copyc cmp$mark_element_reserved
*copyc cmp$mark_pp_element_reserved
*copyc cmp$pc_get_element
*copyc cmp$pp_queue_lock
*copyc cmp$release_channel_resource
*copyc cmp$release_pp_by_index
*copyc cmp$release_pp_resource
*copyc cmp$search_peripheral_table
*copyc cmp$search_pp_table
*copyc cmp$send_pp_command
*copyc cmp$set_element_lock
*copyc cmp$unmark_element_reserved
*copyc cmp$unmark_pp_element_reserved
*copyc cmp$unmark_pp_when_cleanup
*copyc cmp$unmark_when_cleanup
*copyc dsp$retrieve_iou_information
*copyc mmp$create_user_segment
*copyc msp$delete_con_access_gtid
*copyc msp$delete_con_access_job
*copyc msp$search_con_access_job
*copyc msp$search_element_con_accessed
*copyc ofp$format_operator_menu
*copyc osp$append_status_parameter
*copyc osp$establish_condition_handler
*copyc osp$is_caller_system_privileged
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$continue_to_cause
*copyc pmp$get_executing_task_gtid
*copyc pmp$get_job_names
*copyc pmp$get_mainframe_id
*copyc pmp$long_term_wait
*copyc pmp$wait
*copyc pmp$zero_out_table
*copyc rmp$assign_tape_unit
*copyc rmp$release_tape_unit
*copyc cmv$element_reservation_lock
*copyc cmv$logical_pp_table_p
*copyc cmv$logical_unit_table
*copyc cmv$peripheral_element_table
*copyc gfv$null_sfid
*copyc msv$con_access_gtid_list
*if $true(osv$debug_code)
  VAR
    cmv$free_trap: [XREF] boolean;
*ifend
*if $true(osv$ff_debug_code)
*copyc dpp$put_critical_message
*ifend
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

{cmv$task_reserved_element_count counts the number of elements or maintenance access
{that a particular task has requested. cmp$task_termination_cleanup has to be called,
{at task termination, when it's count is over 0.

  VAR
    cmv$task_reserved_element_count: [XDCL, oss$task_private] integer := 0;

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

  PROCEDURE release_channel_resource
    (    element_descriptor: cmt$element_descriptor;
     VAR status: ost$status);

    VAR
      channel_definition: cmt$data_channel_definition,
      channel: cmt$physical_channel,
      iou_number: dst$iou_number;

    status.normal := TRUE;

    IF element_descriptor.element_type <> cmc$data_channel_element THEN
      RETURN; {----->
    IFEND;

    cmp$get_channel_definition (element_descriptor.channel_descriptor, channel_definition, status);
    IF NOT status.normal AND (status.condition <> cme$lcm_element_not_found) THEN
      RETURN; {----->
    IFEND;

    channel.number := channel_definition.number;
    channel.concurrent := channel_definition.concurrent;
    channel.port := channel_definition.port;
    cmp$convert_iou_name (channel_definition.iou, iou_number, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    cmp$release_channel_resource (channel, iou_number, status);

  PROCEND release_channel_resource;
?? OLDTITLE ??
?? NEWTITLE := 'RELEASE_PP_ELEMENT', EJECT ??

{ PURPOSE:
{   This procedure releases a physical PP and releases a slot in the Logical PP Table.

  PROCEDURE release_pp_element
    (    job_name: jmt$system_supplied_name;
         system_caller: boolean;
         mainframe_id: pmt$mainframe_id;
         number_of_ious: dst$number_of_ious;
         iou_information_table: dst$iou_information_table;
         element_reservation: cmt$element_reservation;
     VAR status: ost$status);

    VAR
      found: boolean,
      len: integer,
      local_status: ost$status,
      physical_pp: dst$iou_resource,
      pp_index: iot$pp_number,
      pp_memory_size: cmt$pp_memory_length,
      pp_number: string (13),
      pp_registers: cmt$pp_registers,
      pp_software_idled: boolean;

*if $true(osv$ff_debug_code)
    VAR
      i: integer,
      str: string (80);
*ifend

    status.normal := TRUE;
    cmp$convert_pp_ordinal (element_reservation.pp_reservation.acquired_pp_identification.ordinal,
          physical_pp);

    IF number_of_ious = 1 THEN
      physical_pp.iou_number := iou_information_table [1].physical_iou_number;
    ELSE
      cmp$convert_iou_name (element_reservation.pp_reservation.acquired_pp_identification.iou,
            physical_pp.iou_number, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    cmp$search_pp_table (physical_pp, pp_index, found, local_status);
    IF NOT found THEN
      IF physical_pp.channel_protocol = dsc$cpt_cio THEN
        STRINGREP (pp_number, len, 'IOU', physical_pp.iou_number: 2, ' CPP', physical_pp.number: 3, 'search');
      ELSE
        STRINGREP (pp_number, len, 'IOU', physical_pp.iou_number: 2, ' PP', physical_pp.number: 3, 'search');
      IFEND;
      osp$set_status_abnormal (cmc$configuration_management_id, cme$element_not_reserved, pp_number (1, len),
            status);
      RETURN; {----->
    IFEND;

*if $true(osv$ff_debug_code)
    STRINGREP (str, i, 'Release PP: ', 'IOU', physical_pp.iou_number: 2, ' PP', physical_pp.number: 3);
    dpp$put_critical_message (str (1, i), local_status);
*ifend
{ Free all outstanding requests on the PP queue.
    cmp$free_pp_request (pp_index);

    cmp$release_pp_by_index (pp_index, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{ Clear all channel interlocks held by PP.
    cmp$clear_channel_interlock (physical_pp.iou_number, pp_index, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

*if $true(osv$ff_debug_code)
    STRINGREP (str, i, 'Unmark PP - Index: ', pp_index, ' Job: ', job_name);
    dpp$put_critical_message (str (1, i), local_status);
*ifend
    cmp$unmark_pp_element_reserved (job_name, system_caller, pp_index, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

*if $true(osv$ff_debug_code)
    IF cmv$task_reserved_element_count < 1 THEN
      STRINGREP (str, i, 'cmv$task_reserved_element_count underrun by ', job_name);
      dpp$put_critical_message (str (1, i), local_status);
      cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
    IFEND;

    cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
    STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
    dpp$put_critical_message (str (1, i), local_status);
*else
    IF cmv$task_reserved_element_count > 0 THEN
      cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
    IFEND;
*ifend

  PROCEND release_pp_element;
?? OLDTITLE ??
?? NEWTITLE := 'reserve_element_handler', EJECT ??

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

    VAR
      ignore_status: ost$status;

    handler_status.normal := TRUE;

    cmp$clear_element_lock (ignore_status);

    pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

  PROCEND reserve_element_handler;
?? OLDTITLE ??
?? NEWTITLE := 'RESERVE_PP_ELEMENT', EJECT ??

{ PURPOSE:
{   This procedure retrieves a physical PP and reserves a slot in the Logical PP Table.

  PROCEDURE reserve_pp_element
    (    gtid: ost$global_task_id;
         job_name: jmt$system_supplied_name;
         system_caller: boolean;
         mainframe_id: pmt$mainframe_id;
         number_of_ious: dst$number_of_ious;
         iou_information_table: dst$iou_information_table;
     VAR element_reservation: cmt$element_reservation;
     VAR status: ost$status);

    VAR
      channel_name: cmt$element_name,
      channel: cmt$physical_channel,
      channel_present: boolean,
      dummy_channel: cmt$physical_channel,
      element_entry: integer,
      found: boolean,
      ignore_status: ost$status,
      iou_number: dst$iou_number,
      len: integer,
      mark_channel: boolean,
      physical_pp: dst$iou_resource,
      pp_index: iot$pp_number,
      pp_number: string (13);
*if $true(osv$ff_debug_code)

    VAR
      i: integer,
      local_status: ost$status,
      str: string (80);
*ifend

    status.normal := TRUE;
    mark_channel := FALSE;
    dummy_channel.number := 15;
    dummy_channel.port := cmc$unspecified_port;
    dummy_channel.concurrent := FALSE;
    channel_present := FALSE;

    CASE element_reservation.pp_reservation.selector OF
    = cmc$choose_any_pp =

{ Procedure cmp$acquire_resources will decide in which IOU to request the PP.
      cmp$acquire_resources (dsc$rrt_get_pp, dummy_channel, 0, 0, 0, FALSE, FALSE, FALSE, physical_pp,
            status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    = cmc$choose_pp_by_channel =
      channel_present := TRUE;

{ Only use the user passed in IOU if the system has more than 1 IOU.
      IF number_of_ious = 1 THEN
        iou_number := iou_information_table [1].physical_iou_number;
      ELSE
        cmp$convert_iou_name (element_reservation.pp_reservation.channel.iou, iou_number, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

      cmp$convert_channel_ordinal (element_reservation.pp_reservation.channel.ordinal, channel_name,
            channel.number, channel.concurrent, channel.port, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

{ Find the channel entry in the peripheral element table.
      FOR element_entry := LOWERBOUND (cmv$peripheral_element_table.pointer^)
            TO UPPERBOUND (cmv$peripheral_element_table.pointer^) DO
        mark_channel := FALSE;
        IF cmv$peripheral_element_table.pointer^ [element_entry].element_name = channel_name THEN
          IF cmv$peripheral_element_table.pointer^ [element_entry].gtid <> gtid THEN
            mark_channel := TRUE;

            cmp$acquire_resources (dsc$rrt_get_channel, channel, iou_number, 0, 0, FALSE, FALSE, FALSE,
                  physical_pp, status);

            IF status.normal AND mark_channel THEN
              cmp$mark_element_reserved (element_reservation, FALSE, job_name, gtid, physical_pp,
                    element_entry, FALSE, status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
              cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
*if $true(osv$ff_debug_code)
              STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
              dpp$put_critical_message (str (1, i), local_status);
*ifend
            IFEND;
          IFEND;
        IFEND;
      FOREND;

{go acquire the pp.
      cmp$acquire_resources (dsc$rrt_get_pp, channel, iou_number, 0, 0, FALSE, FALSE, TRUE, physical_pp,
            status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    = cmc$choose_specific_pp =
      cmp$convert_pp_ordinal (element_reservation.pp_reservation.desired_pp.ordinal, physical_pp);

      { Only use the user passed in IOU if the system has more than 1 IOU.

      IF number_of_ious = 1 THEN
        physical_pp.iou_number := iou_information_table [1].physical_iou_number;
      ELSE
        cmp$convert_iou_name (element_reservation.pp_reservation.desired_pp.iou, physical_pp.iou_number,
              status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

      cmp$search_pp_table (physical_pp, pp_index, found, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      IF found THEN
        IF physical_pp.channel_protocol = dsc$cpt_cio THEN
          STRINGREP (pp_number, len, 'IOU', physical_pp.iou_number: 2, ' CPP', physical_pp.number: 3);
        ELSE
          STRINGREP (pp_number, len, 'IOU', physical_pp.iou_number: 2, ' PP', physical_pp.number: 3);
        IFEND;
        osp$set_status_abnormal (cmc$configuration_management_id, cme$element_already_reserved,
              pp_number (1, len), status);
        IF cmv$logical_pp_table_p^ [pp_index].flags.entry_reserved_by_nosve THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, 'NOS/VE', status);
        ELSE
          IF cmv$logical_pp_table_p^ [pp_index].task_info.reserved_job_name = job_name THEN
            osp$append_status_parameter (osc$status_parameter_delimiter, 'this job', status);
          ELSE
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  cmv$logical_pp_table_p^ [pp_index].task_info.reserved_job_name, status);
          IFEND;
        IFEND;
        RETURN; {----->
      IFEND;
      cmp$acquire_resources (dsc$rrt_get_pp, dummy_channel, 0, 0, 0, FALSE, TRUE, FALSE, physical_pp, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    = cmc$choose_pp_by_barrel =

{ Procedure cmp$acquire_resources will decide in which IOU to request the PP.
      cmp$acquire_resources (dsc$rrt_get_pp, dummy_channel, 0, 0, 0,
            element_reservation.pp_reservation.driver_barrel, FALSE, FALSE, physical_pp, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    ELSE
    CASEND;

  /pp_acquired/
    BEGIN
      cmp$mark_pp_element_reserved (element_reservation, system_caller, job_name, gtid, physical_pp,
            channel_present, pp_index, status);
      IF NOT status.normal THEN
        EXIT /pp_acquired/; {----->
      IFEND;

      cmp$convert_pp_number (physical_pp, element_reservation.pp_reservation.acquired_pp_identification.
            ordinal);
      cmp$convert_iou_number (physical_pp.iou_number, element_reservation.pp_reservation.
            acquired_pp_identification.iou, status);
      IF status.normal THEN
        cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
*if $true(osv$ff_debug_code)
        STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
        dpp$put_critical_message (str (1, i), local_status);
*ifend
      ELSE
        cmp$unmark_pp_element_reserved (job_name, system_caller, pp_index, ignore_status);
      IFEND;
    END /pp_acquired/;

    IF NOT status.normal THEN
      cmp$release_pp_resource (physical_pp, ignore_status);
    IFEND;

  PROCEND reserve_pp_element;
?? OLDTITLE ??
?? NEWTITLE := 'search_connected_elements', EJECT ??

  PROCEDURE search_connected_elements
    (    channel: cmt$data_channel_definition;
         channel_name: cmt$element_name;
     VAR status: ost$status);

    VAR
      channel_element_p: ^cmt$element_definition,
      channel_element_name: cmt$element_name,
      element_descriptor: cmt$element_descriptor,
      element_reservation: cmt$element_reservation,
      error_string: string (64),
      found: boolean,
      index: integer,
      local_status: ost$status,
      number_string: ost$string,
      outer_loop: 1 .. 3,
      outer_loop_index: 1 .. 3,
      peripheral_index: integer,
      string_length: integer,
      second_name: cmt$element_name,
      third_name: cmt$element_name;

    status.normal := TRUE;
    found := FALSE;
    second_name := ' ';
    third_name := ' ';

    IF channel.concurrent THEN

      { If a CIO channel is being reserved, the connections to all three possible names of the channel must
      { all be OFF.

      clp$convert_integer_to_string (channel.number, 10, FALSE, number_string, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      IF channel.port = cmc$port_a THEN
        STRINGREP (second_name, string_length, 'CCH', number_string.value (1, number_string.size));
        STRINGREP (third_name, string_length, 'CCH', number_string.value (1, number_string.size), 'B');
      ELSEIF channel.port = cmc$port_b THEN
        STRINGREP (second_name, string_length, 'CCH', number_string.value (1, number_string.size));
        STRINGREP (third_name, string_length, 'CCH', number_string.value (1, number_string.size), 'A');
      ELSE
        STRINGREP (second_name, string_length, 'CCH', number_string.value (1, number_string.size), 'A');
        STRINGREP (third_name, string_length, 'CCH', number_string.value (1, number_string.size), 'B');
      IFEND;
      outer_loop_index := 3;
    ELSE
      outer_loop_index := 1;
    IFEND;

  /outer_for_loop/
    FOR outer_loop := 1 TO outer_loop_index DO

      CASE outer_loop OF
      = 1 =
        channel_element_name := channel_name;
      = 2 =
        channel_element_name := second_name;
      = 3 =
        channel_element_name := third_name;
      ELSE
      CASEND;

      cmp$pc_get_element (channel_element_name, channel.iou, channel_element_p, local_status);
      IF NOT local_status.normal THEN
        CYCLE /outer_for_loop/; {----->
      IFEND;

    /for_loop/
      FOR index := LOWERVALUE (cmt$physical_equipment_number) TO UPPERVALUE (cmt$physical_equipment_number) DO
        IF channel_element_p^.data_channel.connection.equipment [index].configured THEN
          element_descriptor.element_type := cmc$controller_element;
          element_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
          element_descriptor.peripheral_descriptor.element_name :=
                channel_element_p^.data_channel.connection.equipment [index].element_name;

          cmp$search_peripheral_table (element_descriptor, element_reservation, FALSE, peripheral_index,
                status);
          IF NOT status.normal THEN
            EXIT /for_loop/; {----->
          IFEND;
          IF cmv$peripheral_element_table.pointer^ [peripheral_index].element_status.state <> cmc$off THEN
            found := TRUE;
            EXIT /for_loop/; {----->
          IFEND;
        IFEND;
      FOREND /for_loop/;

      IF found THEN
        error_string := ' ';
        error_string (1, 6) := channel.iou;
        error_string (7, * ) := channel_name;
        osp$set_status_abnormal (cmc$configuration_management_id, cme$element_downline_connected,
              error_string, status);
        EXIT /outer_for_loop/; {----->
      IFEND;

    FOREND /outer_for_loop/;

  PROCEND search_connected_elements;
?? OLDTITLE ??
?? NEWTITLE := 'validate_pp_reserved', EJECT ??

{ PURPOSE:
{   This procedure validates the PP parameters passed through CM program interfaces, and makes sure that the
{   PP is properly reserved by the same job via CMP$RESERVE_ELEMENT.  If the test passes then the logical PP
{   which is the index to logical PP table is returned.

  PROCEDURE validate_pp_reserved
    (    system_caller: boolean;
         job_name: jmt$system_supplied_name;
         pp: dst$iou_resource;
         iou: string (5);
     VAR pp_index: iot$pp_number;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      index: iot$pp_number,
      integer_string: ost$string,
      text: string (64);

    status.normal := TRUE;

    FOR index := LOWERBOUND (cmv$logical_pp_table_p^) TO UPPERBOUND (cmv$logical_pp_table_p^) DO
      IF cmv$logical_pp_table_p^ [index].pp_info.physical_pp = pp THEN
        IF (cmv$logical_pp_table_p^ [index].flags.entry_reserved_by_other AND
              (cmv$logical_pp_table_p^ [index].task_info.reserved_job_name = job_name)) OR
              (cmv$logical_pp_table_p^ [index].flags.entry_reserved_by_system_job AND system_caller) THEN
          pp_index := index;
          RETURN; {----->
        IFEND;
      IFEND;
    FOREND;

    text := ' ';
    text (1, 5) := iou;
    clp$convert_integer_to_string (pp.number, 10, FALSE, integer_string, ignore_status);
    IF pp.channel_protocol = dsc$cpt_cio THEN
      text (6, 3) := 'CPP';
      text (9, * ) := integer_string.value (1, integer_string.size);
    ELSE
      text (6, 2) := 'PP';
      text (8, * ) := integer_string.value (1, integer_string.size);
    IFEND;
    osp$set_status_abnormal (cmc$configuration_management_id, cme$element_not_reserved, text, status);

  PROCEND validate_pp_reserved;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$execute_pp_program', EJECT ??
*copyc cmh$execute_pp_program

  PROCEDURE [XDCL, #GATE] cmp$execute_pp_program
    (VAR program_description: array [1 .. * ] of cmt$pp_program_description;
     VAR status: ost$status);

    TYPE
      t$communication_buff = packed record
        fill1: 0 .. 7fffffff(16),
        slave: boolean,
        partner_pp: ost$real_memory_address,
      recend;

    VAR
      active_elements: array [1 .. 2] of cmt$access_elements,
      commun_buffer_p: ^t$communication_buff,
      element_descriptor: cmt$element_descriptor,
      element_index: integer,
      element_reservation: cmt$element_reservation,
      found: boolean,
      iou_name: cmt$element_name,
      iou_number: dst$iou_number,
      index: integer,
      job_name: jmt$system_supplied_name,
      job_found: boolean,
      master_pp_table_rma: ost$real_memory_address,
      physical_id: cmt$physical_identification,
      pp_entry_index_p: ^array [1 .. * ] of iot$pp_number,
      pp_number: array [1 .. 2] of dst$iou_resource,
      rma: ost$real_memory_address,
      search_from_dstape: boolean,
      seg_attributes_p: ^array [ * ] of mmt$user_attribute_descriptor,
      selected_pp_programs: boolean,
      slave_pp_table_rma: ost$real_memory_address,
      slave_seq_ptr: amt$segment_pointer,
      seq_ptr: amt$segment_pointer,
      system_caller: boolean,
      table_index: integer,
      user_job_name: jmt$user_supplied_name;

    status.normal := TRUE;
    system_caller := osp$is_caller_system_privileged ();
    search_from_dstape := FALSE;
    master_pp_table_rma := 0;
    slave_pp_table_rma := 0;

    IF UPPERBOUND (program_description) > 2 THEN
      osp$set_status_condition (cme$too_many_pp_program_desc, status);
      RETURN; {----->
    IFEND;

    pmp$get_job_names (user_job_name, job_name, status);

    PUSH pp_entry_index_p: [LOWERBOUND (program_description) .. UPPERBOUND (program_description)];

  /master_slave/
    FOR index := LOWERBOUND (program_description) TO UPPERBOUND (program_description) DO
      cmp$convert_pp_ordinal (program_description [index].pp_identification.ordinal, pp_number [index]);
      cmp$convert_iou_name (program_description [index].pp_identification.iou, pp_number [index].iou_number,
            status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      validate_pp_reserved (system_caller, job_name, pp_number [index],
            program_description [index].pp_identification.iou (1, 5), pp_entry_index_p^ [index], status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF (program_description [index].pp_program = NIL) AND program_description [index].master_pp THEN
        search_from_dstape := TRUE;
      IFEND;
      IF program_description [index].communication_buffer_length > osc$max_page_size THEN
        osp$set_status_condition (cme$buffer_length_too_large, status);
        RETURN; {----->
      IFEND;

      IF program_description [index].element_access = NIL THEN
        CYCLE /master_slave/; {----->
      IFEND;
      PUSH active_elements [index].accessed_elements_p: [LOWERBOUND (program_description [index].
            element_access^) .. UPPERBOUND (program_description [index].element_access^)];
      FOR element_index := LOWERBOUND (program_description [index].element_access^)
            TO UPPERBOUND (program_description [index].element_access^) DO
        active_elements [index].accessed_elements_p^ [element_index].active := FALSE;
        active_elements [index].accessed_elements_p^ [element_index].lun := 0;

        physical_id.product_identification.product_number := ' ';
        physical_id.serial_number := ' ';
        physical_id.hardware_address := program_description [index].element_access^ [element_index];
        cmp$get_element_name (physical_id, element_descriptor, status);
        IF NOT status.normal THEN
          IF status.condition = cme$lcm_element_name_not_found THEN
            status.normal := TRUE;
          ELSE
            RETURN; {----->
          IFEND;
        ELSE
          active_elements [index].accessed_elements_p^ [element_index].active := TRUE;
        IFEND;

        IF active_elements [index].accessed_elements_p^ [element_index].active THEN
          cmp$search_peripheral_table (element_descriptor, element_reservation, FALSE, table_index, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          active_elements [index].accessed_elements_p^ [element_index].lun :=
                cmv$peripheral_element_table.pointer^ [table_index].logical_unit_number;

        ELSE
          IF $cmt$physical_address_specifier [cmc$unit_address] <=
                physical_id.hardware_address.physical_address_specifier THEN
            element_reservation.element_type := cmc$storage_device_element;
          ELSE
            element_reservation.element_type := cmc$controller_element;
          IFEND;
          element_reservation.peripheral_descriptor.use_logical_identification := FALSE;
          element_reservation.peripheral_descriptor.hardware_address :=
                program_description [index].element_access^ [element_index];
          cmp$search_peripheral_table (element_descriptor, element_reservation, TRUE, table_index, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

        IF (job_name <> cmv$peripheral_element_table.pointer^ [table_index].reserved_job) AND
              NOT (system_caller AND cmv$peripheral_element_table.pointer^ [table_index].
              reserved_by_system) THEN
          IF active_elements [index].accessed_elements_p^ [element_index].active THEN

            { Check if device is the object of either CONCURRENT or DEDICATED maintenance.

            CASE cmv$peripheral_element_table.pointer^ [table_index].maintenance_activity.access OF
            = msc$dedicated_access =
              IF cmv$peripheral_element_table.pointer^ [table_index].maintenance_activity.dedicated_accessor.
                    active AND (cmv$peripheral_element_table.pointer^ [table_index].maintenance_activity.
                    dedicated_accessor.job_identification <> job_name) THEN
                osp$set_status_abnormal (cmc$configuration_management_id, mse$dedicated_access_granted,
                      cmv$peripheral_element_table.pointer^ [table_index].element_name, status);
                osp$append_status_parameter (osc$status_parameter_delimiter,
                      cmv$peripheral_element_table.pointer^ [table_index].maintenance_activity.
                      dedicated_accessor.job_identification, status);
                RETURN; {----->
              IFEND;

            = msc$concurrent_access =
              msp$search_con_access_job (table_index, job_name, job_found, status);
              IF NOT job_found THEN
                osp$set_status_abnormal (cmc$configuration_management_id, mse$req_maint_access_required,
                      cmv$peripheral_element_table.pointer^ [table_index].element_name, status);
                RETURN; {----->
              IFEND;
            ELSE
            CASEND;
          ELSE
            osp$set_status_abnormal (cmc$configuration_management_id, cme$element_not_reserved,
                  'Storage devices on element_access', status);
            RETURN; {----->
          IFEND;
        IFEND;
      FOREND;
    FOREND /master_slave/;
    seq_ptr.kind := amc$sequence_pointer;
    seq_ptr.sequence_pointer := NIL;
    slave_seq_ptr.kind := amc$sequence_pointer;
    slave_seq_ptr.sequence_pointer := NIL;

    selected_pp_programs := (program_description [1].iou_program_name <> 'ICAD') AND
          (program_description [1].iou_program_name <> 'NDI0') AND
          (program_description [1].iou_program_name <> 'NPDR') AND
          (program_description [1].iou_program_name <> 'NETW') AND
          (program_description [1].iou_program_name <> 'IVB0') AND
          (program_description [1].iou_program_name <> 'IVB4') AND
          (program_description [1].iou_program_name <> 'ESMD');

    { Build the PP table.

    IF selected_pp_programs AND (program_description [1].communication_buffer_length > 0) THEN
      PUSH seg_attributes_p: [1 .. 3];
      seg_attributes_p^ [1].keyword := mmc$ua_segment_access_control;
      seg_attributes_p^ [1].access_control.cache_bypass := TRUE;
      seg_attributes_p^ [1].access_control.execute_privilege := osc$non_executable;
      seg_attributes_p^ [1].access_control.read_privilege := osc$read_uncontrolled;
      seg_attributes_p^ [1].access_control.write_privilege := osc$write_uncontrolled;
      seg_attributes_p^ [2].keyword := mmc$ua_ring_numbers;
      seg_attributes_p^ [2].r1 := osc$sj_ring_3;
      seg_attributes_p^ [2].r2 := osc$sj_ring_3;
      seg_attributes_p^ [3].keyword := mmc$ua_wired_segment;
      seg_attributes_p^ [3].wired_segment_length := program_description [1].communication_buffer_length;
      seg_attributes_p^ [3].contiguous_real_memory := TRUE;

      mmp$create_user_segment (seg_attributes_p, amc$sequence_pointer, mmc$as_sequential, seq_ptr, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      RESET seq_ptr.sequence_pointer;
      pmp$zero_out_table (#LOC (seq_ptr.sequence_pointer^),
            program_description [1].communication_buffer_length);

      IF (UPPERBOUND (program_description) = 2) AND (program_description [2].communication_buffer_length >
            0) THEN

        { Create wired area for slave PP

        seg_attributes_p^ [3].wired_segment_length := program_description [2].communication_buffer_length;
        mmp$create_user_segment (seg_attributes_p, amc$sequence_pointer, mmc$as_sequential, slave_seq_ptr,
              status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        RESET slave_seq_ptr.sequence_pointer;
        pmp$zero_out_table (#LOC (slave_seq_ptr.sequence_pointer^),
              program_description [2].communication_buffer_length);
      IFEND;
    IFEND;
    cmp$build_pp_table_entry (pp_entry_index_p^, active_elements, seq_ptr.sequence_pointer,
          slave_seq_ptr.sequence_pointer, program_description, master_pp_table_rma, slave_pp_table_rma,
          status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    FOR index := LOWERBOUND (program_description) TO UPPERBOUND (program_description) DO
      IF selected_pp_programs AND ((master_pp_table_rma <> 0) OR (slave_pp_table_rma <> 0)) AND
            (program_description [index].communication_buffer_length > 0) THEN
        IF index = 1 THEN
          RESET seq_ptr.sequence_pointer;
          program_description [index].communication_buffer := seq_ptr.sequence_pointer;
          NEXT commun_buffer_p IN seq_ptr.sequence_pointer;
          IF commun_buffer_p <> NIL THEN
            commun_buffer_p^.slave := FALSE;
            commun_buffer_p^.partner_pp := slave_pp_table_rma;
            commun_buffer_p^.fill1 := 0;
          IFEND;
        ELSE
          RESET slave_seq_ptr.sequence_pointer;
          program_description [index].communication_buffer := slave_seq_ptr.sequence_pointer;
          NEXT commun_buffer_p IN slave_seq_ptr.sequence_pointer;
          IF commun_buffer_p <> NIL THEN
            commun_buffer_p^.slave := TRUE;
            commun_buffer_p^.partner_pp := master_pp_table_rma;
            commun_buffer_p^.fill1 := 0;
          IFEND;
        IFEND;
      IFEND;

      IF (master_pp_table_rma <> 0) OR (slave_pp_table_rma <> 0) THEN
        IF index = 1 THEN
          rma := master_pp_table_rma;
        ELSE
          rma := slave_pp_table_rma;
        IFEND;
      ELSE
        rma := cmv$logical_pp_table_p^ [pp_entry_index_p^ [index]].pp_info.pp_interface_table_rma;
      IFEND;


      cmp$deadstart_pp (pp_entry_index_p^ [index], rma, search_from_dstape,
            program_description [index].pp_program, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    FOREND;

  PROCEND cmp$execute_pp_program;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$get_pp_registers', EJECT ??
*copyc cmh$get_pp_registers

  PROCEDURE [XDCL, #GATE] cmp$get_pp_registers
    (    pp_identification: cmt$pp_identification;
     VAR pp_registers: cmt$pp_registers;
     VAR status: ost$status);

    VAR
      found: boolean,
      job_name: jmt$system_supplied_name,
      pp_index: iot$pp_number,
      pp: dst$iou_resource,
      pp_regs: dst$dft_pp_registers,
      system_caller: boolean,
      user_job_name: jmt$user_supplied_name;

    system_caller := osp$is_caller_system_privileged ();
    status.normal := TRUE;

    cmp$convert_pp_ordinal (pp_identification.ordinal, pp);
    cmp$convert_iou_name (pp_identification.iou, pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    pmp$get_job_names (user_job_name, job_name, status);
    validate_pp_reserved (system_caller, job_name, pp, pp_identification.iou (1, 5), pp_index, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    cmp$get_pp_reg (pp, pp_regs, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pp_registers.a_register := pp_regs.a_register;
    pp_registers.k_register := pp_regs.k_register;
    pp_registers.p_register := pp_regs.p_register;
    pp_registers.q_register := pp_regs.q_register;

  PROCEND cmp$get_pp_registers;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$idle_pp', EJECT ??
*copyc cmh$idle_pp

  PROCEDURE [XDCL, #GATE] cmp$idle_pp
    (    pp_identification: cmt$pp_identification;
         break_interlocks: boolean;
         hardware_idle_pp: boolean;
         pp_memory_area: ^SEQ ( * );
     VAR actual_pp_memory_size: cmt$pp_memory_length;
     VAR pp_registers: cmt$pp_registers;
     VAR pp_software_idled: boolean;
     VAR status: ost$status);

    VAR
      dump_pp: boolean,
      dump_registers_only: boolean,
      found: boolean,
      job_name: jmt$system_supplied_name,
      physical_pp: dst$iou_resource,
      pp_entry_index: iot$pp_number,
      system_caller: boolean,
      user_job_name: jmt$user_supplied_name;

    status.normal := TRUE;

    system_caller := osp$is_caller_system_privileged ();
    pp_software_idled := FALSE;

    IF (NOT hardware_idle_pp) AND (pp_memory_area <> NIL) THEN
      osp$set_status_condition (cme$dump_requires_hardware_idle, status);
      RETURN; {----->
    IFEND;

    dump_pp := (hardware_idle_pp) AND (pp_memory_area <> NIL);
    dump_registers_only := NOT dump_pp;

    cmp$convert_pp_ordinal (pp_identification.ordinal, physical_pp);
    cmp$convert_iou_name (pp_identification.iou, physical_pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pmp$get_job_names (user_job_name, job_name, status);
    validate_pp_reserved (system_caller, job_name, physical_pp, pp_identification.iou (1, 5), pp_entry_index,
          status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF NOT hardware_idle_pp THEN

      { Check pp queue lockword, if set then return abnormal status because on Soft IDLE, pp has to have
      { its queue cleared.

      IF cmp$pp_queue_lock (pp_entry_index) THEN
        osp$set_status_condition (cme$pp_holds_pp_queue_lock, status);
        RETURN; {----->
      IFEND;
    IFEND;

    { Soft IDLE the PP first.

    cmp$send_pp_command (pp_entry_index, cmc$idle_command, pp_software_idled, status);

    IF hardware_idle_pp THEN
      cmp$hardware_idle_pp (physical_pp, dump_pp, dump_registers_only, pp_memory_area, actual_pp_memory_size,
            pp_registers, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    IF pp_software_idled THEN
      cmp$free_pp_request (pp_entry_index);
    IFEND;

    IF break_interlocks AND status.normal THEN
      cmp$clear_channel_interlock (physical_pp.iou_number, pp_entry_index, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

  PROCEND cmp$idle_pp;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$mount_storage_medium', EJECT ??
*copyc cmh$mount_storage_medium

  PROCEDURE [XDCL, #GATE] cmp$mount_storage_medium
    (    storage_device: cmt$peripheral_descriptor;
         medium: rmt$external_vsn;
         write_access: boolean;
         wait_for_attachment: fst$wait_for_attachment;
     VAR status: ost$status);

?? NEWTITLE := 'menu_for_tape_maintenance_mount', EJECT ??

    PROCEDURE menu_for_tape_maintenance_mount
      (VAR status: ost$status);

      CONST
        default_terminate_reason = 'the requested tape volume is not available',
        number_of_choices = 2;

      VAR
        parameter_names: ^ost$parameter_help_names,
        response: oft$number_of_choices,
        response_string: ost$string,
        string_size: ost$name_size,
        menu_parameters: array [1 .. 3] of ^ost$message_parameter,
        terminate_reason: string (osc$max_string_size);

      status.normal := TRUE;

      menu_parameters [1] := ^medium;
      IF write_access THEN
        PUSH menu_parameters [2]: [4];
        menu_parameters [2]^ := 'TRUE';
      ELSE
        PUSH menu_parameters [2]: [5];
        menu_parameters [2]^ := 'FALSE';
      IFEND;
      string_size := clp$trimmed_string_size (element_name);
      menu_parameters [3] := ^element_name (1, string_size);

      PUSH parameter_names: [1 .. number_of_choices];
      parameter_names^ [1] := 'ALLOW_MAINTENANCE';
      parameter_names^ [2] := 'TERMINATE_REQUEST';

      ofp$format_operator_menu (rmc$manual_tape_maintenance, parameter_names, ^menu_parameters,
            number_of_choices, ofc$removable_media_operator, response, response_string, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      CASE response OF
      = 1 =
        ;
      = 2 =
        IF response_string.size > 0 THEN
          terminate_reason := response_string.value (1, response_string.size);
        ELSE
          terminate_reason := default_terminate_reason;
        IFEND;
        osp$set_status_abnormal (rmc$resource_management_id, dme$operator_stop, terminate_reason, status);
      ELSE
      CASEND;

    PROCEND menu_for_tape_maintenance_mount;
?? OLDTITLE ??

    VAR
      configured: boolean,
      definition: cmt$element_definition,
      element_descriptor: cmt$element_descriptor,
      element_name: cmt$element_name,
      element_reservation: cmt$element_reservation,
      iou_information_table: dst$iou_information_table,
      iou_number: dst$iou_number,
      job_found: boolean,
      job_name: jmt$system_supplied_name,
      local_status: ost$status,
      lun: iot$logical_unit,
      number_of_ious: dst$number_of_ious,
      peripheral_index: integer,
      physical_id: cmt$physical_identification,
      tape_unit_assigned: boolean,
      user_job_name: jmt$user_supplied_name;

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

  /main_program/
    BEGIN
      pmp$get_job_names (user_job_name, job_name, status);

      element_descriptor.element_type := cmc$storage_device_element;
      element_descriptor.peripheral_descriptor := storage_device;

      element_reservation.element_type := cmc$storage_device_element;
      element_reservation.peripheral_descriptor := storage_device;

      IF NOT element_descriptor.peripheral_descriptor.use_logical_identification THEN
        dsp$retrieve_iou_information (number_of_ious, iou_information_table);

{ Only use the user passed in IOU if the system has more than 1 IOU.  If the
{ system has only 1 IOU, force the IOU to IOU0.

        IF number_of_ious = 1 THEN
          cmp$convert_iou_number (iou_information_table [1].physical_iou_number,
                element_descriptor.peripheral_descriptor.hardware_address.iou, status);
          IF NOT status.normal THEN
            EXIT /main_program/; {----->
          IFEND;
          element_reservation.peripheral_descriptor.hardware_address.iou :=
                element_descriptor.peripheral_descriptor.hardware_address.iou;
        ELSE { validate IOU passed in is a valid name
          cmp$convert_iou_name (element_descriptor.peripheral_descriptor.hardware_address.iou, iou_number,
                status);
          IF NOT status.normal THEN
            EXIT /main_program/; {----->
          IFEND;
        IFEND;
      IFEND;

      configured := FALSE;
      cmp$get_element_definition (element_descriptor, definition, status);

      IF NOT status.normal THEN
        IF (status.condition = cme$lcm_element_not_found) OR
              (status.condition = cme$lcm_element_name_not_found) THEN
          status.normal := TRUE;
        ELSE
          EXIT /main_program/; {----->
        IFEND;
      ELSE

        IF element_descriptor.element_type <> definition.element_type THEN
          osp$set_status_abnormal (cmc$configuration_management_id, cme$element_not_storage_device,
                'CMP$MOUNT_STORAGE_MEDIUM', status);
          EXIT /main_program/; {----->
        IFEND;
        configured := TRUE;

        IF NOT storage_device.use_logical_identification THEN
          element_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
          element_descriptor.peripheral_descriptor.element_name := definition.element_name;
          element_reservation.peripheral_descriptor.use_logical_identification := TRUE;
          element_reservation.peripheral_descriptor.element_name := definition.element_name;
        IFEND;

      IFEND;

      IF configured THEN
        cmp$search_peripheral_table (element_descriptor, element_reservation, FALSE, peripheral_index,
              status);
        IF NOT status.normal THEN
          EXIT /main_program/; {----->
        IFEND;
      ELSE
        cmp$search_peripheral_table (element_descriptor, element_reservation, TRUE, peripheral_index, status);
        IF NOT status.normal THEN
          EXIT /main_program/; {----->
        IFEND;
      IFEND;

    /validate_job_name/
      BEGIN

{ NOTE : Malet/ve will NOT use CMP$MOUNT_STORAGE_MEDIUM for MASS storage device, but
{        the feature is still IMPLEMENTED here (recommended by A. J. Lawson).

{ At present, CMP$MOUNT_STORAGE_MEDIUM is allowed on a MASS storage device reserved
{ either by CMP$RESERVE_ELEMENT or DEDICATED MSP$REQUEST_MAINTENANCE_ACCESS. If a job
{ does CMP$MOUNT_STORAGE_MEDIUM more than one on the same MASS storage device,
{ CME$LCM_DEVICE_ATTACHED_TO_JOB is NOT issued as it IS for TAPE storage device.

{ NOTE : Malet/ve will NOT use CMP$MOUNT_STORAGE_MEDIUM for MASS storage device, but
{        the feature is still IMPLEMENTED here (recommended by A. J. Lawson).

        IF cmv$peripheral_element_table.pointer^ [peripheral_index].entry_interlock THEN
          IF cmv$peripheral_element_table.pointer^ [peripheral_index].reserved_status THEN
            IF cmv$peripheral_element_table.pointer^ [peripheral_index].reserved_job <> job_name THEN
              cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                    cme$element_already_reserved, status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    cmv$peripheral_element_table.pointer^ [peripheral_index].reserved_job, status);
              EXIT /main_program/; {----->
            ELSE
              IF configured THEN
                cmp$get_logical_unit_number (cmv$peripheral_element_table.pointer^ [peripheral_index].
                      element_name, lun, status);
                IF NOT status.normal THEN
                  EXIT /main_program/; {----->
                IFEND;
                IF cmv$logical_unit_table^ [lun].status.assignable_device THEN
                  IF cmv$logical_unit_table^ [lun].status.assigned THEN
                    IF cmv$logical_unit_table^ [lun].status.assigned_jsn = job_name THEN
                      osp$set_status_abnormal (cmc$configuration_management_id,
                            cme$lcm_device_attached_to_job, cmv$peripheral_element_table.
                            pointer^ [peripheral_index].element_name, status);
                      EXIT /main_program/; {----->
                    ELSE
                      osp$set_status_abnormal (cmc$configuration_management_id, mse$element_already_assigned,
                            cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
                      osp$append_status_parameter (osc$status_parameter_delimiter,
                            cmv$logical_unit_table^ [lun].status.assigned_jsn, status);
                      EXIT /main_program/; {----->
                    IFEND;
                  ELSE
                    EXIT /validate_job_name/; {----->
                  IFEND;
                IFEND;
              ELSE
                EXIT /validate_job_name/; {----->
              IFEND;
            IFEND;
          IFEND;
        IFEND;

        CASE cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.access OF
        = msc$dedicated_access =
          IF cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.dedicated_accessor.
                active THEN
            IF cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.
                  dedicated_accessor.job_identification <> job_name THEN
              cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                    mse$dedicated_access_granted, status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.
                    dedicated_accessor.job_identification, status);
              EXIT /main_program/; {----->
            ELSE

              IF configured THEN
                cmp$get_logical_unit_number (cmv$peripheral_element_table.pointer^ [peripheral_index].
                      element_name, lun, status);
                IF NOT status.normal THEN
                  EXIT /main_program/; {----->
                IFEND;
                IF cmv$logical_unit_table^ [lun].status.assignable_device THEN
                  IF cmv$logical_unit_table^ [lun].status.assigned THEN
                    IF cmv$logical_unit_table^ [lun].status.assigned_jsn = job_name THEN
                      osp$set_status_abnormal (cmc$configuration_management_id,
                            cme$lcm_device_attached_to_job, cmv$peripheral_element_table.
                            pointer^ [peripheral_index].element_name, status);
                      EXIT /main_program/; {----->
                    ELSE
                      osp$set_status_abnormal (cmc$configuration_management_id, mse$element_already_assigned,
                            cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
                      osp$append_status_parameter (osc$status_parameter_delimiter,
                            cmv$logical_unit_table^ [lun].status.assigned_jsn, status);
                      EXIT /main_program/; {----->
                    IFEND;
                  ELSE
                    EXIT /validate_job_name/; {----->
                  IFEND;
                IFEND;
              ELSE
                EXIT /validate_job_name/; {----->
              IFEND;
            IFEND;
          IFEND;

        = msc$concurrent_access =

          msp$search_con_access_job (peripheral_index, job_name, job_found, status);
          IF NOT job_found THEN
            cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                  cme$reserve_request_required, status);
            EXIT /main_program/; {----->
          IFEND;

          IF configured THEN
            cmp$get_logical_unit_number (cmv$peripheral_element_table.pointer^ [peripheral_index].
                  element_name, lun, status);
            IF NOT status.normal THEN
              EXIT /main_program/; {----->
            IFEND;

{ CMP$MOUNT_STORAGE_MEDIUM is not allowed on MASS storage device which
{ is the object of CONCURRENT MSP$REQUEST_MAINTENANCE_ACCESS.

            IF NOT cmv$logical_unit_table^ [lun].status.assignable_device THEN
              osp$set_status_abnormal (cmc$configuration_management_id, cme$mount_media_denied,
                    cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
              EXIT /main_program/; {----->
            IFEND;

            IF cmv$logical_unit_table^ [lun].status.assignable_device THEN
              IF cmv$logical_unit_table^ [lun].status.assigned THEN
                IF cmv$logical_unit_table^ [lun].status.assigned_jsn = job_name THEN
                  osp$set_status_abnormal (cmc$configuration_management_id, cme$lcm_device_attached_to_job,
                        cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
                  EXIT /main_program/; {----->
                ELSE
                  IF wait_for_attachment.wait = osc$nowait THEN
                    osp$set_status_abnormal (cmc$configuration_management_id, cme$lcm_device_busy,
                          cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
                    osp$append_status_parameter (osc$status_parameter_delimiter,
                          cmv$logical_unit_table^ [lun].status.assigned_jsn, status);
                    EXIT /main_program/; {----->
                  ELSEIF wait_for_attachment.wait = osc$wait THEN

                  /wait_for_device_unattached/
                    REPEAT
                      pmp$long_term_wait (5000, 5000);
                      CYCLE /wait_for_device_unattached/; {----->
                    UNTIL (NOT cmv$logical_unit_table^ [lun].status.assigned) AND
                          (cmv$logical_unit_table^ [lun].status.assigned_jsn = ' ');
                  IFEND;
                  ;
                IFEND;
              IFEND;
            IFEND;
          IFEND;

        CASEND;

      END /validate_job_name/;

      element_name := element_reservation.peripheral_descriptor.element_name;

      IF configured AND cmv$logical_unit_table^ [lun].status.assignable_device THEN
        rmp$assign_tape_unit (gfv$null_sfid, element_name, $cmt$element_states [cmc$down],
              {label_type} amc$unlabelled, lun, status);
        IF NOT status.normal THEN
          EXIT /main_program/; {----->
        IFEND;
      IFEND;

      tape_unit_assigned := TRUE;

    /operator_menu/
      BEGIN
        menu_for_tape_maintenance_mount (status);
        IF NOT status.normal THEN
          IF ((status.condition = dme$termination_condition) OR (status.condition = dme$operator_stop)) THEN
            EXIT /operator_menu/; {----->
          IFEND;
        IFEND;

      END /operator_menu/;

    END /main_program/;

    IF NOT status.normal AND tape_unit_assigned THEN
      rmp$release_tape_unit (gfv$null_sfid, lun, {delete_request_from_vsn_queue} FALSE, local_status);
    IFEND;

  PROCEND cmp$mount_storage_medium;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$release_element', EJECT ??
*copyc cmh$release_element

  PROCEDURE [XDCL, #GATE] cmp$release_element
    (    element: array [ * ] of cmt$element_reservation;
     VAR status: ost$status);

    VAR
      definition: cmt$element_definition,
      element_descriptor: cmt$element_descriptor,
      element_reservation: cmt$element_reservation,
      index: integer,
      iou_information_table: dst$iou_information_table,
      iou_number: dst$iou_number,
      job_name: jmt$system_supplied_name,
      local_status: ost$status,
      lun: integer,
      mainframe_id: pmt$mainframe_id,
      number_of_ious: dst$number_of_ious,
      peripheral_index: integer,
      physical_id: cmt$physical_identification,
      system_caller: boolean,
      user_job_name: jmt$user_supplied_name;

*if $true(osv$ff_debug_code)
    VAR
      i: integer,
      str: string (80);
*ifend

    status.normal := TRUE;
    system_caller := osp$is_caller_system_privileged ();
    IF (cmv$peripheral_element_table.pointer = NIL) OR (cmv$logical_pp_table_p = NIL) THEN
      osp$set_status_condition (cme$cm_table_empty, status);
      RETURN; {----->
    IFEND;

    pmp$get_job_names (user_job_name, job_name, status);
    pmp$get_mainframe_id (mainframe_id, status);
    dsp$retrieve_iou_information (number_of_ious, iou_information_table);

  /for_loop/
    FOR index := LOWERBOUND (element) TO UPPERBOUND (element) DO
      element_descriptor.element_type := element [index].element_type;
      element_reservation := element [index];

      CASE element_reservation.element_type OF
      = cmc$pp_element =
        release_pp_element (job_name, system_caller, mainframe_id, number_of_ious, iou_information_table,
              element_reservation, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

      = cmc$data_channel_element, cmc$channel_adapter_element, cmc$controller_element,
            cmc$storage_device_element, cmc$communications_element =

        CASE element_descriptor.element_type OF
        = cmc$data_channel_element =
          element_descriptor.channel_descriptor := element_reservation.channel_descriptor;
          IF number_of_ious = 1 THEN
            cmp$convert_iou_number (iou_information_table [1].physical_iou_number,
                  element_descriptor.channel_descriptor.iou, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            element_reservation.channel_descriptor.iou := element_descriptor.channel_descriptor.iou;
          ELSE
            cmp$convert_iou_name (element_descriptor.channel_descriptor.iou, iou_number, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
          IFEND;

        = cmc$controller_element, cmc$storage_device_element, cmc$external_processor_element,
              cmc$channel_adapter_element, cmc$communications_element =
          element_descriptor.peripheral_descriptor := element_reservation.peripheral_descriptor;
          IF NOT element_descriptor.peripheral_descriptor.use_logical_identification THEN
            IF number_of_ious = 1 THEN
              cmp$convert_iou_number (iou_information_table [1].physical_iou_number,
                    element_descriptor.peripheral_descriptor.hardware_address.iou, status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
              element_reservation.peripheral_descriptor.hardware_address.iou :=
                    element_descriptor.peripheral_descriptor.hardware_address.iou;
            ELSE
              cmp$convert_iou_name (element_descriptor.peripheral_descriptor.hardware_address.iou, iou_number,
                    status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
            IFEND;
          IFEND;
        ELSE
        CASEND;

        cmp$get_element_definition (element_descriptor, definition, status);
        IF NOT status.normal THEN { not in physical configuration
          IF (status.condition <> cme$lcm_element_name_not_found) AND
                (status.condition <> cme$lcm_element_not_found) THEN
            RETURN; {----->
          IFEND;
          cmp$search_peripheral_table (element_descriptor, element_reservation, TRUE, peripheral_index,
                status);
          IF NOT status.normal THEN
            IF status.condition = cme$cm_element_not_found THEN
              cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                    cme$element_not_reserved, status);
            IFEND;
            RETURN; {----->
          IFEND;
          cmp$unmark_element_reserved (element_reservation, job_name, system_caller, peripheral_index,
                status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;

*if $true(osv$ff_debug_code)
          IF cmv$task_reserved_element_count < 1 THEN
            STRINGREP (str, i, 'cmv$task_reserved_element_count underrun by ', job_name);
            dpp$put_critical_message (str (1, i), local_status);
            cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
          IFEND;

          cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
          STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
          dpp$put_critical_message (str (1, i), local_status);
*else
          IF cmv$task_reserved_element_count > 0 THEN
            cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
          IFEND;
*ifend

          release_channel_resource (element_descriptor, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          CYCLE /for_loop/; {----->
        IFEND;

        { The code from here on is only reached if the element is in the configuration.

        IF element_reservation.element_type <> definition.element_type THEN
          osp$set_status_abnormal (cmc$configuration_management_id, cme$incorrect_element_type,
                definition.element_name, status);
          RETURN; {----->
        IFEND;

        CASE element_reservation.element_type OF
        = cmc$data_channel_element =
          IF NOT element_reservation.channel_descriptor.use_logical_identification THEN
            element_descriptor.channel_descriptor.use_logical_identification := TRUE;
            element_descriptor.channel_descriptor.name := definition.element_name;
          IFEND;
        = cmc$controller_element, cmc$storage_device_element, cmc$external_processor_element,
              cmc$channel_adapter_element, cmc$communications_element =
          IF NOT element_reservation.peripheral_descriptor.use_logical_identification THEN
            element_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
            element_descriptor.peripheral_descriptor.element_name := definition.element_name;
          IFEND;
        ELSE
        CASEND;

        cmp$search_peripheral_table (element_descriptor, element_reservation, FALSE, peripheral_index,
              status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

        cmp$unmark_element_reserved (element_reservation, job_name, system_caller, peripheral_index, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

*if $true(osv$ff_debug_code)
        IF cmv$task_reserved_element_count < 1 THEN
          STRINGREP (str, i, 'cmv$task_reserved_element_count underrun by ', job_name);
          dpp$put_critical_message (str (1, i), local_status);
          cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
        IFEND;

        cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
        STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
        dpp$put_critical_message (str (1, i), local_status);
*else
        IF cmv$task_reserved_element_count > 0 THEN
          cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
        IFEND;
*ifend

        release_channel_resource (element_descriptor, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

        IF cmv$peripheral_element_table.pointer^ [peripheral_index].physical_descriptor.element_type =
              cmc$storage_device_element THEN
          lun := cmv$peripheral_element_table.pointer^ [peripheral_index].logical_unit_number;
          IF cmv$logical_unit_table^ [lun].status.assignable_device THEN
            rmp$release_tape_unit (gfv$null_sfid, lun, {delete_request_from_vsn_queue} FALSE, local_status);
          IFEND;
        IFEND;

      ELSE
      CASEND;
    FOREND /for_loop/;

  PROCEND cmp$release_element;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$reserve_element', EJECT ??
*copyc cmh$reserve_element

  PROCEDURE [XDCL, #GATE] cmp$reserve_element
    (VAR {input,output} element: array [ * ] of cmt$element_reservation;
     VAR status: ost$status);

    VAR
      channel_definition: cmt$data_channel_definition,
      channel_index: integer,
      channel_name: cmt$element_name,
      channel: cmt$physical_channel,
      channel_ordinal: cmt$channel_ordinal,
      definition: cmt$element_definition,
      element_description: cmt$element_descriptor,
      element_descriptor: cmt$element_descriptor,
      element_index: integer,
      element_entry: boolean,
      element_lock: boolean,
      element_reservation: cmt$element_reservation,
      entry_index: integer,
      found: boolean,
      gtid: ost$global_task_id,
      ignore_status: ost$status,
      index: integer,
      iou_number: dst$iou_number,
      iou_definition: cmt$iou_definition,
      iou_information_table: dst$iou_information_table,
      job_name: jmt$system_supplied_name,
      len: integer,
      mainframe_id: pmt$mainframe_id,
      number_of_ious: dst$number_of_ious,
      peripheral_index: integer,
      physical_id: cmt$physical_identification,
      physical_pp: dst$iou_resource,
      pp_number: string (13),
      privileged_job: boolean,
      released_elements_p: ^array [ * ] of cmt$element_reservation,
      release_index: integer,
      release_status: ost$status,
      system_caller: boolean,
      user_job_name: jmt$user_supplied_name,
      valid: boolean;

*if $true(osv$ff_debug_code)
    VAR
      i: integer,
      local_status: ost$status,
      str: string (80);
*ifend

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

    system_caller := osp$is_caller_system_privileged ();

    IF (cmv$peripheral_element_table.pointer = NIL) OR (cmv$logical_pp_table_p = NIL) THEN
      osp$set_status_condition (cme$cm_table_empty, status);
      RETURN; {----->
    IFEND;

    pmp$get_job_names (user_job_name, job_name, status);
    pmp$get_mainframe_id (mainframe_id, status);

    { Determine if caller is allowed to reserve more elements.

    IF NOT system_caller THEN

      { Serialize the acquisition of new elements.

      cmp$set_element_lock (status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      element_lock := TRUE;

      FOR index := 1 TO UPPERBOUND (cmv$peripheral_element_table.pointer^) DO
        IF cmv$peripheral_element_table.pointer^ [index].entry_interlock AND
              cmv$peripheral_element_table.pointer^ [index].reserved_status AND
              (cmv$peripheral_element_table.pointer^ [index].reserved_job = job_name) AND
              (NOT cmv$peripheral_element_table.pointer^ [index].reserved_by_system) THEN
          FOR element_index := LOWERBOUND (element) TO UPPERBOUND (element) DO
            IF element [element_index].element_type <> cmc$pp_element THEN
              osp$set_status_abnormal (cmc$configuration_management_id, cme$reserve_not_permitted,
                    'a CHANNEL or a PERIPHERAL ELEMENT', status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    'a CHANNEL or a PERIPHERAL ELEMENT', status);
              cmp$clear_element_lock (ignore_status);
              RETURN; {----->
            IFEND;
          FOREND;
        IFEND;
      FOREND;

      FOR index := LOWERBOUND (cmv$logical_pp_table_p^) TO UPPERBOUND (cmv$logical_pp_table_p^) DO
        IF NOT cmv$logical_pp_table_p^ [index].flags.entry_reserved_by_nosve AND
              cmv$logical_pp_table_p^ [index].flags.entry_in_use AND
              cmv$logical_pp_table_p^ [index].flags.entry_reserved_by_other AND
              (cmv$logical_pp_table_p^ [index].task_info.reserved_job_name = job_name) AND
              NOT cmv$logical_pp_table_p^ [index].flags.entry_reserved_by_system_job THEN
          osp$set_status_abnormal (cmc$configuration_management_id, cme$reserve_not_permitted, 'a PP',
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                'a PP or a CHANNEL or a PERIPHERAL ELEMENT', status);
          cmp$clear_element_lock (ignore_status);
          RETURN; {----->
        IFEND;
      FOREND;
    IFEND;

    pmp$get_executing_task_gtid (gtid);
    dsp$retrieve_iou_information (number_of_ious, iou_information_table);

  /for_loop/
    FOR index := LOWERBOUND (element) TO UPPERBOUND (element) DO
      element_descriptor.element_type := element [index].element_type;
      element_reservation := element [index];

      CASE element_reservation.element_type OF
      = cmc$pp_element =
        reserve_pp_element (gtid, job_name, system_caller, mainframe_id, number_of_ious,
              iou_information_table, element_reservation, status);
        IF NOT status.normal THEN
          EXIT /for_loop/; {----->
        IFEND;
        element [index].pp_reservation.acquired_pp_identification :=
              element_reservation.pp_reservation.acquired_pp_identification;

      = cmc$data_channel_element, cmc$channel_adapter_element, cmc$controller_element,
            cmc$storage_device_element, cmc$communications_element =

        CASE element_descriptor.element_type OF
        = cmc$data_channel_element =
          element_descriptor.channel_descriptor := element_reservation.channel_descriptor;
          IF number_of_ious = 1 THEN
            cmp$convert_iou_number (iou_information_table [1].physical_iou_number,
                  element_descriptor.channel_descriptor.iou, status);
            IF NOT status.normal THEN
              EXIT /for_loop/; {----->
            IFEND;
            element_reservation.channel_descriptor.iou := element_descriptor.channel_descriptor.iou;
          ELSE
            cmp$convert_iou_name (element_descriptor.channel_descriptor.iou, iou_number, status);
            IF NOT status.normal THEN
              EXIT /for_loop/; {----->
            IFEND;
          IFEND;

        = cmc$controller_element, cmc$storage_device_element, cmc$external_processor_element,
              cmc$channel_adapter_element, cmc$communications_element =
          element_descriptor.peripheral_descriptor := element_reservation.peripheral_descriptor;
          IF NOT element_descriptor.peripheral_descriptor.use_logical_identification THEN
            IF number_of_ious = 1 THEN
              cmp$convert_iou_number (iou_information_table [1].physical_iou_number,
                    element_descriptor.peripheral_descriptor.hardware_address.iou, status);
              IF NOT status.normal THEN
                EXIT /for_loop/; {----->
              IFEND;
              element_reservation.peripheral_descriptor.hardware_address.iou :=
                    element_descriptor.peripheral_descriptor.hardware_address.iou;
            ELSE
              cmp$convert_iou_name (element_descriptor.peripheral_descriptor.hardware_address.iou, iou_number,
                    status);
              IF NOT status.normal THEN
                EXIT /for_loop/; {----->
              IFEND;
            IFEND;
          IFEND;
        ELSE
        CASEND;

        { Determine if the element (or physical path) is in the active physical configuration. If the
        { element is in the configuration, continue with the validation process.  If the element or path
        { is not in the configuration, one of the following will occur:
        {   - Return an error immediately if the reserve request is by logical_identification and the
        {     element requested is not a channel element.
        {   - Return an error immediately if the reserve request is from a system process
        {     (i.e. NAM/VE or RHF).
        {   - Reserve a channel element if it is not already reserved to a job or to the NOS/VE system.
        {   - Reserve a physical path without any further validation.
        {  -  If the element which is not in the active configuration is a CIO channel and one of the other
        {     possible names of the channel IS in the active configuration,  the validation will continue
        {     following the rules for an element in the configuration.

        cmp$get_element_definition (element_descriptor, definition, status);

        IF NOT status.normal THEN {not in physical configuration}
          IF (status.condition <> cme$lcm_element_not_found) AND
                (status.condition <> cme$lcm_element_name_not_found) THEN
            EXIT /for_loop/; {----->
          IFEND;

          IF (system_caller OR ((element_reservation.element_type <> cmc$data_channel_element) AND
                (element_reservation.peripheral_descriptor.use_logical_identification))) THEN
            EXIT /for_loop/; {----->
          IFEND;

          cmp$search_peripheral_table (element_descriptor, element_reservation, TRUE, peripheral_index,
                status);
          IF status.normal THEN
            IF (element_reservation.element_type = cmc$data_channel_element) AND
                  NOT cmv$peripheral_element_table.pointer^ [peripheral_index].entry_interlock AND
                  (cmv$peripheral_element_table.pointer^ [peripheral_index].element_name (1, 3) = 'CCH') THEN

              { To reach this point means that the requested CIO channel was not in the configuration,
              { however, one of its aliases was.  The validation must continue following the rules for
              { a channel in the configuration.

              element_descriptor.channel_descriptor.use_logical_identification := TRUE;
              element_descriptor.channel_descriptor.name := cmv$peripheral_element_table.
                    pointer^ [peripheral_index].element_name;
            ELSE
              cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                    cme$element_already_reserved, status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    cmv$peripheral_element_table.pointer^ [peripheral_index].reserved_job, status);
              EXIT /for_loop/; {----->
            IFEND;

          ELSE { element is not already reserved
            IF status.condition <> cme$cm_element_not_found THEN
              EXIT /for_loop/; {----->
            IFEND;
            IF element_reservation.element_type = cmc$data_channel_element THEN
              cmp$get_channel_definition (element_descriptor.channel_descriptor, channel_definition, status);
              IF NOT status.normal AND (status.condition <> cme$lcm_element_not_found) THEN
                EXIT /for_loop/; {----->
              IFEND;
              cmp$get_iou_definition (element_descriptor.channel_descriptor.iou, iou_definition, status);
              IF NOT status.normal THEN
                EXIT /for_loop/; {----->
              IFEND;
              IF ((channel_definition.number >= 12) AND (channel_definition.number <= 15)) OR
                    ((channel_definition.number > 25) AND (channel_definition.concurrent)) OR
                    ((iou_definition.kind = dsc$imn_i4_44_model) AND (channel_definition.number <= 1)) THEN
                cmp$convert_channel_number (channel_definition.number, channel_definition.concurrent,
                      channel_definition.port, channel_ordinal, channel_name, valid);
                osp$set_status_abnormal (cmc$configuration_management_id, cme$element_not_reservable,
                      channel_name, status);
                EXIT /for_loop/; {----->
              IFEND;
              cmp$convert_iou_name (channel_definition.iou, iou_number, status);
              IF NOT status.normal THEN
                EXIT /for_loop/; {----->
              IFEND;
              channel.number := channel_definition.number;
              channel.concurrent := channel_definition.concurrent;
              channel.port := channel_definition.port;
              cmp$acquire_resources (dsc$rrt_get_channel, channel, iou_number, 0, 0, FALSE, FALSE, FALSE,
                    physical_pp, status);
              IF NOT status.normal THEN
                EXIT /for_loop/; {----->
              IFEND;
            IFEND;
            cmp$mark_element_reserved (element_reservation, system_caller, job_name, gtid, physical_pp,
                  peripheral_index, FALSE, status);
            IF NOT status.normal THEN
              release_channel_resource (element_descriptor, release_status);
              EXIT /for_loop/; {----->
            IFEND;
            cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
*if $true(osv$ff_debug_code)
            STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
            dpp$put_critical_message (str (1, i), local_status);
*ifend
            CYCLE /for_loop/; {----->
          IFEND;

        ELSE {element is in physical configuration
          IF element_reservation.element_type <> definition.element_type THEN
            osp$set_status_abnormal (cmc$configuration_management_id, cme$incorrect_element_type,
                  definition.element_name, status);
            EXIT /for_loop/; {----->
          IFEND;

          CASE element_reservation.element_type OF
          = cmc$data_channel_element =
            IF NOT element_reservation.channel_descriptor.use_logical_identification THEN
              element_descriptor.channel_descriptor.use_logical_identification := TRUE;
              element_descriptor.channel_descriptor.name := definition.element_name;
            IFEND;

          = cmc$controller_element, cmc$storage_device_element, cmc$external_processor_element,
                cmc$channel_adapter_element, cmc$communications_element =
            IF NOT element_reservation.peripheral_descriptor.use_logical_identification THEN
              element_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
              element_descriptor.peripheral_descriptor.element_name := definition.element_name;
            IFEND;
          ELSE
          CASEND;
          cmp$search_peripheral_table (element_descriptor, element_reservation, FALSE, peripheral_index,
                status);
          IF NOT status.normal THEN
            EXIT /for_loop/; {----->
          IFEND;
        IFEND; { in physical configuration

        { The code from here on is only reached if the element is in the configuration.
        { Check if element is already the object of either dedicated or concurrent access.

        CASE cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.access OF
        = msc$concurrent_access =
          IF cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.
                con_access_job_list <> NIL THEN
            osp$set_status_abnormal (cmc$configuration_management_id, mse$concurrent_access_granted,
                  cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.
                  con_access_job_list^.job_name, status);
            EXIT /for_loop/; {----->
          IFEND;
        = msc$dedicated_access =
          IF cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.dedicated_accessor.
                active THEN
            osp$set_status_abnormal (cmc$configuration_management_id, mse$dedicated_access_granted,
                  cmv$peripheral_element_table.pointer^ [peripheral_index].element_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  cmv$peripheral_element_table.pointer^ [peripheral_index].maintenance_activity.
                  dedicated_accessor.job_identification, status);
            EXIT /for_loop/; {----->
          IFEND;
        ELSE
        CASEND;

        CASE element_reservation.element_type OF
        = cmc$data_channel_element =

          { Check to see if channel is already reserved.

          IF cmv$peripheral_element_table.pointer^ [peripheral_index].entry_interlock THEN
            cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                  cme$element_already_reserved, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  cmv$peripheral_element_table.pointer^ [peripheral_index].reserved_job, status);
            EXIT /for_loop/; {----->
          IFEND;

          { Check to see if CHANNEL is in ON STATE.

          IF cmv$peripheral_element_table.pointer^ [peripheral_index].element_status.state <> cmc$on THEN
            cmp$format_error_message (element_descriptor, {not_used} physical_id, FALSE,
                  cme$element_state_not_proper, status);
            EXIT /for_loop/; {----->
          IFEND;

          cmp$get_channel_definition (element_descriptor.channel_descriptor, channel_definition, status);
          IF NOT status.normal AND (status.condition <> cme$lcm_element_not_found) THEN
            EXIT /for_loop/; {----->
          IFEND;

          { Check to see if no logically configured elements in ON STATE connected to the channel.
          { This check is not performed if the caller is from a system segment.

          IF NOT system_caller THEN
            search_connected_elements (channel_definition, element_descriptor.channel_descriptor.name,
                  status);
            IF NOT status.normal THEN
              EXIT /for_loop/; {----->
            IFEND;
          IFEND;

          cmp$convert_iou_name (channel_definition.iou, iou_number, status);
          IF NOT status.normal THEN
            EXIT /for_loop/; {----->
          IFEND;
          channel.number := channel_definition.number;
          channel.concurrent := channel_definition.concurrent;
          channel.port := channel_definition.port;
          cmp$acquire_resources (dsc$rrt_get_channel, channel, iou_number, 0, 0, FALSE, FALSE, FALSE,
                physical_pp, status);
          IF NOT status.normal THEN
            EXIT /for_loop/; {----->
          IFEND;

        = cmc$controller_element, cmc$storage_device_element, cmc$external_processor_element,
              cmc$channel_adapter_element, cmc$communications_element =

          { Check to see if element is in ON state.

          IF cmv$peripheral_element_table.pointer^ [peripheral_index].element_status.state <> cmc$on THEN
            cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                  cme$element_state_not_proper, status);
            EXIT /for_loop/; {----->
          IFEND;

          { Check to see if element is reservable.

          IF (cmv$peripheral_element_table.pointer^ [peripheral_index].reservable_element =
                cmc$not_reservable) OR ((cmv$peripheral_element_table.pointer^ [peripheral_index].
                reservable_element = cmc$reservable_only_by_system) AND (NOT system_caller)) THEN
            cmp$format_error_message (element_descriptor, {not used} physical_id, FALSE,
                  cme$element_not_reservable, status);
            EXIT /for_loop/; {----->
          IFEND;

        ELSE
        CASEND;

        cmp$mark_element_reserved (element_reservation, system_caller, job_name, gtid, physical_pp,
              peripheral_index, FALSE, status);
        IF NOT status.normal THEN
          release_channel_resource (element_descriptor, release_status);
          EXIT /for_loop/; {----->
        IFEND;
        cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
*if $true(osv$ff_debug_code)
        STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
        dpp$put_critical_message (str (1, i), local_status);
*ifend
      ELSE
      CASEND;

    FOREND /for_loop/;

{ If status is abnormal, release any successful elements that were reserved.
    IF NOT status.normal AND (index > LOWERBOUND (element)) THEN
      PUSH released_elements_p: [LOWERBOUND (element) .. index - 1];
      FOR release_index := LOWERBOUND (element) TO index - 1 DO
        released_elements_p^ [release_index] := element [release_index];
      FOREND;
      cmp$release_element (released_elements_p^, release_status);
    IFEND;

    IF element_lock THEN
      cmp$clear_element_lock (ignore_status);
    IFEND;

  PROCEND cmp$reserve_element;
?? OLDTITLE ??
?? NEWTITLE := 'cmp$resume_pp', EJECT ??
*copyc cmh$resume_pp

  PROCEDURE [XDCL, #GATE] cmp$resume_pp
    (    pp_identification: cmt$pp_identification;
         hardware_resume_pp: boolean;
         start_address: cmt$pp_memory_length;
     VAR pp_software_resumed: boolean;
     VAR status: ost$status);

    VAR
      found: boolean,
      job_name: jmt$system_supplied_name,
      pp_entry_index: iot$pp_number,
      physical_pp: dst$iou_resource,
      system_caller: boolean,
      user_job_name: jmt$user_supplied_name;


    system_caller := osp$is_caller_system_privileged ();
    status.normal := TRUE;
    pp_software_resumed := FALSE;

    cmp$convert_pp_ordinal (pp_identification.ordinal, physical_pp);
    cmp$convert_iou_name (pp_identification.iou, physical_pp.iou_number, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pmp$get_job_names (user_job_name, job_name, status);
    validate_pp_reserved (system_caller, job_name, physical_pp, pp_identification.iou (1, 5), pp_entry_index,
          status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF hardware_resume_pp THEN
      cmp$hardware_resume_pp (physical_pp, start_address, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    cmp$send_pp_command (pp_entry_index, cmc$resume_command, pp_software_resumed, status);

    IF pp_software_resumed THEN
      cmp$free_pp_request (pp_entry_index);
    IFEND;

  PROCEND cmp$resume_pp;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl, #gate] CMP$TASK_TERMINATION_CLEANUP', EJECT ??

  PROCEDURE [XDCL, #GATE] cmp$task_termination_cleanup;

    VAR
      con_access_gtid_list: mst$con_access_gtid_list,
      configured: boolean,
      element_descriptor: cmt$element_descriptor,
      element_found: boolean,
      element_index: integer,
      gtid: ost$global_task_id,
      hardware_address: cmt$hardware_address,
      index: integer,
      job_name: jmt$system_supplied_name,
      job_name_found: boolean,
      lun: iot$logical_unit,
      mainframe_id: pmt$mainframe_id,
      physical_pp: dst$iou_resource,
      pp_id: cmt$pp_identification,
      pp_software_idle: boolean,
      pp_registers: cmt$pp_registers,
      pp_memory_size: cmt$pp_memory_length,
      status: ost$status,
      user_name: jmt$user_supplied_name;

*if $true(osv$ff_debug_code)
    VAR
      i: integer,
      local_status: ost$status,
      str: string (80);
*ifend

    IF (cmv$peripheral_element_table.pointer = NIL) OR (cmv$logical_pp_table_p = NIL) THEN
      RETURN; {----->
    IFEND;

*if $true(osv$ff_debug_code)
    IF (cmv$task_reserved_element_count > 0) THEN
      STRINGREP (str, i, 'cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
      dpp$put_critical_message (str (1, i), local_status);
    IFEND;
*ifend

    pmp$get_job_names (user_name, job_name, status);
    pmp$get_mainframe_id (mainframe_id, status);
    pmp$get_executing_task_gtid (gtid);

  /peripheral_loop/
    FOR index := 1 TO UPPERBOUND (cmv$peripheral_element_table.pointer^) DO

{ Do not release element if the task is a system process
      IF (cmv$peripheral_element_table.pointer^ [index].gtid <> gtid) OR
            (cmv$peripheral_element_table.pointer^ [index].reserved_by_system) THEN
        CYCLE /peripheral_loop/; {----->
      IFEND;

      configured := cmv$peripheral_element_table.pointer^ [index].physical_descriptor.configured;
      IF configured THEN
        element_descriptor.element_type := cmv$peripheral_element_table.pointer^ [index].physical_descriptor.
              element_type;
      ELSEIF cmv$peripheral_element_table.pointer^ [index].physical_descriptor.hardware_address.
            address_specifier = $cmt$physical_address_specifier [cmc$iou, cmc$channel] THEN
        element_descriptor.element_type := cmc$data_channel_element;
      ELSEIF cmv$peripheral_element_table.pointer^ [index].physical_descriptor.hardware_address.
            address_specifier = $cmt$physical_address_specifier
            [cmc$iou, cmc$channel, cmc$channel_address] THEN
        element_descriptor.element_type := cmc$controller_element;
      ELSEIF cmv$peripheral_element_table.pointer^ [index].physical_descriptor.hardware_address.
            address_specifier = $cmt$physical_address_specifier
            [cmc$iou, cmc$channel, cmc$channel_address, cmc$unit_address] THEN
        element_descriptor.element_type := cmc$storage_device_element;
      IFEND;

      IF element_descriptor.element_type = cmc$data_channel_element THEN

        { Set up rest of the element_descriptor for the release_channel_resource.  In the case of a channel,
        { the element name is always in the peripheral_element_table, even if the channel was reserved by
        { physical address.

        element_descriptor.channel_descriptor.use_logical_identification := TRUE;
        element_descriptor.channel_descriptor.name := cmv$peripheral_element_table.pointer^ [index].
              element_name;
        IF cmv$peripheral_element_table.pointer^ [index].physical_descriptor.configured THEN
          cmp$convert_iou_number (cmv$peripheral_element_table.pointer^ [index].physical_descriptor.
                channel_path.iou, element_descriptor.channel_descriptor.iou, status);
        ELSE
          cmp$convert_iou_number (cmv$peripheral_element_table.pointer^ [index].physical_descriptor.
                hardware_address.iou, element_descriptor.channel_descriptor.iou, status);
        IFEND;
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

{ Unmark the cmv$peripheral_element_table.
      cmp$unmark_when_cleanup (index, mainframe_id, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

*if $true(osv$ff_debug_code)
      IF cmv$task_reserved_element_count < 1 THEN
        STRINGREP (str, i, 'cmv$task_reserved_element_count underrun by ', job_name);
        dpp$put_critical_message (str (1, i), local_status);
        cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
      IFEND;

      cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
      STRINGREP (str, i, 'CMV$PERIPHERAL_ELEMENT_TABLE cmv$task_reserved_element_count: ',
            cmv$task_reserved_element_count);
      dpp$put_critical_message (str (1, i), local_status);
*else
      IF cmv$task_reserved_element_count > 0 THEN
        cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
      IFEND;
*ifend

      release_channel_resource (element_descriptor, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF configured THEN
        IF cmv$peripheral_element_table.pointer^ [index].physical_descriptor.element_type =
              cmc$storage_device_element THEN
          lun := cmv$peripheral_element_table.pointer^ [index].logical_unit_number;
          IF cmv$logical_unit_table^ [lun].status.assignable_device THEN
            rmp$release_tape_unit (gfv$null_sfid, lun, {delete_request_from_vsn_queue} FALSE, status);
          IFEND;
        IFEND;
      IFEND;
    FOREND /peripheral_loop/;

    con_access_gtid_list := msv$con_access_gtid_list;

    WHILE con_access_gtid_list <> NIL DO
      IF con_access_gtid_list^.gtid = gtid THEN
        element_index := con_access_gtid_list^.element_index;
        con_access_gtid_list := con_access_gtid_list^.forward_link;
        msp$delete_con_access_gtid (gtid, element_index, status);
        msp$search_element_con_accessed (element_index, element_found, status);
        IF NOT element_found THEN
          msp$search_con_access_job (element_index, job_name, job_name_found, status);
          IF job_name_found THEN
            IF cmv$peripheral_element_table.pointer^ [element_index].physical_descriptor.element_type =
                  cmc$storage_device_element THEN
              IF cmv$peripheral_element_table.pointer^ [element_index].logical_unit_number <> 0 THEN
                cmp$clear_unit_shared (cmv$peripheral_element_table.pointer^ [element_index].
                      logical_unit_number, TRUE);
              IFEND;
            IFEND;
            msp$delete_con_access_job (element_index, job_name, status);
          IFEND;
        IFEND;
        IF cmv$peripheral_element_table.pointer^ [element_index].physical_descriptor.element_type =
              cmc$storage_device_element THEN
          lun := cmv$peripheral_element_table.pointer^ [element_index].logical_unit_number;
          IF cmv$logical_unit_table^ [lun].status.assignable_device THEN
            rmp$release_tape_unit (gfv$null_sfid, lun, {delete_request_from_vsn_queue} FALSE, status);
          IFEND;
        IFEND;
      ELSE
        con_access_gtid_list := con_access_gtid_list^.forward_link;
      IFEND;
    WHILEND;

  /pp_loop/
    FOR index := LOWERBOUND (cmv$logical_pp_table_p^) TO UPPERBOUND (cmv$logical_pp_table_p^) DO
{ Do not release PP if the task is a system process
      IF (cmv$logical_pp_table_p^ [index].task_info.gtid <> gtid) OR
            (cmv$logical_pp_table_p^ [index].flags.entry_reserved_by_system_job) THEN
        CYCLE /pp_loop/; {----->
      IFEND;

      { Unmark the logical pp table.

      physical_pp := cmv$logical_pp_table_p^ [index].pp_info.physical_pp;
      cmp$convert_pp_number (physical_pp, pp_id.ordinal);
      cmp$convert_iou_number (physical_pp.iou_number, pp_id.iou, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      cmp$idle_pp (pp_id, TRUE, TRUE, NIL, pp_memory_size, pp_registers, pp_software_idle, status);
      IF NOT status.normal THEN
        status.normal := TRUE;
      IFEND;

      cmp$release_pp_by_index (index, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      { Clear all channel interlocks held by PP.

      cmp$clear_channel_interlock (physical_pp.iou_number, index, status);

      cmp$unmark_pp_when_cleanup (index, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

*if $true(osv$ff_debug_code)
      IF cmv$task_reserved_element_count < 1 THEN
        STRINGREP (str, i, 'cmv$task_reserved_element_count underrun by ', job_name);
        dpp$put_critical_message (str (1, i), local_status);
        cmv$task_reserved_element_count := cmv$task_reserved_element_count + 1;
      IFEND;

      cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
      STRINGREP (str, i, 'PP cmv$task_reserved_element_count: ', cmv$task_reserved_element_count);
      dpp$put_critical_message (str (1, i), local_status);
*else
      IF cmv$task_reserved_element_count > 0 THEN
        cmv$task_reserved_element_count := cmv$task_reserved_element_count - 1;
      IFEND;
*ifend
    FOREND /pp_loop/;

  PROCEND cmp$task_termination_cleanup;
?? OLDTITLE ??


  PROCEDURE [XDCL, #GATE] cmp$dummy_up_pp
    (VAR element_reservation: array [1 .. * ] of cmt$element_reservation;
     VAR program_description: array [1 .. * ] of cmt$pp_program_description;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      i: integer,
      break_interlock: boolean,
*if $true(osv$debug_code)
      stop: cell,
      kill: ^cell,
*ifend
      hardware_idle: boolean,
      mem_size: cmt$pp_memory_length,
      ppr: cmt$pp_registers,
      idled: boolean,
      pp_program_description: array [1 .. 1] of cmt$pp_program_description;

    status.normal := TRUE;
    pp_program_description [1].pp_identification := program_description [1].pp_identification;
    pp_program_description [1].iou_program_name := 'NERD';
    pp_program_description [1].pp_program := NIL;
    pp_program_description [1].master_pp := program_description [1].master_pp;
    pp_program_description [1].element_access := program_description [1].element_access;
    pp_program_description [1].communication_buffer_length :=
          program_description [1].communication_buffer_length;
    pp_program_description [1].communication_buffer := program_description [1].communication_buffer;

{  Now a request is made to load the dummy PP driver into the PP reserved
{  in the lines above.

    cmp$execute_pp_program (pp_program_description, status);
*if $true(osv$debug_code)
    IF NOT status.normal THEN
      IF cmv$free_trap THEN
        stop := kill^;
      IFEND;
    IFEND;
*ifend

{ Delay 10 seconds to allow name to appear in ved pa display.
    pmp$wait (10000, 10000);

    break_interlock := TRUE;
    hardware_idle := TRUE;

    cmp$idle_pp (pp_program_description [1].pp_identification, break_interlock, hardware_idle, NIL, mem_size,
          ppr, idled, status);
*if $true(osv$debug_code)
    IF NOT idled THEN
      IF cmv$free_trap THEN
        stop := kill^;
      IFEND;
    IFEND;
*ifend

    cmp$release_element (element_reservation, ignore_status);

  PROCEND cmp$dummy_up_pp;

MODEND cmm$manage_element_reservation;
