?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Expression Scanner' ??
MODULE clm$f_scan_expression;

{
{ PURPOSE:
{   This module contains the SCL expression scanner.  This includes both syntactic and semantic analyzers
{   for all of the various kinds of expressions.  In particular, included are the scanners for variable
{   references, as well as evaluators for the operators.
{
{ DESIGN:
{   Expression scanning is accomplished using the technique known as "recursive descent".  This means that
{   "knowledge" of the syntax of expressions is embodied in the code rather than in syntax tables and that,
{   in general, for each syntactic construct there is a corresponding procedure to process it.  The desired
{   kind of result is used to select a starting point for the scan, but apart from that has no influence
{   during expression scanning.  Once a result has been obtained, checking for a match against the desired
{   kind of result is performed and, if appropriate, conversion or variable dereferencing performed.
{     Names encounterred in an expression are evaluated under the following rules:
{       1.  If the name designates a "built-in" function the function is evaluated.
{       2.  If the name is immediately followed by a "(" it assumed that a subscripted variable reference has
{           been found and dereferenceing takes place.
{       3.  If the name is followed a "." then:
{             a.  if the name designates a variable it is assumed that a field reference to that variable
{                 is being made and dereferencing takes place
{             b.  otherwise it is assumed that a file reference has been found and it is evaluated.
{       4.  If the name is the operand of one of the expression operators it is assumed to be a "simple"
{           variable reference and dereferencing takes place.
{       5.  If a name is the result of complete evaluation of the expression then:
{             a.  if the desired kind of result is string, boolean, integer, real or status, variable
{                 dereferenceing takes place
{             b.  if the desired kind of result is file, the name is "converted" to a file reference
{             c.  if the desired kind of result is variable, the name is "converted" to a variable
{                 reference.
{     Each scanning procedure receives the first token of its part of the expression and, in addition
{   to returning its primary result, returns the token that follows its part of the expression, and
{   causes the updating of the text index parameters which keep track of the current scan position.
{

?? NEWTITLE := 'Global Declarations' ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$value
*copyc clt$variable_reference
*copyc cle$ecc_expression
*copyc cle$ecc_expression_result
*copyc cle$ecc_function_processing
*copyc cle$ecc_lexical
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_scl_formatter
*copyc clt$command_line_size
*copyc clt$lexical_unit_kinds
*copyc clt$value_kind_specifier
*copyc oss$job_paged_literal
*copyc ost$status
*copyc ost$string
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$delete_current_format_token
*copyc clp$delete_node_format_token
*copyc clp$evaluate_numeric_literal
*copyc clp$f_add_node_value
*copyc clp$f_scan_argument_list
*copyc clp$f_scan_parameter_list
*copyc clp$f_scan_token
*copyc clp$f_set_tree_marker
*copyc clp$initialize_parse_state
*copyc clp$insert_format_marker
*copyc clp$isolate_balanced_text
*copyc clp$isolate_text_via_separator
*copyc clp$recognize_format_tokens
*copyc clp$scan_balanced_parenthesis
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper

  VAR
    clv$substitution_mark: [XDCL]  string (1) := ' ';

?? TITLE := 'clp$f_scan_expression', EJECT ??
*copyc clh$scan_expression

  PROCEDURE [XDCL, #GATE] clp$f_scan_expression
    (    expression: string ( * );
         value_kind_specifier: clt$value_kind_specifier;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      parse: clt$parse_state,
      new_token_index: integer,
      token: clt$token_array_index,
      token_index: integer;

    status.normal := TRUE;
    clp$initialize_parse_state (^expression, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    clp$f_get_token_index (token_index);
    clp$f_evaluate_expression (value_kind_specifier, FALSE, FALSE, parse, value, local_status);
    IF (parse.unit.kind <> clc$lex_end_of_line) AND (parse.unit.kind <> clc$lex_comma) AND
          (NOT parse.previous_unit_is_space) AND (NOT parse.unit_is_space) THEN
      osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', local_status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, local_status);
    IFEND;
    IF local_status.normal AND (parse.unit.kind <> clc$lex_end_of_line) THEN
      clp$f_get_token_index (new_token_index);
      FOR token := new_token_index DOWNTO token_index DO
        clp$delete_node_format_token (token);
      FOREND;
    IFEND;
    status := local_status;

  PROCEND clp$f_scan_expression;
?? TITLE := 'clv$value_descriptors', EJECT ??

  VAR
    clv$value_descriptors: [READ, oss$job_paged_literal] array [clc$variable_reference .. clc$status_value] of
          string (8) := ['VARIABLE', 'FILE', 'NAME', 'STRING', 'REAL', 'INTEGER', 'BOOLEAN', 'STATUS'];

?? TITLE := 'expression_scanners table', EJECT ??

  TYPE
    expression_kinds = (operand_expression, numeric_expression, string_expression, general_expression);

  VAR
    expression_kind_selector: [STATIC, READ, oss$job_paged_literal] array
          [clc$unspecified_value .. clc$keyword_value] of expression_kinds := [
          {} operand_expression {clc$unspecified_value} ,
          {} * {clc$application_value} ,
          {} operand_expression {clc$variable_reference} ,
          {} operand_expression {clc$file_value} ,
          {} operand_expression {clc$name_value} ,
          {} string_expression {clc$string_value} ,
          {} numeric_expression {clc$real_value} ,
          {} numeric_expression {clc$integer_value} ,
          {} general_expression {clc$boolean_value} ,
          {} operand_expression {clc$status_value} ,
          {} general_expression {clc$any_value} ,
          {} * {clc$cobol_name_value} ,
          {} * {clc$date_time_value} ,
          {} * {clc$entry_point_reference_value} ,
          {} operand_expression {clc$keyword_value} ];

  VAR
    expression_scanners: [STATIC, READ, oss$job_paged_literal] array [expression_kinds] of ^procedure
           (    expression_kind: expression_kinds;
                evaluate: boolean;
            VAR parse {input, output} : clt$parse_state;
            VAR value: clt$value;
            VAR status: ost$status) := [^scan_operand, ^scan_term_5, ^scan_term_4, ^scan_term_0];

  VAR
    spaces_before_not_part_of_token: [STATIC, READ, oss$job_paged_literal] set of clt$lexical_unit_kind :=
          [clc$lex_unknown, clc$lex_dot, clc$lex_colon, clc$lex_left_parenthesis, clc$lex_query, clc$lex_add,
          clc$lex_subtract, clc$lex_string, clc$lex_name, clc$lex_unsigned_decimal, clc$lex_alpha_number];


  TYPE
    clt$operator_representation = string (3);

?? TITLE := 'clp$f_expression_scanner', EJECT ??
*copyc clh$expression_scanner

  PROCEDURE [XDCL] clp$f_expression_scanner
    (    value_kind_specifier: clt$value_kind_specifier;
         control_expression: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);


    status.normal := TRUE;

{ Scan SCL expression or application value.

    expression_scanners [expression_kind_selector [value_kind_specifier.kind]]^
          (expression_kind_selector [value_kind_specifier.kind], TRUE, parse, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF NOT control_expression THEN
      WHILE parse.unit_index < parse.index_limit DO
        scan_operand (expression_kind_selector [value_kind_specifier.kind], TRUE, parse, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      WHILEND;
    IFEND;

  PROCEND clp$f_expression_scanner;
?? TITLE := 'clp$f_evaluate_expression', EJECT ??

{   NOTE: a  flag referred to as EVALUATE is passed among the various parts of
{ the expression scanner.  It is  initially  set  to  TRUE  to  indicate  that
{ operators,  function calls, nested expressions, and variable references will
{ be evaluated.  When it is set to FALSE, these things are only scanned  (i.e.
{ not interpreted or evaluated).  The flag is set to FALSE prior to processing
{ the right operand of an AND operator whose left operand is FALSE  or  an  OR
{ operator whose left operand is TRUE.
{

  PROCEDURE [XDCL] clp$f_evaluate_expression
    (    value_kind_specifier: clt$value_kind_specifier;
         control_expression: boolean;
         parameter: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);


?? TITLE := 'check_for_and_handle_range', EJECT ??

    PROCEDURE [INLINE] check_for_and_handle_range;

      VAR
        local_parse: clt$parse_state;


{ scan low value of range

      scan_value;
      IF status.normal AND (parse.index <> parse.index_limit) THEN
        IF parse.unit.kind <> clc$lex_ellipsis THEN
          local_parse := parse;
          clp$recognize_format_tokens (FALSE);
          clp$f_scan_token (clc$slu_non_space, local_parse);
          clp$recognize_format_tokens (TRUE);
          IF local_parse.unit.kind = clc$lex_ellipsis THEN
            clp$f_scan_token (clc$slu_non_space, parse);
          IFEND;
        IFEND;
        IF parse.unit.kind = clc$lex_ellipsis THEN

{ scan high value of range

          clp$f_scan_token (clc$slu_non_space, parse);
          scan_value;
        IFEND;
      IFEND;

    PROCEND check_for_and_handle_range;
?? TITLE := 'scan_value', EJECT ??

    PROCEDURE [INLINE] scan_value;

      VAR
        text_index: clt$command_line_index,
        expression_index: clt$command_line_index;

      IF parameter THEN
        clp$delete_current_format_token;
        expression_index := parse.unit_index;
        clp$isolate_balanced_text (parse.text^, expression_index, text_index);
        parse.index := text_index;
        scan_expression (parse.text^ (expression_index, text_index - expression_index));
      ELSE
        clp$f_expression_scanner (value_kind_specifier, control_expression, parse, value, status);
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    PROCEND scan_value;
?? TITLE := 'check_for_handle_nested_range', EJECT ??

    PROCEDURE [INLINE] check_for_handle_nested_range;

      VAR
        local_parse: clt$parse_state;


{ scan low value of range

      scan_nested_value;
      IF status.normal AND (parse.index <> parse.index_limit) THEN
        IF parse.unit.kind <> clc$lex_ellipsis THEN
          local_parse := parse;
          clp$recognize_format_tokens (FALSE);
          clp$f_scan_token (clc$slu_non_space, local_parse);
          clp$recognize_format_tokens (TRUE);
          IF local_parse.unit.kind = clc$lex_ellipsis THEN
            clp$f_scan_token (clc$slu_non_space, parse);
          IFEND;
        IFEND;
        IF parse.unit.kind = clc$lex_ellipsis THEN

{ scan high value of range

          clp$f_scan_token (clc$slu_non_space, parse);
          scan_nested_value;
        IFEND;
      IFEND;

    PROCEND check_for_handle_nested_range;
?? TITLE := 'scan_nested_value', EJECT ??

    PROCEDURE [INLINE] scan_nested_value;

      VAR
        text_index: clt$command_line_index,
        expression_index: clt$command_line_index;

      clp$delete_current_format_token;
      expression_index := parse.unit_index;
      clp$isolate_balanced_text (parse.text^, expression_index, text_index);
      parse.index := text_index;
      scan_expression (parse.text^ (expression_index, text_index - expression_index));
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    PROCEND scan_nested_value;
?? TITLE := 'scan_expression', EJECT ??

    PROCEDURE [INLINE] scan_expression
      (    expression: string ( * ));

      VAR
        new_token_index: integer,
        parse: clt$parse_state,
        token: clt$token_array_index,
        token_index: integer;

      status.normal := TRUE;
      clp$initialize_parse_state (^expression, NIL, parse);
      clp$f_scan_token (clc$slu_non_space, parse);
      clp$f_get_token_index (token_index);

      clp$f_expression_scanner (value_kind_specifier, control_expression, parse, value, status);
      IF (parse.unit.kind <> clc$lex_end_of_line) THEN
        clp$f_get_token_index (new_token_index);
        FOR token := new_token_index DOWNTO token_index DO
          clp$delete_node_format_token (token);
        FOREND;
      IFEND;

    PROCEND scan_expression;
?? TITLE := 'scan_parenthesized_list', EJECT ??

    PROCEDURE scan_parenthesized_list
      (VAR parse: clt$parse_state;
           parameter: boolean);

      VAR
        text_index: clt$command_line_index,
        start_index: integer,
        end_index: integer,
        token: clt$token_array_index,
        expression_index: clt$command_line_index;


      status.normal := TRUE;
      IF parse.unit.kind = clc$lex_left_parenthesis THEN

      /try_list/
        BEGIN
          expression_index := parse.unit_index;
          clp$f_get_token_index (start_index);
          clp$insert_format_marker (clc$value_begin, 1);
          clp$f_scan_token (clc$slu_non_space, parse);
          IF parse.unit.kind = clc$lex_right_parenthesis THEN
            clp$insert_format_marker (clc$value_end, 1);
            clp$f_scan_token (clc$slu_non_space, parse);
            RETURN;
          IFEND;

        /scan_list/
          WHILE TRUE DO
            IF parameter THEN
              scan_parenthesized_list (parse, parameter);
            ELSE
              clp$delete_current_format_token;
              clp$scan_balanced_parenthesis (parse.text^, parse.unit_index, text_index);
              clp$initialize_parse_state (^parse.text^ (parse.unit_index, text_index - parse.unit_index), NIL,
                    local_parse);
              clp$f_scan_token (clc$slu_non_space, local_parse);
              parse.index := text_index;
              scan_parenthesized_list (local_parse, parameter);
            IFEND;
            IF NOT status.normal THEN
              EXIT /try_list/;
            IFEND;
            IF (parse.unit.kind <> clc$lex_right_parenthesis) AND
                  (parse.unit.kind <> clc$lex_left_parenthesis) THEN
              clp$f_scan_token (clc$slu_non_space, parse);
            IFEND;
            CASE parse.unit.kind OF
            = clc$lex_end_of_line =
              osp$set_status_abnormal ('CL', cle$expecting_rparen, '', status);
              EXIT /try_list/;
            = clc$lex_right_parenthesis =
              clp$insert_format_marker (clc$value_end, 1);
              clp$f_scan_token (clc$slu_non_space, parse);
              EXIT /scan_list/;
            = clc$lex_comma, clc$lex_ellipsis =
              clp$insert_format_marker (clc$value_end, 1);
              clp$f_scan_token (clc$slu_non_space, parse);
            ELSE
              IF (parse.unit.kind IN spaces_before_not_part_of_token) AND parse.previous_unit_is_space THEN
                clp$insert_format_marker (clc$value_end, 1);
              ELSE
                osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                EXIT /try_list/;
              IFEND;
            CASEND;
          WHILEND /scan_list/;
        END /try_list/;

        IF (NOT status.normal) THEN

{ not a list

          status.normal := TRUE;
          clp$f_get_token_index (end_index);
          FOR token := end_index DOWNTO start_index + 1 DO
            clp$delete_node_format_token (token);
            clp$delete_current_format_token;
          FOREND;
          parse.index := expression_index;
          clp$f_scan_token (clc$slu_non_space, parse);
          clp$f_expression_scanner (value_kind_specifier, control_expression, parse, value, status);
        IFEND;
      ELSE
        clp$insert_format_marker (clc$value_begin, 1);
        check_for_handle_nested_range;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    PROCEND scan_parenthesized_list;
?? OLDTITLE, EJECT ??

    VAR
      text_index: clt$command_line_index,
      start_index: integer,
      end_index: integer,
      token: clt$token_array_index,
      expression_index: clt$command_line_index,
      saved_parse: clt$parse_state,
      local_parse: clt$parse_state;


    status.normal := TRUE;
    IF parse.unit.kind = clc$lex_left_parenthesis THEN

    /try_list/
      BEGIN
        expression_index := parse.unit_index;
        clp$f_get_token_index (start_index);
        clp$insert_format_marker (clc$value_set_begin, 0);
        clp$f_scan_token (clc$slu_non_space, parse);
        IF parse.unit.kind = clc$lex_right_parenthesis THEN
          clp$insert_format_marker (clc$value_set_end, 1);
          clp$f_scan_token (clc$slu_non_space, parse);
          RETURN;
        IFEND;

      /scan_list/
        WHILE TRUE DO
          IF parse.unit.kind = clc$lex_left_parenthesis THEN
            saved_parse := parse;
            clp$f_scan_token (clc$slu_non_space, saved_parse);
            clp$delete_current_format_token;
            IF saved_parse.unit.kind = clc$lex_left_parenthesis THEN
              clp$f_evaluate_expression (value_kind_specifier, control_expression, parameter, parse, value,
                    status);
            ELSE
              scan_parenthesized_list (parse, TRUE);
            IFEND;
          ELSE
            scan_parenthesized_list (parse, parameter);
            clp$f_scan_token (clc$slu_any, parse);
          IFEND;
          IF NOT status.normal THEN
            EXIT /try_list/;
          IFEND;
          IF parse.unit.kind = clc$lex_space THEN
            clp$f_scan_token (clc$slu_non_space, parse);
          IFEND;
          CASE parse.unit.kind OF
          = clc$lex_end_of_line =
            osp$set_status_abnormal ('CL', cle$expecting_rparen, '', status);
            EXIT /try_list/;
          = clc$lex_right_parenthesis =
            clp$insert_format_marker (clc$value_set_end, 1);
            clp$f_scan_token (clc$slu_non_space, parse);
            EXIT /scan_list/;
          = clc$lex_comma, clc$lex_ellipsis =
            clp$insert_format_marker (clc$value_end, 1);
            clp$f_scan_token (clc$slu_non_space, parse);
          ELSE
            IF (parse.unit.kind IN spaces_before_not_part_of_token) AND parse.previous_unit_is_space THEN
              clp$insert_format_marker (clc$value_end, 1);
            ELSE
              osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT /try_list/;
            IFEND;
          CASEND;
        WHILEND /scan_list/;
      END /try_list/;

      IF (NOT status.normal) OR
            ((NOT parameter) AND (parse.unit.kind <> clc$lex_right_parenthesis) AND
            (parse.unit.kind <> clc$lex_end_of_line)) THEN

{ not a list

        status.normal := TRUE;
        clp$f_get_token_index (end_index);
        FOR token := end_index DOWNTO start_index DO
{         clp$delete_node_format_token (token);
          clp$delete_current_format_token;
        FOREND;
        parse.unit_index := expression_index;
        parse.index := expression_index;
        clp$f_scan_token (clc$slu_non_space, parse);
        clp$f_expression_scanner (value_kind_specifier, control_expression, parse, value, status);
      IFEND;
    ELSE
      clp$insert_format_marker (clc$value_begin, 1);
      check_for_and_handle_range;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$f_scan_token (clc$slu_any, parse);
    IFEND;

  PROCEND clp$f_evaluate_expression;
?? TITLE := 'clp$f_set_substitution_mark', EJECT ??

  PROCEDURE [XDCL] clp$f_set_substitution_mark
    (    substitution_mark: string (1));

    clv$substitution_mark := substitution_mark;

  PROCEND clp$f_set_substitution_mark;
?? TITLE := 'scan_operand', EJECT ??

  PROCEDURE scan_operand
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      name: clt$name,
      name_is_constant: boolean,
      number: clt$number,
      offset: 0 .. 2,
      sign: -1 .. 1,
      first_string_unit: boolean,
      string_complete: boolean,
      string_unit_size: clt$string_size,
      translate_name_kludge: ^string ( * <= osc$max_name_size),
      parameter_list_string: ost$string,
      save_parse: clt$parse_state,
      text_index: clt$command_line_index,
      ignore_extra_element: clt$name;

    status.normal := TRUE;
    IF parse.unit_is_space THEN
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;
    CASE parse.unit.kind OF
    = clc$lex_long_name =
      osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
            status);
      RETURN;
    = clc$lex_unterminated_string =
      osp$set_status_abnormal ('CL', cle$missing_string_delimiter, parse.
            text^ (parse.unit_index, parse.unit.size), status);
      RETURN;
    = clc$lex_colon, clc$lex_dot =
      clp$insert_format_marker (clc$file_or_var_begin, 1);
      clp$f_complete_file_or_var_scan (parse, status);
      IF status.normal THEN
        IF parse.unit.kind <> clc$lex_end_of_line THEN
          clp$insert_format_marker (clc$file_or_var_end, 1);
        ELSE
          clp$insert_format_marker (clc$file_or_var_end, 0);
        IFEND;
      IFEND;
      RETURN;

    = clc$lex_name =
      name.value := parse.text^ (parse.unit_index, parse.unit.size);
      name.size := parse.unit.size;
      clp$f_scan_token (clc$slu_any, parse);
      CASE parse.unit.kind OF

      = clc$lex_left_parenthesis =

        IF name.value (1) = '$' THEN {have function
          clp$insert_format_marker (clc$function_begin, 2);
          IF parse.unit_index + 1 = parse.index_limit THEN
            osp$set_status_abnormal ('CL', cle$expecting_rparen_of_alist, name.value (1, name.size), status);
            RETURN;
          IFEND;
          clp$isolate_text_via_separator (clc$ibt_stop_on_balanced, parse.text^, parse.unit_index,
                text_index);
          clp$f_scan_argument_list (name, parse.text^ (parse.unit_index + 1,
                text_index - parse.unit_index - 2), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          parse.index := text_index - 1;
          clp$f_scan_token (clc$slu_non_space, parse);
          IF parse.unit.kind <> clc$lex_right_parenthesis THEN
            osp$set_status_abnormal ('CL', cle$expecting_rparen_of_alist, ' ', status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            RETURN;
          IFEND;
          clp$insert_format_marker (clc$function_end, 0);
          clp$f_scan_token (clc$slu_any, parse);
          clp$insert_format_marker (clc$file_or_var_begin, 1);
          clp$f_complete_file_or_var_scan (parse, status);
          IF status.normal THEN
            IF parse.unit.kind <> clc$lex_end_of_line THEN
              clp$insert_format_marker (clc$file_or_var_end, 1);
            ELSE
              clp$insert_format_marker (clc$file_or_var_end, 0);
            IFEND;
          IFEND;
        ELSE {variable
          clp$insert_format_marker (clc$file_or_var_begin, 2);
          clp$f_complete_file_or_var_scan (parse, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF parse.unit.kind <> clc$lex_end_of_line THEN
            clp$insert_format_marker (clc$file_or_var_end, 1);
          ELSE
            clp$insert_format_marker (clc$file_or_var_end, 0);
          IFEND;
        IFEND;

      = clc$lex_dot =
        clp$insert_format_marker (clc$file_or_var_begin, 2);
        clp$f_complete_file_or_var_scan (parse, status);
        IF parse.unit.kind <> clc$lex_end_of_line THEN
          clp$insert_format_marker (clc$file_or_var_end, 1);
        ELSE
          clp$insert_format_marker (clc$file_or_var_end, 0);
        IFEND;

      ELSE
        IF name.value (1) = '$' THEN
          IF parse.unit.kind = clc$lex_end_of_line THEN
            offset := 1;
          ELSE
            offset := 2;
          IFEND;
          clp$insert_format_marker (clc$function_begin, offset);
          clp$insert_format_marker (clc$function_end, offset - 1);
        IFEND;
      CASEND;
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      RETURN;
    = clc$lex_unsigned_decimal, clc$lex_alpha_number =
      sign := 1;

{ NOTE:
{      Since clp$evaluate_numeric_literal does not add format tokens,
{      that action must be taken here upon return.

      save_parse := parse;
      clp$evaluate_numeric_literal (sign, 10, parse, number, status);
      IF status.normal THEN
        IF number.kind = clc$integer_number THEN
          value.descriptor := clv$value_descriptors [clc$integer_value];
          value.kind := clc$integer_value;
          value.int := number.integer_number;
        ELSE
          value.descriptor := clv$value_descriptors [clc$real_value];
          value.kind := clc$real_value;
          value.rnum := number.real_number
        IFEND;
        WHILE save_parse.index < parse.index DO
          clp$f_scan_token (clc$slu_any, save_parse);
        WHILEND;

{ Check for time_increment

        WHILE parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_unsigned_decimal, clc$lex_subtract,
              clc$lex_colon, clc$lex_dot] DO
          clp$f_scan_token (clc$slu_any, parse);
        WHILEND;

        IF parse.unit_is_space THEN
          clp$f_scan_token (clc$slu_non_space, parse);
        IFEND;
        RETURN;
      IFEND;

    = clc$lex_string =
      value.descriptor := clv$value_descriptors [clc$string_value];
      value.kind := clc$string_value;

      value.str.size := 0;
      value.str.value := ' ';
      first_string_unit := TRUE;
      REPEAT
        IF NOT first_string_unit THEN
          IF value.str.size = osc$max_string_size THEN
            osp$set_status_abnormal ('CL', cle$string_too_long, value.str.value (1, value.str.size), status);
            RETURN;
          IFEND;
          value.str.size := value.str.size + 1;
          value.str.value (value.str.size) := '''';
        IFEND;
        string_unit_size := parse.unit.size - 2;
        IF (value.str.size + string_unit_size) > osc$max_string_size THEN
          osp$set_status_abnormal ('CL', cle$string_too_long, value.str.value (1, value.str.size), status);
          RETURN;
        IFEND;
        value.str.value (value.str.size + 1, string_unit_size) :=
              parse.text^ (parse.unit_index + 1, string_unit_size);
        value.str.size := value.str.size + string_unit_size;
        first_string_unit := FALSE;
        clp$f_scan_token (clc$slu_any, parse);
      UNTIL parse.unit.kind <> clc$lex_string;
      IF parse.unit.kind = clc$lex_unterminated_string THEN
        osp$set_status_abnormal ('CL', cle$missing_string_delimiter, parse.
              text^ (parse.unit_index, parse.unit.size), status);
      IFEND;
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      RETURN;

    = clc$lex_left_parenthesis =
      clp$f_scan_token (clc$slu_non_space, parse);
      IF parse.unit.kind <> clc$lex_right_parenthesis THEN
        expression_scanners [expression_kind]^ (expression_kind, TRUE, parse, value, status);
        IF (parse.unit_is_space) OR (parse.unit.kind = clc$lex_name) THEN
          REPEAT
            clp$f_scan_token (clc$slu_non_space, parse);
          UNTIL (parse.unit.kind = clc$lex_right_parenthesis) OR (parse.unit.kind =
                clc$lex_end_of_line);
        IFEND;
      IFEND;
      IF status.normal AND (parse.unit.kind <> clc$lex_right_parenthesis) THEN
        osp$set_status_abnormal ('CL', cle$expecting_rparen, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      IFEND;

    = clc$lex_unknown =
      IF (clv$substitution_mark = ' ') OR (parse.text^ (parse.unit_index, parse.unit.size) <>
            clv$substitution_mark) THEN
        osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Unknown char in line.', status);
        RETURN;
      ELSE
        REPEAT
          clp$f_scan_token (clc$slu_non_space, parse);
        UNTIL parse.text^ (parse.unit_index, parse.unit.size) = clv$substitution_mark;
      IFEND;

    ELSE
      IF (parse.unit_index + parse.unit.size - 1) <= STRLENGTH (parse.text^) THEN
        value.descriptor := parse.text^ (parse.unit_index, parse.unit.size);
      ELSE
        value.descriptor := '';
      IFEND;
      value.kind := clc$unknown_value;
      IF ((value.descriptor(1,1) = ')') AND (parse.unit.kind = clc$lex_right_parenthesis)) THEN
        osp$set_status_abnormal ('CL', cle$unbalanced_parenthesis, '', status);
        RETURN;
      IFEND;
      clp$f_scan_token (clc$slu_any, parse);
      RETURN;
    CASEND;

    IF status.normal THEN
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;

  PROCEND scan_operand;
?? TITLE := 'scan_term_0 (OR and XOR operators)', EJECT ??

  PROCEDURE scan_term_0
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      insert_index: integer,
      node_encountered: boolean,
      operator_name: ost$name;

    clp$f_get_token_index (insert_index);
    node_encountered := FALSE;
    scan_term_1 (expression_kind, evaluate, parse, value, status);
    WHILE status.normal DO
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), operator_name);
        IF NOT ((operator_name = 'OR') OR (operator_name = 'XOR')) THEN
          IF node_encountered THEN
            clp$f_set_tree_marker (clc$or_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
          IFEND;
          RETURN;
        IFEND;
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, operator_name, status);
          RETURN;
        IFEND;
      ELSE
        IF node_encountered THEN
          clp$f_set_tree_marker (clc$or_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
        IFEND;
        RETURN;
      IFEND;
      node_encountered := TRUE;
      clp$f_add_node_value (clc$or_node);
      clp$f_scan_token (clc$slu_non_space, parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', cle$missing_spaces_after, operator_name, status);
        RETURN;
      IFEND;
      IF status.normal THEN
        scan_term_1 (expression_kind, FALSE, parse, value, status);
      IFEND;
    WHILEND;

  PROCEND scan_term_0;
?? TITLE := 'scan_term_1 (AND operator)', EJECT ??

  PROCEDURE scan_term_1
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      insert_index: integer,
      node_encountered: boolean,
      operator_name: ost$name;

    node_encountered := FALSE;
    clp$f_get_token_index (insert_index);
    scan_term_2 (expression_kind, evaluate, parse, value, status);
    WHILE status.normal DO
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), operator_name);
        IF operator_name <> 'AND' THEN
          IF node_encountered THEN
            clp$f_set_tree_marker (clc$and_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
          IFEND;
          RETURN;
        IFEND;
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, operator_name, status);
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, operator_name, status);
          RETURN;
        IFEND;
      ELSE
        IF node_encountered THEN
          clp$f_set_tree_marker (clc$and_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
        IFEND;
        RETURN;
      IFEND;
      node_encountered := TRUE;
      clp$f_add_node_value (clc$and_node);
      clp$f_scan_token (clc$slu_non_space, parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', cle$missing_spaces_after, operator_name, status);
        RETURN;
      IFEND;
      scan_term_2 (expression_kind, evaluate, parse, value, status);
    WHILEND;

  PROCEND scan_term_1;
?? TITLE := 'scan_term_2 (NOT operator)', EJECT ??

  PROCEDURE scan_term_2
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      insert_index: integer,
      operator_name: ost$name;

    IF parse.unit_is_space THEN
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;
    IF parse.unit.kind = clc$lex_name THEN
      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), operator_name);
    ELSE
      operator_name := '';
    IFEND;
    IF operator_name = 'NOT' THEN
      clp$f_get_token_index (insert_index);
      clp$f_add_node_value (clc$not_node);
      status.normal := TRUE;
      clp$f_scan_token (clc$slu_non_space, parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', cle$missing_spaces_after, operator_name, status);
        RETURN;
      IFEND;
      scan_term_3 (expression_kind, evaluate, parse, value, status);
      IF status.normal THEN
        clp$f_set_tree_marker (clc$not_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
      IFEND;
    ELSE
      scan_term_3 (expression_kind, evaluate, parse, value, status);
    IFEND;

  PROCEND scan_term_2;
?? TITLE := 'scan_term_3 (>, >=, < , <=, = and <> operators)', EJECT ??

  PROCEDURE scan_term_3
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      relational_operators: [STATIC, READ, oss$job_paged_literal] set of clt$lexical_unit_kind :=
            [clc$lex_greater_than, clc$lex_greater_equal, clc$lex_less_than, clc$lex_less_equal,
            clc$lex_equal, clc$lex_not_equal],
      insert_index: integer,
      node_encountered: boolean;

    clp$f_get_token_index (insert_index);
    node_encountered := FALSE;
    scan_term_4 (expression_kind, evaluate, parse, value, status);
    WHILE status.normal AND (parse.unit.kind IN relational_operators) DO
      node_encountered := TRUE;
      clp$f_add_node_value (clc$rel_node);
      clp$f_scan_token (clc$slu_non_space, parse);
      scan_term_4 (expression_kind, FALSE, parse, value, status);
    WHILEND;
    IF node_encountered THEN
      clp$f_set_tree_marker (clc$rel_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
    IFEND;

  PROCEND scan_term_3;
?? TITLE := 'scan_term_4 (// operator)', EJECT ??

  PROCEDURE scan_term_4
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      insert_index: integer,
      node_encountered: boolean;

    node_encountered := FALSE;
    clp$f_get_token_index (insert_index);
    IF expression_kind = string_expression THEN
      scan_operand (expression_kind, evaluate, parse, value, status);
    ELSE
      scan_term_5 (expression_kind, evaluate, parse, value, status);
    IFEND;
    WHILE status.normal AND (parse.unit.kind = clc$lex_concatenate) DO
      node_encountered := TRUE;
      clp$f_add_node_value (clc$cat_node);
      clp$f_scan_token (clc$slu_non_space, parse);
      scan_term_5 (expression_kind, TRUE, parse, value, status);
    WHILEND;
    IF node_encountered THEN
      clp$f_set_tree_marker (clc$cat_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
    IFEND;

  PROCEND scan_term_4;
?? TITLE := 'scan_term_5 (+ and - operators)', EJECT ??

  PROCEDURE scan_term_5
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      add_sub_operators: [STATIC, READ, oss$job_paged_literal] set of clt$lexical_unit_kind :=
            [clc$lex_add, clc$lex_subtract],
      unary_operator: boolean,
      save_parse: clt$parse_state,
      operator: clc$lex_add .. clc$lex_subtract,
      operator_representation: clt$operator_representation,
      insert_index: integer,
      node_encountered: boolean;

    node_encountered := FALSE;
    clp$f_get_token_index (insert_index);
    IF parse.unit_is_space THEN
      clp$f_scan_token (clc$slu_non_space, parse);
      insert_index := insert_index + 1;
    IFEND;
    unary_operator := parse.unit.kind IN add_sub_operators;
    IF unary_operator THEN
      status.normal := TRUE;
      value.descriptor := clv$value_descriptors [clc$integer_value];
      value.kind := clc$integer_value;
      value.int.radix := 10;
      value.int.radix_specified := FALSE;
      value.int.value := 0;
    ELSE
      scan_term_6 (expression_kind, evaluate, parse, value, status);
    IFEND;
    WHILE status.normal DO
      IF parse.unit.kind IN add_sub_operators THEN
        node_encountered := TRUE;
        clp$f_add_node_value (clc$add_node);
      ELSE
        IF node_encountered THEN
          clp$f_set_tree_marker (clc$add_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
        IFEND;
        RETURN;
      IFEND;
      clp$f_scan_token (clc$slu_non_space, parse);
      scan_term_6 (expression_kind, FALSE, parse, value, status);
    WHILEND;

  PROCEND scan_term_5;
?? TITLE := 'scan_term_6 (* and / operators)', EJECT ??

  PROCEDURE scan_term_6
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      mult_div_operators: [STATIC, READ, oss$job_paged_literal] set of clt$lexical_unit_kind :=
            [clc$lex_multiply, clc$lex_divide],
      insert_index: integer,
      node_encountered: boolean;

    node_encountered := FALSE;
    clp$f_get_token_index (insert_index);
    scan_term_7 (expression_kind, evaluate, parse, value, status);
    WHILE status.normal AND (parse.unit.kind IN mult_div_operators) DO
      clp$f_add_node_value (clc$mul_node);
      node_encountered := TRUE;
      clp$f_scan_token (clc$slu_non_space, parse);
      scan_term_7 (expression_kind, FALSE, parse, value, status);
    WHILEND;
    IF node_encountered THEN
      clp$f_set_tree_marker (clc$mul_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
    IFEND;

  PROCEND scan_term_6;
?? TITLE := 'scan_term_7 (** operator)', EJECT ??

  PROCEDURE scan_term_7
    (    expression_kind: expression_kinds;
         evaluate: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      insert_index: integer,
      node_encountered: boolean;

    node_encountered := FALSE;
    clp$f_get_token_index (insert_index);
    scan_operand (expression_kind, evaluate, parse, value, status);
    WHILE status.normal AND (parse.unit.kind = clc$lex_exponentiate) DO
      clp$f_add_node_value (clc$exp_node);
      node_encountered := TRUE;
      clp$f_scan_token (clc$slu_non_space, parse);
      scan_operand (expression_kind, FALSE, parse, value, status);
    WHILEND;
    IF node_encountered THEN
      clp$f_set_tree_marker (clc$exp_node, insert_index, parse.unit.kind = clc$lex_end_of_line);
      RETURN;
    IFEND;

  PROCEND scan_term_7;
?? TITLE := 'clp$f_complete_file_or_var_scan', EJECT ??

  PROCEDURE [XDCL] clp$f_complete_file_or_var_scan
    (VAR parse {input, output} : clt$parse_state;
     VAR status: ost$status);

    VAR
      nesting_level: clt$string_size;

    status.normal := TRUE;

    nesting_level := 0;

  /scan/
    WHILE parse.unit.kind <> clc$lex_end_of_line DO
      CASE parse.unit.kind OF
      = clc$lex_colon, clc$lex_dot, clc$lex_concatenate =
        clp$f_scan_token (clc$slu_any, parse);
      = clc$lex_left_parenthesis =
        nesting_level := nesting_level + 1;
      = clc$lex_right_parenthesis =
        IF nesting_level <= 0 THEN
          EXIT /scan/;
        IFEND;
        nesting_level := nesting_level - 1;
      ELSE
        IF nesting_level <= 0 THEN
          EXIT /scan/;
        IFEND;
      CASEND;
      clp$f_scan_token (clc$slu_any, parse);
    WHILEND /scan/;
    IF nesting_level <> 0 THEN
      osp$set_status_abnormal ('CL', 55555, 'Unbalanced parens', status); {||
    IFEND;

  PROCEND clp$f_complete_file_or_var_scan;

MODEND clm$f_scan_expression;
