?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File Server: pp_management_commands', EJECT ??
MODULE dfm$pp_management_commands;
{
{  This module contains procedures which process file server PP management
{  commands for the FILE_SERVER_TEST_UTILITY.
{
?? NEWTITLE := '    Global Declarations ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dft$pp_element_reservations
*copyc dft$queue_interface_directory
?? POP ??
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc dfe$error_condition_codes
*copyc dfp$activate_pp
*copyc dfp$change_pp
*copyc dfp$idle_pp
*copyc dfp$load_pp
*copyc dfp$resume_pp
*copyc dfp$set_esm_divisions
*copyc dfp$unload_pp
*copyc dfv$p_queue_interface_directory
*copyc osp$set_status_abnormal
?? TITLE := '    Inline Procedures ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfi$display
?? POP ??
?? TITLE := ' [XDCL] dfp$activate_pp_command ', EJECT ??
{ The purpose of this routine is to process the file server ACTIVATE_PP command.

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

{   pdt activate_pp (element_name, en: name = $required
{   use_dma, ud: boolean = true
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      activate_pp: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^activate_pp_names, ^activate_pp_params];

    VAR
      activate_pp_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['USE_DMA', 2], ['UD', 2],
            ['STATUS', 3]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ USE_DMA UD }
      [[clc$optional_with_default, ^activate_pp_dv2], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

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

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

?? POP ??

    VAR
      element: clt$value,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      use_dma: clt$value;

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

    clp$get_value ('ELEMENT_NAME', 1, 1, clc$low, element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('USE_DMA', 1, 1, clc$low, use_dma, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    locate_q_directory_entry (element.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      dfp$activate_pp (p_q_interface_directory_entry, use_dma.bool.value, status)
    IFEND;
  PROCEND dfp$activate_pp_command;

?? TITLE := ' [XDCL] dfp$change_pp_command ', EJECT ??
{ The purpose of this routine is to process the file server CHANGE_PP command.

  PROCEDURE [XDCL] dfp$change_pp_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{    pdt change_pp (old_name, on: name = $required
{     new_name, nn: name = $required
{     pp_task, ppt: key send, receive, both = both
{     status)

?? PUSH (LISTEXT := ON) ??

    VAR
      change_pp: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^change_pp_names, ^change_pp_params];

    VAR
      change_pp_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
            clt$parameter_name_descriptor := [['OLD_NAME', 1], ['ON', 1], ['NEW_NAME', 2], ['NN', 2],
            ['PP_TASK', 3], ['PPT', 3], ['STATUS', 4]];

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

{ OLD_NAME ON }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ NEW_NAME NN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ PP_TASK PPT }
      [[clc$optional_with_default, ^change_pp_dv3], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^change_pp_kv3, clc$keyword_value]],

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

    VAR
      change_pp_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of ost$name := ['SEND',
            'RECEIVE', 'BOTH'];

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

?? POP ??


    VAR
      new_name: clt$value,
      old_name: clt$value,
      pp_task: clt$value,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry;

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

    clp$get_value ('OLD_NAME', 1, 1, clc$low, old_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('NEW_NAME', 1, 1, clc$low, new_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    locate_q_directory_entry (old_name.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      clp$get_value ('PP_TASK', 1, 1, clc$low, pp_task, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dfp$change_pp (p_q_interface_directory_entry, new_name.name.value, pp_task.name.value, status);
    IFEND;
  PROCEND dfp$change_pp_command;

?? TITLE := ' [XDCL] dfp$idle_pp_command ', EJECT ??
{ The purpose of this routine is to process the file server IDLE_PP command.

  PROCEDURE [XDCL] dfp$idle_pp_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);



{  pdt idle_pp (element_name, en: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      idle_pp: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^idle_pp_names, ^idle_pp_params];

    VAR
      idle_pp_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['STATUS', 2]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

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

?? POP ??


    VAR
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      value: clt$value;

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

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

    locate_q_directory_entry (value.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      dfp$idle_pp (p_q_interface_directory_entry, status);
    IFEND;
  PROCEND dfp$idle_pp_command;

?? TITLE := ' [XDCL] dfp$load_pp_command ', EJECT ??
{ The purpose of this routine is to process the file server LOAD_PP command.

  PROCEDURE [XDCL] dfp$load_pp_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{  pdt load_pp (element_name, en: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      load_pp: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^load_pp_names, ^load_pp_params];

    VAR
      load_pp_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['STATUS', 2]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

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

?? POP ??


    VAR
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      value: clt$value;

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

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

    locate_q_directory_entry (value.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      dfp$load_pp (p_q_interface_directory_entry, status);
    IFEND;
  PROCEND dfp$load_pp_command;

?? TITLE := ' [XDCL] dfp$resume_pp_command ', EJECT ??
{ The purpose of this routine is to process the file server RESUME_PP command.

  PROCEDURE [XDCL] dfp$resume_pp_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{  pdt resume_pp (element_name, en: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      resume_pp: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^resume_pp_names, ^resume_pp_params];

    VAR
      resume_pp_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['STATUS', 2]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

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

?? POP ??


    VAR
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      value: clt$value;

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

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

    locate_q_directory_entry (value.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      dfp$resume_pp (p_q_interface_directory_entry, status);
    IFEND;
  PROCEND dfp$resume_pp_command;

?? TITLE := ' [XDCL] dfp$set_esm_divisions_command ', EJECT ??
{ The purpose of this routine is to process the file server SET_ESM_DIVISIONS command.

  PROCEDURE [XDCL] dfp$set_esm_divisions_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt set_esm_divisions (element_name, en: name = $required
{                        number_of_divisions, nod: integer 1 .. 8 = $required
{                        status)

?? PUSH (LISTEXT := ON) ??

    VAR
      set_esm_divisions: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^set_esm_divisions_names, ^set_esm_divisions_params];

    VAR
      set_esm_divisions_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['NUMBER_OF_DIVISIONS', 2],
            ['NOD', 2], ['STATUS', 3]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ NUMBER_OF_DIVISIONS NOD }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1, 8]],

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

?? POP ??


    VAR
      element: clt$value,
      divisions: clt$value,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry;

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

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

    locate_q_directory_entry (element.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      clp$get_value ('NUMBER_OF_DIVISIONS', 1, 1, clc$low, divisions, status);
      IF status.normal THEN
        dfp$set_esm_divisions (p_q_interface_directory_entry, divisions.int.value, status);
      IFEND;
    IFEND;
  PROCEND dfp$set_esm_divisions_command;

?? TITLE := ' [XDCL] dfp$unload_pp_command ', EJECT ??
{
{ The purpose of this routine is to process the file server UNLOAD_PP command.

  PROCEDURE [XDCL] dfp$unload_pp_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{  pdt unload_pp (element_name, en: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      unload_pp: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^unload_pp_names, ^unload_pp_params];

    VAR
      unload_pp_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['STATUS', 2]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

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

?? POP ??


    VAR
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      value: clt$value;

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

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

    locate_q_directory_entry (value.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      dfp$unload_pp (p_q_interface_directory_entry, status);
    IFEND;
  PROCEND dfp$unload_pp_command;

?? TITLE := ' [XDCL] dfp$set_driver_active ', EJECT ??
{ This procedure is left over from the PROTOTYPE, and is moved from
{ dfm$queue_initialization to this module. This process remains to
{ provide continuity. It has not been determined as yet if this process
{ will be required in the new order.

  PROCEDURE [XDCL] dfp$set_driver_active
    (    driver_name: ost$name;
         driver_active: boolean;
     VAR status: ost$status);

    VAR
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      queue_directory_index: dft$queue_directory_index;

    locate_q_directory_entry (driver_name, p_q_interface_directory_entry, status);
    IF status.normal THEN
      p_q_interface_directory_entry^.driver_active := driver_active;
    IFEND;
  PROCEND dfp$set_driver_active;

?? TITLE := ' [XDCL] dfp$store_p_qit ', EJECT ??
{ This procedure is left over from the PROTOTYPE, and is moved from
{ dfm$queue_initialization to this module. This process remains to
{ provide continuity. It will be eliminated in the new order.
{
{ The purpose of this routine is to store the queue interface table pointer
{ into the unit interface table in one step.  This should be done after
{ all mainframes are registred, and after the PP driver is loaded.
{ This allows all mainframes to be configured before pp looks at requests.
{ MODIFIED TO CALL ACTIVATE_PP.

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


{  pdt store_p_qit (element_name, en: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      store_p_qit: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^store_p_qit_names, ^store_p_qit_params];

    VAR
      store_p_qit_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ELEMENT_NAME', 1], ['EN', 1], ['STATUS', 2]];

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

{ ELEMENT_NAME EN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

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

?? POP ??

    VAR
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      value: clt$value;

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

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

    locate_q_directory_entry (value.name.value, p_q_interface_directory_entry, status);
    IF status.normal THEN
      dfp$activate_pp (p_q_interface_directory_entry, TRUE {use_dma if present} , status);
    IFEND;
  PROCEND dfp$store_p_qit;

?? TITLE := ' locate_q_directory_entry ', EJECT ??

  PROCEDURE locate_q_directory_entry
    (    element_name: cmt$element_name;
     VAR p_q_interface_directory_entry: ^dft$q_interface_directory_entry;
     VAR status: ost$status);


    VAR
      found: boolean,
      index: dft$queue_directory_index;

    { Given the element name of either the send or receive ESM element name,
    { this process will locate the queue directory entry for the file server
    { connection and return a pointer to it.

    found := FALSE;
    p_q_interface_directory_entry := NIL;

    IF dfv$p_queue_interface_directory <> NIL THEN

    /locate_entry/
      FOR index := 1 TO UPPERBOUND (dfv$p_queue_interface_directory^) DO
        IF dfv$p_queue_interface_directory^ [index].driver_name = element_name THEN
          found := TRUE;
          EXIT /locate_entry/;
        IFEND;
      FOREND /locate_entry/;
    IFEND;
    IF found THEN
      status.normal := TRUE;
      p_q_interface_directory_entry := ^dfv$p_queue_interface_directory^ [index];
    ELSE
      osp$set_status_abnormal (dfc$file_server_id, dfe$unknown_driver, element_name, status);
    IFEND;
  PROCEND locate_q_directory_entry;

MODEND dfm$pp_management_commands;
