?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE message template generator' ??
MODULE osm$generate_message_template ALIAS 'genmt';

{
{ PURPOSE:
{   The purpose of this module is to generate a list of commands to create
{   message templates.  The commands include CREATE_MESSAGE_MODULE,
{   CREATE_STATUS_MESSAGE, and END_MESSAGE_MODULE.
{
{ DESIGN:
{
{   An input file of condition code definitions is processed.  The list of
{   generated commands is written to an output file.  An error file will
{   contain errors encountered by the GENMT program.
{
{   The GENMT program will terminate abnormally if a file cannot be accessed
{   properly, such as by open, read, or write.
{
{   The format and basic processing of the input file is described below:
{
{     Any line beginning with a CYBIL name where the third and fourth characters
{     are c$, c#, e$, or e# is considered a constant to be evaluated by the GENMT
{     program.  An e$ or e# constant is considered by GENMT to be the start of an
{     condition code definition and is processed accordingly.
{
{     A constant may be declared in the following ways:
{       constant = integer
{               OR
{       constant = string (only for c$ or c#)
{               OR
{       constant = constant
{               OR
{       constant = constant + integer
{               OR
{       constant = (($INTEGER ('x') * 100(16)) + $INTEGER ('y')) * 1000000(16)
{         where 'x' and 'y' are any one character
{               OR
{       constant = (($INTEGER ('x') * 100(16)) + $INTEGER ('y')) * 1000000(16) + integer
{
{     In the case of an e$ or e# constant the condition name and condition code are
{     defined at this point.
{
{    Only one constant declaration per line is recognized.  The constant declaration
{    must be contained on one line.  Only integer constants can be referenced in
{    other constant declarations.
{
{  * IF a constant is declared more than once the first definition is used in
{    future references of other constant declarations.
{
{    Any consecutive lines beginning with '{' directly following an e$ or e# constant
{    declaration are processed for the error severity level and message text.
{    The lines may contain a corresponding end bracket to signify the end of the
{    line or the end bracket may be excluded.  IF an end_bracket is found and is
{    preceeded by any blanks, an ellipsis is concatenated to the end of the blanks
{    as part of the message text.  If any of these lines contain all blanks (excluding
{    the beginning and end brackets) the searching for more message text is terminated.
{
{  * The severity level is the first character after '{' of the first line.  If
{    one is not found 'E' is assumed.  The first non-blank character found on the
{    line following the severity level is considered the start of the message text.
{
{    A condition definition will generate a CREATE_STATUS_MESSAGE command written to
{    the output file.  The message text will be printed line by line as found in the
{    input file.
{
{    Any line beginning with 'MODULE' OR 'MODEND' will generate a CREATE_MESSAGE_MODULE
{    or END_MESSAGE_MODULE command, respectively, written to the output file.
{
{    All other unprocessed lines and excessive characters of processed lines
{    are IGNORED.
{      Example: ignore_constant =1;              : This line is ignored.
{      Example: xxe$error = 10; {E message text  : the characters starting with ';'
{                                                  to the end of line are ignored.
{
{    Error messages are issued for all errors GENMT may find while processing a line.
{    At that point the constant declaration or complete condition definition is
{    ignored except for 2 errors noted above with '*'.
{
{  Any line to be printed to the output file whose length is longer than the file's
{  page width will be broken into multiple print lines.  Each print line except
{  the last one will be concatenated with an ellipsis.
{
{  One example of minimum information that GENMT will process correctly:
{    MODULE errors
{    xxc$one_thousand = 1000
{    xxc$one_thousand_ten = xxc$one_thousand + 10
{    xxe$first_error = xxc$one_thousand_ten + 1
{    {E xxxxxxxxx
{    {xxxxxxxxxxx
{    xxe$second_error = 1012
{    {E xxxxxxx
{    MODEND
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_mt_generator
*copyc clt$parameter_list
*copyc oss$job_paged_literal
*copyc ost$message_module_severity
*copyc ost$status
*copyc osv$lower_to_upper
?? POP ??
*copyc amp$fetch
*copyc amp$get_next
*copyc amp$put_next
*copyc clp$evaluate_parameters
*copyc clp$evaluate_token
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$format_message
*copyc osp$set_status_abnormal
*copyc osp$unpack_status_condition
?? EJECT ??

  TYPE
    work_files = (input_file, output_file, error_file),
    input_line_description = (module_line, modend_line, c$_or_c#_line, e$_or_e#_line, message_text_line,
          eoi_encountered);

  VAR
    file_identifier: array [work_files] of amt$file_identifier,
    error_file_attributes: array [1 .. 1] of amt$fetch_item,
    output_file_attributes: array [1 .. 1] of amt$fetch_item,
    ignore_byte_address: amt$file_byte_address,
    input_line: ost$string,
    input_line_type: input_line_description,
    processing_message_text: boolean,
    start_pos: clt$string_index;

?? TITLE := 'clp$generate_message_template', EJECT ??

{
{    The purpose of this request is to generate a list of commands to create
{  message templates.
{
{    Note: Memory is allocated for a linked list.  The memory is not freed in
{  this procedure.  It is expected to be freed at program termination.
{

  PROCEDURE [XDCL] clp$generate_message_template
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$genmt) generate_message_template, generate_message_templates, genmt (
{   input, i: file = $required
{   output, o: file = $required
{   error, e: file = $errors
{   product_identifier, identifier, pi: name 1..2 = $optional
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 10] of clt$pdt_parameter_name,
        parameters: array [1 .. 5] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
        type3: record
          header: clt$type_specification_header,
          default_value: string (7),
        recend,
        type4: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type5: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 10, 27, 17, 48, 55, 890], clc$command, 10, 5, 2, 0, 0, 0, 5, 'OSM$GENMT'],
            [['E                              ', clc$abbreviation_entry, 3],
            ['ERROR                          ', clc$nominal_entry, 3],
            ['I                              ', clc$abbreviation_entry, 1],
            ['IDENTIFIER                     ', clc$alias_entry, 4],
            ['INPUT                          ', clc$nominal_entry, 1],
            ['O                              ', clc$abbreviation_entry, 2],
            ['OUTPUT                         ', clc$nominal_entry, 2],
            ['PI                             ', clc$abbreviation_entry, 4],
            ['PRODUCT_IDENTIFIER             ', clc$nominal_entry, 4],
            ['STATUS                         ', clc$nominal_entry, 5]], [

{ PARAMETER 1

      [5, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],

{ PARAMETER 2

      [7, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],

{ PARAMETER 3

      [2, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_default_parameter, 0, 7],

{ PARAMETER 4

      [9, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 5, clc$optional_parameter, 0, 0],

{ PARAMETER 5

      [10, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name], clc$pass_by_reference, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],

{ PARAMETER 1

      [[1, 0, clc$file_type]],

{ PARAMETER 2

      [[1, 0, clc$file_type]],

{ PARAMETER 3

      [[1, 0, clc$file_type], '$errors'],

{ PARAMETER 4

      [[1, 0, clc$name_type], [1, 2]],

{ PARAMETER 5

      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$input = 1,
      p$output = 2,
      p$error = 3,
      p$product_identifier = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

?? NEWTITLE := 'process_base_expression', EJECT ??

{    This procedure will process the following expressions:
{      (($INTEGER ('x') * 100(16)) + $INTEGER ('y')) * 1000000(16)
{                                OR
{      (($INTEGER ('x') * 100(16)) + $INTEGER ('y')) * 1000000(16) + integer
{      where 'x' and 'y' are any one character.

    PROCEDURE process_base_expression;

?? NEWTITLE := 'get_character', EJECT ??

      PROCEDURE [INLINE] get_character;

        VAR
*IF NOT $true(osv$unix_tools_on_ve)
          offset: 100(16) .. 1000000(16);
*ELSE
          offset: 100(16) .. 10000(16);
*IFEND

      /ok/
        BEGIN
          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF NOT ((first_char = '') AND (token.kind = clc$left_parenthesis_token) OR
                (token.kind = clc$add_token)) THEN
            EXIT /ok/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          ELSEIF (token.kind <> clc$name_token) OR (token.str.value (1, token.str.size) <> '$INTEGER') THEN
            EXIT /ok/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          ELSEIF token.kind <> clc$left_parenthesis_token THEN
            EXIT /ok/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          ELSEIF (token.kind <> clc$string_token) OR (token.str.size <> 1) THEN
            EXIT /ok/;
          IFEND;

          IF first_char = '' THEN
            first_char := token.str.value (1);
            offset := 100(16);
          ELSE
            second_char := token.str.value (1);
*IF NOT $true(osv$unix_tools_on_ve)
            offset := osc$max_status_condition_number + 1;
*ELSE
            offset := 65535 + 1;
*IFEND
            clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                  ignore_preceding_spaces, token, status);
            IF NOT status.normal THEN
              RETURN;
            ELSEIF token.kind <> clc$right_parenthesis_token THEN
              EXIT /ok/;
            IFEND;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          ELSEIF token.kind <> clc$right_parenthesis_token THEN
            EXIT /ok/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          ELSEIF token.kind <> clc$multiply_token THEN
            EXIT /ok/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          ELSEIF (token.kind <> clc$unsigned_integer_token) OR (token.int.value <> offset) THEN
            EXIT /ok/;
          IFEND;

          IF second_char = '' THEN
            clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                  ignore_preceding_spaces, token, status);
            IF NOT status.normal THEN
              RETURN;
            ELSEIF token.kind <> clc$right_parenthesis_token THEN
              EXIT /ok/;
            IFEND;
          IFEND;

          RETURN;

        END /ok/;

        osp$set_status_abnormal ('CL', cle$unrecognizable_ecc_base, name_token.str.
              value (1, name_token.str.size), status);

      PROCEND get_character;
?? OLDTITLE, EJECT ??

      VAR
        first_char: string (1),
        second_char: string (1),
        count: 1 .. 2;

      first_char := '';
      second_char := '';

      FOR count := 1 TO 2 DO
        get_character;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

      number := (($INTEGER (first_char) * 100(16)) + $INTEGER (second_char)) *
*IF NOT $true(osv$unix_tools_on_ve)
            (osc$max_status_condition_number + 1);
*ELSE
            (65535 + 1);
*IFEND
      process_plus_integer;

    PROCEND process_base_expression;
?? TITLE := 'process_plus_integer', EJECT ??

    PROCEDURE [INLINE] process_plus_integer;

      clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
            ignore_preceding_spaces, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (token.kind <> clc$signed_integer_token) OR (token.int.value <= 0) THEN
        IF token.kind = clc$add_token THEN
          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          osp$set_status_abnormal ('CL', cle$expecting_integer_value, token.descriptor, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, name_token.str.
                value (1, name_token.str.size), status);
        IFEND;
        RETURN;
      IFEND;

      IF (number + token.int.value) > osc$max_condition THEN
        osp$set_status_abnormal ('CL', cle$cond_code_too_large, name_token.str.value (1, name_token.str.size),
              status);
        RETURN;
      IFEND;
      number := number + token.int.value;

    PROCEND process_plus_integer;
?? TITLE := 'process_constant_expression', EJECT ??

    PROCEDURE [INLINE] process_constant_expression;

      search_for_defined_constant;
      IF status.normal THEN
        process_plus_integer;
      IFEND;

    PROCEND process_constant_expression;
?? TITLE := 'search_for_defined_constant', EJECT ??

    PROCEDURE [INLINE] search_for_defined_constant;

      IF (token.str.value (3, 2) = 'C$') OR (token.str.value (3, 2) = 'C#') THEN
        defined_constant := current_c$_or_c#_constant;
      ELSEIF (token.str.value (3, 2) = 'E$') OR (token.str.value (3, 2) = 'E#') THEN
        defined_constant := current_e$_or_e#_constant;
      ELSE
        defined_constant := NIL;
      IFEND;

      WHILE defined_constant <> NIL DO
        IF defined_constant^.name = token.str.value THEN
          number := defined_constant^.value;
          RETURN;
        IFEND;
        defined_constant := defined_constant^.next_defined_constant;
      WHILEND;

      osp$set_status_abnormal ('CL', cle$constant_not_defined, token.str.value (1, token.str.size), status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name_token.str.
            value (1, name_token.str.size), status);

    PROCEND search_for_defined_constant;
?? TITLE := 'save_defined_constant', EJECT ??

    PROCEDURE [INLINE] save_defined_constant;

      IF input_line_type = c$_or_c#_line THEN
        defined_constant := current_c$_or_c#_constant;
      ELSE
        defined_constant := current_e$_or_e#_constant;
      IFEND;

      WHILE defined_constant <> NIL DO
        IF defined_constant^.name = name_token.str.value THEN
          osp$set_status_abnormal ('CL', cle$constant_already_defined, name_token.str.
                value (1, name_token.str.size), status);
          RETURN;
        IFEND;
        defined_constant := defined_constant^.next_defined_constant;
      WHILEND;

      ALLOCATE defined_constant;
      IF defined_constant = NIL THEN
        osp$set_status_abnormal ('CL', cle$constant_stack_overflow, name_token.str.
              value (1, name_token.str.size), status);
        RETURN;
      IFEND;
      defined_constant^.name := name_token.str.value;
      defined_constant^.value := number;
      IF input_line_type = c$_or_c#_line THEN
        defined_constant^.next_defined_constant := current_c$_or_c#_constant;
        current_c$_or_c#_constant := defined_constant;
      ELSE
        defined_constant^.next_defined_constant := current_e$_or_e#_constant;
        current_e$_or_e#_constant := defined_constant;
      IFEND;

    PROCEND save_defined_constant;
?? TITLE := 'determine_severity_level', EJECT ??

    PROCEDURE [INLINE] determine_severity_level;

      IF start_pos <= input_line.size THEN

      /get_severity_level/
        FOR severity_char := LOWERBOUND (severity_levels) TO UPPERBOUND (severity_levels) DO
          IF input_line.value (start_pos) = severity_levels [severity_char] THEN
            waiting_for_severity_level := FALSE;
            start_pos := start_pos + 1;
            WHILE (start_pos <= input_line.size) AND (input_line.value (start_pos) = ' ') DO
              start_pos := start_pos + 1;
            WHILEND;
            RETURN;
          IFEND;
        FOREND /get_severity_level/;
      ELSE
        severity_char := UPPERBOUND (severity_levels);
      IFEND;

      IF waiting_for_severity_level THEN
        osp$set_status_abnormal ('CL', cle$no_severity_level, name_token.str.value (1, name_token.str.size),
              status);
        print_error (status);
        waiting_for_severity_level := FALSE;
      IFEND;

    PROCEND determine_severity_level;
?? OLDTITLE, EJECT ??

    CONST
*IF NOT $true(osv$unix_tools_on_ve)
      cresm_command_line_size = 144; {Max number of characters in a   CRESM command without the message text.}
*ELSE
      cresm_command_line_size = 145; {Max number of characters in a   CRESM command without the message text.}
*IFEND

    TYPE
      constant_info = record
        name: ost$name,
        value: ost$status_condition,
        next_defined_constant: constant_ptr,
      recend,
      constant_ptr = ^constant_info;

    VAR
      attachment_options: array [1 .. 3] of fst$attachment_option,
      command_line: string (cresm_command_line_size),
      command_line_size: integer,
*IF NOT $true(osv$unix_tools_on_ve)
      condition_number: ost$status_condition_number,
*ELSE
      condition_number: ost$status_condition_code,
*IFEND
      current_c$_or_c#_constant: constant_ptr,
      current_e$_or_e#_constant: constant_ptr,
      default_creation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
      defined_constant: constant_ptr,
      evaluation_options: clt$token_evaluation_options,
      file: work_files,
      file_names: array [work_files] of ^fst$file_reference,
      get_another_line: boolean,
      id_characters: ost$status_identifier,
      ignore_preceding_spaces: boolean,
      local_status: ost$status,
      name_token: clt$lexical_token,
      number: ost$status_condition,
      severity_char: ost$message_module_severity,
      severity_key: [STATIC, READ, oss$job_paged_literal] array [ost$message_module_severity] of
            ost$string := [[11, 'INFORMATIVE'], [7, 'WARNING'], [5, 'FATAL'], [12, 'CATASTROPHIC'], [12,
            'NON_STANDARD'], [9, 'DEPENDENT'], [5, 'ERROR']],
      severity_levels: [STATIC, READ, oss$job_paged_literal] array [ost$message_module_severity] of
            char := ['I', 'W', 'F', 'C', 'N', 'D', 'E'],
      token: clt$lexical_token,
      validation_attributes: array [1 .. 5] of fst$file_cycle_attribute,
      waiting_for_message_text: boolean,
      waiting_for_severity_level: boolean;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_names [input_file] := pvt [p$input].value^.file_value;
    file_names [output_file] := pvt [p$output].value^.file_value;
    file_names [error_file] := pvt [p$error].value^.file_value;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [2].selector := fsc$open_share_modes;
    attachment_options [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [3].selector := fsc$create_file;
    attachment_options [3].create_file := FALSE;
    validation_attributes [1].selector := fsc$null_attribute;
    validation_attributes [2].selector := fsc$file_contents_and_processor;
    validation_attributes [2].file_contents := fsc$legible_data;
    validation_attributes [2].file_processor := osc$null_name;
    validation_attributes [3].selector := fsc$file_contents_and_processor;
    validation_attributes [3].file_contents := amc$legible;
    validation_attributes [3].file_processor := osc$null_name;
    validation_attributes [4].selector := fsc$file_contents_and_processor;
    validation_attributes [4].file_contents := fsc$data;
    validation_attributes [4].file_processor := osc$null_name;
    validation_attributes [5].selector := fsc$file_contents_and_processor;
    validation_attributes [5].file_contents := fsc$unknown_contents;
    validation_attributes [5].file_processor := osc$null_name;
    fsp$open_file (file_names [input_file]^, amc$record, ^attachment_options, NIL, NIL,
          ^validation_attributes, NIL, file_identifier [input_file], status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options [fsc$append, fsc$shorten];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [];
    attachment_options [2].selector := fsc$access_and_share_modes;
    attachment_options [2].access_modes.selector := fsc$specific_access_modes;
    attachment_options [2].access_modes.value := $fst$file_access_options [fsc$append];
    attachment_options [2].share_modes.selector := fsc$specific_share_modes;
    attachment_options [2].share_modes.value := $fst$file_access_options [];
    attachment_options [3].selector := fsc$open_share_modes;
    attachment_options [3].open_share_modes := -$fst$file_access_options [];
    validation_attributes [1].selector := fsc$file_contents_and_processor;
    validation_attributes [1].file_contents := fsc$legible_scl_include;
    validation_attributes [1].file_processor := osc$null_name;
    default_creation_attributes [1].selector := fsc$file_contents_and_processor;
    default_creation_attributes [1].file_contents := fsc$legible_scl_include;
    default_creation_attributes [1].file_processor := osc$null_name;
    default_creation_attributes [2].selector := fsc$page_format;
    default_creation_attributes [2].page_format := amc$untitled_form;
    fsp$open_file (file_names [output_file]^, amc$record, ^attachment_options, ^default_creation_attributes,
          NIL, ^validation_attributes, NIL, file_identifier [output_file], status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier [input_file], local_status);
      RETURN;
    IFEND;

    validation_attributes [1].file_contents := fsc$list;
    default_creation_attributes [1].file_contents := fsc$list;
    default_creation_attributes [1].file_processor := osc$null_name;
    default_creation_attributes [2].page_format := amc$continuous_form;
    fsp$open_file (file_names [error_file]^, amc$record, ^attachment_options, ^default_creation_attributes,
          NIL, ^validation_attributes, NIL, file_identifier [error_file], status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier [input_file], local_status);
      fsp$close_file (file_identifier [output_file], local_status);
      RETURN;
    IFEND;

  /generate_template/
    BEGIN
      output_file_attributes [1].key := amc$page_width;
      amp$fetch (file_identifier [output_file], output_file_attributes, status);
      IF status.normal THEN
        error_file_attributes [1].key := amc$page_width;
        amp$fetch (file_identifier [error_file], error_file_attributes, status);
      IFEND;

      IF NOT status.normal THEN
        EXIT /generate_template/;
      IFEND;

      IF output_file_attributes [1].page_width < osc$min_status_message_line THEN
        output_file_attributes [1].page_width := osc$min_status_message_line;
      IFEND;
      IF error_file_attributes [1].page_width > osc$max_status_message_line THEN
        error_file_attributes [1].page_width := osc$max_status_message_line;
      ELSEIF error_file_attributes [1].page_width < osc$min_status_message_line THEN
        error_file_attributes [1].page_width := osc$min_status_message_line;
      IFEND;

      current_c$_or_c#_constant := NIL;
      current_e$_or_e#_constant := NIL;
      get_another_line := TRUE;
      processing_message_text := FALSE;
      evaluation_options := $clt$token_evaluation_options [clc$ignore_spaces_before_token,
            clc$comment_is_token, clc$classify_name_token, clc$international_char_is_token];

    /process_input_file/
      WHILE TRUE DO

        IF NOT status.normal THEN
          print_error (status);
          IF NOT status.normal THEN
            EXIT /process_input_file/;
          IFEND;
        IFEND;

        IF get_another_line THEN
          get_input_line (status);
          IF NOT status.normal THEN
            EXIT /process_input_file/;
          IFEND
        ELSE
          get_another_line := TRUE;
        IFEND;

        CASE input_line_type OF
        = eoi_encountered =
          EXIT /process_input_file/;

        = c$_or_c#_line, e$_or_e#_line =
          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, name_token, status);
          IF NOT status.normal THEN
            CYCLE /process_input_file/;
          IFEND;
          IF name_token.kind <> clc$cybil_name_token THEN
            osp$set_status_abnormal ('CL', cle$expecting_name_value, input_line.
                  value (token.text_index, token.text_size), status);
            CYCLE /process_input_file/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            CYCLE /process_input_file/;
          IFEND;
          IF token.kind <> clc$equal_token THEN
            osp$set_status_abnormal ('CL', cle$expecting_equal_sign, token.descriptor, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, name_token.str.
                  value (1, name_token.str.size), status);
            CYCLE /process_input_file/;
          IFEND;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            CYCLE /process_input_file/;
          IFEND;

          CASE token.kind OF
          = clc$unsigned_integer_token =
            IF token.int.value > osc$max_condition THEN
              osp$set_status_abnormal ('CL', cle$cond_code_too_large, name_token.str.
                    value (1, name_token.str.size), status);
              CYCLE /process_input_file/;
            IFEND;
            number := token.int.value;

          = clc$left_parenthesis_token =
            process_base_expression;
            IF NOT status.normal THEN
              CYCLE /process_input_file/;
            IFEND;

          = clc$cybil_name_token, clc$simple_name_token =
            process_constant_expression;
            IF NOT status.normal THEN
              CYCLE /process_input_file/;
            IFEND;

          ELSE
            IF input_line_type = e$_or_e#_line THEN
              osp$set_status_abnormal ('CL', cle$invalid_integer_constant, name_token.str.
                    value (1, name_token.str.size), status);
            ELSEIF token.kind <> clc$string_token THEN
              osp$set_status_abnormal ('CL', cle$invalid_int_or_string_const, name_token.str.
                    value (1, name_token.str.size), status);
            IFEND;
            CYCLE /process_input_file/;
          CASEND;

          save_defined_constant;
          IF defined_constant = NIL THEN
            EXIT /process_input_file/;
          IFEND;
          IF input_line_type = c$_or_c#_line THEN
            CYCLE /process_input_file/;
          IFEND;

*IF NOT $true(osv$unix_tools_on_ve)
          IF number > osc$max_status_condition_number THEN
            osp$unpack_status_condition (number, id_characters, condition_number);
          ELSE
*IFEND
            id_characters := name_token.str.value (1, 2);
            condition_number := number;
*IF NOT $true(osv$unix_tools_on_ve)
          IFEND;
*IFEND
          IF pvt [p$product_identifier].specified THEN
            id_characters := pvt [p$product_identifier].value^.name_value (1, 2);
          IFEND;

          waiting_for_severity_level := TRUE;
          waiting_for_message_text := TRUE;
          processing_message_text := TRUE;

          WHILE processing_message_text DO
            get_input_line (status);
            IF NOT status.normal THEN
              EXIT /process_input_file/;
            IFEND;

            IF input_line_type = message_text_line THEN
              IF waiting_for_severity_level THEN
                determine_severity_level;
                IF NOT status.normal THEN
                  EXIT /process_input_file/;
                IFEND;
              IFEND;

              IF start_pos <= input_line.size THEN
                IF waiting_for_message_text THEN
                  waiting_for_message_text := FALSE;
                  STRINGREP (command_line, command_line_size, 'CREATE_STATUS_MESSAGE', '  NAME=',
                        name_token.str.value (1, name_token.str.size), '  IDENTIFIER=''', id_characters,
                        '''  CODE=', condition_number, '  SEVERITY=', severity_key [severity_char].
                        value (1, severity_key [severity_char].size), '  COLLECT_TEMPLATE_UNTIL=''**''');
                  print_line (command_line (1, command_line_size), status);
                  IF NOT status.normal THEN
                    EXIT /process_input_file/;
                  IFEND;
                IFEND;

                print_line (input_line.value (start_pos, input_line.size - start_pos + 1), status);
                IF NOT status.normal THEN
                  EXIT /process_input_file/;
                IFEND;
              IFEND;
            ELSE
              get_another_line := FALSE;
              IF waiting_for_message_text THEN
                IF waiting_for_severity_level THEN
                  osp$set_status_abnormal ('CL', cle$no_severity_level, name_token.str.
                        value (1, name_token.str.size), status);
                  print_error (status);
                  IF NOT status.normal THEN
                    EXIT /process_input_file/;
                  IFEND;
                IFEND;
                osp$set_status_abnormal ('CL', cle$no_message_text, name_token.str.
                      value (1, name_token.str.size), status);
                CYCLE /process_input_file/;
              ELSE
                command_line := '**';
                command_line_size := 2;
              IFEND;
            IFEND;
          WHILEND;

        = module_line =
          start_pos := start_pos + 6;

          clp$evaluate_token (input_line.value (1, input_line.size), evaluation_options, start_pos,
                ignore_preceding_spaces, token, status);
          IF NOT status.normal THEN
            CYCLE /process_input_file/;
          IFEND;
          IF NOT ((token.kind = clc$cybil_name_token) OR (token.kind = clc$simple_name_token)) THEN
            osp$set_status_abnormal ('CL', cle$expecting_module_name, token.descriptor, status);
            CYCLE /process_input_file/;
          IFEND;

          STRINGREP (command_line, command_line_size, 'CREATE_MESSAGE_MODULE  NAME=', token.str.
                value (1, token.str.size));

        = modend_line =
          command_line := 'END_MESSAGE_MODULE';
          command_line_size := 18;

        ELSE
          osp$set_status_abnormal ('CL', cle$internal_generator_error, name_token.str.
                value (1, name_token.str.size), status);
          CYCLE /process_input_file/;
        CASEND;

        print_line (command_line (1, command_line_size), status);
        IF NOT status.normal THEN
          EXIT /process_input_file/;
        IFEND;

      WHILEND /process_input_file/;
    END /generate_template/;

    FOR file := LOWERBOUND (file_names) TO UPPERBOUND (file_names) DO
      fsp$close_file (file_identifier [file], local_status);
      IF (NOT local_status.normal) AND status.normal THEN
        status := local_status;
      IFEND;
    FOREND;

  PROCEND clp$generate_message_template;
?? TITLE := 'get_input_line', EJECT ??

{
{    The purpose of this request is to repeatedly get the next line of a
{  specified input file until it finds one of six line types.
{
{    The input line types are:
{  module_line,
{  modend_line,
{  c$_or_c#_line,
{  e$_or_e#_line,
{  message_text_line,
{  eoi_encountered.
{

  PROCEDURE get_input_line
    (VAR status: ost$status);

    CONST
      max_upper_case_chars_size = 7;

    VAR
      end_pos: ost$string_size,
      save_pos: ost$string_size,
      position_of_file: amt$file_position,
      string_size: ost$string_size,
      transfer_count: amt$transfer_count,
      upper_case_chars: string (max_upper_case_chars_size);

  /get_next_line/
    WHILE TRUE DO
      amp$get_next (file_identifier [input_file], ^input_line.value, osc$max_string_size, transfer_count,
            ignore_byte_address, position_of_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF position_of_file = amc$eoi THEN
        input_line_type := eoi_encountered;
        processing_message_text := FALSE;
        RETURN;
      IFEND;

      start_pos := 1;
      end_pos := transfer_count;

    /find_non_blank_char/
      WHILE TRUE DO
        IF start_pos > end_pos THEN
          processing_message_text := FALSE;
          CYCLE /get_next_line/;
        IFEND;
        IF input_line.value (start_pos) = ' ' THEN
          start_pos := start_pos + 1;
        ELSE
          EXIT /find_non_blank_char/;
        IFEND;
      WHILEND /find_non_blank_char/;

      IF input_line.value (start_pos) = '{' THEN
        IF processing_message_text THEN
          start_pos := start_pos + 1;
          save_pos := start_pos;

        /find_end_pos/
          WHILE start_pos <= end_pos DO
            CASE input_line.value (end_pos) OF
            = ' ' =
              end_pos := end_pos - 1;

            = '}' =
              end_pos := end_pos - 1;
              IF input_line.value (end_pos) = ' ' THEN
                save_pos := end_pos;
                end_pos := end_pos - 1;
              IFEND;

            ELSE
              IF save_pos <> start_pos THEN
                input_line.value (save_pos + 1, 2) := '..';
                end_pos := save_pos + 2;
              IFEND;
              input_line_type := message_text_line;
              EXIT /get_next_line/;
            CASEND;
          WHILEND /find_end_pos/;
          processing_message_text := FALSE;
        IFEND;
      ELSE
        processing_message_text := FALSE;
        string_size := end_pos - start_pos + 1;

        IF string_size > 3 THEN
          IF string_size > max_upper_case_chars_size THEN
            string_size := max_upper_case_chars_size;
          IFEND;
          #TRANSLATE (osv$lower_to_upper, input_line.value (start_pos, string_size), upper_case_chars);

          IF (upper_case_chars (3, 2) = 'C$') OR (upper_case_chars (3, 2) = 'C#') THEN
            input_line_type := c$_or_c#_line;
            EXIT /get_next_line/;
          ELSEIF (upper_case_chars (3, 2) = 'E$') OR (upper_case_chars (3, 2) = 'E#') THEN
            input_line_type := e$_or_e#_line;
            EXIT /get_next_line/;
          ELSEIF upper_case_chars = 'MODULE ' THEN
            input_line_type := module_line;
            EXIT /get_next_line/;
          ELSEIF upper_case_chars = 'MODULE;' THEN
            input_line_type := module_line;
            EXIT /get_next_line/;
          ELSEIF upper_case_chars = 'MODEND ' THEN
            input_line_type := modend_line;
            EXIT /get_next_line/;
          ELSEIF upper_case_chars = 'MODEND;' THEN
            input_line_type := modend_line;
            EXIT /get_next_line/;
          IFEND;
        IFEND;
      IFEND;
    WHILEND /get_next_line/;

    input_line.size := end_pos;

  PROCEND get_input_line;
?? TITLE := 'print_line', EJECT ??

{
{    The purpose of this request is to print a line to a specified
{  output file.

  PROCEDURE print_line
    (    line: string ( * );
     VAR status: ost$status);

    VAR
      char_index: ost$string_size,
      found_other_characters: boolean,
      output_line: ^string ( * ),
      output_line_size: integer,
      page_width: amt$page_width,
      remaining_text: ost$string_size,
      start_index: ost$string_size;

    remaining_text := STRLENGTH (line);
    IF remaining_text <= output_file_attributes [1].page_width THEN
      amp$put_next (file_identifier [output_file], ^line, remaining_text, ignore_byte_address, status);
      RETURN;
    IFEND;

    PUSH output_line: [output_file_attributes [1].page_width];
    start_index := 1;

    WHILE TRUE DO
      found_other_characters := FALSE;
      page_width := output_file_attributes [1].page_width - 2;

    /determine_page_width/
      FOR char_index := (start_index + page_width - 1) DOWNTO start_index DO
        CASE line (char_index) OF
        = ' ' =
          page_width := char_index - start_index + 1;
          EXIT /determine_page_width/;

        = '.' =
          IF NOT found_other_characters THEN
            IF page_width > 1 THEN
              page_width := page_width - 1;
            ELSE
              page_width := output_file_attributes [1].page_width - 2;
            IFEND;
          IFEND;

        ELSE
          found_other_characters := TRUE;
        CASEND;
      FOREND /determine_page_width/;

      STRINGREP (output_line^, output_line_size, line (start_index, page_width), '..');
      amp$put_next (file_identifier [output_file], output_line, output_line_size, ignore_byte_address,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      remaining_text := remaining_text - page_width;
      start_index := start_index + page_width;

      IF remaining_text <= output_file_attributes [1].page_width THEN
        amp$put_next (file_identifier [output_file], ^line (start_index), remaining_text, ignore_byte_address,
              status);
        RETURN;
      IFEND;
    WHILEND;

  PROCEND print_line;
?? TITLE := 'print_error', EJECT ??

{
{    The purpose of this request is to print the status error message in a
{  specified error file.
{

  PROCEDURE print_error
    (VAR status: ost$status);

    VAR
      local_status: ost$status,
      message: ost$status_message,
      message_area: ^ost$status_message,
      message_line_count: ^ost$status_message_line_count,
      message_line_index: 1 .. osc$max_status_message_lines,
      message_line_size: ^ost$status_message_line_size,
      message_line: ^string ( * );


    osp$format_message (status, osc$full_message_level, error_file_attributes [1].page_width, message,
          local_status);
    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;

    message_area := ^message;
    RESET message_area;
    NEXT message_line_count IN message_area;
    FOR message_line_index := 1 TO message_line_count^ DO
      NEXT message_line_size IN message_area;
      NEXT message_line: [message_line_size^] IN message_area;
      amp$put_next (file_identifier [error_file], message_line, message_line_size^, ignore_byte_address,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND print_error;

MODEND osm$generate_message_template;
