?? LEFT := 1, RIGHT := 110 ??
?? FMT (FORMAT := ON, KEYW := UPPER, IDENT := LOWER) ??
MODULE dum$debug_table_interfaces;
?? PUSH (LISTEXT := ON) ??
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc clp$evaluate_parameters
*copyc clt$data_value
*copyc clt$work_area
*copyc dbp$module_table_address
*copyc dbt$entry_point_table
*copyc dbt$module_address_table_item
*copyc due$symbolic_access_exceptions
*copyc dup$close_display
*copyc dup$display_string
*copyc dup$open_display
*copyc dup$process_module_parameter
*copyc dut$home_specification
*copyc dut$variable_search_options
*copyc dut$variable_specification
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#compare_collated
*copyc llt$form_definition
*copyc lle$load_map_diagnostics
*copyc llt$load_module
*copyc mmp$create_scratch_segment
*copyc oce$library_generator_errors
*copyc ocp$close_linker_debug_table
*copyc ocp$define_linker_debug_table
*copyc ocp$find_debug_entry_point
*copyc ocp$find_debug_module_item
*copyc ocp$open_running_debug_table
*copyc osd$registers
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc ost$exchange_package
*copyc ost$hardware_subranges
*copyc ost$stack_frame_save_area
*copyc osv$lower_to_upper
*copyc pme$debug_exceptions
*copyc pmp$validate_previous_save_area
?? POP ??
?? NEWTITLE := 'Global Definitions', EJECT ??
  TYPE
    stack_frame_control_image = packed record
      p_reg: ost$p_register,
      fill0: 0 .. 0f(16),
      vmid: 0 .. 0f(16),
      fill1: 0 .. 0ff(16),
      dsp: ost$pva,
      frame_desc: ost$frame_descriptor,
      csf: ost$pva,
      user_condition_mask: packed array [ost$user_condition] of boolean,
      psa: ost$pva,
      fill2: 0 .. 0ffff(16),
      bsp: ost$pva,
      user_conditions: packed array [ost$user_condition] of boolean,
      arg: ost$pva,
      monitor_conditions: packed array [ost$monitor_condition] of boolean,
      fill3: 0 .. 0ffffffffffff(16),
    recend,

    stack_afield = packed record
      fill1: 0 .. 0ffff(16),
      pva: ost$pva,
    recend,

    stack_xfield = record
      lhalf: 0 .. 0ffffffff(16),
      rhalf: 0 .. 0ffffffff(16),
    recend,

    stack_frame_areg_image = packed record
      p_reg: ost$p_register,
      reg: array [0 .. 0f(16)] of stack_afield,
    recend,

    stack_frame_xreg_image = record
      p_reg: ost$p_register,
      reg: array [0 .. 32] of stack_xfield,
    recend,

    stack_image_pointer = record
      case x: 0 .. 4 of
      = 0 =
        control: ^stack_frame_control_image,
      = 1 =
        aregs: ^stack_frame_areg_image,
      = 2 =
        xregs: ^stack_frame_xreg_image,
      = 3 =
        cell_p: ^cell,
      = 4 =
        pva: ost$pva,
      casend
    recend;

  VAR
    starting_procedure_ptr: ^cell := NIL,
    trapped_save_area_address: array [1 .. 1] of ^ost$stack_frame_save_area := [NIL];

  VAR
    nested_procedures: SET OF llt$module_generator := [llc$cybil, llc$obsolete_cybil, llc$pascal];

  VAR
    non_nested_structure_generators: [READ] set of llt$module_generator := [llc$cobol, llc$fortran];

  CONST
    c$current_module = '$CURRENT',
    c$current_procedure = '$CURRENT';

  VAR
    v$default_module: pmt$program_name := c$current_module,
    v$default_procedure: pmt$program_name := c$current_procedure;

  VAR
    p_debug_directory: ^SEQ (*) := NIL,
    p_first_module: ^dbt$module_address_table_item := NIL,
    p_local_modules: ^dbt$module_address_table_item := NIL;
?? TITLE := 'dup$add_debug_tables', EJECT ??

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

{ PROCEDURE add_debug_tables, add_debug_table, adddt (
{   debug_tables, debug_table, dt: list of any of
{       key
{         (running_system, rs)
{       keyend
{       file
{     anyend = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 4] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$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,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 2] of clt$keyword_specification,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
          recend,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 10, 12, 30, 54, 666],
    clc$command, 4, 2, 1, 0, 0, 0, 2, ''], [
    ['DEBUG_TABLE                    ',clc$alias_entry, 1],
    ['DEBUG_TABLES                   ',clc$nominal_entry, 1],
    ['DT                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 120,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [104, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$union_type], [[clc$file_type, clc$keyword_type],
      FALSE, 2],
      81, [[1, 0, clc$keyword_type], [2], [
        ['RS                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
        ['RUNNING_SYSTEM                 ', clc$nominal_entry, clc$normal_usage_entry, 1]]
        ],
      3, [[1, 0, clc$file_type]]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);

    IF status.normal THEN
      process_debug_tables (pvt [p$debug_tables].value, status);
    IFEND;
  PROCEND dup$add_debug_tables;
?? TITLE := 'dup$build_home_spec', EJECT ??
{
{ This code is used to establish the concept of a "home" module and procedure.
{ Specifically, it interprets the module, procedure, recursion_level and
{ recursion_direction parameters passed to it in parameter list form.  These
{ parameters appear on several commands.  For parameters that are not present,
{ defaults are established.  The code is further complicated by needing to solve
{ these problems:
{
{ 1)  Not all four of the above-mentioned parameters are defined for each
{     command that can call this procedure.  Also, not all parameters are valid
{     for every language that is supported.
{
{ 2)  The method for establishing defaults differs for different languages.  It
{     is not possible to establish language without assuming some default as
{     the language is determined by the line or symbol table, not the module
{     table.
{
{ The following table attempts to define the way defaults should be established
{ for module and procedure.  The code attempts to implement this scheme with the
{ case tested first being that of assuming that home being established will be
{ in a FTN (non_nested_structure language) program.
{
{_________________________|___|___|___|___|___|___|___|___|___|___|___|___|___|
{  module parameter       | T | T | T | T | F | F | F | F | F | F | F | F | F |
{ specified               |___|___|___|___|___|___|___|___|___|___|___|___|___|
{  procedure parameter    | T | F | F | F | T | T | T | F | F | F | F | F | F |
{ specified               |___|___|___|___|___|___|___|___|___|___|___|___|___|
{  default module         | N | N | N | N | T | N | F | T | T | T | F | F | F |
{ available               |___|___|___|___|___|___|___|___|___|___|___|___|___|
{  default procedure      | N | T | F | N | N | N | N | T | F | F | T | T | F |
{ available               |___|___|___|___|___|___|___|___|___|___|___|___|___|
{  language that supports | N | T | T | F | T | F | T | N | T | F | T | F | N |
{ nested procedures       |___|___|___|___|___|___|___|___|___|___|___|___|___|
{                         | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |10 |11 |12 |13 |
{                         |___|___|___|___|___|___|___|___|___|___|___|___|___|
{
{ (1)  Use module specified and procedure specified
{
{ (2)  Use module specified and default procedure
{
{ (3)  Use specified module and current P register for procedure
{
{ (4)  Use specified module for both module and procedure
{
{ (5)  Use default module and specified procedure
{
{ (6)  Use specified procedure for both module and procedure
{
{ (7)  Use current P register to determine module and use specified procedure
{
{ (8)  Use default module and default procedure
{
{ (9)  Use default module and current P register for procedure
{
{ (10) Use default module for both module and procedure
{
{ (11) Use current P register for module and default procedure
{
{ (12) Use default procedure for both module and procedure
{
{ (13) Use current P register to determine module and procedure
{

  PROCEDURE [XDCL] dup$build_home_spec (module_name: pmt$program_name;
        procedure_name: pmt$program_name;
        recursion_level_value: clt$data_value;
        recursion_direction_value: clt$data_value;
    VAR home_spec: dut$home_specification;
    VAR status: ost$status);

    VAR
      found: boolean,
      language_questionable: boolean,
      line_table_address: ^llt$line_address_table,
      line_item_index: llt$line_address_table_size,
      local_stat: ost$status,
      local_status: ost$status,
      module_specified: boolean,
      procedure_specified: boolean,
      ring_specified: boolean,
      save_area: ^ost$stack_frame_save_area,
      section_item_index: llt$section_ordinal,
      symbol: ^llt$symbol_table_item,
      symbol_index: llt$symbol_number,
      symbol_table_address: ^llt$debug_symbol_table,
      target_ring: ost$ring,
      trapped_sf: stack_image_pointer;

    VAR
      converter: record
        case boolean of
        = FALSE =
          p_cell: ^cell,
        = TRUE =
          pva: ost$pva,
        casend,
      recend,
      pva: ost$pva;

?? EJECT ??
    local_status.normal := TRUE;
    status.normal := TRUE;
    local_stat.normal := TRUE;
    home_spec.line_table_address := NIL;
    home_spec.symbol_table_address := NIL;
    home_spec.procedure_entry.symbol := NIL;
    language_questionable := TRUE;
    home_spec.language := llc$unknown_generator;
    module_specified := (module_name <> osc$null_name);
    procedure_specified := (procedure_name  <> osc$null_name);

{Set up ring to be the ring where the user is stopped
    ring_specified := false;
    find_trapped_stack_frame (trapped_sf.cell_p, found);
    IF found THEN
      pva := trapped_sf.control^.p_reg.pva;
    ELSE
      IF (starting_procedure_ptr = NIL) THEN
        save_area := #previous_save_area ();
        converter.pva := save_area^.minimum_save_area.p_register.pva;
        starting_procedure_ptr := converter.p_cell;
      IFEND;
      converter.p_cell := starting_procedure_ptr;
      pva := converter.pva;
    IFEND;
    target_ring := pva.ring;

    IF module_specified THEN
{a specified module is always used
      find_tables_for_module_name (module_name, target_ring, ring_specified, home_spec.module_item,
            line_table_address, symbol_table_address, status);
      IF NOT status.normal THEN
        RETURN; {------->
      IFEND;
      home_spec.line_table_address := line_table_address;
      home_spec.symbol_table_address := symbol_table_address;
      IF procedure_specified THEN   {If procedure specified}
{a specified procedure is always used
        find_procedure_for_name (symbol_table_address, procedure_name, symbol, symbol_index, status);
        IF NOT status.normal THEN
          RETURN; {------->
        IFEND;
        home_spec.procedure_entry.table_entry_index := symbol_index;
        home_spec.procedure_entry.symbol := symbol;
        language_questionable := FALSE;
      ELSE
{assume a non nested structured language and use the module parameter for procedure
        local_status.normal := TRUE;
        find_procedure_for_name (symbol_table_address, module_name, symbol, symbol_index,
              local_status);
        IF (local_status.normal) AND (home_spec.symbol_table_address <> NIL) AND (symbol_table_address^.
              language IN non_nested_structure_generators) THEN
          language_questionable := FALSE;
          home_spec.procedure_entry.table_entry_index := symbol_index;
          home_spec.procedure_entry.symbol := symbol;
        IFEND;
      IFEND;
    ELSE {module not specified
      IF procedure_specified THEN
{assume that language will be a non nested structured one and use specified
{procedure for module name
        find_tables_for_module_name (procedure_name, target_ring, ring_specified, home_spec.module_item,
              line_table_address, symbol_table_address, local_stat);
        IF local_stat.normal THEN
          home_spec.symbol_table_address := symbol_table_address;
          home_spec.line_table_address := line_table_address;
          find_procedure_for_name (symbol_table_address, procedure_name, symbol, symbol_index,
                local_status);
          IF (local_status.normal) AND (symbol_table_address <> NIL) AND (symbol_table_address^.language IN
                non_nested_structure_generators) THEN
            home_spec.procedure_entry.table_entry_index := symbol_index;
            home_spec.procedure_entry.symbol := symbol;
            language_questionable := FALSE;
          IFEND;
        IFEND;
      ELSE {both module and procedure not specified}
        IF v$default_module <> c$current_module THEN
{an explicit default module exists, use it for module
          find_tables_for_module_name (v$default_module, target_ring, ring_specified,
                home_spec.module_item, line_table_address, symbol_table_address, status);
          IF NOT status.normal THEN
            RETURN; {------->
          IFEND;
          home_spec.symbol_table_address := symbol_table_address;
          home_spec.line_table_address := line_table_address;
          IF v$default_procedure <> c$current_procedure THEN
{a default procedure also exists
            find_procedure_for_name (symbol_table_address, v$default_procedure, symbol, symbol_index,
                  status);
            IF NOT status.normal THEN
              RETURN; {------->
            IFEND;
            home_spec.procedure_entry.table_entry_index := symbol_index;
            home_spec.procedure_entry.symbol := symbol;
            language_questionable := FALSE;
          ELSE
{use default module as procedure name also
            local_status.normal := TRUE;
            find_procedure_for_name (symbol_table_address, v$default_module, symbol, symbol_index,
                  local_status);
            IF (local_status.normal) AND (symbol_table_address <> NIL) AND (symbol_table_address^.language IN
                  non_nested_structure_generators) THEN
              home_spec.procedure_entry.table_entry_index := symbol_index;
              home_spec.procedure_entry.symbol := symbol;
              language_questionable := FALSE;
            IFEND;
          IFEND;
        ELSE
{no default module
          IF v$default_procedure <> c$current_procedure THEN
{Use default procedure for module
            local_stat.normal := TRUE;
            find_tables_for_module_name (v$default_procedure, target_ring, ring_specified,
                  home_spec.module_item, line_table_address, symbol_table_address, local_stat);
            IF local_stat.normal THEN
              home_spec.symbol_table_address := symbol_table_address;
              home_spec.line_table_address := line_table_address;
              local_status.normal := TRUE;
              find_procedure_for_name (symbol_table_address, v$default_procedure, symbol, symbol_index,
                    local_status);
              IF (local_status.normal) AND (symbol_table_address <> NIL) AND (symbol_table_address^.language
                    IN non_nested_structure_generators) THEN
                home_spec.procedure_entry.table_entry_index := symbol_index;
                home_spec.procedure_entry.symbol := symbol;
                language_questionable := FALSE;
              IFEND;
            IFEND;
          ELSE
{use where you are for module and procedure
            dup$find_module_table_for_pva (pva, home_spec.module_item, section_item_index, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            IF home_spec.module_item^.section_item [section_item_index].kind <> llc$code_section THEN
              osp$set_status_abnormal (duc$symbolic_id, due$internal_error,
                'Value of trapped_sf.control^.p_reg.pva not in code section', status);
              RETURN; {----->
            IFEND;
            find_line_number_for_pva (home_spec.module_item, section_item_index, pva, line_table_address,
                  line_item_index, status);
            IF status.normal THEN
              home_spec.line_table_address := line_table_address;
            ELSE
{ If we cant find the current pva in the line table, assume we are in the first
{  one for the current module.
              IF home_spec.module_item^.line_address_tables <> NIL THEN
                home_spec.line_table_address := home_spec.module_item^.line_address_tables^[0];
              IFEND;   {If there are line tables}
            IFEND;

            dup$find_procedure_for_pva (home_spec.module_item, section_item_index, pva, symbol_table_address,
                  symbol_index, status);
            IF NOT status.normal THEN
              RETURN; { ----->
            IFEND;
            home_spec.procedure_entry.table_entry_index := symbol_index;
            home_spec.procedure_entry.symbol := ^symbol_table_address^.item [symbol_index];
            home_spec.symbol_table_address := symbol_table_address;
            language_questionable := FALSE;
          IFEND; {explicit default procedure}
        IFEND; {explicit default module}
      IFEND; {procedure specified}
    IFEND; {module specified}

{if module not established or if the set of default chosen yielded the wrong
{language type

    IF (language_questionable) OR (NOT local_stat.normal) THEN
      IF NOT local_stat.normal THEN
{module has not been established
        IF v$default_module <> c$current_module THEN
{Use default module for module name
          find_tables_for_module_name (v$default_module, target_ring, ring_specified,
                home_spec.module_item, line_table_address, symbol_table_address, status);
          IF NOT status.normal THEN
            RETURN; {------->
          IFEND;
          home_spec.line_table_address := line_table_address;
          home_spec.symbol_table_address := symbol_table_address;
        ELSE
{use where you are for module
          dup$find_module_table_for_pva (pva, home_spec.module_item, section_item_index, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          IF home_spec.module_item^.section_item [section_item_index].kind <> llc$code_section THEN
            osp$set_status_abnormal (duc$symbolic_id, due$internal_error,
              'Value of trapped_sf.control^.p_reg.pva not in code section', status);
            RETURN; {----->
          IFEND;
          find_line_number_for_pva (home_spec.module_item, section_item_index, pva, line_table_address,
                line_item_index, status);
          IF status.normal THEN
            home_spec.line_table_address := line_table_address;
          ELSE
{ If we cant find the current pva in the line table, assume we are in the first
{  one for the current module.
            IF home_spec.module_item^.line_address_tables <> NIL THEN
              home_spec.line_table_address := home_spec.module_item^.line_address_tables^[0];
            IFEND;
          IFEND;

          dup$find_procedure_for_pva (home_spec.module_item, section_item_index, pva, symbol_table_address,
                symbol_index, status);
          IF NOT status.normal THEN
            RETURN; { ----->
          IFEND;
          home_spec.procedure_entry.table_entry_index := symbol_index;
          home_spec.procedure_entry.symbol := ^symbol_table_address^.item [symbol_index];
          home_spec.symbol_table_address := symbol_table_address;
        IFEND;
      IFEND;

      local_status.normal := TRUE;
      IF procedure_specified THEN
        find_procedure_for_name (symbol_table_address, procedure_name,
                     symbol, symbol_index, status);
        IF NOT status.normal THEN
          home_spec.procedure_entry.symbol := NIL;
          RETURN; {------->
        IFEND;
        home_spec.procedure_entry.table_entry_index := symbol_index;
        home_spec.procedure_entry.symbol := symbol;
      ELSE
        IF v$default_procedure <> c$current_procedure THEN
          find_procedure_for_name (symbol_table_address, v$default_procedure, symbol, symbol_index,
                status);
          IF NOT status.normal THEN
            RETURN; {------->
          IFEND;
          home_spec.procedure_entry.table_entry_index := symbol_index;
          home_spec.procedure_entry.symbol := symbol;
        ELSE
{procedure name has not already been found
          find_section_for_pva (home_spec.module_item, pva,
                        section_item_index, local_status);
          IF local_status.normal THEN
{ The current pva is in the specified module }
            dup$find_procedure_for_pva (home_spec.module_item, section_item_index, pva, symbol_table_address,
                  symbol_index, status);
            IF NOT status.normal THEN
              RETURN; { ----->
            IFEND;
{Now make sure this procedure is in the specified module
            find_procedure_for_name (home_spec.symbol_table_address, symbol_table_address^.item
                  [symbol_index].symbol_name, symbol, symbol_index, status);
            IF NOT status.normal THEN
              status.normal := TRUE;
            ELSE
              home_spec.procedure_entry.symbol := symbol;
              home_spec.procedure_entry.table_entry_index := symbol_index;
            IFEND;
          IFEND;
        IFEND;  {explicit default procedure specified}
      IFEND;  {procedure_specified}
    IFEND;  {language_questionable OR NOT local_stat.normal}
{Fill in the language field from the symbol table if available; then the line table; otherwise
{set it to unknown
    IF home_spec.symbol_table_address <> NIL THEN
      home_spec.language := home_spec.symbol_table_address^.language;
    ELSEIF home_spec.line_table_address <> NIL THEN
      home_spec.language := home_spec.line_table_address^.language;
    ELSE
    IFEND;

{ Take care of recursion_level parameter

    IF (recursion_level_value.kind = clc$integer) THEN   {If specified}
      home_spec.proc_recursion_level := recursion_level_value.integer_value.value;
    ELSE
      home_spec.proc_recursion_level := 0;
    IFEND;

{ Take care of recursion_direction parameter

    IF (recursion_direction_value.kind = clc$keyword) AND
          (recursion_direction_value.keyword_value (1) = 'F') THEN
      home_spec.stack_search_direction := duc$first_to_trapped;
    ELSE
      home_spec.stack_search_direction := duc$trapped_to_first;
    IFEND;

  PROCEND dup$build_home_spec;
?? TITLE := 'dup$build_variable_spec', EJECT ??

  PROCEDURE [XDCL] dup$build_variable_spec (
        home_spec: dut$home_specification;
        symbol_entry: dut$symbol_entry;
        nested_proc: boolean;
        current_proc: dut$symbol_entry;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

{ PURPOSE: Establish a variable_spec given a symbol_entry. }

    CONST
      bits_per_byte = 8,
      bytes_per_word = 8,
      reserved_stack_space = bytes_per_word * 2,
      right_justified_offset = 2;

    VAR
      field_entry: dut$symbol_entry,
      field_offset: machine_addr_in_bits_type,
      true_current_proc: dut$symbol_entry,
      true_procedure_entry: dut$symbol_entry,
      entry_item: dbt$entry_point_table_item,
      indirectly_referenced: boolean,
      pointer: ^^ost$pva,
      helper: ^cell,
      proc_start: ost$pva,
      stack_frame_save_area: ^ost$stack_frame_save_area;

    status.normal := TRUE;
    variable_spec.name := symbol_entry.symbol^.symbol_name;
    variable_spec.symbol_entry := symbol_entry;
    variable_spec.length := symbol_entry.symbol^.var_length;
    variable_spec.length_is_bits := FALSE;
    variable_spec.bit_offset := 0;
    variable_spec.range_specified := FALSE;
    variable_spec.constant_value := FALSE;

    IF symbol_entry.symbol^.symbol_kind = llc$constant_kind THEN
      CASE symbol_entry.symbol^.constant_kind OF
      = llc$short_constant =
        CASE symbol_entry.symbol^.short_constant_value.kind OF
        = llc$boolean_kind =
          helper := #LOC(symbol_entry.symbol^.short_constant_value.boolean_value);
        = llc$char_kind =
          helper := #LOC(symbol_entry.symbol^.short_constant_value.char_value);
        = llc$bit_kind =
          helper := #LOC(symbol_entry.symbol^.short_constant_value.bit_value);
{ CYBIL sets length for bit short constants to 2 - should be 8. }
          IF (home_spec.language = llc$cybil) OR (home_spec.language = llc$obsolete_cybil) THEN
            variable_spec.length := 8;     {kludge for CYBIL bug}
          IFEND;
        = llc$integer_kind =
          helper := #LOC(symbol_entry.symbol^.short_constant_value.integer_value);
{ CYBIL sets length for integer short constants to 2 - should be 8. }
          IF (home_spec.language = llc$cybil) OR (home_spec.language = llc$obsolete_cybil) THEN
            variable_spec.length := 8;     {kludge for CYBIL bug}
          IFEND;
        CASEND;
        variable_spec.address.ring := osc$invalid_ring {flag local address};
        variable_spec.address.seg := #SEGMENT(helper);
        variable_spec.address.offset := #OFFSET(helper);
      = llc$medium_constant =
        CASE symbol_entry.symbol^.medium_constant_value.kind OF
        = llc$integer_kind =
          helper := #LOC(symbol_entry.symbol^.medium_constant_value.integer_value);
        = llc$real_kind =
          helper := #LOC(symbol_entry.symbol^.medium_constant_value.real_value);
        = llc$shortreal_kind =
          helper := #LOC(symbol_entry.symbol^.medium_constant_value.shortreal_value);
        CASEND;
        variable_spec.address.ring := osc$invalid_ring {flag local address};
        variable_spec.address.seg := #SEGMENT(helper);
        variable_spec.address.offset := #OFFSET(helper);
      = llc$long_constant =
        variable_spec.address :=
          home_spec.module_item^.section_item[symbol_entry.symbol^.constant_section_ordinal].address;
        variable_spec.address.offset :=
          variable_spec.address.offset + symbol_entry.symbol^.constant_offset;
      CASEND;
      RETURN;
    IFEND;

    indirectly_referenced := llc$var_indirectly_referenced IN symbol_entry.symbol^.var_attributes;
    CASE symbol_entry.symbol^.var_base OF
    = llc$static_base =
      variable_spec.address := home_spec.module_item^.section_item
            [symbol_entry.symbol^.var_section_ordinal].address;
      variable_spec.address.offset := variable_spec.address.offset +
            symbol_entry.symbol^.var_offset;

    = llc$stack_frame_base, llc$parm_list_base =
      IF home_spec.proc_recursion_level <> 0 THEN
        true_procedure_entry := home_spec.procedure_entry;
        WHILE true_procedure_entry.symbol^.symbol_kind <> llc$proc_kind DO
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                true_procedure_entry.symbol^.with_parent, true_procedure_entry, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        WHILEND;
        proc_start := home_spec.module_item^.section_item[
              true_procedure_entry.symbol^.proc_section_ordinal].address;
        proc_start.offset := proc_start.offset +
              true_procedure_entry.symbol^.proc_offset;
        dup$find_stack_frame_for_proc (proc_start,
              true_procedure_entry.symbol^.proc_length, home_spec.
              stack_search_direction, home_spec.proc_recursion_level,
              variable_spec.address, stack_frame_save_area, status);
        IF NOT status.normal THEN
          IF status.condition = due$procedure_not_active THEN
            osp$set_status_abnormal (duc$symbolic_id,
                due$procedure_not_active, true_procedure_entry.
                symbol^.symbol_name, status);  {put proc name in msg}
          ELSE
            IF home_spec.procedure_entry.symbol^.proc_return_type <> 0 THEN
              osp$set_status_abnormal (duc$symbolic_id, due$function_not_active,
                true_procedure_entry.symbol^.symbol_name, status)
            IFEND;
          IFEND;
          RETURN; {----->
        IFEND;
      ELSE
        stack_frame_save_area := home_spec.current_stack_frame;
        variable_spec.address.ring := #ring (stack_frame_save_area^.minimum_save_area.
              a1_current_stack_frame);
        variable_spec.address.seg := #segment (stack_frame_save_area^.minimum_save_area.
              a1_current_stack_frame);
        variable_spec.address.offset := #offset (stack_frame_save_area^.minimum_save_area.
              a1_current_stack_frame);
      IFEND;
      IF nested_proc THEN
{ First check to see if the stack is initialized. }
        check_for_prolog (home_spec, stack_frame_save_area^,
                             variable_spec.name, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        true_current_proc := current_proc;
        WHILE true_current_proc.symbol^.symbol_kind <> llc$proc_kind DO
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                true_current_proc.symbol^.with_parent, true_current_proc, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        WHILEND;
        variable_spec.address.offset := variable_spec.address.offset
              + (true_current_proc.symbol^.proc_lexical_level * bytes_per_word)
              + reserved_stack_space + right_justified_offset;
        pointer := #LOC (variable_spec.address);
        variable_spec.address := pointer^^;
      IFEND;
      IF symbol_entry.symbol^.var_base = llc$parm_list_base THEN
        IF (stack_frame_save_area^.minimum_save_area.
              frame_descriptor.a_terminating < 4) THEN
          osp$set_status_abnormal (duc$symbolic_id,
                due$variable_not_accessible, variable_spec.name, status);
          RETURN;
        IFEND;
        IF nested_proc THEN
          variable_spec.address.offset := variable_spec.address.offset
                + (true_current_proc.symbol^.proc_lexical_level * bytes_per_word)
                + reserved_stack_space + right_justified_offset;
          pointer := #LOC (variable_spec.address);
          variable_spec.address := pointer^^;
        ELSE
          variable_spec.address.ring := #ring
                (stack_frame_save_area^.a4);
          variable_spec.address.seg := #segment
                (stack_frame_save_area^.a4);
          variable_spec.address.offset := #offset
                (stack_frame_save_area^.a4);
        IFEND;
      IFEND;
      variable_spec.address.offset := variable_spec.address.offset +
            symbol_entry.symbol^.var_offset;

    = llc$xref_base =
      find_entry_point_item (variable_spec.name, entry_item, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      variable_spec.address := entry_item.address;
      indirectly_referenced := FALSE; {no dereference for xref
      {symbols}

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

    IF indirectly_referenced THEN
      variable_spec.descriptor_address := variable_spec.address;
      pointer := #LOC (variable_spec.address);
      variable_spec.address := pointer^^;
    IFEND;

    IF (current_proc.symbol <> NIL) AND
       (current_proc.symbol^.symbol_kind = llc$pascal_with_kind) THEN
{ WITH block var_kind symbols point to a field_type entry.  This code updates
{  variable_spec in the same way locate_cybil_field does.  Any further subfields
{  will be handled in the normal way.
      dup$locate_symbol_for_number (home_spec.symbol_table_address,
        variable_spec.symbol_entry.symbol^.var_type, field_entry, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      IF field_entry.symbol^.symbol_kind = llc$field_kind 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;
      IFEND; { If field }
    IFEND; {If with block }

  PROCEND dup$build_variable_spec;
?? TITLE := 'dup$change_default_module', EJECT ??

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

{ PROCEDURE change_default_module, chadm (
{   module, m: (CHECK) any of
{       key
{         $current
{       keyend
{       program_name
{       application
{     anyend = $CURRENT
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          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,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
        default_value: string (8),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 12, 2, 10, 46, 18, 465],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['M                              ',clc$abbreviation_entry, 1],
    ['MODULE                         ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [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, 75,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 2
    [3, 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$application_type, clc$keyword_type, clc$program_name_type],
    FALSE, 3],
    44, [[1, 0, clc$keyword_type], [1], [
      ['$CURRENT                       ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ,
    '$CURRENT'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      module_name: pmt$program_name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);

    IF status.normal THEN
      dup$process_module_parameter ('MODULE', pvt [p$module].value, module_name, status);
      IF status.normal THEN
        v$default_module := module_name;
      IFEND;
    IFEND;
  PROCEND dup$change_default_module;
?? TITLE := 'dup$change_default_procedure', EJECT ??

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

{ PROCEDURE change_default_procedure, chadp (
{   procedure, p: (CHECK) any of
{       key
{         $current
{       keyend
{       program_name
{       application
{     anyend = $CURRENT
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          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,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
        default_value: string (8),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 12, 2, 11, 1, 16, 119],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['P                              ',clc$abbreviation_entry, 1],
    ['PROCEDURE                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [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, 75,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 2
    [3, 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$application_type, clc$keyword_type, clc$program_name_type],
    FALSE, 3],
    44, [[1, 0, clc$keyword_type], [1], [
      ['$CURRENT                       ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    3, [[1, 0, clc$program_name_type]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ,
    '$CURRENT'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      procedure_name: pmt$program_name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);

    IF status.normal THEN
      dup$process_module_parameter ('PROCEDURE', pvt [p$procedure].value, procedure_name, status);
      IF status.normal THEN
        v$default_procedure := procedure_name;
      IFEND;
    IFEND;
  PROCEND dup$change_default_procedure;
?? TITLE := 'dup$default_module_function', EJECT ??

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

{ FUNCTION $default_module, $dm

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 1, 11, 10, 49, 53, 947],
    clc$function, 0, 0, 0, 0, 0, 0, 0, '']];

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

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);

    IF status.normal THEN
      NEXT p_value IN p_work;
      p_value^.kind := clc$program_name;
      p_value^.program_name_value := v$default_module;
    IFEND;
  PROCEND dup$default_module_function;
?? TITLE := 'dup$default_procedure_function', EJECT ??

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

{ FUNCTION $default_procedure, $dp

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 1, 11, 12, 19, 0, 964],
    clc$function, 0, 0, 0, 0, 0, 0, 0, '']];

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

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);

    IF status.normal THEN
      NEXT p_value IN p_work;
      p_value^.kind := clc$program_name;
      p_value^.program_name_value := v$default_procedure;
    IFEND;
  PROCEND dup$default_procedure_function;
?? TITLE := 'dup$display_line_number', EJECT ??

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

{ PROCEDURE display_line_number, disln (
{   procedure_offset, po, offset: (CHECK) integer 0..7fffffff(16) = 0
{   module, m: (CHECK) any of
{       program_name
{       application
{     anyend = $optional
{   procedure, p: (CHECK) any of
{       program_name
{       application
{     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 .. 10] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      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,
        default_value: string (7),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 28, 9, 47, 46, 472],
    clc$command, 10, 5, 0, 0, 0, 0, 5, ''], [
    ['M                              ',clc$abbreviation_entry, 2],
    ['MODULE                         ',clc$nominal_entry, 2],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OFFSET                         ',clc$abbreviation_entry, 1],
    ['OUTPUT                         ',clc$nominal_entry, 4],
    ['P                              ',clc$abbreviation_entry, 3],
    ['PO                             ',clc$alias_entry, 1],
    ['PROCEDURE                      ',clc$nominal_entry, 3],
    ['PROCEDURE_OFFSET               ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [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$extended_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ 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
    [5, 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 5
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 7fffffff(16), 10],
    '0'],
{ 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$file_type],
    '$output'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$procedure_offset = 1,
      p$module = 2,
      p$procedure = 3,
      p$output = 4,
      p$status = 5;

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

    VAR
      display_control: clt$display_control,
      length: integer,
      line_index: llt$line_address_table_size,
      line_number: integer,
      line_string: string (30),
      local_status: ost$status,
      module_name: pmt$program_name,
      p_display_control: ^clt$display_control,
      p_line_table: ^llt$line_address_table,
      p_module: ^dbt$module_address_table_item,
      p_symbol: ^llt$symbol_table_item,
      p_symbol_table: ^llt$debug_symbol_table,
      proc_section: llt$section_ordinal,
      procedure_name: pmt$program_name,
      pva: ost$pva,
      symbol_index: llt$symbol_number;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);

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

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

    IF status.normal THEN
      IF (module_name = osc$null_name) THEN
        module_name := v$default_module;
      IFEND;
      find_tables_for_module_name (module_name, 11, FALSE, p_module, p_line_table, p_symbol_table, status);
    IFEND;

    IF status.normal THEN
      IF (procedure_name = osc$null_name) THEN
        procedure_name := v$default_procedure;
      IFEND;
      find_procedure_for_name (p_symbol_table, procedure_name, p_symbol, symbol_index, status);
    IFEND;

    IF status.normal THEN
      proc_section := p_symbol^.proc_section_ordinal;
      pva := p_module^.section_item [proc_section].address;
      pva.offset := pva.offset + p_symbol^.proc_offset + pvt [p$procedure_offset].value^.integer_value.value;
      find_line_number_for_pva (p_module, proc_section, pva, p_line_table, line_index, status);
    IFEND;

    IF status.normal THEN
      line_number := p_line_table^.item [line_index].line_number;
      STRINGREP (line_string, length, 'Line number =', line_number);

      p_display_control := ^display_control;
      dup$open_display (pvt [p$output].value^.file_value^, p_display_control, status);

      IF status.normal THEN
        dup$display_string (p_display_control, length, line_string (1, length), 0, status);
        dup$close_display (p_display_control, FALSE, local_status);
        IF NOT local_status.normal AND status.normal THEN
          status := local_status;
        IFEND;
      IFEND;
    IFEND;
  PROCEND dup$display_line_number;
?? TITLE := 'dup$find_module_table_for_pva', EJECT ??
*copy duh$find_module_table_for_pva

  PROCEDURE [XDCL] dup$find_module_table_for_pva (pva: ost$pva;
    VAR module_item: ^dbt$module_address_table_item;
    VAR section_item_index: llt$section_ordinal;
    VAR status: ost$status);

    module_item := p_first_module;
  /look_for_module_containing_pva/
    WHILE module_item <> NIL DO
      find_section_for_pva (module_item, pva, section_item_index, status);
      IF status.normal = TRUE THEN
        EXIT /look_for_module_containing_pva/;
      IFEND;
      module_item := module_item^.next_module;
    WHILEND /look_for_module_containing_pva/;
{  if we get here and the module address table pointer is nil it
{  means that we searched the entire module table and did not find
{  a module with a section contining the specified pva.
{
    IF module_item = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$pva_not_in_any_module,
            osc$null_name, status);
      RETURN;
    IFEND;
  PROCEND dup$find_module_table_for_pva;
?? TITLE := 'dup$find_procedure_for_pva', EJECT ??
*copyc duh$find_procedure_for_pva

  PROCEDURE [XDCL] dup$find_procedure_for_pva (module_item: ^dbt$module_address_table_item;
        section_item_index: llt$section_ordinal;
        pva: ost$pva;
    VAR symbol_table_address: ^llt$debug_symbol_table;
    VAR symbol_index: llt$symbol_number;
    VAR status: ost$status);

    VAR
      offset: ost$segment_length,
      symbol: ^llt$symbol_table_item,
      symbol_table_index: llt$symbol_number;

    status.normal := TRUE;
{
{  check if the module actually has a symbol table
{
    IF module_item^.debug_symbol_tables = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_symbol_table_in_module, module_item^.name, status);
      RETURN; { ----->
    IFEND;
{
    offset := pva.offset - module_item^.section_item [section_item_index].address.offset;
{
{  now search the symbol table(s) for the required procedure
{
    FOR symbol_table_index := 0 TO UPPERBOUND (module_item^.debug_symbol_tables^) DO
      FOR symbol_index := 1 TO UPPERBOUND (module_item^.debug_symbol_tables^ [symbol_table_index]^.item) DO
        symbol := ^module_item^.debug_symbol_tables^ [symbol_table_index]^.item [symbol_index];
        IF symbol^.symbol_kind = llc$proc_kind THEN
          IF (module_item^.debug_symbol_tables^[symbol_table_index]^.
            language <> llc$fortran) OR ((module_item^.debug_symbol_tables^
            [symbol_table_index]^.language = llc$fortran) AND (symbol^.
            proc_lexical_level = 0)) THEN
            IF (symbol^.proc_section_ordinal = module_item^.section_item[section_item_index].section_ordinal)
                AND (symbol^.proc_offset <= offset) AND
                (symbol^.proc_offset + symbol^.proc_length > offset) THEN
              symbol_table_address := module_item^.debug_symbol_tables^[symbol_table_index];
              RETURN; { ----->
            IFEND;
          IFEND;
        ELSEIF symbol^.symbol_kind = llc$pascal_with_kind THEN
          IF (symbol^.with_section_ordinal = module_item^.section_item[section_item_index].section_ordinal)
              AND (symbol^.with_offset <= offset) AND
                (symbol^.with_offset + symbol^.with_length > offset) THEN
            symbol_table_address := module_item^.debug_symbol_tables^[symbol_table_index];
            RETURN; { ----->
          IFEND;
        IFEND;
      FOREND;
    FOREND;

{  procedure not found for this address.

    osp$set_status_abnormal (duc$symbolic_id, due$pva_not_in_known_proc,
          osc$null_name, status);

  PROCEND dup$find_procedure_for_pva;
?? TITLE := 'dup$find_stack_frame_for_proc', EJECT ??

  PROCEDURE [XDCL] dup$find_stack_frame_for_proc (proc_start: ost$pva;
    proc_length: ost$segment_length;
    search_direction: dut$stack_search_direction;
    target_sf_number: dut$proc_recursion_number;
    VAR target_sf: ost$pva;
    VAR target_sf_save_area: ^ost$stack_frame_save_area;
    VAR status: ost$status);

    VAR
      trapped_sf_found: boolean,
      trapped_to_first_target_sf_num,
      trapped_to_first_sf_counter,
      total_sf_count_for_proc: dut$proc_recursion_number,
      trapped_sf_sa_ptr: ^cell,
      sa_ptr: ^ost$stack_frame_save_area,
      sa_p_register: ost$pva;


    find_trapped_stack_frame (trapped_sf_sa_ptr, trapped_sf_found);
    IF NOT trapped_sf_found THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_trap_has_occurred, osc$null_name,
        status);
      RETURN; {------>
    IFEND;

{If search_direction is duc$trapped_to_first then the search takes place backwards starting with the last
{(i.e. trapped) stack frame in direction of the first stack frame of the task. The search counter
{trapped_to_first_sf_counter is increased by one each time a stack frame to the procedure identified by
{proc_start is encountered. The search is continued until the search counter reaches the value
{of target_sf_number, or the first frame of the task is reached, in which case there are fewer frames
{for that procedure in the stack than target_sf_number expresses.
{Note that there are always 3 or 4 system stack frames on top of the trapped user frame.
{
{If search_direction is duc$first_to_trapped, the search direction is conceptually forwards starting
{with the first procedure of the stack in direction of the trapped frame of the task until the
{target_sf_number'th frame to that procedure is encountered, or the top of stack is reached.
{Note, however, the actual searching can take place only from trapped to first frame (see previous save area).
{Therefore, when search_direction is duc$first_to_trapped, we have to search at first all the way to the first
{frame, obtain the total number of frames belonging to that procedure, recalculate the position of the
{target_sf in terms of trapped_to_first direction, the search the stack again in backward direction
{until the target frame is found.


{Calculate the value of trapped_to_first_target_sf_num. This value represents the position of the
{target stack frame assuming a search direction from trapped to first frame.

    IF search_direction = duc$trapped_to_first THEN
      trapped_to_first_target_sf_num := target_sf_number;
    ELSE {search direction is from first to trapped stack frame}
      sa_ptr := trapped_sf_sa_ptr;
      trapped_to_first_sf_counter := 0;
      WHILE sa_ptr <> NIL DO
        sa_p_register := sa_ptr^.minimum_save_area.p_register.pva;
        IF (sa_p_register.ring = proc_start.ring) AND
          (sa_p_register.seg = proc_start.seg) AND
          (proc_start.offset <= sa_p_register.offset) AND
          (sa_p_register.offset < proc_start.offset + proc_length) THEN
          trapped_to_first_sf_counter := trapped_to_first_sf_counter + 1;
        IFEND;
        pmp$validate_previous_save_area (sa_ptr, status);
        IF NOT status.normal THEN
          RETURN; {------>
        IFEND;
        sa_ptr := sa_ptr^.minimum_save_area.a2_previous_save_area;
      WHILEND;
      total_sf_count_for_proc := trapped_to_first_sf_counter;
      IF total_sf_count_for_proc < target_sf_number THEN
        IF total_sf_count_for_proc = 0 THEN    {the procedure is not active}
          osp$set_status_abnormal (duc$symbolic_id, due$procedure_not_active,
                   '', status);
        ELSE     {recursion_level parameter too big}
          osp$set_status_abnormal (duc$symbolic_id, due$target_sf_number_too_big,
                   '', status);
        IFEND;
        RETURN; {----->
      ELSE
        trapped_to_first_target_sf_num := total_sf_count_for_proc - target_sf_number + 1;
      IFEND;
    IFEND;

{Find target stack frame to procedure with target_sf_number parameter value if search_direction is
{duc$trapped_to_first, or with recalculated target stack frame number if search_direction is
{duc$first_to_trapped.

    sa_ptr := trapped_sf_sa_ptr;
    trapped_to_first_sf_counter := 0;
    WHILE sa_ptr <> NIL DO
      sa_p_register := sa_ptr^.minimum_save_area.p_register.pva;
      IF sa_ptr <> trapped_sf_sa_ptr THEN
{Assume all stack frames but the trapped stack frame were laid down by call
{instructions, meaning that the p-register points to the instruction following
{the call.  Subtract 4 from the p-register to get the address of the call.
        sa_p_register.offset := sa_p_register.offset - 4;
      IFEND;
      IF (sa_p_register.ring = proc_start.ring) AND
        (sa_p_register.seg = proc_start.seg) AND
        (proc_start.offset <= sa_p_register.offset) AND
        (sa_p_register.offset < proc_start.offset + proc_length) THEN
        trapped_to_first_sf_counter := trapped_to_first_sf_counter + 1;
        IF trapped_to_first_sf_counter = trapped_to_first_target_sf_num THEN
          target_sf.ring := #ring (sa_ptr^.minimum_save_area.a1_current_stack_frame);
          target_sf.seg := #segment (sa_ptr^.minimum_save_area.a1_current_stack_frame);
          target_sf.offset := #offset (sa_ptr^.minimum_save_area.a1_current_stack_frame);
          target_sf_save_area := sa_ptr;
          RETURN; {----->
        IFEND
      IFEND;
      IF search_direction = duc$trapped_to_first THEN
        pmp$validate_previous_save_area (sa_ptr, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;
      sa_ptr := sa_ptr^.minimum_save_area.a2_previous_save_area;
    WHILEND;
    IF trapped_to_first_sf_counter = 0 THEN    {the procedure is not active}
      osp$set_status_abnormal (duc$symbolic_id, due$procedure_not_active,
               '', status);
    ELSE     {recursion_level parameter too big}
      osp$set_status_abnormal (duc$symbolic_id, due$target_sf_number_too_big,
               '', status);
    IFEND;

  PROCEND dup$find_stack_frame_for_proc;
?? TITLE := 'dup$locate_next_symbol', EJECT ??

*copyc duh$locate_next_symbol
  PROCEDURE [XDCL] dup$locate_next_symbol (symbol_table_address: ^llt$debug_symbol_table;
    VAR symbol_entry: {input,output} dut$symbol_entry;
    VAR status: ost$status);

    VAR
      symbol_index: llt$symbol_number;

    status.normal := TRUE;
{
{  check if the module actually has a symbol table
{
    IF symbol_table_address = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$symbol_table_not_available, osc$null_name, status);
      RETURN; { ----->
    IFEND;
{
{ now step to the next symbol table entry
{
    IF symbol_entry.table_entry_index < symbol_table_address^.number_of_items THEN
      symbol_index := symbol_entry.table_entry_index + 1;
      symbol_entry.table_entry_index := symbol_index;
      symbol_entry.symbol := ^symbol_table_address^.item [symbol_index];
    ELSE
      symbol_entry.symbol := NIL;   { No more entries in the symbol table }
    IFEND;

  PROCEND dup$locate_next_symbol;
?? TITLE := 'dup$locate_symbol_for_number', EJECT ??

*copyc duh$locate_symbol_for_number
  PROCEDURE [XDCL] dup$locate_symbol_for_number (symbol_table_address: ^llt$debug_symbol_table;
        symbol_number: llt$symbol_number;
    VAR symbol_entry: dut$symbol_entry;
    VAR status: ost$status);

    VAR
      symbol_index: llt$symbol_number;

    status.normal := TRUE;
{
{  check if the module actually has a symbol table
{
    IF symbol_table_address = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$symbol_table_not_available, osc$null_name, status);
      RETURN; { ----->
    IFEND;
{
{  now search the symbol table for the required number.  Use symbol number as index if possible.
{
    IF llc$symbol_number_is_index IN symbol_table_address^.attributes THEN
      IF (symbol_number <= 0) OR (symbol_number > symbol_table_address^.number_of_items) THEN
        osp$set_status_abnormal (duc$symbolic_id, due$symbol_number_not_found, osc$null_name, status);
        RETURN; { ----->
      IFEND;
      symbol_entry.table_entry_index := symbol_number;
      symbol_entry.symbol := ^symbol_table_address^.item[symbol_number];
      RETURN; {----->
    ELSE
      FOR symbol_index := 1 TO UPPERBOUND (symbol_table_address^.item) DO
        IF symbol_number = symbol_table_address^.item [symbol_index].symbol_number
              THEN
          symbol_entry.table_entry_index := symbol_index;
          symbol_entry.symbol := ^symbol_table_address^.item [symbol_index];
          RETURN; { ----->
        IFEND;
      FOREND;
    IFEND;
{
{  if we get here, the required symbol number was not found in
{  the symbol table.  This is impossible in principle.
{
    osp$set_status_abnormal (duc$symbolic_id, due$symbol_number_not_found,
          osc$null_name, status);

  PROCEND dup$locate_symbol_for_number;
?? TITLE := 'dup$locate_variable_symbol', EJECT ??

  PROCEDURE [XDCL] dup$locate_variable_symbol (
        variable_name: pmt$program_name;
        home_spec: dut$home_specification;
        search_options: dut$variable_search_options;
    VAR symbol_entry: dut$symbol_entry;
    VAR nested_proc: boolean;
    VAR current_proc: dut$symbol_entry;
    VAR status: ost$status);

{ PURPOSE: Find the symbol entry for the given variable name. }

    VAR
      first_symbol_number: llt$symbol_number,
      parent_symbol_number: llt$symbol_number,
      proc_start: ost$pva,
      module_level_searched: boolean,
      stack_frame_save_area: ^ost$stack_frame_save_area,
      true_procedure_entry: dut$symbol_entry,
      variable_spec: dut$variable_specification;

    current_proc := home_spec.procedure_entry;
    nested_proc := FALSE;
    module_level_searched := FALSE;

    REPEAT

/search_lexical_level/
      BEGIN
        IF current_proc.symbol <> NIL THEN
          IF current_proc.symbol^.symbol_kind = llc$proc_kind THEN
            first_symbol_number := current_proc.symbol^.first_symbol_for_proc;
          ELSE { Must be a WITH block }
            first_symbol_number := current_proc.symbol^.with_first_symbol;
          IFEND;
          IF first_symbol_number = 0 THEN
            EXIT /search_lexical_level/; {no symbols at this level}
          IFEND;
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                first_symbol_number, symbol_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          module_level_searched := TRUE;
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                home_spec.symbol_table_address^.first_symbol_for_module,
                symbol_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        WHILE TRUE DO
          IF ((symbol_entry.symbol^.symbol_kind = llc$var_kind) OR
              (symbol_entry.symbol^.symbol_kind = llc$constant_kind)) AND
             (symbol_entry.symbol^.symbol_name = variable_name) THEN
{ We have found the variable ... }
            RETURN;
          ELSE
{ Get the next symbol in the chain }
            IF symbol_entry.symbol^.end_of_chain THEN
              EXIT /search_lexical_level/;
            IFEND;
            dup$locate_next_symbol (home_spec.symbol_table_address,
                  symbol_entry, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        WHILEND;
      END /search_lexical_level/;

{ Check the next outer level of procedure nesting if there is one }

      IF (current_proc.symbol <> NIL) AND
         (NOT (duc$search_outer_procedures IN search_options)) AND
         (NOT (llc$proc_uses_outer_level_stack IN current_proc.symbol^.proc_attributes)) THEN
        current_proc.symbol := NIL;  { NIL means check module level next }
      IFEND;
      IF current_proc.symbol <> NIL THEN
        IF current_proc.symbol^.symbol_kind = llc$proc_kind THEN
          parent_symbol_number := current_proc.symbol^.proc_parent;
        ELSE { Must be WITH block }
          parent_symbol_number := current_proc.symbol^.with_parent;
        IFEND;
        IF parent_symbol_number = 0 THEN
          current_proc.symbol := NIL;
        ELSE
{ WITH blocks and procs that share outer level stack don't count as nested }
          IF (current_proc.symbol^.symbol_kind = llc$proc_kind) AND
             NOT (llc$proc_uses_outer_level_stack IN current_proc.symbol^.proc_attributes) THEN
            nested_proc := TRUE;
          IFEND;
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                parent_symbol_number, current_proc, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;
      IF (current_proc.symbol = NIL) AND
         (NOT(duc$search_module_level IN search_options)) THEN
        module_level_searched := TRUE; { Don't search the module level }
      IFEND;
    UNTIL module_level_searched;

    osp$set_status_abnormal (duc$symbolic_id, due$variable_not_found,
          variable_name, status);

  PROCEND dup$locate_variable_symbol;
?? TITLE := 'dup$simulate_variable', EJECT ??

  PROCEDURE [XDCL] dup$simulate_variable (home_spec: dut$home_specification;
        address: ost$pva;
        type_name: pmt$program_name;
    VAR variable_spec: dut$variable_specification;
    VAR status: ost$status);

    VAR
      maximum: integer,
      p_cell: ^cell,
      symbol_entry: dut$symbol_entry;

    locate_named_symbol (type_name, home_spec, symbol_entry, status);
    IF not status.normal THEN
      RETURN;
    IFEND;

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

    variable_spec.name := symbol_entry.symbol^.symbol_name;
    variable_spec.symbol_entry := symbol_entry;
    variable_spec.address := address;
    variable_spec.length_is_bits := FALSE;
    variable_spec.bit_offset := 0;
    variable_spec.range_specified := FALSE;
    variable_spec.constant_value := FALSE;

    CASE symbol_entry.symbol^.symbol_kind OF
    = llc$longreal_kind =
      variable_spec.length := 16;
    = llc$integer_kind, llc$real_kind =
      variable_spec.length := 8;
    = llc$boolean_kind, llc$char_kind, llc$cell_kind =
      variable_spec.length := 1;
    = llc$subrange_kind =
      IF (symbol_entry.symbol^.low_value < 0) THEN
        variable_spec.length := 8;
      ELSE
        variable_spec.length := 0;
        maximum := symbol_entry.symbol^.high_value;
        REPEAT
          variable_spec.length := variable_spec.length + 1;
          maximum := maximum DIV 256;
        UNTIL (maximum = 0);
      IFEND;
    = llc$set_kind =
      variable_spec.length := (symbol_entry.symbol^.set_length + 7) DIV 8;
    = llc$ordinal_kind =
      variable_spec.length := 0;
      maximum := symbol_entry.symbol^.ordinal_upper_bound;
      REPEAT
        variable_spec.length := variable_spec.length + 1;
        maximum := maximum DIV 256;
      UNTIL (maximum = 0);
    = llc$cybil_array_kind =
      variable_spec.length := symbol_entry.symbol^.cybil_array_element_length;
    = llc$pointer_kind =
      variable_spec.length := #SIZE (p_cell);
    = llc$string_kind =
      variable_spec.length := symbol_entry.symbol^.string_length;
    = llc$bound_vrec_kind =
      dup$locate_symbol_for_number (home_spec.symbol_table_address, symbol_entry.symbol^.bound_type,
            symbol_entry, status);
      IF status.normal THEN
        variable_spec.symbol_entry := symbol_entry;
        variable_spec.length := symbol_entry.symbol^.record_length;
      IFEND;
    = llc$record_kind =
      variable_spec.length := symbol_entry.symbol^.record_length;
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$unsupported_type, type_name, status);
    CASEND;
  PROCEND dup$simulate_variable;
?? TITLE := 'check_for_prolog', EJECT ??
{   This routine checks to see if the variables normally available for the
{    given home_spec, are unavailable because we are stopped in prolog
{    code.  A normal status is returned if
{         - The stack frame to be used in the display is not the current
{            stack frame.
{         - The current pva is in a different module or procedure than
{            described in home_spec.
{         - The current pva is not the first byte of a line which contains
{            prolog code.
{    Since the length of prologs are not available to DEBUG, this
{    routine only checks the current pva against the first byte of the
{    prolog.
{   An abnormal status is returned if
{         - An error is returned from any of the look-up routines.
{         - A line table exists for the module but no line covers the
{            current pva.  We will assume prolog in this case.
{         - The current pva is the first byte of a line which contains
{            prolog code.

  PROCEDURE check_for_prolog (
        home_spec: dut$home_specification;
        stack_frame: ost$stack_frame_save_area;
        variable_name: pmt$program_name;
    VAR status: ost$status);

    VAR
      aux_ptr: ^ost$pva,
      found: boolean,
      line_table_ptr: ^llt$line_address_table,
      line_item_index: llt$line_address_table_size,
      line_table_item: llt$line_address_item,
      module_table_ptr: ^dbt$module_address_table_item,
      pva: ost$pva,
      section_item_index: llt$section_ordinal,
      symbol_index: llt$symbol_number,
      symbol_table_ptr: ^llt$debug_symbol_table,
      trapped_sf: stack_image_pointer;

    status.normal := TRUE;
    pva := stack_frame.minimum_save_area.p_register.pva;
    dup$find_module_table_for_pva (pva, module_table_ptr, section_item_index,
                   status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (duc$symbolic_id, due$in_prolog_code,
                   variable_name, status);
      RETURN; {----->
    IFEND;
    IF home_spec.module_item <> module_table_ptr THEN
      RETURN; {----->     different module
    IFEND;

    dup$find_procedure_for_pva (module_table_ptr, section_item_index, pva,
                   symbol_table_ptr, symbol_index, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (duc$symbolic_id, due$in_prolog_code,
                   variable_name, status);
      RETURN; { ----->
    IFEND;
    IF home_spec.procedure_entry.table_entry_index <> symbol_index THEN
      RETURN; {----->     different procedure
    IFEND;

    find_line_number_for_pva (module_table_ptr, section_item_index, pva, line_table_ptr,
          line_item_index, status);
    IF NOT status.normal THEN
      IF status.condition = due$no_line_numbers_in_module THEN
        status.normal := TRUE;  {can't tell anything if no line table}
      ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$in_prolog_code,
                   variable_name, status);
      IFEND;
      RETURN; {----->
    IFEND;

    CASE home_spec.language OF
    = llc$cybil, llc$obsolete_cybil =
      IF line_table_ptr^.item[line_item_index].cybil_statement_kind =
                              llc$cybil_procedure THEN
{ If the pva (where we are stopped) is the beginning of the line, return
{   the 'in prolog' error status.   Currently, we cannot tell how long the
{   prolog is, so if by chance we are stopped in the middle of the prolog,
{   that's tuff cookies.  We can only recognize the beginning.
        IF (pva.offset - module_table_ptr^.section_item[section_item_index].address.
                     offset) = line_table_ptr^.item[line_item_index].offset THEN
          osp$set_status_abnormal (duc$symbolic_id, due$in_prolog_code,
               variable_name, status);
          RETURN; {----->
        IFEND;
      IFEND;
    ELSE
      IF llc$prolog_code IN line_table_ptr^.item [line_item_index].line_attributes THEN
{ If this line entry is prolog code, don't return error if the last line entry
{  is the same line and is prolog code.  This is for BASIC which likes to jump
{  to subroutine statements.
        IF (line_item_index = 1) OR
           (line_table_ptr^.item[line_item_index].line_number <>
                    line_table_ptr^.item[line_item_index - 1].line_number) OR
           (NOT(llc$prolog_code IN line_table_ptr^.item[line_item_index - 1].line_attributes)) THEN
          osp$set_status_abnormal (duc$symbolic_id, due$in_prolog_code, variable_name,
             status);
          RETURN; {----->
        IFEND;
      IFEND;
    CASEND;
  PROCEND check_for_prolog;
?? TITLE := 'create_module_item', EJECT ??

  PROCEDURE create_module_item (module_name: pmt$program_name;
        greatest_section_ordinal: llt$section_ordinal;
    VAR p_module_item: ^dbt$module_address_table_item;
    VAR status: ost$status);

    VAR
      section_ordinal: llt$section_ordinal,
      section_item: dbt$section_item;

    status.normal := TRUE;
    NEXT p_module_item: [0 .. greatest_section_ordinal] IN p_debug_directory;

    p_module_item^.name := module_name;
    p_module_item^.language := llc$unknown_generator;
    p_module_item^.greatest_section_ordinal := greatest_section_ordinal;
    p_module_item^.application_identifier := NIL;
    p_module_item^.reinitialization_information := NIL;
    p_module_item^.next_module := NIL;
    p_module_item^.line_address_tables := NIL;
    p_module_item^.debug_symbol_tables := NIL;
    p_module_item^.supplemental_debug_tables := NIL;

    section_item.kind := llc$lts_reserved;
    section_item.address.ring := 0;
    section_item.address.seg := 0;
    section_item.address.offset := 0;
    section_item.length := 0;
    section_item.segment_access_control.cache_bypass := FALSE;
    section_item.segment_access_control.execute_privilege := osc$non_executable;
    section_item.segment_access_control.read_privilege := osc$non_readable;
    section_item.segment_access_control.write_privilege := osc$non_writable;
    section_item.ring.r1 := 0;
    section_item.ring.r2 := 0;
    section_item.ring.r3 := 0;
    section_item.key_lock.global := FALSE;
    section_item.key_lock.local := FALSE;
    section_item.key_lock.value := 0;
    section_item.name := osc$null_name;

    FOR section_ordinal := 0 to greatest_section_ordinal DO
      section_item.section_ordinal := section_ordinal;
      p_module_item^.section_item [section_ordinal] := section_item;
    FOREND;
  PROCEND create_module_item;
?? TITLE := 'find_entry_point_item', EJECT ??
{
{  This procedure searches the entry point table for an entry point of
{  a specified name.
{
{  FIND_ENTRY_POINT_ITEM (NAME, ENTRY, STATUS)
{
{  NAME : (input)    is the name of the entry point for which the
{                    entry point table is to be searched
{
{  ENTRY : (output)  is the required entry point table item (if found)
{
{  STATUS : (output) is the status of the request. Possible value(s):
{                      due$named_entry_point_not_found
{

  PROCEDURE find_entry_point_item (name: pmt$program_name;
    VAR entry_point_table_item: dbt$entry_point_table_item;
    VAR status: ost$status);

    VAR
      entry_point: dbt$entry_point_table_item,
      found: boolean,
      module_name: pmt$program_name,
      segment: ost$segment,
      offset: ost$segment_offset;

    ocp$find_debug_entry_point (name, found, module_name, segment, offset, status);

    IF status.normal THEN
      IF found THEN
        entry_point.name := name;
        entry_point.call_bracket := UPPERVALUE (ost$ring);
        entry_point.loaded_ring := UPPERVALUE (ost$ring);
        entry_point.global_lock := 0;
        entry_point.address.ring := UPPERVALUE (ost$ring);
        entry_point.address.seg := segment;
        entry_point.address.offset := offset;
        entry_point_table_item := entry_point;
      ELSE
        osp$set_status_abnormal (duc$symbolic_id, due$named_entry_point_not_found,name, status);
      IFEND;
    IFEND;
  PROCEND find_entry_point_item;
?? TITLE := 'find_line_number_for_pva', EJECT ??
{
{  This procedure searches the line address table for a specific
{  module to determine if there is a line that contains that pva.
{
{  FIND_LINE_NUMBER_FOR_PVA (MODULE, SECTION_INDEX, PVA, LINE, LINE_INDEX, STATUS)
{
{  MODULE : (input)  is the module address table item in which the
{                    pva is located.
{
{  SECTION_INDEX : (input) is the index of the section definition record
{                    within the array of section definition records
{                    containing the pva.
{
{  PVA : (input)     is the pva for which the line address table is
{                    to be searched.
{
{  LINE : (output)   is the pointer to the line address table (if one is
{                    found) which contains the pva.
{
{  LINE_INDEX : (output) is the line item index in the line address table.
{
{  STATUS : (output) is the status of the request. Possible value(s):
{                      due$no_line_numbers_in_module
{                      due$pva_not_line_number
{

  PROCEDURE find_line_number_for_pva (module_item: ^dbt$module_address_table_item;
    section_item_index: llt$section_ordinal;
    pva: ost$pva;
    VAR line_table: ^llt$line_address_table;
    VAR line_item_index: llt$line_address_table_size;
    VAR status: ost$status);

    VAR
      line_table_index: integer,
      sect_item: dbt$section_item,
      relative_offset: llt$section_offset;

    status.normal := TRUE;
{
{  check if this module actually has any line number tables
{
    IF module_item^.line_address_tables = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_line_numbers_in_module,
        osc$null_name, status);
      RETURN; {----->
    IFEND;
{
{  module does have line number tables.  Search to see if this
{  address corresponds to a line number in this module.
{
    sect_item := module_item^.section_item[section_item_index];
    relative_offset := pva.offset - module_item^.section_item[section_item_index].address.offset;
    FOR line_table_index := 0 TO UPPERBOUND (module_item^.line_address_tables^) DO
      FOR line_item_index := 1 TO UPPERBOUND (module_item^.line_address_tables^ [line_table_index]^.item) DO
        IF (sect_item.section_ordinal = module_item^.line_address_tables^ [line_table_index]^.item
          [line_item_index].section_ordinal) AND (relative_offset >= module_item^.line_address_tables^
            [line_table_index]^.item [line_item_index].offset) AND (relative_offset < module_item^.
            line_address_tables^[line_table_index]^.item [line_item_index].offset + module_item^.
            line_address_tables^ [line_table_index]^.item [line_item_index].extent) THEN
{
{  the line number has actually been found
{
          line_table := module_item^.line_address_tables^ [line_table_index];
          RETURN; {----->
        IFEND;
      FOREND;
    FOREND;
{
{  if we get here we have searched all the line address tables
{  and have not found a match for the pva we have.  This
{  situation would occur when a bound module has been encountered
{  without line numbers.  For the time being we will return a bad
{  status.
{
    osp$set_status_abnormal (duc$symbolic_id, due$pva_not_line_number,
          osc$null_name, status);
    RETURN; {----->
  PROCEND find_line_number_for_pva;
?? TITLE := 'find_procedure_for_name', EJECT ??
{
{  This procedure locates the symbol table item which corresponds to
{  the specified name.
{
{  FIND_PROCEDURE_FOR_NAME (ADDRESS, NAME, SYMBOL, INDEX, STATUS)
{
{  ADDRESS : (input)    is a pointer to the debug symbol table.
{
{  NAME : (input)       is the name of the procedure to be located.
{
{  SYMBOL : (output)    is a pointer to the debug symbol table entry.
{
{  INDEX : (output)     is the index of the symbol table item.
{
{  STATUS : (OUTPUT)    is the status of the request. Possible value(s):
{                         due$no_symbol_table_in_module
{                         due$proc_not_in_module
{

  PROCEDURE find_procedure_for_name (symbol_table_address: ^llt$debug_symbol_table;
        name: pmt$program_name;
    VAR symbol: ^llt$symbol_table_item;
    VAR symbol_index: llt$symbol_number;
    VAR status: ost$status);

    VAR
      case_sensitive: boolean,
      temp_name: pmt$program_name;

    status.normal := TRUE;
{
{  check if the module actually has a symbol table
{
    IF symbol_table_address = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$symbol_table_not_available, osc$null_name, status);
      RETURN; { ----->
    IFEND;
    case_sensitive := llc$language_is_case_sensitive IN
                             symbol_table_address^.attributes;
{
{  now search the symbol table for the required procedure
{
    FOR symbol_index := 1 TO UPPERBOUND (symbol_table_address^.item) DO
      symbol := ^symbol_table_address^.item [symbol_index];
      IF (symbol^.symbol_kind = llc$proc_kind) THEN
        IF ((case_sensitive) AND (symbol^.symbol_name = name)) OR
           ((NOT case_sensitive) AND (i#compare_collated(symbol^.symbol_name,
                           name, osv$lower_to_upper) = 0)) THEN
          IF NOT((symbol^.proc_length = 0) AND
               (symbol^.first_symbol_for_proc = 0)) THEN {Ignore XREF'd procs}
            RETURN; { ----->
          IFEND;
        IFEND;
      IFEND;
    FOREND;

{  procedure not found for this name.

    temp_name := name;
    IF NOT case_sensitive THEN
      #TRANSLATE (osv$lower_to_upper, temp_name, temp_name);
    IFEND;
    osp$set_status_abnormal (duc$symbolic_id, due$proc_not_in_module, temp_name, status);
    osp$append_status_parameter (osc$status_parameter_delimiter,
      symbol_table_address^.original_module_name, status);

  PROCEND find_procedure_for_name;
?? TITLE := 'find_section_for_pva', EJECT ??
{
{  This procedure searches the section definition records of a specific
{  module to locate a section that contains the pva.
{
{  FIND_SECTION_FOR_PVA (MODULE, PVA, SECTION, STATUS)
{
{  MODULE : (input)  is a pointer to the module address table item
{                    containing the section definition records to be searched.
{
{  PVA : (input)     is the pva for which the section definition records
{                    are to be searched.
{
{ SECTION : (output) is the index of the section definition record
{                    within the array of section definition records
{                    (if one is found) containing the pva.
{
{  STATUS : (output) is the request status. Possible value(s):
{                      due$pva_not_in_section
{

  PROCEDURE find_section_for_pva (module_item: ^dbt$module_address_table_item;
    pva: ost$pva;
    VAR section_item_index: llt$section_ordinal;
    VAR status: ost$status);

    status.normal := TRUE;
    FOR section_item_index := 0 TO UPPERBOUND (module_item^.section_item) DO
      IF (pva.ring = module_item^.section_item [section_item_index].address.ring) AND (pva.seg =
        module_item^.section_item [section_item_index].address.seg) AND ((pva.offset >= module_item^.
          section_item [section_item_index].address.offset) AND (pva.offset < module_item^.section_item
          [section_item_index].address.offset + module_item^.section_item [section_item_index].length)) THEN
        RETURN; { ----->
      IFEND;
    FOREND;
{
{  if we get here we've been through the section table without
{  finding a section that contains the given pva.
{
    osp$set_status_abnormal (duc$symbolic_id, due$pva_not_in_section, osc$null_name, status);
  PROCEND find_section_for_pva;
?? TITLE := 'find_section_for_specs', EJECT ??
{
{  The purpose of this request is to find the section that satisfies some given specifications.
{  The specifications are in terms of the section kind, section name and  access privileges
{  (execute, read, write).
{
{  FIND_SECTION_FOR_SPECS (MODULE, KIND, NAME, EXECUTE, READ, WRITE, SECTION, STATUS)
{
{  MODULE:  (input)   This parameter specifies the module which is searched for the section.
{
{  KIND:  (input)     This parameter specifies the kind (code, working storage, etc.) of the
{                     section to be found.
{
{  NAME:  (input)     This parameter specifies the name of the section to be found.
{                     This is either the name of a CYBIL section, or the null name.
{
{  EXECUTE:  (input)  This parameter specifies the execute privilege of the section to be found.
{
{  READ:  (input)     This parameter specifies the read privilege of the section to be found.
{
{  WRITE:  (input)    This parameter specifies the write privilege of the section to be found.
{
{  SECTION:  (output) This parameter specifies the section that satisfies the input specifications.
{
{  STATUS:  (output)  This parameter specifies the request status. Possible value(s):
{                       due$specd_section_not_in_module
{

  PROCEDURE find_section_for_specs (module_item: ^dbt$module_address_table_item;
    section_kind: llt$section_kind;
    section_name: pmt$program_name;
    execute_privileges: set of ost$execute_privilege;
    read_privileges: set of ost$read_privilege;
    write_privileges: set of ost$write_privilege;
    VAR section_item: dbt$section_item;
    VAR status: ost$status);

    VAR
      section_item_index: integer;

    status.normal := TRUE;
    FOR section_item_index := 0 TO UPPERBOUND (module_item^.section_item) DO
      section_item := module_item^.section_item [section_item_index];
      IF (section_item.kind = section_kind) AND (i#compare_collated (section_item.name, section_name,
        osv$lower_to_upper) = 0) AND (section_item.segment_access_control.execute_privilege IN
          execute_privileges) AND (section_item.segment_access_control.read_privilege IN read_privileges) AND
          (section_item.segment_access_control.write_privilege IN write_privileges) THEN
        RETURN; {------->
      IFEND;
    FOREND;
{
{ If we get here we have been thru the section table without finding a section item of the given
{ specifications for section kind, section name, and section access privileges.
{
    osp$set_status_abnormal (duc$symbolic_id, due$specd_section_not_in_module,
      section_name, status);
  PROCEND find_section_for_specs;
?? TITLE := 'find_sf_pointers_and_length', EJECT ??

  PROCEDURE find_sf_pointers_and_length (starting_sf_save_area_ptr: ^cell;
        target_sf_number: integer;
    VAR target_sf_ptr: ^cell;
    VAR target_sf_save_area_ptr: ^cell;
    VAR target_sf_length: integer;
    VAR status: ost$status);

    VAR
      frame_number: integer,
      scan_save_area: ^ost$stack_frame_save_area;

    IF starting_sf_save_area_ptr = NIL THEN
      scan_save_area := #previous_save_area ();
    ELSE
      scan_save_area := starting_sf_save_area_ptr;
    IFEND;

  /find_target_sf/
    FOR frame_number := 1 TO target_sf_number - 1 DO
      scan_save_area := scan_save_area^.minimum_save_area.a2_previous_save_area;
      IF scan_save_area = NIL THEN
        EXIT /find_target_sf/;
      IFEND;
    FOREND /find_target_sf/;
    IF NOT (scan_save_area = NIL) THEN
      target_sf_ptr := scan_save_area^.minimum_save_area.a1_current_stack_frame;
      target_sf_save_area_ptr := scan_save_area;
      target_sf_length := #offset (target_sf_save_area_ptr) - #offset (target_sf_ptr);
    ELSE
      target_sf_ptr := NIL;
      target_sf_save_area_ptr := NIL;
      target_sf_length := 0;
    IFEND;
  PROCEND find_sf_pointers_and_length;
?? TITLE := 'find_statement_label', EJECT ??
{
{   This procedure searches the symbol table for the given statement
{    label name and returns the label's symbol table entry.  If the statement
{    label is not found, symbol_entry.symbol is set to NIL.  Only symbols in the
{    scope of the procedure specified in home_spec are examined.  For nested
{    languages (e.g. CYBIL), this means if the label exists in an outer
{    procedure, it is not found.  In this case, the user needs to specify the
{    PROCEDURE to further qualify the label.
{
{   FIND_STATEMENT_LABEL (home_spec, label_name, symbol, status)
{
{   home_spec : (INPUT)    The home specification as built by
{                           dup$build_home_spec
{
{   label_name : (INPUT)   The name of the desired label as it appears in the
{                           symbol table.
{
{   symbol : (OUTPUT)      Contains a pointer to the symbol table entry of the
{                           label, if found, and contains a NIL pointer, if not
{                           found.
{
{   status : (OUTPUT)      Contains the status of the request.

  PROCEDURE find_statement_label (
        home_spec: dut$home_specification;
        label_name: pmt$program_name;
    VAR symbol_entry: dut$symbol_entry;
    VAR status: ost$status );

    VAR
      first_symbol_number: llt$symbol_number,
      section_symbol_entry: dut$symbol_entry;

    status.normal := TRUE;
    symbol_entry.symbol := NIL;

{ Statement labels are described in the symbol table. See if it is there }

    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;

{ Make sure there is a procedure_entry }

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

    first_symbol_number := home_spec.procedure_entry.symbol^.first_symbol_for_proc;
    IF first_symbol_number = 0 THEN
      osp$set_status_abnormal (duc$symbolic_id, due$label_not_found, label_name, status);
      RETURN; {----->  label not in the specified procedure }
    IFEND;
    dup$locate_symbol_for_number (home_spec.symbol_table_address, first_symbol_number,
                  symbol_entry, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

/label_search/
    REPEAT
      IF (symbol_entry.symbol^.symbol_name = label_name) AND
         (symbol_entry.symbol^.symbol_kind = llc$label_kind) THEN
        EXIT /label_search/;
      IFEND;
      IF ((home_spec.language IN nested_procedures) AND (symbol_entry.symbol^.end_of_chain = TRUE)) THEN
        symbol_entry.symbol := NIL;
        EXIT /label_search/;
      IFEND;
      dup$locate_next_symbol (home_spec.symbol_table_address, symbol_entry, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    UNTIL symbol_entry.symbol = NIL;

    IF symbol_entry.symbol = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$label_not_found, label_name, status);
    IFEND;

  PROCEND find_statement_label;
?? TITLE := 'find_tables_for_module_name', EJECT ??
{
{  This procedure searches the module address table to find a module of a
{  specified name.  It also returns the line table address and the symbol
{  table address.
{
{  FIND_TABLES_FOR_MODULE_NAME (NAME, MODULE, LINE, SYMBOL, STATUS)
{
{  NAME : (input)    is the name of the module for which the module
{                    address table is to be searched.
{
{  RING : (input)    The first named module residing in the specified ring will
{                    be found.  If none is found but ring_must_match is false,
{                    the first named module residing in any ring will be found.
{
{  RING_MUST_MATCH : If true, the module must reside in the ring specified.
{     (input)        If false, a module residing in the specified ring will be
{                    chosen before a module residing in any other ring.
{
{  MODULE : (output) is a pointer to the module address table
{
{  LINE : (output)   is a pointer to the line address table
{
{  SYMBOL : (output) is a pointer to the debug symbol table
{                    entry (if one is found).
{
{  STATUS : (output) is the status of the request. Possible value(s):
{                      due$named_module_not_found
{

  PROCEDURE find_tables_for_module_name (
        name: pmt$program_name;
        target_ring: ost$ring;
        ring_must_match: boolean;
    VAR module_item: ^dbt$module_address_table_item;
    VAR line_table_address: ^llt$line_address_table;
    VAR symbol_table_address: ^llt$debug_symbol_table;
    VAR status: ost$status);

    VAR table_index: integer,
        temp_name: pmt$program_name,
        case_sensitive_module_found: boolean,
        current_line_table: ^llt$line_address_table,
        current_symbol_table: ^llt$debug_symbol_table,
        saved_table_index: integer,
        saved_module_item: ^dbt$module_address_table_item;

    status.normal := TRUE;
    saved_module_item := NIL;
    module_item := p_first_module;
    case_sensitive_module_found := FALSE;
    line_table_address := NIL;
    symbol_table_address := NIL;
  /search_for_original_name/
    WHILE module_item <> NIL DO
      IF module_item^.debug_symbol_tables <> NIL THEN
        FOR table_index := 0 TO UPPERBOUND (module_item^.debug_symbol_tables^) DO
          current_symbol_table := module_item^.debug_symbol_tables ^[table_index];
          IF llc$language_is_case_sensitive IN current_symbol_table^.attributes THEN
            case_sensitive_module_found := TRUE;
          IFEND;
          IF (NOT(llc$language_is_case_sensitive IN current_symbol_table^.attributes) AND
              (i#compare_collated(current_symbol_table^.original_module_name,
                         name, osv$lower_to_upper) = 0)) OR
             ((llc$language_is_case_sensitive IN current_symbol_table^.attributes) AND
              (name = current_symbol_table^.original_module_name)) THEN
            IF module_item^.section_item[0].address.ring = target_ring THEN
              EXIT /search_for_original_name/;
            ELSE
              IF NOT ring_must_match AND (saved_module_item = NIL) THEN
                saved_module_item := module_item;
                saved_table_index := table_index;
              IFEND;
            IFEND;
          IFEND;
        FOREND;
      ELSEIF module_item^.line_address_tables <> NIL THEN
        FOR table_index := 0 TO UPPERBOUND (module_item^.line_address_tables^) DO
          current_line_table := module_item^.line_address_tables ^[table_index];
          IF i#compare_collated(current_line_table^.original_module_name, name, osv$lower_to_upper)
                                                            = 0 THEN
            IF module_item^.section_item[0].address.ring = target_ring THEN
              EXIT /search_for_original_name/;
            ELSE
              IF NOT ring_must_match AND (saved_module_item = NIL) THEN
                saved_module_item := module_item;
                saved_table_index := table_index;
              IFEND;
            IFEND;
          IFEND;
        FOREND;
      IFEND;
      module_item := module_item^.next_module;
    WHILEND /search_for_original_name/;

    IF (module_item = NIL) AND (saved_module_item <> NIL) THEN
      module_item := saved_module_item;
      table_index := saved_table_index;
    IFEND;

    IF (module_item = NIL) THEN
{ Search the module table itself.  Assume upper case except for C }
      #TRANSLATE (osv$lower_to_upper, name, temp_name); {case insensitive name}
      module_item := p_first_module;
  /search_module_name/
      WHILE module_item <> NIL DO
        IF (NOT(module_item^.language = llc$the_c_language) AND
            (temp_name = module_item^.name)) OR
           ((module_item^.language = llc$the_c_language) AND
            (name = module_item^.name)) THEN
          IF module_item^.section_item[0].address.ring = target_ring THEN
            EXIT  /search_module_name/;
          ELSE
            IF NOT ring_must_match AND (saved_module_item = NIL) THEN
              saved_module_item := module_item;
            IFEND;
          IFEND;
        IFEND;
        module_item := module_item^.next_module;
      WHILEND /search_module_name/;
      IF (module_item = NIL) THEN
         module_item := saved_module_item;
      IFEND;
      table_index := 0;
    IFEND;

    IF module_item = NIL THEN              { module not found
      IF case_sensitive_module_found THEN
{ If there were no case sensitive modules found, make the name upper case }
        temp_name := name;
      IFEND;
      osp$set_status_abnormal (duc$symbolic_id, due$named_module_not_found,
                   temp_name, status);
    ELSE  { module found }
      IF module_item^.line_address_tables <> NIL THEN
        line_table_address := module_item^.line_address_tables^[table_index];
      IFEND;
      IF module_item^.debug_symbol_tables <> NIL THEN
        symbol_table_address := module_item^.debug_symbol_tables^[table_index];
      IFEND;
    IFEND;

  PROCEND find_tables_for_module_name;
?? TITLE := 'find_trapped_stack_frame', EJECT ??

  PROCEDURE find_trapped_stack_frame (VAR trapped_sf: ^cell;
    VAR found: boolean);

    trapped_sf := trapped_save_area_address [1];
    found := (trapped_sf <> NIL);
  PROCEND find_trapped_stack_frame;
?? TITLE := 'get_parm_list_address', EJECT ??
{
{  This procedure returns the address of the parameter list.
{  It obtains the address of the parameter list either from register a4,
{  or from a location in storage (from stackframe for C180 Fortran).
{  To that end, it searches the symbol table for a var_kind entry and
{  label_kind entry, both of the name DBV$PARAMETER_LIST_POINTER.
{  If both entries exist and the p_register value has at least reached
{  the instruction sequence point marked by the label, the parameter
{  list address is obtained from the storage described by the var_kind
{  entry, else it is obtained from a4 of the belonging stack frame.
{
{  GET_PARM_LIST_ADDRESS (HOME_SPECIFICATION, PARAMETER_LIST_ADDRESS,
{      STATUS)
{
{  HOME_SPECIFICATION : (input)   describes the environment of the parameter
{                                 in terms of run time and source code.
{
{  PARAMETER_LIST_ADDRESS : (output)   returns the address of the parameter
{                                      list as a PVA.
{
{  STATUS :  (output)   is the status of the request. Possible values:
{

  PROCEDURE get_parm_list_address (home_spec: dut$home_specification;
    VAR parm_list_address: ost$pva;
    VAR status: ost$status);

{****
    VAR
      a1_current_stack_frame: ^cell,
      line_item_index: llt$line_address_table_size,
      line_table: ^llt$line_address_table,
      p_register: ost$pva,
      pva_ptr: ^ost$pva,
      section_item_index: llt$section_ordinal,
      stored_address_ptr: ^cell,
      stored_address_pva: ost$pva,
      symbol_entry: dut$symbol_entry,
      var_kind_symbol: ^llt$symbol_table_item;

    status.normal := TRUE;
    dup$locate_symbol_for_number (home_spec.symbol_table_address,
        home_spec.procedure_entry.symbol^.first_symbol_for_proc, symbol_entry, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{ Search symbol table for var_kind entry for internal name duv$parameter_list_pointer
{ starting with symbol_entry found for first_symbol_for_proc.

    var_kind_symbol := NIL;
  /symbol_table_search/
    WHILE TRUE DO
      IF (i#compare_collated (symbol_entry.symbol^.symbol_name, 'duv$parameter_list_pointer',
        osv$lower_to_upper) = 0) AND (symbol_entry.symbol^.symbol_kind = llc$var_kind) THEN
        var_kind_symbol := symbol_entry.symbol;
        EXIT /symbol_table_search/;
      IFEND;

{ Note: In Fortran, the end_of_chain field is not used to mark the last
{ symbol table item of programs, subprograms or functions. The field is
{ set to TRUE in all items, except the items associated with parameters,
{ in which end_of_chain = TRUE is used to mark the item of the last
{ parameter. Normally , the end_of_chain flag is used, and is the only way,
{ to mark the last item of the chain in the scope. Since Fortran does not yet
{ conform to this rule, 'IF symbol_entry.symbol^.end_of_chain THEN' has temporarily
{ been replaced by the following IF statement; The replacement does no harm as long as
{ get_parm_list_address is used only for Fortran.

      IF symbol_entry.table_entry_index = home_spec.symbol_table_address^.number_of_items THEN
        EXIT /symbol_table_search/;
      IFEND;
      symbol_entry.table_entry_index := symbol_entry.table_entry_index + 1;
      symbol_entry.symbol := ^home_spec.symbol_table_address^.
        item [symbol_entry.table_entry_index];
    WHILEND /symbol_table_search/;

{ Determine if the parameter list pointer is to be taken from a4 or storage, and get it from there.

    IF var_kind_symbol <> NIL THEN
      p_register := home_spec.current_stack_frame^.minimum_save_area.p_register.pva;
      find_section_for_pva (home_spec.module_item, p_register, section_item_index, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      find_line_number_for_pva (home_spec.module_item, section_item_index, p_register,
            line_table, line_item_index, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      IF NOT (llc$prolog_code IN line_table^.item [line_item_index].line_attributes) THEN
        IF var_kind_symbol^.var_base = llc$stack_frame_base THEN
          a1_current_stack_frame := home_spec.current_stack_frame^.minimum_save_area.a1_current_stack_frame;
          stored_address_pva.ring := #RING (a1_current_stack_frame);
          stored_address_pva.seg := #SEGMENT (a1_current_stack_frame);
          stored_address_pva.offset := #OFFSET (a1_current_stack_frame);
          stored_address_pva.offset := stored_address_pva.offset + var_kind_symbol^.var_offset;
        ELSE
        IFEND;
        stored_address_ptr := #ADDRESS (stored_address_pva.ring, stored_address_pva.seg,
          stored_address_pva.offset);
        pva_ptr := stored_address_ptr;
        parm_list_address := pva_ptr^;
        RETURN; {----->
      IFEND;
    IFEND;
    parm_list_address.ring := #RING (home_spec.current_stack_frame^.a4);
    parm_list_address.seg := #SEGMENT (home_spec.current_stack_frame^.a4);
    parm_list_address.offset := #OFFSET (home_spec.current_stack_frame^.a4);
  PROCEND get_parm_list_address;
?? TITLE := 'initialize_debug_directory', EJECT ??

  PROCEDURE initialize_debug_directory (VAR status: ost$status);

    VAR
      segment: amt$segment_pointer;

    IF (p_debug_directory = NIL) THEN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment, status);

      IF status.normal THEN
        p_debug_directory := segment.sequence_pointer;
        RESET p_debug_directory;
        p_local_modules := dbp$module_table_address ();
        p_first_module := p_local_modules;
      IFEND;
    IFEND;
  PROCEND initialize_debug_directory;
?? TITLE := 'locate_line_number_entry', EJECT ??
{
{  This procedure locates the line address table entry corresponding
{  to a specified source line number.
{
{  LOCATE_LINE_NUMBER_ENTRY (MODULE, LINE, ENTRY, STATUS)
{
{  MODULE (input) :  is the address of the specific module table
{                    in which the line entry is to be found.
{
{  LINE (input) :    is the source line number to be looked for in
{                    the line address table.
{
{  STATEMENT (inp) : is the statement associated with the source
{                    line number.
{
{  ENTRY (output) :  is the ordinal in the line address table
{                    of the entry corresponding to the source
{                    line number (if an entry is found).
{
{  STATUS (output) : is the status of the request. Possible value(s):
{                      due$no_line_numbers_in_module
{                      due$line_number_not_found
{                      due$statement_number_not_found

  PROCEDURE locate_line_number_entry (line_table_address: ^llt$line_address_table;
    line_number: llt$source_line_number;
    statement_number: integer;
    VAR line_table_item: llt$line_address_item;
    VAR status: ost$status);

    VAR
      line_table_index: integer,
      current_line_table: ^llt$line_address_table,
      line_item_index: llt$line_address_table_size,
      line_item_indexx: llt$line_address_table_size,
      string1: string(6),
      temp_number: integer,
      statement_hold: integer,
      save_line_number: integer,
      save_line_number1: integer;

    status.normal := TRUE;
{
{  check that module actually has a line address table
{
    IF line_table_address = NIL THEN
      osp$set_status_abnormal (duc$symbolic_id, due$no_line_numbers_in_module,
            osc$null_name, status);
      RETURN; { ----->
    IFEND;
{
{  now search the line address table
{
      /loop1/
      FOR line_item_index := 1 TO UPPERBOUND (line_table_address^.item) DO
        IF line_number = line_table_address^.item [line_item_index].line_number THEN
          save_line_number := line_table_address^.item [line_item_index].line_number;
          statement_hold := statement_number;
          IF llc$prolog_code IN line_table_address^.item [line_item_index].line_attributes THEN
            line_item_indexx := line_item_index;
            line_item_indexx := line_item_indexx + statement_hold;
          ELSE
            statement_hold := statement_hold - 1;
            line_item_indexx := line_item_index;
            line_item_indexx := line_item_indexx + statement_hold;
          IFEND;

          IF save_line_number <> line_table_address^.item [line_item_indexx].line_number THEN
            STRINGREP (string1, line_table_index, statement_number);
            osp$set_status_abnormal (duc$symbolic_id, due$statement_number_not_found,
              string1 (1, line_table_index), status);
            RETURN; {----->
          IFEND;

          IF llc$prolog_code IN line_table_address^.item [line_item_indexx].line_attributes THEN
            CYCLE /loop1/;
          ELSE
            line_table_item := line_table_address^.item [line_item_indexx];
            RETURN; {----->
          IFEND;
        IFEND;
      FOREND /loop1/;
{
{  if we get here, the required line number was not found in the
{  line address table.
{
      STRINGREP (string1, line_table_index, line_number);
    osp$set_status_abnormal (duc$symbolic_id, due$line_number_not_found, string1(1,line_table_index),
    status);
  PROCEND locate_line_number_entry;
?? TITLE := 'locate_named_symbol', EJECT ??

  PROCEDURE locate_named_symbol (symbol_name: pmt$program_name;
        home_spec: dut$home_specification;
    VAR symbol_entry: dut$symbol_entry;
    VAR status: ost$status);

    VAR
      current_proc: dut$symbol_entry,
      first_symbol_number: llt$symbol_number,
      index: llt$symbol_number,
      p_symbol_list: ^array [1 .. *] of llt$symbol_table_item,
      parent_symbol_number: llt$symbol_number,
      proc_start: ost$pva,
      module_level_searched: boolean,
      upper: llt$symbol_number;

    current_proc := home_spec.procedure_entry;
    module_level_searched := FALSE;

    REPEAT

/search_lexical_level/
      BEGIN
        IF current_proc.symbol <> NIL THEN
          IF current_proc.symbol^.symbol_kind = llc$proc_kind THEN
            first_symbol_number := current_proc.symbol^.first_symbol_for_proc;
          ELSE { Must be a WITH block }
            first_symbol_number := current_proc.symbol^.with_first_symbol;
          IFEND;
          IF first_symbol_number = 0 THEN
            EXIT /search_lexical_level/; {no symbols at this level}
          IFEND;
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                first_symbol_number, symbol_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          module_level_searched := TRUE;
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                home_spec.symbol_table_address^.first_symbol_for_module,
                symbol_entry, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        WHILE TRUE DO
          IF (symbol_entry.symbol^.symbol_name = symbol_name) THEN
            RETURN;
          ELSE
{ Get the next symbol in the chain }
            IF symbol_entry.symbol^.end_of_chain THEN
              EXIT /search_lexical_level/;
            IFEND;
            dup$locate_next_symbol (home_spec.symbol_table_address,
                  symbol_entry, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        WHILEND;
      END /search_lexical_level/;

{ Check the next outer level of procedure nesting if there is one }

      IF current_proc.symbol <> NIL THEN
        IF current_proc.symbol^.symbol_kind = llc$proc_kind THEN
          parent_symbol_number := current_proc.symbol^.proc_parent;
        ELSE { Must be WITH block }
          parent_symbol_number := current_proc.symbol^.with_parent;
        IFEND;
        IF parent_symbol_number = 0 THEN
          current_proc.symbol := NIL;
        ELSE
          dup$locate_symbol_for_number (home_spec.symbol_table_address,
                parent_symbol_number, current_proc, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;
    UNTIL module_level_searched;

    p_symbol_list := ^home_spec.symbol_table_address^.item;
    upper := UPPERBOUND (p_symbol_list^);
    index := 1;
    WHILE (index <= upper) AND (p_symbol_list^ [index].symbol_name <> symbol_name) DO
      index := index + 1;
    WHILEND;
    IF (index <= upper) THEN
      symbol_entry.table_entry_index := index;
      symbol_entry.symbol := ^p_symbol_list^ [index];
    ELSE
      osp$set_status_abnormal (duc$symbolic_id, due$variable_not_found, symbol_name, status);
    IFEND;
  PROCEND locate_named_symbol;
?? TITLE := 'object_record_size', EJECT ??

  FUNCTION object_record_size (kind: llt$object_record_kind;
        fixer: 0 .. 7fffffff(16)): integer;

    CASE kind OF
    = llc$libraries =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$libraries: [1 .. fixer]);
      IFEND;

    = llc$section_definition, llc$unallocated_common_block =
      object_record_size := #SIZE (llt$section_definition);

    = llc$allotted_section_definition =
      object_record_size := #SIZE (llt$section_definition);

    = llc$segment_definition =
      object_record_size := #SIZE (llt$segment_definition);

    = llc$allotted_segment_definition =
      object_record_size := #SIZE (llt$segment_definition);

    = llc$obsolete_segment_definition =
      object_record_size := #SIZE (llt$obsolete_segment_definition);

    = llc$obsolete_allotted_seg_def =
      object_record_size := #SIZE (llt$obsolete_segment_definition);

    = llc$application_identifier =
      object_record_size := #SIZE (llt$application_identifier);

    = llc$transfer_symbol =
      object_record_size := #SIZE (llt$transfer_symbol);

    = llc$entry_definition =
      object_record_size := #SIZE (llt$entry_definition);

    = llc$deferred_entry_points =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$deferred_entry_points: [1 .. fixer]);
      IFEND;

    = llc$deferred_common_blocks =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$deferred_common_blocks: [1 .. fixer]);
      IFEND;

    = llc$external_linkage =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$external_linkage: [1 .. fixer]);
      IFEND;

    = llc$address_formulation =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$address_formulation: [1 .. fixer]);
      IFEND;

    = llc$text =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$text: [1 .. fixer]);
      IFEND;

    = llc$replication =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$replication: [1 .. fixer]);
      IFEND;

    = llc$bit_string_insertion =
      object_record_size := #SIZE (llt$bit_string_insertion);

    = llc$obsolete_formal_parameters =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$obsolete_formal_parameters: [[REP fixer  OF cell]]);
      IFEND;

    = llc$formal_parameters =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$formal_parameters: [[REP fixer  OF cell]]);
      IFEND;

    = llc$form_definition =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$form_definition: [[REP fixer  OF cell]]);
      IFEND;

    = llc$actual_parameters =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$actual_parameters: [[REP fixer  OF cell]]);
      IFEND;

    = llc$relocation =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$relocation: [1 .. fixer]);
      IFEND;

    = llc$binding_template =
      object_record_size := #SIZE (llt$binding_template);

    = llc$ppu_absolute =
      object_record_size := #SIZE (llt$ppu_absolute: [0 .. fixer]);

    = llc$identification =
      object_record_size := #SIZE (llt$identification);

    = llc$obsolete_line_table =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$obsolete_line_address_table: [1 .. fixer]);
      IFEND;

    = llc$68000_absolute =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$68000_absolute: [[REP fixer  OF cell]]);
      IFEND;

    = llc$line_table =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$line_address_table: [1 .. fixer]);
      IFEND;

    = llc$cybil_symbol_table_fragment =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$debug_table_fragment: [[REP fixer  OF cell]]);
      IFEND;

    = llc$symbol_table =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$symbol_table: [[REP fixer  OF cell]]);
      IFEND;

    = llc$supplemental_debug_tables =
      IF (fixer < 1) THEN
        object_record_size := -1;
      ELSE
        object_record_size := #SIZE (llt$supplemental_debug_tables: [[REP fixer  OF cell]]);
      IFEND;

    ELSE
      object_record_size := -1;
    CASEND;
  FUNCEND object_record_size;
?? TITLE := 'open_debug_file', EJECT ??

  PROCEDURE open_debug_file (debug_file: fst$file_reference;
    VAR file_contents: ost$name;
    VAR file_structure: ost$name;
    VAR p_debug_file: ^SEQ (*);
    VAR status: ost$status);

    VAR
      attachment: [STATIC] array [1 .. 2] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read]],
            [fsc$determine_from_access_modes]], [fsc$create_file, FALSE]],
      contains_data: boolean,
      existing_file: boolean,
      file_id: amt$file_identifier,
      get_attributes: [STATIC] array [1 .. 2] of amt$get_item := [[ * , amc$file_contents, * ],
            [ * , amc$file_structure, * ]],
      local_file: boolean,
      local_status: ost$status,
      segment: amt$segment_pointer;

    amp$get_file_attributes (debug_file, get_attributes, local_file, existing_file, contains_data, status);

    IF status.normal THEN
      file_contents := get_attributes [1].file_contents;
      file_structure := get_attributes [2].file_structure;

      IF contains_data THEN
        fsp$open_file (debug_file, amc$segment, ^attachment, NIL, NIL, NIL, NIL, file_id, status);
      ELSE
        osp$set_status_abnormal ('OC', oce$e_missing_or_empty_file, debug_file, status);
      IFEND;
    IFEND;

    IF status.normal THEN
      amp$get_segment_pointer (file_id, amc$sequence_pointer, segment, status);
      IF status.normal THEN
        p_debug_file := segment.sequence_pointer;
      ELSE
        fsp$close_file (file_id, local_status);
      IFEND;
    IFEND;
  PROCEND open_debug_file;
?? TITLE := 'process_debug_file', EJECT ??

  PROCEDURE process_debug_file (file_name: fst$file_reference;
        p_debug_file: ^SEQ (*);
    VAR status: ost$status);

    VAR
      p_descriptor: ^llt$object_text_descriptor,
      p_file: ^SEQ (*);

    status.normal := TRUE;
    p_file := p_debug_file;
    NEXT p_descriptor IN p_file;

    WHILE status.normal AND (p_descriptor <> NIL) DO
      RESET p_file TO p_descriptor;
      process_module_debug_tables (file_name, p_file, status);
      NEXT p_descriptor IN p_file;
    WHILEND;
  PROCEND process_debug_file;
?? TITLE := 'process_debug_library', EJECT ??

  PROCEDURE process_debug_library (library_name: fst$file_reference;
        p_debug_library: ^SEQ (*);
    VAR status: ost$status);

    VAR
      p_library: ^SEQ (*),
      p_library_header: ^llt$object_library_header,
      p_old_library_header: ^llt$object_library_header_v1_0,
      p_dictionaries: ^llt$object_library_dictionaries,
      p_module_dictionary: ^llt$module_dictionary,
      dictionary: 0 .. llc$max_dictionaries_on_library,
      module_count: 0 .. llc$max_modules_in_library,
      module_index: 0 .. llc$max_modules_in_library,
      p_module_header: ^llt$load_module_header,
      p_descriptor: ^llt$object_text_descriptor;


    p_library := p_debug_library;
    RESET p_library;
    NEXT p_library_header IN p_library;

    IF (p_library_header = NIL) THEN
      set_loader_error (lle$library_header_missing, library_name, '', 0, FALSE, status);
      RETURN;
    IFEND;

    IF (p_library_header^.version = llc$object_library_version) THEN
      NEXT p_dictionaries: [1 .. p_library_header^.number_of_dictionaries] IN p_library;
      IF (p_dictionaries = NIL) THEN
        set_loader_error (lle$library_header_missing, library_name, '', 0, FALSE, status);
        RETURN;
      IFEND;

      module_count := 0;
      for dictionary := LOWERBOUND (p_dictionaries^) TO UPPERBOUND (p_dictionaries^) DO
        IF (p_dictionaries^ [dictionary].kind = llc$module_dictionary) THEN
          p_module_dictionary := #PTR (p_dictionaries^ [dictionary].module_dictionary, p_library^);
          module_count := UPPERBOUND (p_module_dictionary^);
        IFEND;
      FOREND;
    ELSEIF (p_library_header^.version = 'V1.0') THEN
      RESET p_library;
      NEXT p_old_library_header IN p_library;
      IF (p_old_library_header = NIL) THEN
        set_loader_error (lle$library_header_missing, library_name, '', 0, FALSE, status);
        RETURN;
      IFEND;

      p_module_dictionary := #PTR (p_old_library_header^.module_dictionary, p_library^);
      module_count := p_old_library_header^.number_of_modules;
    ELSE
      set_loader_error (lle$wrong_library_version, library_name, '', 0, FALSE, status);
      RETURN;
    IFEND;

    IF (module_count = 0) THEN
      set_loader_error (lle$empty_module_dictionary, library_name, '', 0, FALSE, status);
      RETURN;
    ELSEIF (p_module_dictionary = NIL) THEN
      set_loader_error (lle$bad_module_dictionary_ptr, library_name, '', 0, FALSE, status);
      RETURN;
    IFEND;

    FOR module_index := 1 to module_count DO
      IF (p_module_dictionary^ [module_index].kind = llc$load_module) THEN
        p_module_header := #PTR (p_module_dictionary^ [module_index].module_header, p_library^);
        IF (p_module_header = NIL) THEN
          set_loader_error (lle$bad_module_header_ptr, library_name, 'module', module_index, FALSE, status);
          RETURN;
        IFEND;

        p_descriptor := #PTR (p_module_header^.interpretive_element, p_library^);
        IF (p_descriptor = NIL) THEN
          set_loader_error (lle$bad_interpretive_elem_ptr, library_name, '', #offset (p_module_header), TRUE,
                status);
          RETURN;
        IFEND;

        RESET p_library TO p_descriptor;
        process_module_debug_tables (library_name, p_library, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    FOREND;
  PROCEND process_debug_library;
?? TITLE := 'process_debug_tables', EJECT ??

  PROCEDURE process_debug_tables (
        p_debug_table_list: ^clt$data_value;
    VAR status: ost$status);

    VAR
      content: ost$name,
      first_linker_table: boolean,
      p_debug_file: ^SEQ (*),
      p_element: ^clt$data_value,
      p_list: ^clt$data_value,
      structure: ost$name;

    initialize_debug_directory (status);

    p_list := p_debug_table_list;
    first_linker_table := TRUE;

    WHILE status.normal AND (p_list <> NIL) DO
      p_element := p_list^.element_value;
      IF (p_element^.kind = clc$file) THEN
        open_debug_file (p_element^.file_value^, content, structure, p_debug_file, status);
        IF status.normal THEN
          IF (content = amc$object) THEN
            IF (structure = amc$library) THEN
              process_debug_library (p_element^.file_value^, p_debug_file, status);
            ELSE
              process_debug_file (p_element^.file_value^, p_debug_file, status);
            IFEND;
          ELSE
            IF first_linker_table THEN
              ocp$close_linker_debug_table (status);
              first_linker_table := FALSE;
            IFEND;
            ocp$define_linker_debug_table (p_debug_file, status);
          IFEND;
        IFEND;
      ELSE
        IF first_linker_table THEN
          ocp$close_linker_debug_table (status);
          first_linker_table := FALSE;
        IFEND;
        ocp$open_running_debug_table (status);
      IFEND;
      p_list := p_list^.link;
    WHILEND;

    IF status.normal THEN
      update_section_info;
    IFEND;
  PROCEND process_debug_tables;
?? TITLE := 'process_module_debug_tables', EJECT ??

  PROCEDURE process_module_debug_tables (file_name: fst$file_reference;
    VAR p_file: ^SEQ (*);
    VAR status: ost$status);

    TYPE
      line = record
        p_next_line: ^line,
        p_line_table: ^llt$line_address_table,
      recend,

      symbol = record
        p_next_symbol: ^symbol,
        p_symbol_table: ^llt$debug_symbol_table,
      recend;

    VAR
      kind: llt$object_record_kind,
      module_name: pmt$program_name,
      greatest_section: llt$section_ordinal,
      line_count: integer,
      p_identification: ^llt$identification,
      p_module: ^dbt$module_address_table_item,
      p_descriptor: ^llt$object_text_descriptor,
      symbol_count: integer,
      p_first_line: ^line,
      p_first_symbol: ^symbol,
      p_current_line: ^line,
      p_current_symbol: ^symbol,
      p_line_table: ^llt$line_address_table,
      p_line_tables: ^array [0 .. *] of ^llt$line_address_table,
      p_symbol_table: ^llt$debug_symbol_table,
      p_symbol_tables: ^array [0 .. *] of ^llt$debug_symbol_table;


    status.normal := TRUE;
    line_count := 0;
    p_first_line := NIL;
    symbol_count := 0;
    p_first_symbol := NIL;

    NEXT p_descriptor IN p_file;
    IF (p_descriptor = NIL) OR (p_descriptor^.kind <> llc$identification) THEN
      set_loader_error (lle$identification_expected, file_name, '', #offset (p_descriptor), TRUE, status);
      RETURN;
    IFEND;
    kind := llc$identification;

    NEXT p_identification IN p_file;
    IF (p_identification = NIL) THEN
      set_loader_error (lle$premature_eof, file_name, '', 0, FALSE, status);
      RETURN;
    ELSE
      greatest_section := p_identification^.greatest_section_ordinal;
      module_name := p_identification^.name;
      create_module_item (module_name, greatest_section, p_module, status);
      IF status.normal THEN
        p_module^.next_module := p_first_module;
        p_first_module := p_module;
      IFEND;
    IFEND;

    WHILE status.normal AND (kind <> llc$transfer_symbol) DO
      NEXT p_descriptor IN p_file;
      IF (p_descriptor = NIL) THEN
        set_loader_error (lle$premature_eof, file_name, '', 0, FALSE, status);
      ELSE
        kind := p_descriptor^.kind;
        CASE kind OF

        = llc$line_table =
          NEXT p_line_table: [1 .. p_descriptor^.number_of_line_items] IN p_file;
          IF (p_line_table = NIL) THEN
            set_loader_error (lle$premature_eof, file_name, '', 0, FALSE, status);
          ELSE
            PUSH p_current_line;
            line_count := line_count + 1;
            p_current_line^.p_next_line := p_first_line;
            p_current_line^.p_line_table := p_line_table;
            p_first_line := p_current_line;
          IFEND;

        = llc$symbol_table =
          process_symbol_record (module_name, p_descriptor^.sequence_length, file_name, p_file,
                p_symbol_table, status);
          IF status.normal THEN
            PUSH p_current_symbol;
            symbol_count := symbol_count + 1;
            p_current_symbol^.p_next_symbol := p_first_symbol;
            p_current_symbol^.p_symbol_table := p_symbol_table;
            p_first_symbol := p_current_symbol;
          IFEND;

        ELSE
          skip_object_record (p_descriptor, file_name, p_file, status);
        CASEND;
      IFEND;
    WHILEND;

    IF status.normal AND (line_count > 0) THEN
      NEXT p_line_tables: [0 .. line_count - 1] IN p_debug_directory;
      p_current_line := p_first_line;
      WHILE (line_count > 0) DO
        line_count := line_count - 1;
        p_line_tables^ [line_count] := p_current_line^.p_line_table;
        p_current_line := p_current_line^.p_next_line;
      WHILEND;
      p_module^.line_address_tables := p_line_tables;
    IFEND;

    IF status.normal AND (symbol_count > 0) THEN
      NEXT p_symbol_tables: [0 .. symbol_count - 1] IN p_debug_directory;
      p_current_symbol := p_first_symbol;
      WHILE (symbol_count > 0) DO
        symbol_count := symbol_count - 1;
        p_symbol_tables^ [symbol_count] := p_current_symbol^.p_symbol_table;
        p_current_symbol := p_current_symbol^.p_next_symbol;
      WHILEND;
      p_module^.debug_symbol_tables := p_symbol_tables;
    IFEND;
  PROCEND process_module_debug_tables;
?? TITLE := 'process_symbol_record', EJECT ??

  PROCEDURE process_symbol_record (module_name: pmt$program_name;
        record_length: llt$section_length;
        object_file_name: fst$file_reference;
    VAR p_object_file: ^SEQ (*);
    VAR p_symbol_table: ^llt$debug_symbol_table;
    VAR status: ost$status);

    VAR
      p_symbol_record: ^llt$symbol_table,
      p_symbol_text: ^SEQ (*);

    status.normal := TRUE;
    NEXT p_symbol_record: [[REP record_length OF cell]] IN p_object_file;
    IF (p_symbol_record = NIL) THEN
      set_loader_error (lle$premature_eof, object_file_name, '', 0, FALSE, status);
    ELSE
      p_symbol_text := ^p_symbol_record^.text;
      RESET p_symbol_text;
      NEXT p_symbol_table: [1 .. 1] IN p_symbol_text;
      IF (p_symbol_table <> NIL) THEN
        RESET p_symbol_text;
        NEXT p_symbol_table: [1 .. p_symbol_table^.number_of_items] IN p_symbol_text;
      IFEND;
      IF (p_symbol_table = NIL) THEN
        osp$set_status_abnormal ('PM', pme$bad_debug_symbol_table, module_name, status);
      IFEND;
    IFEND;
  PROCEND process_symbol_record;
?? TITLE := 'set_loader_error', EJECT ??

  PROCEDURE set_loader_error (error_condition: ost$status_condition;
        text_1: string (*);
        text_2: string (*);
        number: integer;
        hex_base: boolean;
    VAR status: ost$status);

    osp$set_status_abnormal ('LL', error_condition, text_1, status);

    IF (text_2 <> '') THEN
      osp$append_status_parameter (osc$status_parameter_delimiter, text_2, status);
    IFEND;

    IF hex_base THEN
      osp$append_status_integer (osc$status_parameter_delimiter, number, 16, TRUE, status);
    ELSE
      osp$append_status_integer (osc$status_parameter_delimiter, number, 10, FALSE, status);
    IFEND;
  PROCEND set_loader_error;
?? TITLE := 'skip_object_record', EJECT ??

  PROCEDURE skip_object_record (p_descriptor: ^llt$object_text_descriptor;
        object_file_name: fst$file_reference;
    VAR p_object_file: ^SEQ (*);
    VAR status:ost$status);

    VAR
      fixer: 0 .. 37777777(16),
      record_size: integer,
      p_sequence: ^SEQ (*);

    status.normal := TRUE;

    CASE p_descriptor^.kind OF

    = llc$identification, llc$section_definition, llc$bit_string_insertion, llc$entry_definition,
            llc$binding_template, llc$transfer_symbol, llc$obsolete_segment_definition,
            llc$unallocated_common_block, llc$application_identifier, llc$segment_definition =
      fixer := 0;

    = llc$libraries =
      fixer := p_descriptor^.number_of_libraries;

    = llc$text, llc$replication =
      fixer := p_descriptor^.number_of_bytes;

    = llc$relocation =
      fixer := p_descriptor^.number_of_rel_items;

    = llc$address_formulation =
      fixer := p_descriptor^.number_of_adr_items;

    = llc$external_linkage =
      fixer := p_descriptor^.number_of_ext_items;

    = llc$obsolete_formal_parameters, llc$actual_parameters, llc$cybil_symbol_table_fragment,
            llc$symbol_table, llc$formal_parameters, llc$form_definition, llc$supplemental_debug_tables =
      fixer := p_descriptor^.sequence_length;

    = llc$ppu_absolute =
      fixer := p_descriptor^.number_of_words;

    = llc$allotted_section_definition, llc$allotted_segment_definition, llc$obsolete_allotted_seg_def =
      fixer := 0;

    = llc$68000_absolute =
      fixer := p_descriptor^.number_of_68000_bytes;

    = llc$line_table, llc$obsolete_line_table =
      fixer := p_descriptor^.number_of_line_items;

    = llc$deferred_entry_points =
      fixer := p_descriptor^.number_of_entry_points;

    = llc$deferred_common_blocks =
      fixer := p_descriptor^.number_of_common_blocks;
    ELSE
      set_loader_error (lle$unknown_record_kind, '', '', #offset (p_descriptor), TRUE, status);
    CASEND;

    IF status.normal THEN
      record_size := object_record_size (p_descriptor^.kind, fixer);
      IF (record_size < 0) THEN
        set_loader_error (lle$bad_fixer_value, '', '', #offset (p_descriptor), TRUE, status);
      ELSEIF (record_size > 0) THEN
        NEXT p_sequence: [[REP record_size of cell]] IN p_object_file;
        IF (p_sequence = NIL) THEN
          set_loader_error (lle$premature_eof, object_file_name, '', 0, FALSE, status);
        IFEND;
      IFEND;
    IFEND;
  PROCEND skip_object_record;
?? TITLE := 'update_section_info', EJECT ??

  PROCEDURE update_section_info;

    VAR
      p_current_module: ^dbt$module_address_table_item,
      p_linker_module: ^pmt$module_item,
      found: boolean,
      highest_section: llt$section_ordinal,
      section_index: llt$section_ordinal,
      p_section: ^dbt$section_item,
      p_linker_section: ^pmt$section_item,
      status: ost$status;

    status.normal := TRUE;
    p_current_module := p_first_module;

    WHILE (p_current_module <> p_local_modules) AND status.normal DO
      ocp$find_debug_module_item (p_current_module^.name, 1, found, p_linker_module, status);
      IF status.normal AND found THEN
        highest_section := UPPERBOUND (p_current_module^.section_item);
        IF (highest_section > UPPERBOUND (p_linker_module^.section_item)) THEN
          highest_section := UPPERBOUND (p_linker_module^.section_item);
        IFEND;
        IF TRUE THEN;
          FOR section_index := 0 TO highest_section DO
            p_section := ^p_current_module^.section_item [section_index];
            p_linker_section := ^p_linker_module^.section_item [section_index];
            p_section^.kind := p_linker_section^.kind;
            p_section^.section_ordinal := p_linker_section^.section_ordinal;
            p_section^.address.ring := UPPERVALUE (ost$ring);
            p_section^.address.seg := p_linker_section^.address DIV 100000000(16);
            p_section^.address.offset := p_linker_section^.address MOD 100000000(16);
            p_section^.length := p_linker_section^.length;
            p_section^.segment_access_control := p_linker_section^.segment_access_control;
            p_section^.ring.r1 := p_linker_section^.ring.r1;
            p_section^.ring.r2 := p_linker_section^.ring.r2;
            p_section^.ring.r3 := p_linker_section^.ring.r3;
            p_section^.key_lock := p_linker_section^.key_lock;
            p_section^.name := p_linker_section^.name;
          FOREND;
        IFEND;
      IFEND;
      p_current_module := p_current_module^.next_module;
    WHILEND;
  PROCEND update_section_info;
?? TITLE := 'verify_procedure_exists', EJECT ??
{
{  This procedure searches the module table for a
{  procedure of a specified name.  Unlike other 'find_procedure'
{  routines, this one searches the entire module table, and returns
{  the module table if the specified proc exists somewhere.
{
{  VERIFY_PROCEDURE_EXISTS (PROCEDURE_NAME, MODULE_ITEM, STATUS)
{
{  PROCEDURE_NAME : (input)  is the procedure name we are looking for
{
{  MODULE_ITEM: (output)     is the address of the module table for the
{                              procedure and is only valid if status is
{                              normal
{
{  STATUS : (output)         is the status.  Possible values:
{                              due$invalid_procedure
{

  PROCEDURE verify_procedure_exists (
    VAR procedure_name: pmt$program_name;
    VAR module_item: ^dbt$module_address_table_item;
    VAR status: ost$status);

    VAR
      section_item: dbt$section_item,
      section_item_index: integer,
      symbol_index: llt$symbol_number,
      symbol_table_index: integer,
      symbol_table_ptr: ^llt$debug_symbol_table;

    status.normal := TRUE;
    module_item := p_first_module;   { pointer to first module table

    WHILE module_item <> NIL DO
      IF module_item^.name(1,4) <> 'DBM$' THEN   { Ignore DEBUG modules }
        IF module_item^.debug_symbol_tables <> NIL THEN
          FOR symbol_table_index := 0 TO UPPERBOUND(module_item^.debug_symbol_tables^) DO
            symbol_table_ptr := module_item^.debug_symbol_tables^[symbol_table_index];
            FOR symbol_index := 1 TO symbol_table_ptr^.number_of_items DO
              IF (symbol_table_ptr^.item[symbol_index].symbol_kind = llc$proc_kind) AND
                (symbol_table_ptr^.item[symbol_index].proc_length <> 0) THEN
                IF llc$language_is_case_sensitive IN symbol_table_ptr^.attributes THEN
                  IF symbol_table_ptr^.item[symbol_index].symbol_name = procedure_name THEN
                    RETURN; {----->
                  IFEND;
                ELSE { Language not case sensitive }
                  IF (i#compare_collated(symbol_table_ptr^.item[symbol_index].symbol_name,
                             procedure_name, osv$lower_to_upper) = 0) THEN
                    #TRANSLATE (osv$lower_to_upper, procedure_name, procedure_name);
                    RETURN; {----->
                  IFEND;
                IFEND;  { If language is case sensitive }
              IFEND;  { If this is a proc_kind symbol }
            FOREND;
          FOREND;
        ELSE { No symbol tables - check module table code sections }
          IF module_item^.language <> llc$object_library_generator THEN
            FOR section_item_index := 0 TO UPPERBOUND(module_item^.section_item) DO
              section_item := module_item^.section_item[section_item_index];
              IF (section_item.kind = llc$code_section) AND
                 (i#compare_collated(section_item.name, procedure_name, osv$lower_to_upper) = 0) THEN
                #TRANSLATE (osv$lower_to_upper, procedure_name, procedure_name);
                RETURN; {----->
              IFEND;
            FOREND;
          IFEND;  { If not a bound module }
        IFEND; { If symbol tables exist }
      IFEND; { If not a DEBUG module }
      module_item := module_item^.next_module;
    WHILEND;

{ Did not find procedure in entire module table - return error }

    osp$set_status_abnormal (duc$symbolic_id, due$invalid_procedure,
                   procedure_name, status);
  PROCEND verify_procedure_exists;
?? OLDTITLE ??
MODEND dum$debug_table_interfaces;
