?? LEFT := 1, RIGHT := 110 ??
?? FMT (FORMAT := ON, keyw := upper, ident := lower) ??
MODULE dum$display_variable;
?? PUSH (LISTEXT := ON) ??
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$count_list_elements
*copyc clp$evaluate_expression
*copyc clp$evaluate_parameters
*copyc clp$evaluate_token
*copyc clp$get_variable
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clt$data_value
*copyc clt$string_value
*copyc clt$work_area
*copyc cyd$cybil_structure_definitions
*copyc due$symbolic_access_exceptions
*copyc dup$build_home_spec
*copyc dup$build_variable_spec
*copyc dup$close_display
*copyc dup$display_all_names
*copyc dup$display_string
*copyc dup$find_module_table_for_pva
*copyc dup$find_procedure_for_pva
*copyc dup$get_bytes
*copyc dup$locate_next_symbol
*copyc dup$locate_symbol_for_number
*copyc dup$locate_variable_symbol
*copyc dup$open_display
*copyc dup$simulate_variable
*copyc dut$display_type
*copyc dut$variable_search_options
*copyc dut$variable_specification
*copyc i#compare_collated
*copyc i#current_sequence_position
*copyc osp$append_status_integer
*copyc osp$format_message
*copyc osp$set_status_abnormal
*copyc ost$status
*copyc osv$lower_to_upper
*copyc pmp$continue_to_cause
*copyc pmp$convert_binary_unique_name
*copyc pmp$establish_condition_handler
?? POP ??
?? NEWTITLE := 'Global Definitions', EJECT ??
  CONST
    max_name_parameter_length = 4095,
    max_string_size = 65535,
    smallest_graphic = ' ',
    largest_graphic = '~',
    max_set_element = 32767,
    value_spacer = 2,
    record_indent = 2,
    first_character = 0,
    last_character = 255,
    true_value = 1,
    false_value = 0,
    bytes_per_word = 8,
    bits_per_byte = 8;

  TYPE
    string_list = array [1 .. *] of ^clt$string_value;

  TYPE
    iindex = 0 .. max_name_parameter_length + 1;

  TYPE
    ptr_pva_conversion = record
      case boolean of

      = true =
        cell_ptr: ^cell,

      = false =
        pva: ost$pva,
      casend,
    recend;

  TYPE
    value_record = record
      case boolean of
      = TRUE =
        bits: packed array [0 .. 63] of boolean,
      = FALSE =
        word_sized_value: integer,
      casend,
    recend,

    string_descriptor = record
      pva: ost$pva,
      length: 0..0FFFF(16)
    recend;

  VAR
    delay_change_of_type: SET OF llt$entry_kind := [llc$cybil_array_kind,
      llc$pascal_conf_array_kind ];

  VAR
    v$name_stack: SEQ (REP clc$max_string_size OF char),
    v$p_name_stack: ^SEQ (*) := ^v$name_stack;

  VAR
    v$work_area: SEQ (REP clc$max_string_size OF char);

  CONST
    reserved_stack_space = bytes_per_word * 2,
    right_justified_offset = 2;

  VAR
    simple_types: SET OF llt$entry_kind := [
          llc$integer_kind, llc$boolean_kind, llc$char_kind, llc$cell_kind ],
    scan_options: clt$token_evaluation_options := $clt$token_evaluation_options[
                                   clc$ignore_spaces_before_token,
                                   clc$classify_name_token,
                                   clc$international_char_is_token];

  VAR
    powers_of_two: [STATIC, READ] array [0 .. 62] of integer := [1, 2, 4, 8, 10(16), 20(16), 40(16), 80(16),
      100(16), 200(16), 400(16), 800(16), 1000(16), 2000(16), 4000(16), 8000(16), 10000(16), 20000(16),
      40000(16), 80000(16), 100000(16), 200000(16), 400000(16), 800000(16), 1000000(16), 2000000(16),
      4000000(16), 8000000(16), 10000000(16), 20000000(16), 40000000(16), 80000000(16), 100000000(16),
      200000000(16), 400000000(16), 800000000(16), 1000000000(16), 2000000000(16), 4000000000(16),
      8000000000(16), 10000000000(16), 20000000000(16), 40000000000(16), 80000000000(16), 100000000000(16),
      200000000000(16), 400000000000(16), 800000000000(16), 1000000000000(16), 2000000000000(16),
      4000000000000(16), 8000000000000(16), 10000000000000(16), 20000000000000(16), 40000000000000(16),
      80000000000000(16), 100000000000000(16), 200000000000000(16), 400000000000000(16), 800000000000000(16),
      1000000000000000(16), 2000000000000000(16), 4000000000000000(16)];

{ We allow pointer arithmetic on pointers and arrays.  Adding 1 to a C pointer
{  amounts to adding 1 unit of the thing being pointed to. (that is, for a ptr
{  to integer, we will add 8 for each 1 added.

  VAR
    ptr_mod_specified: boolean,
    ptr_modification: integer;
?? TITLE := 'dup$change_variable ', EJECT ??

  PROCEDURE [XDCL] dup$change_variable (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: Command processor for the CHANGE_VARIABLE command.

{ PROCEDURE change_program_variable, chapv (
{   name, n: (CHECK) list of application balance_brackets = $required
{   value, v: (CHECK) list of application = $required
{   module, m: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   procedure, p: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   recursion_level, rl: integer 1..7ffffff(16) = 1
{   recursion_direction, rd: key
{       (backward, b)
{       (forward, f)
{     keyend = backward
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
      recend,
      type3: 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$application_type_qualifier,
        recend,
      recend,
      type4: 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$application_type_qualifier,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (8),
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 11, 23, 21, 54, 51, 877],
    clc$command, 13, 7, 2, 0, 0, 0, 7, ''], [
    ['M                              ',clc$abbreviation_entry, 3],
    ['MODULE                         ',clc$nominal_entry, 3],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['P                              ',clc$abbreviation_entry, 4],
    ['PROCEDURE                      ',clc$nominal_entry, 4],
    ['RD                             ',clc$abbreviation_entry, 6],
    ['RECURSION_DIRECTION            ',clc$nominal_entry, 6],
    ['RECURSION_LEVEL                ',clc$nominal_entry, 5],
    ['RL                             ',clc$abbreviation_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['V                              ',clc$abbreviation_entry, 2],
    ['VALUE                          ',clc$nominal_entry, 2]],
    [
{ 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$extended_parameter_checking, 20,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [13, 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$extended_parameter_checking, 20,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$extended_parameter_checking, 27,
  clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [6, 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$extended_parameter_checking, 27,
  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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 6
    [8, 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, 155,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 7
    [11, 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$list_type], [4, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$application_type], [TRUE]]
    ],
{ PARAMETER 2
    [[1, 0, clc$list_type], [4, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$application_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$application_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, 7ffffff(16), 10],
    '1'],
{ PARAMETER 6
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BACKWARD                       ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FORWARD                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'backward'],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

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

    CONST
      p$name = 1,
      p$value = 2,
      p$module = 3,
      p$procedure = 4,
      p$recursion_level = 5,
      p$recursion_direction = 6,
      p$status = 7;

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

    VAR
      home_spec: dut$home_specification,
      input_modified: boolean,
      index: integer,
      length: iindex,
      module_name: pmt$program_name,
      p_name_list: ^string_list,
      p_value_list: ^string_list,
      procedure_name: pmt$program_name,
      temporary_value: [STATIC] string (max_name_parameter_length),
      temporary_index: 1 .. max_name_parameter_length + 1,
      value_count: integer,
      value_name: ^string ( * ),
      variable_name: ^string ( * );

    status.normal := TRUE;
    RESET v$p_name_stack;

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

    process_variable_name ('NAME', pvt [p$name].value, p_name_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_variable_name ('VALUE', pvt [p$value].value, p_value_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$process_module_parameter ('MODULE', pvt [p$module].value, module_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$process_module_parameter ('PROCEDURE', pvt [p$procedure].value, procedure_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$build_home_spec (module_name, procedure_name, pvt [p$recursion_level].value^,
          pvt [p$recursion_direction].value^, home_spec, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF home_spec.symbol_table_address = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_symbol_table_in_module, home_spec.module_item^.name,
            status);
      RETURN; {------->
    IFEND;

    IF (p_name_list = NIL) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$name_parameter_missing, osc$null_name, status);
      RETURN; {------->
    IFEND;

    variable_name := p_name_list^ [1];
    value_count := UPPERBOUND (p_value_list^) - LOWERBOUND (p_value_list^) + 1;
    value_name := p_value_list^ [1];

{This code tries to take into account the fact that FTN complex constants must be entered
{as a list of real values and reconstructed into a normal-looking constant while
{minimizing the possible side-effects on other languages. 1/84

    IF ((value_count <> 1) AND (home_spec.language <> llc$fortran)) OR ((value_count > 2) AND
     (home_spec.language = llc$fortran)) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$list_not_allowed, osc$null_name, status);
      return; {------->
    IFEND;

    IF value_count > 1 THEN
      temporary_value (1,1) := '(';
      temporary_index := 2;
      FOR index := 1 to value_count DO
        value_name := p_value_list^ [index];
        IF STRLENGTH (value_name^) <= (max_name_parameter_length - temporary_index) THEN
          temporary_value (temporary_index, STRLENGTH (value_name^)) := value_name^;
          temporary_index := temporary_index + STRLENGTH (value_name^);
          IF index > 1 THEN
            temporary_value (temporary_index,1) := ')';
          ELSE
            temporary_value (temporary_index, 1) := ',';
            temporary_index := temporary_index + 1;
          IFEND;
        ELSE
          osp$set_status_abnormal (duc$symbolic_id, due$value_parm_too_long, osc$null_name, status);
           return; {-------->
        IFEND;
      FOREND;
      value_name := ^temporary_value (1, temporary_index);
    IFEND;

    IF home_spec.symbol_table_address <> NIL THEN
      CASE home_spec.language OF
      = llc$basic =
        change_basic_variable (variable_name, home_spec,value_name,status);
      = llc$fortran =
        change_fortran_variable (variable_name, home_spec, value_name, status);
      = llc$cobol =
        osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Cobol', status);
      ELSE
        change_cybil_variable (variable_name, home_spec, value_name, status);
      CASEND;
    IFEND;
  PROCEND dup$change_variable;
?? TITLE := 'dup$display_language_variable', EJECT ??

  PROCEDURE [XDCL] dup$display_language_variable (
        variable_name: ^string ( * );
        home_spec: dut$home_specification;
        display_type: dut$display_type;
        p_variant_selection: ^clt$data_value;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

    VAR
      break_characters: [STATIC, READ] SET OF char := ['.', ']', '^', ')', ','],
      i: integer,
      name_index: 0 .. max_name_parameter_length,
      output_index: 0 .. max_name_parameter_length,
      output_length: 0 .. max_name_parameter_length,
      remaining_length: 0 .. max_name_parameter_length,
      type_specified: boolean,
      value_index: clt$string_index,
      variable_spec: dut$variable_specification,
      working_home_spec: dut$home_specification;

    working_home_spec := home_spec;
    value_index := 1;
    CASE home_spec.language OF
    = llc$basic =
      scan_basic_variable (variable_name, working_home_spec, value_index,
                   variable_spec, status);
    = llc$fortran =
      scan_fortran_variable (variable_name, working_home_spec, value_index,
                   variable_spec, status);
    = llc$cobol =
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Cobol', status);

    = llc$cybil, llc$obsolete_cybil,
      llc$pascal =
      scan_cybil_variable (variable_name, working_home_spec, value_index, variable_spec, status);
    = llc$the_c_language =
      scan_c_variable (variable_name, working_home_spec, value_index,
                   variable_spec, status);
    ELSE
      scan_universal_variable (variable_name, working_home_spec, variable_spec,
                   status);
    CASEND;
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
{ Format the variable name if one is given. Break it into several lines if it
{ is longer than the display width.

    IF variable_name <> NIL THEN
      name_index := 1;
      remaining_length := STRLENGTH (variable_name^);

      WHILE remaining_length > display_control_pointer^.page_width DO
        output_length := display_control_pointer^.page_width;

      /find_break_character/
        FOR output_index := output_length DOWNTO 10 DO {10 is an arbitrary
          {minimum}
          IF variable_name^ (name_index + output_index - 1) IN break_characters THEN
            output_length := output_index;
            EXIT /find_break_character/;
          IFEND;
        FOREND /find_break_character/;
        clp$put_display (display_control_pointer^, variable_name^ (name_index, output_length), clc$no_trim,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        remaining_length := remaining_length - output_length;
        name_index := name_index + output_length;
      WHILEND;

      clp$put_partial_display (display_control_pointer^, variable_name^ (name_index, remaining_length),
            clc$no_trim, amc$start, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_partial_display (display_control_pointer^, ' = ', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF (display_type = duc$hex_type) THEN
      display_variable_in_hex (variable_spec, display_control_pointer, status);
      RETURN;
    IFEND;

    CASE working_home_spec.language OF
    = llc$fortran =
      display_fortran_variable (working_home_spec, variable_spec, variable_name,
                     0, display_type, display_control_pointer, status);
    = llc$cobol =
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Cobol', status);
    ELSE
      format_and_display_variable (working_home_spec, variable_spec, variable_name,
            0, display_type, p_variant_selection, display_control_pointer, status);
    CASEND;

  PROCEND dup$display_language_variable;
?? TITLE := 'dup$display_variable ', EJECT ??

  PROCEDURE [XDCL] dup$display_variable (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PURPOSE: Command processor for the DISPLAY_VARIABLE command.

{ PROCEDURE display_program_variable, dispv (
{   name, n: (CHECK) any of
{       key
{         $all
{       keyend
{       list of application balance_brackets
{     anyend = $required
{   module, m: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   procedure, p: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   recursion_level, rl: integer 1..7ffffff(16) = 1
{   recursion_direction, rd: key
{       (backward, b)
{       (forward, f)
{     keyend = backward
{   type, t: key
{       (natural, n)
{       (hex, h)
{       (integer, i)
{       (real, r)
{     keyend = natural
{   variant_selection, vs: list of any of
{       boolean
{       name
{       integer
{       string
{     anyend = $optional
{   output, o: file = $OUTPUT
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 17] of clt$pdt_parameter_name,
      parameters: array [1 .. 9] 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,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        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,
            qualifier: clt$application_type_qualifier,
          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,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
      recend,
      type3: 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$application_type_qualifier,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (8),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 8] of clt$keyword_specification,
        default_value: string (7),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: 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$name_type_qualifier,
          recend,
          type_size_3: clt$type_specification_size,
          element_type_spec_3: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
          type_size_4: clt$type_specification_size,
          element_type_spec_4: record
            header: clt$type_specification_header,
            qualifier: clt$string_type_qualifier,
          recend,
        recend,
      recend,
      type8: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type9: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 6, 15, 32, 44, 983],
    clc$command, 17, 9, 1, 0, 0, 0, 9, ''], [
    ['M                              ',clc$abbreviation_entry, 2],
    ['MODULE                         ',clc$nominal_entry, 2],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 8],
    ['OUTPUT                         ',clc$nominal_entry, 8],
    ['P                              ',clc$abbreviation_entry, 3],
    ['PROCEDURE                      ',clc$nominal_entry, 3],
    ['RD                             ',clc$abbreviation_entry, 5],
    ['RECURSION_DIRECTION            ',clc$nominal_entry, 5],
    ['RECURSION_LEVEL                ',clc$nominal_entry, 4],
    ['RL                             ',clc$abbreviation_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 9],
    ['T                              ',clc$abbreviation_entry, 6],
    ['TYPE                           ',clc$nominal_entry, 6],
    ['VARIANT_SELECTION              ',clc$nominal_entry, 7],
    ['VS                             ',clc$abbreviation_entry, 7]],
    [
{ 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$extended_parameter_checking, 84, 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$extended_parameter_checking, 27, clc$optional_parameter,
  0, 0],
{ PARAMETER 3
    [8, 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$extended_parameter_checking, 27, clc$optional_parameter,
  0, 0],
{ PARAMETER 4
    [11, 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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [10, 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, 155,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 6
    [15, 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, 303,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 7
    [16, 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, 80, clc$optional_parameter,
  0, 0],
{ PARAMETER 8
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 9
    [13, 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$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['$ALL                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    20, [[1, 0, clc$list_type], [4, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$application_type], [TRUE]]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$application_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$application_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, 7ffffff(16), 10],
    '1'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BACKWARD                       ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FORWARD                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'backward'],
{ PARAMETER 6
    [[1, 0, clc$keyword_type], [8], [
    ['H                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['HEX                            ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['I                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['INTEGER                        ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['NATURAL                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['R                              ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['REAL                           ', clc$nominal_entry, clc$normal_usage_entry, 4]]
    ,
    'natural'],
{ PARAMETER 7
    [[1, 0, clc$list_type], [64, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$union_type], [[clc$boolean_type, clc$integer_type, clc$name_type,
      clc$string_type],
      TRUE, 4],
      3, [[1, 0, clc$boolean_type]],
      5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
      20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
      8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]
      ]
    ],
{ PARAMETER 8
    [[1, 0, clc$file_type],
    '$OUTPUT'],
{ PARAMETER 9
    [[1, 0, clc$status_type]]];

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

    CONST
      p$name = 1,
      p$module = 2,
      p$procedure = 3,
      p$recursion_level = 4,
      p$recursion_direction = 5,
      p$type = 6,
      p$variant_selection = 7,
      p$output = 8,
      p$status = 9;

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

    VAR
      display_control: clt$display_control,
      display_control_pointer: ^clt$display_control,
      display_type: dut$display_type,
      home_spec: dut$home_specification,
      index: integer,
      input_modified: boolean,
      length: iindex,
      local_status: ost$status,
      message_status: ost$status,
      module_name: pmt$program_name,
      p_name_list: ^string_list,
      p_variant_selection: ^clt$data_value,
      procedure_name: pmt$program_name,
      recursion_specified: boolean,
      status1: ost$status,
      variable_name: ^string ( * );

    input_modified := FALSE;
    status1.normal := TRUE;
    status.normal := TRUE;
    RESET v$p_name_stack;

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

    process_variable_name ('NAME', pvt [p$name].value, p_name_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$process_module_parameter ('MODULE', pvt [p$module].value, module_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$process_module_parameter ('PROCEDURE', pvt [p$procedure].value, procedure_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$build_home_spec (module_name, procedure_name, pvt [p$recursion_level].value^,
          pvt [p$recursion_direction].value^, home_spec, status);
    IF NOT status.normal THEN
      RETURN; {------->
    IFEND;

    display_type := duc$natural_type;

    IF (pvt [p$type].value <> NIL) THEN
      IF (pvt [p$type].value^.keyword_value = 'HEX') THEN
        display_type := duc$hex_type;
      ELSEIF (pvt [p$type].value^.keyword_value = 'INTEGER') THEN
        display_type := duc$integer_type;
      ELSEIF (pvt [p$type].value^.keyword_value = 'REAL') THEN
        display_type := duc$real_type;
      IFEND;
    IFEND;

    p_variant_selection := pvt [p$variant_selection].value;

    IF home_spec.symbol_table_address = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_symbol_table_in_module,
       home_spec.module_item^.name, status);
      RETURN; {----->
    IFEND;

    recursion_specified := pvt [p$recursion_level].specified OR pvt [p$recursion_direction].specified;

    { For BASIC, duc$natural_type and duc$hex_type are the only legal display types }

    IF (display_type <> duc$natural_type) AND (display_type <> duc$hex_type) THEN
      IF home_spec.language = llc$basic THEN
        osp$set_status_abnormal (duc$symbolic_id, due$type_equals_hex_only,
          'BASIC', status);
        RETURN;
      IFEND;
    IFEND;

    IF pvt [p$variant_selection].specified AND NOT
                             ((home_spec.language = llc$cybil) OR
                              (home_spec.language = llc$obsolete_cybil) OR
                              (home_spec.language = llc$pascal)) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_parameter,
                   'VARIANT_SELECTION', status);
      RETURN; {------->
    IFEND;

{Process NAME parameter.

    IF (p_name_list = NIL) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$name_parameter_missing, osc$null_name, status);
      RETURN; {----->
    ELSE

{IF name is specified, enter loop and process one by one.

      display_control_pointer := ^display_control;

      dup$open_display (pvt [p$output].value^.file_value^, display_control_pointer, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      /display_variable_loop/
      FOR index := LOWERBOUND (p_name_list^) TO UPPERBOUND (p_name_list^) DO
        variable_name := p_name_list^ [index];

        IF (STRLENGTH (variable_name^) = 4) AND (i#compare_collated (variable_name^(1,4),
         '$ALL', osv$lower_to_upper) = 0) THEN
            dup$display_all_names (home_spec, display_type, p_variant_selection,
                  display_control_pointer, status);
        ELSE
          IF (UPPERBOUND (p_name_list^) > LOWERBOUND (p_name_list^)) THEN {multiple names}
            dup$display_language_variable (variable_name, home_spec, display_type, p_variant_selection,
              display_control_pointer, local_status);
            IF NOT local_status.normal THEN
              clp$new_display_line (display_control_pointer^, 0, status);
              dup$output_message (local_status, display_control_pointer, status);
              IF NOT status.normal THEN
                EXIT /display_variable_loop/;
              IFEND;
              osp$set_status_abnormal (duc$symbolic_id, due$errors_in_list_of_names,
                osc$null_name, status1);
            IFEND;
          ELSE {single name}
            dup$display_language_variable (variable_name, home_spec, display_type, p_variant_selection,
              display_control_pointer, status);
          IFEND;
        IFEND;
      FOREND /display_variable_loop/;
    IFEND;

    IF status.normal AND NOT status1.normal THEN
      status := status1;
    IFEND;

    dup$close_display (display_control_pointer, FALSE, local_status);
  PROCEND dup$display_variable;
?? TITLE := 'dup$output_message', EJECT ??
*copy duh$output_message

  PROCEDURE [XDCL] dup$output_message (
        status_message: ost$status;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

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

    osp$format_message (status_message, osc$brief_message_level, display_control_pointer^.page_width,
          message, status);
    IF NOT status.normal THEN
      RETURN;  {------>
    IFEND;
    message_area := ^message;
    RESET message_area;
    NEXT message_line_count IN message_area;
    FOR message_line_index := 1 TO message_line_count^ DO
      NEXT message_line_size IN message_area;
      NEXT message_line: [message_line_size^] IN message_area;
      clp$put_partial_display (display_control_pointer^,message_line^, clc$no_trim,
        amc$terminate, status);
      IF NOT status.normal THEN
        return; {------->
      IFEND;
    FOREND;

  PROCEND dup$output_message;
?? TITLE := 'dup$process_module_parameter', EJECT ??

  PROCEDURE [XDCL] dup$process_module_parameter (
        parameter_name: string (*);
        p_parameter_value: ^clt$data_value;
    VAR module_name: pmt$program_name;
    VAR status: ost$status);

    VAR
      p_seq: ^SEQ (*),
      p_string: ^clt$string_value,
      program_name: pmt$program_name;

    p_seq := #SEQ (program_name);

    expand_value (parameter_name, p_parameter_value, p_seq, p_string, status);

    IF status.normal THEN
      IF (p_string = NIL) THEN
        module_name := osc$null_name;
      ELSE
        module_name := p_string^;
      IFEND;
    IFEND;
  PROCEND dup$process_module_parameter;
?? TITLE := 'dup$program_value', EJECT ??

  PROCEDURE [XDCL] dup$program_value (parameter_list: clt$parameter_list;
    VAR p_work: ^clt$work_area;
    VAR p_value: ^clt$data_value;
    VAR status: ost$status);

{ FUNCTION $program_variable, $pv (
{   name: (CHECK) application balance_brackets = $required
{   module: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   procedure: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   recursion_level: integer 1..7ffffff(16) = 1
{   recursion_direction: key
{       (backward, b)
{       (forward, f)
{     keyend = backward
{   type: key
{       (natural, n)
{       (integer, i)
{     keyend = natural
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$application_type_qualifier,
      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,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
      recend,
      type3: 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$application_type_qualifier,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (8),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (7),
      recend,
    recend := [
    [1,
    [88, 12, 22, 14, 18, 49, 432],
    clc$function, 6, 6, 1, 0, 0, 0, 0, ''], [
    ['MODULE                         ',clc$nominal_entry, 2],
    ['NAME                           ',clc$nominal_entry, 1],
    ['PROCEDURE                      ',clc$nominal_entry, 3],
    ['RECURSION_DIRECTION            ',clc$nominal_entry, 5],
    ['RECURSION_LEVEL                ',clc$nominal_entry, 4],
    ['TYPE                           ',clc$nominal_entry, 6]],
    [
{ 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$extended_parameter_checking, 4, 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$extended_parameter_checking, 27, clc$optional_parameter,
  0, 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$extended_parameter_checking, 27, clc$optional_parameter,
  0, 0],
{ PARAMETER 4
    [5, 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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [4, 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, 155,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 6
    [6, 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, 155,
  clc$optional_default_parameter, 0, 7]],
{ PARAMETER 1
    [[1, 0, clc$application_type], [TRUE]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$application_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$application_type, clc$program_name_type],
    FALSE, 2],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, 7ffffff(16), 10],
    '1'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BACKWARD                       ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FORWARD                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'backward'],
{ PARAMETER 6
    [[1, 0, clc$keyword_type], [4], [
    ['I                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['INTEGER                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['NATURAL                        ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'natural']];

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

    CONST
      p$name = 1,
      p$module = 2,
      p$procedure = 3,
      p$recursion_level = 4,
      p$recursion_direction = 5,
      p$type = 6;

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

    VAR
      display_type: dut$display_type,
      home_spec: dut$home_specification,
      input_modified: boolean,
      length: 0 .. max_name_parameter_length + 1,
      module_name: pmt$program_name,
      p_name_list: ^string_list,
      procedure_name: pmt$program_name,
      recursion_specified: boolean,
      variable_name: ^string ( * );

    RESET v$p_name_stack;

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

    process_variable_name ('NAME', pvt [p$name].value, p_name_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$process_module_parameter ('MODULE', pvt [p$module].value, module_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$process_module_parameter ('PROCEDURE', pvt [p$procedure].value, procedure_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dup$build_home_spec (module_name, procedure_name, pvt [p$recursion_level].value^,
          pvt [p$recursion_direction].value^, home_spec, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF home_spec.module_item^.debug_symbol_tables = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_symbol_table_in_module,
            home_spec.module_item^.name, status);
      RETURN;
    IFEND;

    recursion_specified := pvt [p$recursion_level].specified OR pvt [p$recursion_direction].specified;

    display_type := duc$natural_type;

    IF (pvt [p$type].value <> NIL) AND (pvt [p$type].value^.keyword_value = 'INTEGER') THEN
      display_type := duc$integer_type;
    IFEND;

    variable_name := p_name_list^ [1];

    CASE home_spec.language OF
    = llc$basic =
      get_basic_variable_value (variable_name, home_spec, p_value, status);

    = llc$cobol =
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Cobol', status);

    = llc$fortran =
      get_fortran_variable_value (variable_name, home_spec, p_value, status);

    ELSE
      get_cybil_variable_value (variable_name, home_spec, display_type, p_work, p_value, status);
    CASEND;

  PROCEND dup$program_value;
?? TITLE := 'change_basic_variable', EJECT ??

  PROCEDURE change_basic_variable (variable_name: ^string ( * );
        home_spec: dut$home_specification;
        value_name : ^string ( * );
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Basic', status);
  PROCEND change_basic_variable;
?? TITLE := 'change_cybil_variable', EJECT ??

  PROCEDURE change_cybil_variable (variable_name: ^string ( * );
        home_spec: dut$home_specification;
        value_name : ^string ( * );
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Cybil', status);
  PROCEND change_cybil_variable;
?? TITLE := 'change_fortran_variable', EJECT ??

  PROCEDURE change_fortran_variable (variable_name: ^string ( * );
        home_spec: dut$home_specification;
        value_name : ^string ( * );
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Fortran', status);
  PROCEND change_fortran_variable;
?? TITLE := 'convert_c_string', EJECT ??
{ In C, strings are really dereferenced pointers to char.  This routine is
{  called if that situation is encountered.  The end of the string is the first
{  NUL character found.

  PROCEDURE convert_c_string (
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

{ In C a string is a ptr to char.  If we find a ptr to char dereferenced, we
{  artificially change it to a string using this symbol.

  VAR
    c_symbol: [STATIC] llt$symbol_table_item;

    VAR
      ch: char,
      i: integer,
      tmp_address: ost$pva;

    i := 0;
    tmp_address := variable_spec.address;
{ Find the end of string }
    REPEAT
      tmp_address.offset := variable_spec.address.offset + i;
      dup$get_bytes (tmp_address, #LOC (ch), #SIZE (ch), status);
      i := i + 1;
    UNTIL NOT status.normal OR (ch = $CHAR(0));

    variable_spec.length := i - 1;               { The string length }
    variable_spec.max_string_length := i - 1;    { The string length }
{ Setup a new string symbol to replace the old ptr to char symbol }
    variable_spec.symbol_entry.symbol := ^c_symbol;
    variable_spec.symbol_entry.symbol^.symbol_kind := llc$string_kind;

  PROCEND convert_c_string;
?? TITLE := 'convert_pva_to_hexstring', EJECT ??
{
{  The purpose of this procedure is to convert the 48 bit string of a PVA
{  into a string of 12 hex digits: 1 hex digit for ring, 3 hex digits for
{  segment, 8 hex digits for byte number. A blank space is inserted between
{  ring and segment, segment and byte number hex digits.
{  Note: The mentioned convertion is merely a string conversion, thus it is
{        irrelevant for this conversion that the leftmost bit of the byte
{        number bit string functions as sign bit of the byte number.
{
{        CONVERT_PVA_TO_HEXSTRING (PVA, HEXSTRING, STATUS)
{
{  PVA: (input) This parameter specifies the pva that is to be converted
{       to a hex string. The pva is a record of ring number, segment number,
{       and a signed byte number.
{
{  HEXSTRING: (output) This parameter specifies the hex string represented
{       in ASCII. 12 hex digits for the pva and 2 blank spaces for sepatating
{       the hex strings for ring, segment, and byte numbers. The blanks are
{       used for readability.
{
{  STATUS: (output) This parameter specifies the request status.

  PROCEDURE convert_pva_to_hexstring (pva: ost$pva;
    VAR hexstring: string (14);
    VAR status: ost$status);

    TYPE
      alternate_view_of_pva = PACKED RECORD
                                ring: 0 .. 0F(16),
                                segment: 0 .. 0FFF(16),
                                offset: 0 .. 0FFFFFFFF(16)
                              RECEND;
{
{If the number to be converted is signed (that is, leftmost bit of its internal
{bit representation is sign bit), clp$convert_integer_to_rjstring recognizes it
{and builds the result string accordingly. Thus, if the number to be
{converted is negative, the complement will be built and the result string will
{be prefixed with a negative sign character if anough space is available.
{
{The offset field of a pva can be negative (see ost$pva),therefore its internal
{representation has a sign bit. For a positive offset, clp$convert_integer_to_rjstring
{always produces the true hex string representation of the bit string, but not
{for negative offsets.
{
{To obtain a true hex string representation of negative offsets too, we introduce
{an alternate_view_of_pva type in which the offset field is only positive,
{and then we map this type into the ost$pva type using the #LOC function.
{
    VAR
      pva_ptr: ^alternate_view_of_pva;

    pva_ptr := #LOC (pva);
    clp$convert_integer_to_rjstring (pva_ptr^.ring, 16, FALSE, '0', hexstring (1,1), status);
    clp$convert_integer_to_rjstring (pva_ptr^.segment, 16, FALSE, '0', hexstring (3, 3), status);
    clp$convert_integer_to_rjstring (pva_ptr^.offset, 16, FALSE, '0',hexstring (7, 8), status);
  PROCEND convert_pva_to_hexstring;
?? TITLE := 'display_fortran_variable', EJECT ??

  PROCEDURE display_fortran_variable (home_spec: dut$home_specification;
        variable_spec: dut$variable_specification;
        variable_name: ^string ( * );
        indent_count: integer;
        display_type: dut$display_type;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Fortran', status);
  PROCEND display_fortran_variable;
?? TITLE := 'display_variable_in_hex', EJECT ??

  PROCEDURE display_variable_in_hex (
        variable_spec: dut$variable_specification;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

    VAR
      value_length: integer,
      value_string: string (38),
      variable_length: integer;

    clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF variable_spec.length = 0 THEN
      IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$string_kind THEN
        dup$display_string (display_control_pointer, 45, '**This variable is a string of length zero.**',
                          0, status);
      ELSE
        dup$display_string (display_control_pointer, 42, '**TYPE=HEX not valid for this data type.**',
                          0, status);
      IFEND;
      RETURN; {----->
    IFEND;
    IF variable_spec.bit_offset <> 0 THEN
      dup$display_string (display_control_pointer, 12, 'Bit offset:',
                          0, status);
      STRINGREP (value_string, value_length, variable_spec.bit_offset,
                 ', ');
      dup$display_string (display_control_pointer, value_length,
                value_string (1, value_length), 0, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
    IF variable_spec.length_is_bits THEN
      variable_length := ((variable_spec.length + variable_spec.bit_offset - 1)
                                DIV byte_size) + 1;
      dup$display_string (display_control_pointer, 12, 'Bit length:',
                          0, status);
      STRINGREP (value_string, value_length, variable_spec.length,
                 ', ');
      dup$display_string (display_control_pointer, value_length,
                value_string (1, value_length), 0, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      variable_length := variable_spec.length;
    IFEND;
    format_and_display_data (variable_spec.address, variable_length,
          16, 99999999, display_control_pointer, status);

  PROCEND display_variable_in_hex;
?? TITLE := 'enable_c_globals', EJECT ??

  PROCEDURE enable_c_globals (
    VAR home_spec: dut$home_specification);

    VAR
      global_module: pmt$program_name,
      index: integer,
      p_debug_tables: ^array [0 .. *] of ^llt$debug_symbol_table,
      upper: integer;

    global_module := 'c_globals';
    IF (home_spec.symbol_table_address^.original_module_name = global_module) THEN
      RETURN; {----->           { We have already tried the global module }
    IFEND;
    p_debug_tables := home_spec.module_item^.debug_symbol_tables;
    IF (p_debug_tables = NIL) THEN
      RETURN; {----->           { No debug tables }
    IFEND;
    upper := UPPERBOUND (p_debug_tables^);
    index := 0;
    WHILE (index <= upper) AND (p_debug_tables^ [index]^.original_module_name <> global_module) DO
      index := index + 1;
    WHILEND;
    IF (index > upper) THEN
      RETURN; {----->           { global module not found }
    IFEND;
    home_spec.symbol_table_address := p_debug_tables^ [index];
    home_spec.procedure_entry.symbol := NIL;
  PROCEND enable_c_globals;
?? TITLE := 'evaluate_c_pointer', EJECT ??

  PROCEDURE evaluate_c_pointer (
        home_spec: dut$home_specification;
        working_var_name: ^string ( * );         {For error messages only}
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

    VAR
      ptr_mod: integer,
      symbol_kind: llt$entry_kind;

    symbol_kind := variable_spec.symbol_entry.symbol^.symbol_kind;
    IF symbol_kind = llc$cybil_array_kind THEN
{ C arrays can be treated as pointers.  Dereferencing an array means accessing
{  an element of the array (the 1st element if there is no pointer modification
{  to do, the (n+1)th if the value of the pointer modifier is n).
      variable_spec.length := variable_spec.symbol_entry.symbol^.cybil_array_element_length;
      dup$locate_symbol_for_number (home_spec.symbol_table_address,
                  variable_spec.symbol_entry.symbol^.cybil_array_element_type,
                  variable_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      reduce_cybil_type (home_spec, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    ELSE
      IF variable_spec.symbol_entry.symbol^.symbol_kind <> llc$pointer_kind THEN
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_pointer_reference, working_var_name^, status);
        RETURN; {----->
      IFEND;

{ We have a "real" pointer.  Evaluate it.

      variable_spec.address.offset := variable_spec.address.offset + 2;
      variable_spec.length := variable_spec.length - 2;
      evaluate_cybil_pointer (home_spec, working_var_name, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

{ If the user wanted to modify the pointer, do it now.

    IF ptr_mod_specified THEN
      ptr_mod := (ptr_modification * variable_spec.length);
      IF ((variable_spec.address.offset + ptr_mod) > osc$maximum_offset) OR
         ((variable_spec.address.offset + ptr_mod) < -(osc$maximum_offset - 1)) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$c_ptr_mod_range_err, '', status);
        RETURN; {----->
      ELSE
        variable_spec.address.offset := variable_spec.address.offset + ptr_mod;
      IFEND;
      ptr_mod_specified := FALSE;
      ptr_modification := 0;
    ELSE

{  If we were passed an unmodified pointer to char then make it a string }

      IF symbol_kind = llc$pointer_kind THEN
        IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$char_kind THEN
{ Interpret a pointer to char as a string only if the ptr is not modified.
          convert_c_string (variable_spec, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND evaluate_c_pointer;
?? TITLE := 'evaluate_c_subscript', EJECT ??

  PROCEDURE evaluate_c_subscript (
        home_spec: dut$home_specification;
        working_var_name: ^string ( * );
        parameter_value: ^string ( * );
    VAR parameter_index: {input,output} clt$string_index;
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

{ If the symbol in question is an array, call evaluate_cybil_subscript.  If
{  it is a pointer to char, the subscript reference is equivalent to modifying
{  the pointer and clp$evaluate_token it.  Otherwise, diagnose the error.

    VAR
      derefs: integer,
      scan_index: clt$string_index,
      spaces_preceded_token: boolean,
      subscript_length: clt$string_size,
      symbol_entry: dut$symbol_entry,
      token: clt$lexical_token;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$cybil_array_kind THEN
      evaluate_cybil_subscript (home_spec, parameter_value, parameter_index, variable_spec, status);
      RETURN; {----->
    IFEND;
    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$pointer_kind THEN
      dup$locate_symbol_for_number (home_spec.symbol_table_address,
                  variable_spec.symbol_entry.symbol^.ptr_type,
                  symbol_entry, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      scan_index := 1;
      clp$evaluate_token (parameter_value^(parameter_index,*), scan_options,
            scan_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      find_c_subscript (parameter_value^(parameter_index, *), subscript_length);
      IF subscript_length = 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_spec.name, status);
        RETURN; {----->
      IFEND;
      derefs := 0;           { No dereferences wanted here }
{ Fake no dereferences since this is a fake ptr mod.  Subscripts are higher
{  precedence than dereferences.
      modify_c_pointer (home_spec, token, working_var_name,
                   ^parameter_value^(1,parameter_index + subscript_length - 1),
                   parameter_index, derefs, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      evaluate_c_pointer (home_spec, working_var_name, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
{ Update the index if the subscript was a constant.  For variable subscripts,
{  the index is taken care of in modify_c_pointer.
      IF token.kind = clc$unsigned_integer_token THEN
        parameter_index := parameter_index + scan_index - 1;
      IFEND;
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_subscript_reference,
              working_var_name^, status);
    IFEND;

  PROCEND evaluate_c_subscript;
?? TITLE := 'evaluate_cybil_pointer', EJECT ??
{ PURPOSE: dereference a CYBIL pointer reference.

  PROCEDURE evaluate_cybil_pointer (
        home_spec: dut$home_specification;
        parameter_name: ^string ( * );
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

    VAR
      pointer: ost$pva;

    IF variable_spec.symbol_entry.symbol^.symbol_kind <> llc$pointer_kind THEN
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_pointer_reference, parameter_name^, status);
      RETURN;
    IFEND;

    variable_spec.descriptor_address := variable_spec.address;
    pointer := variable_spec.address;
    dup$get_bytes (pointer, #LOC (variable_spec.address), #SIZE (variable_spec.address), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    variable_spec.length := variable_spec.symbol_entry.symbol^.ptr_object_length;
    variable_spec.length_is_bits := FALSE;
    variable_spec.bit_offset := 0;
    dup$locate_symbol_for_number (home_spec.symbol_table_address,
          variable_spec.symbol_entry.symbol^.ptr_type, variable_spec.symbol_entry, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    reduce_cybil_type (home_spec, variable_spec, status);
  PROCEND evaluate_cybil_pointer;
?? TITLE := 'evaluate_cybil_subscript', EJECT ??

  PROCEDURE evaluate_cybil_subscript (
        home_spec: dut$home_specification;
        parameter_value: ^string ( * );
    VAR parameter_index: {input,output} clt$string_index;
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

{ PURPOSE: Interpret a CYBIL subscript reference and adjust the variable_spec
{          entry to describe the requested element of the array.
{ DESIGN:  The reference is examined to see if it is a constant value of the
{          appropriate type. If it is not, an attempt is made to evaluate it as
{          a variable. When the subscript has been evaluated to a value, the
{          variable_spec is modified to describe an element of the array, and
{          the address is adjusted to indicate the requested element.

    VAR
      array_element_length: llt$section_length_in_bits,
      array_element_type: llt$symbol_number,
      array_entry: dut$symbol_entry,
      element_offset: machine_addr_in_bits_type,
      index_spec: dut$variable_specification,
      index_value: integer,
      pca_lower_bound: integer,
      pca_upper_bound: integer,
      subscript_index: clt$string_index,
      tmp_home_spec: dut$home_specification;     { In case the language is C }

    array_entry := variable_spec.symbol_entry;
    IF (array_entry.symbol^.symbol_kind <> llc$cybil_array_kind) AND
       (array_entry.symbol^.symbol_kind <> llc$pascal_conf_array_kind) THEN
      osp$set_status_abnormal (duc$symbolic_id,
            due$invalid_subscript_reference, variable_spec.name, status);
      RETURN;
    IFEND;
    IF parameter_index > STRLENGTH(parameter_value^) THEN
{ We have reached the end of the parameter prematurely }
      osp$set_status_abnormal (duc$symbolic_id, due$subscript_error,
                 variable_spec.name, status);
      RETURN;
    IFEND;
    IF array_entry.symbol^.symbol_kind = llc$cybil_array_kind THEN
      array_element_type := array_entry.symbol^.cybil_array_element_type;
      array_element_length := array_entry.symbol^.cybil_array_element_length;

{ Get index specification }

      dup$locate_symbol_for_number (home_spec.symbol_table_address,
        array_entry.symbol^.cybil_index_type, index_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      index_spec.range_specified := FALSE;
      index_spec.descriptor_address := variable_spec.descriptor_address;
      reduce_cybil_type (home_spec, index_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE  { Setup for Pascal conformant arrays }
      array_element_type := array_entry.symbol^.conf_array_element_kind;
      array_element_length := array_entry.symbol^.conf_array_element_length;

{ Get index specification for a conformant array }

      dup$locate_symbol_for_number (home_spec.symbol_table_address,
            array_entry.symbol^.conf_array_lower_bound, index_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      subscript_index := 1;
      scan_cybil_variable (^index_spec.symbol_entry.symbol^.symbol_name, home_spec, subscript_index,
            index_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      get_cybil_value (index_spec, pca_lower_bound, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Get upper bound value }
      dup$locate_symbol_for_number (home_spec.symbol_table_address,
            array_entry.symbol^.conf_array_upper_bound, index_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      subscript_index := 1;
      scan_cybil_variable (^index_spec.symbol_entry.symbol^.symbol_name, home_spec, subscript_index,
            index_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      get_cybil_value (index_spec, pca_upper_bound, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Put the conformant array upper and lower bounds into index_spec }

      index_spec.low_value := pca_lower_bound;
      index_spec.high_value := pca_upper_bound;
    IFEND;

    { C home_spec's can be modified if the variable is global.
    tmp_home_spec := home_spec;

    get_index_value (tmp_home_spec, variable_spec.name, index_spec.symbol_entry, parameter_value,
          parameter_index, index_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (index_value < index_spec.low_value) OR (index_value > index_spec.
          high_value) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$subscript_out_of_range,
            variable_spec.name, status);
      RETURN;
    IFEND;

{ Modify variable_spec to describe requested element in array.}

    dup$locate_symbol_for_number (tmp_home_spec.symbol_table_address, array_element_type,
                   variable_spec.symbol_entry, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    variable_spec.range_specified := FALSE;
    reduce_cybil_type (tmp_home_spec, variable_spec, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    variable_spec.length := array_element_length;
    IF array_entry.symbol^.symbol_kind = llc$cybil_array_kind THEN
      variable_spec.length_is_bits := llc$cybil_array_is_bits IN
                           array_entry.symbol^.cybil_array_attributes;
    ELSE
      variable_spec.length_is_bits := llc$cybil_array_is_bits IN
                           array_entry.symbol^.conf_array_attributes;
    IFEND;

    element_offset := variable_spec.length * (index_value - index_spec.
          low_value);
    IF variable_spec.length_is_bits THEN
      element_offset := element_offset + variable_spec.bit_offset;
      variable_spec.address.offset := variable_spec.address.offset +
            (element_offset DIV bits_per_byte);
      variable_spec.bit_offset := element_offset MOD bits_per_byte;
    ELSE
      variable_spec.address.offset := variable_spec.address.offset +
            element_offset;
    IFEND;
  PROCEND evaluate_cybil_subscript;
?? TITLE := 'evaluate_cybil_substring', EJECT ??

  PROCEDURE evaluate_cybil_substring (
        home_spec: dut$home_specification;
        parameter_value: ^string ( * );
    VAR parameter_index: clt$string_index;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

    VAR
      old_string_len: ost$segment_length,
      param_index: clt$string_index,
      scan_index: clt$string_index,
      scan_length: clt$string_size,
      spaces_preceded_token: boolean,
      starting_position: integer,
      string_entry: dut$symbol_entry,
      substring_length: integer,
      sub_var_spec: dut$variable_specification,
      token: clt$lexical_token;

    string_entry := variable_spec.symbol_entry;
    IF string_entry.symbol^.symbol_kind <> llc$string_kind THEN
      IF string_entry.symbol^.symbol_kind = llc$constant_kind THEN
        osp$set_status_abnormal (duc$symbolic_id, due$internal_error,
            'A substring reference of a constant is not legal', status);
      ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$substring_illegal,
                 variable_spec.name, status);
      IFEND;
      RETURN;
    IFEND;
    IF parameter_index > STRLENGTH(parameter_value^) THEN
{ We have reached the end of the parameter prematurely }
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring, '', status);
      RETURN;
    IFEND;

    old_string_len := variable_spec.length;
    scan_index := 1;
    clp$evaluate_token (parameter_value^(parameter_index,*), scan_options, scan_index,
                   spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    CASE token.kind OF
    = clc$unsigned_integer_token =
      starting_position := token.int.value;

    = clc$simple_name_token,
      clc$name_token,
      clc$cybil_name_token =
      find_separator_token (parameter_value^(parameter_index,*), scan_length,
                   status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      param_index := 1;
      scan_cybil_variable (^parameter_value^(parameter_index,scan_length), home_spec, param_index,
            sub_var_spec, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (duc$symbolic_id, due$substring_start_is_int,
                 variable_spec.name, status);
        RETURN;
      IFEND;
      IF sub_var_spec.symbol_entry.symbol^.symbol_kind <> llc$integer_kind THEN
        osp$set_status_abnormal (duc$symbolic_id, due$substring_start_is_int,
                 variable_spec.name, status);
        RETURN;
      IFEND;
      get_cybil_value (sub_var_spec, starting_position, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (duc$symbolic_id, due$substring_start_is_int,
                 variable_spec.name, status);
        RETURN;
      IFEND;
      scan_index := 1 + scan_length;

    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$substring_start_is_int,
                 variable_spec.name, status);
      RETURN;

    CASEND;
    IF (starting_position < 1) OR
       (starting_position > variable_spec.length) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$substring_start_range_err,
                 variable_spec.name, status);
      RETURN;
    IFEND;

{ Update variable_spec with new starting position }

    variable_spec.address.offset := variable_spec.address.offset +
                   starting_position - 1;
    variable_spec.length := 1;         { assume one character substring for now }
    variable_spec.max_string_length := 1;
    variable_spec.range_specified := TRUE;

{ See if a length was specified }

    clp$evaluate_token (parameter_value^(parameter_index,*), scan_options, scan_index,
                   spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF token.kind = clc$right_parenthesis_token THEN
      parameter_index := parameter_index + scan_index - 1; {Update param index}
      RETURN;      {We are done...}
    IFEND;
    IF token.kind <> clc$comma_token THEN
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring, '', status);
      RETURN;
    IFEND;

{ Get the length of the substring }

    clp$evaluate_token (parameter_value^(parameter_index,*), scan_options, scan_index,
                   spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    CASE token.kind OF
    = clc$unsigned_integer_token =
      substring_length := token.int.value;

    = clc$multiply_token =
      substring_length := old_string_len - (starting_position - 1);

    = clc$simple_name_token,
      clc$name_token,
      clc$cybil_name_token =
      scan_index := scan_index - token.text_size;
      find_separator_token (parameter_value^(parameter_index + scan_index - 1,*),
                   scan_length, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      param_index := 1;
      scan_cybil_variable (^parameter_value^ (parameter_index + scan_index - 1, scan_length),
                   home_spec, param_index, sub_var_spec, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring_length,
                 parameter_value^, status);
        RETURN;
      IFEND;
      IF sub_var_spec.symbol_entry.symbol^.symbol_kind <> llc$integer_kind THEN
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring_length,
                 parameter_value^, status);
        RETURN;
      IFEND;
      get_cybil_value (sub_var_spec, substring_length, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring_length,
                 parameter_value^, status);
        RETURN;
      IFEND;
      scan_index := scan_index + scan_length;

    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring_length,
                 parameter_value^, status);
      RETURN;

    CASEND;
    IF substring_length < 0 THEN
      osp$set_status_abnormal (duc$symbolic_id, due$substring_length_range_err,
                 variable_spec.name, status);
      RETURN;
    IFEND;
    IF substring_length > old_string_len - (starting_position - 1) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$substring_length_range_err,
                 variable_spec.name, status);
      RETURN;
    IFEND;
    variable_spec.length := substring_length;
    variable_spec.max_string_length := substring_length;

{ Make sure next token is a right parenthesis }

    clp$evaluate_token (parameter_value^(parameter_index,*), scan_options, scan_index,
                   spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF token.kind <> clc$right_parenthesis_token THEN
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring, '', status);
      RETURN;
    IFEND;
    parameter_index := parameter_index + scan_index - 1;

  PROCEND evaluate_cybil_substring;
?? TITLE := 'expand_value', EJECT ??

  PROCEDURE expand_value (value_name: string (*);
        p_value: ^clt$data_value;
    VAR p_seq: {input, output} ^SEQ (*);
    VAR p_string: ^clt$string_value;
    VAR status: ost$status);

{ TYPE
{   expression: any
{ TYPEND

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

  VAR
    type_specification : [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      name: string (10),
      qualifier: clt$union_type_qualifier,
    recend := [
      [1, 10, clc$union_type], 'EXPRESSION', [-$clt$type_kinds [],
      FALSE, 0]];

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

    VAR
      class: clt$variable_class,
      expression_start: clt$string_index,
      macro_size: clt$string_size,
      maximum_size: integer,
      method: clt$expression_eval_method,
      mode: clt$data_access_mode,
      open_paren_count: integer,
      p_expression: ^string (*),
      p_macro_string: ^string (*),
      p_macro_value: ^clt$data_value,
      p_name: ^string (*),
      p_type_spec: ^clt$type_specification,
      p_value_string: ^clt$string_value,
      p_var_string: ^ost$string,
      p_work: ^SEQ (*),
      p_work_area: ^SEQ (*),
      query_options: clt$token_evaluation_options,
      scan_options: clt$token_evaluation_options,
      spaces: boolean,
      string_index: clt$string_index,
      temp_p_seq: ^SEQ (*),
      token: clt$lexical_token,
      value_index: clt$string_index,
      value_size: clt$string_size;

    status.normal := TRUE;
    p_work_area := ^v$work_area;
    RESET p_work_area;

    get_value_string (p_value, p_work_area, p_value_string);

    IF (p_value_string = NIL) THEN
      p_string := NIL;
    ELSE
      temp_p_seq := p_seq;
      maximum_size := #SIZE (temp_p_seq^) - i#current_sequence_position (temp_p_seq);
      IF (maximum_size > clc$max_string_size) THEN
        maximum_size := clc$max_string_size;
      ELSEIF (maximum_size < 1) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$parameter_value_too_long, value_name, status);
        RETURN;
      IFEND;
      NEXT p_string: [maximum_size] IN temp_p_seq;

      scan_options := $clt$token_evaluation_options [clc$cobol_name_is_token, clc$classify_name_token,
            clc$international_char_is_token, clc$special_cybil_name_is_token];
      query_options := $clt$token_evaluation_options [clc$classify_name_token,
            clc$international_char_is_token];

      value_index := 1;
      string_index := 1;

      REPEAT
        clp$evaluate_token (p_value_string^, scan_options, value_index, spaces, token, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF (token.kind = clc$query_token) THEN
          p_work := p_work_area;

          clp$evaluate_token (p_value_string^, query_options, value_index, spaces, token, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF (token.kind = clc$left_parenthesis_token) THEN
            value_size := STRLENGTH (p_value_string^);
            expression_start := value_index;
            open_paren_count := 1;
            WHILE (value_index <= value_size) AND (open_paren_count > 0) DO
              IF (p_value_string^ (value_index) = ')') THEN
                open_paren_count := open_paren_count - 1;
              ELSEIF (p_value_string^ (value_index) = '(') THEN
                open_paren_count := open_paren_count + 1;
              IFEND;
              value_index := value_index + 1;
            WHILEND;

            IF (open_paren_count <> 0) THEN
              osp$set_status_abnormal (duc$symbolic_id, due$unbalanced_macro_parens, '', status);
              RETURN;
            IFEND;

            p_expression := ^p_value_string^ (expression_start, value_index - expression_start - 1);
            p_type_spec := #SEQ (type_specification);
            clp$evaluate_expression (p_expression^, p_type_spec, p_work, p_macro_value, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          ELSE
            p_name := ^token.str.value (1, token.str.size);
            clp$get_variable (p_name^, p_work_area, class, mode, method, p_type_spec, p_macro_value, status);
            IF NOT status.normal THEN
              osp$set_status_abnormal (duc$symbolic_id, due$scl_variable_expected, p_name^, status);
              RETURN;
            IFEND;
          IFEND;

          get_value_string (p_macro_value, p_work, p_macro_string);

          IF (p_macro_string <> NIL) THEN
            macro_size := STRLENGTH (p_macro_string^);
            IF ((string_index + macro_size - 1) > maximum_size) THEN
              osp$set_status_abnormal (duc$symbolic_id, due$parameter_value_too_long, value_name, status);
              RETURN;
            IFEND;
            p_string^ (string_index, macro_size) := p_macro_string^;
            string_index := string_index + macro_size;
          IFEND;
        ELSE
          IF ((string_index + token.text_size - 1) > maximum_size) THEN
            osp$set_status_abnormal (duc$symbolic_id, due$parameter_value_too_long, value_name, status);
            RETURN;
          IFEND;
          p_string^ (string_index, token.text_size) := p_value_string^ (token.text_index, token.text_size);
          string_index := string_index + token.text_size;
        IFEND;
      UNTIL token.kind = clc$end_of_line_token;

      NEXT p_string: [string_index -1] IN p_seq;
    IFEND;
  PROCEND expand_value;
?? TITLE := 'find_c_sub_expression', EJECT ??
{ This routine is used to isolate sub-expressions in a variable name.

  PROCEDURE find_c_sub_expression (
        expression: string ( * );
    VAR expression_len: clt$string_size;
    VAR status: ost$status );

    VAR
      i: integer,
      l_parens: integer;

    status.normal := TRUE;
    l_parens := 0;
  /find_matching_r_paren/
    FOR i := 1 TO STRLENGTH(expression) DO
      IF expression(i) = '(' THEN
        l_parens := l_parens + 1;
      ELSEIF expression(i) = ')' THEN
        IF l_parens = 0 THEN
          expression_len := i - 1;
          IF expression_len = 0 THEN
            osp$set_status_abnormal (duc$symbolic_id, due$c_empty_expression, '', status);
          IFEND;
          RETURN; {----->
        ELSE
          l_parens := l_parens - 1;
        IFEND;
      IFEND;
    FOREND /find_matching_r_paren/;
    osp$set_status_abnormal (duc$symbolic_id, due$c_unbalanced_parens, '', status);

  PROCEND find_c_sub_expression;
?? TITLE := 'find_c_subscript', EJECT ??
{ This routine finds the length of the parameter string up to the next right
{ bracket not contained in bracket pairs.
{
{ Param_str is only the substring part of the original parameter string.
{ That is, if the original parameter is - blip[arghh[2][3]]
{ then param_str will be - arghh[2][3]]
{ and we will return sub_param_len = 11, corresponding to - arghh[2][3]
{
{ sub_param_len is zero if the brackets are unbalanced or empty.

  PROCEDURE find_c_subscript (
        param_str: string ( * );
    VAR sub_param_len: clt$string_size);

    VAR
      i: clt$string_index,
      open_brackets: integer;

    open_brackets := 0;
    FOR i := 1 TO STRLENGTH (param_str) DO
      CASE param_str(i) OF
      = ']' =
        IF open_brackets = 0 THEN
          sub_param_len := i - 1;
          RETURN; {----->
        IFEND;
        open_brackets := open_brackets - 1;

      = '[' =
        open_brackets := open_brackets + 1;

      ELSE
      CASEND;
    FOREND;
    sub_param_len := 0;

  PROCEND find_c_subscript;
?? TITLE := 'find_end_of_subscript', EJECT ??

  PROCEDURE find_end_of_subscript (
        param_str: string ( * );
    VAR sub_param_len: clt$string_size);

{ This routine is called by evaluate_cybil_subscript if the subscript is
{  not expressed as a constant.  Its purpose is to find the length of the
{  parameter string up to the next right bracket or comma (not contained in
{  bracket pairs).
{  Scan_cybil_variable is then called to evaluate the expression as a CYBIL
{  variable reference.
{  Param_str is only the substring part of the original parameter string.
{  That is, if the original parameter is - xyzzy.blip[arghh[2,3]][plugh.yup]
{  then param_str will be - arghh[2,3]][plugh.yup]
{  and we will return sub_param_len = 10, corresponding to - arghh[2,3]

    VAR
      i: clt$string_index,
      open_brackets: integer;

    open_brackets := 0;
    FOR i := 1 TO STRLENGTH (param_str) DO
      CASE param_str(i) OF
      = ']',
        ',' =
        IF open_brackets = 0 THEN
          sub_param_len := i - 1;
          RETURN;
        IFEND;
        IF param_str(i) = ']' THEN
          open_brackets := open_brackets - 1;
        IFEND;

      = '[' =
        open_brackets := open_brackets + 1;

      ELSE
      CASEND;
    FOREND;
    sub_param_len := 0;

  PROCEND find_end_of_subscript;
?? TITLE := 'find_separator_token', EJECT ??

  PROCEDURE find_separator_token (
        param_str: string ( * );
    VAR sub_param_len: clt$string_size;
    VAR status: ost$status);

{ This routine is called by evaluate_cybil_substring if the substring starting
{  position or length is not expressed as a constant.  Its purpose is to find
{  the length of the parameter string up to the next space, comma, or right
{  parenthesis (not contained in parentheses or bracket pairs).
{  Scan_cybil_variable is then called to evaluate the expression as a CYBIL
{  variable reference.
{  Param_str is only the substring part of the original parameter string.
{  That is, if the original parameter is - xyzzy.blip(arghh[2,3],plugh.yup)
{  then param_str will be - arghh[2,3],plugh.yup)
{  on the first call and we will return sub_param_len = 10, corresponding
{  to - arghh[2,3]

    VAR
      i: clt$string_index,
      open_brackets: integer,
      open_parens: integer;

    open_parens := 0;
    open_brackets := 0;
    FOR i := 1 TO STRLENGTH (param_str) DO
      CASE param_str(i) OF
      = ')',
        ',',
        ' ' =
        IF (open_parens = 0) AND
           (open_brackets = 0) THEN
          sub_param_len := i - 1;
          RETURN;
        IFEND;
        IF param_str(i) = ')' THEN
          open_parens := open_parens - 1;
        IFEND;

      = '(' =
        open_parens := open_parens + 1;

      = '[' =
        open_brackets := open_brackets + 1;

      = ']' =
        open_brackets := open_brackets - 1;

      ELSE
      CASEND;
    FOREND;
    osp$set_status_abnormal (duc$symbolic_id, due$c_unbalanced_parens,
                 '', status);

  PROCEND find_separator_token;
?? TITLE := 'format_and_display_data', EJECT ??

  PROCEDURE format_and_display_data (display_start: ost$pva;
        displayable_length: integer;
        byte_count: integer;
        repeat_count: integer;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

    CONST
      out_str_len = 96;

    VAR
      address: ost$pva,
      bytes_per_line: integer,         {max bytes per line in long display
      first_ascii: integer,            {position in s of first ascii chr
      out_len: 0 .. out_str_len,       {length of s used.
      byte: 0 .. 255,
      s: string (out_str_len),
      character: char,
      portion_length: 1 .. 24,
      number_of_portions,
      portion_index,
      hex_position,
      index,
      actual_repeat_count,
      byte_count_rest,
      i,
      k: integer;

    PROCEDURE condition_handler (condition: pmt$condition,
          ignore_cond_inf: ^pmt$condition_information;
          ignore_save_area: ^ost$stack_frame_save_area;
      VAR handler_status: ost$status);

      handler_status.normal := TRUE;
      CASE condition.selector OF
      = mmc$segment_access_condition =
        clp$put_partial_display (display_control_pointer^, s, clc$no_trim, amc$terminate, status);
        pmp$continue_to_cause (pmc$inhibit_standard_procedure, handler_status);

      CASEND;
    PROCEND condition_handler;

    VAR
      condition: [STATIC, READ] pmt$condition := [pmc$condition_combination, $pmt$condition_combination
        [pmc$system_conditions, mmc$segment_access_condition]],
      established_condition_handler: pmt$established_handler;

    s := 'STARTING ADDRESS: 0 000 00000000';
    convert_pva_to_hexstring (display_start, s (19, 14), status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;
    clp$put_partial_display (display_control_pointer^, s (1, 32), clc$trim, amc$terminate, status);

    pmp$establish_condition_handler (condition, ^condition_handler, ^established_condition_handler, status);

    address := display_start;

    IF byte_count < 9 THEN {format two byte_count fields per line.
      s := '00000000                               00000000                                 ';
    /display_memory_loop_one/
      FOR i := 1 TO repeat_count DO
        clp$convert_integer_to_rjstring (byte_count * (i - 1), 16, FALSE, '0', s (1 + 39 * ((i - 1) MOD 2),
              8), status);
        FOR k := 0 TO byte_count - 1 DO
          index := (i - 1) * byte_count + k + 1;
{
{If end of displayable block (section or segment) is reached,
{prpare for output and output last line, if necessary, and end display.
{
          IF index > displayable_length THEN
            IF (i MOD 2 = 1) THEN
              IF k = 0 THEN
                EXIT /display_memory_loop_one/;
              ELSE
                s (40, 8) := '        ';
              IFEND;
            ELSE { i MOD 2 = 0
              IF k = 0 THEN
                s (40,8) := '        ';
              IFEND;
            IFEND;
            clp$put_partial_display (display_control_pointer^, s(1,77),
              clc$no_trim, amc$terminate, status);
            exit /display_memory_loop_one/;
          IFEND;

          address.offset := display_start.offset + index - 1;
          dup$get_bytes (address, #LOC (byte), #SIZE (byte), status);

          IF NOT status.normal THEN
            RETURN;
          IFEND;
          character := $char (byte);

          IF (ORD (character) < 32) OR (ORD (character) > 126) THEN
            character := '?';
          IFEND;
          s (31 + 39 * ((i - 1) MOD 2) + k) := character;
          hex_position := 11 + 2 * k + k DIV 2 + 39 * ((i - 1) MOD 2);
          clp$convert_integer_to_rjstring (byte, 16, FALSE, '0', s (hex_position, 2),
                status);
        FOREND;
        IF (i MOD 2 = 0) THEN
          clp$put_partial_display (display_control_pointer^, s(1,77), clc$no_trim, amc$terminate, status);
          s := '00000000                               00000000                                 ';
        ELSEIF (i MOD 2 = 1) AND (i = repeat_count) THEN
          s (40, 8) := '        ';
          clp$put_partial_display (display_control_pointer^, s(1,77), clc$no_trim, amc$terminate, status);
        IFEND;
      FOREND /display_memory_loop_one/;
    ELSE {byte_count >= 9
{
{   If the page is wide enough, format up to 3 words per line, otherwise 2.
{If byte_count > bytes_per_line, then divide byte field of length byte_count
{into portions of bytes_per_line bytes each, with the last portion having usually less.
{There will be one line per portion.
{A new line is started at the start of each byte field of length byte_count.
{
      IF (display_control_pointer^.page_width < 96) OR
         (byte_count < 17) THEN
{ If there is only room for two words per display line or the user asked for two
        bytes_per_line := 16;
      ELSE
{ Three words will fit and user asked for more than two words per portion.
        bytes_per_line := 24;
      IFEND;
      first_ascii := 10 + (bytes_per_line * 2) + (bytes_per_line DIV 2) + 2;
      out_len := first_ascii + bytes_per_line - 1;
      number_of_portions := (byte_count + (bytes_per_line - 1)) DIV bytes_per_line;
    /display_memory_loop_two/
      FOR i := 1 TO repeat_count DO
        s := '00000000';
        clp$convert_integer_to_rjstring (byte_count * (i - 1), 16, FALSE, '0', s (1, 8), status);
        FOR portion_index := 1 TO number_of_portions DO
          IF portion_index < number_of_portions THEN
            portion_length := bytes_per_line;
          ELSE
            portion_length := byte_count - (portion_index - 1) * bytes_per_line;
          IFEND;
          FOR k := 0 TO portion_length - 1 DO
            index := byte_count * (i - 1) + bytes_per_line * (portion_index - 1) + k + 1;
{
{If end of displayable block (section or segment) is reached,
{prepare for output and output last line, if necessary, and end display.
{
            IF index > displayable_length THEN
              IF k <> 0 THEN
                clp$put_partial_display (display_control_pointer^, s(1,out_len),
                  clc$no_trim, amc$terminate, status);
              IFEND;
              exit /display_memory_loop_two/;
            IFEND;

            address.offset := display_start.offset + index - 1;
            dup$get_bytes (address, #LOC (byte), #SIZE (byte), status);

            IF NOT status.normal THEN
              RETURN;
            IFEND;
            character := $char (byte);

            IF (ORD (character) < 32) OR (ORD (character) > 126) THEN
              character := '?';
            IFEND;
            s (first_ascii + k) := character;
            hex_position := 11 + 2 * k + k DIV 2;
            clp$convert_integer_to_rjstring (byte, 16, FALSE, '0', s (hex_position, 2),
                  status);
          FOREND;
          clp$put_partial_display (display_control_pointer^, s(1,out_len),
                             clc$no_trim, amc$terminate, status);
          s := '';
        FOREND;
      FOREND /display_memory_loop_two/;

    IFEND;
  PROCEND format_and_display_data;
?? TITLE := 'format_and_display_variable', EJECT ??

  PROCEDURE format_and_display_variable (
        home_spec: dut$home_specification;
        input_variable_spec: dut$variable_specification;
        variable_name: ^string ( * );
        indent_count: ost$string_size;
        display_type: dut$display_type;
        p_variant_selection: ^clt$data_value;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

{ PURPOSE: Format a variable value and write it on the display file.
{ DESIGN:  Simple types are displayed in accordance with their type.
{          Compound types are broken down into their elements and this
{          routine is called recursively to display the elements.

    VAR
      address: ost$pva,
      blank_fill: 0 .. bits_per_byte,
      code_address: ost$pva,
      column_number: 0 .. amc$max_page_width,
      constant_entry: dut$symbol_entry,
      constant_spec: dut$variable_specification,
      copied_string_pointer: ^string ( * ),
      element_address_ptr: ^ost$pva,
      element_found: boolean,
      element_offset: machine_addr_in_bits_type,
      element_spec: dut$variable_specification,
      element_value: integer,
      element_value_ptr: ^cell,
      err_msg: string(80),
      field_number: symbol_no,
      field_offset: machine_addr_in_bits_type,
      field_spec: dut$variable_specification,
      index_spec: dut$variable_specification,
      i: integer,
      int_string: ost$string,
      local_status: ost$status,
      local_status1: ost$status,
      longreal_value_pointer: ^^longreal,
      message: ost$status_message,
      message_area: ^ost$status_message,
      message_line_count: ^ost$status_message_line_count,
      message_line_index: 1 .. osc$max_status_message_lines,
      message_line: ^string(*),
      message_line_size: ^ost$status_message_line_size,
      module_item: ^dbt$module_address_table_item,
      name: ost$name,
      number_of_elements_ptr: ^integer,
      ordinal_entry: dut$symbol_entry,
      p_vs_list: ^clt$data_value,
      pascal_file_ptr: ^^boolean,
      pascal_file_ptr2: ^^0 .. 0FF(16),
      pca_lower_bound: integer,
      pca_upper_bound: integer,
      pointer: ost$pva,
      pointer_pva: ^ost$pva,
      pointer_to_procedure: ^^ost$pointer_to_procedure,
      procedure_entry: dut$symbol_entry,
      real_value_pointer: ^^real,
      section_item_index: llt$section_ordinal,
      select_any: boolean,
      selector_entry: dut$symbol_entry,
      selector_number: symbol_no,
      selector_value: integer,
      set_index: 0 .. max_set_element,
      set_array: packed array [0 .. 7] of boolean,
      storage: integer,
      string_index: 1 .. max_string_size,
      string_delimiter_left: string (2),
      string_delimiter_right: string (1),
      string_desc_ptr_pointer: ^^string_descriptor,
      string_value_length: 0..max_string_size,
      subscript_index: clt$string_index,
      symbol_table_address: ^llt$debug_symbol_table,
      symbol_index: symbol_no,
      unique_name: ost$binary_unique_name,
      unpacked_value: value_record,
      value: integer,
      value_length: integer,
      value_string: string (38),
      variable_kind: llt$entry_kind,
      variable_spec: dut$variable_specification,
      variant_entry: dut$symbol_entry,
      vspec: dut$variable_specification,
      vs_current_entry: integer,
      vs_value: clt$data_value;

?? NEWTITLE := '  display_array', EJECT ??
    PROCEDURE display_array (
          variable_spec: dut$variable_specification;
          index_lower_bound: integer;
          index_upper_bound: integer;
          p_variant_selection: ^clt$data_value;
      VAR element_spec: dut$variable_specification;
      VAR status: ost$status );

{ This routine displays a range of elements from an array.  For consecutive
{  duplicate elements, only the first one is displayed.  Display_repeat_count
{  is called for the duplicates.

      VAR
        actual_element_spec: dut$variable_specification,
        array_index: integer,
        string_desc_ptr_pointer: ^^string_descriptor,
        current_value: integer,
        element_kind: llt$entry_kind,
        element_length: ost$segment_length,
        last_index: integer,
        previous_value: integer,
        repeat_count: integer;

      repeat_count := 0;
      last_index := index_upper_bound - index_lower_bound;
      element_kind := element_spec.symbol_entry.symbol^.symbol_kind;
      element_length := element_spec.length;  {length occupied by each element}
{ PASCAL strings element_spec.length is the current length, not total length }
      IF (element_kind = llc$string_kind) AND
         (home_spec.language = llc$pascal) THEN
        element_length := element_spec.max_string_length + 2;
      IFEND;

    /display_elements/
      FOR array_index := 0 TO last_index DO
        IF element_spec.length_is_bits THEN
          element_offset := (element_length * array_index) + variable_spec.bit_offset;
          element_spec.address.offset := variable_spec.address.offset + (element_offset DIV bits_per_byte);
          element_spec.bit_offset := element_offset MOD bits_per_byte;
        ELSE
          element_spec.address.offset := variable_spec.address.offset + (element_length * array_index);
          element_spec.bit_offset := variable_spec.bit_offset;
        IFEND;
{ PASCAL strings have a current length which can vary from element to element }
        IF (element_kind = llc$string_kind) AND
           (home_spec.language = llc$pascal) AND
           (array_index <> 0) THEN
          element_spec.length := element_length;  {Reset max length}
          reduce_cybil_type (home_spec, element_spec, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        IF element_kind <= llc$ordinal_kind THEN
          get_cybil_value (element_spec, current_value, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF (repeat_count > 0) AND (current_value = previous_value) THEN
            repeat_count := repeat_count + 1;
            CYCLE /display_elements/;
          IFEND;
          previous_value := current_value;
        IFEND;
        display_repeat_count (repeat_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        repeat_count := 1;
        element_spec.attribute := duc$variable_value;
        actual_element_spec := element_spec;
        IF (home_spec.language = llc$basic) AND (element_kind = llc$string_kind) THEN
          actual_element_spec.descriptor_address := element_spec.address;
          string_desc_ptr_pointer := #LOC (element_spec.address);
          actual_element_spec.length := string_desc_ptr_pointer^^.length;
          actual_element_spec.address := string_desc_ptr_pointer^^.pva;
        IFEND;
        format_and_display_variable (home_spec, actual_element_spec, NIL, indent_count,
              display_type, p_variant_selection, display_control_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
{ If there is room, tab over 'value_spacer' columns.  Otherwise, go to a new line }
        IF display_control_pointer^.column_number + value_spacer < display_control_pointer^.page_width THEN
          clp$horizontal_tab_display (display_control_pointer^, display_control_pointer^.column_number +
                value_spacer, status);
        ELSE
          clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
        IFEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND /display_elements/;
      display_repeat_count (repeat_count, status);
    PROCEND display_array;
?? TITLE := 'display_repeat_count', EJECT ??

    PROCEDURE display_repeat_count (repeat_count: integer;
      VAR status: ost$status);

{ PURPOSE: Display the string "( n OCCURRENCES)" when n > 1.

      IF repeat_count > 1 THEN
        STRINGREP (value_string, value_length, repeat_count);
        dup$display_string (display_control_pointer, 16 + value_length, ' (', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dup$display_string (display_control_pointer, 1, value_string (1, value_length), indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dup$display_string (display_control_pointer, 1, ' OCCURRENCES) ', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    PROCEND display_repeat_count;
?? OLDTITLE ??
?? EJECT ??
{ Begin procedure format_and_display_variable

{ Display the variable value }

    p_vs_list := p_variant_selection;
    vs_current_entry := 1;

    get_variable_attribute (home_spec, input_variable_spec, storage, variable_spec, status);
    IF NOT status.normal THEN
      IF (status.condition = due$unaligned_pointer) THEN
        dup$display_string (display_control_pointer, 31, '** Variable not byte aligned **', indent_count,
              local_status);
      IFEND;
      RETURN;
    IFEND;

    variable_kind := variable_spec.symbol_entry.symbol^.symbol_kind;
    IF variable_spec.constant_value = TRUE THEN
      dup$display_string (display_control_pointer, 11, '(CONSTANT)', indent_count, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ CYBIL Long constants are the only constants that are not reduced. These are
{  not represented properly in the tables.
      IF variable_kind = llc$constant_kind THEN
        dup$display_string (display_control_pointer, 40, '***CYBIL long constants not available***',
                              indent_count, status);
        RETURN; {we do not get the value of long constants}
      IFEND;
    IFEND; { If this is a constant to be displayed }

{ Display packed array of characters as a string }
    IF (variable_kind = llc$cybil_array_kind) AND
       (variable_spec.symbol_entry.symbol^.cybil_array_packing = llc$packed) THEN
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            cybil_array_element_type, element_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF element_spec.symbol_entry.symbol^.symbol_kind = llc$char_kind THEN
        variable_kind := llc$string_kind;
      IFEND;
    IFEND;
{ See if we need to change the type }
    IF NOT (display_type = duc$natural_type) THEN
      IF NOT (variable_kind IN delay_change_of_type) THEN
{ The variable_kind is one whose type change does not need to be delayed (arrays
{   need to be delayed until we are dealing with the elements).  Change the
{   type now.
        CASE display_type OF
        = duc$integer_type =
          IF (variable_spec.length > 8) OR (variable_spec.length < 1) THEN
            osp$set_status_abnormal (duc$symbolic_id, due$cant_display_as_integer,
              '', status);
            RETURN;
          IFEND;
          variable_kind := llc$integer_kind;
        = duc$real_type =
          IF variable_spec.length <> 8 THEN
            osp$set_status_abnormal (duc$symbolic_id, due$cant_display_as_real,
              '', status);
            RETURN;
          IFEND;
          variable_kind := llc$real_kind;
        CASEND;
      IFEND;
    IFEND;  { If need to change the type from variable's natural type. }

    CASE variable_kind OF
    = llc$integer_kind =
      get_cybil_value (variable_spec, unpacked_value.word_sized_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{If the integer was in a packed structure
      IF variable_spec.length_is_bits AND (variable_spec.range_specified AND (variable_spec.low_value < 0))
            THEN
{If the value was negative, sign-extend it
        IF unpacked_value.bits [64 - variable_spec.length] THEN
          FOR value_length := 0 TO 63 - variable_spec.length DO
            unpacked_value.bits [value_length] := TRUE;
          FOREND;
        IFEND;
      IFEND;
      clp$convert_integer_to_string (unpacked_value.word_sized_value, 16, TRUE, int_string, status);
      value_length := int_string.size;
      IF int_string.value (1) <> ' ' THEN
        dup$display_string (display_control_pointer, 1, ' ', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      dup$display_string (display_control_pointer, value_length, int_string.value (1, value_length),
            indent_count, status);

    = llc$boolean_kind =
      get_cybil_value (variable_spec, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value = false_value THEN
        dup$display_string (display_control_pointer, 6, ' FALSE', indent_count, status);
      ELSEIF value = true_value THEN
        dup$display_string (display_control_pointer, 5, ' TRUE', indent_count, status);
      ELSE
        dup$display_string (display_control_pointer, 28, ' ** INVALID BOOLEAN VALUE **', indent_count,
              status);
      IFEND;

    = llc$char_kind =
      get_cybil_value (variable_spec, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      value_string := ' '' ''';
      IF (value < ORD (smallest_graphic)) OR (value > ORD (largest_graphic)) THEN
        value_string (3) := '?';
      ELSE
        value_string (3) := CHR (value);
      IFEND;
      dup$display_string (display_control_pointer, 4, value_string (1, 4), indent_count, status);

    = llc$real_kind =
      IF variable_spec.bit_offset > 0 THEN
        dup$display_string (display_control_pointer, 20, '** Unaligned real **', indent_count, status);
        RETURN;
      IFEND;
      real_value_pointer := #LOC (variable_spec.address);
      STRINGREP (value_string, value_length, real_value_pointer^^);
      dup$display_string (display_control_pointer, value_length, value_string (1, value_length), indent_count,
            status);

    = llc$longreal_kind =
      longreal_value_pointer := #LOC (variable_spec.address);
      STRINGREP (value_string, value_length, longreal_value_pointer^^);
      dup$display_string (display_control_pointer, value_length, value_string (1, value_length),
        indent_count, status);

    = llc$cell_kind =
      get_cybil_value (variable_spec, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      STRINGREP (value_string, value_length, value: 4: #(16));
      dup$display_string (display_control_pointer, value_length, value_string (1, value_length), indent_count,
            status);

    = llc$ordinal_kind =
      get_cybil_value (variable_spec, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (value < 0) OR (value > variable_spec.symbol_entry.symbol^.ordinal_upper_bound) THEN
        dup$display_string (display_control_pointer, 27, ' ** INVALID ORDINAL VALUE **', indent_count,
              status);
      ELSE
        ordinal_entry := variable_spec.symbol_entry;
        REPEAT
          dup$locate_next_symbol (home_spec.symbol_table_address, ordinal_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        UNTIL value = ordinal_entry.symbol^.short_constant_value.integer_value;
        IF ordinal_entry.symbol^.symbol_name = variable_spec.name THEN
{ If this is one of the ordinal constant symbols, display its integer value.
          STRINGREP (value_string, value_length, value);
        ELSE
          value_length := STRLENGTH (ordinal_entry.symbol^.symbol_name);
          WHILE (value_length > 0) AND (ordinal_entry.symbol^.symbol_name (value_length) = ' ') DO
            value_length := value_length - 1;
          WHILEND;
          value_string(1) := ' ';        {emulate leading blank from STRINGREP}
          value_length := value_length + 1;
          value_string(2,*) := ordinal_entry.symbol^.symbol_name;
        IFEND;
        dup$display_string (display_control_pointer, value_length,
                        value_string (1,value_length), indent_count, status);
      IFEND;

    = llc$proc_kind =
      IF variable_spec.bit_offset > 0 THEN
        dup$display_string (display_control_pointer, 28, '** Unaligned proc pointer **', indent_count,
              status);
        RETURN;
      IFEND;
      dup$find_module_table_for_pva (variable_spec.address, module_item, section_item_index, status);
      IF NOT status.normal THEN
        status.normal := TRUE;
        dup$display_string (display_control_pointer, 27, '** Invalid pointer value **', indent_count, status);
        RETURN;
      IFEND;
      IF module_item^.section_item [section_item_index].kind <> llc$binding_section THEN
        dup$display_string (display_control_pointer, 36, '** Pointer not in binding section **', indent_count,
              status);
        RETURN;
      IFEND;

      pointer_to_procedure := #LOC (variable_spec.descriptor_address);
      code_address.ring := #ring (pointer_to_procedure^^.code_base_pointer_p^.code_pva);
      code_address.seg := #segment (pointer_to_procedure^^.code_base_pointer_p^.code_pva);
      code_address.offset := #offset (pointer_to_procedure^^.code_base_pointer_p^.code_pva);
      dup$find_module_table_for_pva (code_address, module_item, section_item_index, status);
      IF status.normal THEN
        dup$display_string (display_control_pointer, 8, ' MODULE ', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dup$find_procedure_for_pva (module_item, section_item_index, code_address, symbol_table_address,
              symbol_index, status);
        IF status.normal THEN
          value_length := STRLENGTH (symbol_table_address^.original_module_name);
          WHILE (value_length > 1) AND (symbol_table_address^.original_module_name (value_length) = ' ') DO
            value_length := value_length - 1;
          WHILEND;
          dup$display_string (display_control_pointer, value_length, symbol_table_address^.
                original_module_name (1, value_length), indent_count, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          dup$display_string (display_control_pointer, 11, ' PROCEDURE ', indent_count, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          procedure_entry.table_entry_index := symbol_index;
          procedure_entry.symbol := ^symbol_table_address^.item[symbol_index];
          value_length := STRLENGTH (procedure_entry.symbol^.symbol_name);
          WHILE (value_length > 1) AND (procedure_entry.symbol^.symbol_name (value_length) = ' ') DO
            value_length := value_length - 1;
          WHILEND;
          dup$display_string (display_control_pointer, value_length, procedure_entry.symbol^.symbol_name (1,
                value_length), indent_count, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          status.normal := TRUE;
          value_length := STRLENGTH (module_item^.name);
          WHILE (value_length > 1) AND (module_item^.name (value_length) = ' ') DO
            value_length := value_length - 1;
          WHILEND;
          dup$display_string (display_control_pointer, value_length, module_item^.name (1, value_length),
                indent_count, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          dup$display_string (display_control_pointer, 8, ' OFFSET ', indent_count, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          STRINGREP (value_string, value_length, variable_spec.address.offset - module_item^.section_item
                [section_item_index].address.offset);
          dup$display_string (display_control_pointer, value_length, value_string (1, value_length),
                indent_count, status);
        IFEND;
        clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dup$display_string (display_control_pointer, 1, '  Binding pointer = ', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        pointer_pva := #LOC (pointer_to_procedure^^.code_base_pointer_p^.binding_pva);
        STRINGREP (value_string, value_length, pointer_pva^.ring: 2: #(16), pointer_pva^.seg: 4: #(16),
              pointer_pva^.offset: 9: #(16));
        dup$display_string (display_control_pointer, value_length, value_string (1, value_length),
              indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dup$display_string (display_control_pointer, 16, '  Static link = ', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        pointer_pva := #LOC (pointer_to_procedure^^.static_link);
        STRINGREP (value_string, value_length, pointer_pva^.ring: 2: #(16), pointer_pva^.seg: 4: #(16),
              pointer_pva^.offset: 9: #(16));
        dup$display_string (display_control_pointer, value_length, value_string (1, value_length),
              indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        status.normal := TRUE;
        dup$display_string ( display_control_pointer, 24, ' ** NOT IN ANY MODULE **', indent_count, status);
      IFEND;

    = llc$pointer_kind =
      IF variable_spec.bit_offset > 0 THEN
        dup$display_string (display_control_pointer, 23, '** Unaligned pointer **', indent_count, status);
        RETURN;
      IFEND;
      address := variable_spec.address;
      IF home_spec.language = llc$the_c_language THEN
        address.offset := address.offset + 2;
      IFEND;
      dup$get_bytes (address, #LOC(pointer), #SIZE (pointer), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      STRINGREP (value_string, value_length, pointer.ring: 2: #(16), pointer.seg: 4:
            #(16), pointer.offset: 9: #(16));
      dup$display_string (display_control_pointer, value_length, value_string (1, value_length), indent_count,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    = llc$set_kind =
      element_found := FALSE;
      element_spec.name := ' ';
      element_spec.length := #SIZE (element_value);
      element_spec.bit_offset := 0;
      element_spec.length_is_bits := FALSE;
      element_spec.range_specified := FALSE;
      element_value_ptr := ^element_value;

      element_spec.address.ring := osc$invalid_ring {flag local address};
      element_spec.address.seg := #segment (element_value_ptr);
      element_spec.address.offset := #offset (element_value_ptr);
      element_spec.attribute := duc$variable_value;
      element_spec.constant_value := FALSE;

      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            set_element_type, element_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      reduce_cybil_type (home_spec, element_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF variable_spec.length_is_bits THEN
        IF variable_spec.symbol_entry.symbol^.set_length > 57 THEN {mapped as
          {unpacked set}
          IF variable_spec.symbol_entry.symbol^.set_length > (bits_per_byte * bytes_per_word) THEN
            blank_fill := variable_spec.bit_offset;
          ELSE
            blank_fill := variable_spec.bit_offset + variable_spec.length - variable_spec.symbol_entry.
                  symbol^.set_length;
          IFEND;
        ELSE {mapped as packed set}
          blank_fill := variable_spec.bit_offset;
        IFEND;
      ELSE {length in bytes}
        IF variable_spec.length <= bytes_per_word THEN
          blank_fill := variable_spec.bit_offset + (variable_spec.length * bits_per_byte) - variable_spec.
                symbol_entry.symbol^.set_length;
        ELSE
          blank_fill := variable_spec.bit_offset;
        IFEND;
      IFEND;

{ A set is overlayed with a packed array of boolean and examined. }

      FOR set_index := 0 TO variable_spec.symbol_entry.symbol^.set_length - 1 DO
        address := variable_spec.address;
        address.offset := address.offset + (set_index + blank_fill) DIV 8;
        dup$get_bytes (address, #LOC (set_array), #SIZE (set_array), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF set_array [(set_index + blank_fill) MOD 8] THEN
          element_found := TRUE;
          IF element_spec.range_specified THEN
            element_value := element_spec.low_value + set_index;
          ELSE
            element_value := set_index;
          IFEND;
          format_and_display_variable (home_spec, element_spec, NIL, indent_count,
                display_type, p_vs_list, display_control_pointer, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
{ If there is room, tab over 'value_spacer' columns.  Otherwise, go to a new line }
          IF display_control_pointer^.column_number + value_spacer < display_control_pointer^.page_width THEN
            clp$horizontal_tab_display (display_control_pointer^, display_control_pointer^.column_number +
                  value_spacer, status);
          ELSE
            clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      FOREND;

      IF NOT element_found THEN
        dup$display_string (display_control_pointer, 16, ' ** EMPTY SET **', indent_count, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;


    = llc$string_kind =
      IF variable_spec.bit_offset > 0 THEN
        dup$display_string (display_control_pointer, 22, '** Unaligned string **', indent_count, status);
        RETURN;
      IFEND;
      IF (home_spec.language = llc$basic) OR
         (home_spec.language = llc$the_c_language) THEN
        string_delimiter_left := ' "';
        string_delimiter_right := '"';
      ELSE
        string_delimiter_left := ' ''';
        string_delimiter_right := '''';
      IFEND;
      string_value_length := variable_spec.length;
      PUSH copied_string_pointer: [string_value_length];
      address := variable_spec.address;
      dup$get_bytes (address, #LOC (copied_string_pointer^), string_value_length, status);
      IF NOT status.normal THEN
        RETURN; {------->
      IFEND;
      FOR string_index := 1 TO string_value_length DO
        IF (copied_string_pointer^ (string_index) < smallest_graphic) OR (copied_string_pointer^
              (string_index) > largest_graphic) THEN
          copied_string_pointer^ (string_index) := '?';
        IFEND;
      FOREND;
      dup$display_string (display_control_pointer, string_value_length + 3, string_delimiter_left,
          indent_count, status);
      IF NOT status.normal THEN
        RETURN; {------->
      IFEND;
      dup$display_string (display_control_pointer, 1, copied_string_pointer^, indent_count, status);
      IF NOT status.normal THEN
        RETURN; {------>
      IFEND;
{ If the string was longer than the page width, the column num is too big.  Must
{  adjust it so that the terminating quote is in the right place.
      column_number := display_control_pointer^.column_number -
        ( (display_control_pointer^.column_number DIV display_control_pointer^.page_width) *
           display_control_pointer^.page_width );
      IF column_number <> 0 THEN
        display_control_pointer^.column_number := column_number;
      ELSE
        display_control_pointer^.column_number := display_control_pointer^.page_width;
      IFEND;
      dup$display_string (display_control_pointer, 1, string_delimiter_right, indent_count, status);

    = llc$basic_array_kind =
      element_spec.name := '   ';
      element_spec.length := 8;
      element_spec.length_is_bits := FALSE;
      element_spec.range_specified := FALSE;
      element_spec.address := variable_spec.address;
      element_spec.constant_value := FALSE;

{        Note: If the array elements are integers or reals, this is the address
{        of the first array element. If the array elements are strings, this is the
{        address of the descriptor of the first string element of the array.

      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            basic_array_element_type, element_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN; {------>
      IFEND;
       number_of_elements_ptr := #address (variable_spec.descriptor_address.ring,
        variable_spec.descriptor_address.seg, variable_spec.descriptor_address.offset + 8);
       display_array (variable_spec, 1, number_of_elements_ptr^, p_vs_list, element_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    = llc$cybil_array_kind =
      element_spec.name := '   ';
      element_spec.range_specified := FALSE;
      element_spec.address := variable_spec.address;
      element_spec.descriptor_address := variable_spec.descriptor_address;
      element_spec.constant_value := FALSE;

      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            cybil_array_element_type, element_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      reduce_cybil_type (home_spec, element_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      element_spec.length := variable_spec.symbol_entry.symbol^.cybil_array_element_length;
      element_spec.length_is_bits := llc$cybil_array_is_bits IN variable_spec.symbol_entry.symbol^.
            cybil_array_attributes;

      index_spec.range_specified := FALSE;
      index_spec.descriptor_address := variable_spec.descriptor_address;
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            cybil_index_type, index_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      reduce_cybil_type (home_spec, index_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

       display_array (variable_spec, index_spec.low_value, index_spec.high_value,
               p_vs_list, element_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    = llc$pascal_conf_array_kind =
      element_spec.name := '   ';
      element_spec.address := variable_spec.address;
      element_spec.length := variable_spec.symbol_entry.symbol^.conf_array_element_length;
      element_spec.length_is_bits := llc$cybil_array_is_bits IN variable_spec.symbol_entry.symbol^.
            conf_array_attributes;
      element_spec.range_specified := FALSE;
      element_spec.descriptor_address := variable_spec.descriptor_address;
      element_spec.constant_value := FALSE;

      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            conf_array_element_kind, element_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      reduce_cybil_type (home_spec, element_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Get the value of the lower bound }
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.
            symbol^.conf_array_lower_bound, index_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      subscript_index := 1;
      scan_cybil_variable (^index_spec.symbol_entry.symbol^.symbol_name, home_spec, subscript_index,
            index_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      get_cybil_value (index_spec, pca_lower_bound, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
{ Get the value of the upper bound }
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.
            symbol^.conf_array_upper_bound, index_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      subscript_index := 1;
      scan_cybil_variable (^index_spec.symbol_entry.symbol^.symbol_name, home_spec, subscript_index,
            index_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      get_cybil_value (index_spec, pca_upper_bound, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      display_array (variable_spec, pca_lower_bound, pca_upper_bound, p_vs_list, element_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    = llc$record_kind =
      field_number := variable_spec.symbol_entry.symbol^.record_first_field;
      selector_number := variable_spec.symbol_entry.symbol^.record_selector;

      IF (variable_spec.length = #SIZE (unique_name)) AND NOT variable_spec.length_is_bits AND
         ((home_spec.language = llc$cybil) OR (home_spec.language = llc$obsolete_cybil)) AND
         (variable_spec.symbol_entry.symbol^.symbol_name = 'OST$BINARY_UNIQUE_NAME') THEN
        address := variable_spec.address;
        dup$get_bytes (address, #LOC (unique_name), #SIZE(unique_name), status);

        IF status.normal THEN
          pmp$convert_binary_unique_name (unique_name, name, status);
        IFEND;

        IF status.normal THEN
          value_length := STRLENGTH (name);
          WHILE (value_length > 0) AND (name (value_length) = ' ') DO
            value_length := value_length - 1;
          WHILEND;
          value_string (1) := ' ';
          value_string (2, value_length) := name (1, value_length);
          dup$display_string (display_control_pointer, value_length, value_string (1, value_length + 1),
                indent_count, status);
        IFEND;

        IF status.normal THEN
          field_number := 0;
        IFEND;
      IFEND;

    /display_fields/
      WHILE field_number > 0 DO
        dup$locate_symbol_for_number (home_spec.symbol_table_address, field_number, field_spec.symbol_entry,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        field_spec.name := field_spec.symbol_entry.symbol^.symbol_name;
        field_spec.length := field_spec.symbol_entry.symbol^.field_length;
        field_number := field_spec.symbol_entry.symbol^.next_field;
        IF field_spec.length <> 0 THEN
          field_spec.length_is_bits := NOT (llc$field_is_byte_addressable IN field_spec.symbol_entry.symbol^.
                field_attributes);
          field_spec.range_specified := FALSE;
          field_spec.address := variable_spec.address;
          field_spec.descriptor_address := variable_spec.descriptor_address;
          IF field_spec.length_is_bits THEN
            field_offset := variable_spec.bit_offset + field_spec.symbol_entry.symbol^.field_offset;
            field_spec.address.offset := field_spec.address.offset + (field_offset DIV bits_per_byte);
            field_spec.bit_offset := field_offset MOD bits_per_byte;
          ELSE
            field_spec.address.offset := field_spec.address.offset + field_spec.symbol_entry.symbol^.
                  field_offset;
            field_spec.bit_offset := variable_spec.bit_offset;
          IFEND;
          reduce_cybil_type (home_spec, field_spec, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF display_control_pointer^.column_number > indent_count + 1 THEN
            clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
          clp$horizontal_tab_display (display_control_pointer^, indent_count + 2, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          value_string := field_spec.name;
          value_length := 31;
          WHILE value_string(value_length) = ' ' DO
            value_length := value_length - 1;
          WHILEND;
          IF NOT(llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes) THEN
{ For non-case sensitive languages, put the field name out in lower case.  This
{  makes the display look a little nicer.
            FOR i := 1 TO value_length DO
              IF (value_string(i) >= 'A') AND
                 (value_string(i) <= 'Z') THEN
                value_string(i) := $CHAR($INTEGER(value_string(i)) + 20(16));
              IFEND;
            FOREND;
          IFEND;
          value_string(value_length + 1) := ':';
          value_length := value_length + 1;
{ Display the field name followed by a colon.
          dup$display_string (display_control_pointer, value_length,
                   value_string(1,value_length), indent_count, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          field_spec.attribute := duc$variable_value;
          field_spec.constant_value := FALSE;
          format_and_display_variable (home_spec, field_spec, NIL, indent_count + record_indent,
                display_type, p_vs_list, display_control_pointer, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          reduce_cybil_type (home_spec, field_spec, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        IF (field_number = 0) AND (selector_number > 0) THEN
{ Display variant part of record.  If the length of the previous field is
{  non-zero, that field is the tag, and its value determines the format of
{  the variant field.  If the length of the previous field is zero, the
{  VS parameter (if present) is used as the tag.
          select_any := FALSE;
          IF field_spec.length = 0 THEN
{ We have a tagless record }
            IF (p_vs_list = NIL) THEN {no more variant selections left}
              IF display_control_pointer^.column_number > indent_count + 1 THEN
                clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              IFEND;
              clp$horizontal_tab_display (display_control_pointer^, indent_count + 1, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              dup$display_string (display_control_pointer, 67,
                '**VS PARAMETER DOES NOT CONTAIN ENOUGH INFORMATION TO DISPLAY TAGLESS VARIANT**',
                indent_count, status);
              RETURN; {------->
            ELSE {find variant from next variant selection}
              vs_value := p_vs_list^.element_value^;
              err_msg := '';
              CASE vs_value.kind OF
              = clc$integer =
                selector_value := vs_value.integer_value.value;
              = clc$boolean =
                selector_value := $INTEGER(vs_value.boolean_value.value);
              = clc$string =
                selector_value := STRLENGTH (vs_value.string_value^);
                IF (selector_value <> 1) THEN
                  err_msg := '**VARIANT SELECTION NUMBER ';
                  STRINGREP (err_msg(27,*), value_length, vs_current_entry);
                  err_msg(27+value_length,*) := ' IS NOT A SCALAR TYPE**';
                IFEND;
                IF (selector_value > 0) THEN
                  selector_value := $INTEGER(vs_value.string_value^ (1));
                IFEND;
              = clc$name =
                ordinal_entry := field_spec.symbol_entry;
                IF (vs_value.name_value = 'TRUE') THEN
                  selector_value := 1;    { TRUE value }
                ELSEIF (vs_value.name_value = 'FALSE') THEN
                  selector_value := 0;    { FALSE value }
                ELSEIF (vs_value.name_value = '$FIRST') THEN
                  select_any := TRUE;     { any selection will do
                ELSEIF ordinal_entry.symbol^.symbol_kind <> llc$ordinal_kind THEN
                  err_msg := '**VARIANT SELECTION NUMBER ';
                  STRINGREP (err_msg(27,*), value_length, vs_current_entry);
                  err_msg(27+value_length,*) := ' IS THE WRONG TYPE** ';
                ELSE { the vs specified is an ordinal and should be }
                  symbol_index := ordinal_entry.symbol^.last_constant;
/ordinal_search/
                  BEGIN
                    REPEAT
                      dup$locate_next_symbol (home_spec.symbol_table_address, ordinal_entry, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;
                      IF (ordinal_entry.symbol^.symbol_name = vs_value.name_value) THEN
                        selector_value := ordinal_entry.symbol^.short_constant_value.integer_value;
                        EXIT /ordinal_search/;
                      IFEND;
                    UNTIL ordinal_entry.symbol^.symbol_number = symbol_index;
                    err_msg := '**VARIANT SELECTION NUMBER ';
                    STRINGREP (err_msg(27,*), value_length, vs_current_entry);
                    err_msg(27+value_length,*) := ', ORDINAL NOT FOUND** ';
                  END /ordinal_search/;
                IFEND;
              ELSE  { Illegal type for VS parameter }
                err_msg := '**VARIANT SELECTION NUMBER ';
                STRINGREP (err_msg(27,*), value_length, vs_current_entry);
                err_msg(27+value_length,*) := ' IS NOT A SCALAR TYPE**';
              CASEND;
              IF err_msg <> '' THEN
                IF display_control_pointer^.column_number > indent_count + 1 THEN
                  clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;
                IFEND;
                clp$horizontal_tab_display (display_control_pointer^, indent_count + 1, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                dup$display_string (display_control_pointer, 50+value_length, err_msg,
                   indent_count, status);
                RETURN; {------->
              IFEND;
              vs_current_entry := vs_current_entry + 1;
              p_vs_list := p_vs_list^.link;
            IFEND;
          ELSE  { here if there is a tag field }
            get_cybil_value (field_spec, selector_value, status); {last
            {field is selector}
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;

/find_variant/
          REPEAT
            dup$locate_symbol_for_number (home_spec.symbol_table_address,
                                     selector_number, selector_entry, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF (select_any = TRUE) OR
               ((selector_entry.symbol^.low_selector <= selector_value) AND
               (selector_entry.symbol^.high_selector >= selector_value)) THEN
              dup$locate_symbol_for_number (home_spec.symbol_table_address,
                      selector_entry.symbol^.variation, variant_entry, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              field_number := variant_entry.symbol^.record_first_field;
              selector_number := variant_entry.symbol^.record_selector;
              EXIT /find_variant/;
            IFEND;
            selector_number := selector_entry.symbol^.next_selector;
          UNTIL selector_number = 0; {/find_variant/}
          IF (field_number = 0) AND
             (field_spec.length = 0) THEN
            IF display_control_pointer^.column_number > indent_count + 1 THEN
              clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
            clp$horizontal_tab_display (display_control_pointer^, indent_count + 1, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            err_msg := '**VARIANT SELECTION NUMBER ';
            STRINGREP (err_msg(27,*), value_length, vs_current_entry-1);
            err_msg(27+value_length,*) := ' IS OUT OF RANGE**';
            dup$display_string (display_control_pointer, 45+value_length, err_msg,
                   indent_count, status);
            RETURN; {------->
          IFEND;
        IFEND;  { If there is a variant portion of the record }
      WHILEND /display_fields/;

      IF ((home_spec.language = llc$cybil) OR (home_spec.language = llc$obsolete_cybil)) AND
        (i#compare_collated (variable_spec.symbol_entry.symbol^.symbol_name,'OST$STATUS',
        osv$lower_to_upper) = 0) THEN
          address := variable_spec.address;
          dup$get_bytes (address, #LOC (local_status), #SIZE (local_status), status);
          IF (status.normal AND NOT local_status.normal) THEN
          osp$format_message (local_status, osc$full_message_level,
            display_control_pointer^.page_width, message, status);
          IF status.normal THEN
            clp$put_partial_display (display_control_pointer^, '',
              clc$no_trim, amc$terminate, status);
            IF NOT status.normal THEN
              status.normal := TRUE;
              return; {------->
            IFEND;
            osp$set_status_abnormal (duc$symbolic_id,
              due$formatted_status_is, osc$null_name, local_status1);
            dup$output_message (local_status1, display_control_pointer,
              status);
            IF NOT status.normal THEN
              status.normal := TRUE;
              return; {------->
            IFEND;
            message_area := ^message;
            RESET message_area;
            NEXT message_line_count IN message_area;
            FOR message_line_index := 1 TO message_line_count^ DO
              NEXT message_line_size IN message_area;
              NEXT message_line: [message_line_size^] IN message_area;
              clp$put_display (display_control_pointer^, message_line^, clc$no_trim, status);
              IF NOT status.normal THEN
                status.normal := TRUE;
                return; {------->
              IFEND;
           FOREND;
           IFEND;
         IFEND;
       IFEND;

    = llc$heap_kind =
      dup$display_string (display_control_pointer, 11, ' ** HEAP **', indent_count, status);

    = llc$seq_kind =
      dup$display_string (display_control_pointer, 15, ' ** SEQUENCE **', indent_count, status);

    = llc$rel_ptr_kind =
      vspec := variable_spec;
      vspec.length := 4;
      get_cybil_value (vspec, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      STRINGREP (value_string, value_length, value: : #(16));
      dup$display_string (display_control_pointer, value_length,
                  value_string(1, value_length), indent_count, status);
      dup$display_string (display_control_pointer, 4, '(16)', indent_count, status);

    = llc$pascal_file_kind =

{ Pascal files are of the following format :
{                  eof: boolean, (1 byte)
{                  eol: boolean, (1 byte)
{                  mode: 0=null,1=read,2=write (1 byte)
{                  other stuff: ?  (1 byte)
{                  empty: boolean, (1 byte)
{                  buffer_defined: boolean, (1 byte)
{                  buffer: buffer type (any type)

      element_spec := variable_spec;
      clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Display EOF information }
      dup$display_string (display_control_pointer, 8, '   EOF: ',
              indent_count + record_indent, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      pascal_file_ptr := #LOC(element_spec.address);
      IF pascal_file_ptr^^ = TRUE THEN
        dup$display_string (display_control_pointer, 6, ' TRUE ', indent_count, status);
      ELSE
        dup$display_string (display_control_pointer, 6, ' FALSE', indent_count, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Display EOL information }
      clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dup$display_string (display_control_pointer, 8, '   EOL: ',
                 indent_count + record_indent, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      element_spec.address.offset := element_spec.address.offset + 1;
      pascal_file_ptr := #LOC(element_spec.address);
      IF pascal_file_ptr^^ = TRUE THEN
        dup$display_string (display_control_pointer, 6, ' TRUE ', indent_count, status);
      ELSE
        dup$display_string (display_control_pointer, 6, ' FALSE', indent_count, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Display mode information }
      clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dup$display_string (display_control_pointer, 8, '  MODE: ',
                 indent_count + record_indent, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      element_spec.address.offset := element_spec.address.offset + 1;
      pascal_file_ptr2 := #LOC(element_spec.address);
      IF pascal_file_ptr2^^ = 1 THEN
        dup$display_string (display_control_pointer, 6, ' READ ', indent_count, status);
      ELSEIF pascal_file_ptr2^^ = 2 THEN
        dup$display_string (display_control_pointer, 6, ' WRITE', indent_count, status);
      ELSEIF pascal_file_ptr2^^ = 3 THEN
        dup$display_string (display_control_pointer, 4, ' R/W', indent_count, status);
      ELSE
        dup$display_string (display_control_pointer, 10, ' UNDEFINED', indent_count, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ Display Empty information }
      clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dup$display_string (display_control_pointer, 8, ' EMPTY: ',
                 indent_count + record_indent, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      element_spec.address.offset := element_spec.address.offset + 2;
      pascal_file_ptr := #LOC(element_spec.address);
      IF pascal_file_ptr^^ = TRUE THEN
        dup$display_string (display_control_pointer, 6, ' TRUE ', indent_count, status);
      ELSE
        dup$display_string (display_control_pointer, 6, ' FALSE', indent_count, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
{ If the buffer is defined, display it }
      clp$new_display_line (display_control_pointer^, clc$next_display_line, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dup$display_string (display_control_pointer, 8, 'BUFFER: ',
                    indent_count + record_indent, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      element_spec.address.offset := element_spec.address.offset + 1;
{ Check the buffer defined byte }
      pascal_file_ptr2 := #LOC(element_spec.address);
      IF pascal_file_ptr2^^ = 1 THEN
{ Display the buffer }
        element_spec.address.offset := element_spec.address.offset + 1;
        element_spec.length := element_spec.length - 6;
        element_spec.name := ' ';
        dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
              buffer_type, element_spec.symbol_entry, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        reduce_cybil_type (home_spec, element_spec, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        format_and_display_variable (home_spec, element_spec, NIL, indent_count,
                  display_type, p_vs_list, display_control_pointer, status);
      ELSE
        dup$display_string (display_control_pointer, 13, '**UNDEFINED**',
                 indent_count + record_indent, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSE
      dup$display_string (display_control_pointer, 26, '** UNEXPECTED DATA TYPE **', indent_count, status);
    CASEND;
  PROCEND format_and_display_variable;
?? TITLE := 'get_adaptable_bounds', EJECT ??

  PROCEDURE get_adaptable_bounds (home_spec: dut$home_specification;
        variable_name: pmt$program_name;
        index_type: llt$symbol_number;
        parameter_value: ^string ( * );
    VAR parameter_index: {input, output} clt$string_index;
    VAR lower_bound: integer;
    VAR upper_bound: integer;
    VAR status: ost$status);

    VAR
      bounds_specified: boolean,
      index_symbol: dut$symbol_entry,
      spaces: boolean,
      token: clt$lexical_token;

    dup$locate_symbol_for_number (home_spec.symbol_table_address, index_type, index_symbol, status);

    IF status.normal AND (index_symbol.symbol^.symbol_kind <> llc$subrange_kind) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_subscript_type, '', status);
    IFEND;

    IF status.normal THEN
      clp$evaluate_token (parameter_value^, scan_options, parameter_index, spaces, token, status);
    IFEND;

    bounds_specified := FALSE;
    IF status.normal THEN
      IF (token.kind = clc$left_bracket_token) THEN
        clp$evaluate_token (parameter_value^, scan_options, parameter_index, spaces, token, status);

        IF status.normal THEN
          IF (token.kind = clc$unsigned_integer_token) OR (token.kind = clc$signed_integer_token) THEN
            lower_bound := token.int.value;
            clp$evaluate_token (parameter_value^, scan_options, parameter_index, spaces, token, status);
          ELSE
            osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_name, status);
          IFEND;
        IFEND;

        IF status.normal AND (token.kind = clc$ellipsis_token) THEN
          bounds_specified := TRUE;
          clp$evaluate_token (parameter_value^, scan_options, parameter_index, spaces, token, status);

          IF status.normal THEN
            IF (token.kind = clc$unsigned_integer_token) OR (token.kind = clc$signed_integer_token) THEN
              upper_bound := token.int.value;
              clp$evaluate_token (parameter_value^, scan_options, parameter_index, spaces, token, status);
            ELSE
              osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_name, status);
            IFEND;
          IFEND;
        IFEND;

        IF status.normal AND (token.kind <> clc$right_bracket_token) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_name, status);
        IFEND;

      ELSE {no fixer - default to 1 element}
        lower_bound := 1;
        parameter_index := parameter_index - token.text_size;
      IFEND;
    IFEND;

    IF status.normal THEN
      IF bounds_specified THEN
        IF (index_symbol.symbol^.low_value_type <> llc$adaptable_length) AND
           (index_symbol.symbol^.low_value <> lower_bound) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$lowerbound_mismatch, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, index_symbol.symbol^.low_value, 10,
               FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, lower_bound, 10, FALSE, status);
        IFEND;
        IF (index_symbol.symbol^.high_value_type <> llc$adaptable_length) AND
           (index_symbol.symbol^.high_value <> upper_bound) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$upperbound_mismatch, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, index_symbol.symbol^.high_value, 10,
               FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, upper_bound, 10, FALSE, status);
        IFEND;
      ELSEIF (index_symbol.symbol^.low_value_type <> llc$adaptable_length) THEN
        upper_bound := index_symbol.symbol^.low_value + lower_bound - 1;
        lower_bound := index_symbol.symbol^.low_value;
      ELSEIF (index_symbol.symbol^.high_value_type <> llc$adaptable_length) THEN
        lower_bound := index_symbol.symbol^.high_value - lower_bound + 1;
        upper_bound := index_symbol.symbol^.high_value;
      ELSE
        upper_bound := lower_bound;
        lower_bound := 1;
      IFEND;
    IFEND;
  PROCEND get_adaptable_bounds;
?? TITLE := 'get_basic_variable_value', EJECT ??

  PROCEDURE get_basic_variable_value ( variable_name: ^string ( * );
        home_spec: dut$home_specification;
    VAR p_value: ^clt$data_value;
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Basic', status);
  PROCEND get_basic_variable_value;
?? TITLE := 'get_cybil_value', EJECT ??
{ Get the current program value for variables that are 8 or less bytes.

  PROCEDURE get_cybil_value (variable_spec: dut$variable_specification;
    VAR value: integer;
    VAR status: ost$status);

    VAR
      p_value: ^cell,
      ring: ost$ring,
      segment: ost$segment,
      offset: ost$segment_offset,
      source: ost$pva,
      length: integer,
      right_fill: 0 .. bits_per_byte;

    IF variable_spec.length_is_bits THEN
      length := (variable_spec.length + variable_spec.bit_offset + bits_per_byte - 1) DIV bits_per_byte;
      right_fill := bits_per_byte - ((variable_spec.length + variable_spec.bit_offset) MOD bits_per_byte);
      IF right_fill = bits_per_byte THEN
        right_fill := 0;
      IFEND;
    ELSE
      IF variable_spec.bit_offset = 0 THEN
        length := variable_spec.length;
        right_fill := 0;
      ELSE
        length := variable_spec.length + 1;
        right_fill := bits_per_byte - variable_spec.bit_offset;
      IFEND;
    IFEND;

    value := 0;
    IF (length <= 8) THEN
      p_value := #LOC (value);
      ring := #RING (p_value);
      segment := #SEGMENT (p_value);
      offset := #OFFSET (p_value);
      offset := offset + 8 - length;
      source := variable_spec.address;
      dup$get_bytes (source, #ADDRESS (ring, segment, offset), length, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$internal_error,
            'get_cybil_value called for variable larger than one word', status);
      RETURN;
    IFEND;

    IF right_fill > 0 THEN {right shift}
      value := value DIV powers_of_two [right_fill];
    IFEND;
    IF variable_spec.length_is_bits THEN {isolate value}
      value := value MOD powers_of_two [variable_spec.length];
    ELSEIF variable_spec.bit_offset > 0 THEN
      value := value MOD powers_of_two [variable_spec.length * bits_per_byte];
    IFEND;

  PROCEND get_cybil_value;
?? TITLE := 'get_cybil_variable_value', EJECT ??

  PROCEDURE get_cybil_variable_value (
        variable_name: ^string ( * );
        home_spec: dut$home_specification;
        display_type: dut$display_type;
    VAR p_work: ^clt$work_area;
    VAR p_value: ^clt$data_value;
    VAR status: ost$status);

    VAR
      local_home_spec: dut$home_specification,
      value_index: clt$string_index,
      variable_spec: dut$variable_specification;

    local_home_spec := home_spec;
    CASE home_spec.language OF
    = llc$cybil, llc$obsolete_cybil,
      llc$pascal =
      value_index := 1;
      scan_cybil_variable (variable_name, home_spec, value_index, variable_spec, status);
    = llc$the_c_language =
      value_index := 1;
{ If we are dealing with a global variable, home_spec will change
      scan_c_variable (variable_name, local_home_spec, value_index,
           variable_spec, status);
    ELSE
      scan_universal_variable (variable_name, home_spec, variable_spec,
                   status);
    CASEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    get_variable_value (variable_name, variable_spec, local_home_spec, display_type, p_work, p_value,
          status);
  PROCEND get_cybil_variable_value;
?? TITLE := 'get_fortran_variable_value', EJECT ??

  PROCEDURE get_fortran_variable_value (variable_name: ^string ( * );
        home_spec: dut$home_specification;
    VAR p_value: ^clt$data_value;
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Fortran', status);
  PROCEND get_fortran_variable_value;
?? TITLE := 'get_index_value', EJECT ??

  PROCEDURE get_index_value (VAR home_spec: dut$home_specification;
        variable_name: pmt$program_name;
        index_symbol: dut$symbol_entry;
        parameter_value: ^string ( * );
    VAR parameter_index: {input, output} clt$string_index;
    VAR index_value: integer;
    VAR status: ost$status);

    VAR
      index_variable: dut$variable_specification,
      ordinal_entry: dut$symbol_entry,
      ordinal_token: string (osc$max_name_size),
      scan_index: clt$string_index,
      scan_length: integer,
      spaces_preceded_token: boolean,
      subscript_is_constant: boolean,
      subscript_length: clt$string_size,
      token: clt$lexical_token;

    { Parse index value from input }

    scan_length := STRLENGTH (parameter_value^) - parameter_index + 1;
    scan_index := 1;
    clp$evaluate_token (parameter_value^ (parameter_index, scan_length), scan_options,
            scan_index, spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Interpret input value according to index type }

    subscript_is_constant := FALSE;
    CASE index_symbol.symbol^.symbol_kind OF
    = llc$integer_kind =
      IF (token.kind = clc$unsigned_integer_token) OR (token.kind = clc$signed_integer_token) THEN
        subscript_is_constant := TRUE;
        index_value := token.int.value;
      IFEND;

    = llc$boolean_kind =
      IF token.kind = clc$simple_name_token THEN
        IF (token.str.size = 4) AND (token.str.value(1,4) = 'TRUE') THEN
          subscript_is_constant := TRUE;
          index_value := true_value;
        ELSEIF (token.str.size = 5) AND (token.str.value(1,5) = 'FALSE') THEN
          subscript_is_constant := TRUE;
          index_value := false_value;
        IFEND;
      IFEND;

    = llc$char_kind =
      IF token.kind = clc$string_token THEN
        IF token.str.size = 1 THEN
          subscript_is_constant := TRUE;
          index_value := ORD (token.str.value (1));
        IFEND;
      IFEND;

    = llc$ordinal_kind =
      IF (token.kind = clc$simple_name_token) OR (token.kind = clc$cybil_name_token) THEN
        ordinal_entry := index_symbol; { ordinal values follow the ordinal entry }

      /search_ordinal_values/
        REPEAT
          dup$locate_next_symbol (home_spec.symbol_table_address, ordinal_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes THEN
            ordinal_token := parameter_value^(parameter_index, token.str.size);
          ELSE
            ordinal_token := token.str.value(1, token.str.size);
          IFEND;
          IF ordinal_token = ordinal_entry.symbol^.symbol_name THEN
            subscript_is_constant := TRUE;
            IF ordinal_entry.symbol^.constant_kind = llc$short_constant THEN
              index_value := ordinal_entry.symbol^.short_constant_value.integer_value;
            ELSE { assume medium constant }
              index_value := ordinal_entry.symbol^.medium_constant_value.integer_value;
            IFEND;
            EXIT /search_ordinal_values/;
          IFEND;
        UNTIL ordinal_entry.symbol^.symbol_number = index_symbol.symbol^.last_constant;
      IFEND;

    ELSE
    CASEND;

    { Use constant value or get value of variable index }

    IF subscript_is_constant THEN
      parameter_index := parameter_index + scan_index - 1;
    ELSE {may be a variable reference}
      find_end_of_subscript (parameter_value^(parameter_index, scan_length), subscript_length);
      IF subscript_length = 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_name, status);
        RETURN;
      IFEND;
      IF home_spec.language = llc$the_c_language THEN
        scan_c_variable (^parameter_value^(1,parameter_index + subscript_length - 1),
              home_spec, parameter_index, index_variable, status);
      ELSE
        scan_cybil_variable (^parameter_value^(1,parameter_index + subscript_length - 1),
              home_spec, parameter_index, index_variable, status);
      IFEND;

      IF NOT status.normal THEN
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_type_for_subscript, variable_name, status);
        RETURN;
      IFEND;

      IF index_variable.symbol_entry.symbol <> index_symbol.symbol THEN

        { For simple types, allow the index if the symbol_kinds are equal }

        IF (NOT(index_variable.symbol_entry.symbol^.symbol_kind IN simple_types)) OR
           (index_variable.symbol_entry.symbol^.symbol_kind <> index_symbol.symbol^.symbol_kind) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$invalid_type_for_subscript, variable_name, status);
          RETURN;
        IFEND;
      IFEND;
      get_cybil_value (index_variable, index_value, status);
    IFEND;
  PROCEND get_index_value;
?? TITLE := 'get_trimmed_name', EJECT ??

  PROCEDURE get_trimmed_name (p_name: ^ost$name;
    VAR p_trimmed_name: ^clt$string_value);

    VAR
      size: integer;

    size := 0;
    IF (p_name <> NIL) AND (p_name^ (1) <> ' ') THEN
      size := STRLENGTH (p_name^);
      WHILE (p_name^ (size) = ' ') DO
        size := size - 1;
      WHILEND;
    IFEND;
    IF (size > 0) THEN
      p_trimmed_name := ^p_name^ (1, size);
    ELSE
      p_trimmed_name := NIL;
    IFEND;
  PROCEND get_trimmed_name;
?? TITLE := 'get_value_string', EJECT ??

  PROCEDURE get_value_string (p_value: ^clt$data_value;
    VAR p_work_area: {input, output} ^SEQ (*);
    VAR p_string: ^clt$string_value);

    VAR
      length: clt$string_size,
      status: ost$status,
      str: ost$string;

    IF (p_value = NIL) THEN
       p_string := NIL;
    ELSE
      CASE p_value^.kind OF

      = clc$application =
        p_string := p_value^.application_value;

      = clc$cobol_name =
        get_trimmed_name (^p_value^.cobol_name_value, p_string);

      = clc$data_name =
        get_trimmed_name (^p_value^.data_name_value, p_string);

      = clc$file =
        p_string := p_value^.file_value;

      = clc$integer =
        clp$convert_integer_to_string (p_value^.integer_value.value, p_value^.integer_value.radix,
              p_value^.integer_value.radix_specified, str, status);
        length := str.size;
        NEXT p_string: [length] IN p_work_area;
        IF (p_string <> NIL) THEN
          p_string^ := str.value (1, length);
          IF (str.value (1) = ' ') THEN
            p_string := ^p_string^ (2, length - 1);
          IFEND;
        IFEND;

      = clc$keyword =
        get_trimmed_name (^p_value^.keyword_value, p_string);

      = clc$name =
        get_trimmed_name (^p_value^.name_value, p_string);

      = clc$program_name =
        get_trimmed_name (^p_value^.program_name_value, p_string);

      = clc$string =
        p_string := p_value^.string_value;

      ELSE
        p_string := NIL;
      CASEND;
    IFEND;
  PROCEND get_value_string;
?? TITLE := 'get_variable_attribute', EJECT ??

  PROCEDURE get_variable_attribute (home_spec: dut$home_specification;
        variable_spec: dut$variable_specification;
    VAR storage: integer;
    VAR attribute_spec: dut$variable_specification;
    VAR status: ost$status);

    VAR
      address: ost$pva,
      integer_symbol: [STATIC] llt$symbol_table_item,
      length: integer,
      pointer_symbol: [STATIC] llt$symbol_table_item,
      scalars: [STATIC, READ] SET OF llt$entry_kind := [llc$integer_kind, llc$boolean_kind,
            llc$char_kind, llc$cell_kind, llc$ordinal_kind, llc$subrange_kind];

    status.normal := TRUE;
    attribute_spec := variable_spec;
    length := 8;

    IF (variable_spec.attribute = duc$variable_value) THEN
      RETURN;
    IFEND;

    CASE variable_spec.attribute OF

    = duc$variable_address =
      IF variable_spec.bit_offset > 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$unaligned_pointer, variable_spec.name, status);
        RETURN;
      IFEND;

      pointer_symbol.symbol_name := '';
      pointer_symbol.symbol_number := UPPERVALUE (llt$symbol_number);
      pointer_symbol.end_of_chain := TRUE;
      pointer_symbol.symbol_kind := llc$pointer_kind;
      pointer_symbol.ptr_type := UPPERVALUE (llt$symbol_number);
      pointer_symbol.ptr_object_length := 0;

      attribute_spec.symbol_entry.table_entry_index := UPPERVALUE (llt$symbol_number);
      attribute_spec.symbol_entry.symbol := ^pointer_symbol;

      address := variable_spec.address;
      storage := 100000000000(16) * address.ring + 100000000(16) * address.seg + address.offset;
      IF (home_spec.language <> llc$the_c_language) THEN
        length := 6;
      IFEND;

    = duc$variable_size =
      integer_symbol.symbol_name := '';
      integer_symbol.symbol_number := UPPERVALUE (llt$symbol_number);
      integer_symbol.end_of_chain := TRUE;
      integer_symbol.symbol_kind := llc$integer_kind;

      attribute_spec.symbol_entry.table_entry_index := UPPERVALUE (llt$symbol_number);
      attribute_spec.symbol_entry.symbol := ^integer_symbol;

      IF variable_spec.length_is_bits THEN
        storage := (variable_spec.length + 7) DIV 8;
      ELSE
        storage := variable_spec.length;
      IFEND;

    = duc$variable_lower_bound, duc$variable_upper_bound =
      IF (variable_spec.symbol_entry.symbol^.symbol_kind <> llc$cybil_array_kind) THEN
        IF (variable_spec.attribute = duc$variable_lower_bound) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$lowerbound_non_array, '', status);
        ELSE
          osp$set_status_abnormal (duc$symbolic_id, due$upperbound_non_array, '', status);
        IFEND;
        RETURN;
      IFEND;

      dup$locate_symbol_for_number (home_spec.symbol_table_address, attribute_spec.symbol_entry.symbol^.
            cybil_index_type, attribute_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      reduce_cybil_type (home_spec, attribute_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (variable_spec.attribute = duc$variable_lower_bound) THEN
        storage := attribute_spec.low_value;
      ELSE
        storage := attribute_spec.high_value;
      IFEND;

    = duc$variable_lower_value, duc$variable_upper_value =
      IF NOT (variable_spec.symbol_entry.symbol^.symbol_kind IN scalars) THEN
        IF (variable_spec.attribute = duc$variable_lower_value) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$lowervalue_non_scalar, '', status);
        ELSE
          osp$set_status_abnormal (duc$symbolic_id, due$uppervalue_non_scalar, '', status);
        IFEND;
        RETURN;
      IFEND;

      IF variable_spec.constant_value THEN
        get_cybil_value (variable_spec, storage, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSEIF (variable_spec.attribute = duc$variable_lower_value) THEN
        storage := attribute_spec.low_value;
      ELSE
        storage := attribute_spec.high_value;
      IFEND;

    ELSE
    CASEND;

    attribute_spec.attribute := duc$variable_value;
    attribute_spec.length := length;
    attribute_spec.bit_offset := 0;
    attribute_spec.length_is_bits := FALSE;
    attribute_spec.address.ring := osc$invalid_ring {flag local address};
    attribute_spec.address.seg := #SEGMENT (^storage);
    attribute_spec.address.offset := #OFFSET (^storage) + #SIZE (storage) - length;
  PROCEND get_variable_attribute;
?? TITLE := 'get_variable_spec', EJECT ??

  PROCEDURE get_variable_spec (home_spec: dut$home_specification;
        name: pmt$program_name;
        p_text: ^string (*);
        address_wanted: boolean;
    VAR text_index: {input, output} clt$string_index;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

    CONST
      lower_bound_function = 'LOWERBOUND                     ',
      lower_value_function = 'LOWERVALUE                     ',
      size_function = '#SIZE                          ',
      upper_bound_function = 'UPPERBOUND                     ',
      upper_value_function = 'UPPERVALUE                     ';

    VAR
      attribute: dut$variable_attribute,
      index: clt$string_index,
      nested: boolean,
      open_paren_count: integer,
      options: [STATIC] dut$variable_search_options := [duc$search_outer_procedures,
                                                        duc$search_module_level],
      p_param: ^string (*),
      param_start: clt$string_index,
      proc_entry: dut$symbol_entry,
      spaces: boolean,
      symbol_entry: dut$symbol_entry,
      text_size: clt$string_size,
      token: clt$lexical_token;

    IF (name = size_function) THEN
      attribute := duc$variable_size;
    ELSEIF (name = lower_bound_function) THEN
      attribute := duc$variable_lower_bound;
    ELSEIF (name = upper_bound_function) THEN
      attribute := duc$variable_upper_bound;
    ELSEIF (name = lower_value_function) THEN
      attribute := duc$variable_lower_value;
    ELSEIF (name = upper_value_function) THEN
      attribute := duc$variable_upper_value;
    ELSEIF address_wanted THEN
      attribute := duc$variable_address;
    ELSE
      attribute := duc$variable_value;
    IFEND;

    IF address_wanted AND (attribute <> duc$variable_address) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$invalid_address_constructor, '', status);
      RETURN;
    IFEND;

    IF (attribute = duc$variable_value) OR (attribute = duc$variable_address) THEN
      variable_spec.attribute := attribute;
      dup$locate_variable_symbol (name, home_spec, options, symbol_entry, nested, proc_entry, status);

      IF status.normal THEN
        dup$build_variable_spec (home_spec, symbol_entry, nested, proc_entry, variable_spec, status);
      IFEND;
    ELSE {attribute wanted}
      clp$evaluate_token (p_text^, scan_options, text_index, spaces, token, status);

      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (token.kind <> clc$left_parenthesis_token) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$missing_function_parameters, name, status);
        RETURN;
      IFEND;

      text_size := STRLENGTH (p_text^);
      param_start := text_index;
      open_paren_count := 1;
      WHILE (text_index <= text_size) AND (open_paren_count > 0) DO
        IF (p_text^ (text_index) = ')') THEN
          open_paren_count := open_paren_count - 1;
        ELSEIF (p_text^ (text_index) = '(') THEN
          open_paren_count := open_paren_count + 1;
        IFEND;
        text_index := text_index + 1;
      WHILEND;

      IF (open_paren_count <> 0) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$unbalanced_function_parens, name, status);
        RETURN;
      ELSEIF (text_index <= text_size) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$expression_end_expected,
              p_text^ (text_index, *), status);
        RETURN;
      IFEND;

      p_param := ^p_text^ (param_start, text_index - param_start - 1);
      index := 1;
      scan_cybil_variable (p_param, home_spec, index, variable_spec, status);

      IF status.normal THEN
        IF (variable_spec.attribute = duc$variable_value) THEN
          variable_spec.attribute := attribute;
        ELSE
          osp$set_status_abnormal (duc$symbolic_id, due$invalid_function_nesting, '', status);
        IFEND;
      IFEND;
    IFEND;
  PROCEND get_variable_spec;
?? TITLE := 'get_variable_value', EJECT ??

  PROCEDURE get_variable_value (
        variable_name: ^string ( * );
        input_variable_spec: dut$variable_specification;
        home_spec: dut$home_specification;
        display_type: dut$display_type;
    VAR p_work: ^clt$work_area;
    VAR p_value: ^clt$data_value;
    VAR status: ost$status);

{     This routine is called by several languages to return the variable value
{      given a variable_spec.  Special types for FORTRAN and COBOL are not
{      included here.

    VAR
      address: ost$pva,
      address_of_leftmost_part: ost$pva,
      address_of_rightmost_part: ost$pva,
      converter: ptr_pva_conversion,
      pointer: 0 .. 0ffffffffffff(16),
      program_value: integer,
      real_value_pointer: ^^real,
      real_var: real,
      storage: integer,
      temporary_value: integer,
      unique_name: ost$binary_unique_name,
      value_of_leftmost_part_ptr: ^real,
      value_of_rightmost_part_ptr: ^real,
      var_sym_entry: dut$symbol_entry,
      variable_kind: llt$entry_kind,
      variable_spec: dut$variable_specification;

    get_variable_attribute (home_spec, input_variable_spec, storage, variable_spec, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ For constants, we need to find out what kind of constant it is. }

    variable_kind := variable_spec.symbol_entry.symbol^.symbol_kind;
    var_sym_entry := variable_spec.symbol_entry;
    IF variable_kind = llc$constant_kind THEN
      IF (variable_spec.symbol_entry.symbol^.constant_kind = llc$long_constant) AND
         ((home_spec.symbol_table_address^.language = llc$cybil) OR
         (home_spec.symbol_table_address^.language = llc$obsolete_cybil)) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$parms_only_message,
               '***CYBIL long constants not available***', status);
        RETURN; {we cannot get the value of CYBIL long constants}
      IFEND;
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            constant_type, var_sym_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      variable_kind := var_sym_entry.symbol^.symbol_kind;
      IF (variable_kind = llc$bit_kind) THEN
        variable_kind := llc$integer_kind; { bit constants will display as integers}
      IFEND;
      IF (variable_kind = llc$ordinal_kind) AND
         ((variable_spec.symbol_entry.symbol^.symbol_number > var_sym_entry.symbol^.symbol_number) AND
          (variable_spec.symbol_entry.symbol^.symbol_number <= var_sym_entry.symbol^.last_constant)) THEN
        variable_kind := llc$integer_kind; { ordinal member constants will display as integers}
      IFEND;
    IFEND;

    IF (display_type = duc$integer_type) THEN
      variable_kind := llc$integer_kind;
    IFEND;

    NEXT p_value IN p_work;

    CASE variable_kind OF

    = llc$integer_kind =

      get_cybil_value (variable_spec, program_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_value^.kind := clc$integer;
      p_value^.integer_value.value := program_value;
      p_value^.integer_value.radix := 16;
      p_value^.integer_value.radix_specified := TRUE;

    = llc$boolean_kind =

      get_cybil_value (variable_spec, program_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (program_value = false_value) OR (program_value = true_value) THEN
        p_value^.kind := clc$boolean;
        p_value^.boolean_value.value := (program_value = true_value);
        p_value^.boolean_value.kind := clc$true_false_boolean;
      ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_boolean_value,
              variable_name^, status);
      IFEND;

    = llc$char_kind =

      get_cybil_value (variable_spec, program_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_value^.kind := clc$string;
      NEXT p_value^.string_value: [1] IN p_work;
      p_value^.string_value^ (1) := CHR (program_value);

    = llc$ordinal_kind =

      get_cybil_value (variable_spec, program_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (program_value < 0) OR
         (program_value > var_sym_entry.symbol^.ordinal_upper_bound) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_ordinal_value,
              variable_name^, status);
      ELSE
      /find_ordinal/
        WHILE TRUE DO
          dup$locate_next_symbol (home_spec.symbol_table_address,
                var_sym_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CASE var_sym_entry.symbol^.constant_kind OF
          = llc$short_constant =
            temporary_value := var_sym_entry.symbol^.short_constant_value.integer_value;
          = llc$medium_constant =
            temporary_value := var_sym_entry.symbol^.medium_constant_value.integer_value;
          = llc$long_constant =
            osp$set_status_abnormal (duc$symbolic_id, due$internal_error,
              'Long_constants not supported as ordinal entries.', status);
            return; {------->
          CASEND;
          IF program_value = temporary_value THEN
            EXIT /find_ordinal/;
          IFEND;
        WHILEND /find_ordinal/;
        p_value^.kind := clc$name;
        p_value^.name_value := var_sym_entry.symbol^.symbol_name;
      IFEND;

{3/86 - The following comments document the reason why code for longreals and reals was developed
{in this manner.
{
{ 1. Cybil cannot deal with longreals properly.  For example, it does not understand assignment
{    of longreals and dereference of pointers to longreal types.
{ 2. Clt$value expects a longreal - this is permanent and independent of Cybil's longreal problem.
{ 3. The addess of the longreal value provided by variable_spec.address is a pva - this is also
{     permanent and independent of Cybil's longreal problem.
{
{Because of 1.2.3 we have the assignment of the longreal value addressed by variable_spec.address
{(which is a pva).  The longreal value represented by real_value.value has to be done in two parts,
{assignment of the leftmost part and assignment of the rightmost part.  If the value addressed by
{variable_spec.address is just of real type, then only a leftmost part exists and the righmost part
{of real_value    ue is set to 0.  In order to find the address of the rightmost part of real_value.
{value, the type converter, ptr_pva_conversion, is used.
{
{This applies to corresponding code in Fortran and Cobol.

    = llc$longreal_kind =

      IF variable_spec.bit_offset > 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$unaligned_real,
              variable_name^, status);
        RETURN;
      IFEND;

      p_value^.kind := clc$real;
      p_value^.real_value.number_of_digits := clc$max_real_number_digits;
      address_of_leftmost_part := variable_spec.address;
      real_value_pointer := #LOC (address_of_leftmost_part);
      value_of_leftmost_part_ptr := #LOC (p_value^.real_value.value);
      value_of_leftmost_part_ptr^ := real_value_pointer^^;
      address_of_rightmost_part := address_of_leftmost_part;
      address_of_rightmost_part.offset := address_of_rightmost_part.offset + 8;
      real_value_pointer := #LOC (address_of_rightmost_part);
      converter.cell_ptr := value_of_leftmost_part_ptr;
      converter.pva.offset := converter.pva.offset + 8;
      value_of_rightmost_part_ptr := converter.cell_ptr;
      value_of_rightmost_part_ptr^ := real_value_pointer^^;

    = llc$real_kind =

      IF variable_spec.bit_offset > 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$unaligned_real,
          variable_name^, status);
        RETURN; {----->
      IFEND;

      p_value^.kind := clc$real;
      p_value^.real_value.number_of_digits := 14;
      address_of_leftmost_part := variable_spec.address;
      real_value_pointer := #LOC (address_of_leftmost_part);
      value_of_leftmost_part_ptr := #LOC (p_value^.real_value.value);
      value_of_leftmost_part_ptr^ := real_value_pointer^^;
      converter.cell_ptr := value_of_leftmost_part_ptr;
      converter.pva.offset := converter.pva.offset + 8;
      value_of_rightmost_part_ptr := converter.cell_ptr;
      value_of_rightmost_part_ptr^ := 0.0;

    = llc$string_kind =

      IF variable_spec.bit_offset > 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$unaligned_string,
              variable_name^, status);
        RETURN;
      IFEND;
      p_value^.kind := clc$string;
      NEXT p_value^.string_value: [variable_spec.length] IN p_work;
      address := variable_spec.address;
      dup$get_bytes (address, #LOC (p_value^.string_value^), variable_spec.length, status);

    = llc$pointer_kind =

      IF variable_spec.bit_offset > 0 THEN
        osp$set_status_abnormal (duc$symbolic_id, due$unaligned_pointer,
              variable_name^, status);
        RETURN;
      IFEND;
      p_value^.kind := clc$integer;
      p_value^.integer_value.radix := 16;
      p_value^.integer_value.radix_specified := TRUE;
      address := variable_spec.address;
      IF (home_spec.language = llc$the_c_language) THEN
        address.offset := address.offset + 2;
      IFEND;
      dup$get_bytes (address, #LOC (pointer), #SIZE (pointer), status);
      p_value^.integer_value.value := pointer;

    = llc$cell_kind =

      get_cybil_value (variable_spec, program_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_value^.kind := clc$integer;
      p_value^.integer_value.value := program_value;
      p_value^.integer_value.radix := 16;
      p_value^.integer_value.radix_specified := TRUE;

    = llc$record_kind =

      IF (variable_spec.length = #SIZE (unique_name)) AND NOT variable_spec.length_is_bits AND
         ((home_spec.language = llc$cybil) OR (home_spec.language = llc$obsolete_cybil)) AND
         (variable_spec.symbol_entry.symbol^.symbol_name = 'OST$BINARY_UNIQUE_NAME') THEN
        address := variable_spec.address;
        dup$get_bytes (address, #LOC (unique_name), #SIZE(unique_name), status);

        IF status.normal THEN
          p_value^.kind := clc$name;
          pmp$convert_binary_unique_name (unique_name, p_value^.name_value, status);
        IFEND;
      ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_data_type_for_func, variable_name^, status);
      IFEND;
    ELSE
      osp$set_status_abnormal (duc$symbolic_id,
            due$invalid_data_type_for_func, variable_name^, status);
    CASEND;

  PROCEND get_variable_value;
?? TITLE := 'locate_c_variable', EJECT ??
{ This routine attempts to find the C symbol in the symbol table and build its
{  variable_spec.

  PROCEDURE locate_c_variable (
        var_name: ost$name;
    VAR home_spec: dut$home_specification;
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

    VAR
      local_status: ost$status,
      nested: boolean,
      options: [STATIC] dut$variable_search_options := [duc$search_module_level],
      proc_entry: dut$symbol_entry,
      symbol_entry: dut$symbol_entry;

    dup$locate_variable_symbol (var_name, home_spec, options, symbol_entry, nested, proc_entry, status);
    IF NOT status.normal THEN
      enable_c_globals (home_spec);
      dup$locate_variable_symbol (var_name, home_spec, options, symbol_entry, nested, proc_entry,
            local_status);
      IF NOT local_status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    dup$build_variable_spec (home_spec, symbol_entry, nested, proc_entry, variable_spec, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    reduce_cybil_type (home_spec, variable_spec, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
  PROCEND locate_c_variable;
?? TITLE := 'locate_cybil_field', EJECT ??

  PROCEDURE locate_cybil_field (
        home_spec: dut$home_specification;
        parameter_value: ^string ( * );
    VAR parameter_index: {input,output} clt$string_index;
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

{ PURPOSE: Modify a variable specification to reflect a field reference.

    VAR
      field_entry: dut$symbol_entry,
      field_found: boolean,
      field_offset: machine_addr_in_bits_type,
      scan_index: clt$string_index,
      scan_length: clt$string_size,
      spaces_preceded_token: boolean,
      token: clt$lexical_token;

?? NEWTITLE := '    search_record_for_field', EJECT ??

    PROCEDURE search_record_for_field (
          home_spec: dut$home_specification;
          field_name: pmt$program_name;
          record_entry: dut$symbol_entry;
      VAR field_entry: dut$symbol_entry;
      VAR field_found: boolean;
      VAR status: ost$status);

{ PURPOSE: Find the symbol entry in the symbol table for a field, given
{          the symbol entry for a record and the name of the field.
{ DESIGN:  The fixed part of the record is first scanned. If the field is
{          found, we return it to the caller. If the field is not found and
{          this is a case variant record, this procedure is called recursively
{          to search for the field in each variant.

      VAR
        next_field: symbol_no,
        next_selector: symbol_no,
        selector_entry: dut$symbol_entry,
        variant_entry: dut$symbol_entry;

      field_found := FALSE;
      next_field := record_entry.symbol^.record_first_field;

{ Search fixed part of the record for the field }

      WHILE next_field > 0 DO
        dup$locate_symbol_for_number (home_spec.symbol_table_address,
              next_field, field_entry, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF field_name = field_entry.symbol^.symbol_name THEN
          field_found := TRUE;
          RETURN;
        IFEND;
        next_field := field_entry.symbol^.next_field;
      WHILEND;

{ Field is not in the fixed part of the record. If there is a variant part,
{search it.}

      next_selector := record_entry.symbol^.record_selector;
      WHILE next_selector > 0 DO
        dup$locate_symbol_for_number (home_spec.symbol_table_address,
              next_selector, selector_entry, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dup$locate_symbol_for_number (home_spec.symbol_table_address,
              selector_entry.symbol^.variation, variant_entry, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        search_record_for_field (home_spec, field_name, variant_entry,
              field_entry, field_found, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF field_found THEN
          RETURN;
        IFEND;
        next_selector := selector_entry.symbol^.next_selector;
      WHILEND;
    PROCEND search_record_for_field;
?? OLDTITLE, EJECT ??
{ Begin procedure locate_cybil_field }

    IF variable_spec.symbol_entry.symbol^.symbol_kind <> llc$record_kind THEN
      osp$set_status_abnormal (duc$symbolic_id,
            due$only_records_have_fields, parameter_value^ (1,
            parameter_index - 2), status);
      RETURN;
    IFEND;

    scan_length := STRLENGTH (parameter_value^) - parameter_index + 1;
    scan_index := 1;
    clp$evaluate_token (parameter_value^ (parameter_index, scan_length), scan_options,
          scan_index, spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes THEN
      variable_spec.name := parameter_value^(parameter_index,token.str.size);
    ELSE
      variable_spec.name := token.str.value (1, token.str.size);
    IFEND;
    parameter_index := parameter_index + scan_index - 1;
    IF (token.kind <> clc$simple_name_token) AND (token.kind <> clc$cybil_name_token) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$not_valid_field_name, token.
            descriptor, status);
      RETURN;
    IFEND;

    search_record_for_field (home_spec, variable_spec.name, variable_spec.
          symbol_entry, field_entry, field_found, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF field_found THEN
      variable_spec.symbol_entry := field_entry;
      variable_spec.length := field_entry.symbol^.field_length;
      variable_spec.length_is_bits := NOT (llc$field_is_byte_addressable IN field_entry.
        symbol^.field_attributes);
      IF variable_spec.length_is_bits THEN
        field_offset := variable_spec.bit_offset + field_entry.symbol^.
              field_offset;
        variable_spec.address.offset := variable_spec.address.offset +
              (field_offset DIV bits_per_byte);
        variable_spec.bit_offset := field_offset MOD bits_per_byte;
      ELSE
        variable_spec.address.offset := variable_spec.address.offset +
              field_entry.symbol^.field_offset;
      IFEND;
      reduce_cybil_type (home_spec, variable_spec, status);
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$field_not_found,
                 variable_spec.name, status);
    IFEND;
  PROCEND locate_cybil_field;
?? TITLE := 'modify_c_pointer', EJECT ??

  PROCEDURE modify_c_pointer (
        home_spec: dut$home_specification;
        token: clt$lexical_token;
        working_var_name: ^string ( * );         {For error messages only}
        parameter_value: ^string ( * );
    VAR parameter_index: {input,output} clt$string_index;
    VAR dereferences_needed: {input,output} integer;
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

{ In C, it is legal to add/subtract integer values to/from pointers (and
{   arrays, which are treated as pointers).  Adding n to a pointer increments
{   the pointer to point n elements beyond where it currently points.  The
{   number actually added to the pointer is a function of what the pointer
{   points to.
{ Since there can be more than one ptr modification, and we don't want to
{   "reduce" the pointer until it is dereferenced, the ptr modifications are
{   saved in the global array ptr_modification and the variable_spec left as is.
{   Note that if there is a dereference which corresponds to this modification,
{   it must occur at another recursion level. For example:
{                  dispv *(*xyz+3)
{   For this expression to work, xyz must be a pointer to a pointer.  There are
{   two dereferences.  The innermost is done before the ptr mod, and the other
{   dereference (which goes with the ptr mod) is done later in the outer
{   recursion level.

    VAR
      sub_var_home_spec: dut$home_specification,
      sub_var_value_index: clt$string_index,
      sub_variable_spec: dut$variable_specification,
      var_value: integer;

{ Pointer dereferences have a higher precedence than pointer modification.  If
{  there are any to do at this level of recursion, do them now.
    WHILE dereferences_needed > 0 DO
      evaluate_c_pointer (home_spec,
          ^working_var_name^(1+dereferences_needed,STRLENGTH(working_var_name^)-dereferences_needed),
               variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      dereferences_needed := dereferences_needed - 1;
    WHILEND;

    IF (variable_spec.symbol_entry.symbol^.symbol_kind <> llc$pointer_kind) AND
       (variable_spec.symbol_entry.symbol^.symbol_kind <> llc$cybil_array_kind) THEN
      osp$set_status_abnormal (duc$symbolic_id, due$c_must_be_pointer, working_var_name^, status);
      RETURN; {----->
    IFEND;

    IF (token.kind = clc$signed_integer_token) OR
       (token.kind = clc$unsigned_integer_token) THEN
      ptr_modification := ptr_modification + token.int.value;
    ELSE
      sub_var_home_spec := home_spec;
      scan_c_variable (parameter_value, sub_var_home_spec, parameter_index, sub_variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      IF sub_variable_spec.symbol_entry.symbol^.symbol_kind <> llc$integer_kind THEN
        osp$set_status_abnormal (duc$symbolic_id, due$c_wrong_type_for_ptr_mod,
                   sub_variable_spec.name, status);
        RETURN; {----->
      IFEND;
      get_cybil_value (sub_variable_spec, var_value, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      ptr_modification := ptr_modification + var_value;
    IFEND;
    ptr_mod_specified := TRUE;

  PROCEND modify_c_pointer;
?? TITLE := 'process_variable_name', EJECT ??

  PROCEDURE process_variable_name (
        value_name: string (*);
        p_variable_value: ^clt$data_value;
    VAR p_name_list: ^string_list;
    VAR status: ost$status);

    VAR
      name_count: integer,
      name_index: integer,
      p_list: ^clt$data_value,
      p_seq: ^SEQ (*),
      unit_list: clt$data_value;

    status.normal := TRUE;
    p_name_list := NIL;
    p_list := p_variable_value;

    IF (p_list <> NIL) THEN
      IF (p_list^.kind <> clc$list) THEN
        unit_list.kind := clc$list;
        unit_list.element_value := p_list;
        unit_list.link := NIL;
        p_list := ^unit_list;
      IFEND;
      name_count := clp$count_list_elements (p_list);
      IF (name_count > 0) THEN
        p_seq := v$p_name_stack;
        NEXT p_name_list: [1 .. name_count] IN p_seq;
        IF (p_name_list = NIL) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$parameter_value_too_long, value_name, status);
        ELSE
          name_index := 0;
          while (name_index < name_count) AND status.normal DO
            name_index := name_index + 1;
            WHILE (p_list^.element_value = NIL) DO
              p_list := p_list^.link;
            WHILEND;
            expand_value (value_name, p_list^.element_value, p_seq, p_name_list^ [name_index], status);
            p_list := p_list^.link;
          WHILEND;
          IF status.normal THEN
            v$p_name_stack := p_seq;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND process_variable_name;
?? TITLE := 'reduce_cybil_type', EJECT ??

  PROCEDURE reduce_cybil_type (home_spec: dut$home_specification;
    VAR variable_spec: {input,output} dut$variable_specification;
    VAR status: ost$status);

{ PURPOSE: Break a symbol down to its basic type.
{ DESIGN:  If a symbol entry is not considered a basic type, any
{          relevant information in the entry is saved and the entry
{          for the more basic type is retrieved.
{ NOTE:    For a given call to this routine, more than one reductions may
{          be necessary. For instance, a variable entry may point to a
{          subrange entry, which points to an integer entry.
{

    VAR
      array_descriptor: ost$adaptable_array_pointer,
      bound_variant_descriptor: ost$bound_variant_pointer,
      constant_entry: dut$symbol_entry,
      field_number: llt$symbol_number,
      heap_descriptor: ost$adaptable_heap_pointer,
      sequence_descriptor: ost$sequence_pointer,
      string_descriptor: ost$adaptable_string_pointer,
      str_length: 0 .. 0FFFF(16),
      symbol_entry: dut$symbol_entry,
      address: ost$pva;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$var_kind THEN
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            var_type, variable_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$constant_kind THEN
      IF NOT((variable_spec.symbol_entry.symbol^.constant_kind = llc$long_constant) AND
             ((home_spec.symbol_table_address^.language = llc$cybil) OR
             (home_spec.symbol_table_address^.language = llc$obsolete_cybil))) THEN
        dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
             constant_type, constant_entry, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.symbol_entry := constant_entry;
      IFEND;
      variable_spec.constant_value := TRUE;
    IFEND;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$field_kind THEN
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            field_type, variable_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$subrange_kind THEN
      variable_spec.range_specified := TRUE;
      IF variable_spec.symbol_entry.symbol^.low_value_type = llc$adaptable_length THEN
        address := variable_spec.descriptor_address;
        dup$get_bytes (address, #LOC (array_descriptor), #SIZE (array_descriptor), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.low_value := array_descriptor.lower_bound;
      ELSE
        variable_spec.low_value := variable_spec.symbol_entry.symbol^.low_value;
      IFEND;
      IF variable_spec.symbol_entry.symbol^.high_value_type = llc$adaptable_length THEN
        address := variable_spec.descriptor_address;
        dup$get_bytes (address, #LOC (array_descriptor), #SIZE (array_descriptor), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.high_value := array_descriptor.lower_bound + (array_descriptor.array_size DIV
              array_descriptor.element_size) - 1;
      ELSE
        variable_spec.high_value := variable_spec.symbol_entry.symbol^.high_value;
      IFEND;
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            subtype, variable_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$bound_vrec_kind THEN
      dup$locate_symbol_for_number (home_spec.symbol_table_address, variable_spec.symbol_entry.symbol^.
            bound_type, variable_spec.symbol_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      address := variable_spec.descriptor_address;
      dup$get_bytes (address, #LOC (bound_variant_descriptor), #SIZE (bound_variant_descriptor), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      variable_spec.length_is_bits := FALSE;
      variable_spec.length := bound_variant_descriptor.length;

    ELSEIF variable_spec.symbol_entry.symbol^.symbol_kind = llc$record_kind THEN
      variable_spec.length_is_bits := FALSE;
      variable_spec.length := variable_spec.symbol_entry.symbol^.record_length;

      IF (variable_spec.symbol_entry.symbol^.record_binding = llc$adaptable_binding) THEN
        symbol_entry := variable_spec.symbol_entry;

        REPEAT
          field_number := symbol_entry.symbol^.record_first_field;
          WHILE (field_number > 0) DO
            dup$locate_symbol_for_number (home_spec.symbol_table_address, field_number, symbol_entry, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            field_number := symbol_entry.symbol^.next_field;
          WHILEND;
          dup$locate_symbol_for_number (home_spec.symbol_table_address, symbol_entry.symbol^.field_type,
                symbol_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        UNTIL (symbol_entry.symbol^.symbol_kind <> llc$record_kind);

        address := variable_spec.descriptor_address;
        IF (symbol_entry.symbol^.symbol_kind = llc$cybil_array_kind) THEN
          dup$get_bytes (address, #LOC (array_descriptor), #SIZE (array_descriptor), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          variable_spec.length := variable_spec.length + array_descriptor.array_size;
        ELSEIF (symbol_entry.symbol^.symbol_kind = llc$string_kind) THEN
          dup$get_bytes (address, #LOC (string_descriptor), #SIZE (string_descriptor), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          variable_spec.length := variable_spec.length + string_descriptor.length;
        ELSEIF (symbol_entry.symbol^.symbol_kind = llc$seq_kind) THEN
          dup$get_bytes (address, #LOC (sequence_descriptor), #SIZE (sequence_descriptor), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          variable_spec.length := variable_spec.length + sequence_descriptor.length;
        ELSEIF (symbol_entry.symbol^.symbol_kind = llc$heap_kind) THEN
          dup$get_bytes (address, #LOC (heap_descriptor), #SIZE (heap_descriptor), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          variable_spec.length := variable_spec.length + heap_descriptor.length;
        IFEND;
      IFEND;
    IFEND;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$cybil_array_kind THEN
      IF llc$adaptable_binding = variable_spec.symbol_entry.symbol^.cybil_array_binding THEN
        variable_spec.length_is_bits := llc$cybil_array_is_bits IN variable_spec.symbol_entry.symbol^.
              cybil_array_attributes;
        address := variable_spec.descriptor_address;
        dup$get_bytes (address, #LOC (array_descriptor), #SIZE (array_descriptor), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.length := array_descriptor.array_size;
      IFEND;
    IFEND;

    IF variable_spec.symbol_entry.symbol^.symbol_kind = llc$string_kind THEN
      variable_spec.max_string_length := variable_spec.length;
      IF variable_spec.symbol_entry.symbol^.string_length_type = llc$variable_length THEN
{ The current length is in the two bytes following the string value }
        variable_spec.max_string_length := variable_spec.length - 2;
        address := variable_spec.address;
        address.offset := address.offset + variable_spec.max_string_length;
        dup$get_bytes (address, #LOC (str_length), #SIZE (str_length), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.length := str_length;
      IFEND;
      IF variable_spec.symbol_entry.symbol^.string_length_type = llc$dynamic_length THEN
{ The first two bytes = max length, followed by the string value, followed by
{  the two bytes of current length
        address := variable_spec.address;
        dup$get_bytes (address, #LOC (str_length), #SIZE (str_length), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.max_string_length := str_length; {save max length}
        variable_spec.address.offset := variable_spec.address.offset + 2;
        address := variable_spec.address;
        address.offset := address.offset + variable_spec.max_string_length;
        dup$get_bytes (address, #LOC (str_length), #SIZE (str_length), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.length := str_length;
      IFEND;
      IF variable_spec.symbol_entry.symbol^.string_length_type = llc$indefinite_length THEN
{ Variable_spec.address has already been adjusted to point to the string itself.
{  The current length is contained in the two bytes following the string.
        address := variable_spec.descriptor_address;
        dup$get_bytes (address, #LOC (string_descriptor), #SIZE (string_descriptor), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.max_string_length := string_descriptor.length; {save max length}
        address := variable_spec.address;
        address.offset := address.offset + string_descriptor.length;
        dup$get_bytes (address, #LOC (str_length), #SIZE (str_length), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.length := str_length;
      IFEND;
      IF variable_spec.symbol_entry.symbol^.string_length_type = llc$adaptable_length THEN
        variable_spec.length_is_bits := FALSE;
        address := variable_spec.descriptor_address;
        dup$get_bytes (address, #LOC (string_descriptor), #SIZE (string_descriptor), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        variable_spec.length := string_descriptor.length;
        variable_spec.max_string_length := string_descriptor.length;
      IFEND;
    IFEND;

{ Treat character, ordinal and boolean types like subranges }

    IF NOT variable_spec.range_specified THEN
      CASE variable_spec.symbol_entry.symbol^.symbol_kind OF
      = llc$boolean_kind =
        variable_spec.range_specified := TRUE;
        variable_spec.low_value := false_value;
        variable_spec.high_value := true_value;
      = llc$char_kind =
        variable_spec.range_specified := TRUE;
        variable_spec.low_value := first_character;
        variable_spec.high_value := last_character;
      = llc$ordinal_kind =
        variable_spec.range_specified := TRUE;
        variable_spec.low_value := 0;
        variable_spec.high_value := variable_spec.symbol_entry.symbol^.ordinal_upper_bound;
      = llc$integer_kind =
        variable_spec.low_value := LOWERVALUE (variable_spec.low_value);
        variable_spec.high_value := UPPERVALUE (variable_spec.high_value);
      = llc$cell_kind =
        variable_spec.low_value := 0;
        variable_spec.high_value := 0ff(16);
      ELSE
      CASEND;
    IFEND;

  PROCEND reduce_cybil_type;
?? TITLE := 'replace_cybil_value', EJECT ??
{ Replace the current program value for variables that are 8 or less bytes.

  PROCEDURE replace_cybil_value (variable_spec: dut$variable_specification;
    VAR replacement_value: integer;
    VAR status: ost$status);

    VAR
      integer_1: ^^0 .. 0ff(16),
      integer_2: ^^0 .. 0ffff(16),
      integer_3: ^^0 .. 0ffffff(16),
      integer_4: ^^0 .. 0ffffffff(16),
      integer_5: ^^0 .. 0ffffffffff(16),
      integer_6: ^^0 .. 0ffffffffffff(16),
      integer_7: ^^0 .. 0ffffffffffffff(16),
      integer_8: ^^integer,
      left_fill_value: integer,
      length: integer,
      right_fill: 0 .. bits_per_byte,
      right_fill_value: integer,
      value: integer;

    IF variable_spec.range_specified THEN
      IF (replacement_value < variable_spec.low_value) OR (replacement_value > variable_spec.high_value) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$value_out_of_range, variable_spec.name, status);
        RETURN;
      IFEND;
    IFEND;

    IF variable_spec.length_is_bits THEN
      length := (variable_spec.length + variable_spec.bit_offset + bits_per_byte - 1) DIV bits_per_byte;
      right_fill := bits_per_byte - ((variable_spec.length + variable_spec.bit_offset) MOD bits_per_byte);
      IF right_fill = bits_per_byte THEN
        right_fill := 0;
      IFEND;
    ELSE
      IF variable_spec.bit_offset = 0 THEN
        length := variable_spec.length;
        right_fill := 0;
      ELSE
        length := variable_spec.length + 1;
        right_fill := bits_per_byte - variable_spec.bit_offset;
      IFEND;
    IFEND;
    CASE length OF
    = 1 =
      integer_1 := #LOC (variable_spec.address);
      value := integer_1^^;

    = 2 =
      integer_2 := #LOC (variable_spec.address);
      value := integer_2^^;

    = 3 =
      integer_3 := #LOC (variable_spec.address);
      value := integer_3^^;

    = 4 =
      integer_4 := #LOC (variable_spec.address);
      value := integer_4^^;

    = 5 =
      integer_5 := #LOC (variable_spec.address);
      value := integer_5^^;

    = 6 =
      integer_6 := #LOC (variable_spec.address);
      value := integer_6^^;

    = 7 =
      integer_7 := #LOC (variable_spec.address);
      value := integer_7^^;

    = 8 =
      integer_8 := #LOC (variable_spec.address);
      value := integer_8^^;

    ELSE
    CASEND;

    IF right_fill > 0 THEN {right shift}
      right_fill_value := value MOD powers_of_two [right_fill];
      value := value DIV powers_of_two [right_fill];
    ELSE
      right_fill_value := 0;
    IFEND;

    IF variable_spec.length_is_bits THEN
      value := value DIV powers_of_two [variable_spec.length];
      left_fill_value := value * powers_of_two [variable_spec.length + right_fill];
    ELSEIF variable_spec.bit_offset > 0 THEN
      value := value DIV powers_of_two [variable_spec.length * bits_per_byte];
      left_fill_value := value * powers_of_two [(variable_spec.length * bits_per_byte) + right_fill];
    ELSE
      left_fill_value := 0;
    IFEND;

    value := left_fill_value + (replacement_value * powers_of_two [right_fill]) + right_fill_value;

    CASE length OF
    = 1 =
      integer_1^^ := value;

    = 2 =
      integer_2^^ := value;

    = 3 =
      integer_3^^ := value;

    = 4 =
      integer_4^^ := value;

    = 5 =
      integer_5^^ := value;

    = 6 =
      integer_6^^ := value;

    = 7 =
      integer_7^^ := value;

    = 8 =
      integer_8^^ := value;

    ELSE
    CASEND;

  PROCEND replace_cybil_value;
?? TITLE := 'scan_basic_variable', EJECT ??

  PROCEDURE scan_basic_variable (variable_name: ^string ( * );
        home_spec: dut$home_specification;
    VAR value_index: {input,output} clt$string_index;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Basic', status);
  PROCEND scan_basic_variable;
?? TITLE := 'scan_c_variable', EJECT ??
{ PURPOSE: Parse a C variable_name and produce a variable_specification.
{
{  Parameters:
{     variable_name - pointer to the variable name string to be scanned.  For
{                  recursive calls to this routine, this string is a substring
{                  of the original, starting at the original first character
{                  and ending at the end of the subexpression to be scanned.
{                  e.g, dispv *(xyz+1).abc  - to evaluate the inner expression,
{                  '*(xyz+1' is passed to the recursive call with value_index
{                  equal to 3.
{     home_spec - the home specification.  Note that this is a VAR parameter
{                  and will change if the variable is a global. (Globals are
{                  contained in the module 'c_globals').
{     value_index - index into the variable name string.  Unlike the CYBIL
{                  scanner, this is 1 only on the very first call.
{     variable_spec - The variable specification which is produced by this
{                  routine.

  PROCEDURE scan_c_variable (
        variable_name: ^string ( * );
    VAR home_spec: dut$home_specification;
    VAR value_index: clt$string_index;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

{ Variable evaluate_subscript_calls is used to determine if the home_spec needs
{ to be restored.  It needs to be restored if the subscript found is a global
{ variable)

    VAR
      evaluate_subscript_calls: [STATIC] integer;

    VAR
      address: ost$pva,
      dereferences_needed: integer,
      first_call: boolean,
      init_value_index: clt$string_index,
      initial_home_spec: [STATIC] dut$home_specification,
      int: integer,
      local_status: ost$status,
      msg_var_name: ^string ( * <= osc$max_string_size),
      processing_subscript: boolean,
      save_home_spec: dut$home_specification,
      scan_index: clt$string_index,
      scan_length: clt$string_index,
      spaces_preceded_token: boolean,
      sub_expression_len: clt$string_size,
      sub_expr_value_index: clt$string_index,
      token: clt$lexical_token,
      type_name: pmt$program_name,
      value_length: clt$string_index,
      var_name: ost$name,
      working_var_name: ^string ( * );           {name for error messages}

    first_call := FALSE;
    init_value_index := value_index;             {save initial value_index}
    IF value_index = 1 THEN
{ Value_index is equal to 1 only on the very first call.
      first_call := TRUE;
      evaluate_subscript_calls := 0;
      ptr_modification := 0;
      ptr_mod_specified := FALSE;
      initial_home_spec := home_spec;
    IFEND;
    IF evaluate_subscript_calls <> 0 THEN
{ This call was made from evaluate_cybil_subscript.  We must set the home_spec
{  back to the original one since if the array was a global variable, home_spec
{  has changed.
      save_home_spec := home_spec;
      home_spec := initial_home_spec;
    IFEND;
    value_length := STRLENGTH (variable_name^);
    scan_length := value_length - value_index + 1;
    scan_index := 1;

    clp$evaluate_token (variable_name^(value_index, scan_length), scan_options,
            scan_index, spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{ Check for '&' character - request for the address of the variable }
    IF (token.kind = clc$unknown_token) AND
       (token.text_size = 1) AND (token.str.value(1) = '&') THEN
      IF NOT first_call THEN
        osp$set_status_abnormal (duc$symbolic_id, due$c_illegal_ptr_construction, '', status);
        RETURN; {----->
      IFEND;
      variable_spec.attribute := duc$variable_address;
      init_value_index := init_value_index + 1;
      clp$evaluate_token (variable_name^(value_index,scan_length), scan_options,
                   scan_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    ELSE
      IF first_call THEN          {Only initialize the first time through}
        variable_spec.attribute := duc$variable_value;
      IFEND;
    IFEND;

{ Check for '*' tokens - request for pointer dereference.  Since the '*'
{  comes before the variable name in C, just save the number of them.  We
{  will do the dereferencing later.
    dereferences_needed := 0;
    IF (token.kind = clc$multiply_token) OR
       (token.kind = clc$exponentiate_token) THEN
      REPEAT
        IF token.kind = clc$multiply_token THEN
          dereferences_needed := dereferences_needed + 1;
        ELSE
          dereferences_needed := dereferences_needed + 2;
        IFEND;
        clp$evaluate_token (variable_name^(value_index,scan_length), scan_options,
                   scan_index, spaces_preceded_token, token, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      UNTIL (token.kind <> clc$multiply_token) AND
            (token.kind <> clc$exponentiate_token);
    IFEND;

{ Check for a sub-expression.  If there is no sub-expression, look for the
{  variable name.
    IF token.kind = clc$left_parenthesis_token THEN
      find_c_sub_expression (variable_name^(value_index + scan_index - 1,*), sub_expression_len, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      sub_expr_value_index := value_index + scan_index - 1;
      scan_c_variable (^variable_name^(1,value_index+scan_index+sub_expression_len-2),
                home_spec, sub_expr_value_index, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      scan_index := scan_index + sub_expression_len + 1;

    ELSEIF (token.kind = clc$simple_name_token) OR (token.kind = clc$cybil_name_token) OR
           (token.kind = clc$name_token) THEN { process variable name }
{ C is a case sensitive language.  However, there was a time when our C wasn't.
{  This code was left in to help the transition.
      IF llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes THEN
        var_name := variable_name^(value_index + scan_index - token.str.size - 1, token.str.size);
      ELSE
        var_name := token.str.value(1,token.str.size);
      IFEND;
      locate_c_variable (var_name, home_spec, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    ELSEIF (token.kind = clc$unsigned_integer_token) THEN { process address.type }
      int := token.int.value;
      clp$evaluate_token (variable_name^ (value_index, scan_length), scan_options, scan_index,
            spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (token.kind <> clc$dot_token) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name, token.descriptor, status);
        RETURN;
      IFEND;

      clp$evaluate_token (variable_name^ (value_index, scan_length), scan_options, scan_index,
            spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (token.kind <> clc$simple_name_token) AND (token.kind <> clc$cybil_name_token) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name, token.descriptor, status);
        RETURN;
      IFEND;
      IF llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes THEN
        type_name := variable_name^(value_index + scan_index - token.str.size - 1, token.str.size);
      ELSE
        type_name := token.str.value (1, token.str.size);
      IFEND;
      address.ring := #ring (^type_name);
      address.seg := (int DIV 100000000(16)) MOD 1000(16);
      address.offset := int MOD 100000000(16);
      dup$simulate_variable (home_spec, address, type_name, variable_spec, status);
      IF NOT status.normal THEN
        enable_c_globals (home_spec);
        dup$simulate_variable (home_spec, address, type_name, variable_spec, local_status);
        IF local_status.normal THEN
          status.normal := TRUE;
        ELSE
          RETURN;
        IFEND;
      IFEND;

    ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name, token.descriptor, status);
        RETURN; {----->
    IFEND;

    value_index := value_index + scan_index - 1;
    processing_subscript := FALSE;
    working_var_name := ^variable_name^(init_value_index, value_index - init_value_index);

/process_tokens/
    WHILE value_index <= value_length DO
      scan_length := value_length - value_index + 1;
      scan_index := 1;
      clp$evaluate_token (variable_name^(value_index,scan_length), scan_options,
            scan_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      value_index := value_index + scan_index - 1;

      CASE token.kind OF
      = clc$dot_token =
{ Structure field }
        IF variable_spec.symbol_entry.symbol^.symbol_kind <> llc$record_kind THEN
          osp$set_status_abnormal (duc$symbolic_id, due$only_records_have_fields,
            working_var_name^(1+dereferences_needed, STRLENGTH(working_var_name^)-dereferences_needed),
                      status);
          RETURN; {----->
        IFEND;
        locate_cybil_field (home_spec, variable_name, value_index, variable_spec, status);

      = clc$left_bracket_token =
{ Array subscript }
        IF processing_subscript THEN
          osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_name^, status);
          EXIT /process_tokens/;
        IFEND;
        processing_subscript := TRUE;
        evaluate_subscript_calls := evaluate_subscript_calls + 1;
        evaluate_c_subscript (home_spec,
              ^working_var_name^(1+dereferences_needed, STRLENGTH(working_var_name^)-dereferences_needed),
              variable_name, value_index, variable_spec, status);
        evaluate_subscript_calls := evaluate_subscript_calls - 1;

      = clc$right_bracket_token =
        IF NOT processing_subscript THEN
          osp$set_status_abnormal (duc$symbolic_id, due$subscript_error, variable_name^, status);
          EXIT /process_tokens/;
        IFEND;
        processing_subscript := FALSE;

      = clc$signed_integer_token =
{ Pointer modification }
        modify_c_pointer (home_spec, token, working_var_name, variable_name,
                   value_index, dereferences_needed, variable_spec, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

      = clc$add_token =
{ Pointer modification }
        modify_c_pointer (home_spec, token, working_var_name, variable_name,
                   value_index, dereferences_needed, variable_spec, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

      = clc$subtract_token =
{ Either pointer modification or field of a pointer to a structure }
        IF (value_index <= value_length) AND
           (variable_name^(value_index) = '>') THEN
{ If the next token is a '>', the variable should be a pointer to a structure
{  and the user wants to display a structure member.
          value_index := value_index + 1;    {points to structure member name}
          evaluate_c_pointer (home_spec,
              ^working_var_name^(1+dereferences_needed,STRLENGTH(working_var_name^)-dereferences_needed),
                   variable_spec, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          locate_cybil_field (home_spec, variable_name, value_index, variable_spec, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        ELSE
{ Try to interpret this as a pointer modification.
          modify_c_pointer (home_spec, token, working_var_name, variable_name,
                   value_index, dereferences_needed, variable_spec, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

      ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$invalid_token_in_variable, token.descriptor, status);
      CASEND;
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
{ Setup the error message variable name }
      working_var_name :=
        ^variable_name^(init_value_index, value_index - init_value_index);

    WHILEND /process_tokens/;
    IF evaluate_subscript_calls <> 0 THEN
      home_spec := save_home_spec;               {restore home_spec just in case
    IFEND;

{ See if there are any dereferences needed to be done now.  Pointer dereferences
{  have a lower precedence than everything except pointer modification.  The
{  routine modify_c_pointer takes care of dereferences before doing the pointer
{  arithmetic.

    WHILE dereferences_needed > 0 DO
      evaluate_c_pointer (home_spec,
          ^working_var_name^(1+dereferences_needed,STRLENGTH(working_var_name^)-dereferences_needed),
               variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      dereferences_needed := dereferences_needed - 1;
    WHILEND;

{ If ptr mods were specified, then all the pointer modifications have not been
{  used up.  See if we can dereference the variable one more time.

    IF (first_call) AND (ptr_mod_specified) THEN
      IF (variable_spec.attribute = duc$variable_address) THEN
        msg_var_name := ^variable_name^(2,*);
        osp$set_status_abnormal (duc$symbolic_id, due$c_illegal_address_op, msg_var_name^, status);
        RETURN; {----->
      IFEND;
      evaluate_c_pointer (home_spec, working_var_name, variable_spec, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      variable_spec.attribute := duc$variable_address;
    IFEND;

  PROCEND scan_c_variable;
?? TITLE := 'scan_cybil_variable', EJECT ??

  PROCEDURE scan_cybil_variable (
        variable_name: ^string ( * );
        home_spec: dut$home_specification;
    VAR value_index: {input,output} clt$string_index;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

{ PURPOSE: Parse a variable_name and produce a variable_specification.

    VAR
      address_wanted: boolean,
      array_descriptor: [STATIC] ost$adaptable_array_pointer,
      field_number: llt$symbol_number,
      lower_bound: integer,
      no_deref_indx: 1 .. 2,
      processing_subscript: boolean,
      spaces_preceded_token: boolean,
      substring_found: boolean,
      symbol_entry: dut$symbol_entry,
      token: clt$lexical_token,
      upper_bound: integer,
      value_length: clt$string_size,
      int: integer,
      address: ost$pva,
      type_name: pmt$program_name,
      var_name: pmt$program_name;

    IF variable_name^ = '' THEN
      osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name,
            '', status);
      RETURN;
    IFEND;
    value_length := STRLENGTH (variable_name^);

    clp$evaluate_token (variable_name^, scan_options, value_index, spaces_preceded_token, token, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    address_wanted := (token.kind = clc$circumflex_token);
    IF address_wanted THEN
      variable_spec.attribute := duc$variable_address;
      clp$evaluate_token (variable_name^, scan_options, value_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      variable_spec.attribute := duc$variable_value;
    IFEND;

    IF (token.kind = clc$simple_name_token) OR (token.kind = clc$cybil_name_token) OR
          (token.kind = clc$name_token) THEN
      IF llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes THEN
        var_name := variable_name^(value_index - token.str.size, token.str.size);
      ELSE
        var_name := token.str.value (1, token.str.size);
      IFEND;

      get_variable_spec (home_spec, var_name, variable_name, address_wanted, value_index,
            variable_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSEIF (token.kind = clc$unsigned_integer_token) THEN
      int := token.int.value;
      clp$evaluate_token (variable_name^, scan_options, value_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (token.kind <> clc$dot_token) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name,
              token.descriptor, status);
        RETURN;
      IFEND;

      clp$evaluate_token (variable_name^, scan_options, value_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (token.kind <> clc$simple_name_token) AND (token.kind <> clc$cybil_name_token) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name,
              token.descriptor, status);
        RETURN;
      IFEND;
      IF llc$language_is_case_sensitive IN home_spec.symbol_table_address^.attributes THEN
        type_name := variable_name^(value_index - token.str.size, token.str.size);
      ELSE
        type_name := token.str.value (1, token.str.size);
      IFEND;
      address.ring := #ring (^type_name);
      address.seg := (int DIV 100000000(16)) MOD 1000(16);
      address.offset := int MOD 100000000(16);
      dup$simulate_variable (home_spec, address, type_name, variable_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (variable_spec.symbol_entry.symbol^.symbol_kind = llc$cybil_array_kind) AND
         (variable_spec.symbol_entry.symbol^.cybil_array_binding = llc$adaptable_binding) THEN
        get_adaptable_bounds (home_spec, variable_spec.name, variable_spec.symbol_entry.symbol^.
             cybil_index_type, variable_name, value_index, lower_bound, upper_bound, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        array_descriptor.element_size := variable_spec.symbol_entry.symbol^.cybil_array_element_length;
        array_descriptor.array_size := array_descriptor.element_size * (upper_bound - lower_bound + 1);
        array_descriptor.lower_bound := lower_bound;
        variable_spec.descriptor_address.ring := osc$invalid_ring {flag local address};
        variable_spec.descriptor_address.seg := #segment (^array_descriptor);
        variable_spec.descriptor_address.offset := #offset (^array_descriptor);
      ELSEIF (variable_spec.symbol_entry.symbol^.symbol_kind = llc$record_kind) AND
             (variable_spec.symbol_entry.symbol^.record_binding = llc$adaptable_binding) THEN
        symbol_entry := variable_spec.symbol_entry;

        REPEAT
          field_number := symbol_entry.symbol^.record_first_field;
          WHILE (field_number > 0) DO
            dup$locate_symbol_for_number (home_spec.symbol_table_address, field_number, symbol_entry, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            field_number := symbol_entry.symbol^.next_field;
          WHILEND;
          dup$locate_symbol_for_number (home_spec.symbol_table_address, symbol_entry.symbol^.field_type,
                symbol_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        UNTIL (symbol_entry.symbol^.symbol_kind <> llc$record_kind);

        IF (symbol_entry.symbol^.symbol_kind = llc$cybil_array_kind) THEN
          get_adaptable_bounds (home_spec, variable_spec.name, symbol_entry.symbol^.cybil_index_type,
               variable_name, value_index, lower_bound, upper_bound, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          array_descriptor.element_size := symbol_entry.symbol^.cybil_array_element_length;
          array_descriptor.array_size := array_descriptor.element_size * (upper_bound - lower_bound + 1);
          array_descriptor.lower_bound := lower_bound;
        ELSE {set descriptor to work for sequences and heaps}
          array_descriptor.array_size := 1;
          array_descriptor.lower_bound := 0;
          array_descriptor.element_size := 1;
        IFEND;

        variable_spec.descriptor_address.ring := osc$invalid_ring {flag local address};
        variable_spec.descriptor_address.seg := #segment (^array_descriptor);
        variable_spec.descriptor_address.offset := #offset (^array_descriptor);
      IFEND;
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name,
            token.descriptor, status);
      RETURN;
    IFEND;

    IF (variable_spec.attribute = duc$variable_value) OR (variable_spec.attribute = duc$variable_address) THEN
      reduce_cybil_type (home_spec, variable_spec, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    processing_subscript := FALSE;
    substring_found := FALSE;

  /process_tokens/
    WHILE value_index <= value_length DO
      clp$evaluate_token (variable_name^, scan_options, value_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      CASE token.kind OF
      = clc$circumflex_token =
        no_deref_indx := 1;
        IF (variable_spec.attribute = duc$variable_address) THEN
          no_deref_indx := 2;
        IFEND;
        evaluate_cybil_pointer (home_spec, ^variable_name^(no_deref_indx,value_index-no_deref_indx-1),
              variable_spec, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

      = clc$dot_token =
        locate_cybil_field (home_spec, variable_name, value_index, variable_spec, status);

      = clc$left_bracket_token =
        IF processing_subscript THEN
          osp$set_status_abnormal (duc$symbolic_id, due$subscript_error,
                   var_name, status);
          EXIT /process_tokens/;
        IFEND;
        processing_subscript := TRUE;
        evaluate_cybil_subscript (home_spec, variable_name, value_index, variable_spec, status);

      = clc$comma_token =
        IF NOT processing_subscript THEN
          EXIT /process_tokens/;
        IFEND;
        evaluate_cybil_subscript (home_spec, variable_name, value_index, variable_spec, status);

      = clc$right_bracket_token =
        IF NOT processing_subscript THEN
          EXIT /process_tokens/;
        IFEND;
        processing_subscript := FALSE;

      = clc$left_parenthesis_token =
        IF substring_found THEN
          osp$set_status_abnormal (duc$symbolic_id, due$invalid_substring, '', status);
          EXIT /process_tokens/;
        IFEND;
        substring_found := TRUE;        {Can only do this once}
        evaluate_cybil_substring (home_spec, variable_name, value_index, variable_spec, status);

      = clc$end_of_line_token =
        EXIT /process_tokens/;

      ELSE
        osp$set_status_abnormal (duc$symbolic_id,
              due$invalid_token_in_variable, token.descriptor, status);
      CASEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    WHILEND /process_tokens/;
    IF processing_subscript THEN
      osp$set_status_abnormal (duc$symbolic_id, due$subscript_error,
               var_name, status);
    IFEND;
  PROCEND scan_cybil_variable;
?? TITLE := 'scan_fortran_variable', EJECT ??

  PROCEDURE scan_fortran_variable (variable_name: ^string(*);
        home_spec: dut$home_specification;
    VAR value_index: clt$string_index;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

    osp$set_status_abnormal (duc$symbolic_id, due$unsupported_language, 'Fortran', status);
  PROCEND scan_fortran_variable;
?? TITLE := 'scan_universal_variable', EJECT ??

  PROCEDURE scan_universal_variable (
        variable_name: ^string ( * );
        home_spec: dut$home_specification;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

{ PURPOSE: Parse a variable_name and produce a variable_specification.

    VAR
      i: integer,
      nested: boolean,
      options: [STATIC] dut$variable_search_options := [duc$search_module_level],
      proc_entry: dut$symbol_entry,
      symbol_entry: dut$symbol_entry,
      value_length: 1 .. max_name_parameter_length,
      var_name: pmt$program_name;

    value_length := STRLENGTH (variable_name^);

    IF value_length > osc$max_name_size THEN
      osp$set_status_abnormal (duc$symbolic_id, due$expecting_variable_name,
            variable_name^, status);
      RETURN;
    IFEND;

    variable_spec.attribute := duc$variable_value;

    var_name := variable_name^;
{ If the language is not case sensitive, convert the name to upper case }
    IF NOT (llc$language_is_case_sensitive IN
             home_spec.symbol_table_address^.attributes) THEN
      FOR i := 1 TO value_length DO
        IF (var_name(i) >= 'a') AND (var_name(i) <= 'z') THEN
          var_name(i) := CHR($integer(var_name(i)) - 32);
        IFEND;
      FOREND;
    IFEND;
{ Find the symbol for this variable in the symbol table }
    dup$locate_variable_symbol (var_name, home_spec, options, symbol_entry, nested,
                   proc_entry, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
{ Build the variable specification }
    dup$build_variable_spec (home_spec, symbol_entry, nested, proc_entry,
                   variable_spec, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    reduce_cybil_type (home_spec, variable_spec, status);

  PROCEND scan_universal_variable;
?? OLDTITLE ??
MODEND dum$display_variable;
