?? LEFT := 1, RIGHT := 110 ??
?? TITLE := 'NOS/VE: Network Operator Utility' ??
?? NEWTITLE := 'Global Declarations' ??
MODULE nam$network_operator_utility;
?? PUSH (LISTEXT := ON) ??
*copyc ame$condition_codes
*copyc amt$file_byte_address
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc amt$file_access_selections
*copyc amt$term_option
*copyc clt$argument_descriptor_table
*copyc nae$application_interfaces
*copyc nae$directory_me_conditions
*copyc nae$manage_network_applications
*copyc nae$namve_conditions
*copyc nae$network_operator_utility
*copyc nat$bcd_time
*copyc nat$command_interface
*copyc nat$directory_interfaces
*copyc nat$gt_event
*copyc nat$network_address
*copyc nat$system_title
*copyc nat$title
*copyc nat$wait_time
*copyc ost$date
*copyc ost$date_time
*copyc ost$signature_lock_status
*copyc ost$stack_frame_save_area
*copyc ost$status
*copyc ost$status_message
*copyc ost$time
*copyc pfe$error_condition_codes
*copyc pmt$condition
*copyc pmt$condition_information
*copyc rmt$device_class
?? POP ??
*copyc amp$flush
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$return
*copyc avp$get_capability
*copyc clp$begin_utility
*copyc clp$close_display
*copyc clp$create_variable
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$get_parameter_list_text
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$include_file
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$read_variable
*copyc clp$reset_for_next_display_page
*copyc clp$scan_argument_list
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc clp$write_variable
*copyc fsp$close_file
*copyc fsp$open_file
*copyc ifp$discard_suspended_output
*copyc i#move
*copyc nap$activate_network_alarms
*copyc nap$condition_handler_trace
*copyc nap$deactivate_network_alarms
*copyc nap$display_message
*copyc nap$end_command_processing
*copyc nap$generate_network_message
*copyc nap$receive_network_alarm
*copyc nap$receive_command_response
*copyc nap$send_command
*copyc nap$terminate_command
*copyc nlp$get_title_translation
*copyc nlp$translate_title
*copyc osp$append_status_integer
*copyc osp$establish_condition_handler
*copyc osp$format_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$connect_queue
*copyc pmp$continue_to_cause
*copyc pmp$define_queue
*copyc pmp$disconnect_queue
*copyc pmp$disestablish_end_handler
*copyc pmp$establish_condition_handler
*copyc pmp$establish_end_handler
*copyc pmp$execute
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pmp$get_unique_name
*copyc pmp$get_legible_date_time
*copyc pmp$get_os_version
*copyc pmp$get_program_description
*copyc pmp$get_program_size
*copyc pmp$receive_from_queue
*copyc pmp$remove_queue
*copyc pmp$send_to_queue
*copyc pmp$terminate
*copyc pmp$wait
*copyc rmp$get_device_class

  TYPE
    alarm_record = record
      responder: nat$system_title,
      response_code: nat$command_response_code,
      time_stamp: nat$bcd_time,
      response: SEQ ( * ),
    recend;

  TYPE
    output_lock_word = integer;

  TYPE
    title_return_entry = record
      size: ost$string_size,
      value: nat$system_title,
    recend;

  TYPE
    system_response = record
      command_id: nat$command_identifier,
      system: nat$system_title,
      code: nat$command_response_code,
      normal_response: boolean,
      received: boolean,
    recend;

  TYPE
    task_record = record
      task_id: pmt$task_id,
      task_status: pmt$task_status,
    recend;

  CONST
    nac$time_stamp_length = 18,
    nac$operator_utility_version = 'V1.1',
    nac$operator_utility_level = '90086',
    alarm_wait_time = 1000000000, {very long wait time}
    command_terminated = 'Command terminated.',
    command_wait_time = 120000,
    default_output_file = '$OUTPUT',
    few_destinations = 4, {Number of systems specified before requesting all translations}
    locked = 77,
    max_address_count = 1024,
    normal_response_code = 0,
    prompt_string = 'nou',
    translation_wait_time = 1000,
    unlocked = 0;

  VAR
    alarm_output_task: task_record,
    alarm_task: task_record,
    command_id: nat$command_identifier := 0,
    communication_queue: pmt$queue_connection,
    communication_queue_name: pmt$queue_name,
    display_control: ^clt$display_control,
    interrupt_detected: boolean := FALSE,
    output_control: clt$display_control,
    output_lock: ^output_lock_word := NIL,
    response_buffer: SEQ (REP nac$max_command_response_length of cell),
    response_control: clt$display_control,
    response_file: clt$file := ['$RESPONSE'],
    response_list: ^array [1 .. * ] of system_response := NIL,
    shared_segment_attachment: [STATIC, READ] array [1 .. 2] of fst$attachment_option :=
          [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read, fsc$append, fsc$shorten,
          fsc$modify]], [fsc$specific_share_modes, [fsc$read, fsc$append, fsc$shorten, fsc$modify]]],
          [fsc$open_share_modes, [fsc$read, fsc$append, fsc$shorten, fsc$modify]]],
    shared_segment_id: amt$file_identifier,
    shared_segment_name: amt$local_file_name,
    utility_name: ost$name := 'NETWORK_OPERATOR_UTILITY';

{ PDT acta_pdt (
{   group,groups,g : name = CATENET
{   output,o : file = $OUTPUT
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    acta_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^acta_pdt_names, ^acta_pdt_params];

  VAR
    acta_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
      clt$parameter_name_descriptor := [['GROUP', 1], ['GROUPS', 1], ['G', 1], ['OUTPUT', 2], ['O', 2], [
      'STATUS', 3]];

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

{ GROUP GROUPS G }
    [[clc$optional_with_default, ^acta_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$name_value, 1, osc$max_name_size]],

{ OUTPUT O }
    [[clc$optional_with_default, ^acta_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_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
    acta_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := 'CATENET';

  VAR
    acta_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??
?? OLDTITLE ??
?? NEWTITLE := 'nap$send_network_commands', EJECT ??

  PROGRAM nap$send_network_commands (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: This procedure establishes the Network Operator Utility environment.
{ DESIGN:  Prolog file processing is performed if requested. SCL is then called to
{          process commands in the subutility environment.


    VAR
      device_assigned: boolean,
      device_class: rmt$device_class,
      local_status: ost$status,
      network_operation: boolean,
      output_file: clt$value,
      prolog_file: clt$value,
      prolog_specified: boolean,
      utility_attributes: [STATIC, READ] array [1 .. 4] of clt$utility_attribute := [
            [clc$utility_command_search_mode, clc$global_command_search],
            [clc$utility_command_table, ^me_sub_commands_entries],
            [clc$utility_function_table, ^me_functions_entries],
            [clc$utility_prompt, [3, prompt_string]]];

{ PDT netou_pdt(
{   prolog,p: file =$user.network_operator_prolog
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      netou_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^netou_pdt_names,
        ^netou_pdt_params];

    VAR
      netou_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['PROLOG', 1], ['P', 1], ['STATUS', 2]];

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

{ PROLOG P }
      [[clc$optional_with_default, ^netou_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$file_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
      netou_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (29) :=
        '$user.network_operator_prolog';

?? POP ??

{ table me_sub_commands
{ command (send_command,senc) processor = send_command
{ command (activate_alarms,activate_alarm,acta) processor = activate_alarms
{ command (deactivate_alarms,deactivate_alarm,deaa) processor = deactivate_alarms
{ command (quit,qui) processor = quit

?? PUSH (LISTEXT := ON) ??

VAR
  me_sub_commands: [STATIC, READ] ^clt$command_table := ^me_sub_commands_entries,

  me_sub_commands_entries: [STATIC, READ] array [1 .. 10] of clt$command_table_entry := [
  {} ['ACTA                           ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^activate_alarms],
  {} ['ACTIVATE_ALARM                 ', clc$alias_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^activate_alarms],
  {} ['ACTIVATE_ALARMS                ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^activate_alarms],
  {} ['DEAA                           ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^deactivate_alarms],
  {} ['DEACTIVATE_ALARM               ', clc$alias_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^deactivate_alarms],
  {} ['DEACTIVATE_ALARMS              ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^deactivate_alarms],
  {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['SENC                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^send_command],
  {} ['SEND_COMMAND                   ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^send_command]];

?? POP ??

{ table me_functions type = function
{ function $normal_response processor = normal_response_function
{ function $response_identifier processor = response_identifier_function
{ function $matching_names processor = matching_names_function

?? PUSH (LISTEXT := ON) ??

    VAR
      me_functions: [STATIC, READ] ^clt$function_table := ^me_functions_entries,

      me_functions_entries: [STATIC, READ] array [1 .. 3] of clt$function_table_entry := [
        {} ['$MATCHING_NAMES                ', clc$nominal_entry, clc$advertised_entry, 3, clc$linked_call,
        ^matching_names_function],
        {} ['$NORMAL_RESPONSE               ', clc$nominal_entry, clc$advertised_entry, 1, clc$linked_call,
        ^normal_response_function],
        {} ['$RESPONSE_IDENTIFIER           ', clc$nominal_entry, clc$advertised_entry, 2, clc$linked_call,
        ^response_identifier_function]];

?? POP ??

?? NEWTITLE := '  condition_handler', EJECT ??

    PROCEDURE condition_handler (condition: pmt$condition;
          ignore_condition_descriptor: ^pmt$condition_information;
          sa: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        local_status: ost$status;

      nap$condition_handler_trace (condition, sa);
      CASE condition.selector OF
      = pmc$system_conditions =
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      = pmc$block_exit_processing =
        local_status.normal := TRUE;
        terminate_asynchronous_tasks;
        nap$end_command_processing (local_status);
      = ifc$interactive_condition =
        IF condition.interactive_condition = ifc$terminate_break THEN
          interrupt_detected := TRUE;
          ifp$discard_suspended_output;
          osp$set_status_condition ( nae$no_event,  status);
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          osp$set_status_abnormal (nac$status_id, nae$job_recovery, 'NETWORK OPERATOR', status);
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          EXIT nap$send_network_commands;
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        IFEND;
        condition_status.normal := TRUE;
      ELSE
        condition_status.normal := TRUE;
      CASEND;

    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

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

    avp$get_capability (avc$network_operation, avc$user, network_operation, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT network_operation THEN
      osp$set_status_abnormal (nac$status_id, nae$invalid_user, 'NETWORK OPERATOR UTILITY', status);
      RETURN;
    IFEND;

    alarm_task.task_status.complete := TRUE;
    alarm_output_task.task_status.complete := TRUE;

    clp$test_parameter ('PROLOG', prolog_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('PROLOG', 1, 1, clc$low, prolog_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    interrupt_detected := FALSE;
    osp$establish_condition_handler (^condition_handler, {block exit=} TRUE);

    output_file.file.local_file_name := default_output_file;
    clp$open_display (output_file.file, ^generate_headers, output_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$open_display (response_file, ^generate_headers, response_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$include_file (prolog_file.file.local_file_name, prompt_string, utility_name, status);
    IF NOT status.normal THEN
      IF prolog_specified THEN
        { forgive error for explicit prolog=$null. }
        local_status.normal := TRUE;
        rmp$get_device_class (prolog_file.file.local_file_name, device_assigned, device_class, local_status);
        IF NOT local_status.normal THEN
          status := local_status;
          RETURN;
        IFEND;
        IF device_class = rmc$null_device THEN
          status.normal := TRUE;
        IFEND;
      ELSEIF (status.condition = ame$file_not_known) OR (status.condition = pfe$unknown_permanent_file) THEN
        status.normal := TRUE;
      IFEND;
      IF NOT status.normal THEN
        display_message (status, local_status);
        IF NOT local_status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    clp$include_file (clc$current_command_input, prompt_string, utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_utility (utility_name, status);

  PROCEND nap$send_network_commands;
?? OLDTITLE ??
?? NEWTITLE := 'Command Processors' ??
?? NEWTITLE := 'send_command', EJECT ??

  PROCEDURE send_command (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: This is the command processor for the NETOU send_command command.
{ DESIGN:  The command parameters are interpreted and the specified command string
{          is sent to the specified systems. Command responses are then requested
{          and displayed until exactly one response or error indication has been
{          received from each system specified. Responses are formatted and displayed
{          on the file specified on the command. A condition handler for terminate
{          break is enabled during command processing to allow the operator to
{          terminate the command and its output if necessary. If a terminate break
{          is received, an error response will be generated for each system that has
{          not terminated processing the current command.
{          The command identifier is used to associate each response with the system
{          name used to send the command, since the system may have more than one name
{          configured and will respond with a default name that may be different than
{          the one specified by the operator.
{          If a command is destined for more than a few systems, a single wild card
{          translation request will be issued to prime the Directory cache before
{          issuing individual translation requests. This is done in order to avoid
{          swamping the Network Access link with translation request broadcast PDUs.
{          Commands will be timed out after 2 minutes if all responses are not received.


  PROCEDURE terminate_break_handler (condition: pmt$condition;
        condition_descriptor: ^pmt$condition_information;
        save_area: ^ost$stack_frame_save_area;
    VAR break_status: ost$status);

{ PURPOSE: This routine processes the terminate break condition for NETOU.
{ DESIGN:  The global flag interrupt_detected is set to TRUE and the condition
{          is cancelled. Queued output is also discarded. It is the responsibility
{          of the procedure establishing this condition handler to periodically
{          check the interrupt_detected flag and terminate processing when it is set.
{          Status is set abnormal to terminate a wait condition.

    VAR
      ignore_status: ost$status;

    interrupt_detected := TRUE;
    ifp$discard_suspended_output;
    clp$put_display (output_control, command_terminated, clc$trim, ignore_status);
    osp$set_status_condition ( nae$no_event,  local_status);

  PROCEND terminate_break_handler;

    VAR
      v$interrupt_condition: [READ] pmt$condition := [ifc$interactive_condition, ifc$terminate_break];

    VAR
      command: clt$value,
      commands_outstanding: integer,
      commands_sent: integer,
      current_display_control: ^clt$display_control,
      display_line: string (255),
      end_time: integer,
      errors_detected: boolean,
      ignore_status: ost$status,
      index: integer,
      interrupt_descriptor: pmt$established_handler,
      j: integer,
      local_display_control: clt$display_control,
      local_status: ost$status,
      many_translations_required: boolean,
      multiple_destinations: boolean,
      normal_response: boolean,
      output_file: clt$value,
      output_specified: boolean,
      remaining_wait_time: integer,
      responder: nat$system_title,
      response: nat$data_fragment,
      response_code: nat$command_response_code,
      response_id: nat$command_identifier,
      response_length: nat$data_length,
      response_message: ^SEQ ( * ),
      response_pointer: ^SEQ (REP nac$max_command_response_length of cell),
      system_title: clt$value,
      title_count: 0 .. clc$max_value_sets,
      truncated: boolean;

{ PDT senc_pdt (
{   command,c : string = $required
{   system,systems,s : list 1..300 of name = $required
{   output,o : file
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    senc_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^senc_pdt_names, ^senc_pdt_params];

  VAR
    senc_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
      clt$parameter_name_descriptor := [['COMMAND', 1], ['C', 1], ['SYSTEM', 2], ['SYSTEMS', 2], ['S', 2], [
      'OUTPUT', 3], ['O', 3], ['STATUS', 4]];

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

{ COMMAND C }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, osc$max_string_size
      ]],

{ SYSTEM SYSTEMS S }
    [[clc$required], 1, 300, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ OUTPUT O }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

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

?? POP ??

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

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

    clp$get_set_count ('SYSTEM', title_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    multiple_destinations := title_count > 1;
    many_translations_required := title_count > few_destinations;

    clp$test_parameter ('OUTPUT', output_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF output_specified THEN
      clp$get_value ('OUTPUT', 1, 1, clc$low, output_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$open_display (output_file.file, ^generate_headers, local_display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      current_display_control := ^local_display_control;
    ELSE
      current_display_control := ^output_control;
    IFEND;

    interrupt_detected := FALSE;
    pmp$establish_condition_handler (v$interrupt_condition, ^terminate_break_handler, ^interrupt_descriptor,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Send the command to each of the specified systems.

    IF response_list <> NIL THEN
      FREE response_list;
    IFEND;
    ALLOCATE response_list: [1 .. title_count];
    errors_detected := FALSE;
    commands_sent := 0;

    FOR index := 1 TO title_count DO
      clp$get_value ('SYSTEM', index, 1, clc$low, system_title, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      command_id := (command_id + 1) MOD (UPPERVALUE (nat$command_identifier) + 1);
      response_list^ [index].command_id := command_id;
      response_list^ [index].system := system_title.name.value (1, system_title.name.size);
      response_list^ [index].received := FALSE;
      nap$send_command (^command.str.value (1, command.str.size), system_title.name.value (1, system_title.
            name.size), command_id, {retain connection} TRUE, many_translations_required, local_status);
      IF local_status.normal THEN
        commands_sent := commands_sent + 1;
      ELSEIF multiple_destinations THEN
        display_message (local_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        errors_detected := TRUE;
      ELSE
        status := local_status;
      IFEND;
    FOREND;

{ Process one response for each system to which the command was sent.

    response_pointer := ^response_buffer;
    response.address := ^response_buffer;
    response.length := #SIZE (response_buffer);
    commands_outstanding := commands_sent;
    end_time := (#free_running_clock (0) DIV 1000) + command_wait_time;
    remaining_wait_time := command_wait_time;

    WHILE (commands_outstanding > 0) AND (NOT interrupt_detected) AND (remaining_wait_time > 0) DO
      nap$receive_command_response (remaining_wait_time, response, response_length, responder, response_id,
            response_code, normal_response, truncated, local_status);
      IF local_status.normal THEN

        /save_response/
          FOR index := LOWERBOUND (response_list^) TO UPPERBOUND (response_list^) DO
            IF (response_id = response_list^ [index].command_id) AND (NOT response_list^ [index].received)
                  THEN
              response_list^ [index].received := TRUE;
              response_list^ [index].code := response_code;
              response_list^ [index].normal_response := normal_response;
              IF normal_response THEN
                display_control := current_display_control;
              ELSE
                display_control := ^response_control;
              IFEND;
              STRINGREP (display_line, j, 'FROM ', response_list^ [index].system);
              set_output_lock;
              IF normal_response THEN
                clp$put_display (display_control^, display_line (1, j), clc$trim, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              ELSE
                clp$put_partial_display (display_control^, display_line (1, j), clc$trim, amc$start, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                STRINGREP (display_line, j, response_code);
                clp$put_partial_display (display_control^, display_line (1, j), clc$trim, amc$terminate,
                      status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              IFEND;
              RESET response_pointer;
              NEXT response_message: [[REP response_length OF cell]] IN response_pointer;
              nap$generate_network_message (response_message^, display_control^, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF truncated THEN
                clp$put_display (display_control^, ' (Response truncated)', clc$trim, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              IFEND;
              IF multiple_destinations THEN
                amp$flush (display_control^.file_id, osc$wait, ignore_status);
              IFEND;
              clear_output_lock;
              EXIT /save_response/;
            IFEND;
          FOREND /save_response/;
          commands_outstanding := commands_outstanding - 1;

      ELSEIF local_status.condition = nae$no_event THEN
        {ignore this error condition...it is a non-event};

      ELSEIF multiple_destinations THEN
        display_message (local_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        errors_detected := TRUE;
        commands_outstanding := commands_outstanding - 1;

      ELSE {single destination with error}
        status := local_status;
        commands_outstanding := commands_outstanding - 1;
      IFEND;
      remaining_wait_time := end_time - (#free_running_clock (0) DIV 1000);
    WHILEND;

    FOR index := LOWERBOUND (response_list^) TO UPPERBOUND (response_list^) DO
      IF NOT response_list^ [index].received THEN
        nap$terminate_command (response_list^ [index].system, {retain_connection } FALSE, local_status);
        IF NOT local_status.normal THEN
          IF multiple_destinations THEN
            display_message (local_status, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            errors_detected := TRUE;
          ELSE {single destination}
            status := local_status;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

    IF output_specified THEN
      clp$close_display (local_display_control, ignore_status);
    IFEND;

    IF multiple_destinations AND errors_detected THEN
      osp$set_status_abnormal (nac$status_id, nae$errors_during_command, 'SEND_COMMAND', status);
    IFEND;

  PROCEND send_command;
?? OLDTITLE ??
?? NEWTITLE := 'activate_alarms', EJECT ??

  PROCEDURE activate_alarms (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: This is the command processor for the NETOU activate_alarms command.
{ DESIGN:  1. The command parameters are validated.
{          2. A local queue is created for communication among the tasks.
{             An output lock is created and passed via the local queue to the alarm output task.
{          3. An asynchronous task is started to perform the actual command and response processing.
{          4. An asynchronous task is started to produce alarm output while alarm connections are
{             processed.
{          5. The alarm tasks are terminated by the deactivate_alarms command or the quit command.

    VAR
      communication_queue_name_parm: ^pmt$queue_name,
      community_title: clt$value,
      group_count: 0 .. clc$max_value_sets,
      number_of_object_files: pmt$number_of_object_files,
      number_of_modules: pmt$number_of_modules,
      number_of_libraries: pmt$number_of_libraries,
      output_file: clt$value,
      output_file_name_parm: ^amt$local_file_name,
      output_lock_relative_pointer: ^REL (HEAP ( * )) ^output_lock_word,
      parameter_list_contents: ^pmt$program_parameters,
      program_attributes: ^pmt$program_attributes,
      program_description: ^pmt$program_description,
      queue_message: pmt$message,
      queue_message_value: ^pmt$message_value,
      shared_heap: ^HEAP ( * ),
      shared_segment_name_parm: ^amt$local_file_name,
      shared_segment_pointer: amt$segment_pointer,
      starting_procedure: pmt$program_name;

    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, acta_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ **** Verify CATENET is the only alarm group for release 1.2.1

    clp$get_set_count ('GROUPS', group_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('GROUPS', 1, 1, clc$low, community_title, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (group_count > 1) OR (community_title.name.value <> 'CATENET') THEN
      osp$set_status_abnormal (nac$status_id, nae$invalid_alarm_group, community_title.name.value, status);
      RETURN;
    IFEND;

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

    IF NOT alarm_task.task_status.complete THEN {alarms already active}
      osp$set_status_condition ( nae$alarms_already_active,  status);
      RETURN;
    IFEND;

    IF NOT alarm_output_task.task_status.complete THEN {alarm output task still running}
      terminate_asynchronous_tasks;
    IFEND;

{ Define and initialize the communication queue.

    pmp$get_unique_name (shared_segment_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    fsp$open_file (shared_segment_name, amc$segment, {attachment options=} ^shared_segment_attachment,
          {default creation attributes=} NIL, {mandated creation attributes=} NIL,
          {attribute validation=} NIL, {attribute override=} NIL, shared_segment_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (shared_segment_id, amc$heap_pointer, shared_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    shared_heap := shared_segment_pointer.heap_pointer;
    RESET shared_heap^;

    pmp$get_unique_name (communication_queue_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pmp$define_queue (communication_queue_name, osc$user_ring, osc$user_ring, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$connect_queue (communication_queue_name, communication_queue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    queue_message.contents := pmc$message_value;
    queue_message_value := ^queue_message.value;
    RESET queue_message_value;
    NEXT output_lock_relative_pointer IN queue_message_value;
    ALLOCATE output_lock IN shared_heap^;
    output_lock^ := unlocked;
    output_lock_relative_pointer^ := #REL (output_lock, shared_heap^);
    pmp$send_to_queue (communication_queue, queue_message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pmp$disconnect_queue (communication_queue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$get_program_size (number_of_object_files, number_of_modules, number_of_libraries, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH program_description: [[REP (#SIZE (pmt$program_attributes) + (number_of_object_files +
          number_of_libraries) * #SIZE (amt$local_file_name) + number_of_modules * #SIZE (pmt$program_name))
          OF cell]];
    pmp$get_program_description (program_description^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    RESET program_description;
    NEXT program_attributes IN program_description;
    program_attributes^.contents := program_attributes^.contents + $pmt$prog_description_contents
          [pmc$starting_proc_specified];
    program_attributes^.starting_procedure := 'NAP$PROCESS_ACTIVATE_ALARMS';
    RESET program_description;

    PUSH parameter_list_contents: [[REP 2 OF amt$local_file_name, REP 1 OF pmt$queue_name]];
    RESET parameter_list_contents;
    NEXT output_file_name_parm IN parameter_list_contents;
    output_file_name_parm^ := output_file.file.local_file_name;
    NEXT shared_segment_name_parm IN parameter_list_contents;
    shared_segment_name_parm^ := shared_segment_name;
    NEXT communication_queue_name_parm IN parameter_list_contents;
    communication_queue_name_parm^ := communication_queue_name;

    pmp$execute (program_description^, #SEQ (parameter_list_contents^) ^, osc$nowait, alarm_task.task_id,
          alarm_task.task_status, status);

    program_attributes^.starting_procedure := 'NAP$PROCESS_ALARM_OUTPUT';
    pmp$execute (program_description^, #SEQ (parameter_list_contents^) ^, osc$nowait,
          alarm_output_task.task_id, alarm_output_task.task_status, status);

  PROCEND activate_alarms;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nap$process_activate_alarms', EJECT ??

  PROCEDURE [XDCL] nap$process_activate_alarms (parameter_list: pmt$program_parameters;
    VAR status: ost$status);

{ PURPOSE: This procedure controls the operation of the asynchronous task that processes
{          network alarms for NETOU.
{ DESIGN:  The command parameters are interpreted and the specified alarm titles enabled.
{          Alarms are then requested and displayed until the task is terminated by its
{          parent task. Responses are formatted and displayed on the file specified on the command.

    VAR
      alarm_message: ^alarm_record,
      alarm_message_relative_pointer: ^REL (HEAP ( * )) ^alarm_record,
      communication_queue_name: ^pmt$queue_name,
      community_title: clt$value,
      exit_condition: [STATIC] pmt$condition := [pmc$condition_combination,
        [pmc$block_exit_processing, pmc$user_defined_condition]],
      establish_descriptor: pmt$established_handler,
      groups: array [1 .. 1] of nat$community_title,
      job_recovery_in_progress: [STATIC] boolean := FALSE,
      local_status: ost$status,
      output_file: ^amt$local_file_name,
      parameter_list_contents: ^pmt$program_parameters,
      queue_message: pmt$message,
      queue_message_value: ^pmt$message_value,
      responder: nat$system_title,
      response: nat$data_fragment,
      response_code: nat$command_response_code,
      response_length: nat$data_length,
      response_pointer: ^SEQ (REP nac$max_command_response_length of cell),
      shared_heap: ^HEAP ( * ),
      shared_segment_name: ^amt$local_file_name,
      shared_segment_pointer: amt$segment_pointer,
      time_stamp: nat$bcd_time;

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

      VAR
        ignore_status: ost$status;

      nap$condition_handler_trace (condition, save_area);
      CASE condition.selector OF
      = pmc$user_defined_condition =
        IF condition.user_condition_name = 'OSC$JOB_RECOVERY' THEN
          job_recovery_in_progress := TRUE;
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        IFEND;
        handler_status.normal := TRUE;
      ELSE
        IF NOT job_recovery_in_progress THEN
          nap$deactivate_network_alarms (ignore_status);
        IFEND;
        pmp$disestablish_end_handler (^alarm_end_handler, status);
      CASEND;

    PROCEND exit_condition_handler;

    status.normal := TRUE;
    parameter_list_contents := ^parameter_list;
    RESET parameter_list_contents;
    NEXT output_file IN parameter_list_contents;
    NEXT shared_segment_name IN parameter_list_contents;
    NEXT communication_queue_name IN parameter_list_contents;

    fsp$open_file (shared_segment_name^, amc$segment, {attachment options=} ^shared_segment_attachment,
          {default creation attributes=} NIL, {mandated creation attributes=} NIL,
          {attribute validation=} NIL, {attribute override=} NIL, shared_segment_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    amp$get_segment_pointer (shared_segment_id, amc$heap_pointer, shared_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    shared_heap := shared_segment_pointer.heap_pointer;

    pmp$connect_queue (communication_queue_name^, communication_queue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    queue_message.contents := pmc$message_value;
    queue_message_value := ^queue_message.value;
    RESET queue_message_value;
    NEXT alarm_message_relative_pointer IN queue_message_value;

    pmp$establish_end_handler (^alarm_end_handler, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$establish_condition_handler (exit_condition, ^exit_condition_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    groups [1] := 'CATENET';
    nap$activate_network_alarms (groups, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    response_pointer := ^response_buffer;
    response.address := ^response_buffer;
    response.length := #SIZE (response_buffer);

    WHILE TRUE DO
      local_status.normal := TRUE;
      nap$receive_network_alarm (alarm_wait_time, response, response_length, responder, response_code,
            time_stamp, local_status);
      IF local_status.normal THEN
        ALLOCATE alarm_message: [[REP response_length OF cell]] IN shared_heap^;
        alarm_message^.responder := responder;
        alarm_message^.response_code := response_code;
        alarm_message^.time_stamp := time_stamp;
        i#move (response.address, ^alarm_message^.response, response_length);
        alarm_message_relative_pointer^ := #REL (alarm_message, shared_heap^);
        pmp$send_to_queue (communication_queue, queue_message, status);
        IF NOT status.normal THEN
          display_message (status, local_status);
          nap$display_message (status);
          RETURN;
        IFEND;
      ELSEIF local_status.condition <> nae$no_event THEN
        display_message (local_status, status);
        IF NOT status.normal THEN
          nap$display_message (status);
          RETURN;
        IFEND;
      IFEND;
    WHILEND;

  PROCEND nap$process_activate_alarms;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nap$process_alarm_output', EJECT ??

  PROCEDURE [XDCL] nap$process_alarm_output (parameter_list: pmt$program_parameters;
    VAR status: ost$status);

{ PURPOSE: This procedure controls the operation of the asynchronous task that writes
{          network alarms to the output file. By having this process in a separate asynchronous
{          task, the alarm processor will not be blocked by page wait, etc., on the output file.
{ DESIGN:  The first message on the local queue is a pointer to the lockword used to coordinate
{          output of command and alarm output. Subsequent queue messages are alarms.
{          The alarm data is received from the local queue and displayed on the output file.

    VAR
      alarm_message: ^alarm_record,
      alarm_message_relative_pointer: ^REL (HEAP ( * )) ^alarm_record,
      communication_queue_name: ^pmt$queue_name,
      display_line: string (255),
      display_control: clt$display_control,
      exit_condition: [STATIC] pmt$condition := [pmc$block_exit_processing, [pmc$block_exit,
        pmc$program_termination, pmc$program_abort]],
      establish_descriptor: pmt$established_handler,
      formatted_date: ost$date,
      formatted_time: ost$time,
      ignore_status: ost$status,
      j: integer,
      message_from_control: pmt$message,
      output_file: clt$file,
      output_file_name: ^amt$local_file_name,
      output_lock_relative_pointer: ^REL (HEAP ( * )) ^output_lock_word,
      parameter_list_contents: ^pmt$program_parameters,
      program_attributes: ^pmt$program_attributes,
      program_description: ^pmt$program_description,
      queue_message: ^pmt$message_value,
      responder: nat$system_title,
      response: nat$data_fragment,
      response_code: nat$command_response_code,
      response_length: nat$data_length,
      shared_heap: ^HEAP ( * ),
      shared_segment_name: ^amt$local_file_name,
      shared_segment_pointer: amt$segment_pointer,
      time_stamp: nat$bcd_time;


    status.normal := TRUE;
    parameter_list_contents := ^parameter_list;
    RESET parameter_list_contents;
    NEXT output_file_name IN parameter_list_contents;
    NEXT shared_segment_name IN parameter_list_contents;
    NEXT communication_queue_name IN parameter_list_contents;

    fsp$open_file (shared_segment_name^, amc$segment, {attachment options=} ^shared_segment_attachment,
          {default creation attributes=} NIL, {mandated creation attributes=} NIL,
          {attribute validation=} NIL, {attribute override=} NIL, shared_segment_id, status);
    IF NOT status.normal THEN
      display_message (status, ignore_status);
      RETURN;
    IFEND;
    amp$get_segment_pointer (shared_segment_id, amc$heap_pointer, shared_segment_pointer, status);
    IF NOT status.normal THEN
      display_message (status, ignore_status);
      RETURN;
    IFEND;
    shared_heap := shared_segment_pointer.heap_pointer;

    pmp$connect_queue (communication_queue_name^, communication_queue, status);
    IF NOT status.normal THEN
      display_message (status, ignore_status);
      RETURN;
    IFEND;

    pmp$receive_from_queue (communication_queue, osc$wait, message_from_control, status);
    IF NOT status.normal THEN
      display_message (status, ignore_status);
      RETURN;
    IFEND;
    queue_message := ^message_from_control.value;
    RESET queue_message;
    NEXT output_lock_relative_pointer IN queue_message;
    output_lock := #PTR (output_lock_relative_pointer^, shared_heap^);

    output_file.local_file_name := output_file_name^;
    clp$open_display (output_file, ^generate_headers, display_control, status);
    IF NOT status.normal THEN
      display_message (status, ignore_status);
      RETURN;
    IFEND;

    WHILE TRUE DO
      pmp$receive_from_queue (communication_queue, osc$wait, message_from_control, status);
      IF NOT status.normal THEN
        display_message (status, ignore_status);
        RETURN;
      IFEND;
      queue_message := ^message_from_control.value;
      RESET queue_message;
      NEXT alarm_message_relative_pointer IN queue_message;
      alarm_message := #PTR (alarm_message_relative_pointer^, shared_heap^);
      responder := alarm_message^.responder;
      response_code := alarm_message^.response_code;
      time_stamp := alarm_message^.time_stamp;
        format_time_stamp (time_stamp, formatted_date, formatted_time);
        STRINGREP (display_line, j, '****** ALARM FROM ', responder);
        set_output_lock;
        clp$put_partial_display (display_control, display_line (1, j), clc$trim, amc$start, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, ' ', clc$no_trim, amc$continue, ignore_status);
        CASE formatted_date.date_format OF
        = osc$month_date =
          clp$put_partial_display (display_control, formatted_date.month, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = osc$mdy_date =
          clp$put_partial_display (display_control, formatted_date.mdy, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = osc$iso_date =
          clp$put_partial_display (display_control, formatted_date.iso, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = osc$ordinal_date =
          clp$put_partial_display (display_control, formatted_date.ordinal, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = osc$dmy_date =
          clp$put_partial_display (display_control, formatted_date.dmy, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
        CASEND;
        clp$put_partial_display (display_control, ' ', clc$no_trim, amc$continue, ignore_status);
        CASE formatted_time.time_format OF
        = osc$ampm_time =
          clp$put_partial_display (display_control, formatted_time.ampm, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = osc$hms_time =
          clp$put_partial_display (display_control, formatted_time.hms, clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        = osc$millisecond_time =
          clp$put_partial_display (display_control, formatted_time.millisecond, clc$trim, amc$continue,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
        CASEND;
        STRINGREP (display_line, j, response_code);
        clp$put_partial_display (display_control, display_line (1, j), clc$trim, amc$terminate, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        nap$generate_network_message (alarm_message^.response, display_control, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        amp$flush (display_control.file_id, osc$wait, ignore_status);
        clear_output_lock;
        FREE alarm_message IN shared_heap^;
    WHILEND;

  PROCEND nap$process_alarm_output;
?? OLDTITLE ??
?? NEWTITLE := 'alarm_end_handler', EJECT ??
  PROCEDURE alarm_end_handler (termination_status: ost$status;
    VAR handler_status: ost$status);

    VAR
      ignore_status: ost$status;

    nap$deactivate_network_alarms (ignore_status);

  PROCEND alarm_end_handler;
?? OLDTITLE ??
?? NEWTITLE := 'deactivate_alarms', EJECT ??

  PROCEDURE deactivate_alarms (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: This procedure is the command processor for the NETOU deactivate_alarms
{          command.
{ DESIGN:  If the alarm task is active, it is terminated.

{ PDT deaa_pdt(
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      deaa_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^deaa_pdt_names, ^deaa_pdt_params];

    VAR
      deaa_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
        clt$parameter_name_descriptor := [['STATUS', 1]];

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

{ 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
        ignore_status: ost$status;

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

    IF alarm_task.task_status.complete THEN
      osp$set_status_condition ( nae$alarms_not_active,  status);
    ELSE
      pmp$terminate (alarm_task.task_id, status);
    IFEND;
    IF NOT alarm_output_task.task_status.complete THEN
      pmp$terminate (alarm_output_task.task_id, ignore_status);
    IFEND;
    output_lock := NIL;
    fsp$close_file (shared_segment_id, ignore_status);
    pmp$remove_queue (communication_queue_name, ignore_status);
    amp$return (shared_segment_name, ignore_status);

  PROCEND deactivate_alarms;

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

  PROCEDURE quit (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: This procedure is the command processor for the NETOU quit command.
{ DESIGN:  All asynchronous tasks are terminated, the command SAP is closed,
{          and the NETOU command utility is terminated.

{ PDT quit_pdt ()

?? PUSH (LISTEXT := ON) ??

  VAR
    quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

    VAR
      ignore_status: ost$status;

    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$end_include (utility_name, ignore_status);
    terminate_asynchronous_tasks;
    clp$close_display (output_control, ignore_status);
    clp$close_display (response_control, ignore_status);

  PROCEND quit;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := 'Function Processors' ??
?? NEWTITLE := 'normal_response_function', EJECT ??

  PROCEDURE normal_response_function (function_name: clt$name;
        argument_list: string ( * );
    VAR value: clt$value;
    VAR status: ost$status);

{ PURPOSE: This procedure processes the NETOU normal_response function.
{ DESIGN:  The parameter list is processed to determine if the response of
{          a specific system is requested. Response status is maintained
{          in an array referenced via a module level pointer variable.
{          Information saved in this array reflects the status of the last
{          command sent via the send_command command.

    VAR
      avt: array [1 .. 1] of clt$value,
      index: integer,
      normal_response_adt: [STATIC, READ, cls$adt] array [1 .. 1] of clt$argument_descriptor :=
        [[[clc$optional], [NIL, clc$name_value, 1, osc$max_name_size]]];

    clp$scan_argument_list (function_name, argument_list, ^normal_response_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    value.descriptor := 'BOOLEAN';
    value.kind := clc$boolean_value;
    value.bool.kind := clc$true_false_boolean;

    IF response_list = NIL THEN
      osp$set_status_condition ( nae$no_command_sent,  status);

    ELSEIF avt [1].kind = clc$unknown_value THEN {status from all systems requested}
      value.bool.value := TRUE;
      index := LOWERBOUND (response_list^);
      WHILE value.bool.value AND (index <= UPPERBOUND (response_list^)) DO
        value.bool.value := response_list^ [index].received AND response_list^ [index].normal_response;
        index := index + 1;
      WHILEND;

    ELSE {status of specific system requested}

    /search_for_system/
      FOR index := LOWERBOUND (response_list^) TO UPPERBOUND (response_list^) DO
        IF avt [1].name.value = response_list^ [index].system THEN
          value.bool.value := response_list^ [index].received AND response_list^ [index].normal_response;
          RETURN;
        IFEND;
      FOREND /search_for_system/;
      osp$set_status_abnormal (nac$status_id, nae$command_not_sent_to_system, avt [1].name.value, status);
    IFEND;

  PROCEND normal_response_function;
?? OLDTITLE ??
?? NEWTITLE := 'response_identifier_function', EJECT ??

  PROCEDURE response_identifier_function (function_name: clt$name;
        argument_list: string ( * );
    VAR value: clt$value;
    VAR status: ost$status);

{ PURPOSE: This procedure processes the NETOU response_identifier function.
{ DESIGN:  The parameter list is processed to determine if the response of
{          a specific system is requested. Response status is maintained
{          in an array referenced via a module level pointer variable.
{          Information saved in this array reflects the status of the last
{          command sent via the send_command command.
    VAR
      avt: array [1 .. 1] of clt$value,
      index: integer,
      response_identifier_adt: [STATIC, READ, cls$adt] array [1 .. 1] of clt$argument_descriptor :=
        [[[clc$optional], [NIL, clc$name_value, 1, osc$max_name_size]]];


    clp$scan_argument_list (function_name, argument_list, ^response_identifier_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    value.descriptor := 'INTEGER';
    value.kind := clc$integer_value;
    value.int.radix := 10;
    value.int.radix_specified := FALSE;

    IF response_list = NIL THEN
      osp$set_status_condition ( nae$no_command_sent,  status);

    ELSEIF avt [1].kind = clc$unknown_value THEN
      IF UPPERBOUND (response_list^) = 1 THEN
        value.int.value := response_list^ [1].code;
      ELSE
        osp$set_status_abnormal (nac$status_id, nae$system_name_required, 'function $RESPONSE_IDENTIFIER',
              status);
      IFEND;

    ELSE {response of specific system requested}

    /search_for_system/
      FOR index := LOWERBOUND (response_list^) TO UPPERBOUND (response_list^) DO
        IF avt [1].name.value = response_list^ [index].system THEN
          IF response_list^ [index].received THEN
            value.int.value := response_list^ [index].code;
          ELSE
            osp$set_status_abnormal (nac$status_id, nae$response_not_received, avt [1].name.value, status);
          IFEND;
          RETURN;
        IFEND;
      FOREND /search_for_system/;
      osp$set_status_abnormal (nac$status_id, nae$command_not_sent_to_system, avt [1].name.value, status);
    IFEND;

  PROCEND response_identifier_function;
?? OLDTITLE ??
?? NEWTITLE := 'matching_names_function', EJECT ??

  PROCEDURE matching_names_function (function_name: clt$name;
        argument_list: string ( * );
    VAR value: clt$value;
    VAR status: ost$status);

{ PURPOSE: This procedure processes the NETOU matching_names function.
{ DESIGN:  A translation request is issued to the Directory for the requested
{          name pattern with the standard system label prefixed to it. All
{          translations received are built into an SCL array variable and
{          returned.

    VAR
      address: nat$osi_translation_address,
      avt: array [1 .. 1] of clt$value,
      identifier: nat$directory_entry_identifier,
      priority: nat$directory_priority,
      local_status: ost$status,
      request_id: nat$directory_search_identifier,
      search_domain: [STATIC] nat$title_domain := [nac$catenet_domain],
      service: nat$protocol,
      system_title: string (nac$system_title_size + nac$system_title_prefix_size),
      title: string (nac$max_title_length),
      title_count: integer,
      title_index: 0 .. nac$system_title_size,
      title_list: ^array [1 .. * ] of title_return_entry,
      user_identifier: ost$name,
      user_info_length: 0 .. nac$max_directory_data_length,
      variable_sequence: ^SEQ ( * ),
      working_sequence: ^SEQ ( * );

    VAR
      matching_names_adt: [STATIC, READ, cls$adt] array [1 .. 1] of clt$argument_descriptor :=
        [[[clc$optional], [NIL, clc$string_value, 1, osc$max_string_size]]];

    status.normal := TRUE;
    clp$scan_argument_list (function_name, argument_list, ^matching_names_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    system_title := nac$system_title_prefix;
    system_title (nac$system_title_prefix_size + 1, * ) := avt [1].str.value (1, avt [1].str.size);
    nlp$translate_title (system_title, {wild card} TRUE, nac$unknown_protocol, {recurrent_search} FALSE,
          search_domain, nac$cdna_internal, request_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH working_sequence: [[REP max_address_count OF title_return_entry]];
    RESET working_sequence;
    title_count := 0;
    NEXT title_list: [1 .. max_address_count] IN working_sequence;
    IF title_list <> NIL THEN

    /check_title_translation/
      REPEAT
        local_status.normal := TRUE;
        nlp$get_title_translation (request_id, title, address, service, NIL, user_info_length, priority,
              user_identifier, identifier, local_status);
        IF local_status.normal THEN
          title_count := title_count + 1;
          title_list^ [title_count].value := title (nac$system_title_prefix_size + 1, * );
          title_index := nac$system_title_size;
          WHILE (title_index > 0) AND (title_list^ [title_count].value (title_index) = ' ') DO
            title_index := title_index - 1;
          WHILEND;
          title_list^ [title_count].size := title_index;
          CYCLE /check_title_translation/
        ELSEIF local_status.condition = nae$directory_search_complete THEN
          {search is done};
        ELSEIF local_status.condition = nae$no_translation_available THEN
          pmp$wait (translation_wait_time, translation_wait_time);
        ELSEIF local_status.condition <> nae$translation_req_not_active THEN {unexpected error - report it}
          status := local_status;
          RETURN;
        IFEND;
      UNTIL ((NOT local_status.normal) AND (local_status.condition = nae$translation_req_not_active)) OR
            (title_count = max_address_count);

      IF title_count = 0 THEN
        title_list^ [1].value := ' ';
        title_list^ [1].size := 0;
        title_count := 1;
      IFEND;

      RESET working_sequence;
      NEXT variable_sequence: [[REP title_count OF title_return_entry]] IN working_sequence;
      move_names_to_value (title_count, nac$system_title_size, value, variable_sequence, status);
    IFEND;
  PROCEND matching_names_function;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := 'Utility routines' ??
?? NEWTITLE := 'clear_output_lock', EJECT ??

  PROCEDURE clear_output_lock;

{ PURPOSE: This procedure clears a lock to restrict access to the output file if more than
{          one task is actively writing output.

    VAR
      actual: integer,
      result: osc$cs_successful .. osc$cs_variable_locked;

    IF output_lock <> NIL THEN
      REPEAT
        #compare_swap (output_lock^, locked, unlocked, actual, result);
      UNTIL result = osc$cs_successful;
    IFEND;

  PROCEND clear_output_lock;
?? OLDTITLE ??
?? NEWTITLE := 'display_message', EJECT ??

  PROCEDURE display_message (message_status: ost$status;
    VAR status: ost$status);

{ PURPOSE: Format and display a NOS/VE status condition.
{ DESIGN:  The message status is formatted with calls to system routines and written to
{          the $ERRORS file.

    VAR
      attachment_selections: [STATIC, READ] array [1 .. 1] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes,
            [fsc$shorten, fsc$append, fsc$modify]], * ]],
      byte_address: amt$file_byte_address,
      error_file_id: [STATIC] amt$file_identifier,
      error_file_name: [STATIC, READ] amt$local_file_name := '$ERRORS',
      error_file_opened: [STATIC] boolean := FALSE,
      ignore_status: ost$status,
      length_pointer: ^ost$status_message_line_size,
      line_count_pointer: ^ost$status_message_line_count,
      line_index: ost$status_message_line_count,
      message: ost$status_message,
      message_sequence: ^ost$status_message,
      text_pointer: ^ost$status_message_line;

    IF NOT error_file_opened THEN
      fsp$open_file (error_file_name, amc$record, ^attachment_selections,
            {default_creation_attributes =} NIL, {mandated_creation_attributes =} NIL,
            {attribute_validation =} NIL, {attribute_override =} NIL, error_file_id,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      error_file_opened := TRUE;
    IFEND;

    osp$format_message (message_status, osc$current_message_level, osc$max_status_message_line, message,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    message_sequence := ^message;
    RESET message_sequence;
    NEXT line_count_pointer IN message_sequence;

    FOR line_index := 1 TO line_count_pointer^ DO
      NEXT length_pointer IN message_sequence;
      NEXT text_pointer: [length_pointer^] IN message_sequence;
      amp$put_next (error_file_id, text_pointer, length_pointer^, byte_address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;
    amp$flush (error_file_id, osc$wait, ignore_status);

  PROCEND display_message;

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

  PROCEDURE format_time_stamp (time_stamp: nat$bcd_time;
    VAR formatted_date: ost$date;
    VAR formatted_time: ost$time);

{ PURPOSE: This procedure converts a BCD date and time into the default date/time format.

    VAR
      date_time: ost$date_time,
      ignore_status: ost$status;

    date_time.year := (time_stamp.date.year1 * 10) + time_stamp.date.year2;
    IF date_time.year < 80 THEN {allow for years 2000 to 2080}
      date_time.year := date_time.year + 100;
    IFEND;
    date_time.month := (time_stamp.date.month1 * 10) + time_stamp.date.month2;
    date_time.day := (time_stamp.date.day1 * 10) + time_stamp.date.day2;
    date_time.hour := (time_stamp.time.hours1 * 10) + time_stamp.time.hours2;
    date_time.minute := (time_stamp.time.minutes1 * 10) + time_stamp.time.minutes2;
    date_time.second := (time_stamp.time.seconds1 * 10) + time_stamp.time.seconds2;
    date_time.millisecond := (time_stamp.time.milliseconds1 * 100) + (time_stamp.time.milliseconds2 * 10) +
          time_stamp.time.milliseconds3;

    pmp$format_compact_date (date_time, osc$default_date, formatted_date, ignore_status);
    pmp$format_compact_time (date_time, osc$millisecond_time, formatted_time, ignore_status);

  PROCEND format_time_stamp;

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

  PROCEDURE generate_headers (VAR display_control: {input,output} clt$display_control;
        page_number: integer;
    VAR status: ost$status);

{ PURPOSE: This procedure formats a page header for NETOU output.
{ DESIGN:  This procedure is called by the clp$display... routines when a page header
{          is needed. Note that this routine may be called in any of the tasks activated
{          by NETOU.

    CONST
      date_length = 18,
      os_version_length = 6,
      page_number_length = 5, {includes leading blank}
      product_name = 'NETWORK OPERATOR',
      product_name_length = 16,
      product_level_length = 5,
      product_version_length = 4,
      time_length = 12,

      long_os_version_start = 48,
      long_product_name_start = 55,
      long_product_version_start = 56 + product_name_length,
      long_product_level_start = 61 + product_name_length,
      long_date_start = 91,
      long_time_start = 110,
      long_page_title_start = 123,
      long_page_number_start = 127, {includes leading blank}
      long_header_length = 132,

      short_date_start = 48,
      short_page_title_start = 70,
      short_page_number_start = 74, {includes leading blank}
      short_os_version_start = 1,
      short_product_name_start = 8,
      short_product_version_start = 9 + product_name_length,
      short_product_level_start = 14 + product_name_length,
      short_time_start = 48,
      short_header_length = 80;

    VAR
      date: ost$date,
      date_line: 1 .. 2,
      date_start: 0 .. long_header_length,
      header: array [1 .. 2] of string (long_header_length),
      header_count: 1 .. 2,
      header_length: 0 .. long_header_length,
      j: integer,
      os_version: pmt$os_name,
      page_number_start: 0 .. long_header_length,
      str: string (10),
      time: ost$time,
      time_line: 1 .. 2,
      time_start: 0 .. long_header_length;

    pmp$get_legible_date_time (osc$default_date, date, osc$default_time, time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pmp$get_os_version (os_version, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    header [1] := ' ';
    header [2] := ' ';
    IF (display_control.page_width < long_header_length) THEN
      header_length := short_header_length;
      header_count := 2;
      page_number_start := short_page_number_start;
      header [2] (short_os_version_start, os_version_length) := os_version;
      date_line := 1;
      date_start := short_date_start;
      time_line := 2;
      time_start := short_time_start;
      header [2] (short_product_name_start, product_name_length) := product_name;
      header [2] (short_product_version_start, product_version_length) := nac$operator_utility_version;
      header [2] (short_product_level_start, product_level_length) := nac$operator_utility_level;
      header [1] (short_page_title_start, 4) := 'PAGE';
    ELSE
      header_length := long_header_length;
      header_count := 1;
      page_number_start := long_page_number_start;
      header [1] (long_os_version_start, os_version_length) := os_version;
      date_line := 1;
      date_start := long_date_start;
      time_line := 1;
      time_start := long_time_start;
      header [1] (long_product_name_start, product_name_length) := product_name;
      header [1] (long_product_version_start, product_version_length) := nac$operator_utility_version;
      header [1] (long_product_level_start, product_level_length) := nac$operator_utility_level;
      header [1] (long_page_title_start, 4) := 'PAGE';
    IFEND;

    CASE date.date_format OF
    = osc$month_date =
      header [date_line] (date_start, date_length) := date.month;

    = osc$mdy_date =
      header [date_line] (date_start, date_length) := date.mdy;

    = osc$iso_date =
      header [date_line] (date_start, date_length) := date.iso;

    = osc$dmy_date =
      header [date_line] (date_start, date_length) := date.dmy;

    ELSE
    CASEND;

    CASE time.time_format OF
    = osc$ampm_time =
      header [time_line] (time_start, time_length) := time.ampm;

    = osc$hms_time =
      header [time_line] (time_start, time_length) := time.hms;

    = osc$millisecond_time =
      header [time_line] (time_start, time_length) := time.millisecond;

    ELSE
    CASEND;
    clp$reset_for_next_display_page (display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (str, j, page_number);
    header [1] (page_number_start, j) := str (1, j);

    FOR j := 1 TO header_count DO
      clp$put_display (display_control, header [j] (1, header_length), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND generate_headers;

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

  PROCEDURE move_names_to_value (name_count: integer;
        name_length: ost$string_size;
    VAR value: clt$value;
    VAR variable_sequence: ^SEQ ( * );
    VAR status: ost$status);

{ PURPOSE: This routine stores an array of strings in an SCL variable.

    VAR
      string_value: ^array [1 .. * ] of cell,
      unique_name: ost$name,
      variable: clt$variable_reference,
      variable_dimension: integer,
      variable_scope: [STATIC, READ] clt$variable_scope := [clc$local_variable];

    pmp$get_unique_name (unique_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    unique_name (1) := '#';

    IF name_count <= 0 THEN
      variable_dimension := 1;
    ELSE
      variable_dimension := name_count;
    IFEND;

    clp$create_variable (unique_name, clc$string_value, name_length, 1, variable_dimension,
          variable_scope, variable, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    value.descriptor := 'VARIABLE';
    value.kind := clc$variable_reference;
    value.var_ref := variable;

    RESET variable_sequence;
    NEXT string_value: [1 .. #SIZE (variable_sequence^)] IN variable_sequence;
    variable.value.string_value := string_value;
    clp$write_variable (unique_name, variable.value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$read_variable (unique_name, value.var_ref, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND move_names_to_value;
?? OLDTITLE ??
?? NEWTITLE := 'set_output_lock', EJECT ??

  PROCEDURE set_output_lock;

{ PURPOSE: This procedure sets a lock to restrict access to the output file if more than
{          one task is actively writing output.

    VAR
      actual: integer,
      result: osc$cs_successful .. osc$cs_variable_locked;

    IF output_lock <> NIL THEN
      REPEAT
        #compare_swap (output_lock^, unlocked, locked, actual, result);
        IF result = osc$cs_failed THEN
          pmp$wait (1000, 1000);
        IFEND;
      UNTIL result = osc$cs_successful;
    IFEND;

  PROCEND set_output_lock;
?? OLDTITLE ??
?? NEWTITLE := 'terminate_asynchronous_tasks', EJECT ??

  PROCEDURE terminate_asynchronous_tasks;

{ PURPOSE: This procedure terminates an active alarm task.

    VAR
      ignore_status: ost$status;

    IF NOT alarm_task.task_status.complete THEN
      pmp$terminate (alarm_task.task_id, ignore_status);
    IFEND;
    IF NOT alarm_output_task.task_status.complete THEN
      pmp$terminate (alarm_output_task.task_id, ignore_status);
    IFEND;
    fsp$close_file (shared_segment_id, ignore_status);
    pmp$remove_queue (communication_queue_name, ignore_status);
    amp$return (shared_segment_name, ignore_status);

  PROCEND terminate_asynchronous_tasks;
?? OLDTITLE ??
MODEND nam$network_operator_utility;
