?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File Server: file_server_pp_mgnt', EJECT ??
MODULE dfm$file_server_pp_mgnt;
{
{  This module contains procedures which provide for control of
{  the File Server ESM PP driver.
{
?? NEWTITLE := '    Global Declarations ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cmt$pp_program_description
*copyc dfc$iou_names
*copyc dfd$driver_queue_types
*copyc dft$esm_definition_table
*copyc dft$pp_element_reservations
*copyc dft$queue_interface_directory
*copyc dft$request_buffer
*copyc pmt$mainframe_id
?? POP ??
*copyc dfe$error_condition_codes
*copyc dfv$one_word_response_handler
*copyc dfv$p_queue_interface_directory
*copyc dfv$server_wired_heap
*copyc osv$page_size
*copyc cmp$execute_pp_program
*copyc cmp$get_channel_definition
*copyc cmp$get_element_definition
*copyc cmp$get_iou_definition
*copyc cmp$get_logical_pp_index
*copyc cmp$idle_pp
*copyc cmp$pc_get_element
*copyc cmp$release_element
*copyc cmp$reserve_element
*copyc cmp$resume_pp
*copyc dfp$active_queue_exists
*copyc cmp$store_file_server_info
*copyc dfp$convert_p_qit_to_io_request
*copyc dfp$locate_esm_definition
*copyc dfp$verify_esm_product_id
*copyc osp$append_status_parameter
*copyc osp$clear_signature_lock
*copyc osp$set_signature_lock
*copyc osp$set_status_abnormal
*copyc pmp$get_mainframe_id
*copyc pmp$long_term_wait
*copyc pmp$zero_out_table
?? TITLE := '    Inline Procedures ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfi$display
?? POP ??

?? TITLE := ' [XDCL]  dfp$activate_pp ', EJECT ??
{    This procedure brings the file server's ESM PP driver to a state
{    of readiness to process file server requests.
{    The PP and channel elements will be reserved; the PP will be loaded
{    and executed; the pointer to the file server queue interface table
{    will be stored into the next unit request pointer word of the PP
{    interface table (PIT), and, since the PP driver initializes itself
{    as idle, a resume PP request will be queued to the PP.
{
{    DFP$ACTIVATE_PP (P_Q_INTERFACE_DIRECTORY_ENTRY, USE_DMA, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be activated.
{
{    USE_DMA: (input) This parameter, if true, specifies that the PP driver
{      is to utilize the DMA capability of the channel if that capability
{      is available. If false or the channel does not have DMA capability
{      the PP will move data through PP memory to/from the channel.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of the activation procedure.


  PROCEDURE [XDCL] dfp$activate_pp
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         use_dma: boolean;
     VAR status: ost$status);


    VAR
      ignore_status: ost$status,
      iou_definition: cmt$iou_definition,
      iou_name: cmt$element_name,
      p_io_request: ^iot$io_request;

    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);
      RETURN;
    IFEND;

    { Insure PP(s) are loaded to establish IOU tables (PIT etc.)
    dfp$load_pp (p_q_interface_directory_entry, status);
    IF NOT status.normal THEN
      dfp$unload_pp (p_q_interface_directory_entry, ignore_status);
      RETURN;
    IFEND;

    { Activate the send PP.
    p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.dma_adapter.
          use_on_send_channel := (p_q_interface_directory_entry^.send_pp.dma_capability) AND (use_dma);
    p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.dma_adapter.
          use_on_recv_channel := (p_q_interface_directory_entry^.receive_pp.dma_capability) AND (use_dma);

    dfp$convert_p_qit_to_io_request (p_q_interface_directory_entry^.p_queue_interface_table, p_io_request);
    cmp$store_file_server_info (p_q_interface_directory_entry^.p_queue_interface_table^.
         queue_directory.send_pp_number, p_io_request, {one word response allowed = } TRUE,
         dfv$one_word_response_handler, status);
    IF status.normal THEN
      p_q_interface_directory_entry^.send_pp.pp_status.activated := TRUE;

      IF p_q_interface_directory_entry^.send_channel <> p_q_interface_directory_entry^.receive_channel THEN
        { Activate the receive PP.
         cmp$store_file_server_info (p_q_interface_directory_entry^.p_queue_interface_table^.
              queue_directory.receive_pp_number, p_io_request, {one word response allowed = } TRUE,
              dfv$one_word_response_handler, status);
        IF status.normal THEN
          p_q_interface_directory_entry^.receive_pp.pp_status.activated := TRUE;
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
{   This code is needed for CYBER 930.
      iou_name := dfc$iou_name0;
      cmp$get_iou_definition (iou_name, iou_definition, status);
      p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.dma_adapter.iou_i0_model :=
            (iou_definition.kind = dsc$imn_i0_5x_model);
    IFEND;

    IF status.normal THEN
      p_q_interface_directory_entry^.driver_active := TRUE;
      dfp$resume_pp (p_q_interface_directory_entry, status);
    IFEND;

  PROCEND dfp$activate_pp;

?? TITLE := ' [XDCL]  dfp$change_pp ', EJECT ??
{    This procedure changes the file servers ESM connection element name
{    in the queue interface directory table. The PP(s) must be inactive/unloaded
{    before this process will allow the change.
{
{    DFP$CHANGE_PP (P_Q_INTERFACE_DIRECTORY_ENTRY, NEW_NAME, PP_TASK, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be changed.
{
{    NEW_NAME: (input) This parameter specifies the new ESM element name.
{
{    PP_TASK: (input) This parameter specifies the task the PP performs on
{      behalf of the connection.
{      SEND, PP processes file server request from the request buffer.
{  ==> RECEIVE, PP process file server requests queue in ESM flag registers.
{  ==> BOTH, PP performs both send and receive processing.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$change_pp
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         new_name: cmt$element_name;
         pp_task: ost$name;
     VAR status: ost$status);


    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);
      RETURN;
    IFEND;
    dfp$verify_element_name (new_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (p_q_interface_directory_entry^.send_pp.p_element_reservations = NIL) AND
          (NOT p_q_interface_directory_entry^.send_pp.pp_status.activated) THEN
      IF (pp_task = 'SEND') OR (pp_task = 'BOTH') THEN
        p_q_interface_directory_entry^.element_name := new_name;
      IFEND;
      IF (pp_task = 'RECEIVE') THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$connection_not_changed,
             p_q_interface_directory_entry^.element_name, status);
      IFEND;
    ELSE
      osp$set_status_abnormal (dfc$file_server_id, dfe$connection_not_changed,
            p_q_interface_directory_entry^.element_name, status);
    IFEND;

  PROCEND dfp$change_pp;
?? TITLE := ' [XDCL]  dfp$idle_pp ', EJECT ??
{    This procedure causes an idle PP request to be issued to the file server's
{    ESM PP(s). The PP(s) must be active and not already idle before an idle
{    request will be issued.
{
{    DFP$IDLE_PP (P_Q_INTERFACE_DIRECTORY_ENTRY, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be idled.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$idle_pp
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
     VAR status: ost$status);

    VAR
      pp_memory_length: cmt$pp_memory_length,
      pp_registers: cmt$pp_registers,
      soft_idled: boolean;


    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);
      RETURN;
    IFEND;

    IF (p_q_interface_directory_entry^.send_pp.p_element_reservations <> NIL) AND
          (NOT p_q_interface_directory_entry^.send_pp.pp_status.idled) THEN
      IF p_q_interface_directory_entry^.send_pp.pp_status.activated THEN
        cmp$idle_pp (p_q_interface_directory_entry^.send_pp.p_element_reservations^ [1].pp_reservation.
              acquired_pp_identification, FALSE {break_interlocks} , FALSE {hard idle} ,
              NIL {pp_memory_area} , pp_memory_length, pp_registers, soft_idled, status);
        p_q_interface_directory_entry^.send_pp.pp_status.idled := (status.normal) AND (soft_idled);
      IFEND;
    IFEND;
    IF status.normal THEN
      IF p_q_interface_directory_entry^.send_channel <> p_q_interface_directory_entry^.receive_channel THEN
        IF (p_q_interface_directory_entry^.receive_pp.p_element_reservations <> NIL) AND
              (NOT p_q_interface_directory_entry^.receive_pp.pp_status.idled) THEN
          IF p_q_interface_directory_entry^.receive_pp.pp_status.activated THEN
            cmp$idle_pp (p_q_interface_directory_entry^.receive_pp.p_element_reservations^ [1].pp_reservation.
                  acquired_pp_identification, FALSE {break_interlocks} , FALSE {hard idle} , NIL
                  {pp_memory_area} , pp_memory_length, pp_registers, soft_idled, status);
            p_q_interface_directory_entry^.receive_pp.pp_status.idled := (status.normal) AND (soft_idled);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND dfp$idle_pp;

?? TITLE := ' [XDCL]  dfp$load_pp ', EJECT ??
{    This procedure provides for the hardware reservation and loading of the
{    driver into PP(s) which will service the file server connection when
{    activated. This procedure does not activate the PP(s).
{
{    DFP$LOAD_PP (P_Q_INTERFACE_DIRECTORY_ENTRY, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be loaded.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$load_pp
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
     VAR status: ost$status);


    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);
      RETURN;
    IFEND;

    { Insure PP and channel elements are reserved.
    IF p_q_interface_directory_entry^.send_pp.p_element_reservations = NIL THEN
      { Reserve send ESM element and PP.
      reserve_esm_element (p_q_interface_directory_entry^.element_name,
            p_q_interface_directory_entry^.send_channel,
            p_q_interface_directory_entry^.send_pp.p_element_reservations,
            p_q_interface_directory_entry^.send_pp.channel_address,
            p_q_interface_directory_entry^.send_pp.dma_capability, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      { Incase only one channel make receive same as send dma capability.
      p_q_interface_directory_entry^.receive_pp.dma_capability :=
            p_q_interface_directory_entry^.send_pp.dma_capability;
    IFEND;

    IF p_q_interface_directory_entry^.receive_channel <> p_q_interface_directory_entry^.send_channel THEN
      IF p_q_interface_directory_entry^.receive_pp.p_element_reservations = NIL THEN
        { Reserve receive ESM element and PP.
        reserve_esm_element (p_q_interface_directory_entry^.element_name,
              p_q_interface_directory_entry^.receive_channel,
              p_q_interface_directory_entry^.receive_pp.p_element_reservations,
              p_q_interface_directory_entry^.receive_pp.channel_address,
              p_q_interface_directory_entry^.receive_pp.dma_capability, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    { IF the send and receive channels are different then two PPs are loaded.

    IF NOT p_q_interface_directory_entry^.send_pp.pp_status.loaded THEN
      load_and_execute (p_q_interface_directory_entry^.send_pp.channel_address,
            p_q_interface_directory_entry^.send_channel,
            p_q_interface_directory_entry^.send_pp.p_element_reservations,
            p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.send_pp_number, status);
      IF status.normal THEN
        p_q_interface_directory_entry^.send_pp.pp_status.activated := FALSE;
        p_q_interface_directory_entry^.send_pp.pp_status.loaded := TRUE;
        p_q_interface_directory_entry^.send_pp.pp_status.idled := TRUE;

      ELSE
        RETURN;
      IFEND;
      IF p_q_interface_directory_entry^.receive_channel = p_q_interface_directory_entry^.send_channel THEN
        p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.receive_pp_number :=
              p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.send_pp_number;
      IFEND;
    IFEND;

    IF p_q_interface_directory_entry^.receive_channel <> p_q_interface_directory_entry^.send_channel THEN
      IF NOT p_q_interface_directory_entry^.receive_pp.pp_status.loaded THEN
        load_and_execute (p_q_interface_directory_entry^.receive_pp.channel_address,
              p_q_interface_directory_entry^.receive_channel,
              p_q_interface_directory_entry^.receive_pp.p_element_reservations,
              p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.receive_pp_number,
              status);
        IF status.normal THEN
          p_q_interface_directory_entry^.receive_pp.pp_status.activated := FALSE;
          p_q_interface_directory_entry^.receive_pp.pp_status.loaded := TRUE;
          p_q_interface_directory_entry^.receive_pp.pp_status.idled := TRUE;

        ELSE
          RETURN;
        IFEND;
      IFEND;
    IFEND;
  PROCEND dfp$load_pp;

?? TITLE := ' [XDCL]  dfp$load_pp_if_first ', EJECT ??
{    This procedure provides for requesting the loading (activating) of
{    the PP driver if all queues of the associated queue interface table are
{    idle. A signature lock is used here in order to prevent two processes
{    from requesting loading at approximately the same time  (that is, loading
{    is initiated but before appropriate flags are set another process
{    initiates the loading also).
{
{    DFP$LOAD_PP_IF_FIRST (P_Q_INTERFACE_DIRECTORY_ENTRY, QUEUE_INDEX, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be loaded.
{
{    QUEUE_INDEX: (input) This parameter specifies the index of the queue which
{      is being activated.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$load_pp_if_first
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         queue_index: dft$queue_index;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      other_queue_active: boolean,
      p_driver_queue: ^dft$driver_queue,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_request_buffer_directory: ^dft$request_buffer_directory;

    status.normal := TRUE;

    p_queue_interface_table := p_q_interface_directory_entry^.p_queue_interface_table;
    p_driver_queue := p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue;

    osp$set_signature_lock (p_q_interface_directory_entry^.load_unload_pp_lock, osc$wait, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    other_queue_active := dfp$active_queue_exists (p_queue_interface_table);
    p_driver_queue^.queue_header.flags.idle := FALSE;
    IF NOT other_queue_active THEN
      {Initialization of request_buffer_directory should be a call to a procedure in queue_initialization
      p_request_buffer_directory := ^p_queue_interface_table^.request_buffer_directory;
      pmp$zero_out_table (p_request_buffer_directory^.p_request_buffer, #SIZE (
            p_request_buffer_directory^.p_request_buffer^));
      p_request_buffer_directory^.inn := 0;
      p_request_buffer_directory^.out := 0;
      dfp$activate_pp (p_q_interface_directory_entry, p_q_interface_directory_entry^.use_dma, status);
    IFEND;

    osp$clear_signature_lock (p_q_interface_directory_entry^.load_unload_pp_lock, ignore_status);

  PROCEND dfp$load_pp_if_first;

?? TITLE := ' [XDCL]  dfp$resume_pp ', EJECT ??
{    This procedure causes a resume PP request to be issued to the file server's
{    ESM PP(s). The PP(s) must be active and idle before a resume request will
{    be issued.
{
{    DFP$RESUME_PP (P_Q_INTERFACE_DIRECTORY_ENTRY, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be resumed.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$resume_pp
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
     VAR status: ost$status);


    VAR
      pp_registers: cmt$pp_registers,
      start_address: cmt$pp_memory_length,
      soft_resumed: boolean;



    status.normal := TRUE;

    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);
      RETURN;
    IFEND;

    { If the send and receive element names are different, then each
    { of the PPs will be resumed.

    IF (p_q_interface_directory_entry^.send_pp.p_element_reservations <> NIL) AND
          (p_q_interface_directory_entry^.send_pp.pp_status.activated) AND
          (p_q_interface_directory_entry^.send_pp.pp_status.idled) THEN
      cmp$resume_pp (p_q_interface_directory_entry^.send_pp.p_element_reservations^ [1].pp_reservation.
            acquired_pp_identification, FALSE {hardware resume} , start_address, soft_resumed, status);

      p_q_interface_directory_entry^.send_pp.pp_status.idled := NOT ((status.normal) AND (soft_resumed));
      IF NOT soft_resumed THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$path_to_stornet_broken,
              p_q_interface_directory_entry^.element_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              p_q_interface_directory_entry^.send_channel.iou_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              p_q_interface_directory_entry^.send_channel.channel_name, status);
        RETURN;
      IFEND;
    IFEND;

    IF status.normal THEN
      IF p_q_interface_directory_entry^.send_channel <> p_q_interface_directory_entry^.receive_channel THEN
        IF (p_q_interface_directory_entry^.receive_pp.p_element_reservations <> NIL) AND
              (p_q_interface_directory_entry^.receive_pp.pp_status.activated) AND
              (p_q_interface_directory_entry^.receive_pp.pp_status.loaded) THEN
          cmp$resume_pp (p_q_interface_directory_entry^.receive_pp.p_element_reservations^ [1].pp_reservation.
                acquired_pp_identification, FALSE {hardware resume} , start_address, soft_resumed, status);
          p_q_interface_directory_entry^.receive_pp.pp_status.idled :=
                NOT ((status.normal) AND (soft_resumed));
          IF NOT soft_resumed THEN
            osp$set_status_abnormal (dfc$file_server_id, dfe$path_to_stornet_broken,
                  p_q_interface_directory_entry^.element_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  p_q_interface_directory_entry^.receive_channel.iou_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  p_q_interface_directory_entry^.receive_channel.channel_name, status);
            RETURN;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND dfp$resume_pp;


?? TITLE := ' [XDCL]  dfp$set_esm_divisions ', EJECT ??
{    This procedure provides for setting the number of ESM memory subdivisions.
{
{    DFP$SET_ESM_DIVISIONS (P_Q_INTERFACE_DIRECTORY_ENTRY, NUMBER_OF_DIVISIONS, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection for which the
{      number of divisions is to be changed.
{
{    NUMBER_OF_DIVISIONS: (input) specifies ESM memory divisions per mainframe
{      (number of subdivisions the block of ESM memory allocated to each
{       mainframe is to be divided into).
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$set_esm_divisions
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         number_of_divisions: dft$divisions_per_mainframe;
     VAR status: ost$status);



    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);

    ELSE
      p_q_interface_directory_entry^.p_queue_interface_table^.esm_base_addresses.divisions_per_mainframe :=
            number_of_divisions;
      status.normal := TRUE;

    IFEND;

  PROCEND dfp$set_esm_divisions;

?? TITLE := ' [XDCL]  dfp$unload_pp ', EJECT ??
{    This procedure brings the file server's ESM PP driver to an inactive
{    state. An idle PP request is issued to the PP(s), and the PP and channel
{    element reservations are released.
{
{    DFP$UNLOAD_PP (P_Q_INTERFACE_DIRECTORY_ENTRY, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be unloaded.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of the unload PP procedure.


  PROCEDURE [XDCL] dfp$unload_pp
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      p_esm_def_table_entry: ^dft$esm_definition_table_entry,
      pp_registers: cmt$pp_registers,
      start_address: cmt$pp_memory_length;

    status.normal := TRUE;

    IF p_q_interface_directory_entry^.connection_type <> dfc$esm_connection THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$not_stornet_connection,
            p_q_interface_directory_entry^.driver_name, status);
      RETURN;
    IFEND;

    dfp$locate_esm_definition (p_q_interface_directory_entry^.element_name, p_esm_def_table_entry);
    IF p_esm_def_table_entry = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$stornet_not_defined,
            p_q_interface_directory_entry^.element_name, status);
      RETURN;
    IFEND;

    IF p_q_interface_directory_entry^.send_pp.p_element_reservations <> NIL THEN
      IF NOT p_q_interface_directory_entry^.send_pp.pp_status.idled THEN
        { soft idle PPs, cmp$release_element will issue hard idle.
        dfp$idle_pp (p_q_interface_directory_entry, ignore_status);
      IFEND;
      { Return the reserved elements.}
      cmp$release_element (p_q_interface_directory_entry^.send_pp.p_element_reservations^, status);
      IF status.normal THEN
        mark_unload (p_q_interface_directory_entry, p_q_interface_directory_entry^.send_channel);
        FREE p_q_interface_directory_entry^.send_pp.p_element_reservations IN dfv$server_wired_heap^;
        IF p_esm_def_table_entry^.number_of_pps_using_esm <> 0 THEN
          p_esm_def_table_entry^.number_of_pps_using_esm := p_esm_def_table_entry^.
               number_of_pps_using_esm - 1;
        IFEND;
      IFEND;
    IFEND;

    IF status.normal THEN
      IF p_q_interface_directory_entry^.send_channel <> p_q_interface_directory_entry^.receive_channel THEN
        IF p_q_interface_directory_entry^.receive_pp.p_element_reservations <> NIL THEN
          IF NOT p_q_interface_directory_entry^.send_pp.pp_status.idled THEN
            { soft idle PPs, cmp$release_element will issue hard idle.
            dfp$idle_pp (p_q_interface_directory_entry, ignore_status);
          IFEND;
          { Return the reserved receive elements.}
          cmp$release_element (p_q_interface_directory_entry^.receive_pp.p_element_reservations^, status);
          IF status.normal THEN
            mark_unload (p_q_interface_directory_entry, p_q_interface_directory_entry^.receive_channel);
            FREE p_q_interface_directory_entry^.receive_pp.p_element_reservations IN dfv$server_wired_heap^;
            IF p_esm_def_table_entry^.number_of_pps_using_esm <> 0 THEN
              p_esm_def_table_entry^.number_of_pps_using_esm := p_esm_def_table_entry^.
                   number_of_pps_using_esm - 1;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    IF p_esm_def_table_entry^.number_of_pps_using_esm = 0 THEN
      IF p_esm_def_table_entry^.p_element_reservation <> NIL THEN
{       Return the reserved ESM device.
        cmp$release_element (p_esm_def_table_entry^.p_element_reservation^, status);
        IF status.normal THEN
          FREE p_esm_def_table_entry^.p_element_reservation IN dfv$server_wired_heap^;
        IFEND;
      IFEND;
    IFEND;
  PROCEND dfp$unload_pp;
?? TITLE := '  [XDCL] dfp$unload_pp_if_last', EJECT ??
{    This procedure provides for requesting the unloading of the PP driver
{    if all the queues of the associated queue interface table are idle. A
{    signature lock is used here in order to prevent two processes from
{    requesting unloading at approximately the same time.
{
{    DFP$UNLOAD_PP_IF_LAST (P_Q_INTERFACE_DIRECTORY_ENTRY, QUEUE_INDEX, STATUS)
{
{    P_Q_INTERFACE_DIRECTORY_ENTRY: (input) This parameter is a pointer to
{      queue_interface_directory entry of the ESM connection to be unloaded.
{
{    QUEUE_INDEX: (input) This parameter specifies the index of the queue which
{      is being deactivated.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of the unload PP procedure.


  PROCEDURE [XDCL] dfp$unload_pp_if_last
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         queue_index: dft$queue_index;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      p_queue_interface_table: dft$p_queue_interface_table;

    status.normal := TRUE;

    p_queue_interface_table := p_q_interface_directory_entry^.p_queue_interface_table;

    IF NOT p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue^.
          queue_header.flags.idle THEN
      p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue^.
            queue_header.flags.idle := TRUE;
{Delay since at present the PP does not acknowledge the idle request set by caller.
      pmp$long_term_wait (2000, 2000);
    IFEND;

{Check for any active queues.

    osp$set_signature_lock (p_q_interface_directory_entry^.load_unload_pp_lock, osc$wait, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT dfp$active_queue_exists (p_queue_interface_table) THEN
      dfp$unload_pp (p_q_interface_directory_entry, status);
    IFEND;

    osp$clear_signature_lock (p_q_interface_directory_entry^.load_unload_pp_lock, ignore_status);

  PROCEND dfp$unload_pp_if_last;

?? TITLE := ' [XDCL] dfp$verify_element_name ', EJECT ??
{    This procedure verifies that the specified element name belongs to
{    an element assigned an ESM product id.
{
{    DFP$VERIFY_ELEMENT_NAME (ELEMENT_NAME, STATUS)
{
{    ELEMENT_NAME: (input) This parameter is the element name to be verified.
{
{    STATUS: (output) This is ost$status which indicates success or failure
{      of this procedure.
{

  PROCEDURE [XDCL] dfp$verify_element_name
    (    element_name: cmt$element_name;
     VAR status: ost$status);

    VAR
      element_definition: cmt$element_definition,
      element_descriptor: cmt$element_descriptor;


    element_descriptor.element_type := cmc$communications_element;
    element_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
    element_descriptor.peripheral_descriptor.element_name := element_name;

    cmp$get_element_definition (element_descriptor, element_definition, status);
    IF status.normal THEN
      { Verify that the specified element is the ESM product.
      dfp$verify_esm_product_id (element_definition.product_id, status);
    IFEND;

  PROCEND dfp$verify_element_name;

?? TITLE := '    [XDCL] dfp$verify_stornet_channel ', EJECT ??
  PROCEDURE [XDCL] dfp$verify_stornet_channel
    (    esm_element_name: cmt$element_name;
         channel: dft$channel_specification;
     VAR status: ost$status);

    VAR
      element_definition: cmt$element_definition,
      element_descriptor: cmt$element_descriptor,
      found: boolean,
      mainframe_id: pmt$mainframe_id,
      port_number: cmt$communications_port_number;


    status.normal := TRUE;
    pmp$get_mainframe_id (mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Get ESM element_descriptor.
    element_descriptor.element_type := cmc$communications_element;
    element_descriptor.peripheral_descriptor.use_logical_identification := TRUE;
    element_descriptor.peripheral_descriptor.element_name := esm_element_name;
    cmp$get_element_definition (element_descriptor, element_definition, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Verify that the specified element is the ESM product.
    dfp$verify_esm_product_id (element_definition.product_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Find channel in ESM element_definition.
    found := FALSE;
  /find_channel/
    FOR port_number := LOWERVALUE (cmt$communications_port_number)
          TO UPPERVALUE (cmt$communications_port_number) DO
      IF element_definition.communications_element.connection.port [port_number].configured THEN
        IF ((channel.channel_name = element_definition.communications_element.connection.port [port_number].
              element_name) AND
            (channel.iou_name = element_definition.communications_element.connection.port [port_number].
              iou) AND
            (mainframe_id = element_definition.communications_element.connection.port [port_number].
              mainframe_ownership)) THEN
          found := TRUE;
          EXIT /find_channel/;
       IFEND;
      IFEND;
    FOREND /find_channel/;

    IF NOT found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$invalid_channel, channel.channel_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, channel.iou_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, mainframe_id, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, esm_element_name, status);
    IFEND;

  PROCEND dfp$verify_stornet_channel;

?? TITLE := ' load_and_execute ', EJECT ??

  PROCEDURE load_and_execute
    (    channel_address: cmt$physical_equipment_number;
         channel_specification: dft$channel_specification;
         p_element_reservations: ^dft$pp_element_reservations;
     VAR pp_number: iot$pp_number;
     VAR status: ost$status);


    VAR
      element_access: array [1 .. 1] of cmt$hardware_address,
      local_status: ost$status,
      p_channel_element_definition: ^cmt$element_definition,
      pp_index : iot$pp_number,
      program_description: array [1 .. 1] of cmt$pp_program_description;


    { Build the program descriptor and request load and execute of a PP.

    program_description [1].pp_identification := p_element_reservations^ [1].pp_reservation.
          acquired_pp_identification;
    program_description [1].iou_program_name := 'ESMD';
    program_description [1].pp_program := NIL;
    program_description [1].master_pp := TRUE;
    program_description [1].communication_buffer_length := osv$page_size;
    program_description [1].communication_buffer := NIL;

    element_access [1].physical_address_specifier := $cmt$physical_address_specifier
          [cmc$iou, cmc$channel, cmc$channel_address];
    element_access [1].iou := p_element_reservations^ [1].pp_reservation.channel.iou;
    element_access [1].channel.ordinal := p_element_reservations^ [1].pp_reservation.channel.ordinal;
    element_access [1].channel.iou := p_element_reservations^ [1].pp_reservation.channel.iou;
    element_access [1].channel_address := channel_address;

    program_description [1].element_access := ^element_access;

    cmp$execute_pp_program (program_description, status);
    IF status.normal THEN
      cmp$pc_get_element (channel_specification.channel_name, channel_specification.iou_name,
                          p_channel_element_definition, status);
      IF status.normal THEN
        cmp$get_logical_pp_index (p_channel_element_definition^, pp_index, status);
        IF status.normal THEN
          pp_number := pp_index;
        IFEND;
      IFEND;
    IFEND;

  PROCEND load_and_execute;

?? TITLE := ' mark_unload ', EJECT ??

  PROCEDURE mark_unload
    (    p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
         channel: dft$channel_specification);


    { This procedure sets ESM PP status flags in the queue directory entry
    { to reflect the unloaded/inactive state of the specified PP.


    IF channel = p_q_interface_directory_entry^.send_channel THEN
      p_q_interface_directory_entry^.driver_active := FALSE;
      p_q_interface_directory_entry^.send_pp.pp_status.activated := FALSE;
      p_q_interface_directory_entry^.send_pp.pp_status.loaded := FALSE;
      p_q_interface_directory_entry^.send_pp.pp_status.idled := TRUE;
      p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.send_pp_number := 0;
      IF p_q_interface_directory_entry^.send_channel = p_q_interface_directory_entry^.receive_channel THEN
        p_q_interface_directory_entry^.receive_pp.pp_status.activated := FALSE;
        p_q_interface_directory_entry^.receive_pp.pp_status.loaded := FALSE;
        p_q_interface_directory_entry^.receive_pp.pp_status.idled := TRUE;
        p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.receive_pp_number := 0;
      IFEND;

    ELSE { Receive channel different than send channel }
      p_q_interface_directory_entry^.receive_pp.pp_status.activated := FALSE;
      p_q_interface_directory_entry^.receive_pp.pp_status.loaded := FALSE;
      p_q_interface_directory_entry^.receive_pp.pp_status.idled := TRUE;
      p_q_interface_directory_entry^.p_queue_interface_table^.queue_directory.receive_pp_number := 0;
    IFEND;

  PROCEND mark_unload;

?? TITLE := ' reserve_esm_element ', EJECT ??

  PROCEDURE reserve_esm_element
    (    esm_element_name: cmt$element_name;
         channel: dft$channel_specification;
     VAR p_element_reservations: ^dft$pp_element_reservations;
     VAR channel_address: cmt$physical_equipment_number;
     VAR dma: boolean;
     VAR status: ost$status);

    VAR
      channel_definition: cmt$data_channel_definition,
      channel_descriptor: cmt$channel_descriptor,
      found: boolean,
      p_esm_def_table_entry: ^dft$esm_definition_table_entry;


    { This procedure allocates and fills in the required fields of the
    { element reservation record for the specified ESM element. A PP and
    { a channel (accessable by the PP) are reserved.

    dfp$locate_esm_definition (esm_element_name, p_esm_def_table_entry);
    IF p_esm_def_table_entry = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$stornet_not_defined, esm_element_name, status);
      RETURN;
    IFEND;

    dfp$verify_stornet_channel (esm_element_name, channel, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    channel_descriptor.use_logical_identification := TRUE;
    channel_descriptor.name := channel.channel_name;
    channel_descriptor.iou := channel.iou_name;

    cmp$get_channel_definition (channel_descriptor, channel_definition, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    found := FALSE;

  /verify_channel_esm_connection/
    FOR channel_address := LOWERVALUE (cmt$physical_equipment_number)
          TO UPPERVALUE (cmt$physical_equipment_number) DO
      IF (channel_definition.connection.equipment [channel_address].configured) AND
            (channel_definition.connection.equipment [channel_address].element_name = esm_element_name) THEN
        dma := channel_definition.direct_memory_access;
        found := TRUE;
        EXIT /verify_channel_esm_connection/;
      IFEND;
    FOREND /verify_channel_esm_connection/;

    IF NOT found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$no_configured_equipment, channel_descriptor.name,
            status);
      osp$append_status_parameter (osc$status_parameter_delimiter, esm_element_name, status);
      RETURN;
    IFEND;

{   Reserve the STORNET/ESM element if not already reserved.
    IF p_esm_def_table_entry^.p_element_reservation = NIL THEN
      ALLOCATE p_esm_def_table_entry^.p_element_reservation IN dfv$server_wired_heap^;
      p_esm_def_table_entry^.p_element_reservation^ [1].element_type := cmc$communications_element;
      p_esm_def_table_entry^.p_element_reservation^ [1].peripheral_descriptor.
           use_logical_identification := TRUE;
      p_esm_def_table_entry^.p_element_reservation^[1].peripheral_descriptor.element_name := esm_element_name;
      cmp$reserve_element (p_esm_def_table_entry^.p_element_reservation^, status);
      IF NOT status.normal THEN
        FREE p_esm_def_table_entry^.p_element_reservation IN dfv$server_wired_heap^;
        RETURN;
      IFEND;
    IFEND;

{   Reserve the CHANNEL/PP element.
    ALLOCATE p_element_reservations IN dfv$server_wired_heap^;
    p_element_reservations^ [1].element_type := cmc$pp_element;
    p_element_reservations^ [1].pp_reservation.selector := cmc$choose_pp_by_channel;
    p_element_reservations^ [1].pp_reservation.channel.ordinal := channel_definition.ordinal;
    p_element_reservations^ [1].pp_reservation.channel.iou := channel_definition.iou;
    cmp$reserve_element (p_element_reservations^, status);
    IF NOT status.normal THEN
      FREE p_element_reservations IN dfv$server_wired_heap^;
      RETURN;
    IFEND;
    p_esm_def_table_entry^.number_of_pps_using_esm := p_esm_def_table_entry^.number_of_pps_using_esm + 1;

  PROCEND reserve_esm_element;


MODEND dfm$file_server_pp_mgnt;
