?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL : Value qualifier processing routines' ??
MODULE clm$process_value_qualifiers;

{
{ PURPOSE:
{   This module contains the procedures that process qualifiers of SCL
{   data value (fields of records, subscripts of arrays and lists,
{   range elements, and substring references).
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_integer
*copyc clc$min_integer
*copyc cle$bad_data_value
*copyc cle$ecc_lexical
*copyc cle$ecc_parsing
*IF $true(osv$unix)
*copyc cle$not_supported
*IFEND
*copyc cle$work_area_overflow
*copyc clt$access_variable_requests
*copyc clt$value_qualifiers
*copyc oss$job_paged_literal
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$append_status_string
*copyc clp$change_internal_value
*copyc clp$convert_ext_value_to_int
*copyc clp$convert_int_value_to_ext
*copyc clp$evaluate_integer_expression
*copyc clp$make_array_value
*copyc clp$make_boolean_value
*copyc clp$make_command_ref_value
*copyc clp$make_date_time_value
*copyc clp$make_entry_point_ref_value
*copyc clp$make_file_value
*copyc clp$make_integer_value
*copyc clp$make_keyword_value
*copyc clp$make_name_value
*copyc clp$make_program_name_value
*copyc clp$make_record_value
*copyc clp$make_scu_line_id_value
*copyc clp$make_status_code_value
*copyc clp$make_status_value
*copyc clp$make_string_value
*copyc clp$make_time_increment_value
*copyc clp$make_time_zone_value
*copyc clp$make_unspecified_value
*copyc clp$make_value
*copyc clp$scan_any_lexical_unit
*copyc clp$scan_non_space_lexical_unit
*copyc clp$trimmed_string_size
*copyc i#current_sequence_position
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*IF NOT $true(osv$unix)
*copyc pmp$get_compact_date_time
*IFEND

?? EJECT ??

{ Variables used by clp$get_write_value_qualifiers and clp$read_qualified_data_value.

  VAR
    clv$boolean_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$boolean_type], clc$boolean_type],
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$boolean_type], clc$boolean_type],
*IFEND
    clv$file_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$file_type], clc$file_type],
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$file_type], clc$file_type],
*IFEND
    clv$integer_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$integer_type], clc$integer_type, clc$min_integer,
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$integer_type], clc$integer_type, clc$min_integer,
*IFEND
          clc$max_integer, 10],
    clv$keyword_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$keyword_type], clc$keyword_type, ^clv$keyword_names],
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$keyword_type], clc$keyword_type, ^clv$keyword_names],
*IFEND
    clv$name_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$name_type], clc$name_type, 1, osc$max_name_size],
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$name_type], clc$name_type, 1, osc$max_name_size],
*IFEND
    clv$pgm_name_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$program_name_type], clc$program_name_type],
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$program_name_type], clc$program_name_type],
*IFEND
    clv$scu_mod_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$name_type], clc$name_type, 1,
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$name_type], clc$name_type, 1,
*IFEND
          clc$max_scu_modification_name],
    clv$stat_code_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$status_code_type], clc$status_code_type],
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$status_code_type], clc$status_code_type],
*IFEND
    clv$string_type_description: [XDCL, STATIC, READ, oss$job_paged_literal] clt$type_description :=
*IF NOT $true(osv$unix)
          [NIL, NIL, FALSE, FALSE, $clt$type_kinds [clc$string_type], clc$string_type, 0, clc$max_string_size,
*ELSE
          [NIL, NIL, FALSE, FALSE, [clc$string_type], clc$string_type, 0, clc$max_string_size,
*IFEND
          FALSE],
    clv$keyword_names: [XDCL, STATIC, READ, oss$job_paged_literal] array [1 .. 6] of
          clt$keyword_specification := [['FILE_CYCLE', clc$nominal_entry, clc$normal_usage_entry, 1],
          ['MODULE_OR_FILE', clc$nominal_entry, clc$normal_usage_entry, 2],
          ['NAME_ONLY', clc$nominal_entry, clc$normal_usage_entry, 3],
          ['SKIP_FIRST_ENTRY', clc$nominal_entry, clc$normal_usage_entry, 4],
          ['SYSTEM', clc$nominal_entry, clc$normal_usage_entry, 5],
          ['UTILITY', clc$nominal_entry, clc$normal_usage_entry, 6]];

*IF NOT $true(osv$unix)
?? TITLE := 'clp$get_qualified_type_desc', EJECT ??

  PROCEDURE [XDCL] clp$get_qualified_type_desc
    (    value_qualifiers: ^clt$value_qualifiers;
     VAR type_description {input, output} : ^clt$type_description);

    VAR
      index: integer;

?? NEWTITLE := 'evaluate_field_qualifier', EJECT ??

    PROCEDURE evaluate_field_qualifier
      (    field_name: clt$field_name);

      VAR
        field_names: ^clt$pdt_parameter_names,
        i: clt$field_number,
        record_field_name: clt$field_name;


      CASE type_description^.kind OF
      = clc$command_reference_type =
        IF (field_name = 'NAME') OR (field_name = 'UTILITY') THEN
          type_description := ^clv$name_type_description;
        ELSEIF field_name = 'FORM' THEN
          type_description := ^clv$keyword_type_description;
        ELSEIF field_name = 'LIBRARY_OR_CATALOG' THEN
          type_description := ^clv$file_type_description;
        ELSE {IF field_name = 'CYCLE_NUMBER' THEN
          type_description := ^clv$integer_type_description;
        IFEND;
      = clc$date_time_type =
        type_description := ^clv$integer_type_description;
      = clc$entry_point_reference_type =
        IF field_name = 'ENTRY_POINT' THEN
          type_description := ^clv$pgm_name_type_description;
        ELSE {IF field_name = 'OBJECT_LIBRARY' THEN
          type_description := ^clv$file_type_description;
        IFEND;
      = clc$range_type =
        type_description := type_description^.range_element_type_description;
      = clc$record_type =
        IF (type_description^.fields_pdt <> NIL) THEN
          field_names := type_description^.fields_pdt^.names;
          FOR i := 1 TO UPPERBOUND (field_names^) DO
            #TRANSLATE (osv$lower_to_upper, field_names^ [i].name, record_field_name);
            IF record_field_name = field_name THEN
              type_description := ^type_description^.fields_pdt^.type_descriptions^ [i];
              RETURN;
            IFEND;
          FOREND;
        IFEND;
      = clc$scu_line_identifier_type =
        IF field_name = 'MODIFICATION_NAME' THEN
          type_description := ^clv$scu_mod_type_description;
        ELSE {IF field_name = 'SEQUENCE_NUMBER' THEN
          type_description := ^clv$integer_type_description;
        IFEND;
      = clc$status_type =
        IF field_name = 'NORMAL' THEN
          type_description := ^clv$boolean_type_description;
        ELSEIF field_name = 'CONDITION' THEN
          type_description := ^clv$stat_code_type_description;
        ELSE {IF field_name = 'TEXT' THEN
          type_description := ^clv$string_type_description;
        IFEND;
      = clc$time_increment_type =
        type_description := ^clv$integer_type_description;
      = clc$time_zone_type =
        IF (field_name = 'HOURS_FROM_GMT') OR (field_name = 'MINUTES_OFFSET') THEN
          type_description := ^clv$integer_type_description;
        ELSE {IF field_name = 'DAYLIGHT_SAVING_TIME' THEN
          type_description := ^clv$boolean_type_description;
        IFEND;
      CASEND;

    PROCEND evaluate_field_qualifier;
?? OLDTITLE, EJECT ??

{
{ This procedure assumes that:
{   1.  The value qualifiers have been verified against the type description.
{   2.  Currently, the only valid qualifiers are clc$array_subscript,
{       clc$field_qualifier, clc$list_subscript_qualifier, clc$substring_qualifier.
{       Unspecified and invalid qualifiers are NOT allowed because this would
{       constitute a clc$union_type in the type description.  This is not allowed
{       at this point.
{


    FOR index := 1 TO UPPERBOUND (value_qualifiers^) DO
      CASE value_qualifiers^ [index].kind OF
      = clc$array_subscript_qualifier =
        type_description := type_description^.array_element_type_description;
      = clc$field_qualifier =
        evaluate_field_qualifier (value_qualifiers^ [index].field_name);
      = clc$list_subscript_qualifier =
        type_description := type_description^.list_element_type_description;
      = clc$substring_qualifier =
      ELSE
        ;
      CASEND;
    FOREND;

  PROCEND clp$get_qualified_type_desc;
*IFEND
?? TITLE := 'clp$get_read_value_qualifiers', EJECT ??

  PROCEDURE [XDCL] clp$get_read_value_qualifiers
    (    name: clt$variable_name;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR value_qualifiers: ^clt$value_qualifiers;
     VAR status: ost$status);

    TYPE
      value_qualifier_list = record
        link: ^value_qualifier_list,
        value: clt$value_qualifier,
      recend;

    VAR
      first_value_qualifier: ^value_qualifier_list,
      i: integer,
      invalid_subscript_defined: boolean,
      invalid_size_defined: boolean,
      invalid_qualifier_created: boolean,
      invalid_qualifier_separator: char,
      invalid_qualifier_subscript: clt$array_bound,
      invalid_qualifier_size: clt$string_size,
      last_value_qualifier: ^value_qualifier_list,
      local_parse: clt$parse_state,
      local_status: ost$status,
      new_value_qualifier: ^value_qualifier_list,
      number_of_value_qualifiers: integer,
      sub_integer: clt$integer;

?? NEWTITLE := 'create_invalid_qualifier', EJECT ??

    PROCEDURE create_invalid_qualifier
      (    kind: clt$value_qualifier_kind);

      VAR
        status_ptr: ^ost$status;


      invalid_qualifier_created := TRUE;

      NEXT status_ptr IN work_area;
      IF status_ptr = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT clp$get_read_value_qualifiers;
      IFEND;
      status_ptr^ := local_status;

      new_value_qualifier^.value.kind := kind;
      CASE kind OF
      = clc$invalid_field_qualifier =
        new_value_qualifier^.value.invalid_field_status := status_ptr;

      = clc$invalid_subscript_qual =
        new_value_qualifier^.value.invalid_subscript_status := status_ptr;
        new_value_qualifier^.value.subscript_defined := invalid_subscript_defined;
        IF invalid_subscript_defined THEN
          new_value_qualifier^.value.invalid_subscript := invalid_qualifier_subscript;
        IFEND;

      = clc$invalid_substring_qual =
        new_value_qualifier^.value.invalid_index := invalid_qualifier_subscript;
        new_value_qualifier^.value.invalid_separator := invalid_qualifier_separator;
        new_value_qualifier^.value.invalid_substring_status := status_ptr;
        new_value_qualifier^.value.size_defined := invalid_size_defined;
        IF invalid_size_defined THEN
          new_value_qualifier^.value.invalid_size := invalid_qualifier_size;
        IFEND;

      CASEND;

    PROCEND create_invalid_qualifier;
?? TITLE := 'evaluate_field_qualifier', EJECT ??

    PROCEDURE evaluate_field_qualifier;

      VAR
        field_name: clt$field_name;


      #TRANSLATE (osv$lower_to_upper, local_parse.text^ (local_parse.unit_index, local_parse.unit.size),
            field_name);

      new_value_qualifier^.value.kind := clc$unspecified_field_qualifier;
      new_value_qualifier^.value.field_name := field_name;
      new_value_qualifier^.value.record_kind := clc$unknown_record;

    PROCEND evaluate_field_qualifier;
?? TITLE := 'evaluate_subscript_qual', EJECT ??

    PROCEDURE evaluate_subscript_qual;

      VAR
        separator: char,
        substring_size_present: boolean,
        sub_index: integer,
        sub_name: ost$name,
        sub_size: integer;


      IF local_parse.unit.kind = clc$lex_comma THEN
        substring_size_present := TRUE;
        separator := ',';
        clp$scan_non_space_lexical_unit (local_parse);
      ELSEIF local_parse.unit.kind = clc$lex_right_parenthesis THEN
        substring_size_present := FALSE;
      ELSEIF local_parse.previous_unit_is_space THEN
        substring_size_present := TRUE;
        separator := ' ';
      ELSE
        substring_size_present := FALSE;
      IFEND;

      IF substring_size_present THEN

        sub_index := sub_integer.value;

      /get_substring_size/
        BEGIN
          IF local_parse.unit.kind = clc$lex_name THEN
            #TRANSLATE (osv$lower_to_upper, local_parse.text^ (local_parse.unit_index, local_parse.unit.size),
                  sub_name);
            IF sub_name = 'ALL' THEN
              sub_size := 0;
              clp$scan_non_space_lexical_unit (local_parse);
              EXIT /get_substring_size/;
            IFEND;
          IFEND;

          clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, local_parse,
                sub_integer, local_status);
          IF NOT local_status.normal THEN
            invalid_qualifier_subscript := sub_index;
            invalid_qualifier_separator := separator;
            invalid_size_defined := FALSE;
            create_invalid_qualifier (clc$invalid_substring_qual);
            RETURN;
          IFEND;
          IF local_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (local_parse);
          IFEND;

          sub_size := sub_integer.value;
        END /get_substring_size/;

        new_value_qualifier^.value.kind := clc$unspecified_substring_qual;
        new_value_qualifier^.value.unspecified_index := sub_index;
        new_value_qualifier^.value.unspecified_size := sub_size;
        new_value_qualifier^.value.unspecified_all_found := sub_name = 'ALL';
        new_value_qualifier^.value.unspecified_separator := separator;

      ELSE

        new_value_qualifier^.value.kind := clc$unspecified_subscript_qual;
        new_value_qualifier^.value.unspecified_subscript := sub_integer.value;

      IFEND;

    PROCEND evaluate_subscript_qual;
?? OLDTITLE, EJECT ??


{
{ This procedure will return unspecified and invalid qualifiers only.
{ Qualifiers are marked as unspecified (i.e. clc$unspecified_substring_qualifier
{ vs clc$substring_qualifier) because the qualifiers are NOT validated against
{ the actual value or type description.
{


    status.normal := TRUE;
    local_parse := parse;
    first_value_qualifier := NIL;
    last_value_qualifier := NIL;
    new_value_qualifier := NIL;
    number_of_value_qualifiers := 0;
    invalid_qualifier_created := FALSE;
    local_status.normal := TRUE;

  /get_qualifiers/
    WHILE NOT invalid_qualifier_created DO

      PUSH new_value_qualifier;
      NEXT new_value_qualifier^.value.parse IN work_area;
      IF new_value_qualifier^.value.parse = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
      new_value_qualifier^.value.parse^ := local_parse;

      CASE local_parse.unit.kind OF
      = clc$lex_left_parenthesis =
        clp$scan_any_lexical_unit (local_parse);
        clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, local_parse,
              sub_integer, local_status);
        IF NOT local_status.normal THEN
          invalid_subscript_defined := FALSE;
          create_invalid_qualifier (clc$invalid_subscript_qual);
        ELSE
          IF local_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (local_parse);
          IFEND;

          evaluate_subscript_qual;

          IF (NOT invalid_qualifier_created) AND (local_parse.unit.kind <> clc$lex_right_parenthesis) THEN
            IF new_value_qualifier^.value.kind = clc$unspecified_substring_qual THEN
              invalid_qualifier_subscript := new_value_qualifier^.value.unspecified_index;
              invalid_qualifier_separator := new_value_qualifier^.value.unspecified_separator;
              invalid_size_defined := NOT new_value_qualifier^.value.unspecified_all_found;
              IF invalid_size_defined THEN
                invalid_qualifier_size := new_value_qualifier^.value.unspecified_size;
              IFEND;
              osp$set_status_abnormal ('CL', cle$expecting_rparen_of_substr, name, local_status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, local_status);
              create_invalid_qualifier (clc$invalid_substring_qual);
            ELSE
              invalid_subscript_defined := TRUE;
              invalid_qualifier_subscript := new_value_qualifier^.value.unspecified_subscript;
              osp$set_status_abnormal ('CL', cle$expecting_rparen_of_subscr, name, local_status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, local_status);
              create_invalid_qualifier (clc$invalid_subscript_qual);
            IFEND;
          IFEND;
        IFEND;

      = clc$lex_dot =

        clp$scan_any_lexical_unit (local_parse);

        CASE local_parse.unit.kind OF
        = clc$lex_name =
          evaluate_field_qualifier;

        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, local_parse.
                text^ (local_parse.unit_index, local_parse.unit.size), local_status);
          create_invalid_qualifier (clc$invalid_field_qualifier);

        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_field_name, name, local_status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, local_status);
          create_invalid_qualifier (clc$invalid_field_qualifier);
        CASEND;

      ELSE
        EXIT /get_qualifiers/;
      CASEND;

      new_value_qualifier^.link := NIL;
      IF first_value_qualifier = NIL THEN
        first_value_qualifier := new_value_qualifier;
      ELSE
        last_value_qualifier^.link := new_value_qualifier;
      IFEND;
      last_value_qualifier := new_value_qualifier;
      number_of_value_qualifiers := number_of_value_qualifiers + 1;

      clp$scan_any_lexical_unit (local_parse);
    WHILEND /get_qualifiers/;

    IF number_of_value_qualifiers > 0 THEN
      NEXT value_qualifiers: [1 .. number_of_value_qualifiers] IN work_area;
      IF value_qualifiers = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
    IFEND;

    new_value_qualifier := first_value_qualifier;
    FOR i := 1 TO number_of_value_qualifiers DO
      value_qualifiers^ [i] := new_value_qualifier^.value;
      new_value_qualifier := new_value_qualifier^.link;
    FOREND;

    parse := local_parse;

  PROCEND clp$get_read_value_qualifiers;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$get_write_value_qualifiers', EJECT ??

  PROCEDURE [XDCL] clp$get_write_value_qualifiers
    (    name: clt$variable_name;
     VAR type_description {input, output} : ^clt$type_description;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR value_qualifiers: ^clt$value_qualifiers;
     VAR status: ost$status);

    TYPE
      value_qualifier_list = record
        link: ^value_qualifier_list,
        value: clt$value_qualifier,
      recend;

    VAR
      first_value_qualifier: ^value_qualifier_list,
      i: integer,
      last_value_qualifier: ^value_qualifier_list,
      local_parse: clt$parse_state,
      local_type_description: ^clt$type_description,
      new_value_qualifier: ^value_qualifier_list,
      number_of_value_qualifiers: integer,
      sub_integer: clt$integer,
      unspecified_qualifiers_created: boolean;

?? NEWTITLE := 'evaluate_any_field_qualifier', EJECT ??

    PROCEDURE evaluate_any_field_qualifier;

      VAR
        field_name: clt$field_name;


      #TRANSLATE (osv$lower_to_upper, local_parse.text^ (local_parse.unit_index, local_parse.unit.size),
            field_name);

      new_value_qualifier^.value.kind := clc$unspecified_field_qualifier;
      new_value_qualifier^.value.field_name := field_name;
      new_value_qualifier^.value.record_kind := clc$unknown_record;

    PROCEND evaluate_any_field_qualifier;
?? TITLE := 'evaluate_any_subscript_qual', EJECT ??

    PROCEDURE evaluate_any_subscript_qual;

      VAR
        substring_size_present: boolean,
        sub_index: clt$string_index,
        sub_name: ost$name,
        sub_size: clt$string_size;


      IF local_parse.unit.kind = clc$lex_comma THEN
        substring_size_present := TRUE;
        clp$scan_non_space_lexical_unit (local_parse);
      ELSEIF local_parse.unit.kind = clc$lex_right_parenthesis THEN
        substring_size_present := FALSE;
      ELSEIF local_parse.previous_unit_is_space THEN
        substring_size_present := TRUE;
      ELSE
        substring_size_present := FALSE;
      IFEND;

      IF substring_size_present THEN

        sub_index := sub_integer.value;

      /get_substring_size/
        BEGIN
          IF local_parse.unit.kind = clc$lex_name THEN
            #TRANSLATE (osv$lower_to_upper, local_parse.text^ (local_parse.unit_index, local_parse.unit.size),
                  sub_name);
            IF sub_name = 'ALL' THEN
              sub_size := 0;
              clp$scan_non_space_lexical_unit (local_parse);
              EXIT /get_substring_size/;
            IFEND;
          IFEND;

          clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, local_parse,
                sub_integer, status);
          IF NOT status.normal THEN
            EXIT clp$get_write_value_qualifiers;
          IFEND;
          IF local_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (local_parse);
          IFEND;

          sub_size := sub_integer.value;
        END /get_substring_size/;

        new_value_qualifier^.value.kind := clc$unspecified_substring_qual;
        new_value_qualifier^.value.unspecified_index := sub_index;
        new_value_qualifier^.value.unspecified_size := sub_size;
        new_value_qualifier^.value.unspecified_all_found := sub_name = 'ALL';

      ELSE

        new_value_qualifier^.value.kind := clc$unspecified_subscript_qual;
        new_value_qualifier^.value.unspecified_subscript := sub_integer.value;

      IFEND;

    PROCEND evaluate_any_subscript_qual;
?? TITLE := 'evaluate_array_subscript_qual', EJECT ??

    PROCEDURE evaluate_array_subscript_qual;


      IF (NOT local_type_description^.array_bounds_defined) OR
            (sub_integer.value < local_type_description^.bounds.lower) OR
            (sub_integer.value > local_type_description^.bounds.upper) THEN
        osp$set_status_abnormal ('CL', cle$subscript_out_of_range, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_integer.value, sub_integer.radix,
              sub_integer.radix_specified, status);
        osp$append_status_integer (osc$status_parameter_delimiter, local_type_description^.bounds.lower,
              sub_integer.radix, sub_integer.radix_specified, status);
        osp$append_status_integer (osc$status_parameter_delimiter, local_type_description^.bounds.upper,
              sub_integer.radix, sub_integer.radix_specified, status);
        EXIT clp$get_write_value_qualifiers;
      IFEND;

      IF local_type_description^.array_element_type_description = NIL THEN
        osp$set_status_abnormal ('CL', cle$undefined_subscr_element, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_integer.value, sub_integer.radix,
              sub_integer.radix_specified, status);
        EXIT clp$get_write_value_qualifiers;
      IFEND;

      new_value_qualifier^.value.kind := clc$array_subscript_qualifier;
      new_value_qualifier^.value.array_subscript := sub_integer.value;
      new_value_qualifier^.value.bounds := local_type_description^.bounds;
      local_type_description := local_type_description^.array_element_type_description;

    PROCEND evaluate_array_subscript_qual;
?? TITLE := 'evaluate_field_qualifier', EJECT ??

    PROCEDURE evaluate_field_qualifier;

      VAR
        field_name: clt$field_name,
        field_names: ^clt$pdt_parameter_names,
        i: clt$field_number,
        record_field_name: clt$field_name,
        record_kind: clt$value_qualifier_records;


      #TRANSLATE (osv$lower_to_upper, local_parse.text^ (local_parse.unit_index, local_parse.unit.size),
            field_name);

    /find_field/
      BEGIN
        CASE local_type_description^.kind OF
        = clc$command_reference_type =
          IF (field_name = 'NAME') OR (field_name = 'UTILITY') THEN
            local_type_description := ^clv$name_type_description;
          ELSEIF field_name = 'FORM' THEN
            local_type_description := ^clv$keyword_type_description;
          ELSEIF (field_name = 'LIBRARY_OR_CATALOG') THEN
            local_type_description := ^clv$file_type_description;
          ELSEIF (field_name = 'CYCLE_NUMBER') THEN
            local_type_description := ^clv$integer_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$command_reference_record;
        = clc$date_time_type =
          IF (field_name = 'YEAR') OR (field_name = 'MONTH') OR (field_name = 'DAY') OR
                (field_name = 'HOUR') OR (field_name = 'MINUTE') OR (field_name = 'SECOND') OR (field_name =
                'MILLISECOND') THEN
            local_type_description := ^clv$integer_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$date_time_record;
        = clc$entry_point_reference_type =
          IF field_name = 'ENTRY_POINT' THEN
            local_type_description := ^clv$pgm_name_type_description;
          ELSEIF field_name = 'OBJECT_LIBRARY' THEN
            local_type_description := ^clv$file_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$entry_point_ref_record;
        = clc$range_type =
          IF (field_name = 'HIGH') OR (field_name = 'LOW') THEN
            local_type_description := local_type_description^.range_element_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$unknown_record;

        = clc$record_type =
          IF (local_type_description^.fields_pdt <> NIL) THEN
            field_names := local_type_description^.fields_pdt^.names;

          /find_record/
            BEGIN
              FOR i := 1 TO UPPERBOUND (field_names^) DO
                #TRANSLATE (osv$lower_to_upper, field_names^ [i].name, record_field_name);
                IF record_field_name = field_name THEN
                  IF local_type_description^.fields_pdt^.type_descriptions = NIL THEN
                    osp$set_status_abnormal ('CL', cle$undefined_field, field_name, status);
                    osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
                    EXIT clp$get_write_value_qualifiers;
                  IFEND;
                  local_type_description := ^local_type_description^.fields_pdt^.type_descriptions^ [i];
                  record_kind := clc$record_record;
                  EXIT /find_record/;
                IFEND;
              FOREND;
              EXIT /find_field/;
            END /find_record/;
          ELSE
            EXIT /find_field/;
          IFEND;
        = clc$scu_line_identifier_type =
          IF field_name = 'MODIFICATION_NAME' THEN
            local_type_description := ^clv$scu_mod_type_description;
          ELSEIF field_name = 'SEQUENCE_NUMBER' THEN
            local_type_description := ^clv$integer_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$scu_line_ident_record;
        = clc$status_type =
          IF field_name = 'NORMAL' THEN
            local_type_description := ^clv$boolean_type_description;
          ELSEIF field_name = 'CONDITION' THEN
            local_type_description := ^clv$stat_code_type_description;
          ELSEIF field_name = 'TEXT' THEN
            local_type_description := ^clv$string_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$status_record;
        = clc$time_increment_type =
          IF (field_name = 'YEARS') OR (field_name = 'MONTHS') OR (field_name = 'DAYS') OR (field_name =
                'HOURS') OR (field_name = 'MINUTES') OR (field_name = 'SECONDS') OR (field_name =
                'MILLISECONDS') THEN
            local_type_description := ^clv$integer_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$time_increment_record;
        = clc$time_zone_type =
          IF (field_name = 'HOURS_FROM_GMT') OR (field_name = 'MINUTES_OFFSET') THEN
            local_type_description := ^clv$integer_type_description;
          ELSEIF field_name = 'DAYLIGHT_SAVING_TIME' THEN
            local_type_description := ^clv$boolean_type_description;
          ELSE
            EXIT /find_field/;
          IFEND;
          record_kind := clc$time_zone_record;

        CASEND;

        new_value_qualifier^.value.kind := clc$field_qualifier;
        new_value_qualifier^.value.field_name := field_name;
        new_value_qualifier^.value.record_kind := record_kind;
        IF record_kind = clc$record_record THEN
          new_value_qualifier^.value.field_names := field_names;
        IFEND;
        RETURN;

      END /find_field/;

      IF local_type_description^.kind = clc$range_type THEN
        osp$set_status_abnormal ('CL', cle$unknown_range_selector, field_name, status);
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_field, field_name, status);
      IFEND;
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);

    PROCEND evaluate_field_qualifier;
?? TITLE := 'evaluate_list_subscript_qual', EJECT ??

    PROCEDURE evaluate_list_subscript_qual;


      IF sub_integer.value < 1 THEN
        osp$set_status_abnormal ('CL', cle$list_subscript_too_small, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_integer.value, sub_integer.radix,
              sub_integer.radix_specified, status);
        EXIT clp$get_write_value_qualifiers;
      ELSEIF sub_integer.value > local_type_description^.max_list_size THEN
        osp$set_status_abnormal ('CL', cle$max_list_subscript_error, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_integer.value, sub_integer.radix,
              sub_integer.radix_specified, status);
        osp$append_status_integer (osc$status_parameter_delimiter, local_type_description^.max_list_size, 10,
              FALSE, status);
        EXIT clp$get_write_value_qualifiers;
      IFEND;

      IF local_type_description^.list_element_type_description = NIL THEN
        osp$set_status_abnormal ('CL', cle$undefined_subscr_element, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_integer.value, sub_integer.radix,
              sub_integer.radix_specified, status);
        EXIT clp$get_write_value_qualifiers;
      IFEND;
      local_type_description := local_type_description^.list_element_type_description;

      new_value_qualifier^.value.kind := clc$list_subscript_qualifier;
      new_value_qualifier^.value.list_subscript := sub_integer.value;

    PROCEND evaluate_list_subscript_qual;
?? TITLE := 'evaluate_substring_qualifier', EJECT ??

    PROCEDURE evaluate_substring_qualifier;

      VAR
        string_size: clt$string_size,
        substring_size_present: boolean,
        sub_index: clt$string_index,
        sub_name: ost$name,
        sub_size: integer;


      IF local_parse.unit.kind = clc$lex_comma THEN
        substring_size_present := TRUE;
        clp$scan_non_space_lexical_unit (local_parse);
      ELSEIF local_parse.unit.kind = clc$lex_right_parenthesis THEN
        substring_size_present := FALSE;
      ELSEIF local_parse.previous_unit_is_space THEN
        substring_size_present := TRUE;
      ELSE
        substring_size_present := FALSE;
      IFEND;
      sub_name := ' ';

      IF (sub_integer.value < 1) OR (sub_integer.value > (local_type_description^.max_string_size + 1)) THEN
        osp$set_status_abnormal ('CL', cle$max_substr_index_error, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_integer.value, sub_integer.radix,
              sub_integer.radix_specified, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              local_type_description^.max_string_size + 1, sub_integer.radix, sub_integer.radix_specified,
              status);
        EXIT clp$get_write_value_qualifiers;
      IFEND;

      sub_index := sub_integer.value;
      string_size := local_type_description^.max_string_size + 1 - sub_index;

      IF substring_size_present THEN

      /get_substring_size/
        BEGIN
          IF local_parse.unit.kind = clc$lex_name THEN
            #TRANSLATE (osv$lower_to_upper, local_parse.text^ (local_parse.unit_index, local_parse.unit.size),
                  sub_name);
            IF sub_name = 'ALL' THEN
              sub_size := string_size;
              clp$scan_non_space_lexical_unit (local_parse);
              EXIT /get_substring_size/;
            IFEND;
          IFEND;

          clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, local_parse,
                sub_integer, status);
          IF NOT status.normal THEN
            EXIT clp$get_write_value_qualifiers;
          IFEND;
          IF local_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (local_parse);
          IFEND;
          sub_size := sub_integer.value;
        END /get_substring_size/;

      ELSE
        sub_size := 1;
      IFEND;

      IF (sub_size < 0) OR (sub_size > string_size) THEN
        osp$set_status_abnormal ('CL', cle$substr_size_out_of_range, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sub_size, sub_integer.radix,
              sub_integer.radix_specified, status);
        osp$append_status_integer (osc$status_parameter_delimiter, string_size, sub_integer.radix,
              sub_integer.radix_specified, status);
        EXIT clp$get_write_value_qualifiers;
      IFEND;

      new_value_qualifier^.value.kind := clc$substring_qualifier;
      new_value_qualifier^.value.index := sub_index;
      new_value_qualifier^.value.size := sub_size;
      new_value_qualifier^.value.all_specified := sub_name = 'ALL';

    PROCEND evaluate_substring_qualifier;
?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    local_parse := parse;
    local_type_description := type_description;
    unspecified_qualifiers_created := FALSE;
    first_value_qualifier := NIL;
    last_value_qualifier := NIL;
    new_value_qualifier := NIL;
    number_of_value_qualifiers := 0;

  /get_qualifiers/
    WHILE TRUE DO
      CASE local_parse.unit.kind OF
      = clc$lex_left_parenthesis =
        CASE local_type_description^.kind OF
        = clc$array_type, clc$list_type, clc$string_type, clc$union_type =

          clp$scan_any_lexical_unit (local_parse);
          clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, local_parse,
                sub_integer, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF local_parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (local_parse);
          IFEND;

          PUSH new_value_qualifier;

          CASE local_type_description^.kind OF
          = clc$array_type =
            evaluate_array_subscript_qual;
          = clc$list_type =
            evaluate_list_subscript_qual;
          = clc$string_type =
            evaluate_substring_qualifier;
          = clc$union_type =
            evaluate_any_subscript_qual;
            unspecified_qualifiers_created := TRUE;
          CASEND;

          IF local_parse.unit.kind <> clc$lex_right_parenthesis THEN
            IF new_value_qualifier^.value.kind = clc$substring_qualifier THEN
              osp$set_status_abnormal ('CL', cle$expecting_rparen_of_substr, name, status);
            ELSE
              osp$set_status_abnormal ('CL', cle$expecting_rparen_of_subscr, name, status);
            IFEND;
            clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, status);
            RETURN;
          IFEND;

        ELSE
          EXIT /get_qualifiers/;
        CASEND;

      = clc$lex_dot =

        CASE local_type_description^.kind OF
        = clc$command_reference_type, clc$date_time_type, clc$entry_point_reference_type, clc$range_type,
              clc$record_type, clc$scu_line_identifier_type, clc$status_type, clc$time_increment_type,
              clc$time_zone_type, clc$union_type =

          clp$scan_any_lexical_unit (local_parse);
          CASE local_parse.unit.kind OF
          = clc$lex_name =
            PUSH new_value_qualifier;
            IF local_type_description^.kind = clc$union_type THEN
              evaluate_any_field_qualifier;
              unspecified_qualifiers_created := TRUE;
            ELSE
              evaluate_field_qualifier;
            IFEND;

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

          ELSE
            osp$set_status_abnormal ('CL', cle$expecting_field_name, name, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, local_parse, status);
            RETURN;
          CASEND;

        ELSE
          EXIT /get_qualifiers/;
        CASEND;

      ELSE
        EXIT /get_qualifiers/;
      CASEND;

      new_value_qualifier^.link := NIL;
      IF first_value_qualifier = NIL THEN
        first_value_qualifier := new_value_qualifier;
      ELSE
        last_value_qualifier^.link := new_value_qualifier;
      IFEND;
      last_value_qualifier := new_value_qualifier;
      number_of_value_qualifiers := number_of_value_qualifiers + 1;

      clp$scan_any_lexical_unit (local_parse);
    WHILEND /get_qualifiers/;

    IF number_of_value_qualifiers > 0 THEN
      NEXT value_qualifiers: [1 .. number_of_value_qualifiers] IN work_area;
      IF value_qualifiers = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
    IFEND;

    new_value_qualifier := first_value_qualifier;
    FOR i := 1 TO number_of_value_qualifiers DO
      value_qualifiers^ [i] := new_value_qualifier^.value;
      new_value_qualifier := new_value_qualifier^.link;
    FOREND;

    parse := local_parse;
    IF unspecified_qualifiers_created THEN
      type_description := NIL;
    ELSE
      type_description := local_type_description;
    IFEND;

  PROCEND clp$get_write_value_qualifiers;
*IFEND
?? TITLE := 'clp$read_qualified_data_value', EJECT ??

  PROCEDURE [XDCL] clp$read_qualified_data_value
    (    name: clt$variable_name;
         access_variable_requests: clt$access_variable_requests;
         var_parameter_value_qualifiers: ^clt$value_qualifiers;
         internal_value: ^clt$internal_data_value;
     VAR data_value {input, output} : ^clt$data_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR type_description {input, output} : ^clt$type_description;
     VAR parse_value_qualifiers {input, output} : ^clt$value_qualifiers;
     VAR parse_value_qualifier_index: integer;
     VAR status: ost$status);

    VAR
      all_specified: boolean,
      convert_nil_value_to_unspec: boolean,
      evaluating_parse_qualifiers: boolean,
      i_value: ^clt$i_data_value,
      index: integer,
      kind: clt$data_kind,
      local_type_description: ^clt$type_description,
      local_value: ^clt$data_value,
      local_value_qualifiers: ^clt$value_qualifiers,
      possible_file_reference: boolean,
      reset_parse: boolean,
      return_type_description: boolean,
      return_parse_value_qualifiers: boolean,
{
{ Specified_index, specified_size, and subscript are defined as integer.
{ Unspecified and invalid value_qualifier information has not been validated yet.
{
      specified_index: integer,
      specified_size: integer,
      subscript: integer;

?? NEWTITLE := 'evaluate_array_subscript_qual', EJECT ??

    PROCEDURE evaluate_array_subscript_qual;

      VAR
        elements: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value,
        lower_bound: clt$array_bound,
        upper_bound: clt$array_bound;


      IF i_value <> NIL THEN
        elements := #PTR (i_value^.array_value, internal_value^);
        lower_bound := LOWERBOUND (elements^);
        upper_bound := UPPERBOUND (elements^);
      ELSE
        lower_bound := LOWERBOUND (local_value^.array_value^);
        upper_bound := UPPERBOUND (local_value^.array_value^);
      IFEND;

      IF (subscript < lower_bound) OR (subscript > upper_bound) THEN
        osp$set_status_abnormal ('CL', cle$subscript_out_of_range, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, subscript, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, lower_bound, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, upper_bound, 10, FALSE, status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      IF i_value <> NIL THEN
        i_value := #PTR (elements^ [subscript], internal_value^);
      ELSE
        local_value := local_value^.array_value^ [subscript];
      IFEND;

      IF (i_value = NIL) AND (local_value = NIL) THEN
        osp$set_status_abnormal ('CL', cle$undefined_subscr_element, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, subscript, 10, FALSE, status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      IF return_parse_value_qualifiers AND evaluating_parse_qualifiers THEN
        local_value_qualifiers^ [index].kind := clc$array_subscript_qualifier;
        local_value_qualifiers^ [index].array_subscript := subscript;
        local_value_qualifiers^ [index].bounds.lower := lower_bound;
        local_value_qualifiers^ [index].bounds.upper := upper_bound;
        local_value_qualifiers^ [index].parse := NIL;
      IFEND;

    /determine_type_description/
      BEGIN
        IF return_type_description THEN
          IF local_type_description^.kind = clc$union_type THEN
            IF local_type_description^.member_descriptions = NIL THEN
              EXIT /determine_type_description/;
            IFEND;
            evaluate_union_type_description (name, clc$array_type, local_type_description, status);
            IF NOT status.normal THEN
              EXIT clp$read_qualified_data_value;
            IFEND;
          IFEND;
          local_type_description := local_type_description^.array_element_type_description;
        IFEND;
      END /determine_type_description/;

    PROCEND evaluate_array_subscript_qual;
?? TITLE := 'evaluate_field_qualifier', EJECT ??

    PROCEDURE evaluate_field_qualifier;

      VAR
        command_reference_value: ^clt$command_reference,
        date_time_value: ^clt$date_time,
        desired_type_description: clt$type_kind,
        entry_point_reference_value: ^pmt$entry_point_reference,
        field_index: clt$field_number,
        field_name: clt$field_name,
        field_type_description: ^clt$type_description,
        fields: ^array [1 .. * ] of clt$internal_field_value,
        form: clt$keyword,
        n: integer,
        record_kind: clt$value_qualifier_records,
        scu_line_identifier_value: ^clt$scu_line_identifier,
        status_value: ^ost$status,
        time_increment_value: ^pmt$time_increment,
        time_zone_value: ^ost$time_zone;


      field_name := local_value_qualifiers^ [index].field_name;
      field_type_description := NIL;

    /field_known/
      BEGIN

      /field_accessible/
        BEGIN

        /field_defined/
          BEGIN
            CASE kind OF

            = clc$command_reference =
              IF i_value <> NIL THEN
                command_reference_value := #PTR (i_value^.command_reference_value, internal_value^);
                i_value := NIL;
              ELSE
                command_reference_value := local_value^.command_reference_value;
              IFEND;
              IF field_name = 'NAME' THEN
                clp$make_name_value (command_reference_value^.name, work_area, local_value);
                field_type_description := ^clv$name_type_description;
              ELSEIF field_name = 'FORM' THEN
                CASE command_reference_value^.form OF
                = clc$name_only_command_ref =
                  form := 'NAME_ONLY';
                = clc$skip_1st_entry_command_ref =
                  form := 'SKIP_FIRST_ENTRY';
                = clc$system_command_ref =
                  form := 'SYSTEM';
                = clc$utility_command_ref =
                  form := 'UTILITY';
                = clc$module_or_file_command_ref =
                  form := 'MODULE_OR_FILE';
                = clc$file_cycle_command_ref =
                  form := 'FILE_CYCLE';
                ELSE
                  osp$set_status_abnormal ('CL', cle$bad_data_value, '', status);
                  EXIT clp$read_qualified_data_value;
                CASEND;
                clp$make_keyword_value (form, work_area, local_value);
                field_type_description := ^clv$keyword_type_description;
              ELSEIF field_name = 'UTILITY' THEN
                IF command_reference_value^.form <> clc$utility_command_ref THEN
                  EXIT /field_accessible/;
                IFEND;
                clp$make_name_value (command_reference_value^.utility, work_area, local_value);
                field_type_description := ^clv$name_type_description;
              ELSEIF field_name = 'LIBRARY_OR_CATALOG' THEN
                CASE command_reference_value^.form OF
                = clc$module_or_file_command_ref =
                  clp$make_file_value (command_reference_value^.library_or_catalog, work_area, local_value);
                = clc$file_cycle_command_ref =
                  clp$make_file_value (command_reference_value^.catalog, work_area, local_value);
                ELSE
                  EXIT /field_accessible/;
                CASEND;
                field_type_description := ^clv$file_type_description;
              ELSEIF field_name = 'CYCLE_NUMBER' THEN
                IF command_reference_value^.form <> clc$file_cycle_command_ref THEN
                  EXIT /field_accessible/;
                IFEND;
                clp$make_integer_value (command_reference_value^.cycle_number, 10, FALSE, work_area,
                      local_value);
                field_type_description := ^clv$integer_type_description;
              ELSE
                EXIT /field_known/;
              IFEND;
              record_kind := clc$command_reference_record;

            = clc$date_time =
              IF i_value <> NIL THEN
                date_time_value := ^i_value^.date_time_value;
                i_value := NIL;
              ELSE
                date_time_value := ^local_value^.date_time_value;
              IFEND;
              IF field_name = 'YEAR' THEN
                IF NOT date_time_value^.date_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.year + 1900;
              ELSEIF field_name = 'MONTH' THEN
                IF NOT date_time_value^.date_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.month;
              ELSEIF field_name = 'DAY' THEN
                IF NOT date_time_value^.date_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.day;
              ELSEIF field_name = 'HOUR' THEN
                IF NOT date_time_value^.time_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.hour;
              ELSEIF field_name = 'MINUTE' THEN
                IF NOT date_time_value^.time_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.minute;
              ELSEIF field_name = 'SECOND' THEN
                IF NOT date_time_value^.time_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.second;
              ELSEIF field_name = 'MILLISECOND' THEN
                IF NOT date_time_value^.time_specified THEN
                  EXIT /field_defined/;
                IFEND;
                n := date_time_value^.value.millisecond;
              ELSE
                EXIT /field_known/;
              IFEND;
              clp$make_integer_value (n, 10, FALSE, work_area, local_value);
              field_type_description := ^clv$integer_type_description;
              record_kind := clc$date_time_record;

            = clc$entry_point_reference =
              IF i_value <> NIL THEN
                entry_point_reference_value := #PTR (i_value^.entry_point_reference_value, internal_value^);
                i_value := NIL;
              ELSE
                entry_point_reference_value := local_value^.entry_point_reference_value;
              IFEND;
              IF field_name = 'ENTRY_POINT' THEN
                IF entry_point_reference_value^.entry_point = osc$null_name THEN
                  clp$make_program_name_value ('none', work_area, local_value);
                ELSE
                  clp$make_program_name_value (entry_point_reference_value^.entry_point, work_area,
                        local_value);
                IFEND;
                field_type_description := ^clv$pgm_name_type_description;
              ELSEIF field_name = 'OBJECT_LIBRARY' THEN
                IF entry_point_reference_value^.entry_point = osc$null_name THEN
                  EXIT /field_accessible/;
                IFEND;
                IF entry_point_reference_value^.object_library = '' THEN
                  clp$make_file_value ('$NULL', work_area, local_value);
                ELSE
                  clp$make_file_value (entry_point_reference_value^.object_library, work_area, local_value);
                IFEND;
                field_type_description := ^clv$file_type_description;
              ELSE
                EXIT /field_known/;
              IFEND;
              record_kind := clc$entry_point_ref_record;

            = clc$range =
              IF field_name = 'HIGH' THEN
                IF i_value <> NIL THEN
                  IF i_value^.high_value = NIL THEN
                    EXIT /field_defined/;
                  IFEND;
                  i_value := #PTR (i_value^.high_value, internal_value^);
                ELSE
                  IF local_value^.high_value = NIL THEN
                    EXIT /field_defined/;
                  IFEND;
                  local_value := local_value^.high_value;
                IFEND;
              ELSEIF field_name = 'LOW' THEN
                IF i_value <> NIL THEN
                  IF i_value^.low_value = NIL THEN
                    EXIT /field_defined/;
                  IFEND;
                  i_value := #PTR (i_value^.low_value, internal_value^);
                ELSE
                  IF local_value^.low_value = NIL THEN
                    EXIT /field_defined/;
                  IFEND;
                  local_value := local_value^.low_value;
                IFEND;
              ELSE
                EXIT /field_known/;
              IFEND;
              desired_type_description := clc$range_type;
              record_kind := clc$unknown_record;

            = clc$record =

            /find_record_field/
              BEGIN
                IF i_value <> NIL THEN
                  fields := #PTR (i_value^.field_values, internal_value^);
                  FOR field_index := 1 TO UPPERBOUND (fields^) DO
                    IF fields^ [field_index].name = field_name THEN
                      IF fields^ [field_index].value = NIL THEN
                        EXIT /field_defined/;
                      IFEND;
                      i_value := #PTR (fields^ [field_index].value, internal_value^);
                      EXIT /find_record_field/;
                    IFEND;
                  FOREND;
                ELSE
                  FOR field_index := 1 TO UPPERBOUND (local_value^.field_values^) DO
                    IF local_value^.field_values^ [field_index].name = field_name THEN
                      IF local_value^.field_values^ [field_index].value = NIL THEN
                        EXIT /field_defined/;
                      IFEND;
                      local_value := local_value^.field_values^ [field_index].value;
                      EXIT /find_record_field/;
                    IFEND;
                  FOREND;
                IFEND;
                EXIT /field_known/;
              END /find_record_field/;
              desired_type_description := clc$record_type;
              record_kind := clc$record_record;

            = clc$scu_line_identifier =
              IF i_value <> NIL THEN
                scu_line_identifier_value := ^i_value^.scu_line_identifier_value;
                i_value := NIL;
              ELSE
                scu_line_identifier_value := ^local_value^.scu_line_identifier_value;
              IFEND;
              IF field_name = 'MODIFICATION_NAME' THEN
                clp$make_name_value (scu_line_identifier_value^.modification_name, work_area, local_value);
                field_type_description := ^clv$scu_mod_type_description;
              ELSEIF field_name = 'SEQUENCE_NUMBER' THEN
                clp$make_integer_value (scu_line_identifier_value^.sequence_number, 10, FALSE, work_area,
                      local_value);
                field_type_description := ^clv$integer_type_description;
              ELSE
                EXIT /field_known/;
              IFEND;
              record_kind := clc$scu_line_ident_record;

            = clc$status =
              IF i_value <> NIL THEN
                status_value := #PTR (i_value^.status_value, internal_value^);
                i_value := NIL;
              ELSE
                status_value := local_value^.status_value;
              IFEND;
              IF field_name = 'NORMAL' THEN
                clp$make_boolean_value (status_value^.normal, clc$true_false_boolean, work_area, local_value);
                field_type_description := ^clv$boolean_type_description;
              ELSEIF field_name = 'CONDITION' THEN
                IF status_value^.normal THEN
                  EXIT /field_accessible/;
                IFEND;
                clp$make_status_code_value (status_value^.condition, work_area, local_value);
                field_type_description := ^clv$stat_code_type_description;
              ELSEIF field_name = 'TEXT' THEN
                IF status_value^.normal THEN
                  EXIT /field_accessible/;
                IFEND;
                clp$make_string_value (status_value^.text.value (1, status_value^.text.size), work_area,
                      local_value);
                field_type_description := ^clv$string_type_description;
              ELSE
                EXIT /field_known/;
              IFEND;
              record_kind := clc$status_record;

            = clc$time_increment =
              IF i_value <> NIL THEN
                time_increment_value := #PTR (i_value^.time_increment_value, internal_value^);
                i_value := NIL;
              ELSE
                time_increment_value := local_value^.time_increment_value;
              IFEND;
              IF field_name = 'YEARS' THEN
                n := time_increment_value^.year;
              ELSEIF field_name = 'MONTHS' THEN
                n := time_increment_value^.month;
              ELSEIF field_name = 'DAYS' THEN
                n := time_increment_value^.day;
              ELSEIF field_name = 'HOURS' THEN
                n := time_increment_value^.hour;
              ELSEIF field_name = 'MINUTES' THEN
                n := time_increment_value^.minute;
              ELSEIF field_name = 'SECONDS' THEN
                n := time_increment_value^.second;
              ELSEIF field_name = 'MILLISECONDS' THEN
                n := time_increment_value^.millisecond;
              ELSE
                EXIT /field_known/;
              IFEND;
              clp$make_integer_value (n, 10, FALSE, work_area, local_value);
              field_type_description := ^clv$integer_type_description;
              record_kind := clc$time_increment_record;

            = clc$time_zone =
              IF i_value <> NIL THEN
                time_zone_value := ^i_value^.time_zone_value;
                i_value := NIL;
              ELSE
                time_zone_value := ^local_value^.time_zone_value;
              IFEND;
              IF field_name = 'HOURS_FROM_GMT' THEN
                clp$make_integer_value (time_zone_value^.hours_from_gmt, 10, FALSE, work_area, local_value);
                field_type_description := ^clv$integer_type_description;
              ELSEIF field_name = 'MINUTES_OFFSET' THEN
                clp$make_integer_value (time_zone_value^.minutes_offset, 10, FALSE, work_area, local_value);
                field_type_description := ^clv$integer_type_description;
              ELSEIF field_name = 'DAYLIGHT_SAVING_TIME' THEN
                clp$make_boolean_value (time_zone_value^.daylight_saving_time, clc$true_false_boolean,
                      work_area, local_value);
                field_type_description := ^clv$boolean_type_description;
              ELSE
                EXIT /field_known/;
              IFEND;
              record_kind := clc$time_zone_record;

            CASEND;

            IF (i_value = NIL) AND (local_value = NIL) THEN
              osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
              EXIT clp$read_qualified_data_value;
            IFEND;

            IF return_parse_value_qualifiers AND evaluating_parse_qualifiers THEN
              local_value_qualifiers^ [index].record_kind := record_kind;
              IF record_kind = clc$record_record THEN
                local_value_qualifiers^ [index].field_names := NIL;
              IFEND;
              local_value_qualifiers^ [index].parse := NIL;
            IFEND;

          /determine_type_description/
            BEGIN
              IF return_type_description THEN
                IF field_type_description = NIL THEN
                  IF local_type_description^.kind = clc$union_type THEN
                    IF local_type_description^.member_descriptions = NIL THEN
                      EXIT /determine_type_description/;
                    IFEND;
                    evaluate_union_type_description (name, desired_type_description, local_type_description,
                          status);
                    IF NOT status.normal THEN
                      EXIT clp$read_qualified_data_value;
                    IFEND;
                  IFEND;
                  IF desired_type_description = clc$range_type THEN
                    IF (local_type_description^.kind = clc$range_type) THEN
                      local_type_description := local_type_description^.range_element_type_description;
                    IFEND;
                  ELSE
                    local_type_description := ^local_type_description^.fields_pdt^.
                          type_descriptions^ [field_index];
                  IFEND;
                ELSE
                  local_type_description := field_type_description;
                IFEND;
              IFEND;
            END /determine_type_description/;

            RETURN;

          END /field_defined/;

          IF possible_file_reference THEN
            reset_parse := TRUE;
            RETURN;
          ELSEIF kind = clc$range THEN

{ Should never get here.

            osp$set_status_abnormal ('CL', cle$undefined_range_selector, field_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
          ELSE
            osp$set_status_abnormal ('CL', cle$undefined_field, field_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
          IFEND;
          EXIT clp$read_qualified_data_value;

        END /field_accessible/;
        IF possible_file_reference THEN
          reset_parse := TRUE;
          RETURN;
        ELSE
          osp$set_status_abnormal ('CL', cle$unaccessible_field, field_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
        IFEND;
        EXIT clp$read_qualified_data_value;

      END /field_known/;
      IF possible_file_reference THEN
        reset_parse := TRUE;
        RETURN;
      ELSEIF kind = clc$range THEN
        osp$set_status_abnormal ('CL', cle$unknown_range_selector, field_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_field, field_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      IFEND;
      EXIT clp$read_qualified_data_value;

    PROCEND evaluate_field_qualifier;
?? TITLE := 'evaluate_list_subscript_qual', EJECT ??

    PROCEDURE evaluate_list_subscript_qual;

      VAR
        i: clt$list_size;


      IF subscript < 1 THEN
        osp$set_status_abnormal ('CL', cle$list_subscript_too_small, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, subscript, 10, FALSE, status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      i := 1;
      IF i_value <> NIL THEN
        WHILE (i < subscript) AND (i_value^.link <> NIL) DO
          i_value := #PTR (i_value^.link, internal_value^);
          i := i + 1;
        WHILEND;
      ELSE
        WHILE (i < subscript) AND (local_value^.link <> NIL) DO
          local_value := local_value^.link;
          i := i + 1;
        WHILEND;
      IFEND;

      IF i < subscript THEN
        osp$set_status_abnormal ('CL', cle$list_subscript_too_large, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, subscript, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, i, 10, FALSE, status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      IF i_value <> NIL THEN
        i_value := #PTR (i_value^.element_value, internal_value^);
      ELSE
        local_value := local_value^.element_value;
      IFEND;

      IF (i_value = NIL) AND (local_value = NIL) THEN
        osp$set_status_abnormal ('CL', cle$undefined_subscr_element, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, subscript, 10, FALSE, status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      IF return_parse_value_qualifiers AND evaluating_parse_qualifiers THEN
        local_value_qualifiers^ [index].kind := clc$list_subscript_qualifier;
        local_value_qualifiers^ [index].list_subscript := subscript;
        local_value_qualifiers^ [index].parse := NIL;
      IFEND;

    /determine_type_description/
      BEGIN
        IF return_type_description THEN
          IF local_type_description^.kind = clc$union_type THEN
            IF local_type_description^.member_descriptions = NIL THEN
              EXIT /determine_type_description/;
            IFEND;
            evaluate_union_type_description (name, clc$list_type, local_type_description, status);
            IF NOT status.normal THEN
              EXIT clp$read_qualified_data_value;
            IFEND;
          IFEND;
          local_type_description := local_type_description^.list_element_type_description;
        IFEND;
      END /determine_type_description/;

    PROCEND evaluate_list_subscript_qual;
?? TITLE := 'evaluate_substring_qualifier', EJECT ??

    PROCEDURE evaluate_substring_qualifier;

      VAR
        string_value: ^clt$string_value,
        substring_size_present: boolean,
        sub_index: clt$string_index,
        sub_name: ost$name,
        sub_size: clt$string_size;


      IF i_value <> NIL THEN
        string_value := #PTR (i_value^.string_value, internal_value^);
        i_value := NIL;
      ELSE
        string_value := local_value^.string_value;
      IFEND;

      IF (specified_index < 1) OR (specified_index > (STRLENGTH (string_value^) + 1)) THEN
        osp$set_status_abnormal ('CL', cle$substr_index_out_of_range, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, specified_index, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, STRLENGTH (string_value^) + 1, 10, FALSE,
              status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      IF all_specified THEN
        specified_size := STRLENGTH (string_value^) + 1 - specified_index;
      ELSEIF (specified_size < 0) OR (specified_size > (STRLENGTH (string_value^) + 1 - specified_index))
            THEN
        osp$set_status_abnormal ('CL', cle$substr_size_out_of_range, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, specified_size, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              STRLENGTH (string_value^) + 1 - specified_index, 10, FALSE, status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      clp$make_string_value (string_value^ (specified_index, specified_size), work_area, local_value);
      IF local_value = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT clp$read_qualified_data_value;
      IFEND;

      IF return_parse_value_qualifiers AND evaluating_parse_qualifiers THEN
        local_value_qualifiers^ [index].kind := clc$substring_qualifier;
        local_value_qualifiers^ [index].index := specified_index;
        local_value_qualifiers^ [index].size := specified_size;
        local_value_qualifiers^ [index].all_specified := all_specified;
        local_value_qualifiers^ [index].parse := NIL;
      IFEND;

    PROCEND evaluate_substring_qualifier;
?? TITLE := 'evaluate_var_param_qualifiers', EJECT ??

    PROCEDURE evaluate_var_param_qualifiers;

{
{ Currently, the only kind of qualifiers that can make up the
{ var_parameter_value_qualifiers are clc$array_subscript, clc$field_qualifier,
{ clc$list_subscript_qualifier, clc$substring_qualifier.  Unspecified and
{ invalid qualifiers are NOT allowed because this would constitute a
{ clc$union_type in the type description.  This is not allowed at this point.
{

      FOR index := 1 TO UPPERBOUND (local_value_qualifiers^) DO

        IF i_value <> NIL THEN
          kind := i_value^.kind;
        ELSE
          kind := local_value^.kind;
        IFEND;

        CASE local_value_qualifiers^ [index].kind OF

        = clc$array_subscript_qualifier =
          IF kind <> clc$array THEN
            osp$set_status_abnormal ('CL', cle$undefined_var_subscript, name, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  local_value_qualifiers^ [index].array_subscript, 10, FALSE, status);
            EXIT clp$read_qualified_data_value;
          IFEND;
          subscript := local_value_qualifiers^ [index].array_subscript;
          evaluate_array_subscript_qual;

        = clc$field_qualifier =
          evaluate_field_qualifier;

        = clc$list_subscript_qualifier =
          IF kind <> clc$list THEN
            osp$set_status_abnormal ('CL', cle$undefined_var_subscript, name, status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  local_value_qualifiers^ [index].list_subscript, 10, FALSE, status);
            EXIT clp$read_qualified_data_value;
          IFEND;
          subscript := local_value_qualifiers^ [index].list_subscript;
          evaluate_list_subscript_qual;

        = clc$substring_qualifier =
          IF kind <> clc$string THEN
            osp$set_status_abnormal ('CL', cle$undefined_var_substring, name, status);
            EXIT clp$read_qualified_data_value;
          IFEND;
          specified_index := local_value_qualifiers^ [index].index;
          specified_size := local_value_qualifiers^ [index].size;
          all_specified := local_value_qualifiers^ [index].all_specified;
          evaluate_substring_qualifier;

        ELSE

{ Should never get here.

          osp$set_status_abnormal ('CL', cle$internal_read_qualifier_err, name, status);
          EXIT clp$read_qualified_data_value;
        CASEND;
      FOREND;

    PROCEND evaluate_var_param_qualifiers;
?? TITLE := 'evaluate_parse_qualifiers', EJECT ??

    PROCEDURE evaluate_parse_qualifiers;

      VAR
        separator: string (1);


{
{ Currently, the only kind of qualifiers that make up the
{ parse_value_qualifiers are unspecified and invalid qualifiers.
{

    /evaluate_qualifiers/
      FOR index := 1 TO UPPERBOUND (local_value_qualifiers^) DO

        IF i_value <> NIL THEN
          kind := i_value^.kind;
        ELSE
          kind := local_value^.kind;
        IFEND;

        CASE kind OF

        = clc$array =
          CASE local_value_qualifiers^ [index].kind OF
          = clc$unspecified_subscript_qual =
            subscript := local_value_qualifiers^ [index].unspecified_subscript;
          = clc$invalid_subscript_qual =
            IF local_value_qualifiers^ [index].subscript_defined THEN
              subscript := local_value_qualifiers^ [index].invalid_subscript;
              evaluate_array_subscript_qual;
            IFEND;
            status := local_value_qualifiers^ [index].invalid_subscript_status^;
            EXIT clp$read_qualified_data_value;
          = clc$unspecified_substring_qual, clc$invalid_substring_qual =
            IF local_value_qualifiers^ [index].kind = clc$invalid_substring_qual THEN
              subscript := local_value_qualifiers^ [index].invalid_index;
              separator := local_value_qualifiers^ [index].invalid_separator;
            ELSE
              subscript := local_value_qualifiers^ [index].unspecified_index;
              separator := local_value_qualifiers^ [index].unspecified_separator;
            IFEND;
            evaluate_array_subscript_qual;
            osp$set_status_abnormal ('CL', cle$expecting_rparen_of_subscr, name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, separator, status);
            EXIT clp$read_qualified_data_value;
          ELSE
{
{ There is NO clc$array_subscript_qualifier , clc$substring_qualifier, or clc$list_qualifier.
{ This is for clc$unspecified_field_qualifier or clc$invalid_field_qualifier.
{
            reset_parse := TRUE;
            EXIT /evaluate_qualifiers/;
          CASEND;
          evaluate_array_subscript_qual;

        = clc$list =
          CASE local_value_qualifiers^ [index].kind OF
          = clc$unspecified_subscript_qual =
            subscript := local_value_qualifiers^ [index].unspecified_subscript;
          = clc$invalid_subscript_qual =
            IF local_value_qualifiers^ [index].subscript_defined THEN
              subscript := local_value_qualifiers^ [index].invalid_subscript;
              evaluate_list_subscript_qual;
            IFEND;
            status := local_value_qualifiers^ [index].invalid_subscript_status^;
            EXIT clp$read_qualified_data_value;
          = clc$unspecified_substring_qual, clc$invalid_substring_qual =
            IF local_value_qualifiers^ [index].kind = clc$invalid_substring_qual THEN
              subscript := local_value_qualifiers^ [index].invalid_index;
              separator := local_value_qualifiers^ [index].invalid_separator;
            ELSE
              subscript := local_value_qualifiers^ [index].unspecified_index;
              separator := local_value_qualifiers^ [index].unspecified_separator;
            IFEND;
            evaluate_list_subscript_qual;
            osp$set_status_abnormal ('CL', cle$expecting_rparen_of_subscr, name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, separator, status);
            EXIT clp$read_qualified_data_value;
          ELSE
{
{ There is NO clc$array_subscript_qualifier , clc$substring_qualifier, or clc$list_qualifier.
{ This is for clc$unspecified_field_qualifier or clc$invalid_field_qualifier.
{
            reset_parse := TRUE;
            EXIT /evaluate_qualifiers/;
          CASEND;
          evaluate_list_subscript_qual;

        = clc$string =
          CASE local_value_qualifiers^ [index].kind OF
          = clc$unspecified_substring_qual =
            specified_index := local_value_qualifiers^ [index].unspecified_index;
            specified_size := local_value_qualifiers^ [index].unspecified_size;
            all_specified := local_value_qualifiers^ [index].unspecified_all_found;
          = clc$unspecified_subscript_qual =
            specified_index := local_value_qualifiers^ [index].unspecified_subscript;
            specified_size := 1;
            all_specified := FALSE;
          = clc$invalid_substring_qual =
            specified_index := local_value_qualifiers^ [index].invalid_index;
            IF local_value_qualifiers^ [index].size_defined THEN
              specified_size := local_value_qualifiers^ [index].invalid_size;
              all_specified := FALSE;
            ELSE
              all_specified := TRUE;
            IFEND;
            evaluate_substring_qualifier;
            status := local_value_qualifiers^ [index].invalid_substring_status^;
            EXIT clp$read_qualified_data_value;
          = clc$invalid_subscript_qual =
            IF local_value_qualifiers^ [index].subscript_defined THEN
              specified_index := local_value_qualifiers^ [index].invalid_subscript;
              specified_size := 1;
              all_specified := FALSE;
              evaluate_substring_qualifier;
            IFEND;
            status := local_value_qualifiers^ [index].invalid_subscript_status^;
            EXIT clp$read_qualified_data_value;
          ELSE
{
{ There is NO clc$array_subscript_qualifier , clc$substring_qualifier, or clc$list_qualifier.
{ This is for clc$unspecified_field_qualifier or clc$invalid_field_qualifier.
{
            reset_parse := TRUE;
            EXIT /evaluate_qualifiers/;
          CASEND;
          evaluate_substring_qualifier;

        = clc$command_reference, clc$date_time, clc$entry_point_reference, clc$range, clc$record,
              clc$scu_line_identifier, clc$status, clc$time_increment, clc$time_zone =
          CASE local_value_qualifiers^ [index].kind OF
          = clc$unspecified_field_qualifier =
            evaluate_field_qualifier;
          = clc$invalid_field_qualifier =
            IF possible_file_reference AND (local_value_qualifiers^ [index].invalid_field_status^.condition
                 = cle$expecting_field_name) THEN
              reset_parse := TRUE;
            ELSE
              status := local_value_qualifiers^ [index].invalid_field_status^;
              EXIT clp$read_qualified_data_value;
            IFEND;
          ELSE
{
{ There is NO clc$field_qualifier.
{ This is for clc$unspecified_subscript_qualifier, clc$unspecified_substring_qualifier,
{ clc$invalid_subscript_qual, and clc$invalid_substring_qual.
{
            reset_parse := TRUE;
          CASEND;
          IF reset_parse THEN
            EXIT /evaluate_qualifiers/;
          IFEND;

        = clc$unspecified =
          osp$set_status_abnormal ('CL', cle$unexpected_qual_for_unspec, name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, local_value_qualifiers^ [index].
                parse^, status);
          EXIT clp$read_qualified_data_value;
        ELSE
          reset_parse := TRUE;
          EXIT /evaluate_qualifiers/;
        CASEND;
      FOREND /evaluate_qualifiers/;

    PROCEND evaluate_parse_qualifiers;
?? OLDTITLE, EJECT ??

{ It is assumed that either "internal_value" is not nil or that the
{ initial state of "data_value" is not nil, but not both.
{ Var_parameter_value_qualifiers were created by the procedure CLP$GET_WRITE_VALUE_QUALIFIERS.
{ Parse_value_qualifiers were created by the procedure CLP$GET_READ_VALUE_QUALIFIERS.
{


    status.normal := TRUE;
    parse_value_qualifier_index := 0;
    local_type_description := type_description;
    reset_parse := FALSE;
    evaluating_parse_qualifiers := FALSE;

    return_type_description := clc$return_type_description IN access_variable_requests;
    return_parse_value_qualifiers := clc$return_value_qualifiers IN access_variable_requests;
    possible_file_reference := clc$possible_file_reference IN access_variable_requests;
    convert_nil_value_to_unspec := clc$convert_nil_value_to_unspec IN access_variable_requests;

    IF internal_value <> NIL THEN
      i_value := #PTR (internal_value^.header.value, internal_value^);
      local_value := NIL;
    ELSE
      i_value := NIL;
      local_value := data_value;
    IFEND;

  /read_value/
    BEGIN
      IF var_parameter_value_qualifiers <> NIL THEN
        local_value_qualifiers := var_parameter_value_qualifiers;
        evaluate_var_param_qualifiers;

        IF (i_value = NIL) AND (local_value = NIL) AND (parse_value_qualifiers <> NIL) THEN
          IF convert_nil_value_to_unspec THEN
            clp$make_unspecified_value (work_area, local_value);
            IF local_value = NIL THEN
              osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
              RETURN;
            IFEND;
          ELSEIF NOT possible_file_reference THEN
*IF NOT $true(osv$unix)
            osp$set_status_abnormal ('CL', cle$cannot_read_component, name, status);
*ELSE
            osp$set_status_abnormal ('CL', cle$not_supported, 'Variables are', status);
*IFEND
            RETURN;
          ELSE
            reset_parse := TRUE;
            EXIT /read_value/;
          IFEND;
        IFEND;
      IFEND;

      IF parse_value_qualifiers <> NIL THEN
        evaluating_parse_qualifiers := TRUE;
        local_value_qualifiers := parse_value_qualifiers;
        evaluate_parse_qualifiers;
      IFEND;

    END /read_value/;

    IF return_type_description THEN
      type_description := local_type_description;
    IFEND;

    IF reset_parse AND (parse_value_qualifiers <> NIL) THEN
      IF evaluating_parse_qualifiers THEN
        parse_value_qualifier_index := index;
      ELSE
        parse_value_qualifier_index := 1;
      IFEND;
    IFEND;

    IF i_value <> NIL THEN
*IF NOT $true(osv$unix)
      clp$convert_int_value_to_ext (internal_value, #REL (i_value, internal_value^), work_area, data_value,
            status);
*ELSE
{ I don't think we should get here for PHASE I, but if we do, just set status
{ to abnormal.
      osp$set_status_abnormal ('CL', cle$not_supported, 'Variables are',
            status);
*IFEND
    ELSE
      data_value := local_value;
    IFEND;

  PROCEND clp$read_qualified_data_value;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$write_qualified_data_value', EJECT ??

  PROCEDURE [XDCL] clp$write_qualified_data_value
    (    name: clt$variable_name;
         value_qualifiers: ^clt$value_qualifiers;
         old_value: ^clt$internal_data_value;
         replacement_value: ^clt$data_value;
         conformance_checked: boolean;
         allow_padding_or_truncation: boolean;
     VAR work_area {input, output} : ^clt$work_area;
     VAR new_value: ^clt$internal_data_value;
     VAR status: ost$status);

    VAR
      all_specified: boolean,
      elements: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value,
      graft_address: ^ REL (clt$internal_data_value) ^clt$i_data_value,
      index: integer,
      initial_position: integer,
      i_value: ^clt$i_data_value,
      max_string_size: clt$string_size,
      min_string_size: clt$string_size,
      new_value_size: integer,
      replacement_value_address: ^ REL (clt$internal_data_value) ^clt$i_data_value,
      replacement_value_string_size: integer,
{
{ Specified_index, specified_size, and subscript are defined as integers.
{ Unspecified value_qualifier information has not been validated yet.
{
      specified_index: integer,
      specified_size: integer,
      status_text_size: ^ost$string_size,
      string_address: ^clt$string_value,
      string_index: clt$string_index,
      string_size: clt$string_size,
      subscript: integer,
      write_complete: boolean;

?? NEWTITLE := 'evaluate_array_subscript_qual', EJECT ??

    PROCEDURE evaluate_array_subscript_qual;

      VAR
        i: clt$array_bound,
        lower_bound: clt$array_bound,
        upper_bound: clt$array_bound;


      IF i_value = NIL THEN
        start_new_value;
        i_value^.kind := clc$array;
        lower_bound := value_qualifiers^ [index].bounds.lower;
        upper_bound := value_qualifiers^ [index].bounds.upper;
        NEXT elements: [lower_bound .. upper_bound] IN work_area;
        IF elements = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$write_qualified_data_value;
        IFEND;
        i_value^.array_value := #REL (elements, new_value^);
        FOR i := lower_bound TO upper_bound DO
          elements^ [i] := NIL;
        FOREND;
      IFEND;

      IF new_value = NIL THEN
        graft_address := ^elements^ [subscript];
        i_value := #PTR (elements^ [subscript], old_value^);
      ELSE
        replacement_value_address := ^elements^ [subscript];
        i_value := #PTR (elements^ [subscript], new_value^);
      IFEND;

    PROCEND evaluate_array_subscript_qual;
?? TITLE := 'evaluate_field_qualifier', EJECT ??

    PROCEDURE evaluate_field_qualifier;

      VAR
        current_value: ^clt$internal_data_value,
        field_name: clt$field_name,
        fields: ^array [1 .. * ] of clt$internal_field_value,
        i: clt$field_number,
        new_command_reference: ^clt$command_reference,
        new_entry_point_reference: ^pmt$entry_point_reference,
        new_status: ^ost$status,
        new_time_increment: ^pmt$time_increment;


      IF i_value <> NIL THEN
        current_value := old_value;
      ELSE
        start_new_value;
        CASE value_qualifiers^ [index].record_kind OF

        = clc$command_reference_record =
          i_value^.kind := clc$command_reference;
          NEXT new_command_reference IN work_area;
          IF new_command_reference = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$write_qualified_data_value;
          IFEND;
          new_command_reference^.name := '';
          new_command_reference^.form := clc$name_only_command_ref;
          i_value^.command_reference_value := #REL (new_command_reference, new_value^);

        = clc$date_time_record =
          i_value^.kind := clc$date_time;
          pmp$get_compact_date_time (i_value^.date_time_value.value, status);
          IF NOT status.normal THEN
            EXIT clp$write_qualified_data_value;
          IFEND;
          i_value^.date_time_value.value.hour := 0;
          i_value^.date_time_value.value.minute := 0;
          i_value^.date_time_value.value.second := 0;
          i_value^.date_time_value.value.millisecond := 0;
          i_value^.date_time_value.date_specified := FALSE;
          i_value^.date_time_value.time_specified := FALSE;

        = clc$entry_point_ref_record =
          i_value^.kind := clc$entry_point_reference;
          NEXT new_entry_point_reference IN work_area;
          IF new_entry_point_reference = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$write_qualified_data_value;
          IFEND;
          new_entry_point_reference^.entry_point := '';
          new_entry_point_reference^.object_library := '';
          i_value^.entry_point_reference_value := #REL (new_entry_point_reference, new_value^);

        = clc$record_record =
          i_value^.kind := clc$record;
          NEXT fields: [1 .. UPPERBOUND (value_qualifiers^ [index].field_names^)] IN work_area;
          IF fields = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$write_qualified_data_value;
          IFEND;
          FOR i := 1 TO UPPERBOUND (fields^) DO
            fields^ [i].name := value_qualifiers^ [index].field_names^ [i].name;
            fields^ [i].value := NIL;
          FOREND;
          i_value^.field_values := #REL (fields, new_value^);

        = clc$scu_line_ident_record =
          i_value^.kind := clc$scu_line_identifier;
          i_value^.scu_line_identifier_value.modification_name := '';
          i_value^.scu_line_identifier_value.sequence_number := 1;

        = clc$status_record =
          i_value^.kind := clc$status;
          NEXT new_status IN work_area;
          IF new_status = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$write_qualified_data_value;
          IFEND;
          new_status^.normal := TRUE;
          i_value^.status_value := #REL (new_status, new_value^);

        = clc$time_increment_record =
          i_value^.kind := clc$time_increment;
          NEXT new_time_increment IN work_area;
          IF new_time_increment = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$write_qualified_data_value;
          IFEND;
          new_time_increment^.year := 0;
          new_time_increment^.month := 0;
          new_time_increment^.day := 0;
          new_time_increment^.hour := 0;
          new_time_increment^.minute := 0;
          new_time_increment^.second := 0;
          new_time_increment^.millisecond := 0;
          i_value^.time_increment_value := #REL (new_time_increment, new_value^);

        = clc$time_zone_record =
          i_value^.kind := clc$time_zone;
          i_value^.time_zone_value.hours_from_gmt := 0;
          i_value^.time_zone_value.minutes_offset := 0;
          i_value^.time_zone_value.daylight_saving_time := FALSE;

        ELSE
          osp$set_status_abnormal ('CL', cle$cannot_initialize_component, name, status);
          EXIT clp$write_qualified_data_value;
        CASEND;

        current_value := new_value;
      IFEND;


      field_name := value_qualifiers^ [index].field_name;

    /field_known/
      BEGIN

      /field_accessible/
        BEGIN

        /field_defined/
          BEGIN

          /valid_replacement_value_kind/
            BEGIN

            /valid_replacement_value/
              BEGIN
                CASE i_value^.kind OF

                = clc$command_reference =

                  new_command_reference := #PTR (i_value^.command_reference_value, current_value^);
                  IF field_name = 'NAME' THEN
                    IF replacement_value^.kind <> clc$name THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    new_command_reference^.name := replacement_value^.name_value;
                  ELSEIF field_name = 'FORM' THEN
                    IF replacement_value^.kind <> clc$keyword THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    IF replacement_value^.keyword_value = 'NAME_ONLY' THEN
                      new_command_reference^.form := clc$name_only_command_ref;
                    ELSEIF replacement_value^.keyword_value = 'SKIP_FIRST_ENTRY' THEN
                      new_command_reference^.form := clc$skip_1st_entry_command_ref;
                    ELSEIF replacement_value^.keyword_value = 'SYSTEM' THEN
                      new_command_reference^.form := clc$system_command_ref;
                    ELSEIF replacement_value^.keyword_value = 'UTILITY' THEN
                      new_command_reference^.form := clc$utility_command_ref;
                      new_command_reference^.utility := '';
                    ELSEIF replacement_value^.keyword_value = 'MODULE_OR_FILE' THEN
                      new_command_reference^.form := clc$module_or_file_command_ref;
                      new_command_reference^.library_or_catalog := '';
                    ELSEIF replacement_value^.keyword_value = 'FILE_CYCLE' THEN
                      new_command_reference^.form := clc$file_cycle_command_ref;
                      new_command_reference^.catalog := '';
                      new_command_reference^.cycle_number := 1;
                    ELSE
                      EXIT /valid_replacement_value/;
                    IFEND;
                  ELSEIF field_name = 'UTILITY' THEN
                    IF new_command_reference^.form <> clc$utility_command_ref THEN
                      EXIT /field_accessible/;
                    ELSEIF replacement_value^.kind <> clc$name THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    new_command_reference^.utility := replacement_value^.name_value;
                  ELSEIF field_name = 'LIBRARY_OR_CATALOG' THEN
                    IF replacement_value^.kind <> clc$file THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    CASE new_command_reference^.form OF
                    = clc$module_or_file_command_ref =
                      new_command_reference^.library_or_catalog := replacement_value^.file_value^;
                    = clc$file_cycle_command_ref =
                      new_command_reference^.catalog := replacement_value^.file_value^;
                    ELSE
                      EXIT /field_accessible/;
                    CASEND;
                  ELSEIF field_name = 'CYCLE_NUMBER' THEN
                    IF new_command_reference^.form <> clc$file_cycle_command_ref THEN
                      EXIT /field_accessible/;
                    ELSEIF replacement_value^.kind <> clc$integer THEN
                      EXIT /valid_replacement_value_kind/;
                    ELSEIF (replacement_value^.integer_value.value < 1) OR
                          (replacement_value^.integer_value.value > fsc$maximum_cycle_number) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    new_command_reference^.cycle_number := replacement_value^.integer_value.value;
                  ELSE
                    EXIT /field_known/;
                  IFEND;
                  write_complete := TRUE;

                = clc$date_time =

                  IF replacement_value^.kind <> clc$integer THEN
                    EXIT /valid_replacement_value_kind/;
                  IFEND;
                  IF field_name = 'YEAR' THEN
                    IF (replacement_value^.integer_value.value < 1900) OR
                          (replacement_value^.integer_value.value > 2155) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.date_specified := TRUE;
                    i_value^.date_time_value.value.year := replacement_value^.integer_value.value - 1900;
                  ELSEIF field_name = 'MONTH' THEN
                    IF (replacement_value^.integer_value.value < 1) OR
                          (replacement_value^.integer_value.value > 12) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.date_specified := TRUE;
                    i_value^.date_time_value.value.month := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'DAY' THEN
                    IF (replacement_value^.integer_value.value < 1) OR
                          (replacement_value^.integer_value.value > 31) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.date_specified := TRUE;
                    i_value^.date_time_value.value.day := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'HOUR' THEN
                    IF (replacement_value^.integer_value.value < 0) OR
                          (replacement_value^.integer_value.value > 23) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.time_specified := TRUE;
                    i_value^.date_time_value.value.hour := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'MINUTE' THEN
                    IF (replacement_value^.integer_value.value < 0) OR
                          (replacement_value^.integer_value.value > 59) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.time_specified := TRUE;
                    i_value^.date_time_value.value.minute := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'SECOND' THEN
                    IF (replacement_value^.integer_value.value < 0) OR
                          (replacement_value^.integer_value.value > 59) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.time_specified := TRUE;
                    i_value^.date_time_value.value.second := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'MILLISECOND' THEN
                    IF (replacement_value^.integer_value.value < 0) OR
                          (replacement_value^.integer_value.value > 999) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.date_time_value.time_specified := TRUE;
                    i_value^.date_time_value.value.millisecond := replacement_value^.integer_value.value;
                  ELSE
                    EXIT /field_known/;
                  IFEND;
                  write_complete := TRUE;

                = clc$entry_point_reference =

                  new_entry_point_reference := #PTR (i_value^.entry_point_reference_value, current_value^);
                  IF field_name = 'ENTRY_POINT' THEN
                    IF replacement_value^.kind <> clc$program_name THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    IF replacement_value^.program_name_value = 'none' THEN
                      new_entry_point_reference^.entry_point := osc$null_name;
                    ELSE
                      new_entry_point_reference^.entry_point := replacement_value^.program_name_value;
                    IFEND;
                  ELSEIF field_name = 'OBJECT_LIBRARY' THEN
                    IF new_entry_point_reference^.entry_point = osc$null_name THEN
                      EXIT /field_accessible/;
                    ELSEIF replacement_value^.kind <> clc$file THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    IF replacement_value^.file_value^ = '$NULL' THEN
                      new_entry_point_reference^.object_library := '';
                    ELSE
                      new_entry_point_reference^.object_library := replacement_value^.file_value^;
                    IFEND;
                  ELSE
                    EXIT /field_known/;
                  IFEND;
                  write_complete := TRUE;

                = clc$range =

                  IF field_name = 'HIGH' THEN
                    IF new_value = NIL THEN
                      graft_address := ^i_value^.high_value;
                      i_value := #PTR (i_value^.high_value, old_value^);
                    ELSE
                      replacement_value_address := ^i_value^.high_value;
                      i_value := #PTR (i_value^.high_value, new_value^);
                    IFEND;
                  ELSEIF field_name = 'LOW' THEN
                    IF new_value = NIL THEN
                      graft_address := ^i_value^.low_value;
                      i_value := #PTR (i_value^.low_value, old_value^);
                    ELSE
                      replacement_value_address := ^i_value^.low_value;
                      i_value := #PTR (i_value^.low_value, new_value^);
                    IFEND;
                  ELSE
                    EXIT /field_known/;
                  IFEND;

                = clc$record =

                /find_record_field/
                  BEGIN
                    fields := #PTR (i_value^.field_values, current_value^);
                    FOR i := 1 TO UPPERBOUND (fields^) DO
                      IF fields^ [i].name = field_name THEN
                        IF new_value = NIL THEN
                          graft_address := ^fields^ [i].value;
                          i_value := #PTR (fields^ [i].value, old_value^);
                        ELSE
                          replacement_value_address := ^fields^ [i].value;
                          i_value := #PTR (fields^ [i].value, new_value^);
                        IFEND;
                        EXIT /find_record_field/;
                      IFEND;
                    FOREND;
                    EXIT /field_known/;
                  END /find_record_field/;

                = clc$scu_line_identifier =

                  IF field_name = 'MODIFICATION_NAME' THEN
                    IF replacement_value^.kind <> clc$name THEN
                      EXIT /valid_replacement_value_kind/;
                    ELSEIF clp$trimmed_string_size (replacement_value^.name_value) >
                          clc$max_scu_modification_name THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    i_value^.scu_line_identifier_value.modification_name := replacement_value^.name_value;
                  ELSEIF field_name = 'SEQUENCE_NUMBER' THEN
                    IF replacement_value^.kind <> clc$integer THEN
                      EXIT /valid_replacement_value_kind/;
                    ELSEIF (replacement_value^.integer_value.value < 1) OR
                          (replacement_value^.integer_value.value > clc$max_scu_sequence_number) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.scu_line_identifier_value.sequence_number :=
                          replacement_value^.integer_value.value;
                  ELSE
                    EXIT /field_known/;
                  IFEND;
                  write_complete := TRUE;

                = clc$status =

                  new_status := #PTR (i_value^.status_value, current_value^);
                  IF field_name = 'NORMAL' THEN
                    IF replacement_value^.kind <> clc$boolean THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    new_status^.normal := replacement_value^.boolean_value.value;
                    IF NOT new_status^.normal THEN
                      new_status^.condition := 0;
                      new_status^.text.size := 0;
                    IFEND;
                    write_complete := TRUE;
                  ELSEIF field_name = 'CONDITION' THEN
                    IF new_status^.normal THEN
                      EXIT /field_accessible/;
                    ELSEIF replacement_value^.kind <> clc$status_code THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    new_status^.condition := replacement_value^.status_code_value;
                    write_complete := TRUE;
                  ELSEIF field_name = 'TEXT' THEN
                    IF new_status^.normal THEN
                      EXIT /field_accessible/;
                    IFEND;
                    string_address := ^new_status^.text.value;
                    string_index := 1;
                    string_size := new_status^.text.size;
                    IF string_size > osc$max_string_size THEN
                      string_size := 0;
                    IFEND;
                    status_text_size := ^new_status^.text.size;
                  ELSE
                    EXIT /field_known/;
                  IFEND;

                = clc$time_increment =

                  new_time_increment := #PTR (i_value^.time_increment_value, current_value^);
                  IF replacement_value^.kind <> clc$integer THEN
                    EXIT /valid_replacement_value_kind/;
                  IFEND;
                  IF field_name = 'YEARS' THEN
                    new_time_increment^.year := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'MONTHS' THEN
                    new_time_increment^.month := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'DAYS' THEN
                    new_time_increment^.day := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'HOURS' THEN
                    new_time_increment^.hour := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'MINUTES' THEN
                    new_time_increment^.minute := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'SECONDS' THEN
                    new_time_increment^.second := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'MILLISECONDS' THEN
                    new_time_increment^.millisecond := replacement_value^.integer_value.value;
                  ELSE
                    EXIT /field_known/;
                  IFEND;
                  write_complete := TRUE;

                = clc$time_zone =

                  IF field_name = 'HOURS_FROM_GMT' THEN
                    IF replacement_value^.kind <> clc$integer THEN
                      EXIT /valid_replacement_value_kind/;
                    ELSEIF (replacement_value^.integer_value.value < -12) OR
                          (replacement_value^.integer_value.value > 12) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.time_zone_value.hours_from_gmt := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'MINUTES_OFFSET' THEN
                    IF replacement_value^.kind <> clc$integer THEN
                      EXIT /valid_replacement_value_kind/;
                    ELSEIF (replacement_value^.integer_value.value < -30) OR
                          (replacement_value^.integer_value.value > 30) THEN
                      EXIT /valid_replacement_value/;
                    IFEND;
                    i_value^.time_zone_value.minutes_offset := replacement_value^.integer_value.value;
                  ELSEIF field_name = 'DAYLIGHT_SAVING_TIME' THEN
                    IF replacement_value^.kind <> clc$boolean THEN
                      EXIT /valid_replacement_value_kind/;
                    IFEND;
                    i_value^.time_zone_value.daylight_saving_time := replacement_value^.boolean_value.value;
                  ELSE
                    EXIT /field_known/;
                  IFEND;
                  write_complete := TRUE;

                CASEND;
                RETURN;

              END /valid_replacement_value/;
              osp$set_status_abnormal ('CL', cle$improper_variable_value, name, status);
              EXIT clp$write_qualified_data_value;

            END /valid_replacement_value_kind/;
            osp$set_status_abnormal ('CL', cle$incompatible_assignment, name, status);
            EXIT clp$write_qualified_data_value;

          END /field_defined/;
          osp$set_status_abnormal ('CL', cle$undefined_field, field_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
          EXIT clp$write_qualified_data_value;

        END /field_accessible/;
        osp$set_status_abnormal ('CL', cle$unaccessible_field, field_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
        EXIT clp$write_qualified_data_value;

      END /field_known/;
      IF i_value^.kind = clc$range THEN
        osp$set_status_abnormal ('CL', cle$unknown_range_selector, field_name, status);
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_field, field_name, status);
      IFEND;
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      EXIT clp$write_qualified_data_value;

    PROCEND evaluate_field_qualifier;
?? TITLE := 'evaluate_list_subscript_qual', EJECT ??

    PROCEDURE evaluate_list_subscript_qual;

      VAR
        i: clt$list_size;


      i := 1;
      WHILE (i < subscript) AND (i_value^.link <> NIL) DO
        i_value := #PTR (i_value^.link, old_value^);
        i := i + 1;
      WHILEND;

      IF i < subscript THEN
        osp$set_status_abnormal ('CL', cle$cannot_initialize_component, name, status);
        EXIT clp$write_qualified_data_value;
      IFEND;

      graft_address := ^i_value^.element_value;
      i_value := #PTR (i_value^.element_value, old_value^);

    PROCEND evaluate_list_subscript_qual;
?? TITLE := 'evaluate_substring_qualifier', EJECT ??

    PROCEDURE evaluate_substring_qualifier;

      VAR
        new_string: boolean,
        test_size: integer;


      status_text_size := NIL;
      new_string := string_address = NIL;

      IF new_string THEN
        string_address := #PTR (i_value^.string_value, old_value^);
        string_size := STRLENGTH (string_address^);
      IFEND;

      IF (specified_index < 1) OR (specified_index > (string_size + 1)) THEN
        osp$set_status_abnormal ('CL', cle$substr_index_out_of_range, name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, specified_index, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, string_size + 1, 10, FALSE, status);
        EXIT clp$write_qualified_data_value;
      IFEND;

      IF new_string THEN
        string_index := specified_index;
        test_size := string_size - string_index + 1;
      ELSE
        string_index := string_index + specified_index - 1;
        test_size := string_size - specified_index + 1;
      IFEND;

      IF all_specified THEN
        string_size := test_size;
      ELSE
        IF specified_size > test_size THEN
          osp$set_status_abnormal ('CL', cle$substr_size_out_of_range, name, status);
          osp$append_status_integer (osc$status_parameter_delimiter, specified_size, 10, FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, test_size, 10, FALSE, status);
          EXIT clp$write_qualified_data_value;
        IFEND;
        string_size := specified_size;
      IFEND;

    PROCEND evaluate_substring_qualifier;
?? TITLE := 'start_new_value', EJECT ??

    PROCEDURE [INLINE] start_new_value;

      VAR
        header: ^clt$internal_data_value_header;


      IF new_value = NIL THEN
        initial_position := i#current_sequence_position (work_area);
        new_value_size := #SIZE (work_area^) - initial_position - #SIZE (clt$internal_data_value_header);
        IF new_value_size < #SIZE (clt$i_data_value) THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$write_qualified_data_value;
        IFEND;
        NEXT new_value: [[REP new_value_size OF cell]] IN work_area;
        RESET work_area TO new_value;
        NEXT header IN work_area;
        NEXT i_value IN work_area;
        header^.value := #REL (i_value, new_value^);
        header^.unused_space := 0;
        header^.minimum_allocation_increment := 0;
      ELSE
        NEXT i_value IN work_area;
        IF i_value = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$write_qualified_data_value;
        IFEND;
        IF replacement_value_address <> NIL THEN
          replacement_value_address^ := #REL (i_value, new_value^);
          replacement_value_address := NIL;
        IFEND;
      IFEND;

    PROCEND start_new_value;
?? OLDTITLE, EJECT ??

{
{ An assumption is made that the initial value of value_qualifiers is NOT NIL.
{ Value_qualifiers were created by the procedure CLP$GET_WRITE_VALUE_QUALIFIERS.
{


    status.normal := TRUE;
    new_value := NIL;
    IF old_value = NIL THEN
      i_value := NIL;
    ELSE
      i_value := #PTR (old_value^.header.value, old_value^);
    IFEND;
    graft_address := NIL;
    replacement_value_address := NIL;
    write_complete := FALSE;
    string_address := NIL;
    status_text_size := NIL;

    FOR index := 1 TO UPPERBOUND (value_qualifiers^) DO

      IF i_value = NIL THEN
        CASE value_qualifiers^ [index].kind OF
        = clc$array_subscript_qualifier, clc$field_qualifier =
{ Initialization "by component" is allowed for an array or record.
        ELSE
          osp$set_status_abnormal ('CL', cle$cannot_initialize_component, name, status);
          RETURN;
        CASEND;
      IFEND;

      CASE value_qualifiers^ [index].kind OF

      = clc$array_subscript_qualifier =
        subscript := value_qualifiers^ [index].array_subscript;
        IF i_value <> NIL THEN
          elements := #PTR (i_value^.array_value, old_value^);
        IFEND;
        evaluate_array_subscript_qual;

      = clc$field_qualifier =
        evaluate_field_qualifier;

      = clc$list_subscript_qualifier =
        subscript := value_qualifiers^ [index].list_subscript;
        evaluate_list_subscript_qual;

      = clc$substring_qualifier =
        specified_index := value_qualifiers^ [index].index;
        specified_size := value_qualifiers^ [index].size;
        all_specified := value_qualifiers^ [index].all_specified;
        evaluate_substring_qualifier;

      = clc$unspecified_field_qualifier =
        CASE i_value^.kind OF
        = clc$command_reference, clc$date_time, clc$entry_point_reference, clc$range, clc$record,
              clc$scu_line_identifier, clc$status, clc$time_increment, clc$time_zone =
          IF string_address <> NIL THEN
            osp$set_status_abnormal ('CL', cle$undefined_variable_field, value_qualifiers^ [index].field_name,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
            RETURN;
          IFEND;
          evaluate_field_qualifier;
          IF write_complete AND (index <> UPPERBOUND (value_qualifiers^)) THEN
            osp$set_status_abnormal ('CL', cle$undefined_var_qualifier, name, status);
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal ('CL', cle$undefined_variable_field, value_qualifiers^ [index].field_name,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
          RETURN;
        CASEND;

      = clc$unspecified_subscript_qual =
        CASE i_value^.kind OF
        = clc$array =
          subscript := value_qualifiers^ [index].unspecified_subscript;
          elements := #PTR (i_value^.array_value, old_value^);
          IF (subscript < LOWERBOUND (elements^)) OR (subscript > UPPERBOUND (elements^)) THEN
            osp$set_status_abnormal ('CL', cle$subscript_out_of_range, name, status);
            osp$append_status_integer (osc$status_parameter_delimiter, subscript, 10, FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, LOWERBOUND (elements^), 10, FALSE,
                  status);
            osp$append_status_integer (osc$status_parameter_delimiter, UPPERBOUND (elements^), 10, FALSE,
                  status);
            RETURN;
          IFEND;
          evaluate_array_subscript_qual;
        = clc$list =
          subscript := value_qualifiers^ [index].unspecified_subscript;
          evaluate_list_subscript_qual;
        = clc$string =
          specified_index := value_qualifiers^ [index].unspecified_subscript;
          specified_size := 1;
          all_specified := FALSE;
          evaluate_substring_qualifier;
        ELSE
          osp$set_status_abnormal ('CL', cle$undefined_var_subscript, name, status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                value_qualifiers^ [index].unspecified_subscript, 10, FALSE, status);
          RETURN;
        CASEND;

      = clc$unspecified_substring_qual =
        IF i_value^.kind <> clc$string THEN
          osp$set_status_abnormal ('CL', cle$undefined_var_substring, name, status);
          RETURN;
        IFEND;
        specified_index := value_qualifiers^ [index].unspecified_index;
        specified_size := value_qualifiers^ [index].unspecified_size;
        all_specified := value_qualifiers^ [index].unspecified_all_found;
        evaluate_substring_qualifier;

      CASEND;
    FOREND;

{ Change the value component if it has not been changed yet.
{ The only place where the value component could be changed
{ already is in evaluate_field_qualifier.

    IF string_address <> NIL THEN
      IF replacement_value^.kind <> clc$string THEN
        osp$set_status_abnormal ('CL', cle$bad_data_value, name, status);
        RETURN;
      IFEND;
      replacement_value_string_size := STRLENGTH (replacement_value^.string_value^);
      IF status_text_size <> NIL THEN
        max_string_size := osc$max_string_size;
        min_string_size := 0;
        IF replacement_value_string_size > max_string_size THEN
          string_size := max_string_size;
        ELSE
          string_size := replacement_value_string_size;
        IFEND;
      ELSE
        max_string_size := string_size;
        min_string_size := string_size;
      IFEND;
      IF NOT allow_padding_or_truncation THEN
        IF replacement_value_string_size > max_string_size THEN
          osp$set_status_abnormal ('CL', cle$string_value_too_long, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, max_string_size, 10, FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, replacement_value_string_size, 10, FALSE,
                status);
          clp$append_status_string (osc$status_parameter_delimiter, replacement_value^.string_value^, status);
          RETURN;
        ELSEIF replacement_value_string_size < min_string_size THEN
          osp$set_status_abnormal ('CL', cle$string_value_too_short, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, min_string_size, 10, FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, replacement_value_string_size, 10, FALSE,
                status);
          clp$append_status_string (osc$status_parameter_delimiter, replacement_value^.string_value^, status);
          RETURN;
        IFEND;
      IFEND;
      string_address^ (string_index, string_size) := replacement_value^.string_value^;
      IF status_text_size <> NIL THEN
        status_text_size^ := string_size;
      IFEND;

    ELSEIF NOT write_complete THEN
      clp$convert_ext_value_to_int (NIL, replacement_value, replacement_value_address, work_area, new_value,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF old_value <> NIL THEN
      IF new_value <> NIL THEN
        clp$change_internal_value (conformance_checked, old_value, graft_address, work_area, new_value,
              status);
      ELSE
        new_value := old_value;
      IFEND;
    ELSE
      new_value_size := i#current_sequence_position (work_area) -
            initial_position - #SIZE (clt$internal_data_value_header);
      RESET work_area TO new_value;
      NEXT new_value: [[REP new_value_size OF cell]] IN work_area;
    IFEND;

  PROCEND clp$write_qualified_data_value;
*IFEND
?? TITLE := 'evaluate_union_type_description', EJECT ??

  PROCEDURE evaluate_union_type_description
    (    name: clt$variable_name;
         kind: clt$type_kind;
     VAR type_description {input, output} : ^clt$type_description;
     VAR status: ost$status);

    VAR
      index: integer;


    FOR index := 1 TO UPPERBOUND (type_description^.member_descriptions^) DO
      IF type_description^.member_descriptions^ [index].kind = kind THEN
        type_description := ^type_description^.member_descriptions^ [index];
        RETURN;
      IFEND;
    FOREND;

{ Should never get here.
    osp$set_status_abnormal ('CL', cle$internal_read_variable_err, name, status);

  PROCEND evaluate_union_type_description;

MODEND clm$process_value_qualifiers;
