?? LEFT := 1, RIGHT := 110 ??
?? TITLE := 'NOS/VE: CDCNET Message generator' ??
?? NEWTITLE := 'Global Declarations' ??
MODULE nam$generate_network_message;
?? PUSH (LISTEXT:=ON) ??
*copyc nae$network_operator_utility
*copyc nac$network_management_catalog
*copyc nat$command_interface
*copyc nat$management_data_unit_syntax
*copyc ost$status
*copyc osc$max_status_message_line
*copyc ost$status_condition_code
*copyc ost$status_message
*copyc ost$status_message_line
*copyc ost$status_message_line_count
*copyc ost$status_message_line_size
?? POP ??
*copyc clp$convert_integer_to_string
*copyc clp$put_display
*copyc osp$establish_condition_handler
*copyc osp$format_multi_part_message
*copyc osp$set_status_abnormal
*copyc pmp$continue_to_cause

  TYPE
    template_identifier = 0 .. 65535;

  CONST
    nac$di_status_id = 'DC',
    nac$di_condition_bias = (($INTEGER ('D') * 100(16)) + $INTEGER ('C')) * 1000000(16),
    nac$di_message_module_name = 'DCM$TEMPLATES',
    nac$default_di_template_number = 0;

  TYPE
    message_parameter = ^ost$message_parameter;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nap$generate_network_message', EJECT ??

  PROCEDURE [XDCL] nap$generate_network_message (network_message: SEQ ( * );
    VAR display_control: clt$display_control;
    VAR status: ost$status);

{ PURPOSE: This procedure uses the CDCNET templates to format and display a network command
{          response or alarm message.
{ DESIGN:  The message template library must be accessible to the system message generator.
{          It may be in a library specified on the relevant program description or in a
{          library in the command list.
{          The data received from the DI is broken down and converted into a list of
{          parameter strings that are given to the SCL message formatter with the first
{          format request. The message formatter calls the get_message_part procedure
{          to obtain subsequent message conditions and parameter lists until the DI message
{          is exhausted.

    VAR
      condition_code: ost$status_condition_code,
      end_of_message: boolean,
      ignore_status: ost$status,
      line_count: ^ost$status_message_line_count,
      line_index: ost$status_message_line_count,
      message: [STATIC] ^SEQ (REP 5 * nac$max_command_response_length OF cell) := NIL,
      max_parameter_count: integer,
      message_data: ^SEQ ( * ),
      message_parameter_seq: ^SEQ ( * ),
      message_parameter_strings: ^SEQ ( * ),
      message_parameters: ^ost$message_parameters,
      page_width: ost$status_message_line_size,
      template_id: ^template_identifier,
      text_length: ^ost$status_message_line_size,
      text_line: ^ost$status_message_line;

?? 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);

      pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IF (condition.selector = ifc$interactive_condition) AND
            (condition.interactive_condition = ifc$terminate_break) THEN
          EXIT nap$generate_network_message;
      IFEND;

    PROCEND condition_handler;

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

  PROCEDURE get_message_part (VAR condition_code: ost$status_condition_code;
    VAR message_parameters: ^ost$message_parameters;
    VAR end_of_message: boolean;
    VAR status: ost$status);

    VAR
      bit_set: ^packed array [1 .. *] of boolean,
      byte: ^0 .. 255,
      count: 0 .. 256,
      end_of_template: boolean,
      fill_bit_eliminator: [STATIC, READ] array [0 .. 7] of integer := [1, 128, 64, 32, 16, 8, 4, 2],
      header: ^nat$mdu_header,
      hex_array: ^packed array [1 .. *] of 0 .. 15,
      hex_table: [STATIC, READ] array [0 .. 15] of char := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
            'A', 'B', 'C', 'D', 'E', 'F'],
      index: integer,
      integer_string: ost$string,
      integer_value: integer,
      negative_bias: integer,
      negative_number: boolean,
      parameter_count: integer,
      working_parameters: ^ost$message_parameters;

    status.normal := TRUE;
    parameter_count := 0;
    end_of_message := FALSE;
    end_of_template := FALSE;
    RESET message_parameter_strings;
    RESET message_parameter_seq;
    NEXT working_parameters: [1 .. max_parameter_count] IN message_parameter_seq;

    NEXT header IN message_data;
    IF header = NIL THEN
      end_of_message := TRUE;
      RETURN {no data to process};
    IFEND;
    IF header^.command THEN
      NEXT template_id IN message_data;
      IF template_id <> NIL THEN
        condition_code := template_id^ + nac$di_condition_bias;
      ELSE {no template_id specified for display}
        condition_code := nac$default_di_template_number;
      IFEND;
      NEXT header IN message_data;
    ELSE
      condition_code := nac$default_di_template_number;
    IFEND;

  /process_optional_data/
    WHILE (NOT end_of_template) AND (header <> NIL) AND (NOT header^.command) DO
      parameter_count := parameter_count + 1;

      CASE header^.kind OF
      = nac$mdu_binary_string =
{ Binary string is displayed as a series of binary digits (0 and 1).
        count := header^.length + 1;
        NEXT bit_set: [1 .. count] IN message_data;
        IF bit_set <> NIL THEN
          NEXT working_parameters^ [parameter_count]: [count] IN message_parameter_strings;
          FOR index := 1 to count DO
            IF bit_set^ [index] THEN
              working_parameters^ [parameter_count]^ (index) := '1';
            ELSE
              working_parameters^ [parameter_count]^ (index) := '0';
            IFEND;
          FOREND;
        ELSE
          end_of_template := TRUE;
        IFEND;

      = nac$mdu_binary_octet =
{ Binary octet is displayed as a series of hexadecimal digits, two digits per octet. }
        count := (header^.length + 1) * 2;
        NEXT hex_array: [1 .. count] IN message_data;
        IF hex_array <> NIL THEN
          NEXT working_parameters^ [parameter_count]: [count] IN message_parameter_strings;
          FOR index := 1 to count DO
            working_parameters^ [parameter_count]^ (index) := hex_table [hex_array^ [index]];
          FOREND;
        ELSE
          end_of_template := TRUE;
        IFEND;

      = nac$mdu_unsigned_integer =
{ Integer is displayed as a series of decimal digits. Fill bits may need to be removed.}
        count := (header^.length + 1 + 7) DIV 8;
        integer_value := 0;
        FOR index := 1 TO count DO
          NEXT byte IN message_data;
          IF byte <> NIL THEN
            integer_value := (integer_value * 256) + byte^;
          IFEND;
        FOREND;
        IF byte <> NIL THEN
          integer_value := integer_value DIV fill_bit_eliminator [(header^.length + 1) MOD 8];
          clp$convert_integer_to_string (integer_value, {base} 10, {include radix} FALSE, integer_string,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          NEXT working_parameters^ [parameter_count]: [integer_string.size] IN message_parameter_strings;
          working_parameters^ [parameter_count]^ := integer_string.value;
        ELSE
          end_of_template := TRUE;
        IFEND;

      = nac$mdu_signed_integer =
{ Integer is displayed as a series of decimal digits. Fill bits may need to be removed.}
        count := (header^.length + 1 + 7) DIV 8;
        integer_value := 0;
        NEXT byte IN message_data;
        IF byte <> NIL THEN
          negative_number := byte^ >= 128;
          negative_bias := 128;
          IF negative_number THEN
            integer_value := byte^ - 128;
          ELSE {positive number}
            integer_value := byte^;
          IFEND;
          FOR index := 2 TO count DO
            NEXT byte IN message_data;
            IF byte <> NIL THEN
              integer_value := (integer_value * 256) + byte^;
              negative_bias := negative_bias * 256;
            IFEND;
          FOREND;
          IF negative_number THEN
            integer_value := integer_value - negative_bias;
          IFEND;
          integer_value := integer_value DIV fill_bit_eliminator [(header^.length + 1) MOD 8];
          clp$convert_integer_to_string (integer_value, {base} 10, {include radix} FALSE, integer_string,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          NEXT working_parameters^ [parameter_count]: [integer_string.size] IN message_parameter_strings;
          working_parameters^ [parameter_count]^ := integer_string.value;
        ELSE
          end_of_template := TRUE;
        IFEND;

      = nac$mdu_character_string =
{ Character string is displayed as a series of ASCII characters.}
        NEXT working_parameters^ [parameter_count]: [header^.length + 1] IN message_data;
        IF working_parameters^ [parameter_count] = NIL THEN
          end_of_template := TRUE;
          parameter_count := parameter_count - 1;
        IFEND;

      = nac$mdu_bcd =
{ BCD is displayed as a series of hexadecimal digits.}
        count := (header^.length + 1);
        NEXT hex_array: [1 .. count] IN message_data;
        IF hex_array <> NIL THEN
          NEXT working_parameters^ [parameter_count]: [count] IN message_parameter_strings;
          FOR index := 1 to count DO
            working_parameters^ [parameter_count]^ (index) := hex_table [hex_array^ [index]];
          FOREND;
        ELSE
          end_of_template := TRUE;
        IFEND;

      ELSE
        osp$set_status_abnormal (nac$status_id, nae$unknown_cdna_mdu_data_kind, '', status);
        RETURN;
      CASEND;

      NEXT header IN message_data;
    WHILEND {process_optional_data};

    IF (header <> NIL) AND header^.command THEN
      RESET message_data TO header {reposition sequence for next call to get_message_part};
    IFEND;

    IF parameter_count > 0 THEN
      RESET message_parameter_seq;
      NEXT  message_parameters: [1 .. parameter_count] IN message_parameter_seq;
    ELSE
      message_parameters := NIL;
    IFEND;

  PROCEND get_message_part;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    IF message = NIL THEN
      ALLOCATE message;
      RESET message;
    IFEND;

{   Each message parameter requires at least 3 bytes. Maximum number of parameters, therefore, is
{   message_size/3.

    max_parameter_count := #SIZE(network_message) DIV 3;
    PUSH message_parameter_seq: [[REP max_parameter_count OF message_parameter]];

{ Worst case for expansion of raw data to display is the binary string format.
{ Allow for 256 display bytes for each 10 bytes of message (2 header bytes + 8 data bytes)

    PUSH message_parameter_strings: [[REP (#SIZE (network_message) * 256) DIV 10 OF cell]];
    message_data := ^network_message;
    RESET message_data;

    get_message_part (condition_code, message_parameters, end_of_message, status);
    IF (NOT status.normal) OR end_of_message THEN
      RETURN;
    IFEND;

    IF display_control.page_width <= UPPERVALUE (ost$status_message_line_size) THEN
      page_width := display_control.page_width;
    ELSE
      page_width := UPPERVALUE (ost$status_message_line_size);
    IFEND;
    osp$establish_condition_handler (^condition_handler, {block exit=} FALSE);
    osp$format_multi_part_message (osc$brief_message_level, osc$error_status_message_hdr,
          page_width, condition_code, message_parameters, ^get_message_part, message^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET message;
    NEXT line_count IN message;

{ NOTE: The message formatter has placed a format effector in each line. clp$put_display will also add one,
{       so the first character of each line is skipped.

    FOR line_index := 1 TO line_count^ DO
      NEXT text_length IN message;
      NEXT text_line: [text_length^] IN message;
      clp$put_display (display_control, text_line^ (2, *), clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND nap$generate_network_message;
MODEND nam$generate_network_message;
