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

{
{ PURPOSE:
{   This module contains the procedures that evaluate expressions.  The
{   evaluation is guided by a "type description" (derived from a "type
{   specification").  The output is a "data value".
{
{ DESIGN:
{   The expression is parsed 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.
{
{ NOTE:
{   In addition to the routines within this module, there are a number of
{   inline procedures (in their own decks) that evaluate specific types of
{   expressions.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_integer
*copyc clc$min_integer
*copyc clc$reset_dereference_name
*copyc cle$bad_data_value
*copyc cle$bad_keyword_type_spec
*copyc cle$bad_type_description
*copyc cle$ecc_command_processing
*copyc cle$ecc_file_reference
*copyc cle$ecc_lexical
*copyc cle$ecc_parsing
*copyc cle$no_match_for_wild_card_name
*copyc cle$not_supported
*copyc cle$string_too_short
*copyc cle$unknown_variable
*copyc cle$wild_card_not_allowed
*copyc cle$work_area_overflow
*copyc clk$scan_expression
*copyc clt$data_value
*copyc clt$data_kinds
*copyc clt$expression_text
*copyc clt$expression_text_index
*copyc clt$keyword_index
*copyc clt$lexical_unit_kinds
*copyc clt$longreal
*copyc clt$parse_state
*copyc clt$type_description
*copyc clt$type_specification
*copyc clt$work_area
*copyc oss$job_paged_literal
*copyc ost$status
*copyc pme$system_time_exceptions
?? SKIP := 3 ??

{
{ PURPOSE:
{   The following procedure exists solely to provide a "shelter" for the
{   declarations contained in certain decks that are *COPYC'd into this
{   deck.  For example, this module defines an XDCL'd procedure that is
{   referenced by an INLINE procedure.  In order to make the deck containing
{   the INLINE procedure "self-contained" it *COPYCs the deck containing the
{   XREF declaration of the procedure.  Since the INLINE procedure is needed
{   in this module, both the XDCL and XREF declaration will appear in this
{   module.  The following "dummy" procedure is used to hide the XREF
{   declaration of the variable from the rest of the module.
{

  PROCEDURE [INLINE] dummy;

*copyc clp$internal_evaluate_expr

  PROCEND dummy;
?? SKIP := 3 ??
?? POP ??
*copyc bap$process_pt_request
*copyc clp$append_status_parse_state
*copyc clp$append_status_string
*copyc clp$append_status_type_desc
*copyc clp$append_status_value_type
*copyc clp$array_value_compare
*copyc clp$boolean_compare
*copyc clp$build_pattern_for_wild_card
*copyc clp$command_reference_compare
*copyc clp$complete_file_ref_eval
*copyc clp$complete_file_ref_parse
*IF NOT $true(osv$unix)
*copyc clp$construct_path_handle_name
*IFEND
*copyc clp$convert_date_time_to_string
*IF NOT $true(osv$unix)
*copyc clp$convert_file_ref_to_string
*copyc clp$convert_integer_to_real
*copyc clp$convert_real_to_integer
*IFEND
*copyc clp$convert_string_to_date_time
*IF NOT $true(osv$unix)
*copyc clp$convert_string_to_file
*IFEND
*copyc clp$convert_string_to_integer
*copyc clp$convert_type_spec_to_desc
*IF $true(osv$unix)
*copyc clp$conv_unix_file_ref_to_str
*IFEND
*copyc clp$copy_data_value
*copyc clp$count_list_elements
*copyc clp$date_time_compare
*copyc clp$derive_type_desc_from_value
*copyc clp$entry_point_ref_compare
*copyc clp$evaluate_boolean_expression
*copyc clp$evaluate_integer_expression
*copyc clp$evaluate_list_expression
*copyc clp$evaluate_name
*copyc clp$evaluate_name_for_read
*copyc clp$evaluate_numeric_literal
*copyc clp$evaluate_type_conformance
*copyc clp$evaluate_unqual_union_expr
*copyc clp$evaluate_unsigned_decimal
*copyc clp$evaluate_value_conformance
*IF NOT $true(osv$unix)
*copyc clp$file_ref_is_pre_evaluated
*IFEND
*copyc clp$find_command_list
*copyc clp$find_command_source
*IF NOT $true(osv$unix)
*copyc clp$find_scl_options
*IFEND
*copyc clp$first_list_element
*IF NOT $true(osv$unix)
*copyc clp$get_path_name
*IFEND
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$integer_compare
*copyc clp$internal_convert_to_string
*copyc clp$internal_evaluate_params
*copyc clp$internal_gen_type_spec
*copyc clp$isolate_application_value
*copyc clp$list_value_compare
*IF NOT $true(osv$unix)
*copyc clp$longreal_compare
*copyc clp$longreal_compare_eq
*copyc clp$longreal_compare_gt
*copyc clp$longreal_compare_le
*copyc clp$longreal_compare_lt
*copyc clp$longreal_compare_ne
*IFEND
*copyc clp$make_application_value
*copyc clp$make_array_value
*copyc clp$make_boolean_value
*copyc clp$make_clt$boolean_value
*copyc clp$make_clt$number_value
*copyc clp$make_cobol_name_value
*copyc clp$make_command_ref_value
*copyc clp$make_data_name_value
*copyc clp$make_date_time_value
*copyc clp$make_entry_point_ref_value
*IF $true(osv$unix)
*copyc clp$make_file_value
*IFEND
*copyc clp$make_file_value
*copyc clp$make_integer_value
*copyc clp$make_keyword_value
*copyc clp$make_list_value
*copyc clp$make_name_value
*IF $true(osv$unix)
*copyc clp$make_nos_ve_file_value
*IFEND
*copyc clp$make_program_name_value
*copyc clp$make_range_value
*copyc clp$make_record_value
*copyc clp$make_scu_line_id_value
*copyc clp$make_sized_string_value
*copyc clp$make_time_increment_value
*copyc clp$make_time_zone_value
*copyc clp$make_type_spec_value
*copyc clp$make_unspecified_value
*copyc clp$match_string_pattern
*copyc clp$next_list_element
*copyc clp$number_compare
*IF NOT $true(osv$unix)
*copyc clp$parse_file_reference
*IFEND
*copyc clp$perform_numeric_operation
*copyc clp$range_value_compare
*copyc clp$recognize_cobol_name
*copyc clp$record_value_compare
*copyc clp$remove_last_path_element
*copyc clp$rescan_wild_card_lex_unit
*copyc clp$scan_any_lexical_unit
*copyc clp$scan_bal_paren_lexical_unit
*copyc clp$scan_non_space_lexical_unit
*copyc clp$scan_operand
*copyc clp$scan_unnested_sep_lex_unit
*copyc clp$sp_pattern_concat_pattern
*copyc clp$sp_pattern_concat_string
*copyc clp$sp_string_concat_pattern
*copyc clp$sp_string_literal
*copyc clp$status_compare
*copyc clp$string_compare
*copyc clp$time_increment_compare
*copyc clp$trimmed_string_size
*copyc clp$validate_date_time
*copyc clp$validate_type_conformance
*copyc clp$validate_value_conformance
*copyc clv$max_integer_as_real
*copyc clv$min_integer_as_real
*copyc clv$negative_infinity
*copyc clv$positive_infinity
*copyc clv$real_one
*copyc clv$real_zero
*copyc clv$type_kind_names
*copyc clv$user_identification
*copyc clv$value_type_kinds
*IF NOT $true(osv$unix)
*copyc mlp$convert_float_to_intege
*copyc mlp$convert_integer_to_float
*IFEND
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$append_status_real
*IF NOT $true(osv$unix)
*copyc osp$disestablish_cond_handler
*copyc osp$enforce_exception_policies
*copyc osp$file_access_condition
*copyc osp$establish_condition_handler
*IFEND
*copyc osp$get_status_condition_code
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$status_condition_code
*copyc osv$lower_to_upper
*copyc osv$lower_to_upper_26
*IF NOT $true(osv$unix)
*copyc osv$initial_exception_context
*IFEND
*copyc pmp$compute_date_time
*copyc pmp$compute_date_time_increment
*IF NOT $true(osv$unix)
*copyc pmp$continue_to_cause
*IFEND
*copyc pmp$get_compact_date_time

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

{ The following variable is declared outside of clp$check_name_for_boolean so
{ that procedure may be INLINE.

  CONST
    number_of_boolean_value_names = 6,
    max_boolean_name_size = 5;

  VAR
    booleans: [STATIC, READ, oss$job_paged_literal] array [1 .. number_of_boolean_value_names] of record
      name: string (max_boolean_name_size),
      value: clt$boolean,
    recend := [
          {} ['FALSE', [FALSE, clc$true_false_boolean]],
          {} ['NO   ', [FALSE, clc$yes_no_boolean]],
          {} ['OFF  ', [FALSE, clc$on_off_boolean]],
          {} ['ON   ', [TRUE, clc$on_off_boolean]],
          {} ['TRUE ', [TRUE, clc$true_false_boolean]],
          {} ['YES  ', [TRUE, clc$yes_no_boolean]]];

?? SKIP := 3 ??

  PROCEDURE [XDCL, INLINE] clp$check_name_for_boolean
    (    name: ost$name;
     VAR bool: clt$boolean;
     VAR name_is_boolean: boolean);

    VAR
      current_index: 1 .. number_of_boolean_value_names,
      low_index: 1 .. number_of_boolean_value_names + 1,
      temp: integer,
      high_index: 0 .. number_of_boolean_value_names;


    name_is_boolean := FALSE;

    low_index := 1;
    high_index := number_of_boolean_value_names;
    REPEAT
      temp := low_index + high_index;
      current_index := temp DIV 2;
      IF name = booleans [current_index].name THEN

        name_is_boolean := TRUE;
        bool := booleans [current_index].value;
        RETURN;

      ELSEIF name > booleans [current_index].name THEN
        low_index := current_index + 1;
      ELSE
        high_index := current_index - 1;
      IFEND;
    UNTIL low_index > high_index;

  PROCEND clp$check_name_for_boolean;
?? TITLE := 'clp$convert_array_to_list', EJECT ??

  PROCEDURE [XDCL] clp$convert_array_to_list
    (    array_value: ^clt$data_value;
         array_type_description: ^clt$type_description;
         list_type_description: ^clt$type_description;
     VAR work_area {input, output} : ^clt$work_area;
     VAR list_value {input, output} : ^clt$data_value;
     VAR status: ost$status);

    VAR
      check_elements: boolean,
      current_list_node: ^clt$data_value,
      i: clt$array_bound,
      list_size: clt$list_size,
      original_work_area: ^clt$work_area,
      type_conformance: clt$type_conformance;


    status.normal := TRUE;

    check_elements := (list_type_description <> NIL) AND (list_type_description^.
          list_element_type_description <> NIL);
    IF check_elements AND (array_type_description <> NIL) AND
          (array_type_description^.array_element_type_description <> NIL) THEN
      clp$evaluate_type_conformance (array_type_description^.array_element_type_description,
            list_type_description^.list_element_type_description, clc$conforms_to_type, status);
      IF NOT status.normal THEN
        IF status.condition = cle$wrong_kind_of_value THEN
          status.condition := cle$wrong_kind_of_element_type;
        IFEND;
        RETURN;
      IFEND;
      check_elements := FALSE;
    IFEND;

    original_work_area := work_area;

    IF list_value = NIL THEN
      clp$make_list_value (work_area, list_value);
      IF list_value = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, 'clp$convert_array_to_list', status);
        RETURN;
      IFEND;
    IFEND;

    list_size := 0;
    current_list_node := list_value;
    FOR i := LOWERBOUND (array_value^.array_value^) TO UPPERBOUND (array_value^.array_value^) DO
      IF array_value^.array_value^ [i] <> NIL THEN
        IF check_elements THEN
          clp$validate_value_conformance (array_value^.array_value^ [i],
                list_type_description^.list_element_type_description, type_conformance);
          IF type_conformance < clc$conforms_to_type THEN
            osp$set_status_condition (cle$wrong_kind_of_element_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter,
                  list_type_description^.list_element_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, array_value^.array_value^ [i],
                  status);
            osp$append_status_integer (osc$status_parameter_delimiter, i, 10, FALSE, status);
            work_area := original_work_area;
            RETURN;
          IFEND;
        IFEND;

        current_list_node^.element_value := array_value^.array_value^ [i];
        list_size := list_size + 1;

        IF i < UPPERBOUND (array_value^.array_value^) THEN
          clp$make_list_value (work_area, current_list_node^.link);
          IF current_list_node^.link = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, 'clp$convert_array_to_list', status);
            work_area := original_work_area;
            RETURN;
          IFEND;
          current_list_node := current_list_node^.link;
        IFEND;
      ELSE
        osp$set_status_condition (cle$unknown_array_to_list_value, status);
        RETURN;
      IFEND;
    FOREND;

    IF (list_type_description <> NIL) AND ((list_size < list_type_description^.min_list_size) OR
          (list_size > list_type_description^.max_list_size)) THEN
      osp$set_status_condition (cle$too_few_or_many_list_elems, status);
      osp$append_status_integer (osc$status_parameter_delimiter, list_size, 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, list_type_description^.min_list_size, 10,
            FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, list_type_description^.max_list_size, 10,
            FALSE, status);
      work_area := original_work_area;
    IFEND;

  PROCEND clp$convert_array_to_list;
?? TITLE := 'clp$convert_list_to_array', EJECT ??

  PROCEDURE [XDCL] clp$convert_list_to_array
    (    list_value: ^clt$data_value;
         list_type_description: ^clt$type_description;
         array_type_description: ^clt$type_description;
     VAR work_area {input, output} : ^clt$work_area;
     VAR array_value {input, output} : ^clt$data_value;
     VAR status: ost$status);

    VAR
      check_elements: boolean,
      current_list_node: ^clt$data_value,
      i: clt$array_bound,
      list_size: clt$list_size,
      original_work_area: ^clt$work_area,
      type_conformance: clt$type_conformance;


    status.normal := TRUE;

    check_elements := (array_type_description <> NIL) AND
          (array_type_description^.array_element_type_description <> NIL);
    IF check_elements AND (list_type_description <> NIL) AND
          (list_type_description^.list_element_type_description <> NIL) THEN
      clp$evaluate_type_conformance (list_type_description^.list_element_type_description,
            array_type_description^.array_element_type_description, clc$conforms_to_type, status);
      IF NOT status.normal THEN
        IF status.condition = cle$wrong_kind_of_value THEN
          status.condition := cle$wrong_kind_of_element_type;
        IFEND;
        RETURN;
      IFEND;
      check_elements := FALSE;
    IFEND;

    original_work_area := work_area;

    IF check_elements OR (array_value = NIL) THEN
      list_size := 0;
      current_list_node := clp$first_list_element (list_value);
      WHILE current_list_node <> NIL DO
        list_size := list_size + 1;
        IF check_elements THEN
          clp$validate_value_conformance (current_list_node^.element_value,
                array_type_description^.array_element_type_description, type_conformance);
          IF type_conformance < clc$conforms_to_type THEN
            osp$set_status_condition (cle$wrong_kind_of_element_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter,
                  array_type_description^.array_element_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, list_value^.element_value, status);
            osp$append_status_integer (osc$status_parameter_delimiter, list_size, 10, FALSE, status);
            RETURN;
          IFEND;
        IFEND;
        current_list_node := clp$next_list_element (current_list_node);
      WHILEND;

      IF array_value = NIL THEN
        clp$make_array_value (1, list_size, work_area, array_value);
        IF array_value = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, 'clp$convert_list_to_array', status);
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    current_list_node := clp$first_list_element (list_value);
    FOR i := LOWERBOUND (array_value^.array_value^) TO UPPERBOUND (array_value^.array_value^) DO
      array_value^.array_value^ [i] := current_list_node^.element_value;
      current_list_node := clp$next_list_element (current_list_node);
    FOREND;

  PROCEND clp$convert_list_to_array;
?? TITLE := 'clp$evaluate_command_reference', EJECT ??

  PROCEDURE [XDCL] clp$evaluate_command_reference
    (VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
         get_path_handle_name: boolean;
     VAR path_handle_name: fst$path_handle_name;
     VAR command_reference: clt$command_reference;
     VAR utility_command_list_entry: ^clt$command_list_entry;
     VAR parameter_name: clt$parameter_name;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      command_name: clt$name,
      command_source: ost$name,
      command_source_is_utility: boolean,
*IF NOT $true(osv$unix)
      context: ^ost$ecp_exception_context,
*IFEND
      evaluated_file_reference: fst$evaluated_file_reference,
*IF NOT $true(osv$unix)
      ignore_pt_results: bat$process_pt_results,
*IFEND
      initial_path: ^fst$file_reference,
      local_parse: clt$parse_state,
      path_name: fst$path,
      path_name_size: fst$path_size,
*IF NOT $true(osv$unix)
      saved_evaluated_file_reference: fst$evaluated_file_reference,
      work_list: bat$process_pt_work_list;
*ELSE
      saved_evaluated_file_reference: fst$evaluated_file_reference;
*IFEND

?? NEWTITLE := 'find_utility', EJECT ??

    PROCEDURE find_utility
      (    candidate_name: ost$name;
       VAR command_source_is_utility: boolean;
       VAR utility_command_list_entry: ^clt$command_list_entry);

      VAR
        command_list: ^clt$command_list,
        ignore_cmnd_list_found_in_task: boolean;


      clp$find_command_list (command_list, ignore_cmnd_list_found_in_task);
      utility_command_list_entry := command_list^.entries.first_entry;

      WHILE utility_command_list_entry <> NIL DO
        IF (utility_command_list_entry^.kind = clc$sub_commands) AND
              (candidate_name = utility_command_list_entry^.utility_name) THEN

          command_source_is_utility := TRUE;
          RETURN;

        IFEND;
        utility_command_list_entry := utility_command_list_entry^.next_entry;
      WHILEND;

      command_source_is_utility := FALSE;

    PROCEND find_utility;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    parameter_name := osc$null_name;
    command_reference.form := clc$name_only_command_ref;
    utility_command_list_entry := NIL;
    path_handle_name := osc$null_name;

    IF parse.unit.kind = clc$lex_name THEN
      local_parse := parse;
      clp$scan_any_lexical_unit (local_parse);
      IF local_parse.unit.kind = clc$lex_dot THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), command_source);
        clp$scan_any_lexical_unit (local_parse);
        IF local_parse.unit.kind = clc$lex_name THEN
          clp$scan_any_lexical_unit (local_parse);
          IF (local_parse.unit.kind <> clc$lex_dot) AND (local_parse.unit.kind <> clc$lex_concatenate) THEN
            IF (command_source = '$SOURCE') OR (command_source = '$SOURCE_OF_CALLER') THEN
              clp$find_command_source (command_source, block);
              IF block <> NIL THEN
                CASE block^.source.kind OF
                = clc$system_commands =
                  command_source := '$SYSTEM';
                = clc$sub_commands =

{ UTILITY_COMMAND_LIST_ENTRY will be set later in NAME_IS_UTILITY.

                  command_source := block^.source.utility_name;
                ELSE
                  ;
                CASEND;
              ELSE
                osp$set_status_condition (cle$unable_to_find_cmnd_source, status);
                RETURN;
              IFEND;
            IFEND;
            IF command_source = '$SYSTEM' THEN
              command_reference.form := clc$system_command_ref;
              #TRANSLATE (osv$lower_to_upper, local_parse.text^
                    (local_parse.previous_non_space_unit_index, local_parse.previous_non_space_unit.size),
                    command_reference.name);
              parse := local_parse;
              RETURN;
            ELSE
              find_utility (command_source, command_source_is_utility, utility_command_list_entry);

              IF command_source_is_utility THEN
                command_reference.form := clc$utility_command_ref;
                #TRANSLATE (osv$lower_to_upper, local_parse.text^
                      (local_parse.previous_non_space_unit_index, local_parse.previous_non_space_unit.size),
                      command_reference.name);
                command_reference.utility := command_source;
                parse := local_parse;
                RETURN;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    initial_path := NIL;

{ The call to clp$file_ref_is_pre_evaluated (and subsequent call to clp$parse_file_reference) is not
{ necessary since the file ref parsing options are not valid for those requests.

*IF NOT $true(osv$unix)
    clp$complete_file_ref_parse (initial_path, parse, work_area,
          $clt$file_ref_parsing_options [clc$evaluating_command_ref, clc$command_file_ref_allowed],
          clv$user_identification, evaluated_file_reference, command_name, command_reference.form,
          parameter_name, status);
*ELSE
      clp$complete_file_ref_parse (initial_path, parse, work_area, $clt$file_ref_parsing_options
            [clc$unix_path_syntax, clc$evaluating_command_ref, clc$command_file_ref_allowed],
            clv$user_identification, evaluated_file_reference, command_name, command_reference.form,
            parameter_name, status);
*IFEND
    IF NOT status.normal OR (parameter_name <> osc$null_name) THEN
      RETURN;
    IFEND;

    command_reference.name := command_name.value (1, command_name.size);

    IF command_reference.form = clc$module_or_file_command_ref THEN

{ Clp$complete_file_ref_parse will append each path element if no cycle path element was found, so
{ the last path element must be removed.

*IF NOT $true(osv$unix)
      IF evaluated_file_reference.cycle_reference.specification = fsc$cycle_omitted THEN
*IFEND
        clp$remove_last_path_element (evaluated_file_reference, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
*IF NOT $true(osv$unix)
      IFEND;
*IFEND
      saved_evaluated_file_reference := evaluated_file_reference;
*IF NOT $true(osv$unix)
      clp$convert_file_ref_to_string (evaluated_file_reference, FALSE, path_name, path_name_size, status);
*ELSE
        clp$conv_unix_file_ref_to_str (evaluated_file_reference, path_name, path_name_size, status);
*IFEND
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      command_reference.library_or_catalog := path_name (1, path_name_size);
    ELSE {command_reference.form = clc$file_cycle_command_ref}
      saved_evaluated_file_reference := evaluated_file_reference;
      clp$remove_last_path_element (evaluated_file_reference, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
*IF NOT $true(osv$unix)
      command_reference.cycle_number := evaluated_file_reference.cycle_reference.cycle_number;
      evaluated_file_reference.cycle_reference.specification := fsc$cycle_omitted;
      clp$convert_file_ref_to_string (evaluated_file_reference, FALSE, path_name, path_name_size, status);
*ELSE
        clp$conv_unix_file_ref_to_str (evaluated_file_reference, path_name, path_name_size, status);
*IFEND
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      command_reference.catalog := path_name (1, path_name_size);
    IFEND;

*IF NOT $true(osv$unix)
    IF get_path_handle_name THEN
      work_list := $bat$process_pt_work_list [bac$externalize_path_handle, bac$record_path];
      IF (saved_evaluated_file_reference.cycle_reference.specification <> fsc$cycle_omitted) AND
            (saved_evaluated_file_reference.cycle_reference.specification <> fsc$cycle_number) THEN
        work_list := work_list + $bat$process_pt_work_list [bac$resolve_path, bac$resolve_to_catalog];
      IFEND;

      saved_evaluated_file_reference.path_handle_info.path_handle_present := FALSE;
      bap$process_pt_request (work_list, osc$null_name, saved_evaluated_file_reference, ignore_pt_results,
            status);
      IF NOT status.normal THEN
        IF osp$file_access_condition (status) THEN
          PUSH context;
          context^ := osv$initial_exception_context;
          context^.file.selector := osc$ecp_evaluated_file_ref;
          context^.file.evaluated_file_reference := evaluated_file_reference;
          REPEAT
            bap$process_pt_request (work_list, osc$null_name, saved_evaluated_file_reference,
                  ignore_pt_results, status);
            context^.condition_status := status;
            osp$enforce_exception_policies (context^);
            status := context^.condition_status;
          UNTIL status.normal OR (NOT osp$file_access_condition (status)) OR (NOT context^.wait);
        IFEND;
      IFEND;

      IF status.normal THEN
        clp$construct_path_handle_name (saved_evaluated_file_reference.path_handle_info.path_handle,
              path_handle_name);
      IFEND;
    IFEND;
*IFEND

  PROCEND clp$evaluate_command_reference;
?? TITLE := 'clp$evaluate_expression', EJECT ??
*copyc clh$evaluate_expression

  PROCEDURE [XDCL, #GATE] clp$evaluate_expression
    (    expression: clt$expression_text;
         type_specification: ^clt$type_specification;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

    CONST
      clc$evaluate_expression = 'clp$evaluate_expression';

    VAR
      ignore_result_type_description: ^clt$type_description,
      lexical_units: ^clt$lexical_units,
      local_result: ^clt$data_value,
      local_status: ost$status,
      local_work_area: ^^clt$work_area,
      original_local_work_area: ^clt$work_area,
      parse: clt$parse_state,
      type_description: clt$type_description;

    status.normal := TRUE;
    result := NIL;

    local_status.normal := TRUE;
    original_local_work_area := NIL;

  /evaluate/
    BEGIN

      IF work_area = NIL THEN
        osp$set_status_condition (cle$work_area_overflow, local_status);
        EXIT /evaluate/;
      IFEND;

*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^local_work_area), local_work_area, local_status);
*ELSE
      clp$get_work_area (osc$user_ring, local_work_area, local_status);
*IFEND
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;
      original_local_work_area := local_work_area^;

      clp$convert_type_spec_to_desc (type_specification, local_work_area^, type_description, local_status);
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;

      clp$identify_lexical_units (^expression, local_work_area^, lexical_units, local_status);
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;

      clp$initialize_parse_state (^expression, lexical_units, parse);
      clp$scan_non_space_lexical_unit (parse);

      clp$internal_evaluate_expr (parse, ^type_description, local_work_area^, ignore_result_type_description,
            local_result, local_status);
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      IF parse.unit.kind <> clc$lex_end_of_line THEN
        osp$set_status_condition (cle$expecting_end_of_expression, local_status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, local_status);
        EXIT /evaluate/;
      IFEND;

      IF local_result^.kind = clc$unspecified THEN
        osp$set_status_abnormal ('CL', cle$unspecified_value_for_req, clc$evaluate_expression, local_status);
        osp$append_status_parameter (osc$status_parameter_delimiter, expression, local_status);
        EXIT /evaluate/;
      IFEND;

*IF NOT $true(osv$unix)
      IF #SEGMENT (work_area) = #SEGMENT (local_work_area^) THEN
*ELSE
      IF #LOC (work_area^) = #LOC (local_work_area^^) THEN
*IFEND
        result := local_result;
      ELSE
        clp$copy_data_value (local_result, work_area, result, local_status);
        local_work_area^ := original_local_work_area;
      IFEND;

    END /evaluate/;

    IF NOT local_status.normal THEN
      IF local_status.condition = cle$work_area_overflow THEN
        local_status.text.size := 0;
        osp$append_status_parameter (osc$status_parameter_delimiter, clc$evaluate_expression, local_status);
      IFEND;
      status := local_status;

      IF original_local_work_area <> NIL THEN
        local_work_area^ := original_local_work_area;
      IFEND;
    IFEND;

  PROCEND clp$evaluate_expression;
*IF NOT $true(osv$unix)

{ This routine is not called by the system.

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

  PROCEDURE [XDCL, #GATE] clp$evaluate_expression_to_str
    (    expression: clt$expression_text;
     VAR result_string: clt$string_value;
     VAR type_name: clt$type_name;
     VAR status: ost$status);

    VAR
      ignore_result_type_description: ^clt$type_description,
      lexical_units: ^clt$lexical_units,
      original_work_area: ^clt$work_area,
      parse: clt$parse_state,
      representation: ^clt$data_representation,
      representation_text: ^clt$string_value,
      representation_text_size: ^clt$string_size,
      request: clt$convert_to_string_request,
      result: ^clt$data_value,
      string_count: ^clt$data_representation_count,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;
    result_string := '';
    type_name := '';

    original_work_area := NIL;

  /evaluate/
    BEGIN
*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^work_area_ptr), work_area_ptr, status);
*ELSE
      clp$get_work_area (osc$user_ring, work_area_ptr, status);
*IFEND
      IF NOT status.normal THEN
        EXIT /evaluate/;
      IFEND;
      original_work_area := work_area_ptr^;

      clp$identify_lexical_units (^expression, work_area_ptr^, lexical_units, status);
      IF NOT status.normal THEN
        EXIT /evaluate/;
      IFEND;
      clp$initialize_parse_state (^expression, lexical_units, parse);
      clp$scan_non_space_lexical_unit (parse);

      clp$evaluate_unqual_union_expr (work_area_ptr^, parse, ignore_result_type_description, result, status);
      IF NOT status.normal THEN
        EXIT /evaluate/;
      IFEND;

    /get_representation_text/
      BEGIN
        request.initial_indentation := 0;
        request.continuation_indentation := 0;
        request.max_string := clc$max_string_size;
        request.include_advanced_items := TRUE;
        request.include_hidden_items := TRUE;
        request.kind := clc$convert_data_value;
        CASE result^.kind OF
        = clc$application =
          representation_text := result^.application_value;
          EXIT /get_representation_text/;
        = clc$array, clc$deferred, clc$list, clc$range, clc$record, clc$string_pattern,
              clc$type_specification =
          request.representation_option := clc$data_source_representation;
        = clc$boolean, clc$cobol_name, clc$command_reference, clc$data_name, clc$date_time,
*IF NOT $true(osv$unix)
              clc$entry_point_reference, clc$file, clc$integer, clc$keyword, clc$lock, clc$name,
*ELSE
              clc$entry_point_reference, clc$nos_ve_file, clc$integer, clc$keyword, clc$lock, clc$name,
*IFEND
              clc$network_title, clc$program_name, clc$real, clc$scu_line_identifier, clc$statistic_code,
*IF NOT $true(osv$unix)
              clc$status, clc$status_code, clc$time_increment, clc$time_zone, clc$unspecified =
*ELSE
              clc$status, clc$status_code, clc$time_increment, clc$time_zone, clc$unspecified, clc$unix_file =
*IFEND
          request.representation_option := clc$data_elem_representation;
        = clc$string =
          representation_text := result^.string_value;
          EXIT /get_representation_text/;
        ELSE
          osp$set_status_condition (cle$bad_data_value, status);
          EXIT /evaluate/;
        CASEND;
        request.value := result;

        clp$internal_convert_to_string (request, work_area_ptr^, representation, status);
        IF NOT status.normal THEN
          EXIT /evaluate/;
        IFEND;

        NEXT string_count IN representation;
        IF string_count^ <> 1 THEN
          osp$set_status_condition (cle$string_too_short, status);
          EXIT /evaluate/;
        IFEND;
        NEXT representation_text_size IN representation;
        NEXT representation_text: [representation_text_size^] IN representation;
      END /get_representation_text/;

      type_name := clv$type_kind_names [clv$value_type_kinds [result^.kind]];

      result_string := representation_text^;

      IF STRLENGTH (representation_text^) > STRLENGTH (result_string) THEN
        osp$set_status_condition (cle$string_too_short, status);
      IFEND;
    END /evaluate/;

    IF original_work_area <> NIL THEN
      work_area_ptr^ := original_work_area;
    IFEND;

  PROCEND clp$evaluate_expression_to_str;
*IFEND
?? TITLE := 'clp$internal_evaluate_expr', EJECT ??
*copyc clh$internal_evaluate_expr

  PROCEDURE [XDCL] clp$internal_evaluate_expr
    (VAR parse {input, output} : clt$parse_state;
         type_description: ^clt$type_description;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_type_description: ^clt$type_description;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

    CONST
      clc$max_operator_size = 3,
      clc$not_operator_representation = 'NOT',
      clc$not_operator_size = 3,
      clc$or_operator_size = 2;

    TYPE
      clt$arithmetic_operator = clc$lex_exponentiate .. clc$lex_subtract,
      clt$logical_operator = (clc$not_operator, clc$and_operator, clc$or_operator, clc$xor_operator),
      clt$operator = record
        representation: clt$operator_representation,
        case kind: clt$operator_kind of
        = clc$not_an_operator =
          ,
        = clc$arithmetic_operator =
          arithmetic_kind: clc$lex_exponentiate .. clc$lex_subtract,
        = clc$logical_operator =
          logical_kind: clt$logical_operator,
        = clc$relational_operator =
          relational_kind: clt$relational_operator,
        = clc$string_operator =
          ,
        casend,
      recend,
      clt$operator_kind = (clc$not_an_operator, clc$arithmetic_operator, clc$logical_operator,
            clc$relational_operator, clc$string_operator),
      clt$operator_kinds = set of clt$operator_kind,
      clt$operator_representation = string (clc$max_operator_size),
      clt$relational_operator = clc$lex_greater_than .. clc$lex_not_equal,
      clt$relational_operators = set of clt$relational_operator;

    TYPE
      clt$numeric_operand_info = record
        case initialized: boolean of
        = FALSE =
          ,
        = TRUE =
          sign: -1 .. 1,
          min_real_value: longreal,
          max_real_value: longreal,
          min_integer_value: integer,
          max_integer_value: integer,
          radix: record
            default: 2 .. 16,
            case established: boolean of
            = FALSE =
              ,
            = TRUE =
              value: 2 .. 16,
              specified: boolean,
            casend,
          recend,
        casend,
      recend;

    TYPE
      clt$list_expansion = (clc$no_expansion, clc$defer_expansion, clc$normal_expansion);

    VAR
      expression_type_name: ^clt$type_name_reference,
      got_present_date_time: boolean,
      ignore_sub_list_tail: ^clt$data_value,
      numeric_info: clt$numeric_operand_info,
      operator: clt$operator,
      present_date_time: clt$date_time;

{ The following variables are for use by the dereference_name routine (within
{ evaluate_expression) in order to optimize repeated evaluations of the same
{ variable or function which can occur in evaluating an expression of type
{ union, etc.

    VAR
      last_deref_result_type_desc: ^clt$type_description,
      last_dereference_result: ^clt$data_value,
      last_dereference_index: clt$string_index,
      last_dereference_name: clt$variable_name,
      last_dereference_parse: clt$parse_state;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'dereference_name_reset_handler', EJECT ??

{
{ PURPOSE:
{   This procedure handles condition clc$reset_dereference_name which is
{   "cause"d by clp$get_expected_type.  The idea is to ensure that if a
{   function cares about the type under which it is being evaluated, that
{   it will be recalled to do the evaluation again for a different type.
{   This situation could arise as a result of a clc$union_type.
{

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


      IF (condition.selector = pmc$user_defined_condition) AND
            (condition.user_condition_name = clc$reset_dereference_name) THEN
        last_dereference_name := '';
        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND dereference_name_reset_handler;
*IFEND
?? TITLE := 'evaluate_expression', EJECT ??

    PROCEDURE evaluate_expression
      (VAR parse {input, output} : clt$parse_state;
           type_description: ^clt$type_description;
           evaluating_sub_expression: boolean;
           list_expansion: clt$list_expansion;
       VAR numeric_info {input, output} : clt$numeric_operand_info;
       VAR result: ^clt$data_value;
       VAR result_sub_list_tail: ^clt$data_value;
       VAR status: ost$status);

      VAR
        unqual_union_type_description: [STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
              [NIL, NIL, FALSE, FALSE, -$clt$type_kinds [], clc$union_type, NIL, ^unqual_union_information],
*ELSE
              [NIL, NIL, FALSE, FALSE, -$clt$type_kinds_v2 [], clc$union_type, NIL,
              ^unqual_union_information],
*IFEND
        unqual_union_information: [STATIC, READ, oss$job_paged_literal] clt$union_type_information :=
              [FALSE, clc$min_integer, clc$max_integer, 10,
*IF NOT $true(osv$unix)
              [{-$INFINITY} 3, [[0d000(16), 0], [0d000(16), 0]]],
              [{$INFINITY} 3, [[5000(16), 0], [5000(16), 0]]]];
*ELSE
*copy cli$longreal_negative_infinity
              ,
*copy cli$longreal_positive_infinity
              ];
*IFEND

      VAR
        access_variable_requests: clt$access_variable_requests,
        current_type_description: ^clt$type_description,
        defer_expansion: boolean,
        last_qualifier_is_field: boolean,
        operand_is_string_literal: boolean,
        operand_type_description: ^clt$type_description,
        operator_encountered: boolean,
        parse_saved_at_equal_operator: clt$parse_state,
        recognize_wild_cards: boolean;

?? NEWTITLE := 'check_for_variable_or_function', EJECT ??

      PROCEDURE check_for_variable_or_function
        (    element_type_description: ^clt$type_description;
         VAR result_conforms_to_element_type: boolean;
         VAR result_conforms_to_type: boolean;
         VAR type_description: ^clt$type_description;
         VAR result: ^clt$data_value;
         VAR result_sub_list_tail: ^clt$data_value);

        VAR
          initial_path: ^fst$file_reference,
          local_status: ost$status,
          name: ost$name,
          type_conformance: clt$type_conformance;


        type_description := NIL;

        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        clp$scan_any_lexical_unit (parse);

        dereference_name (name, result);
        IF (NOT status.normal) OR (result = NIL) THEN
          status.normal := TRUE;
          result := NIL;
          RETURN;
        IFEND;

*IF NOT $true(osv$unix)
*IF NOT $true(osv$unix)
        IF ((result^.kind = clc$file) OR (result^.kind = clc$name)) AND
              (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_concatenate]) THEN
          evaluate_file (result, result_sub_list_tail);
*ELSE
        IF (result^.kind IN $clt$data_kinds [clc$nos_ve_file, clc$unix_file, clc$name]) AND
              (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_divide, clc$lex_concatenate])
              THEN
          evaluate_file (clc$file = clc$unix_file, result, result_sub_list_tail);
*IFEND
          IF NOT status.normal THEN
            status.normal := TRUE;
            result := NIL;
            RETURN;
          IFEND;
*IF NOT $true(osv$unix)
        ELSEIF result^.kind = clc$file THEN
*ELSE
        ELSEIF result^.kind = clc$nos_ve_file THEN
*IFEND
          IF current_type_description^.derived_from_value_kind_spec THEN
            initial_path := result^.file_value;
*IF NOT $true(osv$unix)
            clp$complete_file_ref_eval (recognize_wild_cards, defer_expansion, TRUE,
*ELSE
            clp$complete_file_ref_eval (FALSE, recognize_wild_cards, defer_expansion, TRUE,
*IFEND
                  initial_path, parse, work_area, result, result_sub_list_tail, status);
            IF NOT status.normal THEN
              status.normal := TRUE;
              result := NIL;
              RETURN;
            IFEND;
          IFEND;
          recognize_binary_operator;
        ELSE
          recognize_binary_operator;
          IF (result^.kind = clc$unspecified) AND (operand_type_description = NIL) THEN
            result_conforms_to_type := TRUE;
            RETURN;
          IFEND;
        IFEND;

        IF operand_type_description <> NIL THEN
          type_description := operand_type_description;
          clp$validate_type_conformance (operand_type_description, current_type_description,
                type_conformance);
          result_conforms_to_type := type_conformance >= clc$conforms_to_type;
          IF result_conforms_to_type THEN
            RETURN;
          IFEND;
        IFEND;

        IF result^.kind <> clc$unspecified THEN
          clp$validate_value_conformance (result, current_type_description, type_conformance);
          result_conforms_to_type := type_conformance >= clc$conforms_to_type;
          IF result_conforms_to_type THEN
            RETURN;
          IFEND;
        IFEND;

        IF (element_type_description = NIL) OR (element_type_description^.kind = clc$union_type)
              OR (operator.kind <> clc$not_an_operator) THEN
          result_conforms_to_type := FALSE;
          RETURN;
        IFEND;

        IF operand_type_description <> NIL THEN
          clp$validate_type_conformance (operand_type_description, element_type_description,
                type_conformance);
          result_conforms_to_element_type := type_conformance >= clc$conforms_to_type;
          IF result_conforms_to_element_type THEN
            RETURN;
          IFEND;
        IFEND;

        IF result^.kind = clc$unspecified THEN
          result_conforms_to_element_type := FALSE;
        ELSE
          clp$validate_value_conformance (result, element_type_description, type_conformance);
          result_conforms_to_element_type := type_conformance >= clc$conforms_to_type;
        IFEND;
*IFEND

      PROCEND check_for_variable_or_function;
?? TITLE := 'convert_fs_file_ref_to_cl_file', EJECT ??

      PROCEDURE convert_fs_file_ref_to_cl_file
        (VAR value: ^clt$data_value);

        VAR
          current_list_node: ^clt$data_value,
          file: clt$file;


        CASE value^.kind OF

        = clc$list =
          current_list_node := clp$first_list_element (value);
          WHILE current_list_node <> NIL DO
            convert_fs_file_ref_to_cl_file (current_list_node^.element_value);
            current_list_node := clp$next_list_element (current_list_node);
          WHILEND;

        = clc$range =
          IF value^.low_value = value^.high_value THEN
            convert_fs_file_ref_to_cl_file (value^.low_value);
            value^.high_value := value^.low_value;
          ELSE
            convert_fs_file_ref_to_cl_file (value^.low_value);
            convert_fs_file_ref_to_cl_file (value^.high_value);
          IFEND;

*IF NOT $true(osv$unix)
        = clc$file =
          clp$convert_string_to_file (value^.file_value^, file, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;
          clp$make_file_value (file.local_file_name, work_area, value);
*ELSE
        = clc$nos_ve_file =
          clp$make_nos_ve_file_value (value^.file_value^, work_area, value);
*IFEND
          IF value = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

        ELSE
          ;

        CASEND;

      PROCEND convert_fs_file_ref_to_cl_file;
?? TITLE := 'convert_string_to_stat_code', EJECT ??

{
{ PURPOSE:
{   Convert a string in one of the following forms to a status or statistic
{   code:
{                   XXnnn
{                   XX_nnn
{                   XX nnn
{   where XX is the code's 2 character product identifier (e.g. CL for
{   "command language") and nnn is the code's numeric part (an unsigned
{   decimal integer in the range 0..0ffffff(16)).
{
{ NOTE:
{   1. If the space_separator_required parameter is given as TRUE, the string
{      must be in the last of the above forms.
{   2. This procedure can be used for status and statistic codes because the
{      structure and size of the two are identical.
{

      PROCEDURE convert_string_to_stat_code
        (    str: clt$string_value;
             space_separator_required: boolean;
         VAR status_code: ost$status_condition_code;
         VAR converted: boolean);

        VAR
          conversion_status: ost$status,
          identifier: ost$status_identifier,
          index: clt$string_index,
          int: clt$integer,
          size: clt$string_size;


        converted := FALSE;

        size := clp$trimmed_string_size (str);
        IF (size < 3) OR (str (1) = ' ') OR (str (2) = ' ') OR (space_separator_required AND (str (3) <> ' '))
              THEN
          RETURN;
        IFEND;
        index := 3 + $INTEGER ((str (3) = ' ') OR (str (3) = '_'));
        IF index > size THEN
          RETURN;
        IFEND;
        size := size - index + 1;

        clp$convert_string_to_integer (str (index, size), int, conversion_status);
        IF (NOT conversion_status.normal) OR (int.value < 0) OR
              (int.value > osc$max_status_condition_number) THEN
          RETURN;
        IFEND;

        #TRANSLATE (osv$lower_to_upper, str (1, 2), identifier);

        status_code := osp$status_condition_code (identifier, int.value);
        converted := TRUE;

      PROCEND convert_string_to_stat_code;
?? TITLE := 'dereference_name', EJECT ??

      PROCEDURE [INLINE] dereference_name
        (    name: ost$name;
         VAR result: ^clt$data_value);

        VAR
          found: boolean,
          index_limit: clt$string_index,
          variable_information: clt$variable_information,
          variable_name: clt$variable_name,
          variable_value: ^clt$data_value;


        status.normal := TRUE;

        IF (name = last_dereference_name) AND (parse.text = last_dereference_parse.text) AND
              (parse.unit_index = last_dereference_index) AND (last_dereference_parse.unit_index <=
              parse.index_limit) THEN
          result := last_dereference_result;
          operand_type_description := last_deref_result_type_desc;
          index_limit := parse.index_limit;
          parse := last_dereference_parse;
          parse.index_limit := index_limit;

        ELSE
          last_dereference_name := name;
          last_dereference_index := parse.unit_index;

          result := NIL;
          operand_type_description := NIL;
          clp$evaluate_name_for_read (name, current_type_description, access_variable_requests, parse,
                work_area, variable_name, variable_information, variable_value, found,
                last_qualifier_is_field, status);
          IF found THEN
            operand_type_description := variable_information.type_description;
          IFEND;
          IF NOT status.normal THEN
            last_dereference_name := '';
          ELSEIF found THEN
            result := variable_value;
            IF result = NIL THEN
              osp$set_status_abnormal ('CL', cle$variable_never_given_value, variable_name, status);
              last_dereference_name := '';
            IFEND;
          IFEND;

          last_dereference_parse := parse;
          last_deref_result_type_desc := operand_type_description;
          last_dereference_result := result;
        IFEND;

      PROCEND dereference_name;
?? TITLE := 'determine_structure_status', EJECT ??

      PROCEDURE [INLINE] determine_structure_status
        (    result: ^clt$data_value;
             structure_kind: clt$data_kind;
             type_description: ^clt$type_description;
             current_type_description: ^clt$type_description;
         VAR status: {input output} ost$status);

        VAR
          local_status: ost$status;

        IF (status.condition <> cle$unknown_keyword) AND (result <> NIL) AND
              (result^.kind = structure_kind) THEN
          IF type_description <> NIL THEN
            clp$evaluate_type_conformance (type_description, current_type_description, clc$conforms_to_type,
                  local_status);
            IF NOT local_status.normal THEN
              status := local_status;
            IFEND;
          ELSE
            clp$evaluate_value_conformance (result, current_type_description, clc$conforms_to_type, status);
          IFEND;
        IFEND;

      PROCEND determine_structure_status;
?? TITLE := 'evaluate_application_value', EJECT ??

      PROCEDURE evaluate_application_value
        (VAR result: ^clt$data_value);

        VAR
          end_index: clt$string_index,
          ignore_conforms_to_element_type: boolean,
          ignore_sub_list_tail: ^clt$data_value,
          result_conforms_to_type: boolean,
          start_index: clt$string_index,
          type_description: ^clt$type_description;


        IF parse.unit.kind = clc$lex_space THEN
          clp$scan_any_lexical_unit (parse);
        IFEND;

        start_index := parse.unit_index;
        clp$isolate_application_value (current_type_description^.balance_brackets, parse.text^, start_index,
              end_index);
        IF end_index > parse.index_limit THEN
          parse.index_limit := end_index;
        IFEND;

        result_conforms_to_type := FALSE;
        operand_type_description := NIL;
        IF parse.unit.kind = clc$lex_name THEN
          check_for_variable_or_function (NIL, ignore_conforms_to_element_type, result_conforms_to_type,
                type_description, result, ignore_sub_list_tail);
          IF (result <> NIL) AND ((result_conforms_to_type AND (operator.kind = clc$not_an_operator) AND
                (parse.unit_index >= end_index)) OR ((result^.kind = clc$unspecified) AND
                (type_description <> NIL) AND (type_description^.kind = clc$application_type))) THEN
            RETURN;
          IFEND;
          status.normal := TRUE;
        IFEND;

        clp$make_application_value (parse.text^ (start_index, end_index - start_index), work_area, result);
        IF result = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;
        IFEND;

        WHILE (parse.unit_index < end_index) AND (parse.unit_index < parse.index_limit) DO
          clp$scan_any_lexical_unit (parse);
        WHILEND;

        recognize_binary_operator;

      PROCEND evaluate_application_value;
?? TITLE := 'evaluate_array', EJECT ??

      PROCEDURE evaluate_array
        (VAR result: ^clt$data_value);

        VAR
          element_type_description: ^clt$type_description,
          ignore_conforms_to_element_type: boolean,
          ignore_sub_list_tail: ^clt$data_value,
          ignore_type_description: ^clt$type_description,
          list_size: clt$list_size,
          list_value: ^clt$data_value,
          local_parse: clt$parse_state,
          lower: clt$array_bound,
          name: ost$name,
          result_conforms_to_type: boolean,
          upper: clt$array_bound;


        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        local_parse := parse;

        result_conforms_to_type := FALSE;
        operand_type_description := NIL;
        IF parse.unit.kind = clc$lex_name THEN
          check_for_variable_or_function (NIL, ignore_conforms_to_element_type, result_conforms_to_type,
                ignore_type_description, result, ignore_sub_list_tail);
          IF result = NIL THEN
            parse := local_parse;
          ELSEIF result_conforms_to_type THEN
            RETURN;
          ELSE
            IF result^.kind = clc$array THEN
              clp$evaluate_value_conformance (result, current_type_description, clc$conforms_to_type, status);
            ELSE
              osp$set_status_condition (cle$wrong_kind_of_value, status);
              clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
              clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            IFEND;
            EXIT evaluate_expression;
          IFEND;
        IFEND;

        IF parse.unit.kind <> clc$lex_left_parenthesis THEN
          local_parse := parse;
          IF parse.unit.kind = clc$lex_name THEN
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
            clp$scan_any_lexical_unit (parse);
            dereference_name (name, result);
          IFEND;
          IF status.normal THEN
            parse := local_parse;
            osp$set_status_condition (cle$wrong_kind_of_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          IFEND;
          EXIT evaluate_expression;
        IFEND;

        clp$make_list_value (work_area, list_value);
        IF list_value = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;
        IFEND;
        list_size := 0;
        clp$scan_non_space_lexical_unit (parse);
        IF current_type_description^.array_element_type_description <> NIL THEN
          element_type_description := current_type_description^.array_element_type_description;
        ELSE
          element_type_description := ^unqual_union_type_description;
        IFEND;
        evaluate_parenthesized_list (element_type_description, NIL, NIL, clc$array, clc$no_expansion, NIL,
              list_size, list_value);
        IF NOT current_type_description^.array_bounds_defined THEN
          IF list_size < 1 THEN
            osp$set_status_condition (cle$unexpected_empty_array, status);
            RETURN;
          IFEND;
          lower := 1;
          upper := list_size;
        ELSE
          lower := current_type_description^.bounds.lower;
          upper := current_type_description^.bounds.upper;
          IF list_size <> (upper - lower + 1) THEN
            osp$set_status_condition (cle$too_few_or_many_array_elems, status);
            osp$append_status_integer (osc$status_parameter_delimiter, list_size, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, lower, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, upper, 10, FALSE, status);
            RETURN;
          IFEND;
        IFEND;

        clp$make_array_value (lower, upper, work_area, result);
        IF result = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;
        IFEND;

        clp$convert_list_to_array (list_value, NIL, NIL, work_area, result, status);

      PROCEND evaluate_array;
?? TITLE := 'evaluate_boolean', EJECT ??

      PROCEDURE evaluate_boolean
        (    check_result_value: boolean;
         VAR result {input, output} : ^clt$data_value);

?? NEWTITLE := 'handle_and', EJECT ??

        PROCEDURE handle_and
          (VAR result {input, output} : ^clt$data_value);

          VAR
            current_operator_representation: clt$operator_representation,
            right_operand: ^clt$data_value;


          CASE result^.kind OF
          = clc$boolean =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
            EXIT evaluate_expression;
          ELSE
            osp$set_status_condition (cle$and_operand_not_boolean, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

          WHILE (operator.kind = clc$logical_operator) AND (operator.logical_kind = clc$and_operator) DO
            current_operator_representation := operator.representation;

            IF NOT result^.boolean_value.value THEN

{ Skip right operand of AND operator since left operand is FALSE.

              REPEAT
                scan_partial_expression;
              UNTIL (operator.kind = clc$not_an_operator) OR ((operator.kind = clc$logical_operator) AND
                    (operator.logical_kind <> clc$and_operator));
              RETURN;
            IFEND;

            evaluate_boolean_operand (right_operand);

            IF operator.kind = clc$relational_operator THEN
              handle_comparison (right_operand);
            IFEND;

            CASE right_operand^.kind OF
            = clc$boolean =
              ;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, current_operator_representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              osp$set_status_condition (cle$and_operand_not_boolean, status);
              clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
              EXIT evaluate_expression;
            CASEND;

            clp$make_boolean_value (right_operand^.boolean_value.value, result^.boolean_value.kind, work_area,
                  result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

          WHILEND;

        PROCEND handle_and;
?? TITLE := 'handle_or_and_xor', EJECT ??

        PROCEDURE handle_or_and_xor
          (VAR result {input, output} : ^clt$data_value);

          VAR
            current_operator: clt$operator,
            right_operand: ^clt$data_value;


          CASE result^.kind OF
          = clc$boolean =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
            EXIT evaluate_expression;
          ELSE
            IF operator.logical_kind = clc$or_operator THEN
              osp$set_status_condition (cle$or_operand_not_boolean, status);
            ELSE
              osp$set_status_condition (cle$xor_operand_not_boolean, status);
            IFEND;
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

          WHILE (operator.kind = clc$logical_operator) AND ((operator.logical_kind = clc$or_operator) OR
                (operator.logical_kind = clc$xor_operator)) DO

            IF (operator.logical_kind = clc$or_operator) AND result^.boolean_value.value THEN

{ Skip right operand of OR operator since left operand is TRUE.

              REPEAT
                scan_partial_expression;
                IF operator.kind = clc$not_an_operator THEN
                  RETURN;
                IFEND;
              UNTIL (operator.kind = clc$logical_operator) AND (operator.logical_kind = clc$xor_operator);
            IFEND;

            current_operator := operator;

            evaluate_boolean_operand (right_operand);

            IF operator.kind = clc$relational_operator THEN
              handle_comparison (right_operand);
            IFEND;

            IF (operator.kind = clc$logical_operator) AND (operator.logical_kind = clc$and_operator) THEN
              handle_and (right_operand);
            IFEND;

            CASE right_operand^.kind OF
            = clc$boolean =
              ;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, current_operator.representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              IF current_operator.logical_kind = clc$or_operator THEN
                osp$set_status_condition (cle$or_operand_not_boolean, status);
              ELSE
                osp$set_status_condition (cle$xor_operand_not_boolean, status);
              IFEND;
              clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
              EXIT evaluate_expression;
            CASEND;

            clp$make_boolean_value (result^.boolean_value.value, result^.boolean_value.kind, work_area,
                  result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

            IF current_operator.logical_kind = clc$or_operator THEN
              result^.boolean_value.value := right_operand^.boolean_value.value;
            ELSE
              result^.boolean_value.value := result^.boolean_value.value XOR
                    right_operand^.boolean_value.value;
            IFEND;

          WHILEND;

        PROCEND handle_or_and_xor;
?? TITLE := 'scan_partial_expression', EJECT ??

        PROCEDURE [INLINE] scan_partial_expression;


          REPEAT
            WHILE recognize_not_operator () DO
              clp$scan_non_space_lexical_unit (parse);
            WHILEND;
            clp$scan_operand (clc$separator, parse);
            recognize_binary_operator;
          UNTIL operator.kind IN $clt$operator_kinds [clc$not_an_operator, clc$logical_operator];

        PROCEND scan_partial_expression;
?? OLDTITLE, EJECT ??

        evaluate_boolean_operand (result);

        IF operator.kind = clc$relational_operator THEN
          handle_comparison (result);
        IFEND;

        IF (operator.kind = clc$logical_operator) AND (operator.logical_kind = clc$and_operator) THEN
          handle_and (result);
        IFEND;

        IF operator.kind = clc$logical_operator THEN
          handle_or_and_xor (result);
        IFEND;

        IF check_result_value AND (NOT evaluating_sub_expression) AND
              (NOT (result^.kind IN $clt$data_kinds [clc$boolean, clc$unspecified])) THEN
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
        IFEND;

      PROCEND evaluate_boolean;
?? TITLE := 'evaluate_boolean_operand', EJECT ??

      PROCEDURE [INLINE] evaluate_boolean_operand
        (VAR result: ^clt$data_value);


        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF

        = clc$lex_add, clc$lex_subtract =
          result := NIL;
          evaluate_number (FALSE, result);

        ELSE
          evaluate_operand (result);

          CASE operator.kind OF
          = clc$arithmetic_operator =
            IF (current_type_description^.kind = clc$boolean_type) AND
                  (result^.kind = clc$date_time) THEN
              clp$validate_date_time (result^.date_time_value, ' ', status);
              IF status.normal THEN
*IF NOT $true(osv$unix)
                current_type_description^.kinds := $clt$type_kinds [clc$date_time_type];
*ELSE
                current_type_description^.kinds := $clt$type_kinds_v2 [clc$date_time_type];
*IFEND
                current_type_description^.kind := clc$date_time_type;
                current_type_description^.date_and_or_time := $clt$date_and_or_time [clc$date, clc$time];
                current_type_description^.tenses := $clt$date_time_tenses [clc$past, clc$present, clc$future];
                evaluate_date_time (result);
              ELSE
                EXIT evaluate_expression;
              IFEND;
            ELSE
              evaluate_number (FALSE, result);
            IFEND;
          = clc$string_operator =
            evaluate_string_or_pattern (FALSE, result);
          ELSE
            ;
          CASEND;
        CASEND;

      PROCEND evaluate_boolean_operand;
?? TITLE := 'evaluate_cobol_name', EJECT ??

      PROCEDURE evaluate_cobol_name
        (VAR result: ^clt$data_value);

        VAR
          cobol_name: clt$cobol_name,
          cobol_name_size: ost$name_size,
          hyphen_encountered: boolean,
          is_cobol_name: boolean,
          is_only_cobol_name: boolean,
          saved_parse: clt$parse_state;


        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        saved_parse := parse;
        hyphen_encountered := FALSE;

        WHILE (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_name, clc$lex_unsigned_decimal,
              clc$lex_alpha_number, clc$lex_subtract]) AND (parse.unit_index < parse.index_limit) DO
          IF parse.unit.kind = clc$lex_subtract THEN
            hyphen_encountered := TRUE;
          IFEND;
          clp$scan_any_lexical_unit (parse);
        WHILEND;

        IF parse.unit_index = saved_parse.unit_index THEN
          osp$set_status_condition (cle$expecting_cobol_name_expr, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        IFEND;

        clp$recognize_cobol_name (parse.text^ (saved_parse.unit_index,
              parse.unit_index - saved_parse.unit_index), cobol_name_size, is_only_cobol_name, is_cobol_name);
        is_cobol_name := is_cobol_name AND (cobol_name_size = (parse.unit_index - saved_parse.unit_index));
        IF is_cobol_name AND is_only_cobol_name AND (cobol_name_size =
              (parse.unit_index - saved_parse.unit_index)) THEN
          clp$make_cobol_name_value (parse.text^ (saved_parse.unit_index, cobol_name_size), work_area,
                result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
          recognize_binary_operator;
          RETURN;
        IFEND;

        IF (saved_parse.unit.kind <> clc$lex_name) OR hyphen_encountered THEN
          osp$set_status_abnormal ('CL', cle$not_a_cobol_name, parse.
                text^ (saved_parse.unit_index, parse.unit_index - saved_parse.unit_index), status);
          EXIT evaluate_expression;
        IFEND;

        parse := saved_parse;
        evaluate_operand (result);

        IF result^.kind = clc$name THEN
          clp$recognize_cobol_name (result^.name_value, cobol_name_size, is_only_cobol_name, is_cobol_name);
          IF is_cobol_name AND (result^.name_value (cobol_name_size + 1, * ) = '') THEN
            clp$make_cobol_name_value (result^.name_value (1, cobol_name_size), work_area, result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            RETURN;
          IFEND;
        IFEND;

        CASE result^.kind OF
        = clc$cobol_name =
          ;
        = clc$unspecified =
          ;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_cobol_name;
?? TITLE := 'evaluate_command_reference', EJECT ??

      PROCEDURE evaluate_command_reference
        (VAR result: ^clt$data_value);

        VAR
          access_variable_requests: clt$access_variable_requests,
          command_reference: clt$command_reference,
          command_reference_name: clt$command_name,
          escaped: boolean,
          found: boolean,
          ignore_path_handle_name: fst$path_handle_name,
          ignore_util_command_list_entry: ^clt$command_list_entry,
          parameter_name: clt$parameter_name,
          saved_parse: clt$parse_state,
          value: ^clt$data_value;


      /evaluate_command_reference_blk/
        BEGIN
          escaped := parse.unit.kind = clc$lex_divide;
          parameter_name := osc$null_name;

          IF escaped THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          saved_parse := parse;

        /evaluate_command_ref/
          BEGIN
            CASE parse.unit.kind OF
            = clc$lex_colon, clc$lex_dot =
              ;
            = clc$lex_long_name =
              osp$set_status_abnormal ('CL', cle$name_too_long, parse.
                    text^ (parse.unit_index, parse.unit.size), status);
              EXIT evaluate_expression;
            = clc$lex_name =
              clp$scan_any_lexical_unit (parse);
              IF (parse.unit.kind <> clc$lex_dot) AND (parse.unit.kind <> clc$lex_concatenate) AND
                    (parse.unit.kind <> clc$lex_left_parenthesis) THEN
                #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.previous_non_space_unit_index,
                      parse.previous_non_space_unit.size), command_reference_name);
                access_variable_requests := $clt$access_variable_requests [];
                clp$evaluate_name (command_reference_name, access_variable_requests, parse, work_area, value,
                      found, status);
                IF NOT status.normal THEN
                  EXIT evaluate_expression;
                IFEND;
                IF found THEN
                  IF value <> NIL THEN
                    IF (value^.kind = clc$command_reference) OR (value^.kind = clc$unspecified) THEN
                      result := value;
                      EXIT /evaluate_command_reference_blk/;
                    IFEND;
                  IFEND;
                IFEND;
                command_reference.name := command_reference_name;
                IF escaped THEN
                  command_reference.form := clc$skip_1st_entry_command_ref;
                ELSE
                  command_reference.form := clc$name_only_command_ref;
                IFEND;
                EXIT /evaluate_command_ref/;
              IFEND;
            ELSE
              osp$set_status_abnormal ('CL', cle$expecting_command_reference, parse.
                    text^ (parse.unit_index, parse.unit.size), status);
              EXIT evaluate_expression;
            CASEND;

            IF escaped THEN
              osp$set_status_abnormal ('CL', cle$file_dot_cmnd_not_allowed, parse.
                    text^ (parse.unit_index, parse.unit.size), status);
              EXIT evaluate_expression;
            IFEND;

            parse := saved_parse;
            clp$evaluate_command_reference (parse, work_area, FALSE, ignore_path_handle_name,
                  command_reference, ignore_util_command_list_entry, parameter_name, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;
          END /evaluate_command_ref/;

          IF parameter_name <> osc$null_name THEN
            clp$make_unspecified_value (work_area, result);
          ELSE
            clp$make_command_ref_value (^command_reference, work_area, result);
          IFEND;
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        END /evaluate_command_reference_blk/;
        recognize_binary_operator;

      PROCEND evaluate_command_reference;
?? TITLE := 'evaluate_data_name', EJECT ??

      PROCEDURE evaluate_data_name
        (VAR result: ^clt$data_value;
         VAR result_sub_list_tail: ^clt$data_value);

        VAR
          saved_parse: clt$parse_state;


        IF recognize_wild_cards THEN
          handle_wild_card_name (result, result_sub_list_tail);
          IF result <> NIL THEN
            RETURN;
          IFEND;
        IFEND;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_expression;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        CASEND;

      /data_name_literal/
        BEGIN
          saved_parse := parse;
          clp$scan_any_lexical_unit (parse);
          IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot] THEN
            parse := saved_parse;
            EXIT /data_name_literal/;
          IFEND;

          clp$make_data_name_value (parse.text^ (saved_parse.unit_index, saved_parse.unit.size), work_area,
                result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

          recognize_binary_operator;
          RETURN;
        END /data_name_literal/;


        evaluate_operand (result);

        CASE result^.kind OF
        = clc$data_name =
          ;
        = clc$keyword =
          clp$make_data_name_value (result^.keyword_value, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        = clc$name =
          clp$make_data_name_value (result^.name_value, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        = clc$unspecified =
          ;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_data_name;
?? TITLE := 'get_present_date_time', EJECT ??

      PROCEDURE [INLINE] get_present_date_time;


        IF NOT got_present_date_time THEN
          pmp$get_compact_date_time (present_date_time.value, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;
          present_date_time.date_specified := TRUE;
          present_date_time.time_specified := TRUE;

          got_present_date_time := TRUE;
        IFEND;

      PROCEND get_present_date_time;
?? TITLE := 'evaluate_date_time', EJECT ??

      PROCEDURE evaluate_date_time
        (VAR result: ^clt$data_value);

        VAR
          date_time: clt$date_time,
          start_index: clt$string_index;

?? NEWTITLE := 'complete_date_time', EJECT ??

        PROCEDURE complete_date_time;

          IF result^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          IF NOT (clc$date IN current_type_description^.date_and_or_time) THEN
            IF NOT result^.date_time_value.time_specified THEN
              osp$set_status_abnormal ('CL', cle$wrong_kind_of_value, 'TIME', status);
              osp$append_status_parameter (osc$status_parameter_delimiter, 'DATE', status);
              EXIT evaluate_expression;
            IFEND;
            get_present_date_time;
            result^.date_time_value.date_specified := FALSE;
            result^.date_time_value.value.year := present_date_time.value.year;
            result^.date_time_value.value.month := present_date_time.value.month;
            result^.date_time_value.value.day := present_date_time.value.day;
          IFEND;

          IF NOT (clc$time IN current_type_description^.date_and_or_time) THEN
            IF NOT result^.date_time_value.date_specified THEN
              osp$set_status_abnormal ('CL', cle$wrong_kind_of_value, 'DATE', status);
              osp$append_status_parameter (osc$status_parameter_delimiter, 'TIME', status);
              EXIT evaluate_expression;
            IFEND;
            result^.date_time_value.time_specified := FALSE;
            result^.date_time_value.value.hour := 0;
            result^.date_time_value.value.minute := 0;
            result^.date_time_value.value.second := 0;
            result^.date_time_value.value.millisecond := 0;
          IFEND;

        PROCEND complete_date_time;
?? TITLE := 'evaluate_variable_or_function', EJECT ??

        PROCEDURE evaluate_variable_or_function;

?? NEWTITLE := 'negate_time_increment', EJECT ??

          PROCEDURE negate_time_increment;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'arithmetic_condition_handler', EJECT ??

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


              IF (condition.selector = pmc$system_conditions) AND
                    (pmc$arithmetic_overflow IN condition.system_conditions) THEN
                osp$set_status_condition (pme$compute_overflow, status);
                EXIT evaluate_expression;
              IFEND;

              pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

            PROCEND arithmetic_condition_handler;
?? OLDTITLE, EJECT ??

            osp$establish_condition_handler (^arithmetic_condition_handler, FALSE);
*IFEND

            right_operand^.time_increment_value^.year := -right_operand^.time_increment_value^.year;
            right_operand^.time_increment_value^.month := -right_operand^.time_increment_value^.month;
            right_operand^.time_increment_value^.day := -right_operand^.time_increment_value^.day;
            right_operand^.time_increment_value^.hour := -right_operand^.time_increment_value^.hour;
            right_operand^.time_increment_value^.minute := -right_operand^.time_increment_value^.minute;
            right_operand^.time_increment_value^.second := -right_operand^.time_increment_value^.second;
            right_operand^.time_increment_value^.millisecond :=
                  -right_operand^.time_increment_value^.millisecond;

          PROCEND negate_time_increment;
?? OLDTITLE, EJECT ??

          VAR
            computed_date_time: ost$date_time,
            current_operator: clt$operator,
            right_operand: ^clt$data_value;


          IF result = NIL THEN
            evaluate_operand (result);
          IFEND;

          CASE result^.kind OF
          = clc$date_time =
            ;
          = clc$unspecified =
            ;
          ELSE
            osp$set_status_condition (cle$wrong_kind_of_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

          IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind IN
                $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]) THEN
            IF result^.kind = clc$unspecified THEN
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
              EXIT evaluate_expression;
            IFEND;

            REPEAT
              current_operator := operator;
              right_operand := NIL;

              IF parse.unit.kind = clc$lex_left_parenthesis THEN
                osp$set_status_abnormal ('CL', cle$expecting_time_incr_operand,
                      current_operator.representation, status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                EXIT evaluate_expression;
              IFEND;

              evaluate_operand (right_operand);

              CASE right_operand^.kind OF
              = clc$time_increment =
                ;
              = clc$unspecified =
                osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
                osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
                EXIT evaluate_expression;
              ELSE
                osp$set_status_abnormal ('CL', cle$expecting_time_incr_operand,
                      current_operator.representation, status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                EXIT evaluate_expression;
              CASEND;

              IF current_operator.arithmetic_kind = clc$lex_subtract THEN
                negate_time_increment;
              IFEND;

              pmp$compute_date_time (result^.date_time_value.value, right_operand^.time_increment_value^,
                    computed_date_time, status);

{ This is commented out in order to prevent clobbering of LAST_DEREFERENCE_NAME.
{             RESET work_area TO right_operand;

              IF NOT status.normal THEN
                EXIT evaluate_expression;
              IFEND;
              result^.date_time_value.value := computed_date_time;

            UNTIL (operator.kind <> clc$arithmetic_operator) OR
                  (NOT (operator.arithmetic_kind IN $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]));
          IFEND;

        PROCEND evaluate_variable_or_function;
?? TITLE := 'evaluate_string', EJECT ??

        PROCEDURE evaluate_string;


          evaluate_operand (result);

          clp$convert_string_to_date_time (result^.string_value^, '', date_time, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

          clp$make_date_time_value (date_time, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

        PROCEND evaluate_string;
?? TITLE := 'validate_date_time_tense', EJECT ??

        PROCEDURE validate_date_time_tense;

          CONST
            max_tense_size = 7 {PRESENT} ;

          VAR
            tense_strings: [STATIC, READ, oss$job_paged_literal] array [clt$date_time_tense] of
                  string (max_tense_size) := ['PAST', 'PRESENT', 'FUTURE'];

          VAR
            date_time_string: ost$string,
            date_time_string_ptr: ^string ( * ),
            delimiter: char,
            tense: clt$date_time_tense;


          get_present_date_time;

          CASE clp$date_time_compare (result^.date_time_value, present_date_time) OF
          = clc$left_is_greater =
            tense := clc$future;
          = clc$right_is_greater =
            tense := clc$past;
          ELSE
            tense := clc$present;
          CASEND;

          IF tense IN current_type_description^.tenses THEN
            RETURN;
          IFEND;

          clp$convert_date_time_to_string (result^.date_time_value, '', date_time_string, status);
          IF status.normal THEN
            date_time_string_ptr := ^date_time_string.value (1, date_time_string.size);
          ELSE
            date_time_string_ptr := ^parse.text^ (start_index, parse.index - start_index);
          IFEND;

          osp$set_status_condition (cle$wrong_date_time_tense, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, tense_strings [tense], status);
          delimiter := osc$status_parameter_delimiter;
          FOR tense := LOWERVALUE (clt$date_time_tense) TO UPPERVALUE (clt$date_time_tense) DO
            IF tense IN current_type_description^.tenses THEN
              osp$append_status_parameter (delimiter, tense_strings [tense], status);
              delimiter := ',';
            IFEND;
          FOREND;
          osp$append_status_parameter (osc$status_parameter_delimiter, date_time_string_ptr^, status);
          EXIT evaluate_expression;

        PROCEND validate_date_time_tense;
?? OLDTITLE, EJECT ??

        start_index := parse.unit_index;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF

        = clc$lex_name, clc$lex_long_name =
          evaluate_variable_or_function;

        = clc$lex_string, clc$lex_unterminated_string =
          evaluate_string;

        = clc$lex_unsigned_decimal, clc$lex_left_parenthesis, clc$lex_subtract, clc$lex_colon, clc$lex_dot =
          get_present_date_time;
          date_time.value := present_date_time.value;
          date_time.date_specified := FALSE;
          date_time.time_specified := FALSE;
          clp$make_date_time_value (date_time, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
          evaluate_date_time_literal (result, ^present_date_time);

        ELSE
          osp$set_status_condition (cle$expecting_date_time_expr, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        CASEND;

        complete_date_time;

        IF current_type_description^.tenses <> $clt$date_time_tenses [clc$past, clc$present, clc$future] THEN
          validate_date_time_tense;
        IFEND;

      PROCEND evaluate_date_time;
?? TITLE := 'evaluate_date_time_literal', EJECT ??

{
{ PURPOSE:
{   This routine evaluates the "literal" form of a date_time or time_increment.
{   The literal parameter is assumed to point to a pre-initialized
{   clc$date_time or clc$time_increment.  For a date_time, the
{   value subfield is assumed to be set to the present date and time, and both
{   the date_specified and time_specified subfields are assumed to be set to
{   FALSE.  For a time_increment, all subfields are assumed to be set to zero
{   and the present_date_time parameter is not used.
{

      PROCEDURE evaluate_date_time_literal
        (    literal: ^clt$data_value;
             present_date_time: ^clt$date_time);

        CONST
          min_year = 1900,
          max_year = 2155,
          max_month = 12,
          max_day = 31,
          max_hour = 23,
          max_minute = 59,
          max_second = 59,
          max_millisecond = 999;

        VAR
          component: integer,
          component_available: boolean,
          start_index: clt$string_index;

?? NEWTITLE := 'evaluate_integer_expression', EJECT ??

        PROCEDURE evaluate_integer_expression;

          VAR
            value: clt$integer;


          clp$scan_non_space_lexical_unit (parse);

          clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, parse, value, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

          IF parse.unit.kind <> clc$lex_right_parenthesis THEN
            osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          IFEND;

          clp$scan_any_lexical_unit (parse);

          component := value.value;
          component_available := TRUE;

        PROCEND evaluate_integer_expression;
?? TITLE := 'evaluate_unsigned_decimal', EJECT ??

        PROCEDURE evaluate_unsigned_decimal;


          clp$evaluate_unsigned_decimal (parse.text^ (parse.unit_index, parse.unit.size), component, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

          clp$scan_any_lexical_unit (parse);

          component_available := TRUE;

        PROCEND evaluate_unsigned_decimal;
?? TITLE := 'impossible', EJECT ??

        PROCEDURE impossible;


          osp$set_status_abnormal ('CL', cle$impossible_date_or_time, parse.
                text^ (start_index, parse.unit_index - start_index), status);
          EXIT evaluate_expression;

        PROCEND impossible;
?? TITLE := 'unrecognizable', EJECT ??

        PROCEDURE unrecognizable;

          VAR
            condition: ost$status_condition_code;


          IF literal^.kind = clc$time_increment THEN
            condition := cle$unrecognizable_time_incr;
          ELSE
            condition := cle$unrecognizable_date_time;
          IFEND;
          osp$set_status_abnormal ('CL', condition, parse.text^ (start_index, parse.index - start_index),
                status);
          EXIT evaluate_expression;

        PROCEND unrecognizable;
?? OLDTITLE, EJECT ??

        start_index := parse.unit_index;

      /handle_date_and_time_parts/
        BEGIN

        /handle_date_part/
          BEGIN

{ Handle year (or possibly hour) component.

            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_integer_expression;
            = clc$lex_unsigned_decimal =
              evaluate_unsigned_decimal;
            ELSE
              component_available := FALSE;
            CASEND;
            CASE parse.unit.kind OF
            = clc$lex_colon =

{ Date omitted, this is just a time literal.

              EXIT /handle_date_part/;
            = clc$lex_subtract =
              ;
            ELSE
              unrecognizable;
            CASEND;

            IF literal^.kind = clc$date_time THEN
              literal^.date_time_value.date_specified := TRUE;
            IFEND;

            IF component_available THEN
              IF literal^.kind = clc$time_increment THEN
                literal^.time_increment_value^.year := component;
              ELSEIF (min_year <= component) AND (component <= max_year) THEN
                literal^.date_time_value.value.year := component - min_year;
              ELSE
                impossible;
              IFEND;
            IFEND;
            clp$scan_any_lexical_unit (parse);

{ Handle month component.

            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_integer_expression;
            = clc$lex_unsigned_decimal =
              evaluate_unsigned_decimal;
            ELSE
              component_available := FALSE;
            CASEND;
            IF parse.unit.kind <> clc$lex_subtract THEN
              unrecognizable;
            IFEND;
            IF component_available THEN
              IF literal^.kind = clc$time_increment THEN
                literal^.time_increment_value^.month := component;
              ELSEIF (1 <= component) AND (component <= max_month) THEN
                literal^.date_time_value.value.month := component;
              ELSE
                impossible;
              IFEND;
            IFEND;
            clp$scan_any_lexical_unit (parse);

{ Handle day component.

            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_integer_expression;
            = clc$lex_unsigned_decimal =
              evaluate_unsigned_decimal;
            ELSE
              component_available := FALSE;
            CASEND;
            IF component_available THEN
              IF literal^.kind = clc$time_increment THEN
                literal^.time_increment_value^.day := component;
              ELSEIF (1 <= component) AND (component <= max_day) THEN
                literal^.date_time_value.value.day := component;
              ELSE
                impossible;
              IFEND;
            IFEND;

{ Handle transition to time part or end of date_time literal.

            IF parse.unit.kind <> clc$lex_dot THEN
              IF literal^.kind = clc$date_time THEN
                literal^.date_time_value.value.hour := 0;
                literal^.date_time_value.value.minute := 0;
                literal^.date_time_value.value.second := 0;
                literal^.date_time_value.value.millisecond := 0;
              IFEND;
              EXIT /handle_date_and_time_parts/;
            IFEND;

            clp$scan_any_lexical_unit (parse);
            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_integer_expression;
            = clc$lex_unsigned_decimal =
              evaluate_unsigned_decimal;
            ELSE
              component_available := FALSE;
            CASEND;
            IF parse.unit.kind <> clc$lex_colon THEN
              unrecognizable;
            IFEND;

          END /handle_date_part/;


{ Handle time part.

          IF literal^.kind = clc$date_time THEN
            literal^.date_time_value.time_specified := TRUE;
          IFEND;

{ Handle hour component.

          IF component_available THEN
            IF literal^.kind = clc$time_increment THEN
              literal^.time_increment_value^.hour := component;
            ELSEIF (0 <= component) AND (component <= max_hour) THEN
              literal^.date_time_value.value.hour := component;
            ELSE
              impossible;
            IFEND;
          IFEND;
          clp$scan_any_lexical_unit (parse);

{ Handle minute component.

          CASE parse.unit.kind OF
          = clc$lex_left_parenthesis =
            evaluate_integer_expression;
          = clc$lex_unsigned_decimal =
            evaluate_unsigned_decimal;
          ELSE
            component_available := FALSE;
          CASEND;
          IF component_available THEN
            IF literal^.kind = clc$time_increment THEN
              literal^.time_increment_value^.minute := component;
            ELSEIF (0 <= component) AND (component <= max_minute) THEN
              literal^.date_time_value.value.minute := component;
            ELSE
              impossible;
            IFEND;
          IFEND;

{ Handle second component.

          IF parse.unit.kind = clc$lex_colon THEN
            clp$scan_any_lexical_unit (parse);
            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_integer_expression;
            = clc$lex_unsigned_decimal =
              evaluate_unsigned_decimal;
            ELSE
              component_available := FALSE;
            CASEND;
            IF component_available THEN
              IF literal^.kind = clc$time_increment THEN
                literal^.time_increment_value^.second := component;
              ELSEIF (0 <= component) AND (component <= max_second) THEN
                literal^.date_time_value.value.second := component;
              ELSE
                impossible;
              IFEND;
            ELSEIF literal^.kind = clc$date_time THEN
              literal^.date_time_value.value.second := 0;
              present_date_time^.value.second := 0;
            IFEND;

{ Handle millisecond component.

            IF parse.unit.kind = clc$lex_dot THEN
              clp$scan_any_lexical_unit (parse);
              CASE parse.unit.kind OF
              = clc$lex_left_parenthesis =
                evaluate_integer_expression;
              = clc$lex_unsigned_decimal =
                evaluate_unsigned_decimal;
              ELSE
                component_available := FALSE;
              CASEND;
              IF component_available THEN
                IF literal^.kind = clc$time_increment THEN
                  literal^.time_increment_value^.millisecond := component;
                ELSEIF (0 <= component) AND (component <= max_millisecond) THEN
                  literal^.date_time_value.value.millisecond := component;
                ELSE
                  impossible;
                IFEND;

              ELSEIF literal^.kind = clc$date_time THEN
                literal^.date_time_value.value.millisecond := 0;
                present_date_time^.value.millisecond := 0;
              IFEND;

            ELSEIF literal^.kind = clc$date_time THEN
              literal^.date_time_value.value.millisecond := 0;
              present_date_time^.value.millisecond := 0;
            IFEND;

          ELSEIF literal^.kind = clc$date_time THEN
            literal^.date_time_value.value.second := 0;
            present_date_time^.value.second := 0;
            literal^.date_time_value.value.millisecond := 0;
            present_date_time^.value.millisecond := 0;
          IFEND;

        END /handle_date_and_time_parts/;

        IF literal^.kind = clc$date_time THEN
          clp$validate_date_time (literal^.date_time_value, parse.
                text^ (start_index, parse.unit_index - start_index), status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;
        IFEND;

        recognize_binary_operator;

      PROCEND evaluate_date_time_literal;
?? TITLE := 'evaluate_entry_point_reference', EJECT ??

      PROCEDURE evaluate_entry_point_reference
        (VAR result: ^clt$data_value);

{
{ The following is a decision table which demonstrates the logic of this
{ procedure.  It should be self-explanatory except perhaps for a few
{ areas:
{    1. "value^.kind valid" means that the value kind is either an
{       entry_point_reference, program_name, cobol_name, data_name, keyword,
{       name, or string.
{    2. "parse moved" means that the parse.unit_index advanced during
{       dereference_name, which indicates the presence of qualifiers -
{       parenthesis or dot.
{    3. "last qualifier field" means that a variable was found and a
{       (record) field qualifier was the last qualifier encountered.
{    4. "special eval file" means don't evaluate file variables or functions
{       while evaluating the file reference - evaluate the file relative to
{       the working catalog.
{
?? EJECT ??
{
{ possible cobol name  |y|n|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ start with : or .    |n|n|y|n|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ parse.unit.kind=name |y|y|n|n|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|y|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ value <> NIL         |-|-|-|-|y|y|y|y|y|y|y|y|y|y|y|y|y|n|n|n|y|y|y|y|y|y|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ value^.kind valid    |-|-|-|-|y|y|y|y|y|y|n|n|n|n|n|n|n|-|-|-|n|n|n|n|n|n|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ value^.kind file     |-|-|-|-|-|-|-|-|-|-|y|y|y|y|y|y|n|-|-|-|n|n|n|n|n|n|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ value^.kind unspec   |-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|y|-|-|-|n|n|n|n|n|n|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ . or // follows val  |-|-|-|-|n|y|y|y|n|n|n|n|n|y|y|y|-|n|y|n|n|n|n|y|y|y|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ any parenthesis?     |-|-|-|-|y|n|y|n|n|n|y|n|n|n|y|n|-|-|-|-|y|n|n|n|n|y|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ parse moved          |-|-|-|-|y|n|y|y|n|y|y|n|y|n|y|y|-|-|-|-|y|n|y|n|y|y|
{                      | | | | | | | | | | | | | | | | | | | | | | | | | | |
{ last qualifier field |-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|y|-|-|-|-|-|-|
{ ____________________________________________________________________________
{
{ recognize cobol name |x| | | | | | | | | | | | | | | | | | | | | | | | | |
{                      |---------------------------------------------------|
{ dereference name     | |x| | | | | | | | | | | | | | | | | | | | | | | | |
{                      |---------------------------------------------------|
{ treat name literally | | | | | | | | | | | |x| | | | | |x| | | |x| | | | |
{                      |---------------------------------------------------|
{ evaluate file ref    | | |x| | | | | | | | | | |x|x|x| | | | | | | | | | |
{                      |---------------------------------------------------|
{ special eval file    | | | | | |x| |x| | | | |x| | | | | |x|x| | |x|x|x| |
{                      |---------------------------------------------------|
{ error                | | | |x| | |x| | | |x| | | | | | | | | |x| | | | |x|
{                      |---------------------------------------------------|
{ entry pt var or fcn  | | | | |x| | | |x|x| | | | | | | | | | | | | | | | |
{                      |---------------------------------------------------|
{ unspecified value    | | | | | | | | | | | | | | | | |x| | | | | | | | | |
{

*IF NOT $true(osv$unix)
        TYPE
          chars = set of char;

        VAR
          cobol_name_size: ost$name_size,
          entry_point: pmt$program_name,
          entry_point_size: clt$string_size,
          evaluated_file_reference: fst$evaluated_file_reference,
          file_ref_parsing_options: clt$file_ref_parsing_options,
          found: boolean,
          ignore_form: clt$command_reference_form,
          ignore_scan_index: integer,
          index_after_name: integer,
          initial_path: ^fst$file_reference,
          is_cobol_name: boolean,
          is_only_cobol_name: boolean,
          parameter_name: clt$parameter_name,
          parenthesis: chars,
          parse_moved: boolean,
          path_name: fst$path,
          path_name_size: fst$path_size,
          saved_parse: clt$parse_state,
          scan_found_parenthesis: boolean,
          value: ^clt$data_value;

?? NEWTITLE := 'evaluate_file_reference', EJECT ??

        PROCEDURE [INLINE] evaluate_file_reference;

          VAR
            entry_point_name: clt$name;

          clp$complete_file_ref_parse (initial_path, parse, work_area, file_ref_parsing_options,
                clv$user_identification, evaluated_file_reference, entry_point_name, ignore_form,
                parameter_name, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;
          IF parameter_name <> osc$null_name THEN
            clp$make_unspecified_value (work_area, result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            RETURN;
          IFEND;

{ Clp$complete_file_ref_parse will append each path element if no cycle path element was found, so
{ the last path element must be removed.

          IF evaluated_file_reference.cycle_reference.specification = fsc$cycle_omitted THEN
            clp$remove_last_path_element (evaluated_file_reference, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;
          IFEND;
*IF NOT $true(osv$unix)
          clp$convert_file_ref_to_string (evaluated_file_reference, FALSE, path_name, path_name_size, status);
*ELSE
            clp$conv_unix_file_ref_to_str (evaluated_file_reference, path_name, path_name_size, status);
*IFEND
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          entry_point := entry_point_name.value;
          entry_point_size := entry_point_name.size;

        PROCEND evaluate_file_reference;
?? OLDTITLE, EJECT ??


      /evaluate_entry_point_ref_blk/
        BEGIN

          saved_parse := parse;
*IF NOT $true(osv$unix)
          file_ref_parsing_options := $clt$file_ref_parsing_options
                [clc$evaluating_entry_point_ref, clc$command_file_ref_allowed];
*ELSE
            file_ref_parsing_options := $clt$file_ref_parsing_options [clc$unix_path_syntax,
                  clc$evaluating_entry_point_ref, clc$command_file_ref_allowed];
*IFEND
          WHILE (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_name, clc$lex_unsigned_decimal,
                clc$lex_alpha_number, clc$lex_subtract]) AND (parse.unit_index < parse.index_limit) DO
            clp$scan_any_lexical_unit (parse);
          WHILEND;

          IF parse.unit_index > saved_parse.unit_index THEN
            clp$recognize_cobol_name (parse.text^ (saved_parse.unit_index,
                  parse.unit_index - saved_parse.unit_index), cobol_name_size, is_only_cobol_name,
                  is_cobol_name);
            IF is_cobol_name AND is_only_cobol_name THEN
              #TRANSLATE (osv$lower_to_upper, parse.text^ (saved_parse.unit_index, cobol_name_size),
                    entry_point);
              clp$make_entry_point_ref_value (entry_point (1, cobol_name_size), osc$null_name,
                    work_area, result);
              IF result = NIL THEN
                osp$set_status_condition (cle$work_area_overflow, status);
                EXIT evaluate_expression;
              IFEND;
              EXIT /evaluate_entry_point_ref_blk/;
            IFEND;
          IFEND;

          path_name := osc$null_name;
          path_name_size := 0;
          parse := saved_parse;
          initial_path := NIL;
          parenthesis := $chars ['('];

        /make_entry_point_value/
          BEGIN

          /evaluate_file_ref/
            BEGIN

            /special_evaluate_file_ref/
              BEGIN
                IF parse.unit.kind = clc$lex_name THEN
                  clp$scan_any_lexical_unit (parse);
                  index_after_name := parse.unit_index;
                  #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.previous_non_space_unit_index,
                        parse.previous_non_space_unit.size), entry_point);
                  entry_point_size := parse.previous_non_space_unit.size;
                  access_variable_requests := access_variable_requests +
                        $clt$access_variable_requests [clc$return_value_qualifiers];
                  dereference_name (entry_point, value);
                  parse_moved := parse.unit_index <> index_after_name;
                  IF NOT status.normal OR (value = NIL) THEN
                    status.normal := TRUE;
                    value := NIL;
                  IFEND;

                  IF (value <> NIL) THEN
                    #SCAN (parenthesis, saved_parse.text^ (saved_parse.unit_index,
                          parse.unit_index - saved_parse.unit_index), ignore_scan_index,
                          scan_found_parenthesis);
                    IF value^.kind IN $clt$data_kinds [clc$entry_point_reference, clc$program_name,
                          clc$cobol_name, clc$data_name, clc$keyword, clc$name, clc$string] THEN
                      IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_concatenate] THEN
                        IF scan_found_parenthesis THEN
                          osp$set_status_condition (cle$wrong_kind_of_value, status);
                          clp$append_status_type_desc (osc$status_parameter_delimiter,
                                current_type_description, status);
                          clp$append_status_value_type (osc$status_parameter_delimiter, value, status);
                          EXIT evaluate_expression;
                        IFEND;
                        EXIT /special_evaluate_file_ref/;
                      ELSE
                        CASE value^.kind OF
                        = clc$entry_point_reference =
                          result := value;
                          EXIT /evaluate_entry_point_ref_blk/;
                        = clc$program_name =
                          entry_point := value^.program_name_value;
                        = clc$cobol_name =
                          entry_point := value^.cobol_name_value;
                        = clc$data_name =
                          entry_point := value^.data_name_value;
                        = clc$keyword =
                          entry_point := value^.keyword_value;
                        = clc$name =
                          entry_point := value^.name_value;
                        = clc$string =
                          evaluate_string_or_pattern (FALSE, value);
                          entry_point_size := clp$trimmed_string_size (value^.string_value^);
                          IF entry_point_size = 0 THEN
                            osp$set_status_condition (cle$null_program_name, status);
                            EXIT evaluate_expression;
                          ELSEIF entry_point_size > STRLENGTH (pmt$program_name) THEN
                            osp$set_status_abnormal ('CL', cle$program_name_too_long, value^.string_value^,
                                  status);
                            EXIT evaluate_expression;
                          IFEND;
                          entry_point := value^.string_value^;
                          EXIT /make_entry_point_value/;
                        CASEND;
                        entry_point_size := clp$trimmed_string_size (entry_point);
                        EXIT /make_entry_point_value/;
                      IFEND;
                    ELSEIF value^.kind = clc$file THEN
*IF NOT $true(osv$unix)
                      IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_concatenate] THEN
*ELSE
                      IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_divide,
                            clc$lex_concatenate] THEN
*IFEND
                        initial_path := value^.file_value;
                        EXIT /evaluate_file_ref/;
                      ELSEIF scan_found_parenthesis THEN
                        osp$set_status_condition (cle$wrong_kind_of_value, status);
                        clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description,
                              status);
                        clp$append_status_value_type (osc$status_parameter_delimiter, value, status);
                        EXIT evaluate_expression;
                      ELSEIF parse_moved THEN
                        EXIT /special_evaluate_file_ref/;
                      ELSE
                        EXIT /make_entry_point_value/;
                      IFEND;
                    ELSEIF value^.kind = clc$unspecified THEN
                      result := value;
                      EXIT /evaluate_entry_point_ref_blk/;
                    ELSE
                      IF scan_found_parenthesis THEN
                        osp$set_status_condition (cle$wrong_kind_of_value, status);
                        clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description,
                              status);
                        clp$append_status_value_type (osc$status_parameter_delimiter, value, status);
                        EXIT evaluate_expression;
                      ELSEIF (parse.unit.kind IN $clt$lexical_unit_kinds
                            [clc$lex_dot, clc$lex_concatenate]) OR parse_moved THEN
                        EXIT /special_evaluate_file_ref/;
                      ELSE
                        EXIT /make_entry_point_value/;
                      IFEND;
                    IFEND;
*IF NOT $true(osv$unix)
                  ELSEIF (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot,
*ELSE
                  ELSEIF (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_divide,
*IFEND
                        clc$lex_concatenate]) OR last_qualifier_is_field THEN
                    EXIT /special_evaluate_file_ref/;
                  ELSE
                    EXIT /make_entry_point_value/;
                  IFEND;
*IF NOT $true(osv$unix)
                ELSEIF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_colon, clc$lex_dot] THEN
*ELSE
                ELSEIF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_colon, clc$lex_dot, clc$lex_divide]
                      THEN
*IFEND
                  EXIT /evaluate_file_ref/;
                ELSE
                  osp$set_status_abnormal ('CL', cle$expecting_entry_point_ref, parse.
                        text^ (parse.unit_index, parse.unit.size), status);
                  EXIT evaluate_expression;
                IFEND;
              END /special_evaluate_file_ref/;
              parse := saved_parse;

{ If initial_path = NIL and clc$evaluating_entry_point_ref is in parsing options,
{ clp$complete_file_ref_parse will not try to evaluate the first path element as a
{ variable or function.

              initial_path := NIL;
            END /evaluate_file_ref/;
            evaluate_file_reference;
            IF NOT status.normal THEN
              RETURN;
            IFEND;

          END /make_entry_point_value/;
          clp$make_entry_point_ref_value (entry_point (1, entry_point_size),
                path_name (1, path_name_size), work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        END /evaluate_entry_point_ref_blk/;
        recognize_binary_operator;
*ELSE
        osp$set_status_abnormal ('CL', cle$not_supported, 'entry points', status);
        EXIT evaluate_expression;
*IFEND

      PROCEND evaluate_entry_point_reference;

?? TITLE := 'evaluate_file', EJECT ??

      PROCEDURE evaluate_file
*IF NOT $true(osv$unix)
        (VAR result {input, output} : ^clt$data_value;
*ELSE
        (    unix_path: boolean;
         VAR result {input, output} : ^clt$data_value;
*IFEND
         VAR result_sub_list_tail: ^clt$data_value);

        VAR
          began_with_left_parenthesis: boolean,
*IF NOT $true(osv$unix)
          func_name: clt$variable_name,
*IFEND
          initial_path: ^fst$file_reference;


      /evaluate_file_blk/
        BEGIN
*IF NOT $true(osv$unix)
          began_with_left_parenthesis := FALSE;
          IF (result <> NIL) AND (result^.kind = clc$file) THEN
            initial_path := result^.file_value;
          ELSE
            initial_path := NIL;
            IF (parse.text^ (parse.unit_index) = '$') AND
                  (last_dereference_result <> NIL) AND (last_dereference_result^.kind = clc$file) AND
                  ((parse.unit_index + parse.unit.size = parse.index_limit) OR
                  (parse.text^ (parse.unit_index + parse.unit.size) <> '.')) THEN
              #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), func_name);
              IF (func_name = last_dereference_name) AND
                    (parse.text = last_dereference_parse.text) AND ((parse.unit_index =
                    last_dereference_index) OR (last_dereference_index = parse.index_limit)) AND
                    (last_dereference_parse.unit_index <= parse.index_limit) THEN
                result := last_dereference_result;
                result_sub_list_tail := NIL;
                clp$scan_any_lexical_unit (parse);
                IF parse.unit.kind = clc$lex_left_parenthesis THEN
                  clp$scan_bal_paren_lexical_unit (parse);
                  IF parse.unit.kind <> clc$lex_right_parenthesis THEN
                    osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
                    clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                    RETURN;
                  IFEND;
                  clp$scan_any_lexical_unit (parse);
                IFEND;
                IF parse.unit.kind <> clc$lex_space THEN
                  initial_path := result^.file_value;
                ELSE
                  EXIT /evaluate_file_blk/;
                IFEND;
              IFEND;
            ELSEIF parse.unit.kind = clc$lex_left_parenthesis THEN
              began_with_left_parenthesis := TRUE;
              clp$scan_non_space_lexical_unit (parse);
            IFEND;
*ELSE
          initial_path := NIL;
          IF result <> NIL THEN
            IF unix_path THEN
              IF result^.kind = clc$unix_file THEN
                initial_path := result^.file_value;
              IFEND;
            ELSE
              IF result^.kind = clc$nos_ve_file THEN
                initial_path := result^.file_value;
              IFEND;
            IFEND;
          IFEND;
          began_with_left_parenthesis := (initial_path = NIL) AND
                (parse.unit.kind = clc$lex_left_parenthesis);
          IF began_with_left_parenthesis THEN
            clp$scan_non_space_lexical_unit (parse);
*IFEND
          IFEND;

*IF NOT $true(osv$unix)
          clp$complete_file_ref_eval (recognize_wild_cards, defer_expansion,
*ELSE
          clp$complete_file_ref_eval (unix_path, recognize_wild_cards, defer_expansion,
*IFEND
                current_type_description^.derived_from_value_kind_spec,
                initial_path, parse, work_area, result, result_sub_list_tail, status);
          IF NOT status.normal THEN
            IF status.condition = cle$work_area_overflow THEN
              EXIT evaluate_expression;
            IFEND;
            RETURN;
          IFEND;

          IF began_with_left_parenthesis THEN
            IF parse.unit_is_space THEN
              clp$scan_non_space_lexical_unit (parse);
            IFEND;
            IF parse.unit.kind <> clc$lex_right_parenthesis THEN
              osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              RETURN;
            IFEND;
            clp$scan_any_lexical_unit (parse);
          IFEND;
        END /evaluate_file_blk/;
        recognize_binary_operator;

      PROCEND evaluate_file;
?? TITLE := 'evaluate_keyword', EJECT ??

      PROCEDURE evaluate_keyword
        (VAR result: ^clt$data_value);


        IF recognize_wild_cards THEN
          handle_wild_card_name (result, result_sub_list_tail);
          IF result <> NIL THEN
            RETURN;
          IFEND;
        IFEND;

        evaluate_operand (result);

        CASE result^.kind OF
        = clc$keyword =
          { checking for allowed keywords is done within evaluate_operand } ;
        = clc$unspecified =
          ;
        = clc$data_name =
          osp$set_status_abnormal ('CL', cle$unknown_keyword, result^.data_name_value, status);
          EXIT evaluate_expression;
        = clc$name =
          osp$set_status_abnormal ('CL', cle$unknown_keyword, result^.name_value, status);
          EXIT evaluate_expression;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_keyword;
?? TITLE := 'evaluate_list', EJECT ??

      PROCEDURE evaluate_list
        (VAR result: ^clt$data_value);

        VAR
          element_expansion: clt$list_expansion,
          element_type_description: ^clt$type_description,
          list_size: clt$list_size,
          local_numeric_info: clt$numeric_operand_info,
          local_parse: clt$parse_state,
          local_result: ^clt$data_value,
          local_status: ^ost$status,
          result_conforms_to_element_type: boolean,
          result_conforms_to_type: boolean,
          type_description: ^clt$type_description,
          sub_list_tail: ^clt$data_value;

?? NEWTITLE := 'validate_list_size', EJECT ??

        PROCEDURE [INLINE] validate_list_size;


          IF (list_size < current_type_description^.min_list_size) OR
                (list_size > current_type_description^.max_list_size) THEN
            osp$set_status_condition (cle$too_few_or_many_list_elems, status);
            osp$append_status_integer (osc$status_parameter_delimiter, list_size, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  current_type_description^.min_list_size, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  current_type_description^.max_list_size, 10, FALSE, status);
            EXIT evaluate_list;
          IFEND;

        PROCEND validate_list_size;
?? OLDTITLE, EJECT ??

        defer_expansion := current_type_description^.defer_expansion;
        IF defer_expansion THEN
          element_expansion := clc$defer_expansion;
        ELSE
          element_expansion := clc$normal_expansion;
        IFEND;
        IF current_type_description^.list_element_type_description <> NIL THEN
          element_type_description := current_type_description^.list_element_type_description;
          CASE element_type_description^.kind OF
*IF NOT $true(osv$unix)
          = clc$file_type, clc$keyword_type =
*ELSE
          = clc$nos_ve_file_type =
            recognize_wild_cards := (clc$file_type = clc$nos_ve_file_type) OR defer_expansion OR
                  (expression_type_name <> NIL);
          = clc$unix_file_type =
            recognize_wild_cards := (clc$file_type = clc$unix_file_type) OR defer_expansion OR
                  (expression_type_name <> NIL);
          = clc$keyword_type =
*IFEND
            recognize_wild_cards := TRUE;
          = clc$data_name_type, clc$name_type, clc$program_name_type =
            recognize_wild_cards := defer_expansion OR (expression_type_name <> NIL);
          ELSE
            recognize_wild_cards := FALSE;
            element_expansion := clc$no_expansion;
          CASEND;
        ELSE
          element_type_description := ^unqual_union_type_description;
          recognize_wild_cards := FALSE;
          element_expansion := clc$no_expansion;
        IFEND;
        sub_list_tail := NIL;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
        IF recognize_wild_cards THEN
          clp$rescan_wild_card_lex_unit (parse);
        IFEND;

        local_parse := parse;

        type_description := NIL;
        result := NIL;
        result_conforms_to_type := FALSE;
        result_conforms_to_element_type := FALSE;
        operand_type_description := NIL;
        IF parse.unit.kind = clc$lex_name THEN
          check_for_variable_or_function (element_type_description, result_conforms_to_element_type,
                result_conforms_to_type, type_description, result, sub_list_tail);
          IF (result <> NIL) AND result_conforms_to_type THEN
            IF (current_type_description^.derived_from_value_kind_spec) THEN
              convert_fs_file_ref_to_cl_file (result);
            IFEND;
            RETURN;
          IFEND;
        IFEND;

        IF ((result <> NIL) AND (result^.kind = clc$unspecified) AND result_conforms_to_element_type) AND
              ((NOT current_type_description^.list_rest) OR (parse.unit.kind = clc$lex_right_parenthesis))
              THEN
          RETURN;
        IFEND;

        IF result_conforms_to_element_type AND (operator.kind = clc$not_an_operator) THEN
          IF sub_list_tail <> NIL THEN
            local_result := result^.element_value;
            list_size := clp$count_list_elements (result);
          ELSE
            local_result := result;
            clp$make_list_value (work_area, result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            result^.element_value := local_result;
            list_size := 1;
          IFEND;

          IF current_type_description^.list_rest THEN

{ check for unspecified list element value

            IF (result^.element_value <> NIL) AND (result^.element_value^.kind = clc$unspecified) THEN
              osp$set_status_abnormal ('CL', cle$unspecified_value_for_list, last_dereference_name, status);
              EXIT evaluate_expression;
            IFEND;
            result^.generated_via_list_rest := TRUE;
            IF parse.unit_is_space THEN
              clp$scan_non_space_lexical_unit (parse);
            IFEND;
            evaluate_parenthesized_list (element_type_description, type_description, local_result, clc$list,
                  element_expansion, sub_list_tail, list_size, result);
          IFEND;
          validate_list_size;
          RETURN;
        IFEND;

        local_result := result;
        clp$make_list_value (work_area, result);
        IF result = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;
        IFEND;

        IF current_type_description^.list_rest THEN
          list_size := 0;
          parse := local_parse;
          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          evaluate_parenthesized_list (element_type_description, type_description, local_result, clc$list,
                element_expansion, NIL, list_size, result);
          result^.generated_via_list_rest := TRUE;
          validate_list_size;
          RETURN;
        IFEND;

        IF local_parse.unit.kind = clc$lex_left_parenthesis THEN
          list_size := 0;
          clp$scan_non_space_lexical_unit (parse);
          evaluate_parenthesized_list (element_type_description, type_description, local_result, clc$list,
                element_expansion, NIL, list_size, result);
          validate_list_size;
          RETURN;
        IFEND;

        local_status := NIL;
        IF (local_result <> NIL) AND (operator.kind = clc$not_an_operator) THEN
          CASE local_result^.kind OF
          = clc$array =
            clp$convert_array_to_list (local_result, operand_type_description, current_type_description,
                  work_area, result, status);
            IF status.normal THEN
              RETURN;
            ELSEIF (status.condition <> cle$wrong_kind_of_element_type) AND
                  (status.condition <> cle$wrong_kind_of_element_value) THEN
              EXIT evaluate_expression;
            IFEND;
            PUSH local_status;
            local_status^ := status;

          = clc$unspecified =
            IF (type_description <> NIL) AND (type_description^.kind = clc$array_type) THEN
              clp$evaluate_type_conformance (type_description^.array_element_type_description,
                    current_type_description^.list_element_type_description, clc$conforms_to_type, status);
              IF status.normal THEN
                result := local_result;
                RETURN;
              IFEND;
            IFEND;
          ELSE
            ;
          CASEND;
        IFEND;

        parse := local_parse;
        local_numeric_info.initialized := FALSE;
        evaluate_expression (parse, element_type_description, FALSE, element_expansion, local_numeric_info,
              result^.element_value, sub_list_tail, status);
        IF NOT status.normal THEN
          IF local_status <> NIL THEN
            status := local_status^;
          ELSE
            determine_structure_status (local_result, clc$list, type_description, current_type_description,
                  status);
          IFEND;
          EXIT evaluate_expression;
        ELSEIF sub_list_tail <> NIL THEN
          result := result^.element_value;
          list_size := clp$count_list_elements (result);
        ELSE
          list_size := 1;
        IFEND;

{ check for unspecified element_value for list

        IF (result^.element_value <> NIL) AND (result^.element_value^.kind = clc$unspecified) THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_list, last_dereference_name, status);
          RETURN;
        IFEND;

        validate_list_size;

        recognize_binary_operator;

      PROCEND evaluate_list;
?? TITLE := 'evaluate_lock', EJECT ??

      PROCEDURE evaluate_lock
        (VAR result: ^clt$data_value);


        osp$set_status_abnormal ('CL', cle$not_supported, 'lock expressions', status);
        EXIT evaluate_expression;

      PROCEND evaluate_lock;
?? TITLE := 'evaluate_name', EJECT ??

      PROCEDURE evaluate_name
        (VAR result: ^clt$data_value;
         VAR result_sub_list_tail: ^clt$data_value);

        VAR
          name_size: ost$name_size;


        IF recognize_wild_cards THEN
          handle_wild_card_name (result, result_sub_list_tail);
          IF result <> NIL THEN
            RETURN;
          IFEND;
        IFEND;

        evaluate_operand (result);

        CASE result^.kind OF
        = clc$data_name =
          clp$make_name_value (result^.data_name_value, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        = clc$keyword =
          clp$make_name_value (result^.keyword_value, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        ELSE
          ;
        CASEND;

        CASE result^.kind OF
        = clc$name =
          name_size := clp$trimmed_string_size (result^.name_value);
          IF name_size > current_type_description^.max_name_size THEN
            osp$set_status_condition (cle$name_value_too_long, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  current_type_description^.max_name_size, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, name_size, 10, FALSE, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, result^.name_value, status);
            EXIT evaluate_expression;
          ELSEIF name_size < current_type_description^.min_name_size THEN
            osp$set_status_condition (cle$name_value_too_short, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  current_type_description^.min_name_size, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, name_size, 10, FALSE, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, result^.name_value, status);
            EXIT evaluate_expression;
          IFEND;
        = clc$unspecified =
          ;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_name;
?? TITLE := 'evaluate_network_title', EJECT ??

      PROCEDURE evaluate_network_title
        (VAR result: ^clt$data_value);


        osp$set_status_abnormal ('CL', cle$not_supported, 'network_title expressions', status);
        EXIT evaluate_expression;

      PROCEND evaluate_network_title;
?? TITLE := 'evaluate_number', EJECT ??

      PROCEDURE evaluate_number
        (    finalize_result: boolean;
         VAR result {input, output} : ^clt$data_value);

        VAR
          integer_result: clt$data_value,
          real_convertable_to_integer: boolean;

?? NEWTITLE := 'complete_numeric_result', EJECT ??

        PROCEDURE complete_numeric_result;

          VAR
            converted_stat_code: integer,
            real_number: clt$real,
            result_kind: clt$type_kind;


          CASE result^.kind OF
          = clc$integer =
            result_kind := clc$integer_type;
          = clc$real =
            result_kind := clc$real_type;
          = clc$statistic_code =
            converted_stat_code := result^.statistic_code_value;
            result^.kind := clc$integer;
            result^.integer_value.value := converted_stat_code;
            result^.integer_value.radix := 10;
            result^.integer_value.radix_specified := FALSE;
            result_kind := clc$integer_type;
          = clc$status_code =
            converted_stat_code := result^.status_code_value;
            result^.kind := clc$integer;
            result^.integer_value.value := converted_stat_code;
            result^.integer_value.radix := 10;
            result^.integer_value.radix_specified := FALSE;
            result_kind := clc$integer_type;
          = clc$unspecified =
            RETURN;
          ELSE
            CASE current_type_description^.kind OF
            = clc$integer_type, clc$real_type =
              osp$set_status_condition (cle$wrong_kind_of_value, status);
              clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
              clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
              EXIT evaluate_expression;
            ELSE
              RETURN;
            CASEND;
          CASEND;

          IF NOT (result_kind IN current_type_description^.kinds) THEN
*IF NOT $true(osv$unix)
            IF clc$real_type IN current_type_description^.kinds THEN
              clp$convert_integer_to_real (result^.integer_value.value, real_number, status);
              IF NOT status.normal THEN
                EXIT evaluate_expression;
              IFEND;
              result^.kind := clc$real;
              result^.real_value := real_number;
            ELSEIF real_convertable_to_integer THEN

{ Since the real number has a fractional part, it can't be treated as an integer without loss of significance.

              osp$set_status_condition (cle$wrong_kind_of_value, status);
              clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
              clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
              EXIT evaluate_expression;
            ELSE
              osp$set_status_condition (cle$real_greater_than_integer, status);
              osp$append_status_real (osc$status_parameter_delimiter, result^.real_value.value,
                    result^.real_value.number_of_digits, status);
              EXIT evaluate_expression;
            IFEND;
*IFEND
          IFEND;

          IF result^.kind = clc$integer THEN
            IF (result^.integer_value.value < numeric_info.min_integer_value) OR
                  (result^.integer_value.value > numeric_info.max_integer_value) THEN
              osp$set_status_condition (cle$integer_out_of_range, status);
              osp$append_status_integer (osc$status_parameter_delimiter, result^.integer_value.value,
                    result^.integer_value.radix, result^.integer_value.radix_specified, status);
              osp$append_status_integer (osc$status_parameter_delimiter, numeric_info.min_integer_value,
                    result^.integer_value.radix, result^.integer_value.radix_specified, status);
              osp$append_status_integer (osc$status_parameter_delimiter, numeric_info.max_integer_value,
                    result^.integer_value.radix, result^.integer_value.radix_specified, status);
              EXIT evaluate_expression;
            IFEND;
*IF NOT $true(osv$unix)
          ELSE {result^.kind = clc$real}
            IF NOT (clp$longreal_compare_le (numeric_info.min_real_value,
                  result^.real_value.value) AND clp$longreal_compare_le
                  (result^.real_value.value, numeric_info.max_real_value)) THEN
              osp$set_status_condition (cle$real_number_out_of_range, status);
              osp$append_status_real (osc$status_parameter_delimiter, result^.real_value.value,
                    result^.real_value.number_of_digits, status);
              osp$append_status_real (osc$status_parameter_delimiter, numeric_info.min_real_value,
                    clc$max_real_number_digits, status);
              osp$append_status_real (osc$status_parameter_delimiter, numeric_info.max_real_value,
                    clc$max_real_number_digits, status);
              EXIT evaluate_expression;
            IFEND;
*IFEND
          IFEND;

        PROCEND complete_numeric_result;
?? TITLE := 'handle_add_and_subtract', EJECT ??

        PROCEDURE handle_add_and_subtract
          (VAR result {input, output} : ^clt$data_value);

          VAR
            current_operator: clt$operator,
            left_operand: ^clt$data_value,
            right_operand: ^clt$data_value;


          PUSH left_operand;
          left_operand^ := result^;
          IF result = last_dereference_result THEN

{ Make a copy of the result so that LAST_DEREFERENCE_RESULT won't get overwritten

            NEXT result IN work_area;
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            result^ := left_operand^;
          IFEND;

          WHILE (operator.kind = clc$arithmetic_operator) AND
                (operator.arithmetic_kind IN $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]) DO
            current_operator := operator;

            IF current_operator.arithmetic_kind = clc$lex_subtract THEN
              numeric_info.sign := -1;
            IFEND;

            evaluate_operand (right_operand);

            CASE right_operand^.kind OF
            = clc$integer, clc$real =
              ;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, current_operator.representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              osp$set_status_abnormal ('CL', cle$arithmetic_operand_not_num, current_operator.representation,
                    status);
              clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
              EXIT evaluate_expression;
            CASEND;

            IF current_operator.arithmetic_kind = clc$lex_subtract THEN
              IF numeric_info.sign = -1 THEN
                numeric_info.sign := 1;
              ELSE

{ right operand was a numeric literal

                IF (operator.kind = clc$arithmetic_operator) AND
                      (operator.arithmetic_kind = clc$lex_exponentiate) THEN
                  handle_unary_minus (right_operand^);
                ELSE
                  current_operator.arithmetic_kind := clc$lex_add;
                  current_operator.representation := '+';
                IFEND;
              IFEND;
            IFEND;

            IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind = clc$lex_exponentiate)
                  THEN
              handle_exponentiate (right_operand);
            IFEND;

            IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind IN
                  $clt$lexical_unit_kinds [clc$lex_multiply, clc$lex_divide]) THEN
              handle_multiply_and_divide (right_operand);
            IFEND;

            clp$perform_numeric_operation (current_operator.representation, left_operand^, right_operand^,
                  result^, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;

            left_operand^ := result^;
          WHILEND;

        PROCEND handle_add_and_subtract;
?? TITLE := 'handle_exponentiate', EJECT ??

        PROCEDURE handle_exponentiate
          (VAR result {input, output} : ^clt$data_value);

          VAR
            current_operator_representation: clt$operator_representation,
            left_operand: ^clt$data_value,
            right_operand: ^clt$data_value;


          current_operator_representation := operator.representation;

          evaluate_operand (right_operand);

          CASE right_operand^.kind OF
          = clc$integer, clc$real =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, current_operator_representation,
                  status);
            EXIT evaluate_expression;
          ELSE
            osp$set_status_abnormal ('CL', cle$arithmetic_operand_not_num, current_operator_representation,
                  status);
            clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
            EXIT evaluate_expression;
          CASEND;

          IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind = clc$lex_exponentiate)
                THEN
            handle_exponentiate (right_operand);
          IFEND;


          PUSH left_operand;
          left_operand^ := result^;
          IF result = last_dereference_result THEN

{ Make a copy of the result so that LAST_DEREFERENCE_RESULT won't get overwritten

            NEXT result IN work_area;
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            result^ := left_operand^;
          IFEND;

          clp$perform_numeric_operation (current_operator_representation, left_operand^, right_operand^,
                result^, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

        PROCEND handle_exponentiate;
?? TITLE := 'handle_multiply_and_divide', EJECT ??

        PROCEDURE handle_multiply_and_divide
          (VAR result {input, output} : ^clt$data_value);

          VAR
            current_operator: clt$operator,
            left_operand: ^clt$data_value,
            right_operand: ^clt$data_value;


          PUSH left_operand;
          left_operand^ := result^;
          IF result = last_dereference_result THEN

{ Make a copy of the result so that LAST_DEREFERENCE_RESULT won't get overwritten

            NEXT result IN work_area;
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            result^ := left_operand^;
          IFEND;

          WHILE (operator.kind = clc$arithmetic_operator) AND
                (operator.arithmetic_kind IN $clt$lexical_unit_kinds [clc$lex_multiply, clc$lex_divide]) DO
            current_operator := operator;

            evaluate_operand (right_operand);

            CASE right_operand^.kind OF
            = clc$integer, clc$real =
              ;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, current_operator.representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              osp$set_status_abnormal ('CL', cle$arithmetic_operand_not_num, current_operator.representation,
                    status);
              clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
              EXIT evaluate_expression;
            CASEND;

            IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind = clc$lex_exponentiate)
                  THEN
              handle_exponentiate (right_operand);
            IFEND;

            clp$perform_numeric_operation (current_operator.representation, left_operand^, right_operand^,
                  result^, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;

            left_operand^ := result^;
          WHILEND;

        PROCEND handle_multiply_and_divide;
?? OLDTITLE, EJECT ??

        IF result = NIL THEN
          evaluate_operand (result);
        IFEND;

        IF operator.kind = clc$arithmetic_operator THEN
          CASE result^.kind OF
          = clc$integer, clc$real =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
            EXIT evaluate_expression;
          ELSE
            osp$set_status_abnormal ('CL', cle$arithmetic_operand_not_num, operator.representation, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

          IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind = clc$lex_exponentiate)
                THEN
            handle_exponentiate (result);
          IFEND;

          IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind IN
                $clt$lexical_unit_kinds [clc$lex_multiply, clc$lex_divide]) THEN
            handle_multiply_and_divide (result);
          IFEND;

          IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind IN
                $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]) THEN
            handle_add_and_subtract (result);
          IFEND;
        IFEND;

        IF evaluating_sub_expression OR ((NOT finalize_result) AND (operator.kind <> clc$not_an_operator))
              THEN
          RETURN;
        IFEND;

        simplify_real_to_integer (result, integer_result, real_convertable_to_integer);

*IF NOT $true(osv$unix)
        IF finalize_result AND (($clt$type_kinds [clc$integer_type, clc$real_type] *
              current_type_description^.kinds) <> $clt$type_kinds []) THEN
*ELSE
        IF finalize_result AND (($clt$type_kinds_v2 [clc$integer_type, clc$real_type] *
              current_type_description^.kinds) <> $clt$type_kinds_v2 []) THEN
*IFEND
          complete_numeric_result;
        IFEND;

      PROCEND evaluate_number;
?? TITLE := 'evaluate_operand', EJECT ??

      PROCEDURE evaluate_operand
        (VAR operand: ^clt$data_value);

        CONST
          min_boolean_operand_name_size = 2,
          max_boolean_operand_name_size = 5;

        VAR
          number: clt$number,
          number_allowed: boolean,
          operand_was_signed: boolean,
          sign: -1 .. 1,
          sign_representation: clt$operator_representation;

?? NEWTITLE := 'complete_numeric_operand', EJECT ??

        PROCEDURE complete_numeric_operand;


          IF NOT numeric_info.radix.established THEN
            numeric_info.radix.established := TRUE;
            IF operand^.kind = clc$integer THEN
              numeric_info.radix.value := operand^.integer_value.radix;
              numeric_info.radix.specified := operand^.integer_value.radix_specified;
            ELSE
              numeric_info.radix.value := 10;
              numeric_info.radix.specified := numeric_info.radix.default <> 10;
            IFEND;
          IFEND;

          IF operand_was_signed AND (sign = -1) THEN
            handle_unary_minus (operand^);
          IFEND;

        PROCEND complete_numeric_operand;
*IF NOT $true(osv$unix)
?? TITLE := 'evaluate_file_operand', EJECT ??

        PROCEDURE evaluate_file_operand
*ELSE
?? TITLE := 'evaluate_nos_ve_file_operand', EJECT ??

        PROCEDURE evaluate_nos_ve_file_operand
*IFEND
          (VAR operand: ^clt$data_value);

          VAR
            ignore_sub_list_tail: ^clt$data_value,
            initial_path: ^fst$file_reference;


*IF NOT $true(osv$unix)
          IF (operand <> NIL) AND (operand^.kind = clc$file) THEN
*ELSE
          IF (operand <> NIL) AND (operand^.kind = clc$nos_ve_file) THEN
*IFEND
            initial_path := operand^.file_value;
          ELSE
            initial_path := NIL;
          IFEND;

*IF NOT $true(osv$unix)
          clp$complete_file_ref_eval (FALSE, FALSE, current_type_description^.derived_from_value_kind_spec,
                initial_path, parse, work_area, operand, ignore_sub_list_tail, status);
*ELSE
          clp$complete_file_ref_eval (FALSE, FALSE, FALSE,
                current_type_description^.derived_from_value_kind_spec, initial_path, parse, work_area,
                operand, ignore_sub_list_tail, status);
*IFEND
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

*IF NOT $true(osv$unix)
        PROCEND evaluate_file_operand;
*ELSE
        PROCEND evaluate_nos_ve_file_operand;
*IFEND
?? TITLE := 'evaluate_name_operand', EJECT ??

        PROCEDURE evaluate_name_operand;

          VAR
            element_type_description: ^clt$type_description,
            i: clt$union_member_number,
            name: ost$name,
            name_size: ost$name_size,
            parse_index_after_name: clt$string_index,
            saved_parse: clt$parse_state,
            type_conformance: clt$type_conformance,
            unknown_name_condition: ost$status_condition;

?? NEWTITLE := 'check_for_and_handle_boolean', EJECT ??

          PROCEDURE check_for_and_handle_boolean
            (    name: ost$name);

            VAR
              bool: clt$boolean,
              name_is_boolean: boolean;


            clp$check_name_for_boolean (name, bool, name_is_boolean);
            IF (NOT name_is_boolean) OR
                  ((parse.unit.kind >= clc$lex_greater_than) AND (parse.unit.kind <= clc$lex_not_equal)) THEN
              RETURN;
            IFEND;

            clp$make_clt$boolean_value (bool, work_area, operand);
            IF operand = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

            EXIT evaluate_name_operand;

          PROCEND check_for_and_handle_boolean;
?? TITLE := 'check_for_and_handle_keyword', EJECT ??

          PROCEDURE check_for_and_handle_keyword
            (    name: ost$name);

            VAR
              current_index: 1 .. clc$max_keywords,
              high_index: 0 .. clc$max_keywords,
              keyword: clt$keyword,
              keyword_ordinal: clt$named_entry_ordinal,
              temp: integer,
              low_index: 1 .. clc$max_keywords + 1;


            keyword := name;
            low_index := 1;
            high_index := UPPERBOUND (current_type_description^.keyword_specifications^);
            REPEAT
              temp := low_index + high_index;
              current_index := temp DIV 2;
              IF current_type_description^.keyword_specifications^ [current_index].keyword = keyword THEN

              /normalize_keyword/
                BEGIN
                  IF current_type_description^.keyword_specifications^ [current_index].class =
                        clc$nominal_entry THEN
                    EXIT /normalize_keyword/;
                  IFEND;

                  keyword_ordinal := current_type_description^.keyword_specifications^ [current_index].
                        ordinal;
                  low_index := current_index + 1;
                  high_index := current_index - 1;

                  FOR current_index := low_index TO UPPERBOUND (current_type_description^.
                        keyword_specifications^) DO
                    IF (current_type_description^.keyword_specifications^ [current_index].ordinal =
                          keyword_ordinal) AND (current_type_description^.
                          keyword_specifications^ [current_index].class = clc$nominal_entry) THEN
                      keyword := current_type_description^.keyword_specifications^ [current_index].keyword;
                      EXIT /normalize_keyword/;
                    IFEND;
                  FOREND;

                  FOR current_index := high_index DOWNTO 1 DO
                    IF (current_type_description^.keyword_specifications^ [current_index].ordinal =
                          keyword_ordinal) AND (current_type_description^.
                          keyword_specifications^ [current_index].class = clc$nominal_entry) THEN
                      keyword := current_type_description^.keyword_specifications^ [current_index].keyword;
                      EXIT /normalize_keyword/;
                    IFEND;
                  FOREND;

                  osp$set_status_condition (cle$bad_keyword_type_spec, status);
                  EXIT evaluate_expression;
                END /normalize_keyword/;

                clp$make_keyword_value (keyword, work_area, operand);
                IF operand = NIL THEN
                  osp$set_status_condition (cle$work_area_overflow, status);
                  EXIT evaluate_expression;
                IFEND;
                EXIT evaluate_name_operand;

              ELSEIF current_type_description^.keyword_specifications^ [current_index].keyword < keyword THEN
                low_index := current_index + 1;
              ELSE
                high_index := current_index - 1;
              IFEND;
            UNTIL low_index > high_index;

          PROCEND check_for_and_handle_keyword;
?? TITLE := 'handle_$max', EJECT ??

          PROCEDURE handle_$max;

            VAR
              real_number: clt$real;


            clp$make_integer_value (numeric_info.max_integer_value, numeric_info.radix.default, FALSE,
                  work_area, operand);
            IF operand = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

            IF clc$integer_type IN current_type_description^.kinds THEN
*IF NOT $true(osv$unix)
              IF clc$real_type IN current_type_description^.kinds THEN
                clp$convert_integer_to_real (operand^.integer_value.value, real_number, status);
                IF NOT status.normal THEN
                  EXIT evaluate_expression;
                IFEND;
                IF clp$longreal_compare_gt (numeric_info.max_real_value, real_number.value) THEN
                  operand^.kind := clc$real;
                  operand^.real_value.value := numeric_info.max_real_value;
                  operand^.real_value.number_of_digits := clc$max_real_number_digits;
                IFEND;
              IFEND;
*IFEND
            ELSEIF clc$real_type IN current_type_description^.kinds THEN
              operand^.kind := clc$real;
              operand^.real_value.value := numeric_info.max_real_value;
              operand^.real_value.number_of_digits := clc$max_real_number_digits;
            IFEND;

            EXIT evaluate_name_operand;

          PROCEND handle_$max;
?? TITLE := 'handle_$min', EJECT ??

          PROCEDURE handle_$min;

            VAR
              real_number: clt$real;


            clp$make_integer_value (numeric_info.min_integer_value, numeric_info.radix.default, FALSE,
                  work_area, operand);
            IF operand = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

            IF clc$integer_type IN current_type_description^.kinds THEN
*IF NOT $true(osv$unix)
              IF clc$real_type IN current_type_description^.kinds THEN
                clp$convert_integer_to_real (operand^.integer_value.value, real_number, status);
                IF NOT status.normal THEN
                  EXIT evaluate_expression;
                IFEND;
                IF clp$longreal_compare_lt (numeric_info.min_real_value, real_number.value) THEN
                  operand^.kind := clc$real;
                  operand^.real_value.value := numeric_info.min_real_value;
                  operand^.real_value.number_of_digits := clc$max_real_number_digits;
                IFEND;
              IFEND;
*IFEND
            ELSEIF clc$real_type IN current_type_description^.kinds THEN
              operand^.kind := clc$real;
              operand^.real_value.value := numeric_info.min_real_value;
              operand^.real_value.number_of_digits := clc$max_real_number_digits;
            IFEND;

            EXIT evaluate_name_operand;

          PROCEND handle_$min;
?? TITLE := 'handle_$now', EJECT ??

          PROCEDURE handle_$now;

            VAR
              date_time: clt$date_time,
              saved_parse: clt$parse_state;

            IF parse.unit.kind = clc$lex_left_parenthesis THEN

{  Check for $now().  Note that an arbitrary number of spaces may be between
{  the parentheses.  If the syntax is correct, advance the parse state past
{  the right parenthesis, else ignore $now for now and let an error be
{  generated later.

              saved_parse := parse;
              clp$scan_non_space_lexical_unit (parse);
              IF parse.unit.kind <> clc$lex_right_parenthesis THEN
                parse := saved_parse;
                RETURN;
              ELSE
                clp$scan_any_lexical_unit (parse);
              IFEND;
            IFEND;

            get_present_date_time;
            date_time.value := present_date_time.value;
            date_time.date_specified := TRUE;
            date_time.time_specified := TRUE;
            clp$make_date_time_value (date_time, work_area, operand);
            IF operand = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

            EXIT evaluate_name_operand;

          PROCEND handle_$now;
?? TITLE := 'handle_not', EJECT ??

          PROCEDURE handle_not
            (VAR result: ^clt$data_value);


            clp$scan_non_space_lexical_unit (parse);
            IF NOT parse.previous_unit_is_space THEN
              osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'NOT', status);
              EXIT evaluate_expression;
            IFEND;

            evaluate_boolean_operand (result);

            IF operator.kind = clc$relational_operator THEN
              handle_comparison (result);
            IFEND;

            CASE result^.kind OF
            = clc$boolean =
              ;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, clc$not_operator_representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              osp$set_status_condition (cle$not_operand_not_boolean, status);
              clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
              EXIT evaluate_expression;
            CASEND;

            clp$make_boolean_value (NOT result^.boolean_value.value, result^.boolean_value.kind, work_area,
                  result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;

{ The following EXIT avoids a redundant call to recognize_binary_operator.

            EXIT evaluate_operand;

          PROCEND handle_not;
?? OLDTITLE, EJECT ??

          saved_parse := parse;
          name_size := parse.unit.size;
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, name_size), name);
          clp$scan_any_lexical_unit (parse);

          IF recognize_wild_cards AND (parse.unit.kind IN $clt$lexical_unit_kinds
                [clc$lex_query, clc$lex_multiply]) THEN
            evaluate_wild_card_operand (name (1, name_size), operand);
            RETURN;
          IFEND;

          IF current_type_description^.kind = clc$keyword_type THEN
            check_for_and_handle_keyword (name);

{ check_for_and_handle_keyword exits evaluate_name_operand if the name is a keyword

          IFEND;

          IF name (1) = '$' THEN
            IF parse.unit.kind <> clc$lex_dot THEN
              IF number_allowed AND (parse.unit.kind <> clc$lex_left_parenthesis) THEN
                IF name (2, * ) = 'MAX' THEN
                  handle_$max;

{ handle_$max exits evaluate_name_operand

                ELSEIF name (2, * ) = 'MIN' THEN
                  handle_$min;

{ handle_$min exits evaluate_name_operand

                IFEND;
              ELSEIF (clc$date_time_type IN current_type_description^.kinds) AND (name (2, * ) = 'NOW') THEN
                handle_$now;

{ handle_$now exits evaluate_name_operand unless it finds a syntax error.  In that case it
{ returns here so that the error can get handled by more general logic.

              IFEND;
            IFEND;
            unknown_name_condition := cle$unknown_function;
          ELSE
            IF (clc$boolean_type IN current_type_description^.kinds) AND
                  (min_boolean_operand_name_size <= name_size) AND
                  (name_size <= max_boolean_operand_name_size) THEN
              IF name = 'NOT' THEN
                handle_not (operand);

{ handle_not EXITs from evaluate_operand

              IFEND;
              check_for_and_handle_boolean (name);

{ check_for_and_handle_boolean exits evaluate_name_operand if the name is a boolean constant

            IFEND;
            unknown_name_condition := cle$unknown_variable;
          IFEND;

          parse_index_after_name := parse.unit_index;

          dereference_name (name, operand);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

          IF operand <> NIL THEN
            CASE operand^.kind OF
            = clc$unspecified =
              IF operand_type_description = NIL THEN
                RETURN;
              IFEND;
              IF (operand_type_description^.kind = clc$union_type) AND
                    (operand_type_description^.member_descriptions <> NIL) THEN
                FOR i := 1 TO UPPERBOUND (operand_type_description^.member_descriptions^) DO
                  clp$validate_type_conformance (^operand_type_description^.member_descriptions^ [i],
                        current_type_description, type_conformance);
                  IF type_conformance >= clc$conforms_to_generic_type THEN
                    RETURN;
                  IFEND;
                FOREND;
              ELSEIF (current_type_description^.kind = clc$union_type) AND
                    (current_type_description^.member_descriptions <> NIL) THEN
                FOR i := 1 TO UPPERBOUND (current_type_description^.member_descriptions^) DO
                  clp$validate_type_conformance (^current_type_description^.member_descriptions^ [i],
                        operand_type_description, type_conformance);
                  IF type_conformance >= clc$conforms_to_generic_type THEN
                    RETURN;
                  IFEND;
                FOREND;
              IFEND;
              clp$validate_type_conformance (operand_type_description, current_type_description,
                    type_conformance);
              IF type_conformance >= clc$conforms_to_type THEN
                RETURN;
              IFEND;

*IF NOT $true(osv$unix)
            = clc$file =
              evaluate_file_operand (operand);
*ELSE
            = clc$nos_ve_file =
              evaluate_nos_ve_file_operand (operand);
*IFEND
            ELSE
              ;
            CASEND;

            CASE current_type_description^.kind OF

            = clc$keyword_type =
              CASE operand^.kind OF
              = clc$data_name =
                name := operand^.data_name_value;
              = clc$keyword =
                name := operand^.keyword_value;
              = clc$name =
                name := operand^.name_value;
              ELSE
                RETURN;
              CASEND;
              check_for_and_handle_keyword (name);

{ check_for_and_handle_keyword exits evaluate_name_operand if the name is a keyword

            = clc$name_type =
              IF (operand^.kind IN $clt$data_kinds [clc$name, clc$data_name, clc$keyword]) OR
                    (parse.unit_index <> parse_index_after_name) THEN
                RETURN;
              IFEND;

            = clc$program_name_type =
              IF (operand^.kind IN $clt$data_kinds [clc$cobol_name, clc$name, clc$data_name, clc$keyword,
                    clc$program_name, clc$string]) OR (parse.unit_index <> parse_index_after_name) THEN
                RETURN;
              IFEND;

            ELSE

              IF (operand^.kind = clc$name) AND (clc$boolean_type IN current_type_description^.kinds) THEN
                check_for_and_handle_boolean (operand^.name_value);

{ check_for_and_handle_boolean exits evaluate_name_operand if the name is a boolean constant

              IFEND;

              IF (clv$value_type_kinds [operand^.kind] IN current_type_description^.kinds) OR
                    (NOT (clc$name_type IN current_type_description^.kinds)) OR
                    (parse.unit_index <> parse_index_after_name) THEN
                RETURN;
              IFEND;

              CASE operand^.kind OF
              = clc$data_name =
                name := operand^.data_name_value;
              = clc$keyword =
                name := operand^.keyword_value;
              = clc$name =
                name := operand^.name_value;
              ELSE
                ;
              CASEND;
            CASEND;
          IFEND;

*IF NOT $true(osv$unix)
          IF ($clt$type_kinds [clc$application_type, clc$boolean_type, clc$cobol_name_type,
                clc$data_name_type, clc$file_type, clc$keyword_type, clc$name_type, clc$program_name_type,
                clc$statistic_code_type, clc$status_code_type] * current_type_description^.kinds) =
                $clt$type_kinds [] THEN
*ELSE
          IF ($clt$type_kinds_v2 [clc$application_type, clc$boolean_type, clc$cobol_name_type,
                clc$data_name_type, clc$nos_ve_file_type, clc$keyword_type, clc$name_type,
                clc$program_name_type, clc$statistic_code_type, clc$status_code_type, clc$unix_file_type] *
                current_type_description^.kinds) = $clt$type_kinds_v2 [] THEN
*IFEND
            IF (current_type_description^.kind = clc$keyword_type) AND
                  (NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot]))
                  THEN
              unknown_name_condition := cle$unknown_keyword;
            IFEND;
            osp$set_status_abnormal ('CL', unknown_name_condition, name, status);
            EXIT evaluate_expression;
          IFEND;

          clp$make_name_value (name, work_area, operand);
          IF operand = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

*IF NOT $true(osv$unix)
          IF (parse.unit.kind = clc$lex_dot) OR (parse.unit.kind = clc$lex_concatenate) THEN
*ELSE
          IF (parse.unit.kind = clc$lex_dot) OR (parse.unit.kind = clc$lex_concatenate) OR
                (parse.unit.kind = clc$lex_divide) THEN
*IFEND
            parse := saved_parse;
*IF NOT $true(osv$unix)
            evaluate_file_operand (operand);
*ELSE
            evaluate_nos_ve_file_operand (operand);
*IFEND
          IFEND;

        PROCEND evaluate_name_operand;
?? TITLE := 'evaluate_string_literal', EJECT ??

        PROCEDURE evaluate_string_literal;


          clp$make_sized_string_value (parse.unit.size - 2, work_area, operand);
          IF operand <> NIL THEN

            operand^.string_value^ (1, parse.unit.size - 2) :=
                  parse.text^ (parse.unit_index + 1, parse.unit.size - 2);

          /complete_string_literal/
            WHILE parse.unit_index < parse.index_limit DO
              clp$scan_any_lexical_unit (parse);
              CASE parse.unit.kind OF
              = clc$lex_string =
                RESET work_area TO operand^.string_value;
                NEXT operand^.string_value: [STRLENGTH (operand^.string_value^) + parse.unit.size - 1] IN
                      work_area;
                IF operand^.string_value = NIL THEN
                  RESET work_area TO operand;
                  operand := NIL;
                  EXIT /complete_string_literal/;
                IFEND;

                operand^.string_value^ (STRLENGTH (operand^.string_value^) - parse.unit.size + 2,
                      parse.unit.size - 1) := parse.text^ (parse.unit_index, parse.unit.size - 1);

              = clc$lex_unterminated_string =
                osp$set_status_abnormal ('CL', cle$missing_string_delimiter, parse.
                      text^ (parse.unit_index, parse.unit.size), status);
                EXIT evaluate_expression;
              ELSE
                operand_is_string_literal := TRUE;
                RETURN;
              CASEND;
            WHILEND /complete_string_literal/;
          IFEND;

          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;

        PROCEND evaluate_string_literal;
?? TITLE := 'evaluate_sub_expression', EJECT ??

{
{ NOTE:
{   This routine pre-scans for the closing right parenthesis of the
{   sub-expression in order to establish the "index_limit" for the sub-
{   expression.  This limit is required if the evaluation is being done
{   for a union (ANY) type.
{

        PROCEDURE evaluate_sub_expression;

          VAR
            ignore_sub_list_tail: ^clt$data_value,
            saved_parse: clt$parse_state,
            sub_parse: clt$parse_state,
            union_info: clt$union_type_information,
            union_type_description: clt$type_description;


          sub_parse := parse;
          clp$scan_bal_paren_lexical_unit (sub_parse);
          IF sub_parse.unit.kind <> clc$lex_right_parenthesis THEN
            osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, sub_parse, status);
            EXIT evaluate_expression;
          IFEND;

          parse.index_limit := sub_parse.unit_index;
          clp$scan_non_space_lexical_unit (parse);

{ If we are evaluating a string, then we must evaluate the expression within
{ the parenthesis as a union type in order to correctly process operators which
{ may be in the expression, i.e. string_var = 'hi'//(4+3).

          IF current_type_description^.kind = clc$string_type THEN
            union_type_description.specification := NIL;
            union_type_description.name := NIL;
            union_type_description.derived_from_value_kind_spec := FALSE;
            union_type_description.advanced_keywords_present := FALSE;
*IF NOT $true(osv$unix)
            union_type_description.kinds := -$clt$type_kinds [];
*ELSE
            union_type_description.kinds := -$clt$type_kinds_v2 [];
*IFEND
            union_type_description.kind := clc$union_type;
            union_type_description.member_descriptions := NIL;
            union_type_description.union_information := ^union_info;

            union_info.only_standard_types_in_union := TRUE;
            union_info.min_integer_value := clc$min_integer;
            union_info.max_integer_value := clc$max_integer;
            union_info.default_radix := 10;
*IF NOT $true(osv$unix)
            #UNCHECKED_CONVERSION (clv$negative_infinity^,
                  union_info.min_real_value.long_real);
            #UNCHECKED_CONVERSION (clv$positive_infinity^,
                  union_info.max_real_value.long_real);
*ELSE
            union_info.min_real_value.long_real := clv$negative_infinity^;
            union_info.max_real_value.long_real := clv$positive_infinity^;
*IFEND
          ELSE
            union_type_description := current_type_description^;
          IFEND;

          saved_parse := parse;
          evaluate_expression (parse, ^union_type_description, TRUE, list_expansion, numeric_info,
                operand, ignore_sub_list_tail, status);

{ If the status is abnormal, re-evaluate the subexpression as a string, in order
{ to get a more meaningful error message.

          IF NOT status.normal AND (status.condition = cle$expression_not_union_type) THEN
            parse := saved_parse;
            evaluate_expression (parse, current_type_description, TRUE,
                  list_expansion, numeric_info, operand, ignore_sub_list_tail,
                  status);
          IFEND;
          IF NOT status.normal THEN
            parse.index_limit := sub_parse.index_limit;
            EXIT evaluate_expression;
          IFEND;

          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          IF parse.unit_index < sub_parse.unit_index THEN
            osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            parse.index_limit := sub_parse.index_limit;
            EXIT evaluate_expression;
          IFEND;

          parse := sub_parse;
          clp$scan_any_lexical_unit (parse);

          numeric_info.sign := sign;

        PROCEND evaluate_sub_expression;
?? TITLE := 'evaluate_wild_card_operand', EJECT ??

        PROCEDURE evaluate_wild_card_operand
          (    first_component: string ( * <= osc$max_name_size);
           VAR operand: ^clt$data_value);


          osp$set_status_condition (cle$wild_card_not_allowed, status);
          EXIT evaluate_expression;

        PROCEND evaluate_wild_card_operand;
?? OLDTITLE, EJECT ??

        operand := NIL;
        operand_is_string_literal := FALSE;
        operand_type_description := NIL;

*IF NOT $true(osv$unix)
        number_allowed := (current_type_description^.kinds * $clt$type_kinds
              [clc$integer_type, clc$real_type, clc$boolean_type]) <> $clt$type_kinds [];
*ELSE
        number_allowed := (current_type_description^.kinds * $clt$type_kinds_v2
              [clc$integer_type, clc$real_type, clc$boolean_type]) <> $clt$type_kinds_v2 [];
*IFEND
        operand_was_signed := FALSE;
        sign := numeric_info.sign;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        IF number_allowed THEN
          WHILE parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract] DO
            operand_was_signed := TRUE;
            sign_representation := parse.text^ (parse.unit_index, parse.unit.size);
            IF parse.unit.kind = clc$lex_subtract THEN
              sign := -sign;
            IFEND;
            clp$scan_non_space_lexical_unit (parse);
          WHILEND;
        IFEND;

        CASE parse.unit.kind OF

*IF NOT $true(osv$unix)
        = clc$lex_colon, clc$lex_dot, clc$lex_concatenate =
          evaluate_file_operand (operand);
*ELSE
        = clc$lex_colon, clc$lex_dot, clc$lex_concatenate, clc$lex_divide =
          evaluate_nos_ve_file_operand (operand);
*IFEND

        = clc$lex_left_parenthesis =
          evaluate_sub_expression;

        = clc$lex_query, clc$lex_multiply =
          evaluate_wild_card_operand ('', operand);

        = clc$lex_name =
          evaluate_name_operand;

        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_expression;

        = clc$lex_string =
          evaluate_string_literal;

        = clc$lex_unterminated_string =
          osp$set_status_abnormal ('CL', cle$missing_string_delimiter, parse.
                text^ (parse.unit_index, parse.unit.size), status);
          EXIT evaluate_expression;

        = clc$lex_alpha_number, clc$lex_unsigned_decimal =
          clp$evaluate_numeric_literal (sign, numeric_info.radix.default, parse, number, status);
          IF NOT status.normal THEN
            IF NOT number_allowed THEN
              osp$set_status_abnormal ('CL', cle$improper_parameter_value, parse.
                    text^ (parse.previous_non_space_unit_index, parse.previous_non_space_unit.size),
                    status);
              EXIT evaluate_expression;
            ELSE
              EXIT evaluate_expression;
            IFEND;
          IFEND;
          clp$make_clt$number_value (number, work_area, operand);
          IF operand = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
          sign := 1;
          numeric_info.sign := 1;

        ELSE
          operand := NIL;
        CASEND;

        IF operand = NIL THEN
          osp$set_status_condition (cle$expecting_operand, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        ELSEIF operand^.kind IN $clt$data_kinds [clc$integer, clc$real] THEN
          complete_numeric_operand;
        ELSEIF operand_was_signed THEN
          osp$set_status_abnormal ('CL', cle$arithmetic_operand_not_num, sign_representation, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, operand, status);
          EXIT evaluate_expression;
        IFEND;

        recognize_binary_operator;

      PROCEND evaluate_operand;
?? TITLE := 'evaluate_parenthesized_list', EJECT ??

      PROCEDURE evaluate_parenthesized_list
        (    element_type_description: ^clt$type_description;
             type_description: ^clt$type_description;
             temp_result: ^clt$data_value;
             structure_kind: clt$data_kind;
             element_expansion: clt$list_expansion;
             initial_sub_list_tail: ^clt$data_value;
         VAR list_size {input, output} : clt$list_size;
         VAR result {input, output} : ^clt$data_value);

        VAR
          current_list_node: ^clt$data_value,
          evaluate_list_element: boolean,
          local_numeric_info: clt$numeric_operand_info,
          local_parse: clt$parse_state,
          sub_list_tail: ^clt$data_value;


        IF initial_sub_list_tail = NIL THEN
          current_list_node := result;
        ELSE
          current_list_node := initial_sub_list_tail;
        IFEND;
        evaluate_list_element := (list_size = 0) AND (parse.unit.kind <> clc$lex_right_parenthesis);

        WHILE TRUE DO
          IF evaluate_list_element THEN
            local_parse := parse;
            clp$scan_unnested_sep_lex_unit (clc$ignore_ellipsis, parse);
            local_parse.index_limit := parse.unit_index;
            local_numeric_info.initialized := FALSE;
            evaluate_expression (local_parse, element_type_description, FALSE, element_expansion,
                  local_numeric_info, current_list_node^.element_value, sub_list_tail, status);
            IF NOT status.normal THEN
              determine_structure_status (temp_result, structure_kind, type_description,
                    current_type_description, status);
              EXIT evaluate_expression;
            IFEND;

            IF sub_list_tail = NIL THEN
              list_size := list_size + 1;
            ELSE
              IF sub_list_tail = current_list_node^.element_value THEN
                list_size := list_size + 1;
                sub_list_tail := current_list_node;
              ELSE
                list_size := list_size + clp$count_list_elements (current_list_node^.element_value);
              IFEND;
              current_list_node^.link := current_list_node^.element_value^.link;
              current_list_node^.element_value := current_list_node^.element_value^.element_value;
              current_list_node := sub_list_tail;
            IFEND;

            IF local_parse.unit_is_space THEN
              clp$scan_non_space_lexical_unit (local_parse);
            IFEND;
            IF local_parse.unit_index < local_parse.index_limit THEN
              osp$set_status_condition (cle$expecting_end_of_expression, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, status);
              EXIT evaluate_expression;
            IFEND;

{ check for unspecified list element value

            IF (current_list_node^.element_value <> NIL) AND (current_list_node^.element_value^.kind =
                  clc$unspecified) THEN
              osp$set_status_abnormal ('CL', cle$unspecified_value_for_list, last_dereference_name, status);
              EXIT evaluate_expression;
            IFEND;

            IF parse.unit_is_space THEN
              clp$scan_non_space_lexical_unit (parse);
            IFEND;
          IFEND;

          CASE parse.unit.kind OF
          = clc$lex_right_parenthesis =
            clp$scan_any_lexical_unit (parse);
            recognize_binary_operator;
            RETURN;
          = clc$lex_comma =
            clp$scan_non_space_lexical_unit (parse);
          = clc$lex_end_of_line =
            IF (current_type_description^.kind <> clc$list_type) OR
                  (NOT current_type_description^.list_rest) THEN
              osp$set_status_condition (cle$expecting_rparen_of_list, status);
              EXIT evaluate_expression;
            IFEND;
            recognize_binary_operator;
            RETURN;
          ELSE
            IF NOT parse.previous_unit_is_space THEN
              osp$set_status_condition (cle$expecting_list_elem_sep, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_expression;
            IFEND;
          CASEND;

          clp$make_list_value (work_area, current_list_node^.link);
          IF current_list_node^.link = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
          current_list_node := current_list_node^.link;
          evaluate_list_element := TRUE;
        WHILEND;

      PROCEND evaluate_parenthesized_list;
?? TITLE := 'evaluate_program_name', EJECT ??

      PROCEDURE evaluate_program_name
        (VAR result: ^clt$data_value;
         VAR result_sub_list_tail: ^clt$data_value);

        VAR
          cobol_name_size: ost$name_size,
          is_cobol_name: boolean,
          is_only_cobol_name: boolean,
          program_name: pmt$program_name,
          program_name_size: clt$string_size,
          saved_parse: clt$parse_state;


        IF recognize_wild_cards THEN
          handle_wild_card_name (result, result_sub_list_tail);
          IF result <> NIL THEN
            RETURN;
          IFEND;
        IFEND;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        saved_parse := parse;

        WHILE (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_name, clc$lex_unsigned_decimal,
              clc$lex_alpha_number, clc$lex_subtract]) AND (parse.unit_index < parse.index_limit) DO
          clp$scan_any_lexical_unit (parse);
        WHILEND;

        IF parse.unit_index > saved_parse.unit_index THEN
          clp$recognize_cobol_name (parse.text^ (saved_parse.unit_index,
                parse.unit_index - saved_parse.unit_index), cobol_name_size, is_only_cobol_name,
                is_cobol_name);
          IF is_cobol_name AND is_only_cobol_name THEN
            #TRANSLATE (osv$lower_to_upper, parse.text^ (saved_parse.unit_index, cobol_name_size),
                  program_name);
            clp$make_program_name_value (program_name, work_area, result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            recognize_binary_operator;
            RETURN;
          IFEND;
          parse := saved_parse;
        IFEND;

        evaluate_operand (result);
        CASE result^.kind OF

        = clc$cobol_name =
          program_name := result^.cobol_name_value;

        = clc$data_name =
          program_name := result^.data_name_value;

        = clc$keyword =
          program_name := result^.keyword_value;

        = clc$name =
          program_name := result^.name_value;

        = clc$program_name =
          RETURN;

        = clc$string =
          evaluate_string_or_pattern (FALSE, result);
          program_name_size := clp$trimmed_string_size (result^.string_value^);
          IF program_name_size = 0 THEN
            osp$set_status_condition (cle$null_program_name, status);
            EXIT evaluate_expression;
          ELSEIF program_name_size > STRLENGTH (pmt$program_name) THEN
            osp$set_status_abnormal ('CL', cle$program_name_too_long, result^.string_value^, status);
            EXIT evaluate_expression;
          IFEND;
          program_name := result^.string_value^;

        = clc$unspecified =
          RETURN;

        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

        result^.kind := clc$program_name;
        result^.program_name_value := program_name;

      PROCEND evaluate_program_name;
?? TITLE := 'evaluate_range', EJECT ??

{
{ NOTE:
{   Unlike most other expression evaluators, the one for range types assumes
{   that the INDEX_LIMIT field of the CLT$PARSE_STATE designates the end of the
{   expression being evaluated.  This restriction is necessary in order for
{   this evaluator to recognize when its an expression is enclosed in
{   parentheses.
{

      PROCEDURE evaluate_range
        (VAR result: ^clt$data_value);

        VAR
          element_type_description: ^clt$type_description,
          high_value: ^clt$data_value,
          ignore_sub_list_tail: ^clt$data_value,
          local_numeric_info: clt$numeric_operand_info,
          local_parse: clt$parse_state,
          low_value: ^clt$data_value,
          result_conforms_to_element_type: boolean,
          result_conforms_to_type: boolean,
          local_result: ^clt$data_value,
          type_description: ^clt$type_description;

?? NEWTITLE := 'check_for_and_handle_sub_expr', EJECT ??

{
{ PURPOSE:
{   To check whether the range expression is (unnecessarily) parenthesized and
{   if so, to evaluate the sub-expression.  This routine is only called if the
{   expression starts with a left parenthesis.
{
{ NOTE 1:
{   If the expression ends with a right parenthesis that balances the left one
{   it begins with, the expression is treated as a sub-expression by
{   recursively calling evaluate_range to process the sub-expression (with the
{   parentheses removed).  Control is NOT returned to the caller in this case.
{

        PROCEDURE check_for_and_handle_sub_expr;

          VAR
            final_parse: clt$parse_state,
            right_parenthesis_index: clt$expression_text_index;


          clp$scan_bal_paren_lexical_unit (parse);
          IF parse.unit.kind <> clc$lex_right_parenthesis THEN
            RETURN;
          IFEND;
          right_parenthesis_index := parse.unit_index;

          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit_index < parse.index_limit THEN
            RETURN;
          IFEND;
          final_parse := parse;

          parse := local_parse;
          clp$scan_non_space_lexical_unit (parse);
          parse.index_limit := right_parenthesis_index;
          local_parse := parse;
          complete_range;
          IF operator.kind <> clc$not_an_operator THEN
            osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, operator.representation, status);
            EXIT evaluate_expression;
          IFEND;
          IF parse.unit_index < right_parenthesis_index THEN
            osp$set_status_condition (cle$expecting_end_of_expression, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          IFEND;
          parse := final_parse;
          recognize_binary_operator;

          EXIT evaluate_range;

        PROCEND check_for_and_handle_sub_expr;
?? TITLE := 'complete_range', EJECT ??

        PROCEDURE complete_range;


          IF current_type_description^.range_element_type_description <> NIL THEN
            element_type_description := current_type_description^.range_element_type_description;
          ELSE
            element_type_description := ^unqual_union_type_description;
          IFEND;

          result_conforms_to_type := FALSE;
          result_conforms_to_element_type := FALSE;
          type_description := NIL;
          local_result := NIL;
          operand_type_description := NIL;
          IF parse.unit.kind = clc$lex_name THEN
            check_for_variable_or_function (element_type_description, result_conforms_to_element_type,
                  result_conforms_to_type, type_description, result, ignore_sub_list_tail);
            IF result <> NIL THEN
              IF result_conforms_to_type THEN
                IF (current_type_description^.derived_from_value_kind_spec) THEN
                  convert_fs_file_ref_to_cl_file (result);
                IFEND;
                RETURN;
              IFEND;
              local_result := result;
              IF result_conforms_to_element_type AND (operator.kind = clc$not_an_operator) THEN
                low_value := result;
              IFEND;
            IFEND;
          IFEND;

          IF low_value = NIL THEN
            parse := local_parse;
            clp$scan_operand (clc$ellipsis, parse);
            local_parse.index_limit := parse.unit_index;
            local_numeric_info.initialized := FALSE;
            evaluate_expression (local_parse, element_type_description, FALSE, clc$no_expansion,
                  local_numeric_info, low_value, ignore_sub_list_tail, status);
            IF (NOT status.normal) THEN
              determine_structure_status (local_result, clc$range, type_description, current_type_description,
                    status);
              EXIT evaluate_expression;
            ELSEIF local_parse.unit_index < local_parse.index_limit THEN
              osp$set_status_condition (cle$expecting_end_of_expression, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, status);
              EXIT evaluate_expression;
            IFEND;
          IFEND;

          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;

          IF parse.unit.kind = clc$lex_ellipsis THEN

{ check low value for unspecified

            IF (low_value <> NIL) AND (low_value^.kind = clc$unspecified) THEN
              osp$set_status_abnormal ('CL', cle$unspecified_value_for_range, last_dereference_name, status);
              RETURN;
            IFEND;
            clp$scan_non_space_lexical_unit (parse);
            local_numeric_info.initialized := FALSE;
            evaluate_expression (parse, element_type_description, FALSE, clc$no_expansion,
                  local_numeric_info, high_value, ignore_sub_list_tail, status);
            IF NOT status.normal THEN
              determine_structure_status (local_result, clc$range, type_description, current_type_description,
                    status);
              EXIT evaluate_expression;
            IFEND;

{ check high value for unspecified

            IF (high_value <> NIL) AND (high_value^.kind = clc$unspecified) THEN
              osp$set_status_abnormal ('CL', cle$unspecified_value_for_range, last_dereference_name, status);
              RETURN;
            IFEND;
          ELSE

{ IF only one value is given and it is unspecified, then return with result^.kind=clc$unspecified

            IF (low_value <> NIL) AND (low_value^.kind = clc$unspecified) THEN
              RETURN;
            IFEND;
            high_value := low_value;
          IFEND;

          clp$make_range_value (work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

          result^.low_value := low_value;
          result^.high_value := high_value;

{ This call to recognize_binary_operator is not necessary because
{ evaluate_expression makes the call

{         recognize_binary_operator;

        PROCEND complete_range;
?? OLDTITLE, EJECT ??

        low_value := NIL;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        local_parse := parse;

        IF parse.unit.kind = clc$lex_left_parenthesis THEN
          check_for_and_handle_sub_expr;

{ Control is not returned if the expression is a sub-expression.

          parse := local_parse;
        IFEND;

        complete_range;

      PROCEND evaluate_range;
?? TITLE := 'evaluate_record', EJECT ??

      PROCEDURE evaluate_record
        (VAR result: ^clt$data_value);

        VAR
          field_number: clt$field_number,
          ignore_sub_list_tail: ^clt$data_value;

?? NEWTITLE := 'check_remaining_fields_optional', EJECT ??

        PROCEDURE check_remaining_fields_optional
          (    next_field_number: clt$field_number;
           VAR status: ost$status);


          FOR field_number := next_field_number TO current_type_description^.fields_pdt^.header^.
                number_of_parameters DO
            IF current_type_description^.fields_pdt^.parameters^ [field_number].requirement =
                  clc$required_field THEN
              osp$set_status_abnormal ('CL', cle$required_field_omitted,
                    current_type_description^.fields_pdt^.names^ [field_number].name, status);
              clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
              RETURN;
            IFEND;
          FOREND;

        PROCEND check_remaining_fields_optional;
?? TITLE := 'evaluate_field_list', EJECT ??

        PROCEDURE evaluate_field_list;

          VAR
            fields_evaluation_context: clt$parameter_eval_context,
            fields_parse: clt$parse_state,
            pvt: ^clt$parameter_value_table,
            record_name: clt$type_name;


          IF current_type_description^.name <> NIL THEN
            record_name := current_type_description^.name^;
          ELSE
            record_name := clv$type_kind_names [clc$record_type];
          IFEND;

          fields_parse := parse;
          clp$scan_bal_paren_lexical_unit (parse);
          IF parse.unit_index >= parse.index_limit THEN
            osp$set_status_abnormal ('CL', cle$expecting_rparen_of_flist, record_name, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          IFEND;
          fields_parse.index_limit := parse.unit_index;
          clp$scan_non_space_lexical_unit (fields_parse);
          clp$scan_any_lexical_unit (parse);

          PUSH pvt: [1 .. current_type_description^.fields_pdt^.header^.number_of_parameters];

          fields_evaluation_context.interpreter_mode := clc$interpret_mode;
          fields_evaluation_context.interactive_origin := FALSE;
          fields_evaluation_context.interaction_style := osc$line_interaction;
          fields_evaluation_context.prompting_requested := FALSE;
          fields_evaluation_context.command_or_function_name := record_name;
          fields_evaluation_context.command_or_function := clc$function;
          fields_evaluation_context.procedure_parameters := FALSE;
          fields_evaluation_context.command_or_function_source := NIL;

          clp$internal_evaluate_params (fields_evaluation_context, current_type_description^.fields_pdt^, NIL,
                fields_parse, work_area, pvt, status);
          IF NOT status.normal THEN
            IF status.condition = cle$expecting_rparen_of_plist THEN
              status.condition := cle$expecting_rparen_of_flist;
            ELSEIF status.condition = cle$only_string_literal_for_par THEN
              status.condition := cle$only_string_literal_for_fld;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            ELSEIF status.condition = cle$param_expr_not_union_type THEN
              status.condition := cle$field_expr_not_union_type;
            ELSEIF status.condition = cle$required_parameter_omitted THEN
              status.condition := cle$required_field_omitted;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            ELSEIF status.condition = cle$required_parameter_unspec THEN
              status.condition := cle$required_field_unspecified;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            ELSEIF status.condition = cle$too_many_parameters THEN
              status.condition := cle$too_many_fields;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            ELSEIF status.condition = cle$unexpected_in_param_list THEN
              status.condition := cle$unexpected_in_field_list;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            ELSEIF status.condition = cle$unknown_parameter_keyword THEN
              status.condition := cle$unknown_field_keyword;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            ELSEIF status.condition = cle$wrong_kind_of_param_value THEN
              status.condition := cle$wrong_kind_of_field_value;
              osp$append_status_parameter (osc$status_parameter_delimiter, record_name, status);
            IFEND;
            EXIT evaluate_expression;
          IFEND;

          FOR field_number := 1 TO current_type_description^.fields_pdt^.header^.number_of_parameters DO
            result^.field_values^ [field_number].value := pvt^ [field_number].value;
          FOREND;

        PROCEND evaluate_field_list;
?? OLDTITLE, EJECT ??

        VAR
          local_numeric_info: clt$numeric_operand_info,
          local_parse: clt$parse_state,
          local_result: ^clt$data_value,
          result_conforms_to_element_type: boolean,
          result_conforms_to_type: boolean,
          type_description: ^clt$type_description;


        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        local_parse := parse;

        result := NIL;
        result_conforms_to_type := FALSE;
        result_conforms_to_element_type := FALSE;
        operand_type_description := NIL;
        type_description := NIL;

        IF parse.unit.kind = clc$lex_name THEN
          check_for_variable_or_function (^current_type_description^.fields_pdt^.type_descriptions^ [1],
                result_conforms_to_element_type, result_conforms_to_type, type_description, result,
                ignore_sub_list_tail);
          IF (result <> NIL) AND result_conforms_to_type THEN
            RETURN;
          IFEND;
        IFEND;

        local_result := result;

        clp$make_record_value (current_type_description^.fields_pdt^.header^.number_of_parameters, work_area,
              result);
        IF result = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;
        IFEND;

        FOR field_number := 1 TO current_type_description^.fields_pdt^.header^.number_of_parameters DO
          result^.field_values^ [field_number].name := current_type_description^.fields_pdt^.
                names^ [field_number].name;
          result^.field_values^ [field_number].value := NIL;
        FOREND;

{ If the value is unspecified, the first field is NIL and all fields are checked for 'optional'

        IF result_conforms_to_element_type AND (operator.kind = clc$not_an_operator) THEN
          IF local_result^.kind = clc$unspecified THEN
            check_remaining_fields_optional (1, status);
          ELSE
            result^.field_values^ [1].value := local_result;
            check_remaining_fields_optional (2, status);
          IFEND;
          RETURN;
        IFEND;

        parse := local_parse;
        IF parse.unit.kind = clc$lex_left_parenthesis THEN
          evaluate_field_list;
        ELSE
          local_numeric_info.initialized := FALSE;
          evaluate_expression (parse, ^current_type_description^.fields_pdt^.type_descriptions^ [1], FALSE,
                clc$no_expansion, local_numeric_info, result^.field_values^ [1].value, ignore_sub_list_tail,
                status);
          IF status.normal THEN
            check_remaining_fields_optional (2, status);
          IFEND;
          IF (NOT status.normal) THEN
            determine_structure_status (local_result, clc$record, type_description, current_type_description,
                  status);
            EXIT evaluate_expression;
          IFEND;
        IFEND;

        recognize_binary_operator;

      PROCEND evaluate_record;
?? TITLE := 'evaluate_scu_line_identifier', EJECT ??

      PROCEDURE evaluate_scu_line_identifier
        (VAR result: ^clt$data_value);

        VAR
          line_identifier: clt$scu_line_identifier,
          number: integer,
          saved_parse: clt$parse_state;


        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_expression;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        CASEND;

        saved_parse := parse;

      /line_identifier_literal/
        BEGIN
          clp$scan_any_lexical_unit (parse);
          IF parse.unit.kind <> clc$lex_dot THEN
            EXIT /line_identifier_literal/;
          IFEND;
          clp$scan_any_lexical_unit (parse);
          CASE parse.unit.kind OF
          = clc$lex_unsigned_decimal =
            ;
          = clc$lex_name, clc$lex_long_name =
            EXIT /line_identifier_literal/;
          ELSE
            osp$set_status_condition (cle$expecting_sequence_number, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          CASEND;

          clp$evaluate_unsigned_decimal (parse.text^ (parse.unit_index, parse.unit.size), number, status);
          clp$scan_any_lexical_unit (parse);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          ELSEIF saved_parse.unit.size > clc$max_scu_modification_name THEN
            osp$set_status_abnormal ('CL', cle$modification_name_too_long, parse.
                  text^ (saved_parse.unit_index, saved_parse.unit.size), status);
            osp$append_status_integer (osc$status_parameter_delimiter, saved_parse.unit.size, 10, FALSE,
                  status);
            EXIT evaluate_expression;
          ELSEIF (number < 1) OR (number > clc$max_scu_sequence_number) THEN
            osp$set_status_condition (cle$sequence_num_out_of_range, status);
            osp$append_status_integer (osc$status_parameter_delimiter, number, 10, FALSE, status);
            EXIT evaluate_expression;
          IFEND;

          #TRANSLATE (osv$lower_to_upper, parse.text^ (saved_parse.unit_index, saved_parse.unit.size),
                line_identifier.modification_name);
          line_identifier.sequence_number := number;
          clp$make_scu_line_id_value (line_identifier, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

          recognize_binary_operator;
          RETURN;
        END /line_identifier_literal/;

        parse := saved_parse;


        evaluate_operand (result);

        CASE result^.kind OF
        = clc$scu_line_identifier =
          ;
        = clc$unspecified =
          ;
        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_scu_line_identifier;
?? TITLE := 'evaluate_statistic_code', EJECT ??

      PROCEDURE evaluate_statistic_code
        (VAR result: ^clt$data_value);

        VAR
          converted: boolean,
          statistic_code: sft$statistic_code;


        evaluate_operand (result);

        CASE result^.kind OF

        = clc$integer =
          IF (result^.integer_value.value < 0) OR (result^.integer_value.value > sfc$max_statistic_code) THEN
            osp$set_status_condition (cle$statistic_code_out_of_range, status);
            osp$append_status_integer (osc$status_parameter_delimiter, result^.integer_value.value, 16, TRUE,
                  status);
            EXIT evaluate_expression;
          IFEND;
          statistic_code := result^.integer_value.value;

        = clc$name =
          convert_string_to_stat_code (result^.name_value, FALSE, statistic_code, converted);
          IF NOT converted THEN
            osp$set_status_abnormal ('CL', cle$unrecognizable_statist_name, result^.name_value, status);
            EXIT evaluate_expression;
          IFEND;

        = clc$statistic_code =
          RETURN;

        = clc$string =
          convert_string_to_stat_code (result^.string_value^, TRUE, statistic_code, converted);
          IF NOT converted THEN
            osp$set_status_abnormal ('CL', cle$unrecognizable_statist_str, result^.string_value^, status);
            EXIT evaluate_expression;
          IFEND;

        = clc$unspecified =
          RETURN;

        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

        result^.kind := clc$statistic_code;
        result^.statistic_code_value := statistic_code;

      PROCEND evaluate_statistic_code;
?? TITLE := 'evaluate_status', EJECT ??

      PROCEDURE evaluate_status
        (VAR result: ^clt$data_value);


        evaluate_operand (result);

        CASE result^.kind OF

        = clc$status =
          ;

        = clc$unspecified =
          ;

        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_status;
?? TITLE := 'evaluate_status_code', EJECT ??

      PROCEDURE evaluate_status_code
        (VAR result: ^clt$data_value);

        VAR
          converted: boolean,
          status_code: ost$status_condition_code;


        evaluate_operand (result);

        CASE result^.kind OF

        = clc$integer =
          IF (result^.integer_value.value < 0) OR (result^.integer_value.value >
                osc$max_status_condition_code) THEN
            osp$set_status_condition (cle$status_code_out_of_range, status);
            osp$append_status_integer (osc$status_parameter_delimiter, result^.integer_value.value, 16, TRUE,
                  status);
            EXIT evaluate_expression;
          IFEND;
          status_code := result^.integer_value.value;

        = clc$name =
          convert_string_to_stat_code (result^.name_value, FALSE, status_code, converted);
          IF NOT converted THEN
            osp$get_status_condition_code (result^.name_value, status_code, status);
            IF (NOT status.normal) OR (status_code = 0) THEN
              IF (clp$trimmed_string_size (result^.name_value) >= 4) AND
                    (result^.name_value (3) = 'E') AND ((result^.name_value (4) = '$') OR
                    (result^.name_value (4) = '#')) THEN
                osp$set_status_abnormal ('CL', cle$unknown_status_code_name, result^.name_value, status);
              ELSE
                osp$set_status_abnormal ('CL', cle$unrecognizable_status_name, result^.name_value, status);
              IFEND;
              EXIT evaluate_expression;
            IFEND;
          IFEND;

        = clc$status_code =
          RETURN;

        = clc$string =
          convert_string_to_stat_code (result^.string_value^, TRUE, status_code, converted);
          IF NOT converted THEN
            osp$set_status_abnormal ('CL', cle$unrecognizable_status_str, result^.string_value^, status);
            EXIT evaluate_expression;
          IFEND;

        = clc$unspecified =
          RETURN;

        ELSE
          osp$set_status_condition (cle$wrong_kind_of_value, status);
          clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;
        CASEND;

        result^.kind := clc$status_code;
        result^.status_code_value := status_code;

      PROCEND evaluate_status_code;
?? TITLE := 'evaluate_string_or_pattern', EJECT ??

      PROCEDURE evaluate_string_or_pattern
        (    finalize_result: boolean;
         VAR result {input, output} : ^clt$data_value);

?? NEWTITLE := 'complete_string_or_pattern', EJECT ??

        PROCEDURE complete_string_or_pattern;

          VAR
            pattern_string: ^clt$string_value;


          CASE result^.kind OF

          = clc$string =
            IF current_type_description^.kind = clc$string_type THEN
              IF STRLENGTH (result^.string_value^) > current_type_description^.max_string_size THEN
                osp$set_status_condition (cle$string_value_too_long, status);
                osp$append_status_integer (osc$status_parameter_delimiter,
                      current_type_description^.max_string_size, 10, FALSE, status);
                osp$append_status_integer (osc$status_parameter_delimiter, STRLENGTH (result^.string_value^),
                      10, FALSE, status);
                clp$append_status_string (osc$status_parameter_delimiter, result^.string_value^, status);
                EXIT evaluate_expression;
              ELSEIF STRLENGTH (result^.string_value^) < current_type_description^.min_string_size THEN
                osp$set_status_condition (cle$string_value_too_short, status);
                osp$append_status_integer (osc$status_parameter_delimiter,
                      current_type_description^.min_string_size, 10, FALSE, status);
                osp$append_status_integer (osc$status_parameter_delimiter, STRLENGTH (result^.string_value^),
                      10, FALSE, status);
                clp$append_status_string (osc$status_parameter_delimiter, result^.string_value^, status);
                EXIT evaluate_expression;
              IFEND;
              EXIT evaluate_string_or_pattern;
            IFEND;

            pattern_string := result^.string_value;
            clp$make_value (clc$string_pattern, work_area, result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            clp$sp_string_literal (pattern_string, TRUE, work_area, result^.string_pattern_value, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;

          = clc$string_pattern =
            IF current_type_description^.kind = clc$string_pattern_type THEN
              EXIT evaluate_string_or_pattern;
            IFEND;
            osp$set_status_condition (cle$wrong_kind_of_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;

          = clc$unspecified =
            ;

          ELSE
            osp$set_status_condition (cle$wrong_kind_of_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

        PROCEND complete_string_or_pattern;
?? TITLE := 'handle_concatenate', EJECT ??

        PROCEDURE handle_concatenate
          (VAR result: ^clt$data_value);

          VAR
            current_operator_representation: clt$operator_representation,
            left_operand: ^clt$data_value,
            result_size: integer,
            right_operand: ^clt$data_value,
            right_string: ^clt$string_value;

?? NEWTITLE := 'convert_right_operand_to_string', EJECT ??

          PROCEDURE convert_right_operand_to_string;

            VAR
              representation: ^clt$data_representation,
              request: clt$convert_to_string_request,
              right_string_size: ^clt$string_size,
              string_count: ^clt$data_representation_count;


            right_string := NIL;

            request.initial_indentation := 0;
            request.continuation_indentation := 0;
            request.max_string := clc$max_string_size;
            request.include_advanced_items := TRUE;
            request.include_hidden_items := TRUE;
            request.kind := clc$convert_data_value;
            request.representation_option := clc$data_elem_representation;
            request.value := right_operand;
            clp$internal_convert_to_string (request, work_area, representation, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            NEXT string_count IN representation;
            IF string_count^ <> 1 THEN
              RETURN;
            IFEND;

            NEXT right_string_size IN representation;
            NEXT right_string: [right_string_size^] IN representation;

          PROCEND convert_right_operand_to_string;
?? OLDTITLE, EJECT ??

          CASE result^.kind OF
          = clc$string =
            ;
          = clc$string_pattern =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
            EXIT evaluate_expression;
          ELSE
            osp$set_status_condition (cle$concat_left_op_not_str, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

          WHILE operator.kind = clc$string_operator DO
            current_operator_representation := operator.representation;

            CASE parse.unit.kind OF
            = clc$lex_add, clc$lex_subtract =
              right_operand := NIL;
              evaluate_number (FALSE, right_operand);
            ELSE
              evaluate_operand (right_operand);
              IF operator.kind = clc$arithmetic_operator THEN
                evaluate_number (FALSE, right_operand);
              IFEND;
            CASEND;

            CASE right_operand^.kind OF
            = clc$string =
              right_string := right_operand^.string_value;
            = clc$string_pattern =
              right_string := NIL;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, current_operator_representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              convert_right_operand_to_string;
              IF right_string = NIL THEN
                osp$set_status_condition (cle$concat_right_op_not_str, status);
                clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
                EXIT evaluate_expression;
              IFEND;
            CASEND;

            left_operand := result;

            IF (left_operand^.kind = clc$string) AND (right_string <> NIL) THEN
              result_size := STRLENGTH (left_operand^.string_value^) + STRLENGTH (right_string^);
              IF result_size > clc$max_string_size THEN
                osp$set_status_condition (cle$concatenated_str_too_long, status);
                EXIT evaluate_expression;
              IFEND;
              clp$make_sized_string_value (result_size, work_area, result);
              IF result = NIL THEN
                osp$set_status_condition (cle$work_area_overflow, status);
                EXIT evaluate_expression;
              IFEND;
              result^.string_value^ (1, STRLENGTH (left_operand^.string_value^)) :=
                    left_operand^.string_value^;
              result^.string_value^ (STRLENGTH (left_operand^.string_value^) + 1,
                    STRLENGTH (right_string^)) := right_string^;

            ELSE
              clp$make_value (clc$string_pattern, work_area, result);
              IF result = NIL THEN
                osp$set_status_condition (cle$work_area_overflow, status);
                EXIT evaluate_expression;
              IFEND;
              IF left_operand^.kind = clc$string THEN
                clp$sp_string_concat_pattern (left_operand^.string_value,
                      right_operand^.string_pattern_value, work_area, result^.string_pattern_value, status);
              ELSEIF right_string <> NIL THEN
                clp$sp_pattern_concat_string (left_operand^.string_pattern_value, right_string, work_area,
                      result^.string_pattern_value, status);
              ELSE
                clp$sp_pattern_concat_pattern (left_operand^.string_pattern_value,
                      right_operand^.string_pattern_value, work_area, result^.string_pattern_value, status);
              IFEND;
              IF NOT status.normal THEN
                EXIT evaluate_expression;
              IFEND;
            IFEND;

          WHILEND;

        PROCEND handle_concatenate;
?? OLDTITLE, EJECT ??

        IF result = NIL THEN
          evaluate_operand (result);
        IFEND;

        IF (current_type_description^.kind = clc$string_type) AND current_type_description^.literal AND
              ((NOT operand_is_string_literal) OR (operator.kind = clc$string_operator)) THEN
          osp$set_status_condition (cle$only_string_literal_allowed, status);
          EXIT evaluate_expression;
        IFEND;

        IF operator.kind = clc$string_operator THEN
          handle_concatenate (result);
        IFEND;

        IF finalize_result AND (NOT evaluating_sub_expression) THEN
          complete_string_or_pattern;
        IFEND;

      PROCEND evaluate_string_or_pattern;
?? TITLE := 'evaluate_time_increment', EJECT ??

      PROCEDURE evaluate_time_increment
        (VAR result: ^clt$data_value);

        VAR
          right_operand: ^clt$data_value,
          time_increment: pmt$time_increment;

?? NEWTITLE := 'combine_time_increments', EJECT ??

        PROCEDURE combine_time_increments;

?? NEWTITLE := 'add_to_time_increment', EJECT ??

          PROCEDURE add_to_time_increment;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'arithmetic_condition_handler', EJECT ??

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


              IF (condition.selector = pmc$system_conditions) AND
                    (pmc$arithmetic_overflow IN condition.system_conditions) THEN
                osp$set_status_condition (pme$compute_overflow, status);
                EXIT evaluate_expression;
              IFEND;

              pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

            PROCEND arithmetic_condition_handler;
?? OLDTITLE, EJECT ??

            osp$establish_condition_handler (^arithmetic_condition_handler, FALSE);
*IFEND

            result^.time_increment_value^.year := result^.time_increment_value^.year +
                  right_operand^.time_increment_value^.year;
            result^.time_increment_value^.month := result^.time_increment_value^.month +
                  right_operand^.time_increment_value^.month;
            result^.time_increment_value^.day := result^.time_increment_value^.day +
                  right_operand^.time_increment_value^.day;
            result^.time_increment_value^.hour := result^.time_increment_value^.hour +
                  right_operand^.time_increment_value^.hour;
            result^.time_increment_value^.minute := result^.time_increment_value^.minute +
                  right_operand^.time_increment_value^.minute;
            result^.time_increment_value^.second := result^.time_increment_value^.second +
                  right_operand^.time_increment_value^.second;
            result^.time_increment_value^.millisecond := result^.time_increment_value^.millisecond +
                  right_operand^.time_increment_value^.millisecond;

          PROCEND add_to_time_increment;
?? TITLE := 'subtract_from_time_increment', EJECT ??

          PROCEDURE subtract_from_time_increment;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'arithmetic_condition_handler', EJECT ??

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


              IF (condition.selector = pmc$system_conditions) AND
                    (pmc$arithmetic_overflow IN condition.system_conditions) THEN
                osp$set_status_condition (pme$compute_overflow, status);
                EXIT evaluate_expression;
              IFEND;

              pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

            PROCEND arithmetic_condition_handler;
?? OLDTITLE, EJECT ??

            osp$establish_condition_handler (^arithmetic_condition_handler, FALSE);
*IFEND


            result^.time_increment_value^.year := result^.time_increment_value^.year -
                  right_operand^.time_increment_value^.year;
            result^.time_increment_value^.month := result^.time_increment_value^.month -
                  right_operand^.time_increment_value^.month;
            result^.time_increment_value^.day := result^.time_increment_value^.day -
                  right_operand^.time_increment_value^.day;
            result^.time_increment_value^.hour := result^.time_increment_value^.hour -
                  right_operand^.time_increment_value^.hour;
            result^.time_increment_value^.minute := result^.time_increment_value^.minute -
                  right_operand^.time_increment_value^.minute;
            result^.time_increment_value^.second := result^.time_increment_value^.second -
                  right_operand^.time_increment_value^.second;
            result^.time_increment_value^.millisecond := result^.time_increment_value^.millisecond -
                  right_operand^.time_increment_value^.millisecond;

          PROCEND subtract_from_time_increment;
?? OLDTITLE, EJECT ??

          VAR
            current_operator: clt$operator;


          REPEAT
            IF parse.unit.kind = clc$lex_left_parenthesis THEN
              osp$set_status_abnormal ('CL', cle$expecting_time_incr_operand, current_operator.representation,
                    status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_expression;
            IFEND;

            current_operator := operator;

            evaluate_operand (right_operand);

            CASE right_operand^.kind OF
            = clc$time_increment =
              ;
            = clc$unspecified =
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, current_operator.representation,
                    status);
              EXIT evaluate_expression;
            ELSE
              osp$set_status_abnormal ('CL', cle$expecting_time_incr_operand, current_operator.representation,
                    status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_expression;
            CASEND;

            IF current_operator.arithmetic_kind = clc$lex_add THEN
              add_to_time_increment;
            ELSE
              subtract_from_time_increment;
            IFEND;

{ This is commented out in order to prevent clobbering of LAST_DEREFERENCE_NAME.
{           RESET work_area TO right_operand;

          UNTIL (operator.kind <> clc$arithmetic_operator) OR
                (NOT (operator.arithmetic_kind IN $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]));

        PROCEND combine_time_increments;
?? TITLE := 'evaluate_date_time_difference', EJECT ??

        PROCEDURE evaluate_date_time_difference;

          VAR
            operator_representation: clt$operator_representation;


          IF (operator.kind <> clc$arithmetic_operator) OR (operator.arithmetic_kind <> clc$lex_subtract) THEN
            osp$set_status_condition (cle$expecting_date_time_subtrct, status);
            IF operator.kind = clc$not_an_operator THEN
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            ELSE
              osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
            IFEND;
            EXIT evaluate_expression;
          ELSEIF parse.unit.kind = clc$lex_left_parenthesis THEN
            osp$set_status_abnormal ('CL', cle$expecting_date_time_operand, operator_representation, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          IFEND;

          operator_representation := operator.representation;

          evaluate_operand (right_operand);

          CASE right_operand^.kind OF
          = clc$date_time =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, operator_representation, status);
            EXIT evaluate_expression;
          ELSE
            osp$set_status_abnormal ('CL', cle$expecting_date_time_operand, operator.representation, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          CASEND;

          pmp$compute_date_time_increment (right_operand^.date_time_value.value,
                result^.date_time_value.value, time_increment, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

{ This is commented out in order to prevent clobbering of LAST_DEREFERENCE_NAME.
{         RESET work_area TO result;

          clp$make_time_increment_value (^time_increment, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

        PROCEND evaluate_date_time_difference;
?? TITLE := 'evaluate_time_zone_difference', EJECT ??

        PROCEDURE evaluate_time_zone_difference;

?? NEWTITLE := 'subtract_time_zones', EJECT ??

          PROCEDURE subtract_time_zones;

            CONST
              hours_per_day = 24,
              minutes_per_hour = 60;


            time_increment.year := 0;
            time_increment.month := 0;
            time_increment.day := 0;
            time_increment.hour := (result^.time_zone_value.hours_from_gmt +
                  $INTEGER (result^.time_zone_value.daylight_saving_time)) -
                  (right_operand^.time_zone_value.hours_from_gmt +
                  $INTEGER (right_operand^.time_zone_value.daylight_saving_time));
            time_increment.minute := result^.time_zone_value.minutes_offset -
                  right_operand^.time_zone_value.minutes_offset;
            time_increment.second := 0;
            time_increment.millisecond := 0;

            time_increment.hour := (time_increment.hour + (time_increment.minute DIV minutes_per_hour)) MOD
                  hours_per_day;
            time_increment.minute := time_increment.minute MOD minutes_per_hour;

          PROCEND subtract_time_zones;
?? OLDTITLE, EJECT ??

          VAR
            operator_representation: clt$operator_representation;


          IF (operator.kind <> clc$arithmetic_operator) OR (operator.arithmetic_kind <> clc$lex_subtract) THEN
            osp$set_status_condition (cle$expecting_time_zone_subtrct, status);
            IF operator.kind = clc$not_an_operator THEN
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            ELSE
              osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
            IFEND;
            EXIT evaluate_expression;
          ELSEIF parse.unit.kind = clc$lex_left_parenthesis THEN
            osp$set_status_abnormal ('CL', cle$expecting_time_zone_operand, operator_representation, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          IFEND;

          operator_representation := operator.representation;

          evaluate_operand (right_operand);

          CASE right_operand^.kind OF
          = clc$time_zone =
            ;
          = clc$unspecified =
            osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, operator_representation, status);
            EXIT evaluate_expression;
          ELSE
            osp$set_status_abnormal ('CL', cle$expecting_time_zone_operand, operator_representation, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          CASEND;

          subtract_time_zones;

{ This is commented out in order to prevent clobbering of LAST_DEREFERENCE_NAME.
{         RESET work_area TO result;

          clp$make_time_increment_value (^time_increment, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

        PROCEND evaluate_time_zone_difference;
?? OLDTITLE, EJECT ??

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF

        = clc$lex_name, clc$lex_long_name =
          evaluate_operand (result);
          CASE result^.kind OF

          = clc$date_time =
            evaluate_date_time_difference;

          = clc$time_increment =
            IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind IN
                  $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]) THEN
              combine_time_increments;
            IFEND;

          = clc$time_zone =
            evaluate_time_zone_difference;

          = clc$unspecified =
            IF (operator.kind = clc$arithmetic_operator) AND (operator.arithmetic_kind IN
                  $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract]) THEN
              osp$set_status_abnormal ('CL', cle$unexpected_oper_for_unspec, last_dereference_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, operator.representation, status);
              EXIT evaluate_expression;
            IFEND;

          ELSE
            osp$set_status_condition (cle$wrong_kind_of_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

        = clc$lex_unsigned_decimal, clc$lex_left_parenthesis, clc$lex_subtract, clc$lex_colon, clc$lex_dot =
          time_increment.year := 0;
          time_increment.month := 0;
          time_increment.day := 0;
          time_increment.hour := 0;
          time_increment.minute := 0;
          time_increment.second := 0;
          time_increment.millisecond := 0;
          clp$make_time_increment_value (^time_increment, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
          evaluate_date_time_literal (result, NIL);

        ELSE
          osp$set_status_condition (cle$expecting_time_incr_expr, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_time_increment;
?? TITLE := 'evaluate_time_zone', EJECT ??

      PROCEDURE evaluate_time_zone
        (VAR result: ^clt$data_value);

?? NEWTITLE := 'evaluate_time_zone_literal', EJECT ??

        PROCEDURE evaluate_time_zone_literal;

          VAR
            component: integer,
            start_index: clt$string_index,
            time_zone: ost$time_zone;

?? NEWTITLE := 'evaluate_dst_expression', EJECT ??

          PROCEDURE evaluate_dst_expression;

            VAR
              value: clt$boolean;


            clp$scan_non_space_lexical_unit (parse);

            clp$evaluate_boolean_expression (work_area, parse, value, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;

            IF parse.unit.kind <> clc$lex_right_parenthesis THEN
              osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_expression;
            IFEND;

            time_zone.daylight_saving_time := value.value;

          PROCEND evaluate_dst_expression;
?? TITLE := 'evaluate_dst_keyword', EJECT ??

          PROCEDURE evaluate_dst_keyword;

            VAR
              keyword: clt$keyword;


            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), keyword);
            IF (keyword = 'DAYLIGHT_SAVING_TIME') OR (keyword = 'DST') THEN
              time_zone.daylight_saving_time := TRUE;
            ELSEIF (keyword = 'STANDARD_TIME') OR (keyword = 'ST') THEN
              time_zone.daylight_saving_time := FALSE;
            ELSE
              unrecognizable;
            IFEND;

          PROCEND evaluate_dst_keyword;
?? TITLE := 'evaluate_integer_expression', EJECT ??

          PROCEDURE evaluate_integer_expression;

            VAR
              value: clt$integer;


            clp$scan_non_space_lexical_unit (parse);

            clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, parse, value,
                  status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;

            IF parse.unit.kind <> clc$lex_right_parenthesis THEN
              osp$set_status_condition (cle$expecting_rparen_of_subexpr, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_expression;
            IFEND;

            component := value.value;

          PROCEND evaluate_integer_expression;
?? TITLE := 'evaluate_signed_decimal', EJECT ??

          PROCEDURE evaluate_signed_decimal;

            VAR
              negative: boolean;


            negative := parse.unit.kind = clc$lex_subtract;

            clp$scan_any_lexical_unit (parse);

            evaluate_unsigned_decimal;

            IF negative THEN
              component := -component;
            IFEND;

          PROCEND evaluate_signed_decimal;
?? TITLE := 'evaluate_unsigned_decimal', EJECT ??

          PROCEDURE evaluate_unsigned_decimal;


            clp$evaluate_unsigned_decimal (parse.text^ (parse.unit_index, parse.unit.size), component,
                  status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;

          PROCEND evaluate_unsigned_decimal;
?? TITLE := 'impossible', EJECT ??

          PROCEDURE impossible;


            osp$set_status_abnormal ('CL', cle$impossible_time_zone, parse.
                  text^ (start_index, parse.unit_index - start_index), status);
            EXIT evaluate_expression;

          PROCEND impossible;
?? TITLE := 'unrecognizable', EJECT ??

          PROCEDURE unrecognizable;


            osp$set_status_abnormal ('CL', cle$unrecognizable_time_zone, parse.
                  text^ (start_index, parse.index_limit - start_index), status);
            EXIT evaluate_expression;

          PROCEND unrecognizable;
?? OLDTITLE, EJECT ??

          start_index := parse.unit_index;

{ Handle hours_from_gmt (Greenwich Mean Time) component.

          CASE parse.unit.kind OF
          = clc$lex_left_parenthesis =
            evaluate_integer_expression;
          = clc$lex_unsigned_decimal =
            evaluate_unsigned_decimal;
          = clc$lex_add, clc$lex_subtract =
            evaluate_signed_decimal;
          ELSE
            unrecognizable;
          CASEND;
          IF (component < LOWERVALUE (time_zone.hours_from_gmt)) OR
                (component > UPPERVALUE (time_zone.hours_from_gmt)) THEN
            impossible;
          IFEND;
          time_zone.hours_from_gmt := component;
          clp$scan_any_lexical_unit (parse);

{ Handle minutes_offset component.

          IF parse.unit.kind = clc$lex_colon THEN
            clp$scan_any_lexical_unit (parse);
            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_integer_expression;
            = clc$lex_unsigned_decimal =
              evaluate_unsigned_decimal;
            = clc$lex_add, clc$lex_subtract =
              evaluate_signed_decimal;
            ELSE
              unrecognizable;
            CASEND;
            IF (component < LOWERVALUE (time_zone.minutes_offset)) OR
                  (component > UPPERVALUE (time_zone.minutes_offset)) THEN
              impossible;
            IFEND;
            time_zone.minutes_offset := component;
            clp$scan_any_lexical_unit (parse);
          ELSE
            time_zone.minutes_offset := 0;
          IFEND;

{ Handle daylight_saving_time component.

          IF parse.unit.kind = clc$lex_dot THEN
            clp$scan_any_lexical_unit (parse);
            CASE parse.unit.kind OF
            = clc$lex_left_parenthesis =
              evaluate_dst_expression;
            = clc$lex_name, clc$lex_long_name =
              evaluate_dst_keyword;
            ELSE
              unrecognizable;
            CASEND;
            clp$scan_any_lexical_unit (parse);
          ELSE
            time_zone.daylight_saving_time := FALSE;
          IFEND;


          clp$make_time_zone_value (time_zone, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

          recognize_binary_operator;

        PROCEND evaluate_time_zone_literal;
?? OLDTITLE, EJECT ??

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF

        = clc$lex_name, clc$lex_long_name =
          evaluate_operand (result);
          CASE result^.kind OF
          = clc$time_zone =
            ;
          = clc$unspecified =
            ;
          ELSE
            osp$set_status_condition (cle$wrong_kind_of_value, status);
            clp$append_status_type_desc (osc$status_parameter_delimiter, current_type_description, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          CASEND;

        = clc$lex_unsigned_decimal, clc$lex_add, clc$lex_subtract, clc$lex_left_parenthesis, clc$lex_colon,
              clc$lex_dot =
          evaluate_time_zone_literal;

        ELSE
          osp$set_status_condition (cle$expecting_time_zone_expr, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_expression;
        CASEND;

      PROCEND evaluate_time_zone;
?? TITLE := 'evaluate_type_specification', EJECT ??

      PROCEDURE evaluate_type_specification
        (VAR result: ^clt$data_value);

        VAR
          type_specification: ^clt$type_specification;


        clp$internal_gen_type_spec (osc$null_name, TRUE, NIL, NIL, work_area, parse, type_specification,
              status);
        IF NOT status.normal THEN
          EXIT evaluate_expression;
        IFEND;

        IF type_specification = NIL THEN
          clp$make_unspecified_value (work_area, result);
        ELSE
          clp$make_type_spec_value (type_specification, work_area, result);
        IFEND;
        IF result = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT evaluate_expression;
        IFEND;

        recognize_binary_operator;

      PROCEND evaluate_type_specification;
?? TITLE := 'evaluate_union', EJECT ??

{
{ NOTE:
{   Unlike most other expression evaluators, the one for union (ANY) types
{   assumes that the INDEX_LIMIT field of the CLT$PARSE_STATE designates the
{   end of the expression being evaluated.  This restriction is necessary in
{   order for this evaluator to distinguish between the myriad possible types
{   of expressions, particularly those involving lists.
{

      PROCEDURE evaluate_union
        (VAR result: ^clt$data_value);

        VAR
          evaluate_as_standard_type: boolean,
          i: clt$union_member_number,
          kinds: clt$type_kinds,
          list_type_description: ^clt$type_description,
          local_numeric_info: clt$numeric_operand_info,
          numeric_union_type_description: clt$type_description,
          saved_parse: clt$parse_state,
          tried_numeric_evaluate: boolean,
          try_numeric_evaluate: boolean,
          type_conformance: clt$type_conformance;

?? NEWTITLE := 'check_for_and_handle_list', EJECT ??

{
{ PURPOSE:
{   To check whether the form of the expression matches that of a parenthesized
{   list and if so, to evaluate it as such.  This routine is only called if the
{   expression begins with a left parenthesis.
{
{ NOTE 1:
{   The check is made by determining whether the expression ends with a right
{   parenthesis that balances the left one it begins with.  If so, a further
{   check is made to determine whether a list element separator (comma or
{   space) can be found withn the parentheses.  If so, the expression is
{   considered to be a list.  During this analysis special allowance is made
{   for the logical operators (NOT, AND, OR and XOR) because of their need for
{   surrounding spaces.
{
{ NOTE 2:
{   If the expression is determined to be a list, control is NOT returned to
{   the caller.
{
{ NOTE 3:
{   If the expression is determined to be "unnecessarily" parenthesized, i.e.
{   is enclosed in a pair of parentheses but is not a list, evaluate_union is
{   recursively called to process the sub-expression (with the parentheses
{   removed.  Control is NOT returned to the caller in this case.
{

        PROCEDURE check_for_and_handle_list;

          VAR
            empty_list: boolean,
            final_parse: clt$parse_state,
            ignore_list_size: clt$list_size,
            right_parenthesis_index: clt$expression_text_index;


          clp$scan_bal_paren_lexical_unit (parse);
          IF parse.unit.kind <> clc$lex_right_parenthesis THEN
            RETURN;
          IFEND;
          right_parenthesis_index := parse.unit_index;
          empty_list := parse.previous_non_space_unit.kind = clc$lex_left_parenthesis;

          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit_index < parse.index_limit THEN
            RETURN;
          IFEND;
          final_parse := parse;

        /is_list/
          BEGIN
            IF NOT empty_list THEN
              parse := saved_parse;
              clp$scan_non_space_lexical_unit (parse);
              IF recognize_not_operator () THEN
                EXIT /is_list/;
              IFEND;

              clp$scan_unnested_sep_lex_unit (clc$ignore_ellipsis, parse);
              IF parse.unit_is_space THEN
                clp$scan_non_space_lexical_unit (parse);
              IFEND;
              IF parse.unit_index >= right_parenthesis_index THEN
                EXIT /is_list/;
              IFEND;

              recognize_binary_operator;
              IF (operator.kind <> clc$not_an_operator) OR (NOT (parse.previous_unit_is_space OR
                    (parse.unit.kind = clc$lex_comma))) THEN
                EXIT /is_list/;
              IFEND;
            IFEND;

{ At this point the expression is known to be a (possibly empty) list.

            parse := saved_parse;
            clp$make_list_value (work_area, result);
            IF result = NIL THEN
              osp$set_status_condition (cle$work_area_overflow, status);
              EXIT evaluate_expression;
            IFEND;
            ignore_list_size := 0;
            clp$scan_non_space_lexical_unit (parse);
            evaluate_parenthesized_list (current_type_description, NIL, NIL, clc$list, clc$no_expansion, NIL,
                  ignore_list_size, result);

            EXIT evaluate_union;
          END /is_list/;

{ At this point it is known that a pair of parentheses surround the expression
{ but that the expression is not a list, i.e. the expression is unnecessarily
{ parenthesized.  Therefore evaluate_union is called recursively to process the
{ expression with the parentheses removed.

          parse := saved_parse;
          clp$scan_non_space_lexical_unit (parse);
          parse.index_limit := right_parenthesis_index;
          evaluate_union (result);
          parse := final_parse;
          recognize_binary_operator;

          EXIT evaluate_union;

        PROCEND check_for_and_handle_list;
?? TITLE := 'check_for_solely_name_deref', EJECT ??

{
{ PURPOSE:
{   To check whether the expression consists solely of a reference to a
{   variable or function.
{

        PROCEDURE check_for_solely_name_deref;

          VAR
            ignore_sub_list_tail: ^clt$data_value,
            initial_path: ^fst$file_reference,
            local_parse: clt$parse_state;


        /check/
          BEGIN
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

            local_parse := parse;
            clp$scan_any_lexical_unit (parse);
            dereference_name (name, result);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            ELSEIF result = NIL THEN
              EXIT /check/;
            IFEND;

*IF NOT $true(osv$unix)
*IF NOT $true(osv$unix)
            IF ((result^.kind = clc$name) OR (result^.kind = clc$file)) AND
                  (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_concatenate]) THEN
*ELSE
            IF (result^.kind IN $clt$data_kinds [clc$nos_ve_file, clc$unix_file, clc$name]) AND
                  (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_dot, clc$lex_divide,
                  clc$lex_concatenate]) THEN
*IFEND
              IF result^.kind = clc$name THEN
                parse := local_parse;
              IFEND;
*IF NOT $true(osv$unix)
              evaluate_file (result, ignore_sub_list_tail);
*ELSE
              evaluate_file (clc$file = clc$unix_file, result, ignore_sub_list_tail);
*IFEND
              IF NOT status.normal THEN
                EXIT /check/;
              IFEND;
*IF NOT $true(osv$unix)
            ELSEIF result^.kind = clc$file THEN
*ELSE
            ELSEIF result^.kind = clc$nos_ve_file THEN
*IFEND
              IF current_type_description^.derived_from_value_kind_spec THEN
                initial_path := result^.file_value;
*IF NOT $true(osv$unix)
                clp$complete_file_ref_eval (FALSE, FALSE, TRUE, initial_path, parse, work_area, result,
                      ignore_sub_list_tail, status);
*ELSE
                clp$complete_file_ref_eval (FALSE, FALSE, FALSE, TRUE, initial_path, parse, work_area, result,
                      ignore_sub_list_tail, status);
*IFEND
                IF NOT status.normal THEN
                  EXIT /check/;
                IFEND;
              IFEND;
              recognize_binary_operator;
            ELSE
*IFEND
              recognize_binary_operator;
*IF NOT $true(osv$unix)
            IFEND;
*IFEND

            IF (operator.kind = clc$not_an_operator) AND (parse.unit_index >= parse.index_limit) THEN
              RETURN;
            IFEND;
          END /check/;

          result := NIL;
          parse := saved_parse;

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

{
{ PURPOSE:
{   To check whether the form of the expression matches that of a range and if
{   so, to evaluate it as such.
{
{ NOTE 1:
{   The check is made by looking for an unnested ellipsis within the expression.
{   If one is found, the expression is considered to be a range.  During this
{   analysis special allowance is made for the logical operators (NOT, AND, OR
{   and XOR) because of their need for surrounding spaces.
{
{ NOTE 2:
{   If the expression is determined to be a range, control is NOT returned to
{   the caller.
{

        PROCEDURE check_for_and_handle_range;


          clp$scan_operand (clc$ellipsis, parse);

          IF (parse.unit_index >= parse.index_limit) OR (parse.unit.kind <> clc$lex_ellipsis) THEN
            RETURN;
          IFEND;

          clp$make_range_value (work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;

          saved_parse.index_limit := parse.unit_index;
          local_numeric_info.initialized := FALSE;
          evaluate_expression (saved_parse, current_type_description, FALSE, clc$no_expansion,
                local_numeric_info, result^.low_value, ignore_sub_list_tail, status);
          IF NOT status.normal THEN

{ Do not evaluate expression as a range.

            saved_parse.index_limit := parse.index_limit;
            RETURN;
          IFEND;

*IF $true(osv$unix)
{ Check if the ellipsis was eaten up as part of a unix file reference.
{ If so, do not evaluate expression as a range.

          IF (saved_parse.unit_index = saved_parse.index_limit) AND
                (saved_parse.previous_non_space_unit.kind = clc$lex_divide) THEN
            saved_parse := parse_before_handle_range;
            RETURN;
          IFEND;
*IFEND

          IF saved_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (saved_parse);
          IFEND;
          IF saved_parse.unit_index < saved_parse.index_limit THEN
            osp$set_status_condition (cle$expecting_end_of_expression, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, saved_parse, status);
            EXIT evaluate_expression;
          IFEND;

          clp$scan_non_space_lexical_unit (parse);
          local_numeric_info.initialized := FALSE;
          evaluate_expression (parse, current_type_description, FALSE, clc$no_expansion,
                local_numeric_info, result^.high_value, ignore_sub_list_tail, status);
          IF NOT status.normal THEN

{ Do not evaluate expression as a range.

            RETURN;
          IFEND;
          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          IF parse.unit_index < parse.index_limit THEN
            osp$set_status_condition (cle$expecting_end_of_expression, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_expression;
          IFEND;

          EXIT evaluate_union;

        PROCEND check_for_and_handle_range;
?? OLDTITLE, EJECT ??

        VAR
          standard_union_type_description: [STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
                [NIL, NIL, FALSE, FALSE, -$clt$type_kinds [], clc$union_type, ^standard_union_members,
*ELSE
                [NIL, NIL, FALSE, FALSE, -$clt$type_kinds_v2 [], clc$union_type, ^standard_union_members,
*IFEND
                ^standard_union_information],
          standard_union_members: [STATIC, READ, oss$job_paged_literal] array [1 .. 8] of
                clt$type_description := [
                {BOOLEAN} [NIL, NIL, FALSE, FALSE, [clc$boolean_type], clc$boolean_type],
*IF NOT $true(osv$unix)
                {FILE} [NIL, NIL, FALSE, FALSE, [clc$file_type], clc$file_type],
*ELSE
                {NOS_VE_FILE} [NIL, NIL, FALSE, FALSE, [clc$nos_ve_file_type], clc$nos_ve_file_type],
*IFEND
                {INTEGER} [NIL, NIL, FALSE, FALSE, [clc$integer_type], clc$integer_type, clc$min_integer,
                clc$max_integer, 10],
                {NAME} [NIL, NIL, FALSE, FALSE, [clc$name_type], clc$name_type, 1, osc$max_name_size],
                {REAL} [NIL, NIL, FALSE, FALSE, [clc$real_type], clc$real_type,
*IF NOT $true(osv$unix)
                [{-$INFINITY} 3, [[0d000(16), 0], [0d000(16), 0]]],
                [{$INFINITY} 3, [[5000(16), 0], [5000(16), 0]]]],
*ELSE
*copy cli$longreal_negative_infinity
                ,
*copy cli$longreal_positive_infinity
                ],
*IFEND
                {STATUS} [NIL, NIL, FALSE, FALSE, [clc$status_type], clc$status_type],
                {STRING} [NIL, NIL, FALSE, FALSE, [clc$string_type], clc$string_type, 0, clc$max_string_size,
                FALSE],
                {STRING_PATTERN} [NIL, NIL, FALSE, FALSE, [clc$string_pattern_type],
                clc$string_pattern_type]],
          standard_union_information: [STATIC, READ, oss$job_paged_literal] clt$union_type_information :=
*IF NOT $true(osv$unix)
                [TRUE, clc$min_integer, clc$max_integer, 10, [{-$INFINITY} 3, [[0d000(16), 0], [0d000(16),
                0]]], [{$INFINITY} 3, [[5000(16), 0], [5000(16), 0]]]];
*ELSE
                [TRUE, clc$min_integer, clc$max_integer, 10,
*copy cli$longreal_negative_infinity
                ,
*copy cli$longreal_positive_infinity
                ];
*IFEND

        VAR
          non_standard_union_type_desc: [STATIC, READ, oss$job_paged_literal] clt$type_description :=
                [NIL, NIL, FALSE, FALSE, [clc$cobol_name_type, clc$command_reference_type, clc$date_time_type,
                clc$scu_line_identifier_type, clc$time_increment_type, clc$time_zone_type,
                clc$type_specification_type], clc$union_type, ^non_standard_union_members,
                ^non_standard_union_information],
          non_standard_union_members: [STATIC, READ, oss$job_paged_literal] array [1 .. 7] of
                clt$type_description := [
                {DATE_TIME} [NIL, NIL, FALSE, FALSE, [clc$date_time_type], clc$date_time_type,
                [clc$date, clc$time], [clc$past, clc$present, clc$future]],
                {TIME_INCREMENT} [NIL, NIL, FALSE, FALSE, [clc$time_increment_type], clc$time_increment_type],
                {TIME_ZONE} [NIL, NIL, FALSE, FALSE, [clc$time_zone_type], clc$time_zone_type],
                {COBOL_NAME} [NIL, NIL, FALSE, FALSE, [clc$cobol_name_type], clc$cobol_name_type],
                {COMMAND_REFERENCE} [NIL, NIL, FALSE, FALSE, [clc$command_reference_type],
                clc$command_reference_type],
                {LINE_IDENTIFIER} [NIL, NIL, FALSE, FALSE, [clc$scu_line_identifier_type],
                clc$scu_line_identifier_type],
                {TYPE} [NIL, NIL, FALSE, FALSE, [clc$type_specification_type], clc$type_specification_type]],
          non_standard_union_information: [STATIC, READ, oss$job_paged_literal]
                clt$union_type_information := [FALSE, clc$min_integer, clc$max_integer, 10,
*IF NOT $true(osv$unix)
                [{-$INFINITY} 3, [[0d000(16), 0], [0d000(16), 0]]],
                [{$INFINITY} 3, [[5000(16), 0], [5000(16), 0]]]];
*ELSE
*copy cli$longreal_negative_infinity
                ,
*copy cli$longreal_positive_infinity
                ];
*IFEND

?? EJECT ??

        VAR
          ignore_real_convertable_to_int: boolean,
          ignore_integer_result: clt$data_value,
          name: ost$name,
*IF $true(osv$unix)
          parse_before_handle_range: clt$parse_state,
*IFEND
          saved_status: ^ost$status;


        saved_parse := parse;
        saved_status := NIL;

        IF current_type_description^.member_descriptions = NIL THEN

          IF parse.unit.kind = clc$lex_name THEN
            check_for_solely_name_deref;
            IF result <> NIL THEN
              RETURN;
            IFEND;
            IF NOT status.normal THEN
              PUSH saved_status;
              saved_status^ := status;
            IFEND;
            status.normal := TRUE;
          IFEND;

          IF parse.unit.kind = clc$lex_left_parenthesis THEN
            check_for_and_handle_list;

{ Control is not returned if the expression is a list.

          IFEND;

          parse := saved_parse;
*IF $true(osv$unix)
          parse_before_handle_range := saved_parse;
*IFEND
          check_for_and_handle_range;

{ Control is not returned if the expression is a range.

{ Now try evaluating the expression as if it were one of the "standard" types.

          parse := saved_parse;
          local_numeric_info.initialized := FALSE;
          evaluate_expression (parse, ^standard_union_type_description, evaluating_sub_expression,
                clc$no_expansion, local_numeric_info, result, ignore_sub_list_tail, status);
          IF status.normal THEN
            RETURN;
          IFEND;

{ Now try evaluating the expression as if it were not a "standard" types.  Not
{ all of the "non-standard" types are included in the type description used
{ because of the "overlapping" nature of the syntax of the various types of
{ expressions.

          parse := saved_parse;
          local_numeric_info.initialized := FALSE;
          evaluate_expression (parse, ^non_standard_union_type_desc, evaluating_sub_expression,
                clc$no_expansion, local_numeric_info, result, ignore_sub_list_tail, status);
          IF status.normal THEN
            RETURN;
          IFEND;

          IF saved_status <> NIL THEN
            status := saved_status^;
          ELSE
            osp$set_status_abnormal ('CL', cle$expression_not_union_type, saved_parse.
                  text^ (saved_parse.unit_index, saved_parse.index_limit - saved_parse.unit_index), status);
          IFEND;
          EXIT evaluate_expression;
        IFEND;

      /try_member_types/
        BEGIN
          evaluate_as_standard_type := current_type_description^.union_information^.
                only_standard_types_in_union;
          IF evaluate_as_standard_type THEN
*IF NOT $true(osv$unix)
            IF clc$file_type IN current_type_description^.kinds THEN
*ELSE
            IF clc$nos_ve_file_type IN current_type_description^.kinds THEN
*IFEND
              evaluate_as_standard_type := clc$name_type IN current_type_description^.kinds;
            IFEND;
          IFEND;
          IF evaluate_as_standard_type THEN

{ The "standard" types have non-conflicting expression forms, therefore an
{ expression for a union of them can be evaluated without the need for trying
{ each type individually.  The "standard" types are: boolean, file, integer (if
{ default radix is 10), name, real, status, string (if not literal),
{ string_pattern, and union (consisting only of these "standard" types).

            evaluate_boolean (FALSE, result);
            IF parse.unit_index < parse.index_limit THEN
              osp$set_status_condition (cle$expecting_end_of_expression, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_expression;
            IFEND;

          /standardize_result/
            BEGIN
              CASE result^.kind OF
              = clc$data_name =
                name := result^.data_name_value;
              = clc$keyword =
                name := result^.keyword_value;
              = clc$real =
                simplify_real_to_integer (result, ignore_integer_result, ignore_real_convertable_to_int);
                EXIT /standardize_result/;
              = clc$unspecified =
                RETURN;
              ELSE
                EXIT /standardize_result/;
              CASEND;
              result^.kind := clc$name;
              result^.name_value := name;
            END /standardize_result/;

            IF current_type_description <> ^standard_union_type_description THEN
              clp$evaluate_value_conformance (result, current_type_description, clc$conforms_to_type, status);
              IF NOT status.normal THEN
                EXIT evaluate_expression;
              IFEND;
            IFEND;

            RETURN;
          IFEND;

          tried_numeric_evaluate := FALSE;
          FOR i := 1 TO UPPERBOUND (current_type_description^.member_descriptions^) DO
            parse := saved_parse;
            local_numeric_info.initialized := FALSE;
            CASE current_type_description^.member_descriptions^ [i].kind OF
            = clc$integer_type =
              try_numeric_evaluate := clc$real_type IN current_type_description^.kinds;
            = clc$real_type =
              try_numeric_evaluate := clc$integer_type IN current_type_description^.kinds;
            ELSE
              try_numeric_evaluate := FALSE;
            CASEND;
            IF try_numeric_evaluate THEN
              IF NOT tried_numeric_evaluate THEN
                numeric_union_type_description := current_type_description^;
*IF NOT $true(osv$unix)
                numeric_union_type_description.kinds := $clt$type_kinds [clc$integer_type, clc$real_type];
*ELSE
                numeric_union_type_description.kinds := $clt$type_kinds_v2 [clc$integer_type, clc$real_type];
*IFEND
                numeric_union_type_description.union_information^.only_standard_types_in_union := TRUE;
                evaluate_expression (parse, ^numeric_union_type_description, evaluating_sub_expression,
                      clc$no_expansion, local_numeric_info, result, ignore_sub_list_tail, status);
                IF status.normal AND (parse.unit_index >= parse.index_limit) THEN
                  IF result^.kind = clc$unspecified THEN
                    RETURN;
                  ELSEIF evaluating_sub_expression THEN
                    IF result^.kind IN $clt$data_kinds [clc$integer, clc$real] THEN
                      RETURN;
                    IFEND;
                  ELSE
                    clp$validate_value_conformance (result, current_type_description, type_conformance);
                    IF type_conformance >= clc$conforms_to_type THEN
                      RETURN;
                    IFEND;
                  IFEND;
                IFEND;
                tried_numeric_evaluate := TRUE;
              IFEND;
            ELSE
              evaluate_expression (parse, ^current_type_description^.member_descriptions^ [i],
                    evaluating_sub_expression, clc$no_expansion, local_numeric_info, result,
                    ignore_sub_list_tail, status);
              IF status.normal AND (parse.unit_index >= parse.index_limit) THEN
                RETURN;
              IFEND;
            IFEND;
          FOREND;

        END /try_member_types/;

{ The following call to check_for_solely_name_deref is made in order to take a
{ stab at producing a more useful status than cle$expression_not_union_type.
{ If the expression consists solely of a reference to a variable or function
{ that for whatever reason fails, this will ensure that the failing status is
{ reported and not disguised by the more generic status.

        IF saved_parse.unit.kind = clc$lex_name THEN
          parse := saved_parse;
          check_for_solely_name_deref;
        IFEND;
        IF status.normal THEN
          osp$set_status_abnormal ('CL', cle$expression_not_union_type, saved_parse.
                text^ (saved_parse.unit_index, saved_parse.index_limit - saved_parse.unit_index), status);
        IFEND;
        EXIT evaluate_expression;

      PROCEND evaluate_union;
?? TITLE := 'handle_comparison', EJECT ??

      PROCEDURE handle_comparison
        (VAR result {input, output} : ^clt$data_value);

        VAR
          comparison_order: clt$comparison_result,
          current_operator: clt$operator,
          ignore_result_type_description: ^clt$type_description,
          local_numeric_info: clt$numeric_operand_info,
          result_table: [STATIC, READ, oss$job_paged_literal] array [clt$relational_operator] of
                array [clt$comparison_result] of boolean := [
                {op} {equal, left>, ?????, right>}
                {> } [FALSE, TRUE, FALSE, FALSE],
                {>=} [TRUE, TRUE, FALSE, FALSE],
                {< } [FALSE, FALSE, FALSE, TRUE],
                {<=} [TRUE, FALSE, FALSE, TRUE],
                {= } [TRUE, FALSE, FALSE, FALSE],
                {<>} [FALSE, TRUE, TRUE, TRUE]],
          right_operand: ^clt$data_value,
          right_type_description: clt$type_description;

?? NEWTITLE := 'compare_arrays', EJECT ??

        PROCEDURE compare_arrays;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          IF (operand_type_description <> NIL) AND (operand_type_description^.kind <> clc$union_type) THEN
            right_type_description := operand_type_description^;
          ELSE
            clp$derive_type_desc_from_value (result, work_area, right_type_description, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;
          IFEND;

          evaluate_right_operand_type (^right_type_description);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$array_value_compare (result, right_operand);

        PROCEND compare_arrays;
?? TITLE := 'compare_booleans', EJECT ??

        PROCEDURE compare_booleans;


          evaluate_boolean_operand (right_operand);

          CASE right_operand^.kind OF

          = clc$boolean =
            comparison_order := clp$boolean_compare (result^.boolean_value.value,
                  right_operand^.boolean_value.value);

          = clc$unspecified =
            comparison_order := clc$unordered;
            RETURN;

          ELSE
            non_comparable_values;
          CASEND;

        PROCEND compare_booleans;
?? TITLE := 'compare_cobol_names', EJECT ??

        PROCEDURE compare_cobol_names;

          VAR
            right_string: ^clt$string_value;


          IF parse.unit.kind = clc$lex_string THEN
            evaluate_operand (right_operand);

            PUSH right_string: [STRLENGTH (right_operand^.string_value^)];
            #TRANSLATE (osv$lower_to_upper, right_operand^.string_value^, right_string^);

          ELSE
            evaluate_right_operand_kind (clc$cobol_name_type);

            IF right_operand^.kind = clc$unspecified THEN
              RETURN;
            IFEND;

            right_string := ^right_operand^.cobol_name_value;
          IFEND;

          comparison_order := clp$string_compare (^result^.cobol_name_value, right_string);

        PROCEND compare_cobol_names;
?? TITLE := 'compare_command_references', EJECT ??

        PROCEDURE compare_command_references;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          evaluate_right_operand_kind (clc$command_reference_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$command_reference_compare (result^.command_reference_value^,
                right_operand^.command_reference_value^);

        PROCEND compare_command_references;
?? TITLE := 'compare_data_names', EJECT ??

        PROCEDURE compare_data_names;

          VAR
            right_string: ^clt$string_value;


          IF parse.unit.kind = clc$lex_string THEN
            evaluate_operand (right_operand);

            PUSH right_string: [STRLENGTH (right_operand^.string_value^)];
            #TRANSLATE (osv$lower_to_upper, right_operand^.string_value^, right_string^);

          ELSE
            evaluate_right_operand_kind (clc$data_name_type);

            IF right_operand^.kind = clc$unspecified THEN
              RETURN;
            IFEND;

            right_string := ^right_operand^.data_name_value;
          IFEND;

          comparison_order := clp$string_compare (^result^.data_name_value, right_string);

        PROCEND compare_data_names;
?? TITLE := 'compare_date_times', EJECT ??

        PROCEDURE compare_date_times;


          right_type_description.specification := NIL;
          right_type_description.name := NIL;
          right_type_description.derived_from_value_kind_spec := FALSE;
          right_type_description.advanced_keywords_present := FALSE;
*IF NOT $true(osv$unix)
          right_type_description.kinds := $clt$type_kinds [clc$date_time_type];
*ELSE
          right_type_description.kinds := $clt$type_kinds_v2 [clc$date_time_type];
*IFEND
          right_type_description.kind := clc$date_time_type;
          right_type_description.date_and_or_time := $clt$date_and_or_time [clc$date, clc$time];
          right_type_description.tenses := $clt$date_time_tenses [clc$past, clc$present, clc$future];

          evaluate_right_operand_type (^right_type_description);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$date_time_compare (result^.date_time_value, right_operand^.date_time_value);

        PROCEND compare_date_times;
?? TITLE := 'compare_entry_point_references', EJECT ??

        PROCEDURE compare_entry_point_references;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          evaluate_right_operand_kind (clc$entry_point_reference_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$entry_point_ref_compare (result^.entry_point_reference_value^,
                right_operand^.entry_point_reference_value^);

        PROCEND compare_entry_point_references;
*IF NOT $true(osv$unix)
?? TITLE := 'compare_files', EJECT ??

        PROCEDURE compare_files;


          evaluate_right_operand_kind (clc$file_type);
*ELSE
?? TITLE := 'compare_nos_ve_files', EJECT ??

        PROCEDURE compare_nos_ve_files;


          evaluate_right_operand_kind (clc$nos_ve_file_type);
*IFEND

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          compare_path_names (result^.file_value^, right_operand^.file_value^);

*IF NOT $true(osv$unix)
        PROCEND compare_files;
*ELSE
        PROCEND compare_nos_ve_files;
?? TITLE := 'compare_unix_files', EJECT ??

        PROCEDURE compare_unix_files;


          evaluate_right_operand_kind (clc$unix_file_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$string_compare (result^.file_value, right_operand^.file_value);

        PROCEND compare_unix_files;
*IFEND
?? TITLE := 'compare_keywords', EJECT ??
{ Note:
{
{   This is the only compare_xxx procedure in which right_type_description is NOT initialized.
{ (The compare_xxx procs which call evaluate_right_operand_kind do it indirectly.)  However,
{ initializing it (like in compare_arrays) caused the following SCL procedure to no longer work.
{
{ PROCEDURE p (
{   a: any of
{        key
{          one
{          two
{        keyend
{        file
{      anyend = two)
{
{   IF a=one THEN
{     ....
{   ELSEIF a=$user THEN
{     ....
{
{   This would get error CL 2015  Values of types KEYWORD and FILE may not be compared.

        PROCEDURE compare_keywords;

          VAR
            right_string: ^clt$string_value;


          IF parse.unit.kind = clc$lex_string THEN
            evaluate_operand (right_operand);

            PUSH right_string: [STRLENGTH (right_operand^.string_value^)];
            #TRANSLATE (osv$lower_to_upper, right_operand^.string_value^, right_string^);

          ELSEIF operand_type_description <> NIL THEN
            evaluate_right_operand_type (operand_type_description);

            IF right_operand^.kind = clc$unspecified THEN
              RETURN;
            IFEND;

            right_string := ^right_operand^.keyword_value;

          ELSE
            evaluate_right_operand_kind (clc$data_name_type);

            IF right_operand^.kind = clc$unspecified THEN
              RETURN;
            IFEND;

            right_string := ^right_operand^.data_name_value;
          IFEND;

          comparison_order := clp$string_compare (^result^.keyword_value, right_string);

        PROCEND compare_keywords;
?? TITLE := 'compare_lists', EJECT ??

        PROCEDURE compare_lists;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          IF (operand_type_description <> NIL) AND (operand_type_description^.kind <> clc$union_type) THEN
            right_type_description := operand_type_description^;
          ELSE
            clp$derive_type_desc_from_value (result, work_area, right_type_description, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;
          IFEND;

          right_type_description.min_list_size := 0;
          right_type_description.max_list_size := clc$max_list_size;
          right_type_description.list_rest := FALSE;
          evaluate_right_operand_type (^right_type_description);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$list_value_compare (result, right_operand);

        PROCEND compare_lists;
?? TITLE := 'compare_names', EJECT ??

        PROCEDURE compare_names;

          VAR
            right_string: ^clt$string_value;


          IF parse.unit.kind = clc$lex_string THEN
            evaluate_operand (right_operand);

            PUSH right_string: [STRLENGTH (right_operand^.string_value^)];
            #TRANSLATE (osv$lower_to_upper, right_operand^.string_value^, right_string^);

          ELSE
            right_type_description.specification := NIL;
            right_type_description.name := NIL;
            right_type_description.derived_from_value_kind_spec := FALSE;
            right_type_description.advanced_keywords_present := FALSE;
*IF NOT $true(osv$unix)
            right_type_description.kinds := $clt$type_kinds [clc$name_type];
*ELSE
            right_type_description.kinds := $clt$type_kinds_v2 [clc$name_type];
*IFEND
            right_type_description.kind := clc$name_type;
            right_type_description.min_name_size := 1;
            right_type_description.max_name_size := osc$max_name_size;
            evaluate_right_operand_type (^right_type_description);

            IF right_operand^.kind = clc$unspecified THEN
              RETURN;
            IFEND;

            right_string := ^right_operand^.name_value;
          IFEND;

          comparison_order := clp$string_compare (^result^.name_value, right_string);

        PROCEND compare_names;
?? TITLE := 'compare_network_titles', EJECT ??

        PROCEDURE compare_network_titles;


          osp$set_status_abnormal ('CL', cle$not_supported, 'Comparison of network titles', status);
          EXIT evaluate_expression;

        PROCEND compare_network_titles;
?? TITLE := 'compare_numbers', EJECT ??

        PROCEDURE compare_numbers;

          VAR
            real_operand: clt$data_value;


          right_operand := NIL;
          evaluate_number (FALSE, right_operand);

          CASE right_operand^.kind OF

          = clc$integer, clc$real =
            ;

          = clc$unspecified =
            comparison_order := clc$unordered;
            RETURN;

          ELSE
            non_comparable_values;
          CASEND;

          comparison_order := clp$number_compare (result^, right_operand^);

        PROCEND compare_numbers;
?? TITLE := 'compare_path_names', EJECT ??

        PROCEDURE compare_path_names
          (    left_file_reference: fst$file_reference;
               right_file_reference: fst$file_reference);

          CONST
            first_character_of_full_path = ':';

          VAR
            left_full_path: fst$path,
            right_full_path: fst$path;


*IF NOT $true(osv$unix)
          IF (STRLENGTH (left_file_reference) > 1) AND (left_file_reference (1) =
                first_character_of_full_path) THEN
*IFEND
            #TRANSLATE (osv$lower_to_upper, left_file_reference, left_full_path);
*IF NOT $true(osv$unix)
          ELSE
            clp$get_path_name (left_file_reference, osc$full_message_level, left_full_path);
          IFEND;
*IFEND

*IF NOT $true(osv$unix)
          IF (STRLENGTH (right_file_reference) > 1) AND (right_file_reference (1) =
                first_character_of_full_path) THEN
*IFEND
            #TRANSLATE (osv$lower_to_upper, right_file_reference, right_full_path);
*IF NOT $true(osv$unix)
          ELSE
            clp$get_path_name (right_file_reference, osc$full_message_level, right_full_path);
          IFEND;
*IFEND

          comparison_order := clp$string_compare (^left_full_path, ^right_full_path);

        PROCEND compare_path_names;
?? TITLE := 'compare_program_names', EJECT ??

        PROCEDURE compare_program_names;


          evaluate_right_operand_kind (clc$program_name_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$string_compare (^result^.program_name_value,
                ^right_operand^.program_name_value);

        PROCEND compare_program_names;
?? TITLE := 'compare_ranges', EJECT ??

        PROCEDURE compare_ranges;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          IF (operand_type_description <> NIL) AND (operand_type_description^.kind <> clc$union_type) THEN
            right_type_description := operand_type_description^;
          ELSE
            clp$derive_type_desc_from_value (result, work_area, right_type_description, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;
          IFEND;

          evaluate_right_operand_type (^right_type_description);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$range_value_compare (result, right_operand);

        PROCEND compare_ranges;
?? TITLE := 'compare_records', EJECT ??

        PROCEDURE compare_records;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          IF (operand_type_description <> NIL) AND (operand_type_description^.kind <> clc$union_type) THEN
            right_type_description := operand_type_description^;
          ELSE
            clp$derive_type_desc_from_value (result, work_area, right_type_description, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            IFEND;
          IFEND;

          evaluate_right_operand_type (^right_type_description);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$record_value_compare (result, right_operand);

        PROCEND compare_records;
?? TITLE := 'compare_scu_line_identifiers', EJECT ??

        PROCEDURE compare_scu_line_identifiers;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          evaluate_right_operand_kind (clc$scu_line_identifier_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          IF result^.scu_line_identifier_value = right_operand^.scu_line_identifier_value THEN
            comparison_order := clc$equal;
          ELSE
            comparison_order := clc$unordered;
          IFEND;

        PROCEND compare_scu_line_identifiers;
?? TITLE := 'compare_statistic_codes', EJECT ??

        PROCEDURE compare_statistic_codes;


          evaluate_right_operand_kind (clc$statistic_code_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$integer_compare (result^.statistic_code_value,
                right_operand^.statistic_code_value);

        PROCEND compare_statistic_codes;
?? TITLE := 'compare_statuses', EJECT ??

        PROCEDURE compare_statuses;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          evaluate_right_operand_kind (clc$status_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$status_compare (result^.status_value^, right_operand^.status_value^);

        PROCEND compare_statuses;
?? TITLE := 'compare_status_codes', EJECT ??

        PROCEDURE compare_status_codes;


          evaluate_right_operand_kind (clc$status_code_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$integer_compare (result^.status_code_value,
                right_operand^.status_code_value);

        PROCEND compare_status_codes;
?? TITLE := 'compare_strings', EJECT ??

        PROCEDURE compare_strings;


          right_operand := NIL;
          evaluate_string_or_pattern (FALSE, right_operand);

          CASE right_operand^.kind OF

          = clc$string =
            ;

          = clc$unspecified =
            comparison_order := clc$unordered;
            RETURN;

          ELSE
            non_comparable_values;
          CASEND;

          comparison_order := clp$string_compare (result^.string_value, right_operand^.string_value);

        PROCEND compare_strings;
?? TITLE := 'compare_time_increments', EJECT ??

        PROCEDURE compare_time_increments;


          evaluate_right_operand_kind (clc$time_increment_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          comparison_order := clp$time_increment_compare (result^.time_increment_value^,
                right_operand^.time_increment_value^);

        PROCEND compare_time_increments;
?? TITLE := 'compare_time_zones', EJECT ??

        PROCEDURE compare_time_zones;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          evaluate_right_operand_kind (clc$time_zone_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          IF result^.time_zone_value = right_operand^.time_zone_value THEN
            comparison_order := clc$equal;
          ELSE
            comparison_order := clc$unordered;
          IFEND;

        PROCEND compare_time_zones;
?? TITLE := 'compare_type_specifications', EJECT ??

        PROCEDURE compare_type_specifications;

          VAR
            left_type_description: clt$type_description,
            right_type_description: clt$type_description,
            type_conformance: clt$type_conformance;


          IF NOT (current_operator.relational_kind IN $clt$relational_operators
                [clc$lex_equal, clc$lex_not_equal]) THEN
            only_compare_for_equality;
          IFEND;

          evaluate_right_operand_kind (clc$type_specification_type);

          IF right_operand^.kind = clc$unspecified THEN
            RETURN;
          IFEND;

          clp$convert_type_spec_to_desc (result^.type_specification_value, work_area, left_type_description,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          clp$convert_type_spec_to_desc (right_operand^.type_specification_value, work_area,
                right_type_description, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          clp$validate_type_conformance (^left_type_description, ^right_type_description, type_conformance);

          IF type_conformance = clc$identical_types THEN
            comparison_order := clc$equal;
          ELSE
            comparison_order := clc$unordered;
          IFEND;

        PROCEND compare_type_specifications;
?? TITLE := 'compare_unspecified_value', EJECT ??

        PROCEDURE compare_unspecified_value;


{ Skip over right operand.

          REPEAT
            clp$scan_operand (clc$separator, parse);
            recognize_binary_operator;
          UNTIL operator.kind IN $clt$operator_kinds [clc$not_an_operator, clc$logical_operator,
                clc$relational_operator];

          comparison_order := clc$unordered;

        PROCEND compare_unspecified_value;
?? TITLE := 'evaluate_right_operand_kind', EJECT ??

        PROCEDURE [INLINE] evaluate_right_operand_kind
          (    type_kind: clt$type_kind);


          right_type_description.specification := NIL;
          right_type_description.name := NIL;
          right_type_description.derived_from_value_kind_spec := FALSE;
          right_type_description.advanced_keywords_present := FALSE;
*IF NOT $true(osv$unix)
          right_type_description.kinds := $clt$type_kinds [type_kind];
*ELSE
          right_type_description.kinds := $clt$type_kinds_v2 [type_kind];
*IFEND
          right_type_description.kind := type_kind;

          evaluate_right_operand_type (^right_type_description);

        PROCEND evaluate_right_operand_kind;
?? TITLE := 'evaluate_right_operand_type', EJECT ??

        PROCEDURE [INLINE] evaluate_right_operand_type
          (    type_description: ^clt$type_description);

          VAR
            ignore_sub_list_tail: ^clt$data_value;


          local_numeric_info.initialized := FALSE;
          evaluate_expression (parse, type_description, FALSE, clc$no_expansion, local_numeric_info,
                right_operand, ignore_sub_list_tail, status);

          IF NOT status.normal THEN
            IF status.condition = cle$wrong_kind_of_value THEN
              status.condition := cle$non_comparable_values;
            ELSEIF (status.condition = cle$unknown_keyword) AND
                  (type_description^.kind = clc$keyword_type) THEN

{ The following code deals with the attempt to compare a name with a
{ keyword and the name is not one of the allowed values for the keyword
{ type.  For purposes of comparison, we don't want this to be treated as
{ an error, rather just report that the name is not equal to the keyword.
{ The right operand is "kludged up" as a "null keyword" which can't
{ possibly (legitimately) compare equal to the left operand.

              clp$make_keyword_value (osc$null_name, work_area, right_operand);
              IF right_operand = NIL THEN
                osp$set_status_condition (cle$work_area_overflow, status);
                EXIT evaluate_expression;
              IFEND;
              status.normal := TRUE;
              RETURN;
            IFEND;
            EXIT evaluate_expression;

          ELSEIF right_operand^.kind = clc$unspecified THEN
            comparison_order := clc$unordered;
          IFEND;

        PROCEND evaluate_right_operand_type;
?? TITLE := 'non_comparable_values', EJECT ??

        PROCEDURE non_comparable_values;


          osp$set_status_condition (cle$non_comparable_values, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, right_operand, status);
          EXIT evaluate_expression;

        PROCEND non_comparable_values;
?? TITLE := 'only_compare_for_equality', EJECT ??

        PROCEDURE only_compare_for_equality;


          osp$set_status_condition (cle$only_compare_for_equality, status);
          clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
          EXIT evaluate_expression;

        PROCEND only_compare_for_equality;
?? OLDTITLE, EJECT ??

        REPEAT
          current_operator := operator;

          CASE result^.kind OF
          = clc$application, clc$lock, clc$string_pattern =
            osp$set_status_condition (cle$non_comparable_type, status);
            clp$append_status_value_type (osc$status_parameter_delimiter, result, status);
            EXIT evaluate_expression;
          = clc$array =
            compare_arrays;
          = clc$boolean =
            compare_booleans;
          = clc$cobol_name =
            compare_cobol_names;
          = clc$command_reference =
            compare_command_references;
          = clc$data_name =
            compare_data_names;
          = clc$date_time =
            compare_date_times;
          = clc$entry_point_reference =
            compare_entry_point_references;
*IF NOT $true(osv$unix)
          = clc$file =
            compare_files;
*ELSE
          = clc$nos_ve_file =
            compare_nos_ve_files;
          = clc$unix_file =
            compare_unix_files;
*IFEND
          = clc$integer, clc$real =
            compare_numbers;
          = clc$keyword =
            compare_keywords;
          = clc$list =
            compare_lists;
          = clc$name =
            compare_names;
          = clc$network_title =
            compare_network_titles;
          = clc$program_name =
            compare_program_names;
          = clc$range =
            compare_ranges;
          = clc$record =
            compare_records;
          = clc$scu_line_identifier =
            compare_scu_line_identifiers;
          = clc$statistic_code =
            compare_statistic_codes;
          = clc$status =
            compare_statuses;
          = clc$status_code =
            compare_status_codes;
          = clc$string =
            compare_strings;
          = clc$time_increment =
            compare_time_increments;
          = clc$time_zone =
            compare_time_zones;
          = clc$type_specification =
            compare_type_specifications;
          = clc$unspecified =
            compare_unspecified_value;
          ELSE
            osp$set_status_abnormal ('CL', cle$unrecognizable_data_value, current_operator.representation,
                  status);
            EXIT evaluate_expression;
          CASEND;

          clp$make_boolean_value (result_table [current_operator.relational_kind] [comparison_order],
                clc$true_false_boolean, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
        UNTIL operator.kind <> clc$relational_operator;

        IF (operator.kind = clc$not_an_operator) AND (parse.unit.kind = clc$lex_name) THEN
          recognize_binary_operator;
        IFEND;

      PROCEND handle_comparison;
?? TITLE := 'handle_unary_minus', EJECT ??

      PROCEDURE handle_unary_minus
        (VAR operand {input, output} : clt$data_value);

        CONST
          unary_minus_representation = '-';

        VAR
          dummy_operand: clt$data_value,
          original_operand: clt$data_value;


        dummy_operand.kind := clc$unspecified;
        original_operand := operand;

        clp$perform_numeric_operation (unary_minus_representation, dummy_operand, original_operand, operand,
              status);
        IF NOT status.normal THEN
          EXIT evaluate_expression;
        IFEND;

      PROCEND handle_unary_minus;
?? TITLE := 'handle_wild_card_name', EJECT ??

      PROCEDURE handle_wild_card_name
        (VAR result: ^clt$data_value;
         VAR result_sub_list_tail: ^clt$data_value);

        TYPE
          chars = set of char;

        VAR
          candidate_list: ^clt$data_value,
          ignore_scan_index: integer,
          match_info: clt$string_pattern_match_info,
          result_node: ^^clt$data_value,
          scan_found_char: boolean,
*IF NOT $true(osv$unix)
          scl_options: ^clt$scl_options,
*IFEND
          string_pattern: ^clt$string_pattern,
          wild_card_chars: chars,
          wild_card_name: ^clt$application_value_text;

?? NEWTITLE := 'expand_wild_card_keyword', EJECT ??

        PROCEDURE expand_wild_card_keyword;

          VAR
            k: clt$keyword_index,
            keywords: ^clt$keyword_specifications,
            matched_keywords: ^array [1 .. * ] {indexed by keyword's ordinal} of record
              matched: boolean,
              nominal_index: 0 .. clc$max_keywords,
            recend;


          keywords := current_type_description^.keyword_specifications;
          PUSH matched_keywords: [1 .. UPPERBOUND (keywords^)];
          FOR k := 1 TO UPPERBOUND (matched_keywords^) DO
            matched_keywords^ [k].matched := FALSE;
            matched_keywords^ [k].nominal_index := 0;
          FOREND;

          FOR k := 1 TO UPPERBOUND (keywords^) DO
            IF (keywords^ [k].ordinal < 1) OR (keywords^ [k].ordinal > UPPERBOUND (keywords^)) THEN
              osp$set_status_condition (cle$bad_keyword_type_spec, status);
              EXIT evaluate_expression;
            IFEND;

            IF keywords^ [k].availability <> clc$hidden_entry THEN
              clp$match_string_pattern (keywords^ [k].keyword (1, clp$trimmed_string_size
                    (keywords^ [k].keyword)), string_pattern, clc$sp_anchored, clc$sp_quick_scan, match_info,
                    status);
              IF NOT status.normal THEN
                EXIT evaluate_expression;
              ELSEIF match_info.result = clc$sp_success THEN
                matched_keywords^ [keywords^ [k].ordinal].matched := TRUE;
              IFEND;

              IF keywords^ [k].class = clc$nominal_entry THEN
                matched_keywords^ [keywords^ [k].ordinal].nominal_index := k;
              IFEND;
            IFEND;
          FOREND;

          result := NIL;
          result_node := ^result;
          FOR k := 1 TO UPPERBOUND (matched_keywords^) DO
            IF matched_keywords^ [k].matched THEN
              IF matched_keywords^ [k].nominal_index = 0 THEN
                osp$set_status_condition (cle$bad_keyword_type_spec, status);
                EXIT evaluate_expression;
              IFEND;

              clp$make_list_value (work_area, result_node^);
              clp$make_keyword_value (keywords^ [matched_keywords^ [k].nominal_index].keyword, work_area,
                    result_node^^.element_value);

              result_sub_list_tail := result_node^;
              result_node := ^result_node^^.link;
            IFEND;
          FOREND;

        PROCEND expand_wild_card_keyword;
?? TITLE := 'expand_wild_card_name', EJECT ??

        PROCEDURE [INLINE] expand_wild_card_name;

          VAR
            candidate: ^ost$name_reference,
            node: ^clt$data_value;


          result := NIL;
          node := candidate_list;
          result_node := ^result;
          WHILE node <> NIL DO
            CASE node^.element_value^.kind OF
            = clc$data_name =
              candidate := ^node^.element_value^.data_name_value;
            = clc$name =
              candidate := ^node^.element_value^.name_value;
            ELSE { clc$program_name }
              candidate := ^node^.element_value^.program_name_value;
            CASEND;

            clp$match_string_pattern (candidate^ (1, clp$trimmed_string_size (candidate^)), string_pattern,
                  clc$sp_anchored, clc$sp_quick_scan, match_info, status);
            IF NOT status.normal THEN
              EXIT evaluate_expression;
            ELSEIF match_info.result = clc$sp_success THEN
              result_node^ := node;
              result_sub_list_tail := result_node^;
              result_node := ^node^.link;
            IFEND;
            node := node^.link;
          WHILEND;

        PROCEND expand_wild_card_name;
?? TITLE := 'get_candidate_names', EJECT ??

        PROCEDURE get_candidate_names;

          VAR
            expression: ^clt$expression_text,
            function_name: clt$function_name,
            ignore_type_description: ^clt$type_description,
            lexical_units: ^clt$lexical_units,
            local_parse: clt$parse_state;


          IF expression_type_name = NIL THEN
            osp$set_status_condition (cle$wild_card_not_allowed, status);
            EXIT evaluate_expression;
          IFEND;

          IF expression_type_name^ (1) = '$' THEN
            function_name := expression_type_name^;
          ELSE
            function_name (1) := '$';
            function_name (2, * ) := expression_type_name^;
          IFEND;
          expression := ^function_name (1, clp$trimmed_string_size (function_name));

          clp$identify_lexical_units (expression, work_area, lexical_units, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;
          clp$initialize_parse_state (expression, lexical_units, local_parse);
          clp$scan_non_space_lexical_unit (local_parse);

          clp$evaluate_list_expression (1, clc$max_list_size, FALSE, current_type_description,
                work_area, local_parse, ignore_type_description,  candidate_list, status);
          IF NOT status.normal THEN
            EXIT evaluate_expression;
          IFEND;

          IF local_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (local_parse);
          IFEND;

          IF (local_parse.unit.kind <> clc$lex_end_of_line) OR (candidate_list^.kind = clc$unspecified) THEN
            osp$set_status_abnormal ('CL', cle$no_match_for_wild_card_name, wild_card_name^, status);
            EXIT evaluate_expression;
          IFEND;

        PROCEND get_candidate_names;
?? OLDTITLE, EJECT ??

*IF NOT $true(osv$unix)
        clp$find_scl_options (scl_options);
*IFEND

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
        clp$rescan_wild_card_lex_unit (parse);

        CASE parse.unit.kind OF
        = clc$lex_string, clc$lex_unterminated_string =
          RETURN;
        = clc$lex_wild_card_name =
          ;
        ELSE
*IF NOT $true(osv$unix)
          IF scl_options^.wild_card_pattern_type = clc$wc_basic_pattern THEN
            RETURN;
          IFEND;
*IFEND
          wild_card_chars := $chars ['[', '{'];
          #SCAN (wild_card_chars, parse.text^ (parse.unit_index, parse.unit.size), ignore_scan_index,
                scan_found_char);
          IF NOT scan_found_char THEN
            RETURN;
          IFEND;
        CASEND;

        PUSH wild_card_name: [parse.unit.size];
*IF NOT $true(osv$unix)
        IF scl_options^.wild_card_pattern_type = clc$wc_basic_pattern THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), wild_card_name^);
        ELSE
*IFEND
          #TRANSLATE (osv$lower_to_upper_26, parse.text^ (parse.unit_index, parse.unit.size),
                wild_card_name^);
*IF NOT $true(osv$unix)
        IFEND;
*IFEND

        clp$scan_any_lexical_unit (parse);
        recognize_binary_operator;

        IF defer_expansion THEN
          clp$make_application_value (wild_card_name^, work_area, result);
          IF result = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT evaluate_expression;
          IFEND;
          RETURN;
        IFEND;

        IF current_type_description^.kind <> clc$keyword_type THEN
          get_candidate_names;
        IFEND;

*IF NOT $true(osv$unix)
        clp$build_pattern_for_wild_card (scl_options^.wild_card_pattern_type,
*ELSE
        clp$build_pattern_for_wild_card (clc$wc_extended_pattern,
*IFEND
              $clt$string_pattern_build_opts [clc$sp_match_at_right, clc$sp_ignore_matched_substring],
              wild_card_name^, work_area, string_pattern, status);
        IF NOT status.normal THEN
          EXIT evaluate_expression;
        IFEND;

        IF current_type_description^.kind = clc$keyword_type THEN
          expand_wild_card_keyword;
        ELSE
          expand_wild_card_name;
        IFEND;

        IF result = NIL THEN
          osp$set_status_abnormal ('CL', cle$no_match_for_wild_card_name, wild_card_name^, status);
          EXIT evaluate_expression;
        IFEND;

        result_node^ := NIL;
        result^.generated_via_list_rest := FALSE;

      PROCEND handle_wild_card_name;
?? TITLE := 'recognize_binary_operator', EJECT ??

      PROCEDURE recognize_binary_operator;


        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

        CASE parse.unit.kind OF

        = clc$lex_greater_than .. clc$lex_not_equal =
          operator.representation := parse.text^ (parse.unit_index, parse.unit.size);
          operator.kind := clc$relational_operator;
          operator.relational_kind := parse.unit.kind;
          IF parse.unit.kind = clc$lex_equal THEN
            parse_saved_at_equal_operator := parse;
          IFEND;

        = clc$lex_concatenate =
          operator.representation := parse.text^ (parse.unit_index, parse.unit.size);
          operator.kind := clc$string_operator;

        = clc$lex_exponentiate .. clc$lex_subtract =
          operator.representation := parse.text^ (parse.unit_index, parse.unit.size);
          operator.kind := clc$arithmetic_operator;
          operator.arithmetic_kind := parse.unit.kind;

        = clc$lex_name =
          IF (clc$boolean_type IN current_type_description^.kinds) AND
                (clc$or_operator_size <= parse.unit.size) AND (parse.unit.size <= clc$max_operator_size) THEN
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size),
                  operator.representation);
            IF operator.representation = 'AND' THEN
              operator.kind := clc$logical_operator;
              operator.logical_kind := clc$and_operator;
            ELSEIF operator.representation = 'OR ' THEN
              operator.kind := clc$logical_operator;
              operator.logical_kind := clc$or_operator;
            ELSEIF operator.representation = 'XOR' THEN
              operator.kind := clc$logical_operator;
              operator.logical_kind := clc$xor_operator;
            ELSE
              operator.kind := clc$not_an_operator;
              RETURN;
            IFEND;

            IF NOT parse.previous_unit_is_space THEN
              osp$set_status_abnormal ('CL', cle$missing_spaces_before, operator.representation, status);
              EXIT evaluate_expression;
            IFEND;
            clp$scan_non_space_lexical_unit (parse);
            IF NOT parse.previous_unit_is_space THEN
              osp$set_status_abnormal ('CL', cle$missing_spaces_after, operator.representation, status);
              EXIT evaluate_expression;
            IFEND;

            operator_encountered := TRUE;

          ELSE
            operator.kind := clc$not_an_operator;
          IFEND;
          RETURN;

        ELSE
          operator.kind := clc$not_an_operator;
          RETURN;
        CASEND;

        clp$scan_non_space_lexical_unit (parse);

        operator_encountered := TRUE;

      PROCEND recognize_binary_operator;
?? TITLE := 'recognize_not_operator', EJECT ??

      FUNCTION [INLINE] recognize_not_operator: boolean;

        VAR
          name: string (clc$not_operator_size);


        recognize_not_operator := FALSE;
        IF (parse.unit.kind = clc$lex_name) AND (parse.unit.size = clc$not_operator_size) THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
          IF name = clc$not_operator_representation THEN
            recognize_not_operator := TRUE;
          IFEND;
        IFEND;

      FUNCEND recognize_not_operator;
?? TITLE := 'simplify_real_to_integer', EJECT ??

      PROCEDURE simplify_real_to_integer
        (VAR result {input, output} : ^clt$data_value;
         VAR integer_result: clt$data_value;
         VAR real_convertable_to_integer: boolean);

        VAR
          integer_as_real: clt$real,
          real_as_integer: integer;


        integer_result.kind := clc$unspecified;

*IF NOT $true(osv$unix)
        IF NOT ((result^.kind = clc$real) AND (clc$integer_type IN current_type_description^.kinds)) THEN
          real_convertable_to_integer := FALSE;
          RETURN;
        IFEND;

        clp$convert_real_to_integer (result^.real_value.value, real_as_integer, status);
        IF NOT status.normal THEN
          real_convertable_to_integer := FALSE;
          status.normal := TRUE;
          RETURN;
        IFEND;

        real_convertable_to_integer := TRUE;

        integer_result.kind := clc$integer;
        integer_result.integer_value.value := real_as_integer;
        integer_result.integer_value.radix := 10;
        integer_result.integer_value.radix_specified := FALSE;

        clp$convert_integer_to_real (real_as_integer, integer_as_real, status);
        IF NOT status.normal THEN
          EXIT evaluate_expression;
        IFEND;

        IF clp$longreal_compare_ne (result^.real_value.value, integer_as_real.value) THEN
          RETURN;
        IFEND;

        result^ := integer_result;
*ELSE
        real_convertable_to_integer := FALSE;
*IFEND

      PROCEND simplify_real_to_integer;
?? OLDTITLE, EJECT ??

      status.normal := TRUE;
      result := NIL;
      result_sub_list_tail := NIL;
      result_type_description := NIL;

      current_type_description := type_description;
      recognize_wild_cards := FALSE;
      defer_expansion := list_expansion = clc$defer_expansion;
      operand_type_description := NIL;
      operator.kind := clc$not_an_operator;
      operator_encountered := FALSE;
      access_variable_requests := $clt$access_variable_requests [clc$return_type_description];

      IF NOT numeric_info.initialized THEN
        numeric_info.initialized := TRUE;
        numeric_info.min_real_value := clv$negative_infinity^;
        numeric_info.max_real_value := clv$positive_infinity^;
        numeric_info.min_integer_value := clc$min_integer;
        numeric_info.max_integer_value := clc$max_integer;
        numeric_info.radix.default := 10;
        numeric_info.radix.established := FALSE;
      IFEND;
      numeric_info.sign := 1;

      CASE current_type_description^.kind OF
      = clc$application_type =
        evaluate_application_value (result);
      = clc$array_type =
        evaluate_array (result);
      = clc$boolean_type =
        evaluate_boolean (TRUE, result);
      = clc$cobol_name_type =
        evaluate_cobol_name (result);
      = clc$command_reference_type =
        evaluate_command_reference (result);
      = clc$data_name_type =
        recognize_wild_cards := (list_expansion <> clc$no_expansion) AND (defer_expansion OR
              (expression_type_name <> NIL));
        evaluate_data_name (result, result_sub_list_tail);
      = clc$date_time_type =
        evaluate_date_time (result);
      = clc$entry_point_reference_type =
        evaluate_entry_point_reference (result);
*IF NOT $true(osv$unix)
      = clc$file_type =
*ELSE
      = {clc$file_type} clc$nos_ve_file_type, clc$unix_file_type =
*IFEND
        recognize_wild_cards := list_expansion <> clc$no_expansion;
*IF NOT $true(osv$unix)
        evaluate_file (result, result_sub_list_tail);
*ELSE
        evaluate_file (TRUE, result, result_sub_list_tail);
*IFEND
      = clc$integer_type =
        numeric_info.min_integer_value := current_type_description^.min_integer_value;
        numeric_info.max_integer_value := current_type_description^.max_integer_value;
        numeric_info.radix.default := current_type_description^.default_radix;
        evaluate_number (TRUE, result);
      = clc$keyword_type =
        recognize_wild_cards := list_expansion <> clc$no_expansion;
        evaluate_keyword (result);
      = clc$list_type =
        evaluate_list (result);
      = clc$lock_type =
        evaluate_lock (result);
      = clc$name_type =
        recognize_wild_cards := (list_expansion <> clc$no_expansion) AND (defer_expansion OR
              (expression_type_name <> NIL));
        evaluate_name (result, result_sub_list_tail);
      = clc$network_title_type =
        evaluate_network_title (result);
      = clc$program_name_type =
        recognize_wild_cards := (list_expansion <> clc$no_expansion) AND (defer_expansion OR
              (expression_type_name <> NIL));
        evaluate_program_name (result, result_sub_list_tail);
      = clc$range_type =
        evaluate_range (result);
      = clc$real_type =
        numeric_info.min_real_value := current_type_description^.min_real_value.long_real;
        numeric_info.max_real_value := current_type_description^.max_real_value.long_real;
        evaluate_number (TRUE, result);
      = clc$record_type =
        evaluate_record (result);
      = clc$scu_line_identifier_type =
        evaluate_scu_line_identifier (result);
      = clc$statistic_code_type =
        evaluate_statistic_code (result);
      = clc$status_type =
        evaluate_status (result);
      = clc$status_code_type =
        evaluate_status_code (result);
      = clc$string_type, clc$string_pattern_type =
        evaluate_string_or_pattern (TRUE, result);
      = clc$time_increment_type =
        evaluate_time_increment (result);
      = clc$time_zone_type =
        evaluate_time_zone (result);
      = clc$type_specification_type =
        evaluate_type_specification (result);
      = clc$union_type =
        numeric_info.min_integer_value := current_type_description^.union_information^.min_integer_value;
        numeric_info.max_integer_value := current_type_description^.union_information^.max_integer_value;
        numeric_info.radix.default := current_type_description^.union_information^.default_radix;
        numeric_info.min_real_value := current_type_description^.union_information^.min_real_value.long_real;
        numeric_info.max_real_value := current_type_description^.union_information^.max_real_value.long_real;
        evaluate_union (result);
      ELSE
        osp$set_status_condition (cle$bad_type_description, status);
      CASEND;

      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF operator.kind <> clc$not_an_operator THEN
        IF parse.previous_non_space_unit.kind <> clc$lex_equal THEN
          osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, operator.representation, status);
          RETURN;
        IFEND;
        parse := parse_saved_at_equal_operator;
      IFEND;

      IF (operand_type_description <> NIL) AND (NOT operator_encountered) THEN
        result_type_description := operand_type_description;
      ELSE
        result_type_description := NIL;
      IFEND;

    PROCEND evaluate_expression;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    expression_type_name := type_description^.name;

    last_deref_result_type_desc := NIL;
    last_dereference_result := NIL;
    last_dereference_index := 1;
    last_dereference_name := '';
    last_dereference_parse.text := NIL;

    numeric_info.initialized := FALSE;
    got_present_date_time := FALSE;

*IF NOT $true(osv$unix)
    osp$establish_condition_handler (^dereference_name_reset_handler, FALSE);
*IFEND

    evaluate_expression (parse, type_description, FALSE, clc$no_expansion, numeric_info, result,
          ignore_sub_list_tail, status);

  PROCEND clp$internal_evaluate_expr;

MODEND clm$evaluate_expression;
