?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Variable Access Manager' ??
MODULE clm$variable_access_manager;

{
{ PURPOSE:
{   This module contains the commands that declare and remove command language variables, as well as
{   requests that read and initiate the writing of such variables.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_lexical
*copyc cle$ecc_parsing
*copyc cle$ecc_variable
*IF $true(osv$unix)
*copyc cle$not_supported
*IFEND
*copyc cle$unknown_variable
*copyc cle$work_area_overflow
*copyc clk$change_variable
*copyc clk$create_environment_variable
*copyc clk$create_procedure_variable
*copyc clk$declare_variable
*copyc clk$get_variable
*copyc clk$read_variable
*copyc clk$write_variable
*copyc clt$environment_variable_scope
*copyc clt$procedure_variable_scope
*copyc clt$variable_class
*copyc clt$variable_scope
*copyc clt$variable_value_description
?? POP ??
*IF $true(osv$unix)
*copyc clp_getenv
*IFEND
*IF NOT $true(osv$unix)
*copyc clp$access_param_variable
*copyc clp$access_variable
*copyc clp$add_to_defer_list
*IFEND
*copyc clp$append_status_parse_state
*IF NOT $true(osv$unix)
*copyc clp$change_variable_value
*copyc clp$check_name_for_boolean
*copyc clp$compute_variable_name_hash
*copyc clp$convert_integer_to_string
*copyc clp$convert_int_value_to_ext
*copyc clp$convert_type_desc_to_spec
*copyc clp$convert_type_spec_to_desc
*copyc clp$convert_value_to_var_value
*copyc clp$convert_var_value_to_value
*copyc clp$copy_data_value
*copyc clp$create_var_from_conversion
*copyc clp$create_var_from_type_spec
*copyc clp$delete_from_defer_list
*copyc clp$derive_type_desc_from_value
*ELSE
*copyc clt$access_variable_requests
*copyc clt$variable_information
*IFEND
*copyc clp$evaluate_expression
*copyc clp$evaluate_function
*copyc clp$evaluate_parameters
*IF NOT $true(osv$unix)
*copyc clp$evaluate_read_data_value
*copyc clp$evaluate_unqual_union_expr
*IFEND
*copyc clp$find_current_block
*IF NOT $true(osv$unix)
*copyc clp$find_variable_access
*copyc clp$find_first_var_block
*copyc clp$find_next_var_block
*copyc clp$get_qualified_type_desc
*IFEND
*copyc clp$get_read_value_qualifiers
*IF NOT $true(osv$unix)
*copyc clp$get_write_value_qualifiers
*IFEND
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*IF NOT $true(osv$unix)
*copyc clp$internal_delete_variable
*IFEND
*copyc clp$internal_evaluate_expr
*copyc clp$make_boolean_value
*copyc clp$make_deferred_value
*copyc clp$make_integer_value
*copyc clp$make_string_value
*copyc clp$make_unspecified_value
*copyc clp$obtain_variable_value
*IF NOT $true(osv$unix)
*copyc clp$read_qualified_data_value
*IFEND
*copyc clp$scan_lexical_unit
*copyc clp$scan_non_space_lexical_unit
*copyc clp$scan_any_lexical_unit
*IF NOT $true(osv$unix)
*copyc clp$search_parameter_names
*IFEND
*copyc clp$trimmed_string_size
*copyc clp$validate_name
*copyc clv$type_kind_names
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osv$lower_to_upper

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

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

{  PROCEDURE (osm$credv) create_default_variable, credv (
{    name, n: data_name = $required
{    default, d: string = $required
{    scope, s: (by_name) key
{      (environment, e),
{      (job, j),
{      (task, t),
{      (utility, u),
{    keyend = job
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 7] of clt$pdt_parameter_name,
        parameters: array [1 .. 4] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 8] of clt$keyword_specification,
          default_value: string (3),
        recend,
        type4: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [87, 10, 26, 8, 55, 37, 863], clc$command, 7, 4, 2, 0, 0, 0, 4, 'OSM$CREDV'],
            [['D                              ', clc$abbreviation_entry, 2],
            ['DEFAULT                        ', clc$nominal_entry, 2],
            ['N                              ', clc$abbreviation_entry, 1],
            ['NAME                           ', clc$nominal_entry, 1],
            ['S                              ', clc$abbreviation_entry, 3],
            ['SCOPE                          ', clc$nominal_entry, 3],
            ['STATUS                         ', clc$nominal_entry, 4]], [

{ PARAMETER 1

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

{ PARAMETER 2

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

{ PARAMETER 3

      [6, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
            clc$optional_default_parameter, 0, 3],

{ PARAMETER 4

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

{ PARAMETER 1

      [[1, 0, clc$data_name_type]],

{ PARAMETER 2

      [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],

{ PARAMETER 3

      [[1, 0, clc$keyword_type], [8], [['E                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 1], ['ENVIRONMENT                    ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['J                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 2], ['JOB                            ', clc$nominal_entry,
            clc$normal_usage_entry, 2], ['T                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 3], ['TASK                           ', clc$nominal_entry,
            clc$normal_usage_entry, 3], ['U                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 4], ['UTILITY                        ', clc$nominal_entry,
            clc$normal_usage_entry, 4]], 'job'],

{ PARAMETER 4

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

?? POP ??

    CONST
      p$name = 1,
      p$default = 2,
      p$scope = 3,
      p$status = 4;

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

{  TYPE
{    string = string
{  TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
        name: string (6),
        qualifier: clt$string_type_qualifier,
      recend := [[1, 6, clc$string_type], 'STRING', [0, clc$max_string_size, FALSE]];

?? POP ??


    status.normal := TRUE;

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

    create_default_or_file_variable (pvt [p$name].value^.data_name_value, pvt [p$scope].value^.
          keyword_value, #SEQ (type_specification), pvt [p$default].value, status);

  PROCEND clp$_create_default_variable;
?? TITLE := 'clp$_create_file_variable', EJECT ??

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

{  PROCEDURE (osm$crefv) create_file_variable, crefv (
{    name, n: data_name = $required
{    file, f: file = $required
{    scope, s: (by_name) key
{      (environment, e),
{      (job, j),
{      (task, t),
{      (utility, u),
{    keyend = job
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 7] of clt$pdt_parameter_name,
        parameters: array [1 .. 4] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 8] of clt$keyword_specification,
          default_value: string (3),
        recend,
        type4: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [87, 10, 26, 8, 55, 56, 521], clc$command, 7, 4, 2, 0, 0, 0, 4, 'OSM$CREFV'],
            [['F                              ', clc$abbreviation_entry, 2],
            ['FILE                           ', clc$nominal_entry, 2],
            ['N                              ', clc$abbreviation_entry, 1],
            ['NAME                           ', clc$nominal_entry, 1],
            ['S                              ', clc$abbreviation_entry, 3],
            ['SCOPE                          ', clc$nominal_entry, 3],
            ['STATUS                         ', clc$nominal_entry, 4]], [

{ PARAMETER 1

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

{ PARAMETER 2

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

{ PARAMETER 3

      [6, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
            clc$optional_default_parameter, 0, 3],

{ PARAMETER 4

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

{ PARAMETER 1

      [[1, 0, clc$data_name_type]],

{ PARAMETER 2

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

{ PARAMETER 3

      [[1, 0, clc$keyword_type], [8], [['E                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 1], ['ENVIRONMENT                    ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['J                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 2], ['JOB                            ', clc$nominal_entry,
            clc$normal_usage_entry, 2], ['T                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 3], ['TASK                           ', clc$nominal_entry,
            clc$normal_usage_entry, 3], ['U                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 4], ['UTILITY                        ', clc$nominal_entry,
            clc$normal_usage_entry, 4]], 'job'],

{ PARAMETER 4

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

?? POP ??

    CONST
      p$name = 1,
      p$file = 2,
      p$scope = 3,
      p$status = 4;

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

{  TYPE
{    file = file
{  TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
        name: string (4),
      recend := [[1, 4, clc$file_type], 'FILE'];

?? POP ??


    status.normal := TRUE;

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

    create_default_or_file_variable (pvt [p$name].value^.data_name_value, pvt [p$scope].value^.
          keyword_value, #SEQ (type_specification), pvt [p$file].value, status);

  PROCEND clp$_create_file_variable;
?? TITLE := 'clp$_create_variable', EJECT ??

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

{ PROCEDURE (osm$crev) create_variables, create_variable, crev (
{   names, name, n: any of
{       data_name
{       list of data_name
{     anyend = $required
{   kind, k: any of
{       key
{         integer, boolean, real, status, string
{       keyend
{       record
{         string_kind: key
{           string
{         keyend
{         maximum_string_size: integer 0..clc$max_string_size
{       recend
{     anyend = integer
{   dimension, d: range of integer clc$min_variable_dimension..clc$max_variable_dimension = $optional
{   value, v: any = $optional
{   scope, s: any of
{       key
{         local, xdcl, xref, job
{       keyend
{       data_name
{     anyend = local
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 12] of clt$pdt_parameter_name,
        parameters: array [1 .. 6] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$list_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
            recend,
          recend,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 5] of clt$keyword_specification,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$record_type_qualifier,
            field_spec_1: clt$field_specification,
            element_type_spec_1: record
              header: clt$type_specification_header,
              qualifier: clt$keyword_type_qualifier,
              keyword_specs: array [1 .. 1] of clt$keyword_specification,
            recend,
            field_spec_2: clt$field_specification,
            element_type_spec_2: record
              header: clt$type_specification_header,
              qualifier: clt$integer_type_qualifier,
            recend,
          recend,
          default_value: string (7),
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$range_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
        recend,
        type4: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
        recend,
        type5: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 4] of clt$keyword_specification,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
          recend,
          default_value: string (5),
        recend,
        type6: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 5, 16, 14, 49, 32, 581], clc$command, 12, 6, 1, 0, 0, 0, 6, 'OSM$CREV'],
            [['D                              ', clc$abbreviation_entry, 3],
            ['DIMENSION                      ', clc$nominal_entry, 3],
            ['K                              ', clc$abbreviation_entry, 2],
            ['KIND                           ', clc$nominal_entry, 2],
            ['N                              ', clc$abbreviation_entry, 1],
            ['NAME                           ', clc$alias_entry, 1],
            ['NAMES                          ', clc$nominal_entry, 1],
            ['S                              ', clc$abbreviation_entry, 5],
            ['SCOPE                          ', clc$nominal_entry, 5],
            ['STATUS                         ', clc$nominal_entry, 6],
            ['V                              ', clc$abbreviation_entry, 4],
            ['VALUE                          ', clc$nominal_entry, 4]], [

{ PARAMETER 1

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

{ PARAMETER 2

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

{ PARAMETER 3

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

{ PARAMETER 4

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

{ PARAMETER 5

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

{ PARAMETER 6

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

{ PARAMETER 1

      [[1, 0, clc$union_type], [[clc$data_name_type, clc$list_type], FALSE, 2], 3,
            [[1, 0, clc$data_name_type]], 19, [[1, 0, clc$list_type],
            [3, 1, clc$max_list_size, FALSE], [[1, 0, clc$data_name_type]]]],

{ PARAMETER 2

      [[1, 0, clc$union_type], [[clc$keyword_type, clc$record_type], FALSE, 2], 192,
            [[1, 0, clc$keyword_type], [5], [['BOOLEAN                        ', clc$nominal_entry,
            clc$normal_usage_entry, 2], ['INTEGER                        ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['REAL                           ', clc$nominal_entry,
            clc$normal_usage_entry, 3], ['STATUS                         ', clc$nominal_entry,
            clc$normal_usage_entry, 4], ['STRING                         ', clc$nominal_entry,
            clc$normal_usage_entry, 5]]], 143, [[1, 0, clc$record_type], [2],
            ['STRING_KIND                    ', clc$required_field, 44],
            [[1, 0, clc$keyword_type], [1], [['STRING                         ', clc$nominal_entry,
            clc$normal_usage_entry, 1]]], ['MAXIMUM_STRING_SIZE            ', clc$required_field, 20],
            [[1, 0, clc$integer_type], [0, clc$max_string_size, 10]]], 'integer'],

{ PARAMETER 3

      [[1, 0, clc$range_type], [20], [[1, 0, clc$integer_type],
            [clc$min_variable_dimension, clc$max_variable_dimension, 10]]],

{ PARAMETER 4

      [[1, 0, clc$union_type], [-$clt$type_kinds [], FALSE, 0]],

{ PARAMETER 5

      [[1, 0, clc$union_type], [[clc$data_name_type, clc$keyword_type], FALSE, 2], 155,
            [[1, 0, clc$keyword_type], [4], [['JOB                            ', clc$nominal_entry,
            clc$normal_usage_entry, 4], ['LOCAL                          ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['XDCL                           ', clc$nominal_entry,
            clc$normal_usage_entry, 2], ['XREF                           ', clc$nominal_entry,
            clc$normal_usage_entry, 3]]], 3, [[1, 0, clc$data_name_type]], 'local'],

{ PARAMETER 6

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

?? POP ??

    CONST
      p$names = 1,
      p$kind = 2,
      p$dimension = 3,
      p$value = 4,
      p$scope = 5,
      p$status = 6;

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

    VAR
      create_array: boolean,
      ignore_var_ref: clt$variable_reference,
      index: integer,
      initial_value: ^clt$data_value,
      kind: clt$variable_kinds,
      list_value: ^clt$data_value,
      lower_bound: clt$variable_dimension,
      max_string_size: clt$string_size,
      name: ost$name,
      scope: clt$variable_scope,
      upper_bound: clt$variable_dimension,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;

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

*IF NOT $true(osv$unix)
    clp$get_work_area (#RING (^work_area_ptr), work_area_ptr, status);
*ELSE
    clp$get_work_area (osc$user_ring, work_area_ptr, status);
*IFEND
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    work_area := work_area_ptr^;

    IF pvt [p$names].value^.kind = clc$list THEN
      list_value := pvt [p$names].value;
    ELSE
      PUSH list_value;
      list_value^.kind := clc$list;
      list_value^.element_value := pvt [p$names].value;
      list_value^.link := NIL;
      list_value^.generated_via_list_rest := FALSE;
    IFEND;

    IF pvt [p$kind].value^.kind = clc$keyword THEN
      max_string_size := 1;
      IF pvt [p$kind].value^.keyword_value = 'BOOLEAN' THEN
        kind := clc$boolean_value;
      ELSEIF pvt [p$kind].value^.keyword_value = 'INTEGER' THEN
        kind := clc$integer_value;
      ELSEIF pvt [p$kind].value^.keyword_value = 'REAL' THEN
        kind := clc$real_value;
      ELSEIF pvt [p$kind].value^.keyword_value = 'STATUS' THEN
        kind := clc$status_value;
      ELSE

{ Can only be STRING.

        kind := clc$string_value;
        max_string_size := clc$max_string_size;
      IFEND;
    ELSE

{ Can only be STRING with a specified string size.

      kind := clc$string_value;
      max_string_size := pvt [p$kind].value^.field_values^ [2].value^.integer_value.value;
      IF max_string_size = osc$max_string_size THEN
        max_string_size := clc$max_string_size;
      IFEND;
    IFEND;

    create_array := pvt [p$dimension].specified;
    IF NOT create_array THEN
      lower_bound := 1;
      upper_bound := 1;
    ELSE
      upper_bound := pvt [p$dimension].value^.high_value^.integer_value.value;
      IF pvt [p$dimension].value^.low_value = pvt [p$dimension].value^.high_value THEN
        lower_bound := 1;
      ELSE
        lower_bound := pvt [p$dimension].value^.low_value^.integer_value.value;
      IFEND;
      IF (lower_bound > upper_bound) THEN
        osp$set_status_abnormal ('CL', cle$improper_array_bounds, list_value^.element_value^.data_name_value,
              status);
        RETURN;
      IFEND;
    IFEND;

    IF pvt [p$scope].value^.kind = clc$keyword THEN
      IF pvt [p$scope].value^.keyword_value = 'JOB' THEN
        scope.kind := clc$job_variable;
      ELSEIF pvt [p$scope].value^.keyword_value = 'LOCAL' THEN
        scope.kind := clc$local_variable;
      ELSEIF pvt [p$scope].value^.keyword_value = 'XDCL' THEN
        scope.kind := clc$xdcl_variable;
      ELSE

{ Can only be XREF.

        scope.kind := clc$xref_variable;
      IFEND;
    ELSE

{ Can only be UTILITY with a specified utility name.

      scope.kind := clc$utility_variable;
      scope.utility_name := pvt [p$scope].value^.data_name_value;
    IFEND;

    IF pvt [p$value].specified THEN
      CASE pvt [p$value].value^.kind OF
      = clc$boolean, clc$integer, clc$real, clc$string, clc$status =
        IF NOT create_array THEN
          initial_value := pvt [p$value].value;
        ELSE
          NEXT initial_value IN work_area_ptr^;
          IF initial_value <> NIL THEN
            NEXT initial_value^.array_value: [lower_bound .. upper_bound] IN work_area_ptr^;
          IFEND;
          IF initial_value = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            RETURN;
          IFEND;

          initial_value^.kind := clc$array;
          FOR index := lower_bound TO upper_bound DO
            initial_value^.array_value^ [index] := pvt [p$value].value;
          FOREND;
        IFEND;
      ELSE
        osp$set_status_abnormal ('CL', cle$not_a_variable_kind, list_value^.element_value^.data_name_value,
              status);
        RETURN;
      CASEND;
    ELSE
      initial_value := NIL;
    IFEND;

    WHILE list_value <> NIL DO
      name := list_value^.element_value^.data_name_value;
      clp$create_var_from_conversion (name, kind, max_string_size, create_array, lower_bound, upper_bound,
            scope, initial_value, FALSE, work_area_ptr^, ignore_var_ref, status);
      IF NOT status.normal THEN
        work_area_ptr^ := work_area;
        RETURN;
      IFEND;
      list_value := list_value^.link;
    WHILEND;

    work_area_ptr^ := work_area;

  PROCEND clp$_create_variable;
?? TITLE := 'clp$_delete_variable', EJECT ??

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

{ PROCEDURE (osm$delv) delete_variable, delete_variables, delv (
{   names, name, n: any of
{       data_name
{       list of data_name
{     anyend = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 4] of clt$pdt_parameter_name,
        parameters: array [1 .. 2] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$list_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
            recend,
          recend,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 5, 16, 14, 50, 26, 762], clc$command, 4, 2, 1, 0, 0, 0, 2, 'OSM$DELV'],
            [['N                              ', clc$abbreviation_entry, 1],
            ['NAME                           ', clc$alias_entry, 1],
            ['NAMES                          ', clc$nominal_entry, 1],
            ['STATUS                         ', clc$nominal_entry, 2]], [

{ PARAMETER 1

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

{ PARAMETER 2

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

{ PARAMETER 1

      [[1, 0, clc$union_type], [[clc$data_name_type, clc$list_type], FALSE, 2], 3,
            [[1, 0, clc$data_name_type]], 19, [[1, 0, clc$list_type],
            [3, 1, clc$max_list_size, FALSE], [[1, 0, clc$data_name_type]]]],

{ PARAMETER 2

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

?? POP ??

    CONST
      p$names = 1,
      p$status = 2;

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

    VAR
      list_value: ^clt$data_value,
      local_status: ost$status,
      name: ost$name;


    status.normal := TRUE;
    local_status.normal := TRUE;

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

    IF pvt [p$names].value^.kind = clc$list THEN
      list_value := pvt [p$names].value;
    ELSE
      PUSH list_value;
      list_value^.kind := clc$list;
      list_value^.element_value := pvt [p$names].value;
      list_value^.link := NIL;
      list_value^.generated_via_list_rest := FALSE;
    IFEND;

    WHILE list_value <> NIL DO
      name := list_value^.element_value^.data_name_value;
      clp$internal_delete_variable (name, -$clt$internal_variable_classes [], status);
      IF NOT status.normal THEN
        IF status.condition <> cle$unknown_variable THEN
          RETURN;
        IFEND;
        IF local_status.normal THEN
          local_status := status;
        ELSE
          osp$append_status_parameter (' ', name, local_status);
        IFEND;
      IFEND;
      list_value := list_value^.link;
    WHILEND;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$_delete_variable;
*IFEND
*IF $true(osv$unix)
?? TITLE := 'clp$$import', EJECT ??

  PROCEDURE [XDCL] clp$$import
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{   FUNCTION (osm$$import) $import (
{     variable: any of
{         string 1..31
{         name
{       anyend = $required
{     )



?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier_v2,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
    recend := [
    [2,
    [91, 12, 9, 12, 20, 28, 0],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$UNIX_VARIABLE_VALUE'], [
    ['VARIABLE                       ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 42, clc$required_parameter, 0, 0]],
{ PARAMETER 1
    [[2, 0, clc$union_type], [[clc$name_type, clc$string_type],
    TRUE, 2],
    9, [[2, 0, clc$string_type], [1, 31, FALSE]],
    6, [[2, 0, clc$name_type], [1, osc$max_name_size]]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$variable = 1;

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

    VAR
      variable_length: ost_c_integer,
      variable_name: ost_c_name,
      variable_value: ost_c_fixed_string;

    status.normal := TRUE;

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

    IF pvt [p$variable].value^.kind = clc$string THEN
      variable_name := pvt [p$variable].value^.string_value^;
    ELSE { name }
      variable_name := pvt [p$variable].value^.name_value;
    IFEND;
    clp_getenv (variable_name, variable_value, variable_length);

    clp$make_string_value (variable_value (1, variable_length), work_area, result);
    IF result = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
    IFEND;

  PROCEND clp$$import;
*IFEND
*IF NOT $true(osv$unix)
?? TITLE := 'clp$$variable', EJECT ??

  PROCEDURE [XDCL] clp$$variable
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$variable) $variable (
{   variable: data_name = $required
{   attribute: key
{       defined
{       environment
{       initialized
{       local
{       nonlocal
{       read
{     hidden_key
{       declared
{       kind
{       lower_bound
{       upper_bound
{       string_size
{   keyend = $required
{   )

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 2] of clt$pdt_parameter_name,
        parameters: array [1 .. 2] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 11] of clt$keyword_specification,
        recend,
      recend := [[1, [87, 11, 19, 15, 48, 41, 125], clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$VARIABLE'],
            [['ATTRIBUTE                      ', clc$nominal_entry, 2],
            ['VARIABLE                       ', clc$nominal_entry, 1]], [

{ PARAMETER 1

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

{ PARAMETER 2

      [1, clc$normal_usage_entry, clc$non_secure_parameter,
            $clt$parameter_spec_methods [clc$specify_positionally], clc$pass_by_value,
            clc$immediate_evaluation, clc$standard_parameter_checking, 414, clc$required_parameter, 0, 0]],

{ PARAMETER 1

      [[1, 0, clc$data_name_type]],

{ PARAMETER 2

      [[1, 0, clc$keyword_type], [11], [['DECLARED                       ', clc$nominal_entry,
            clc$hidden_entry, 7], ['DEFINED                        ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['ENVIRONMENT                    ', clc$nominal_entry,
            clc$normal_usage_entry, 2], ['INITIALIZED                    ', clc$nominal_entry,
            clc$normal_usage_entry, 3], ['KIND                           ', clc$nominal_entry,
            clc$hidden_entry, 8], ['LOCAL                          ', clc$nominal_entry,
            clc$normal_usage_entry, 4], ['LOWER_BOUND                    ', clc$nominal_entry,
            clc$hidden_entry, 9], ['NONLOCAL                       ', clc$nominal_entry,
            clc$normal_usage_entry, 5], ['READ                           ', clc$nominal_entry,
            clc$normal_usage_entry, 6], ['STRING_SIZE                    ', clc$nominal_entry,
            clc$hidden_entry, 11], ['UPPER_BOUND                    ', clc$nominal_entry, clc$hidden_entry,
            10]]]];

?? POP ??

    CONST
      p$variable = 1,
      p$attribute = 2;

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

    VAR
      allowed_classes: clt$internal_variable_classes,
      associated_utility: boolean,
      block: ^clt$block,
      date_time_type_qualifier: ^clt$date_time_type_qualifier,
      hash: clt$variable_name_hash,
      hashed_name: clt$variable_name,
      inherited_allowed_classes: clt$internal_variable_classes,
      inherited_block: ^clt$block,
      i_value: ^clt$i_data_value,
      keyword: clt$keyword,
      local_block: boolean,
      local_for_declared_keyword: boolean,
      type_specification_area: ^clt$type_specification,
      type_specification_header: ^clt$type_specification_header,
      variable_name: clt$variable_name,
      variable_access_info: ^clt$variable_access_info;

?? NEWTITLE := 'find_variable', EJECT ??

    PROCEDURE [INLINE] find_variable
      (    include_xdcl_variables: boolean);


      local_block := TRUE;
      local_for_declared_keyword := TRUE;
      allowed_classes := -$clt$internal_variable_classes [clc$param_variable];
      clp$find_first_var_block (allowed_classes, inherited_allowed_classes, inherited_block, block,
            associated_utility);
      WHILE block <> NIL DO
        IF (inherited_block <> NIL) AND (block^.kind IN $clt$block_kinds
              [clc$command_proc_block, clc$function_proc_block]) AND block^.parameters.evaluated THEN
          IF include_xdcl_variables THEN
            allowed_classes := $clt$internal_variable_classes
                  [clc$env_variable, clc$lib_variable, clc$pushed_variable, clc$xdcled_variable];
          ELSE
            allowed_classes := $clt$internal_variable_classes
                  [clc$env_variable, clc$lib_variable, clc$pushed_variable];
          IFEND;
        IFEND;

        IF associated_utility AND (block = inherited_block) THEN
          IF include_xdcl_variables THEN
            allowed_classes := $clt$internal_variable_classes
                  [clc$env_variable, clc$lib_variable, clc$pushed_variable, clc$xdcled_variable];
          ELSE
            allowed_classes := $clt$internal_variable_classes
                  [clc$env_variable, clc$lib_variable, clc$pushed_variable];
          IFEND;
        IFEND;
        clp$find_variable_access (variable_name, hashed_name, hash, allowed_classes, block,
              variable_access_info);
        IF variable_access_info <> NIL THEN
          RETURN;
        IFEND;
        IF (block^.kind IN $clt$block_kinds [clc$command_proc_block, clc$function_proc_block]) AND
              block^.parameters.evaluated THEN
          IF include_xdcl_variables THEN
            allowed_classes := $clt$internal_variable_classes
                  [clc$env_variable, clc$lib_variable, clc$pushed_variable, clc$xdcled_variable];
          ELSE
            allowed_classes := $clt$internal_variable_classes
                  [clc$env_variable, clc$lib_variable, clc$pushed_variable];
          IFEND;
        IFEND;
        IF (block^.static_link = NIL) AND (block^.kind <> clc$utility_block) THEN
          local_for_declared_keyword := FALSE;
        IFEND;
        clp$find_next_var_block (allowed_classes, inherited_allowed_classes, inherited_block, block,
              associated_utility);
        local_block := FALSE;
      WHILEND;

    PROCEND find_variable;
?? TITLE := 'process_declared_keyword', EJECT ??

    PROCEDURE [INLINE] process_declared_keyword;

      find_variable ({include_xdcled_variables =} TRUE);

      IF variable_access_info = NIL THEN
        clp$make_string_value ('UNKNOWN', work_area, result);
      ELSEIF local_for_declared_keyword THEN
        clp$make_string_value ('LOCAL', work_area, result);
      ELSE
        clp$make_string_value ('NONLOCAL', work_area, result);
      IFEND;

    PROCEND process_declared_keyword;
?? TITLE := 'process_environment_keyword', EJECT ??

    PROCEDURE process_environment_keyword;

      VAR
        environment_variable: boolean;


      find_variable ({include_xdcled_variables =} FALSE);
      environment_variable := (variable_access_info <> NIL) AND
            (variable_access_info^.class IN $clt$internal_variable_classes
            [clc$env_variable, clc$lib_variable, clc$pushed_variable]);
      clp$make_boolean_value (environment_variable, clc$true_false_boolean, work_area, result);

    PROCEND process_environment_keyword;
?? TITLE := 'process_initialized_keyword', EJECT ??

    PROCEDURE process_initialized_keyword;

      VAR
        initialized_variable: boolean;


      find_variable ({include_xdcled_variables =} TRUE);
      initialized_variable := (variable_access_info <> NIL) AND (variable_access_info^.descriptor <> NIL) AND
            (variable_access_info^.descriptor^.header.value <> NIL);
      clp$make_boolean_value (initialized_variable, clc$true_false_boolean, work_area, result);

    PROCEND process_initialized_keyword;
?? TITLE := 'process_kind_keyword', EJECT ??

    PROCEDURE process_kind_keyword;


      find_variable ({include_xdcled_variables =} TRUE);
      IF (variable_access_info <> NIL) AND (variable_access_info^.descriptor <> NIL) THEN
        type_specification_area := ^variable_access_info^.descriptor^.type_specification;
        RESET type_specification_area;
        NEXT type_specification_header IN type_specification_area;
        IF type_specification_header^.kind = clc$date_time_type THEN
          NEXT date_time_type_qualifier IN type_specification_area;
          IF date_time_type_qualifier^.date_and_or_time = $clt$date_and_or_time [clc$date, clc$time] THEN
            clp$make_string_value ('DATE_TIME', work_area, result);
          ELSEIF date_time_type_qualifier^.date_and_or_time = $clt$date_and_or_time [clc$date] THEN
            clp$make_string_value ('DATE', work_area, result);
          ELSE
            clp$make_string_value ('TIME', work_area, result);
          IFEND;
        ELSE
          clp$make_string_value (clv$type_kind_names [type_specification_header^.kind]
                (1, clp$trimmed_string_size (clv$type_kind_names [type_specification_header^.kind])),
                work_area, result);
        IFEND;
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_variable, variable_name, status);
      IFEND;

    PROCEND process_kind_keyword;
?? TITLE := 'process_local_keyword', EJECT ??

    PROCEDURE process_local_keyword;

      VAR
        local_variable: boolean;


      find_variable ({include_xdcled_variables =} FALSE);

      clp$make_boolean_value ((variable_access_info <> NIL) AND local_block, clc$true_false_boolean,
            work_area, result);

    PROCEND process_local_keyword;
?? TITLE := 'process_lower_bound_keyword', EJECT ??

    PROCEDURE process_lower_bound_keyword;

      VAR
        array_type_qualifier: ^clt$array_type_qualifier,
        lower_bound: clt$array_bound;


      find_variable ({include_xdcled_variables =} TRUE);
      IF (variable_access_info <> NIL) AND (variable_access_info^.descriptor <> NIL) THEN
        type_specification_area := ^variable_access_info^.descriptor^.type_specification;
        RESET type_specification_area;
        NEXT type_specification_header IN type_specification_area;
        lower_bound := 1;
        IF type_specification_header^.kind = clc$array_type THEN
          NEXT array_type_qualifier IN type_specification_area;
          IF array_type_qualifier^.array_bounds_defined THEN
            lower_bound := array_type_qualifier^.bounds.lower;
          IFEND;
        IFEND;
        clp$make_integer_value (lower_bound, 10, FALSE, work_area, result);
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_variable, variable_name, status);
      IFEND;

    PROCEND process_lower_bound_keyword;
?? TITLE := 'process_nonlocal_keyword', EJECT ??

    PROCEDURE process_nonlocal_keyword;


      find_variable ({include_xdcled_variables =} TRUE);

      clp$make_boolean_value ((variable_access_info <> NIL) AND (NOT local_block), clc$true_false_boolean,
            work_area, result);

    PROCEND process_nonlocal_keyword;
?? TITLE := 'process_read_keyword', EJECT ??

    PROCEDURE process_read_keyword;


      find_variable ({include_xdcled_variables =} TRUE);

      clp$make_boolean_value ((variable_access_info <> NIL) AND
            (variable_access_info^.access_mode = clc$read_only), clc$true_false_boolean, work_area, result);

    PROCEND process_read_keyword;
?? TITLE := 'process_string_size_keyword', EJECT ??

    PROCEDURE process_string_size_keyword;

      VAR
        string_type_qualifier: ^clt$string_type_qualifier;


      find_variable ({include_xdcled_variables =} TRUE);
      IF (variable_access_info <> NIL) AND (variable_access_info^.descriptor <> NIL) THEN
        type_specification_area := ^variable_access_info^.descriptor^.type_specification;
        RESET type_specification_area;
        NEXT type_specification_header IN type_specification_area;
        IF type_specification_header^.kind <> clc$string_type THEN
          osp$set_status_abnormal ('CL', cle$undefined_var_attribute, keyword, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, variable_name, status);
        ELSE
          NEXT string_type_qualifier IN type_specification_area;
          clp$make_integer_value (string_type_qualifier^.max_string_size, 10, FALSE, work_area, result);
        IFEND;
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_variable, variable_name, status);
      IFEND;

    PROCEND process_string_size_keyword;
?? TITLE := 'process_upper_bound_keyword', EJECT ??

    PROCEDURE process_upper_bound_keyword;

      VAR
        array_type_qualifier: ^clt$array_type_qualifier,
        upper_bound: clt$array_bound;


      find_variable ({include_xdcled_variables =} TRUE);
      IF (variable_access_info <> NIL) AND (variable_access_info^.descriptor <> NIL) THEN
        type_specification_area := ^variable_access_info^.descriptor^.type_specification;
        RESET type_specification_area;
        NEXT type_specification_header IN type_specification_area;
        upper_bound := 1;
        IF type_specification_header^.kind = clc$array_type THEN
          NEXT array_type_qualifier IN type_specification_area;
          IF array_type_qualifier^.array_bounds_defined THEN
            upper_bound := array_type_qualifier^.bounds.upper;
          IFEND;
        IFEND;
        clp$make_integer_value (upper_bound, 10, FALSE, work_area, result);
      ELSE
        osp$set_status_abnormal ('CL', cle$unknown_variable, variable_name, status);
      IFEND;

    PROCEND process_upper_bound_keyword;
?? OLDTITLE, EJECT ??

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

    keyword := pvt [p$attribute].value^.keyword_value;
    variable_name := pvt [p$variable].value^.data_name_value;
    clp$compute_variable_name_hash (variable_name, hashed_name, hash);
    IF keyword = 'DEFINED' THEN
      find_variable ({include_xdcled_variables =} TRUE);
      clp$make_boolean_value ((variable_access_info <> NIL), clc$true_false_boolean, work_area, result);
    ELSEIF keyword = 'ENVIRONMENT' THEN
      process_environment_keyword;
    ELSEIF keyword = 'INITIALIZED' THEN
      process_initialized_keyword;
    ELSEIF keyword = 'LOCAL' THEN
      process_local_keyword;
    ELSEIF keyword = 'NONLOCAL' THEN
      process_nonlocal_keyword;
    ELSEIF keyword = 'READ' THEN
      process_read_keyword;

{ The following keywords are being retained for compatibility.

    ELSEIF keyword = 'DECLARED' THEN
      process_declared_keyword;
    ELSEIF keyword = 'KIND' THEN
      process_kind_keyword;
    ELSEIF keyword = 'LOWER_BOUND' THEN
      process_lower_bound_keyword;
    ELSEIF keyword = 'STRING_SIZE' THEN
      process_string_size_keyword;
    ELSEIF keyword = 'UPPER_BOUND' THEN
      process_upper_bound_keyword;
    IFEND;

    IF status.normal AND (result = NIL) THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
    IFEND;

  PROCEND clp$$variable;
?? TITLE := 'clp$assignment_statement', EJECT ??

  PROCEDURE [XDCL] clp$assignment_statement
    (VAR left_parse {input, output} : clt$parse_state;
     VAR right_parse {input, output} : clt$parse_state;
     VAR work_area {input,output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      access_handle: clt$variable_access_handle,
      access_variable_requests: clt$access_variable_requests,
      bool: clt$boolean,
      complete_type_description: ^clt$type_description,
      data_value: ^clt$data_value,
      left_operand_name: ost$name,
      left_variable_name: clt$variable_name,
      name_is_boolean: boolean,
      qualified_type_description_copy: clt$type_description,
      result_type_description: ^clt$type_description,
      result_type_specification: ^clt$type_specification,
      right_operand_name: ost$name,
      variable_found: boolean,
      variable_information: clt$variable_information;

    status.normal := TRUE;

{ Evaluate left operand.

    IF left_parse.unit.kind <> clc$lex_name THEN
      osp$set_status_abnormal ('CL', cle$expecting_variable_name, '', status);
      RETURN;
    IFEND;
    #TRANSLATE (osv$lower_to_upper, left_parse.text^ (left_parse.unit_index, left_parse.unit.size),
          left_operand_name);
    clp$scan_any_lexical_unit (left_parse);

    access_variable_requests := $clt$access_variable_requests
          [clc$type_spec_if_defer_method, clc$return_type_description, clc$return_value_qualifiers];
    clp$evaluate_name_for_write (left_operand_name, access_variable_requests, FALSE, left_parse, work_area,
          left_variable_name, variable_information, access_handle, complete_type_description, variable_found,
          status);
    IF NOT status.normal THEN

{ Ignore the error if it is the result of attempting to write to a read only parameter variable,
{ not through $VALUE or $PARAMETER_VALUE, and it is an unqualified reference.  Then go ahead
{ and implicitly create the variable as it would if the parameter variable did not exist.

      IF (status.condition <> cle$cannot_assign_to_a_read_var) OR (left_operand_name (1) = '$') OR
            (variable_information.class <> clc$param_variable) OR
            (left_parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot]) THEN
        RETURN;
      IFEND;
      variable_found := FALSE;
      status.normal := TRUE;
    IFEND;

    IF left_parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (left_parse);
    IFEND;
    IF left_parse.unit_index <> left_parse.index_limit THEN
      osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, left_parse, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, ' for left side of assignment statement',
            status);
      RETURN;
    IFEND;

{ Evaluate right operand.

  /evaluate_value/
    BEGIN
      IF variable_found THEN
        IF variable_information.evaluation_method = clc$deferred_evaluation THEN
          clp$make_deferred_value (right_parse.text^ (right_parse.unit_index,
                right_parse.index_limit - right_parse.unit_index), variable_information.type_specification,
                work_area, data_value);
          IF data_value = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            RETURN;
          IFEND;
          EXIT /evaluate_value/;
        ELSE
          IF variable_information.type_description = NIL THEN

{ There are qualifiers in the left operand and an 'ANY' type was found in the evaluation of the
{ type description for that left operand.

            clp$evaluate_unqual_union_expr (work_area, right_parse, result_type_description, data_value,
                  status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          ELSE

{
{ The variable_information.type_description for the text field of a status variable
{ resides in OSS$JOB_PAGED_LITERAL. Therefore you cannot change any fields within the
{ variable_information.type_description.
{

            qualified_type_description_copy := variable_information.type_description^;
            IF variable_information.type_description^.kind = clc$string_type THEN
              qualified_type_description_copy.min_string_size := 0;
              qualified_type_description_copy.max_string_size := clc$max_string_size;
            IFEND;

            clp$internal_evaluate_expr (right_parse, ^qualified_type_description_copy, work_area,
                  result_type_description, data_value, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

          IFEND;

          IF variable_information.value_qualifiers_present AND (data_value^.kind = clc$deferred) THEN
            osp$set_status_abnormal ('CL', cle$improper_use_of_defer_var, left_operand_name, status);
            RETURN;
          IFEND;
        IFEND;
      ELSE
        clp$evaluate_unqual_union_expr (work_area, right_parse, result_type_description, data_value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      IF right_parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (right_parse);
      IFEND;
      IF right_parse.unit_index <> right_parse.index_limit THEN
        osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, right_parse, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              ' for right side of assignment statement', status);
        RETURN;
      IFEND;
    END /evaluate_value/;

    IF variable_found THEN
      clp$change_variable_value (left_variable_name, data_value, variable_information.value_qualifiers,
            complete_type_description, variable_information.type_description, access_handle, TRUE, work_area,
            status);
    ELSE
      IF result_type_description = NIL THEN
        NEXT result_type_description IN work_area;
        IF result_type_description = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          RETURN;
        IFEND;
        clp$derive_type_desc_from_value (data_value, work_area, result_type_description^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      clp$convert_type_desc_to_spec (result_type_description, work_area, result_type_specification, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$create_var_from_type_spec (left_variable_name, clc$local_scope, clc$read_write,
            clc$immediate_evaluation, result_type_specification, data_value, FALSE, work_area, status);
    IFEND;

  PROCEND clp$assignment_statement;
?? TITLE := 'clp$change_variable', EJECT ??
*copyc clh$change_variable

  PROCEDURE [XDCL, #GATE] clp$change_variable
    (    reference: clt$variable_ref_expression;
         value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      replacement_value: clt$variable_value_description,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;

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

      replacement_value.kind := clc$variable_data_value;
      replacement_value.data_value := value;

      clp$update_variable (^reference, replacement_value, work_area, local_status);
      work_area_ptr^ := work_area;

    END /change_variable/;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$change_variable;
?? TITLE := 'clp$create_environment_variable', EJECT ??
*copyc clh$create_environment_variable

  PROCEDURE [XDCL, #GATE] clp$create_environment_variable
    (    name: clt$variable_name_reference;
         scope: clt$environment_variable_scope;
         access_mode: clt$data_access_mode;
         evaluation_method: clt$expression_eval_method;
         type_specification: ^clt$type_specification;
         initial_value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      name_is_valid: boolean,
      validated_name: ost$name,
      value: ^clt$data_value,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;

  /create_environment_var/
    BEGIN

      clp$validate_name (name, validated_name, name_is_valid);
      IF NOT name_is_valid THEN
        osp$set_status_abnormal ('CL', cle$improper_variable_name, name, local_status);
        EXIT /create_environment_var/;
      IFEND;
      IF ((scope < LOWERVALUE (clt$environment_variable_scope)) OR
            (scope > UPPERVALUE (clt$environment_variable_scope))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_scope, name, local_status);
        EXIT /create_environment_var/;
      IFEND;
      IF ((access_mode < LOWERVALUE (clt$data_access_mode)) OR
            (access_mode > UPPERVALUE (clt$data_access_mode))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_access_mode, name, local_status);
        EXIT /create_environment_var/;
      IFEND;
      IF ((evaluation_method < LOWERVALUE (clt$expression_eval_method)) OR
            (evaluation_method > UPPERVALUE (clt$expression_eval_method))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_eval_method, name, local_status);
        EXIT /create_environment_var/;
      IFEND;
      IF type_specification = NIL THEN
        osp$set_status_abnormal ('CL', cle$no_type_spec_specified, name, local_status);
        EXIT /create_environment_var/;
      IFEND;

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

      IF (initial_value <> NIL) AND (initial_value^.kind = clc$deferred) AND
            (evaluation_method = clc$immediate_evaluation) THEN
        clp$evaluate_expression (initial_value^.deferred_value^, initial_value^.deferred_type, work_area_ptr^,
              value, local_status);
        IF NOT local_status.normal THEN
          IF local_status.condition <> cle$work_area_overflow THEN
            osp$set_status_abnormal ('CL', cle$nonevaluable_deferred_value, name, local_status);
          IFEND;
          EXIT /create_environment_var/;
        IFEND;
      ELSE
        value := initial_value;
      IFEND;

      clp$create_var_from_type_spec (validated_name, scope, access_mode, evaluation_method,
            type_specification, value, FALSE, work_area_ptr^, local_status);

      work_area_ptr^ := work_area;

    END /create_environment_var/;
    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$create_environment_variable;
?? TITLE := 'clp$create_procedure_variable', EJECT ??
*copyc clh$create_procedure_variable

  PROCEDURE [XDCL, #GATE] clp$create_procedure_variable
    (    name: clt$variable_name_reference;
         scope: clt$procedure_variable_scope;
         access_mode: clt$data_access_mode;
         evaluation_method: clt$expression_eval_method;
         type_specification: ^clt$type_specification;
         initial_value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      name_is_valid: boolean,
      validated_name: ost$name,
      value: ^clt$data_value,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;

  /create_procedure_var/
    BEGIN

      clp$validate_name (name, validated_name, name_is_valid);
      IF NOT name_is_valid THEN
        osp$set_status_abnormal ('CL', cle$improper_variable_name, name, local_status);
        EXIT /create_procedure_var/;
      IFEND;
      IF ((scope < LOWERVALUE (clt$procedure_variable_scope)) OR
            (scope > UPPERVALUE (clt$procedure_variable_scope))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_scope, name, local_status);
        EXIT /create_procedure_var/;
      IFEND;
      IF ((access_mode < LOWERVALUE (clt$data_access_mode)) OR
            (access_mode > UPPERVALUE (clt$data_access_mode))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_access_mode, name, local_status);
        EXIT /create_procedure_var/;
      IFEND;
      IF ((evaluation_method < LOWERVALUE (clt$expression_eval_method)) OR
            (evaluation_method > UPPERVALUE (clt$expression_eval_method))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_eval_method, name, local_status);
        EXIT /create_procedure_var/;
      IFEND;
      IF type_specification = NIL THEN
        osp$set_status_abnormal ('CL', cle$no_type_spec_specified, name, local_status);
        EXIT /create_procedure_var/;
      IFEND;
      IF (scope = clc$xref_scope) AND (initial_value <> NIL) THEN
        osp$set_status_abnormal ('CL', cle$xref_var_cannot_have_value, name, local_status);
        EXIT /create_procedure_var/;
      IFEND;

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

      IF (initial_value <> NIL) AND (initial_value^.kind = clc$deferred) AND
            (evaluation_method = clc$immediate_evaluation) THEN
        clp$evaluate_expression (initial_value^.deferred_value^, initial_value^.deferred_type, work_area_ptr^,
              value, local_status);
        IF NOT local_status.normal THEN
          IF local_status.condition <> cle$work_area_overflow THEN
            osp$set_status_abnormal ('CL', cle$nonevaluable_deferred_value, name, local_status);
          IFEND;
          EXIT /create_procedure_var/;
        IFEND;
      ELSE
        value := initial_value;
      IFEND;

      clp$create_var_from_type_spec (validated_name, scope, access_mode, evaluation_method,
            type_specification, value, FALSE, work_area_ptr^, local_status);

      work_area_ptr^ := work_area;

    END /create_procedure_var/;
    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$create_procedure_variable;
?? TITLE := 'clp$create_variable', EJECT ??
*copyc clh$create_variable

  PROCEDURE [XDCL, #GATE] clp$create_variable
    (    name: string ( * );
         kind: clt$variable_kinds;
         max_string_size: ost$string_size;
         lower_bound: clt$variable_dimension;
         upper_bound: clt$variable_dimension;
         scope: clt$variable_scope;
     VAR variable: clt$variable_reference;
     VAR status: ost$status);

    VAR
      create_array: boolean,
      local_max_string_size: clt$string_size,
      local_status: ost$status,
      name_is_valid: boolean,
      validated_name: ost$name,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;
    local_status.normal := TRUE;

  /create_variable/
    BEGIN

      clp$validate_name (name, validated_name, name_is_valid);
      IF NOT name_is_valid THEN
        osp$set_status_abnormal ('CL', cle$improper_variable_name, name, local_status);
        EXIT /create_variable/;
      IFEND;
      IF ((kind < LOWERVALUE (clt$variable_kinds)) OR (kind > UPPERVALUE (clt$variable_kinds))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_kind, name, local_status);
        EXIT /create_variable/;
      IFEND;
      IF ((scope.kind < LOWERVALUE (clt$variable_scope_kind)) OR
            (scope.kind > UPPERVALUE (clt$variable_scope_kind))) THEN
        osp$set_status_abnormal ('CL', cle$bad_variable_scope, name, local_status);
        EXIT /create_variable/;
      IFEND;
      local_max_string_size := max_string_size;
      IF (kind = clc$string_value) THEN
        IF ((max_string_size < 0) OR (max_string_size > osc$max_string_size)) THEN
          osp$set_status_abnormal ('CL', cle$bad_variable_string_size, name, local_status);
          EXIT /create_variable/;
        IFEND;
        IF max_string_size = osc$max_string_size THEN
          local_max_string_size := clc$max_string_size;
        IFEND;
      IFEND;
      IF (((lower_bound < clc$min_variable_dimension) OR (lower_bound > clc$max_variable_dimension)) OR
            ((upper_bound < clc$min_variable_dimension) OR (upper_bound > clc$max_variable_dimension)) OR
            ((lower_bound > upper_bound))) THEN
        osp$set_status_abnormal ('CL', cle$improper_array_bounds, name, local_status);
        EXIT /create_variable/;
      IFEND;

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

      create_array := (lower_bound <> upper_bound) OR ((lower_bound <> 0) AND (lower_bound <> 1));
      clp$create_var_from_conversion (validated_name, kind, local_max_string_size, create_array, lower_bound,
            upper_bound, scope, NIL, TRUE, work_area_ptr^, variable, local_status);

      work_area_ptr^ := work_area;

    END /create_variable/;
    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$create_variable;
*IFEND
?? TITLE := 'clp$evaluate_name_for_read', EJECT ??

  PROCEDURE [XDCL] clp$evaluate_name_for_read
    (    name: clt$variable_name;
         context_type_description: ^clt$type_description;
         access_variable_requests: clt$access_variable_requests;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR variable_name: clt$variable_name;
     VAR variable_information: clt$variable_information;
     VAR value: ^clt$data_value;
     VAR found: boolean;
     VAR last_qualifier_is_field: boolean;
     VAR status: ost$status);

    VAR
      access_handle: clt$variable_access_handle,
      access_handle_ptr: ^clt$variable_access_handle,
      block: ^clt$block,
      deferred_value: ^clt$expression_text,
      function_qualifiers_present: boolean,
      i_value: ^clt$i_data_value,
      internal_value: ^clt$internal_data_value,
      kind: clt$value_qualifier_kind,
      local_variable_requests: clt$access_variable_requests,
      parse_value_qualifiers: ^clt$value_qualifiers,
      parse_value_qualifier_index: integer,
      result: clt$function_result,
      temporary_sequence: ^SEQ ( * ),
      variable_requests: clt$access_variable_requests;

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

    PROCEDURE process_name;

      VAR
        hash: clt$variable_name_hash,
        hashed_name: clt$variable_name;


      clp$compute_variable_name_hash (name, hashed_name, hash);
      local_variable_requests := access_variable_requests +
            $clt$access_variable_requests [clc$value_info_if_defer_value] -
            $clt$access_variable_requests [clc$return_value_qualifiers];
      clp$access_variable (name, hashed_name, hash, TRUE, local_variable_requests, work_area,
            variable_information, access_handle, status);
      IF NOT (status.normal AND variable_information.access_info_found) THEN
        EXIT clp$evaluate_name_for_read;
      IFEND;
      access_handle_ptr := ^access_handle;

      found := TRUE;

      IF NOT variable_information.parameter_passed THEN
        clp$make_unspecified_value (work_area, value);
        IF value = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$evaluate_name_for_read;
        IFEND;
        RETURN;
      IFEND;

      IF variable_information.has_no_internal_value THEN
        IF (variable_information.value_qualifiers_present OR
              (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot])) AND
              (NOT (clc$possible_file_reference IN variable_requests)) THEN
          osp$set_status_abnormal ('CL', cle$cannot_read_component, name, status);
          EXIT clp$evaluate_name_for_read;
        IFEND;
        access_handle_ptr := NIL;
        RETURN;
      IFEND;

      IF variable_information.internal_value <> NIL THEN
        clp$add_to_defer_list (name, status);
        IF NOT status.normal THEN
          EXIT clp$evaluate_name_for_read;
        IFEND;
        internal_value := variable_information.internal_value;
        i_value := #PTR (internal_value^.header.value, internal_value^);
        deferred_value := #PTR (i_value^.deferred_value, internal_value^);

{
{ Clp$evaluate_expression will return an error if the result value is NIL or unspecified.
{

        clp$evaluate_expression (deferred_value^, variable_information.type_specification, work_area, value,
              status);
        clp$delete_from_defer_list;
        IF NOT status.normal THEN
          IF (status.condition <> cle$work_area_overflow) AND
                (status.condition <> cle$recursive_deferred_variable) THEN
            osp$set_status_abnormal ('CL', cle$nonevaluable_deferred_value, name, status);
          IFEND;
          EXIT clp$evaluate_name_for_read;
        IFEND;
        variable_information.internal_value := NIL;
      IFEND;

    PROCEND process_name;
?? TITLE := 'process_parameter_name', EJECT ??

    PROCEDURE process_parameter_name;


      variable_requests := access_variable_requests + $clt$access_variable_requests
            [clc$convert_nil_value_to_unspec];

      variable_name := result.parameter_name;
      local_variable_requests := access_variable_requests +
            $clt$access_variable_requests [clc$value_info_if_defer_value] -
            $clt$access_variable_requests [clc$return_value_qualifiers];
      clp$access_param_variable (variable_name, local_variable_requests, work_area, variable_information,
            access_handle, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_read;
      IFEND;
      IF variable_information.access_info_found THEN
        access_handle_ptr := ^access_handle;
      ELSE
        initialize_variable_information (variable_information);
      IFEND;

      IF NOT (variable_information.access_info_found AND variable_information.parameter_passed) OR
            variable_information.has_no_internal_value THEN
        clp$make_unspecified_value (work_area, value);
        IF value = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$evaluate_name_for_read;
        IFEND;
        RETURN;
      IFEND;

      IF variable_information.internal_value <> NIL THEN
        internal_value := variable_information.internal_value;
        i_value := #PTR (internal_value^.header.value, internal_value^);
        deferred_value := #PTR (i_value^.deferred_value, internal_value^);

{
{ Clp$evaluate_expression will return an error if the result value is NIL or unspecified.
{

        clp$evaluate_expression (deferred_value^, variable_information.type_specification, work_area, value,
              status);
        IF NOT status.normal THEN
          IF status.condition <> cle$work_area_overflow THEN
            osp$set_status_abnormal ('CL', cle$nonevaluable_deferred_value, name, status);
          IFEND;
          EXIT clp$evaluate_name_for_read;
        IFEND;
        variable_information.internal_value := NIL;
      IFEND;

    PROCEND process_parameter_name;
?? TITLE := 'process_variable_reference', EJECT ??

    PROCEDURE process_variable_reference;

      VAR
        lexical_units: ^clt$lexical_units,
        nested_parse: clt$parse_state;


      clp$identify_lexical_units (result.variable, work_area, lexical_units, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_read;
      IFEND;
      clp$initialize_parse_state (result.variable, lexical_units, nested_parse);
      clp$scan_non_space_lexical_unit (nested_parse);
      CASE nested_parse.unit.kind OF
      = clc$lex_name =
        ;
      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, nested_parse.
              text^ (nested_parse.unit_index, nested_parse.unit.size), status);
        EXIT clp$evaluate_name_for_read;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_variable_name, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, nested_parse, status);
        EXIT clp$evaluate_name_for_read;
      CASEND;

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

      local_variable_requests := variable_requests - $clt$access_variable_requests
            [clc$possible_file_reference];
      clp$evaluate_name_for_read (variable_name, context_type_description, local_variable_requests,
            nested_parse, work_area, variable_name, variable_information, value, found,
            last_qualifier_is_field, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_read;
      IFEND;
      IF NOT found THEN
        osp$set_status_abnormal ('CL', cle$unknown_variable, variable_name, status);
        EXIT clp$evaluate_name_for_read;
      IFEND;
      function_qualifiers_present := variable_information.value_qualifiers_present;

      IF nested_parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (nested_parse);
      IFEND;
      IF nested_parse.unit.kind <> clc$lex_end_of_line THEN
        osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, variable_name, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, nested_parse, status);
        EXIT clp$evaluate_name_for_read;
      IFEND;

      IF value = NIL THEN
        IF (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot]) THEN
          osp$set_status_abnormal ('CL', cle$cannot_read_component, name, status);
        IFEND;
        EXIT clp$evaluate_name_for_read;
      IFEND;

    PROCEND process_variable_reference;
*IFEND
?? TITLE := 'process_value', EJECT ??

    PROCEDURE process_value;


      value := result.value;
      initialize_variable_information (variable_information);

      IF value = NIL THEN
        IF (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot]) 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
        IFEND;
        RETURN;
      IFEND;

    PROCEND process_value;
?? OLDTITLE, EJECT ??

{
{ The type description may not be found and therefore not returned even
{ though it was requested by the caller of this routine.
{ It is known that return_value_qualifiers is only set to TRUE when this
{ routine is called by clp$read_variable.
{


    status.normal := TRUE;
    variable_information.access_info_found := FALSE;
    found := FALSE;
    variable_name := name;
    value := NIL;
    internal_value := NIL;
    function_qualifiers_present := FALSE;
    parse_value_qualifiers := NIL;
    parse_value_qualifier_index := 0;
    access_handle_ptr := NIL;
    last_qualifier_is_field := FALSE;

    clp$find_current_block (block);
*IF NOT $true(osv$unix)
    IF (block^.kind = clc$sub_parameters_block) AND (NOT block^.lookup_functions_and_variables) THEN
      RETURN;
    IFEND;
*IFEND

    IF ($clt$access_variable_requests [clc$return_internal_value, clc$value_info_if_defer_value,
          clc$return_type_specification, clc$type_spec_if_defer_method,
          clc$convert_nil_value_to_unspec] * access_variable_requests) <> $clt$access_variable_requests
          [] THEN
*IF NOT $true(osv$unix)
      osp$set_status_abnormal ('CL', cle$improper_variable_requests, name, status);
*ELSE
      osp$set_status_abnormal ('CL', cle$not_supported, 'Variables are', status);
*IFEND
      RETURN;
    IFEND;

    variable_requests := access_variable_requests;

    IF name (1) = '$' THEN
      clp$evaluate_function (FALSE, name, context_type_description, parse, work_area, result, found, status);
      IF NOT (status.normal AND found) THEN
        IF found THEN
          initialize_variable_information (variable_information);
        IFEND;
        RETURN;
      IFEND;

      CASE result.kind OF

      = clc$fr_value =
        process_value;

*IF NOT $true(osv$unix)
      = clc$fr_parameter_name =

{ Result from $PARAMETER_VALUE function.

        process_parameter_name;

      = clc$fr_variable_reference =

{ Result from $VNAME function.

        process_variable_reference;
*IFEND

      ELSE

{ Should never get here.

        osp$set_status_abnormal ('CL', cle$bad_function_result, name, status);
        RETURN;
      CASEND;

*IF NOT $true(osv$unix)
    ELSE
      process_name;
*IFEND

    IFEND;

    IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot] THEN
      clp$get_read_value_qualifiers (name, parse, work_area, parse_value_qualifiers, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_read;
      IFEND;
    IFEND;

{
{ The value has already been obtained at this point in the following instances
{    (we would not make the call to clp$obtain_variable_value):
{    1. It is a function result other than $PARAMETER_VALUE and there are no qualifiers.
{    2. It is an unitialized value and there are no qualifiers.
{

    IF (access_handle_ptr <> NIL) OR (parse_value_qualifiers <> NIL) THEN

      IF variable_information.type_description = NIL THEN
        variable_requests := variable_requests - $clt$access_variable_requests [clc$return_type_description];
      IFEND;

{ Access_handler_ptr is NIL for all function results except $parameter_value(known parameter).
{ Otherwise access_handler_ptr is always NOT NIL.
{
{ Value is NOT NIL for function results other than $parameter_value(known parameter) or a
{ deferred value or a newly created 'unspecified' value.  Otherwise value is always NIL.
{

      clp$obtain_variable_value (variable_name, access_handle_ptr, variable_requests, work_area,
            variable_information.type_description, parse_value_qualifiers, parse_value_qualifier_index, value,
            status);
    IFEND;

    variable_information.value_qualifiers_present := (parse_value_qualifiers <> NIL) AND
          (parse_value_qualifier_index <> 1) OR function_qualifiers_present;

    IF parse_value_qualifiers <> NIL THEN
      kind := parse_value_qualifiers^ [UPPERBOUND (parse_value_qualifiers^)].kind;
      last_qualifier_is_field := (kind = clc$field_qualifier) OR (kind = clc$unspecified_field_qualifier) OR
            (kind = clc$invalid_field_qualifier);
    IFEND;

    IF parse_value_qualifier_index <> 0 THEN
      parse := parse_value_qualifiers^ [parse_value_qualifier_index].parse^;
    IFEND;

    IF (clc$return_value_qualifiers IN access_variable_requests) AND (parse_value_qualifier_index > 1) THEN
      temporary_sequence := #SEQ (parse_value_qualifiers);
      RESET temporary_sequence;
      NEXT variable_information.value_qualifiers: [1 .. parse_value_qualifier_index - 1] IN
            temporary_sequence;
    ELSE
      variable_information.value_qualifiers := NIL;
    IFEND;

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

  PROCEDURE [XDCL] clp$evaluate_name_for_write
    (    name: clt$variable_name;
         access_variable_requests: clt$access_variable_requests;
         evaluating_for_var_parameter: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR variable_name: clt$variable_name;
     VAR variable_information: clt$variable_information;
     VAR access_handle: clt$variable_access_handle;
     VAR complete_type_description: ^clt$type_description;
     VAR found: boolean;
     VAR status: ost$status);

    VAR
      all_value_qualifiers: ^clt$value_qualifiers,
      function_or_parameter_qual: ^clt$value_qualifiers,
      function_or_parameter_qual_size: integer,
      i: integer,
      result: clt$function_result,
      value_qualifiers_size: integer,
      variable_requests: clt$access_variable_requests;

?? NEWTITLE := 'process_name', EJECT ??

    PROCEDURE process_name;

      VAR
        hash: clt$variable_name_hash,
        hashed_name: clt$variable_name;


      clp$compute_variable_name_hash (name, hashed_name, hash);
      variable_requests := access_variable_requests + $clt$access_variable_requests
            [clc$return_type_description, clc$return_value_qualifiers];
      clp$access_variable (name, hashed_name, hash, TRUE, variable_requests, work_area, variable_information,
            access_handle, status);
      IF NOT (status.normal AND variable_information.access_info_found) THEN
        EXIT clp$evaluate_name_for_write;
      ELSEIF NOT variable_information.parameter_passed THEN
        IF NOT evaluating_for_var_parameter THEN
          IF variable_information.access_mode = clc$read_write THEN
            osp$set_status_abnormal ('CL', cle$cannot_write_omitted_param, name, status);
          IFEND;
          EXIT clp$evaluate_name_for_write;
        IFEND;
      IFEND;

      found := TRUE;

      complete_type_description := variable_information.type_description;

      IF variable_information.value_qualifiers_present THEN
        function_or_parameter_qual := variable_information.value_qualifiers;
        clp$get_qualified_type_desc (function_or_parameter_qual, variable_information.type_description);
      IFEND;

    PROCEND process_name;
?? TITLE := 'process_parameter_name', EJECT ??

    PROCEDURE process_parameter_name;


      variable_name := result.parameter_name;
      variable_requests := access_variable_requests + $clt$access_variable_requests
            [clc$return_type_description, clc$return_value_qualifiers];
      clp$access_param_variable (variable_name, variable_requests, work_area, variable_information,
            access_handle, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_write;
      ELSEIF NOT variable_information.access_info_found THEN
        osp$set_status_abnormal ('CL', cle$unknown_parameter_name, variable_name, status);
        EXIT clp$evaluate_name_for_write;
      ELSEIF (NOT variable_information.parameter_passed) AND (NOT evaluating_for_var_parameter) AND
            (variable_information.access_mode = clc$read_write) THEN
        osp$set_status_abnormal ('CL', cle$cannot_write_omitted_param, variable_name, status);
        EXIT clp$evaluate_name_for_write;
      IFEND;

      complete_type_description := variable_information.type_description;

      IF variable_information.value_qualifiers_present THEN
        function_or_parameter_qual := variable_information.value_qualifiers;
        clp$get_qualified_type_desc (function_or_parameter_qual, variable_information.type_description);
      IFEND;

    PROCEND process_parameter_name;
?? TITLE := 'process_variable_reference', EJECT ??

    PROCEDURE process_variable_reference;

      VAR
        lexical_units: ^clt$lexical_units,
        nested_parse: clt$parse_state;


      clp$identify_lexical_units (result.variable, work_area, lexical_units, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_write;
      IFEND;
      clp$initialize_parse_state (result.variable, lexical_units, nested_parse);
      clp$scan_non_space_lexical_unit (nested_parse);
      CASE nested_parse.unit.kind OF
      = clc$lex_name =
        ;
      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, nested_parse.
              text^ (nested_parse.unit_index, nested_parse.unit.size), status);
        EXIT clp$evaluate_name_for_write;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_variable_name, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, nested_parse, status);
        EXIT clp$evaluate_name_for_write;
      CASEND;

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

      clp$evaluate_name_for_write (variable_name, access_variable_requests, evaluating_for_var_parameter,
            nested_parse, work_area, variable_name, variable_information, access_handle,
            complete_type_description, found, status);
      IF NOT status.normal THEN
        EXIT clp$evaluate_name_for_write;
      IFEND;
      IF NOT found THEN
        osp$set_status_abnormal ('CL', cle$unknown_variable, variable_name, status);
        EXIT clp$evaluate_name_for_write;
      IFEND;
      IF nested_parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (nested_parse);
      IFEND;
      IF nested_parse.unit.kind <> clc$lex_end_of_line THEN
        osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, variable_name, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, nested_parse, status);
        EXIT clp$evaluate_name_for_write;
      IFEND;

      function_or_parameter_qual := variable_information.value_qualifiers;

    PROCEND process_variable_reference;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    found := FALSE;
    variable_name := name;
    complete_type_description := NIL;

    function_or_parameter_qual := NIL;

    IF ($clt$access_variable_requests [clc$return_internal_value, clc$value_info_if_defer_value,
          clc$return_type_specification, clc$possible_file_reference,
          clc$convert_nil_value_to_unspec] * access_variable_requests) <> $clt$access_variable_requests
          [] THEN
      ;
      osp$set_status_abnormal ('CL', cle$improper_variable_requests, name, status);
      RETURN;
    IFEND;

    IF name (1) = '$' THEN
      clp$evaluate_function (TRUE, name, NIL, parse, work_area, result, found, status);
      IF NOT (status.normal AND found) THEN
        IF found THEN
          initialize_variable_information (variable_information);
        IFEND;
        RETURN;
      IFEND;

      CASE result.kind OF

      = clc$fr_value =

{ Should never get here.

        initialize_variable_information (variable_information);
        osp$set_status_abnormal ('CL', cle$bad_function_result, name, status);
        RETURN;

      = clc$fr_parameter_name =

{ Result from $PARAMETER_VALUE or $VALUE function.

        process_parameter_name;

      = clc$fr_variable_reference =

{Result from $VNAME function.

        process_variable_reference;
      ELSE

{ Should never get here.

        osp$set_status_abnormal ('CL', cle$bad_function_result, name, status);
        RETURN;
      CASEND;
    ELSE
      process_name;
    IFEND;

    IF variable_information.access_mode <> clc$read_write THEN
      osp$set_status_abnormal ('CL', cle$cannot_assign_to_a_read_var, variable_name, status);
      RETURN;
    IFEND;

    IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot] THEN
      IF evaluating_for_var_parameter AND (NOT variable_information.parameter_passed) THEN
        osp$set_status_abnormal ('CL', cle$unexpected_qual_for_unspec, variable_name, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN;
      IFEND;
      clp$get_write_value_qualifiers (name, variable_information.type_description, parse, work_area,
            variable_information.value_qualifiers, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF variable_information.value_qualifiers <> NIL THEN
        variable_information.value_qualifiers_present := TRUE;
        IF variable_information.evaluation_method = clc$deferred_evaluation THEN
          osp$set_status_abnormal ('CL', cle$improper_use_of_defer_var, variable_name, status);
          RETURN;
        IFEND;

        IF function_or_parameter_qual <> NIL THEN
          function_or_parameter_qual_size := UPPERBOUND (function_or_parameter_qual^);
          value_qualifiers_size := UPPERBOUND (variable_information.value_qualifiers^);
          NEXT all_value_qualifiers: [1 .. function_or_parameter_qual_size + value_qualifiers_size] IN
                work_area;
          IF all_value_qualifiers = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            RETURN;
          IFEND;
          FOR i := 1 TO function_or_parameter_qual_size DO
            all_value_qualifiers^ [i] := function_or_parameter_qual^ [i];
          FOREND;
          FOR i := 1 TO value_qualifiers_size DO
            all_value_qualifiers^ [function_or_parameter_qual_size + i] :=
                  variable_information.value_qualifiers^ [i];
          FOREND;
          variable_information.value_qualifiers := all_value_qualifiers;
        IFEND;

      IFEND;
    IFEND;

  PROCEND clp$evaluate_name_for_write;
?? TITLE := 'clp$get_variable', EJECT ??
*copyc clh$get_variable

  PROCEDURE [XDCL, #GATE] clp$get_variable
    (    reference: clt$variable_ref_expression;
     VAR work_area {input, output} : ^clt$work_area;
     VAR class: clt$variable_class;
     VAR access_mode: clt$data_access_mode;
     VAR evaluation_method: clt$expression_eval_method;
     VAR type_specification: ^clt$type_specification;
     VAR value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      access_variable_requests: clt$access_variable_requests,
      local_status: ost$status,
      local_work_area: ^^clt$work_area,
      local_value: ^clt$data_value,
      name: clt$variable_name,
      original_local_work_area: ^clt$work_area,
      variable_information: clt$variable_information;

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

  /get_variable/
    BEGIN
      IF work_area = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', local_status);
        EXIT /get_variable/;
      IFEND;

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


      access_variable_requests := $clt$access_variable_requests [clc$return_type_description];
      get_variable_value (^reference, access_variable_requests, local_work_area^, name, variable_information,
            local_value, local_status);
      IF NOT local_status.normal THEN
        EXIT /get_variable/;
      IFEND;

      IF variable_information.type_description = NIL THEN
        osp$set_status_abnormal ('CL', cle$cannot_read_omitted_param, name, local_status);
        EXIT /get_variable/;
      IFEND;

      clp$convert_type_desc_to_spec (variable_information.type_description, work_area, type_specification,
            local_status);
      IF NOT local_status.normal THEN
        EXIT /get_variable/;
      IFEND;

      IF local_value <> NIL THEN
*IF NOT $true(osv$unix)
        IF #SEGMENT (work_area) = #SEGMENT (local_work_area^) THEN
*ELSE
        IF #LOC (work_area^) = #LOC (local_work_area^^) THEN
*IFEND
          value := local_value;
        ELSE
          clp$copy_data_value (local_value, work_area, value, local_status);
          local_work_area^ := original_local_work_area;
          IF NOT local_status.normal THEN
            EXIT /get_variable/;
          IFEND;
        IFEND;
      IFEND;

      access_mode := variable_information.access_mode;
      evaluation_method := variable_information.evaluation_method;
      CASE variable_information.class OF
      = clc$env_variable, clc$pushed_variable =
        class := clc$environment_variable;
      = clc$proc_variable, clc$xdcled_variable, clc$xrefed_variable =
        class := clc$procedure_variable;
      = clc$lib_variable =
        class := clc$library_variable;
      ELSE
        class := clc$parameter_variable;
      CASEND;

    END /get_variable/;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$get_variable;
?? TITLE := 'clp$get_variable_value', EJECT ??
*copyc clh$get_variable_value

  PROCEDURE [XDCL, #GATE] clp$get_variable_value
    (    reference: clt$variable_ref_expression;
     VAR value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      access_variable_requests: clt$access_variable_requests,
      ignore_variable_information: clt$variable_information,
      local_status: ost$status,
      name: clt$variable_name,
      work_area: ^^clt$work_area;


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

  /get_variable/
    BEGIN
*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^work_area), work_area, local_status);
*ELSE
      clp$get_work_area (osc$user_ring, work_area, local_status);
*IFEND
      IF NOT local_status.normal THEN
        EXIT /get_variable/;
      IFEND;

      access_variable_requests := $clt$access_variable_requests [];
      get_variable_value (^reference, access_variable_requests, work_area^, name, ignore_variable_information,
            value, local_status);
    END /get_variable/;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$get_variable_value;
*IFEND
?? TITLE := 'clp$produce_variable_ref_expr', EJECT ??

  PROCEDURE [XDCL] clp$produce_variable_ref_expr
    (    class: clt$internal_variable_class;
         name: clt$variable_name;
         value_qualifiers: ^clt$value_qualifiers;
     VAR work_area {input, output} : ^clt$work_area;
     VAR variable: ^clt$variable_ref_expression;
     VAR status: ost$status);

    CONST
      parameter_prefix = '$PARAMETER_VALUE(',
      parameter_prefix_size = 17 {STRLENGTH (parameter_prefix)} ,
      substring_all = 'ALL',
      substring_all_size = 3 {STRLENGTH (substring_all)} ;

    VAR
      field_size: integer,
      i: integer,
      name_size: ost$name_size,
      process_subscript: boolean,
      str: ^ost$string,
      subscript: clt$array_bound,
      variable_size: clt$expression_text_size;


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

    name_size := clp$trimmed_string_size (name);
    IF class = clc$param_variable THEN
      variable_size := parameter_prefix_size + name_size + 1;
    ELSE
      variable_size := name_size;
    IFEND;
    NEXT variable: [variable_size] IN work_area;
    IF variable = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      RETURN;
    IFEND;
    IF class = clc$param_variable THEN
      variable^ (1, parameter_prefix_size) := parameter_prefix;
      variable^ (parameter_prefix_size + 1, name_size) := name (1, name_size);
      variable^ (parameter_prefix_size + name_size + 1) := ')';
    ELSE
      variable^ (1, name_size) := name (1, name_size);
    IFEND;

*IF NOT $true(osv$unix)
    IF value_qualifiers = NIL THEN
*IFEND
      RETURN;
*IF NOT $true(osv$unix)
    IFEND;

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

      process_subscript := FALSE;
      CASE value_qualifiers^ [i].kind OF

      = clc$array_subscript_qualifier =
        subscript := value_qualifiers^ [i].array_subscript;
        process_subscript := TRUE;

      = clc$field_qualifier, clc$unspecified_field_qualifier =
        field_size := clp$trimmed_string_size (value_qualifiers^ [i].field_name);
        RESET work_area TO variable;
        NEXT variable: [variable_size + 1 + field_size] IN work_area;
        IF variable = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          RETURN;
        IFEND;
        variable^ (variable_size + 1) := '.';
        variable^ (variable_size + 2, field_size) := value_qualifiers^ [i].field_name (1, field_size);
        variable_size := STRLENGTH (variable^);

      = clc$list_subscript_qualifier =
        subscript := value_qualifiers^ [i].list_subscript;
        process_subscript := TRUE;

      = clc$substring_qualifier, clc$unspecified_substring_qual =
        IF str = NIL THEN
          PUSH str;
        IFEND;
        clp$convert_integer_to_string (value_qualifiers^ [i].index, 10, FALSE, str^, status);
        RESET work_area TO variable;
        NEXT variable: [variable_size + 1 + str^.size + 2] IN work_area;
        IF variable = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          RETURN;
        IFEND;
        variable^ (variable_size + 1) := '(';
        variable^ (variable_size + 2, str^.size) := str^.value (1, str^.size);
        variable_size := STRLENGTH (variable^);
        variable^ (variable_size - 1, 2) := ', ';
        IF (value_qualifiers^ [i].kind = clc$unspecified_substring_qual) AND
              value_qualifiers^ [i].all_specified THEN
          str^.value (1, substring_all_size) := substring_all;
          str^.size := substring_all_size;
        ELSE
          clp$convert_integer_to_string (value_qualifiers^ [i].size, 10, FALSE, str^, status);
        IFEND;
        RESET work_area TO variable;
        NEXT variable: [variable_size + str^.size + 1] IN work_area;
        IF variable = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          RETURN;
        IFEND;
        variable^ (variable_size + 1, str^.size) := str^.value (1, str^.size);
        variable_size := STRLENGTH (variable^);
        variable^ (variable_size) := ')';

      = clc$unspecified_subscript_qual =
        subscript := value_qualifiers^ [i].unspecified_subscript;
        process_subscript := TRUE;

      ELSE
        osp$set_status_abnormal ('CL', cle$bad_value_qualifier, name, status);
        RETURN;
      CASEND;

      IF process_subscript THEN
        IF str = NIL THEN
          PUSH str;
        IFEND;
        clp$convert_integer_to_string (subscript, 10, FALSE, str^, status);
        RESET work_area TO variable;
        NEXT variable: [variable_size + 1 + str^.size + 1] IN work_area;
        IF variable = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          RETURN;
        IFEND;
        variable^ (variable_size + 1) := '(';
        variable^ (variable_size + 2, str^.size) := str^.value (1, str^.size);
        variable_size := STRLENGTH (variable^);
        variable^ (variable_size) := ')';
      IFEND;
    FOREND;
*IFEND

  PROCEND clp$produce_variable_ref_expr;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$read_variable', EJECT ??
*copyc clh$read_variable

  PROCEDURE [XDCL, #GATE] clp$read_variable
    (    reference: string ( * );
     VAR variable: clt$variable_reference;
     VAR status: ost$status);

    VAR
      access_variable_requests: clt$access_variable_requests,
      local_status: ost$status,
      max_string_size: clt$string_size,
      name: clt$variable_name,
      value: ^clt$data_value,
      variable_information: clt$variable_information,
      variable_reference: ^clt$variable_ref_expression,
      work_area: ^^clt$work_area;


    status.normal := TRUE;

  /read_variable/
    BEGIN
*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^work_area), work_area, local_status);
*ELSE
      clp$get_work_area (osc$user_ring, work_area, local_status);
*IFEND
      IF NOT local_status.normal THEN
        EXIT /read_variable/;
      IFEND;

      access_variable_requests := $clt$access_variable_requests
            [clc$return_type_description, clc$return_value_qualifiers];
      get_variable_value (^reference, access_variable_requests, work_area^, name, variable_information, value,
            local_status);
      IF NOT local_status.normal THEN
        EXIT /read_variable/;
      IFEND;

      IF variable_information.type_description = NIL THEN
        osp$set_status_abnormal ('CL', cle$cannot_read_omitted_param, name, local_status);
        EXIT /read_variable/;
      IFEND;

      IF variable_information.type_description^.kind = clc$array_type THEN
        variable.lower_bound := variable_information.type_description^.bounds.lower;
        variable.upper_bound := variable_information.type_description^.bounds.upper;
        variable_information.type_description := variable_information.type_description^.
              array_element_type_description;
      ELSE
        variable.lower_bound := 1;
        variable.upper_bound := 1;
      IFEND;
      IF variable_information.type_description^.kind = clc$string_type THEN
        max_string_size := variable_information.type_description^.max_string_size;
      ELSE
        max_string_size := 1;
      IFEND;
      clp$convert_value_to_var_value (value, max_string_size, variable.value, local_status);
      IF NOT local_status.normal THEN
        EXIT /read_variable/;
      IFEND;

      clp$produce_variable_ref_expr (variable_information.class, name, variable_information.value_qualifiers,
            work_area^, variable_reference, local_status);
      IF NOT local_status.normal THEN
        EXIT /read_variable/;
      IFEND;
      variable.reference.size := #SIZE (variable_reference^);
      variable.reference.value := variable_reference^;

    END /read_variable/;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$read_variable;
?? TITLE := 'clp$update_variable', EJECT ??

  PROCEDURE [XDCL] clp$update_variable
    (    reference: ^clt$variable_ref_expression;
         new_value: clt$variable_value_description;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      access_handle: clt$variable_access_handle,
      access_variable_requests: clt$access_variable_requests,
      array_variable: boolean,
      data_value: ^clt$data_value,
      ignore_variable_name: clt$variable_name,
      lexical_units: ^clt$lexical_units,
      lower_bound: clt$array_bound,
      name: clt$variable_name,
      parse: clt$parse_state,
      complete_type_description: ^clt$type_description,
      upper_bound: clt$array_bound,
      variable_found: boolean,
      variable_information: clt$variable_information;

    status.normal := TRUE;

    clp$identify_lexical_units (reference, work_area, lexical_units, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$initialize_parse_state (reference, lexical_units, parse);
    clp$scan_non_space_lexical_unit (parse);
    IF parse.unit.kind <> clc$lex_name THEN
      osp$set_status_abnormal ('CL', cle$expecting_variable_name, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;
    #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
    clp$scan_any_lexical_unit (parse);

    access_variable_requests := $clt$access_variable_requests
          [clc$return_type_description, clc$return_value_qualifiers];
    clp$evaluate_name_for_write (name, access_variable_requests, FALSE, parse, work_area,
          ignore_variable_name, variable_information, access_handle, complete_type_description,
          variable_found, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF NOT variable_found THEN
      osp$set_status_abnormal ('CL', cle$unknown_variable, name, status);
      RETURN;
    IFEND;

    IF parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (parse);
    IFEND;
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;

    IF new_value.kind = clc$variable_value THEN
      IF variable_information.type_description = NIL THEN

{ Variable with ANY type.

        osp$set_status_abnormal ('CL', cle$bad_variable_kind, name, status);
        RETURN;
      IFEND;
      IF variable_information.type_description^.kind = clc$array_type THEN
        lower_bound := variable_information.type_description^.bounds.lower;
        upper_bound := variable_information.type_description^.bounds.upper;
        array_variable := TRUE;
      ELSE
        lower_bound := 1;
        upper_bound := 1;
        array_variable := FALSE;
      IFEND;
      clp$convert_var_value_to_value (new_value.value, array_variable, lower_bound, upper_bound, work_area,
            data_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      data_value := new_value.data_value;
    IFEND;

    IF data_value = NIL THEN
      osp$set_status_abnormal ('CL', cle$must_specify_new_data_value, name, status);
      RETURN;
    IFEND;

    IF data_value^.kind = clc$deferred THEN
      IF variable_information.value_qualifiers_present THEN
        osp$set_status_abnormal ('CL', cle$improper_use_of_defer_value, name, status);
        RETURN;
      IFEND;
      IF variable_information.evaluation_method = clc$immediate_evaluation THEN
        clp$evaluate_expression (data_value^.deferred_value^, data_value^.deferred_type, work_area,
              data_value, status);
        IF NOT status.normal THEN
          IF status.condition <> cle$work_area_overflow THEN
            osp$set_status_abnormal ('CL', cle$nonevaluable_deferred_value, name, status);
          IFEND;
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    clp$change_variable_value (name, data_value, variable_information.value_qualifiers,
          complete_type_description, variable_information.type_description, access_handle, FALSE, work_area,
          status);

  PROCEND clp$update_variable;
?? TITLE := 'clp$write_variable', EJECT ??
*copyc clh$write_variable

  PROCEDURE [XDCL, #GATE] clp$write_variable
    (    reference: string ( * );
         value: clt$variable_value;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      replacement_value: clt$variable_value_description,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;

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

      replacement_value.kind := clc$variable_value;
      replacement_value.value := value;

      clp$update_variable (^reference, replacement_value, work_area_ptr^, local_status);
      work_area_ptr^ := work_area;

    END /write_variable/;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$write_variable;
?? TITLE := 'create_default_or_file_variable', EJECT ??

  PROCEDURE create_default_or_file_variable
    (    name: clt$variable_name;
         scope: clt$keyword;
         type_specification: ^clt$type_specification;
         initial_value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      var_scope: clt$variable_declaration_scope,
      work_area: ^clt$work_area,
      work_area_ptr: ^^clt$work_area;


    status.normal := TRUE;

*IF NOT $true(osv$unix)
    clp$get_work_area (#RING (^work_area_ptr), work_area_ptr, status);
*ELSE
    clp$get_work_area (osc$user_ring, work_area_ptr, status);
*IFEND
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    work_area := work_area_ptr^;

    IF scope = 'ENVIRONMENT' THEN
      var_scope := clc$environment_scope;
    ELSEIF scope = 'JOB' THEN
      var_scope := clc$job_scope;
    ELSEIF scope = 'TASK' THEN
      var_scope := clc$task_scope;
    ELSE

{ Can only be UTILITY.

      var_scope := clc$utility_scope;
    IFEND;

    clp$create_var_from_type_spec (name, var_scope, clc$read_write, clc$immediate_evaluation,
          type_specification, initial_value, FALSE, work_area_ptr^, status);
    work_area_ptr^ := work_area;

  PROCEND create_default_or_file_variable;
?? TITLE := 'get_variable_value', EJECT ??

  PROCEDURE get_variable_value
    (    reference: ^clt$variable_ref_expression;
         access_variable_requests: clt$access_variable_requests;
     VAR work_area {input, output} : ^clt$work_area;
     VAR name: clt$variable_name;
     VAR variable_information: clt$variable_information;
     VAR value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      ignore_last_qualifier_is_field: boolean,
      lexical_units: ^clt$lexical_units,
      parse: clt$parse_state,
      variable_found: boolean,
      variable_name: clt$variable_name;


    status.normal := TRUE;

    value := NIL;

    clp$identify_lexical_units (reference, work_area, lexical_units, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$initialize_parse_state (reference, lexical_units, parse);
    clp$scan_non_space_lexical_unit (parse);
    IF parse.unit.kind <> clc$lex_name THEN
      osp$set_status_abnormal ('CL', cle$expecting_variable_name, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;
    #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
    clp$scan_any_lexical_unit (parse);

    clp$evaluate_name_for_read (name, NIL, access_variable_requests, parse, work_area, variable_name,
          variable_information, value, variable_found, ignore_last_qualifier_is_field, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF NOT variable_found THEN
      osp$set_status_abnormal ('CL', cle$unknown_variable, name, status);
      RETURN;
    IFEND;

    name := variable_name;

    IF parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (parse);
    IFEND;
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
    IFEND;

  PROCEND get_variable_value;
*IFEND
?? TITLE := 'initialize_variable_information', EJECT ??

  PROCEDURE [INLINE] initialize_variable_information
    (VAR variable_information: clt$variable_information);


    variable_information.access_info_found := FALSE;
    variable_information.parameter_passed := FALSE;
    variable_information.has_no_internal_value := TRUE;
    variable_information.internal_value := NIL;
    variable_information.type_specification := NIL;
    variable_information.type_description := NIL;
    variable_information.value_qualifiers_present := FALSE;
    variable_information.value_qualifiers := NIL;

  PROCEND initialize_variable_information;

MODEND clm$variable_access_manager;
