?? RIGHT := 110 ??
?? TITLE := 'NOS/VE Object Code Utilities: Query Linker Debug Tables' ??
MODULE ocm$query_linker_debug_tables;


{ PURPOSE:
{   This module display_information from a debug table produced by the VE linker.



?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pmt$linker_debug_table_header
*copyc clc$standard_file_names
*copyc oce$ve_linker_exceptions
?? POP ??
*copyc amp$get_next
*copyc clp$begin_utility
*copyc clp$convert_string_to_date_time
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc clp$make_date_time_value
*copyc clp$make_integer_value
*copyc clp$make_list_value
*copyc clp$make_program_name_value
*copyc clp$make_record_value
*copyc clp$make_string_value
*copyc fsp$close_file
*copyc fsp$open_file
*copyc ocp$close_linker_debug_table
*copyc ocp$close_output_file
*copyc ocp$find_debug_address
*copyc ocp$find_debug_entry_point
*copyc ocp$find_debug_module_item
*copyc ocp$get_debug_table_header
*copyc ocp$hexrep
*copyc ocp$open_linker_debug_table
*copyc ocp$open_output_file
*copyc ocp$open_running_debug_table
*copyc ocp$output
*copyc ocp$output_access_control
*copyc ocp$output_date
*copyc ocp$output_module_generator
*copyc ocp$output_module_kind
*copyc ocp$output_section_kind
*copyc ocp$output_time
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal

*copyc osv$lower_to_upper
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    utility_name = 'QUERY_DEBUG_TABLE              ',
    utility_prompt = 'qdt',

    continue = FALSE,
    end_of_line = TRUE;


  VAR
    dummy_header: [STATIC] string (132) := 'Output from QUERY_DEBUG_TABLE';

?? OLDTITLE ??
?? NEWTITLE := 'abnormal_status_with_address', EJECT ??

{ PURPOSE:
{   Build a status message with the address.

  PROCEDURE abnormal_status_with_address
    (    condition: ost$status_condition;
         address: integer;
     VAR status: ost$status);


    VAR
      strng: string (132),
      l: integer;


    ocp$hexrep (strng, l, (address DIV 100000000(16)));
    osp$set_status_abnormal ('OC', condition, strng (1, l), status);

    ocp$hexrep (strng, l, (address MOD 100000000(16)));
    osp$append_status_parameter (osc$status_parameter_delimiter, strng (1, l), status);


  PROCEND abnormal_status_with_address;
?? OLDTITLE ??
?? NEWTITLE := 'c$_display_address', EJECT ??

{ PURPOSE:
{   Command processor for the display_address command.

  PROCEDURE c$_display_address
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE display_address (
{   address, a: integer 0..0fffffffffff(16) RADIX 16 = $required
{   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$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 4, 14, 48, 8, 699],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['A                              ',clc$abbreviation_entry, 1],
    ['ADDRESS                        ',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$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ 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$integer_type], [0, 0fffffffffff(16), 16]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      address: integer,
      segment: ost$segment,
      offset: ost$segment_offset,
      found: boolean,
      module_name: pmt$program_name,
      section_name: pmt$program_name,
      offset_in_section: ost$segment_offset;


    status.normal := TRUE;

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

    address := pvt [p$address].value^.integer_value.value;
    IF ((address MOD 100000000(16)) > 7fffffff(16)) THEN
      abnormal_status_with_address (oce$e_invalid_address_specified, address, status);
      RETURN;
    IFEND;

    segment := address DIV 100000000(16);
    offset := address MOD 100000000(16);

    ocp$find_debug_address (segment, offset, found, module_name, section_name, offset_in_section, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF found THEN
      display_address (segment, offset, module_name, section_name, offset_in_section);
    ELSE
      abnormal_status_with_address (oce$e_address_not_found, address, status);
    IFEND;


  PROCEND c$_display_address;
?? OLDTITLE ??
?? NEWTITLE := 'c$_display_debug_table', EJECT ??

{ PURPOSE:
{   Command processor for the display_debug_table command.

  PROCEDURE c$_display_debug_table
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE display_debug_table (
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 3, 20, 58, 38, 341],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, 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$status_type]]];

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

    CONST
      p$status = 1;

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

    VAR
      debug_table_header: ^pmt$linker_debug_table_header,
      ignore: boolean,
      strng: string (132),
      l: integer;


    status.normal := TRUE;

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

    ocp$get_debug_table_header (debug_table_header, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    ocp$output ('0  Version: ', debug_table_header^.version, #SIZE (debug_table_header^.version), continue);
    ocp$output ('   Build Level: ', debug_table_header^.build_level, #SIZE (debug_table_header^.build_level),
          end_of_line);

    ocp$output ('   ', 'Date built:', 11, continue);
    ocp$output_date (^debug_table_header^.date, continue, ignore);
    ocp$output ('  ', 'Time:', 5, continue);
    ocp$output_time (^debug_table_header^.time, end_of_line, ignore);

    STRINGREP (strng, l, debug_table_header^.number_of_modules);
    ocp$output ('   Modules:', strng, l, continue);
    STRINGREP (strng, l, debug_table_header^.number_of_entry_points);
    ocp$output ('  Entry Points:', strng, l, continue);
    STRINGREP (strng, l, debug_table_header^.number_of_addresses);
    ocp$output ('  Addresses:', strng, l, end_of_line);

    ocp$output (' ', ' ', 1, end_of_line);


  PROCEND c$_display_debug_table;
?? OLDTITLE ??
?? NEWTITLE := 'c$_display_entry_point', EJECT ??

{ PURPOSE:
{   Command processor for the display_entry_point command.

  PROCEDURE c$_display_entry_point
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE display_entry_point (
{   entry_point, ep: program_name = $required
{   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,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 4, 14, 48, 35, 760],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['ENTRY_POINT                    ',clc$nominal_entry, 1],
    ['EP                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [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$program_name_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

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


    status.normal := TRUE;

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



    entry_point := pvt [p$entry_point].value^.program_name_value;
    ocp$find_debug_entry_point (entry_point, found, module_name, segment, offset, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF found THEN
      display_entry_point (entry_point, module_name, segment, offset);
    ELSE
      osp$set_status_abnormal ('OC', oce$e_entry_point_not_found, entry_point, status);
    IFEND;


  PROCEND c$_display_entry_point;
?? OLDTITLE ??
?? NEWTITLE := 'c$_display_module', EJECT ??

{ PURPOSE:
{   Command processor for the display_module command.

  PROCEDURE c$_display_module
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE display_module (
{   module, m: program_name = $required
{   occurrence, o: integer 1..pmc$maximum_debug_items = 1
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 4, 14, 48, 51, 711],
    clc$command, 5, 3, 1, 0, 0, 0, 3, ''], [
    ['M                              ',clc$abbreviation_entry, 1],
    ['MODULE                         ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OCCURRENCE                     ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ 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, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 3
    [5, 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$program_name_type]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, pmc$maximum_debug_items, 10],
    '1'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      module_name: ost$name,
      occurrence: integer,
      found: boolean,
      module_item: ^pmt$module_item;


    status.normal := TRUE;

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

    module_name := pvt [p$module].value^.program_name_value;
    occurrence := pvt [p$occurrence].value^.integer_value.value;

    ocp$find_debug_module_item (module_name, occurrence, found, module_item, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT found THEN
      osp$set_status_abnormal ('OC', oce$e_module_item_not_found, module_name, status);
      RETURN;
    IFEND;

    display_module (module_item);


  PROCEND c$_display_module;
?? OLDTITLE ??
?? NEWTITLE := 'c$_quit', EJECT ??

{ PURPOSE:
{   Command processor for the quit command.

  PROCEDURE c$_quit
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE quit

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 1, 3, 21, 19, 4, 63],
    clc$command, 0, 0, 0, 0, 0, 0, 0, '']];

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


    status.normal := TRUE;

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

    clp$end_include (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


  PROCEND c$_quit;
?? OLDTITLE ??
?? NEWTITLE := 'c$_use_debug_table', EJECT ??

{ PURPOSE:
{   Command processor for the use_debug_table command.

  PROCEDURE c$_use_debug_table
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE use_debug_table (
{   debug_table, dt: any of
{       key
{         (running_system, rs)
{       keyend
{       file
{     anyend = running_system
{   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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
        default_value: string (14),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 3, 21, 1, 20, 419],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['DEBUG_TABLE                    ',clc$nominal_entry, 1],
    ['DT                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, 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, 104,
  clc$optional_default_parameter, 0, 14],
{ 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$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]]
    ,
    'running_system'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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


    status.normal := TRUE;

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

    IF (pvt [p$debug_table].value^.kind = clc$keyword) THEN
      ocp$open_running_debug_table (status);
    ELSE
      ocp$open_linker_debug_table (pvt [p$debug_table].value^.file_value^, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;


  PROCEND c$_use_debug_table;
?? OLDTITLE ??
?? NEWTITLE := 'convert_string_to_integer', EJECT ??

{ PURPOSE:
{   Convert the string containing a hex number to an integer.

  PROCEDURE convert_string_to_integer
    (    strng: string ( * );
     VAR intger: integer);


    VAR
      i: integer;


    intger := 0;

    FOR i := 1 TO STRLENGTH (strng) DO
      CASE strng (i) OF
      = '0' .. '9' =
        intger := (intger * 16) + ($INTEGER (strng (i)) - $INTEGER ('0'));
      = 'a' .. 'f' =
        intger := (intger * 16) + ($INTEGER (strng (i)) - $INTEGER ('a') + 10);
      = 'A' .. 'F' =
        intger := (intger * 16) + ($INTEGER (strng (i)) - $INTEGER ('A') + 10);
      ELSE
        RETURN;
      CASEND;
    FOREND;


  PROCEND convert_string_to_integer;
?? OLDTITLE ??
?? NEWTITLE := 'determine_section_name', EJECT ??

{ PURPOSE:
{   Set the section name to the name explicitly given to the section or to
{   a name determined by the segment type.

  PROCEDURE determine_section_name
    (    section_item: pmt$section_item;
     VAR section_name: pmt$program_name);


    IF (section_item.name <> osc$null_name) THEN
      section_name := section_item.name;
    ELSEIF (section_item.kind = llc$code_section) THEN
      section_name := 'CODE SECTION';
    ELSEIF (section_item.kind = llc$binding_section) THEN
      section_name := 'BINDING SECTION';
    ELSEIF (section_item.segment_access_control.read_privilege <> osc$non_readable) AND
          (section_item.segment_access_control.write_privilege <> osc$non_writable) THEN
      section_name := 'READ WRITE';
    ELSEIF (section_item.segment_access_control.read_privilege <> osc$non_readable) THEN
      section_name := 'READ ONLY';
    ELSE
      section_name := 'WORKING STORAGE';
    IFEND;


  PROCEND determine_section_name;
?? OLDTITLE ??
?? NEWTITLE := 'display_address', EJECT ??

{ PURPOSE:
{   Common routine to display information on an address.

  PROCEDURE display_address
    (    segment: ost$segment;
         offset: ost$segment_offset;
         module_name: pmt$program_name;
         section_name: pmt$program_name;
         offset_in_section: ost$segment_offset);


    VAR
      ignore: boolean,
      strng: string (132),
      l: integer;


    ocp$hexrep (strng, l, segment);
    ocp$output ('   Address: ', strng, l, continue);
    ocp$hexrep (strng, l, offset);
    ocp$output ('', strng, l, continue);

    ocp$output ('   Module: ', module_name, STRLENGTH (module_name), continue);

    ocp$output ('   Section: ', section_name, STRLENGTH (section_name), continue);

    ocp$hexrep (strng, l, offset_in_section);
    ocp$output ('   Offset:', strng, l, end_of_line);


  PROCEND display_address;
?? OLDTITLE ??
?? NEWTITLE := 'display_entry_point', EJECT ??

{ PURPOSE:
{   Displays information about an entry point.

  PROCEDURE display_entry_point
    (    entry_point: pmt$program_name;
         module_name: pmt$program_name;
         segment: ost$segment;
         offset: ost$segment_offset);


    VAR
      strng: string (132),
      l: integer;


    ocp$output ('   Entry Point: ', entry_point, STRLENGTH (entry_point), continue);

    ocp$output ('   Module: ', module_name, STRLENGTH (module_name), continue);

    ocp$hexrep (strng, l, segment);
    ocp$output ('   Address: ', strng, l, continue);
    ocp$hexrep (strng, l, offset);
    ocp$output ('', strng, l, end_of_line);


  PROCEND display_entry_point;
?? OLDTITLE ??
?? NEWTITLE := 'display_module', EJECT ??

{ PURPOSE:
{   Displays information about a module.

  PROCEDURE display_module
    (    module_item: ^pmt$module_item);


    VAR
      ignore: boolean,
      i: integer,
      strng: string (132),
      l: integer;


    ocp$output ('0  Module: ', module_item^.identification.name, #SIZE (module_item^.identification.name),
          continue);

    ocp$output ('  ', 'Created:', 8, continue);
    ocp$output_time (^module_item^.identification.time_created, continue, ignore);
    ocp$output_date (^module_item^.identification.date_created, end_of_line, ignore);


    ocp$output ('   ', 'kind:', 5, continue);
    ocp$output_module_kind (^module_item^.identification.kind, continue, ignore);

    ocp$output ('  ', 'generator:', 10, continue);
    ocp$output_module_generator (^module_item^.identification.generator_id, end_of_line, ignore);

    ocp$output ('   ', 'generator name version:', 23, continue);
    ocp$output (' ', module_item^.identification.generator_name_vers,
          STRLENGTH (module_item^.identification.generator_name_vers), end_of_line);

    IF module_item^.identification.commentary <> osc$null_name THEN
      ocp$output ('   ', 'commentary:', 11, continue);
      ocp$output (' ', module_item^.identification.commentary,
            STRLENGTH (module_item^.identification.commentary), end_of_line);
    IFEND;
?? EJECT ??

    FOR i := 0 TO module_item^.identification.greatest_section_ordinal DO
      ocp$output ('0    ', 'Section kind:', 13, continue);
      ocp$output_section_kind (^module_item^.section_item [i].kind, continue, ignore);
      ocp$output ('  ', 'Attributes:', 11, continue);
      ocp$output_access_control (module_item^.section_item [i].segment_access_control, end_of_line);

      ocp$hexrep (strng, l, module_item^.section_item [i].address DIV 100000000(16));
      ocp$output ('     Segment:', strng, l, continue);
      ocp$hexrep (strng, l, module_item^.section_item [i].address MOD 100000000(16));
      ocp$output ('  Offset:', strng, l, continue);
      ocp$hexrep (strng, l, module_item^.section_item [i].length);
      ocp$output ('  Length:', strng, l, end_of_line);

      ocp$hexrep (strng, l, module_item^.section_item [i].ring.r1);
      ocp$output ('     Rings: (', strng, l, continue);
      ocp$hexrep (strng, l, module_item^.section_item [i].ring.r2);
      ocp$output (',', strng, l, continue);
      ocp$hexrep (strng, l, module_item^.section_item [i].ring.r3);
      ocp$output (',', strng, l, continue);
      ocp$output (' )  Name: ', module_item^.section_item [i].name, #SIZE (pmt$program_name), end_of_line);
    FOREND;

    ocp$output (' ', ' ', 1, end_of_line);


  PROCEND display_module;
?? OLDTITLE ??
?? NEWTITLE := 'f$$debug_table', EJECT ??

{ PURPOSE:
{   Command processor for the $debug_table command.

  PROCEDURE f$$debug_table
    (    parameter_list: clt$parameter_list;
     VAR work_area: ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION $debug_table

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 1, 4, 12, 36, 57, 473],
    clc$function, 0, 0, 0, 0, 0, 0, 0, '']];

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

    VAR
      date_time: clt$date_time,
      debug_table_header: ^pmt$linker_debug_table_header,
      ignore: boolean,
      strng: string (132),
      l: integer;


    status.normal := TRUE;

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

    ocp$get_debug_table_header (debug_table_header, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$make_record_value (6, work_area, result);

    result^.field_values^ [1].name := 'VERSION';
    clp$make_string_value (debug_table_header^.version, work_area, result^.field_values^ [1].value);

    result^.field_values^ [2].name := 'BUILD_LEVEL';
    clp$make_string_value (debug_table_header^.build_level, work_area, result^.field_values^ [2].value);

    result^.field_values^ [3].name := 'DATE_BUILT';
    date_time.date_specified := TRUE;
    date_time.time_specified := TRUE;
    ocp$make_date_time_value (debug_table_header^.date, debug_table_header^.time, work_area,
          result^.field_values^ [3].value);

    result^.field_values^ [4].name := 'MODULES';
    clp$make_integer_value (debug_table_header^.number_of_modules, 16, TRUE, work_area,
          result^.field_values^ [4].value);

    result^.field_values^ [5].name := 'ENTRY_POINTS';
    clp$make_integer_value (debug_table_header^.number_of_entry_points, 16, TRUE, work_area,
          result^.field_values^ [5].value);

    result^.field_values^ [6].name := 'ADDRESSES';
    clp$make_integer_value (debug_table_header^.number_of_addresses, 16, TRUE, work_area,
          result^.field_values^ [6].value);

  PROCEND f$$debug_table;
?? OLDTITLE ??
?? NEWTITLE := 'f$$address', EJECT ??

{ PURPOSE:
{   Command processor for the $address function.

  PROCEDURE f$$address
    (    parameter_list: clt$parameter_list;
     VAR work_area: ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION $address (
{   address: integer 0..0fffffffffff(16) RADIX 16 = $required)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
    recend := [
    [1,
    [89, 1, 4, 14, 49, 53, 716],
    clc$function, 1, 1, 1, 0, 0, 0, 0, ''], [
    ['ADDRESS                        ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 0fffffffffff(16), 16]]];

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

    CONST
      p$address = 1;

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

    VAR
      address: integer,
      segment: ost$segment,
      offset: ost$segment_offset,
      found: boolean,
      module_name: pmt$program_name,
      section_name: pmt$program_name,
      offset_in_section: ost$segment_offset;


    status.normal := TRUE;

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

    address := pvt [p$address].value^.integer_value.value;
    IF ((address MOD 100000000(16)) > 7fffffff(16)) THEN
      abnormal_status_with_address (oce$e_invalid_address_specified, address, status);
      RETURN;
    IFEND;

    segment := address DIV 100000000(16);
    offset := address MOD 100000000(16);

    ocp$find_debug_address (segment, offset, found, module_name, section_name, offset_in_section, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF found THEN

      clp$make_record_value (4, work_area, result);

      result^.field_values^ [1].name := 'ADDRESS';
      clp$make_integer_value (address, 16, TRUE, work_area, result^.field_values^ [1].value);

      result^.field_values^ [2].name := 'MODULE';
      clp$make_program_name_value (module_name, work_area, result^.field_values^ [2].value);

      result^.field_values^ [3].name := 'SECTION';
      clp$make_program_name_value (section_name, work_area, result^.field_values^ [3].value);

      result^.field_values^ [4].name := 'OFFSET';
      clp$make_integer_value (offset_in_section, 16, TRUE, work_area, result^.field_values^ [4].value);
    ELSE
      abnormal_status_with_address (oce$e_address_not_found, address, status);
    IFEND;


  PROCEND f$$address;
?? OLDTITLE ??
?? NEWTITLE := 'f$$entry_point', EJECT ??

{ PURPOSE:
{   Command processor for the $entry_point command.

  PROCEDURE f$$entry_point
    (    parameter_list: clt$parameter_list;
     VAR work_area: ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);


{ FUNCTION $entry_point (
{   entry_point: program_name = $required)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 4, 14, 50, 9, 616],
    clc$function, 1, 1, 1, 0, 0, 0, 0, ''], [
    ['ENTRY_POINT                    ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0]],
{ PARAMETER 1
    [[1, 0, clc$program_name_type]]];

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

    CONST
      p$entry_point = 1;

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

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


    status.normal := TRUE;

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

    entry_point := pvt [p$entry_point].value^.program_name_value;
    ocp$find_debug_entry_point (entry_point, found, module_name, segment, offset, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF found THEN
      clp$make_record_value (3, work_area, result);

      result^.field_values^ [1].name := 'ENTRY_POINT';
      clp$make_program_name_value (entry_point, work_area, result^.field_values^ [1].value);

      result^.field_values^ [2].name := 'MODULE';
      clp$make_program_name_value (module_name, work_area, result^.field_values^ [2].value);

      result^.field_values^ [3].name := 'ADDRESS';
      clp$make_integer_value (segment * 100000000(16) + offset, 16, TRUE, work_area, result^.
            field_values^ [3].value);
    ELSE
      osp$set_status_abnormal ('OC', oce$e_entry_point_not_found, entry_point, status);
    IFEND;


  PROCEND f$$entry_point;
?? OLDTITLE ??
?? NEWTITLE := 'f$$module', EJECT ??

{ PURPOSE:
{   Command processor for the $module function.

  PROCEDURE f$$module
    (    parameter_list: clt$parameter_list;
     VAR work_area: ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);


{ FUNCTION $module (
{   module: program_name = $required
{   occurrence: integer 1..pmc$maximum_debug_items = 1)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 1, 4, 14, 50, 26, 89],
    clc$function, 2, 2, 1, 0, 0, 0, 0, ''], [
    ['MODULE                         ',clc$nominal_entry, 1],
    ['OCCURRENCE                     ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$program_name_type]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, pmc$maximum_debug_items, 10],
    '1']];

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

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

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

    VAR
      entry: ^clt$data_value,
      found: boolean,
      module_item: ^pmt$module_item,
      module_name: ost$name,
      occurrence: integer,
      s: integer,
      section_name: pmt$program_name;


    status.normal := TRUE;

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

    module_name := pvt [p$module].value^.program_name_value;
    occurrence := pvt [p$occurrence].value^.integer_value.value;

    ocp$find_debug_module_item (module_name, occurrence, found, module_item, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT found THEN
      osp$set_status_abnormal ('OC', oce$e_module_item_not_found, module_name, status);
      RETURN;
    IFEND;

    clp$make_record_value (4, work_area, result);

    result^.field_values^ [1].name := 'MODULE';
    clp$make_program_name_value (module_item^.identification.name, work_area, result^.field_values^ [1].
          value);

    result^.field_values^ [2].name := 'CREATED';
    ocp$make_date_time_value (module_item^.identification.date_created,
          module_item^.identification.time_created, work_area, result^.field_values^ [2].value);

    result^.field_values^ [3].name := 'COMMENTARY';
    clp$make_string_value (module_item^.identification.commentary, work_area, result^.field_values^ [3].
          value);

    result^.field_values^ [4].name := 'SECTIONS';
    result^.field_values^ [4].value := NIL;

    FOR s := module_item^.identification.greatest_section_ordinal DOWNTO 0 DO
      clp$make_list_value (work_area, entry);

      clp$make_record_value (4, work_area, entry^.element_value);
      entry^.link := result^.field_values^ [4].value;
      result^.field_values^ [4].value := entry;
      entry := entry^.element_value;

      entry^.field_values^ [1].name := 'NAME';
      determine_section_name (module_item^.section_item [s], section_name);
      clp$make_program_name_value (section_name, work_area,
            entry^.field_values^ [1].value);

      entry^.field_values^ [2].name := 'ADDRESS';
      clp$make_integer_value (module_item^.section_item [s].address, 16, TRUE, work_area,
            entry^.field_values^ [2].value);

      entry^.field_values^ [3].name := 'LENGTH';
      clp$make_integer_value (module_item^.section_item [s].address, 16, TRUE, work_area,
            entry^.field_values^ [3].value);

      entry^.field_values^ [4].name := 'RINGS';
      clp$make_record_value (3, work_area, entry^.field_values^ [4].value);
      entry := entry^.field_values^ [4].value;

      entry^.field_values^ [1].name := 'R1';
      clp$make_integer_value (module_item^.section_item [s].ring.r1, 16, TRUE, work_area,
            entry^.field_values^ [1].value);

      entry^.field_values^ [2].name := 'R2';
      clp$make_integer_value (module_item^.section_item [s].ring.r2, 16, TRUE, work_area,
            entry^.field_values^ [2].value);

      entry^.field_values^ [3].name := 'R3';
      clp$make_integer_value (module_item^.section_item [s].ring.r3, 16, TRUE, work_area,
            entry^.field_values^ [3].value);

    FOREND;

  PROCEND f$$module;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$make_date_time_value', EJECT ??

  PROCEDURE ocp$make_date_time_value
    (    date: ost$date;
         time: ost$time;
     VAR work_area: ^clt$work_area;
     VAR value: ^clt$data_value);

    VAR
      date_time: clt$date_time,
      status: ost$status,
      time_time: clt$date_time;

    value := NIL;
    CASE time.time_format OF
    = osc$ampm_time =
      clp$convert_string_to_date_time (time.ampm, 'AMPM', time_time, status);
    = osc$hms_time =
      clp$convert_string_to_date_time (time.hms, 'HMS', time_time, status);
    = osc$millisecond_time =
      clp$convert_string_to_date_time (time.millisecond, 'MS', time_time, status);
    ELSE
      status.normal := FALSE;
    CASEND;

    IF NOT status.normal THEN
      time_time.time_specified := FALSE;
    IFEND;

    CASE date.date_format OF
    = osc$month_date =
      clp$convert_string_to_date_time (date.month, 'MONTH', date_time, status);
    = osc$iso_date =
      clp$convert_string_to_date_time (date.iso, 'ISOD', date_time, status);
    = osc$ordinal_date =
      clp$convert_string_to_date_time (date.ordinal, 'ORDINAL', date_time, status);
    = osc$dmy_date =
      clp$convert_string_to_date_time (date.dmy, 'DMY', date_time, status);
    = osc$mdy_date =
      clp$convert_string_to_date_time (date.mdy, 'MDY', date_time, status);
    ELSE
      status.normal := FALSE;
    CASEND;

    IF NOT status.normal THEN
      date_time.date_specified := FALSE;
    IFEND;

    date_time.time_specified := time_time.time_specified;
    IF date_time.time_specified THEN
      date_time.value.hour := time_time.value.hour;
      date_time.value.minute := time_time.value.minute;
      date_time.value.second := time_time.value.second;
      date_time.value.millisecond := time_time.value.millisecond;
    IFEND;

    clp$make_date_time_value (date_time, work_area, value);

  PROCEND ocp$make_date_time_value;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$query_debug_table_scl', EJECT ??

{ PURPOSE:
{   Processes the Query_debug_table utility.

  PROCEDURE [XDCL, #GATE] ocp$query_debug_table_scl
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE query_debug_table (
{   debug_table, dt: any of
{       key
{         (running_system, rs)
{       keyend
{       file
{     anyend = running_system
{   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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
        default_value: string (14),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 3, 21, 19, 37, 407],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['DEBUG_TABLE                    ',clc$nominal_entry, 1],
    ['DT                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, 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, 104,
  clc$optional_default_parameter, 0, 14],
{ 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$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]]
    ,
    'running_system'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

{ table utility_functions t=f s=local
{ function $address       f$$address cm=local
{ function $debug_table   f$$debug_table cm=local
{ function $entry_point   f$$entry_point cm=local
{ function $module        f$$module cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

    VAR
      utility_functions: [STATIC, READ] ^clt$function_processor_table := ^utility_functions_entries,

      utility_functions_entries: [STATIC, READ] array [1 .. 4] of clt$function_proc_table_entry := [
            {} ['$ADDRESS                       ', clc$nominal_entry, clc$normal_usage_entry, 1,
            clc$linked_call, ^f$$address],
            {} ['$DEBUG_TABLE                   ', clc$nominal_entry, clc$normal_usage_entry, 2,
            clc$linked_call, ^f$$debug_table],
            {} ['$ENTRY_POINT                   ', clc$nominal_entry, clc$normal_usage_entry, 3,
            clc$linked_call, ^f$$entry_point],
            {} ['$MODULE                        ', clc$nominal_entry, clc$normal_usage_entry, 4,
            clc$linked_call, ^f$$module]];

?? POP ??

{ table utility_commands t=c s=local
{ command (display_address               ,disa) c$_display_address cm=local
{ command (display_debug_table           ,disdt) c$_display_debug_table cm=local
{ command (display_entry_point           ,disep) c$_display_entry_point cm=local
{ command (display_module                ,dism) c$_display_module cm=local
{ command (use_debug_table               ,usedt) c$_use_debug_table cm=local
{ command (quit                          ,qui) c$_quit cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

    VAR
      utility_commands: [STATIC, READ] ^clt$command_table := ^utility_commands_entries,

      utility_commands_entries: [STATIC, READ] array [1 .. 12] of clt$command_table_entry := [
            {} ['DISA                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
            clc$automatically_log, clc$linked_call, ^c$_display_address],
            {} ['DISDT                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
            clc$automatically_log, clc$linked_call, ^c$_display_debug_table],
            {} ['DISEP                          ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
            clc$automatically_log, clc$linked_call, ^c$_display_entry_point],
            {} ['DISM                           ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
            clc$automatically_log, clc$linked_call, ^c$_display_module],
            {} ['DISPLAY_ADDRESS                ', clc$nominal_entry, clc$normal_usage_entry, 1,
            clc$automatically_log, clc$linked_call, ^c$_display_address],
            {} ['DISPLAY_DEBUG_TABLE            ', clc$nominal_entry, clc$normal_usage_entry, 2,
            clc$automatically_log, clc$linked_call, ^c$_display_debug_table],
            {} ['DISPLAY_ENTRY_POINT            ', clc$nominal_entry, clc$normal_usage_entry, 3,
            clc$automatically_log, clc$linked_call, ^c$_display_entry_point],
            {} ['DISPLAY_MODULE                 ', clc$nominal_entry, clc$normal_usage_entry, 4,
            clc$automatically_log, clc$linked_call, ^c$_display_module],
            {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
            clc$automatically_log, clc$linked_call, ^c$_quit],
            {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 6,
            clc$automatically_log, clc$linked_call, ^c$_quit],
            {} ['USEDT                          ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
            clc$automatically_log, clc$linked_call, ^c$_use_debug_table],
            {} ['USE_DEBUG_TABLE                ', clc$nominal_entry, clc$normal_usage_entry, 5,
            clc$automatically_log, clc$linked_call, ^c$_use_debug_table]];

?? POP ??

    VAR
      utility_attributes: array [1 .. 3] of clt$utility_attribute,
      ignore_status: ost$status;


    status.normal := TRUE;

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

    ocp$open_output_file (clc$standard_output, ^dummy_header, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (pvt [p$debug_table].value <> NIL) THEN
      IF (pvt [p$debug_table].value^.kind = clc$keyword) THEN
        ocp$open_running_debug_table (status);
      ELSE
        ocp$open_linker_debug_table (pvt [p$debug_table].value^.file_value^, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    utility_attributes [1].key := clc$utility_command_table;
    utility_attributes [1].command_table := utility_commands;
    utility_attributes [2].key := clc$utility_function_proc_table;
    utility_attributes [2].function_processor_table := utility_functions;
    utility_attributes [3].key := clc$utility_prompt;
    utility_attributes [3].prompt.value := utility_prompt;
    utility_attributes [3].prompt.size := STRLENGTH (utility_prompt);

    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$include_file (clc$current_command_input, '', utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_utility (utility_name, ignore_status);

    ocp$close_linker_debug_table (ignore_status);
    ocp$close_output_file (ignore_status);

  PROCEND ocp$query_debug_table_scl;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] ocp$query_debug_table', EJECT ??

{ PURPOSE:
{   Process the Query_debug_table command.

  PROCEDURE [XDCL, #GATE] ocp$query_debug_table
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE query_debug_table (
{   debug_table, dt: any of
{       key
{         (running_system, rs)
{       keyend
{       file
{     anyend = running_system
{   input, i: file = input
{   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 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
        default_value: string (14),
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (6),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 3, 21, 0, 34, 905],
    clc$command, 7, 4, 0, 0, 0, 0, 4, ''], [
    ['DEBUG_TABLE                    ',clc$nominal_entry, 1],
    ['DT                             ',clc$abbreviation_entry, 1],
    ['I                              ',clc$abbreviation_entry, 2],
    ['INPUT                          ',clc$nominal_entry, 2],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [1, 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, 104,
  clc$optional_default_parameter, 0, 14],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 3
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$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]]
    ,
    'running_system'],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    'input'],
{ PARAMETER 3
    [[1, 0, clc$file_type],
    'output'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$debug_table = 1,
      p$input = 2,
      p$output = 3,
      p$status = 4;

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


    VAR
      input_file_identifier: amt$file_identifier,
      ignore_status: ost$status;


    status.normal := TRUE;

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


    IF (pvt [p$debug_table].value <> NIL) THEN
      IF (pvt [p$debug_table].value^.kind = clc$keyword) THEN
        ocp$open_running_debug_table (status);
      ELSE
        ocp$open_linker_debug_table (pvt [p$debug_table].value^.file_value^, status);
      IFEND;

      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;


    open_input_file (pvt [p$input].value^.file_value^, input_file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    ocp$open_output_file (pvt [p$output].value^.file_value^, ^dummy_header, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    process_input_file (input_file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    ocp$close_linker_debug_table (ignore_status);
    ocp$close_output_file (ignore_status);
    fsp$close_file (input_file_identifier, ignore_status);


  PROCEND ocp$query_debug_table;
?? OLDTITLE ??
?? NEWTITLE := 'open_input_file', EJECT ??

{ PURPOSE:
{   Opens the specified file for input.

  PROCEDURE open_input_file
    (    file: fst$file_reference;
     VAR file_identifier: amt$file_identifier;
     VAR status: ost$status);


    VAR
      read_attributes: [STATIC] array [1 .. 1] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, $fst$file_access_options [fsc$read]],
            [fsc$required_share_modes]]];


    fsp$open_file (file, amc$record, ^read_attributes, NIL, NIL, NIL, NIL, file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


  PROCEND open_input_file;
?? OLDTITLE ??
?? NEWTITLE := 'process_input_file', EJECT ??

{ PURPOSE:
{  Read commands consisting of module names, procedures, hex pvas, or the
{  word QUIT from the input file.  Output the corresponding information.

  PROCEDURE process_input_file
    (    file_identifier: amt$file_identifier;
     VAR status: ost$status);


    VAR
      debug_table_header: ^pmt$linker_debug_table_header,
      transfer_count: amt$transfer_count,
      byte_address: amt$file_byte_address,
      file_position: amt$file_position,
      line: string (31),
      name: string (31),
      found: boolean,
      module_name: pmt$program_name,
      module_item: ^pmt$module_item,
      segment: ost$segment,
      offset: ost$segment_offset,
      intger: integer,
      section_name: pmt$program_name,
      offset_in_section: ost$segment_offset;


    ocp$get_debug_table_header (debug_table_header, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ocp$output ('0Debug table for ', debug_table_header^.build_level, #SIZE (debug_table_header^.build_level),
          end_of_line);

    ocp$output ('0', 'Enter a module or procedure name, an address, or QUIT to exit.', 62, end_of_line);

?? EJECT ??

    WHILE status.normal DO
      line := ' ';

      amp$get_next (file_identifier, #LOC (line), #SIZE (line), transfer_count, byte_address, file_position,
            status);
      IF status.normal THEN
        IF (file_position = amc$eoi) THEN
          RETURN;
        IFEND;

        IF (transfer_count <> 0) AND (line <> ' ') THEN
          IF (line (1) < '0') OR (line (1) > '9') THEN
            #TRANSLATE (osv$lower_to_upper, line, name);
            IF (name = 'QUI ') OR (name = 'QUIT ') THEN
              RETURN;
            ELSE
              ocp$find_debug_entry_point (name, found, module_name, segment, offset, status);
              IF status.normal THEN
                IF found THEN
                  display_entry_point (name, module_name, segment, offset);
                ELSE
                  ocp$find_debug_module_item (name, 1, found, module_item, status);
                  IF status.normal THEN
                    IF found THEN
                      display_module (module_item);
                    ELSE
                      ocp$output (' Name not found: ', name, #SIZE (name), end_of_line);
                    IFEND;
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
?? EJECT ??
          ELSE { address }
            convert_string_to_integer (line, intger);

            segment := intger DIV 100000000(16);
            offset := intger MOD 100000000(16);

            ocp$find_debug_address (segment, offset, found, module_name, section_name, offset_in_section,
                  status);
            IF status.normal THEN
              IF found THEN
                display_address (segment, offset, module_name, section_name, offset_in_section);
              ELSE
                ocp$output (' Address not found: ', line, #SIZE (line), end_of_line);
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    WHILEND;


  PROCEND process_input_file;
?? OLDTITLE ??

MODEND ocm$query_linker_debug_tables;
