?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Analyze System' ??
MODULE dum$analyze_system;

{ PURPOSE:
{
{   This module contains the entry point for the Analyze System utility and some
{   of the command and function processors.  The Analyze System utility provides
{   the ability to access memory in the running system using commands and
{   functions that are similar to those provided by the Analyze Dump utility.
{   Only PVA mode addressing is supported, and only for PVA's contained in the
{   address space of the task running Analyze System.  Since much of NOS/VE is
{   addressable as PVA's in all tasks, however, this is a very useful subset.
{
{ DESIGN:
{
{   The command and function tables for the Analyze System utility are defined
{   in separate modules and are referenced as externals in this module.
{
{   Access to NOS/VE system memory is provided to this module by the
{   dup$move_bytes interface.  This module in turn provides memory access for
{   the Symbolic Access modules through the dup$get_bytes interface.  The
{   dup$get_bytes interface is placed in this module to make sure it gets loaded
{   and linked to rather than the version with the same name that performs the
{   same function in the context of Analyze Dump.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$page_widths
*copyc clc$standard_file_names
*copyc duc$dump_analyzer_constants
*copyc due$exception_condition_codes
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$set_segment_eoi
*copyc clp$begin_utility
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$reset_for_next_display_page
*copyc dup$move_bytes
*copyc fsp$close_file
*copyc fsp$open_file
*copyc ocp$open_running_debug_table
*copyc ofp$display_status_message
*copyc osp$append_status_integer
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$format_message
*copyc osp$get_message_level
*copyc osp$set_status_abnormal
*copyc pmp$get_legible_date_time
?? TITLE := 'Global Declarations Declared by This Module', EJECT ??
  CONST
    c$utility_name = 'ANALYZE_SYSTEM                 ',
    c$prompt_string = 'as',
    c$version = 'Analyze_system (V1.0)';

  TYPE
    t$address_parameter = record
      case 0 .. 1 of
      = 0 =
        fill1: 0 .. 0ffff(16),
        pva: ost$pva,
      = 1 =
        value: integer,
      casend,
    recend;

  TYPE
    s0to63 = set of 0..63;
?? EJECT ??

  VAR
    v$control_codes_to_space: [READ] string (256) := '            '
      CAT '                     !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijkl'
      CAT 'mnopqrstuvwxyz{|}~                                                                                '
      CAT '                                                 ';

  VAR
    v$command_name: [STATIC] string (osc$max_name_size),
    v$title: [STATIC] string (25) := c$version,
    v$titles_built: [STATIC] boolean,
    wide_title: [STATIC] string (clc$wide_page_width),
    narrow_title1,
    narrow_title2: [STATIC] string (clc$narrow_page_width),
    wide: [STATIC] boolean,
    page_width: [STATIC] integer;
?? TITLE := '  dup$get_bytes', EJECT ??
{ Procedure dup$get_bytes is located in module dum$analyze_system to make sure
{ it gets loaded and linked to rather than the version with the same name that
{ performs the same function in the context of Analyze Dump.

  PROCEDURE [XDCL] dup$get_bytes (source: ost$pva;
        destination: ^cell;
        length: 0..7fffffff(16);
    VAR status: ost$status);

    VAR
      s: ost$pva;

    s := source;

    IF (s.ring = osc$invalid_ring) THEN {local address flag}
      s.ring := osc$min_ring;
    IFEND;

    dup$move_bytes (#ADDRESS (s.ring, s.seg, s.offset), destination, length, status);
  PROCEND dup$get_bytes;
?? TITLE := '  dup$analyze_system', EJECT ??

  PROGRAM dup$analyze_system (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE analyze_system, anas (
{   title, t: string 1..25 = $optional
{   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$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 3, 28, 11, 15, 23, 909],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['STATUS                         ',clc$nominal_entry, 2],
    ['T                              ',clc$abbreviation_entry, 1],
    ['TITLE                          ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$optional_parameter, 0
  , 0],
{ PARAMETER 2
    [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$string_type], [1, 25, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

*copy duv$anas_functions
*copy duv$anas_commands


    VAR
      p_attributes: ^clt$utility_attributes;


    PROCEDURE exit_condition_handler (exit_condition: pmt$condition;
          exit_condition_descriptor: ^pmt$condition_information;
          save_area: ^ost$stack_frame_save_area;
      VAR condition_status: ost$status);

      VAR
        utility_status: ost$status;

      condition_status.normal := TRUE;
      CASE exit_condition.selector OF
      = pmc$block_exit_processing =
        clp$end_utility (c$utility_name, utility_status);
        ofp$display_status_message (' ', utility_status);
      ELSE
      CASEND;
    PROCEND exit_condition_handler;


?? NEWTITLE := '    Main routine', EJECT ??

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

    IF pvt [p$title].specified THEN
      v$title := pvt [p$title].value^.string_value^;
    IFEND;

    ocp$open_running_debug_table (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^exit_condition_handler);

    PUSH p_attributes: [1 .. 4];
    p_attributes^ [1].key := clc$utility_command_search_mode;
    p_attributes^ [1].command_search_mode := clc$global_command_search;
    p_attributes^ [2].key := clc$utility_command_table;
    p_attributes^ [2].command_table := duv$anas_commands;
    p_attributes^ [3].key := clc$utility_function_proc_table;
    p_attributes^ [3].function_processor_table := duv$anas_functions;
    p_attributes^ [4].key := clc$utility_prompt;
    p_attributes^ [4].prompt.value := c$prompt_string;
    p_attributes^ [4].prompt.size := STRLENGTH (c$prompt_string);

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

    ofp$display_status_message ('processing command input', status);
    clp$include_file (clc$current_command_input, '', c$utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    ofp$display_status_message (' ', status);

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

    osp$disestablish_cond_handler;
  PROCEND dup$analyze_system;
?? OLDTITLE ??
?? TITLE := '  build_standard_title', EJECT ??

  PROCEDURE build_standard_title (wide: boolean;
        command_name: string (osc$max_name_size);
    VAR wide_title: string (clc$wide_page_width);
    VAR narrow_title1: string (clc$narrow_page_width);
    VAR narrow_title2: string (clc$narrow_page_width);
    VAR status: ost$status);

    CONST
      max_date_time_length = 18;

    VAR
      date_substring: string (max_date_time_length),
      time_substring: string (max_date_time_length),
      date: ost$date,
      time: ost$time;


    PROCEDURE assign_date (VAR substr: string ( * );
          date: ost$date);


      substr := '';
      CASE date.date_format OF
      = osc$month_date =
        substr := date.month;
      = osc$mdy_date =
        substr := date.mdy;
      = osc$iso_date =
        substr := date.iso;
      = osc$ordinal_date =
        substr := date.ordinal;
      = osc$dmy_date =
        substr := date.dmy;
      CASEND;

    PROCEND assign_date;


    PROCEDURE assign_time (VAR substr: string ( * );
          time: ost$time);

      substr := '';
      CASE time.time_format OF
      = osc$ampm_time =
        substr := time.ampm;
      = osc$hms_time =
        substr := time.hms;
      = osc$millisecond_time =
        substr := time.millisecond;
      CASEND;

    PROCEND assign_time;


    pmp$get_legible_date_time (osc$default_date, date, osc$default_time, time,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF wide THEN

      wide_title := '';
      wide_title (1, 25) := v$title;
      wide_title (41, 31) := command_name;
      assign_date (date_substring, date);
      wide_title (90, 18) := date_substring;
      assign_time (time_substring, time);
      wide_title (109, 12) := time_substring;
      wide_title (122, 5) := 'PAGE ';

    ELSE

      narrow_title1 := '';
      narrow_title2 := '';
      narrow_title1 (1, 25) := v$title;
      narrow_title1 (28, 31) := command_name;
      narrow_title1 (62, 5) := 'PAGE ';
      assign_date (date_substring, date);
      narrow_title2 (1, 18) := date_substring;
      assign_time (time_substring, time);
      narrow_title2 (21, 12) := time_substring;

    IFEND;


  PROCEND build_standard_title;
?? TITLE := '  dup$anas_copy_memory_command', EJECT ??
  PROCEDURE [XDCL] dup$anas_copy_memory_command (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE copy_memory, copm (
{   address, a: integer = $required
{   file, f: file = $required
{   byte_count, bc: integer 0..osc$max_segment_length = 100000(16)
{   exchange, e: any of
{       key
{         (active, a)
{         (monitor, m)
{         (job, j)
{       keyend
{       integer 0..0ffffffff(16)
{     anyend = active
{   processor, p: integer 0..3 = 0
{   address_mode, am: key
{       (process_virtual_address, pva)
{     keyend = process_virtual_address
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (10),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 6] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (23),
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 3, 28, 11, 34, 32, 838],
    clc$command, 13, 7, 2, 0, 0, 0, 7, ''], [
    ['A                              ',clc$abbreviation_entry, 1],
    ['ADDRESS                        ',clc$nominal_entry, 1],
    ['ADDRESS_MODE                   ',clc$nominal_entry, 6],
    ['AM                             ',clc$abbreviation_entry, 6],
    ['BC                             ',clc$abbreviation_entry, 3],
    ['BYTE_COUNT                     ',clc$nominal_entry, 3],
    ['E                              ',clc$abbreviation_entry, 4],
    ['EXCHANGE                       ',clc$nominal_entry, 4],
    ['F                              ',clc$abbreviation_entry, 2],
    ['FILE                           ',clc$nominal_entry, 2],
    ['P                              ',clc$abbreviation_entry, 5],
    ['PROCESSOR                      ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 7]],
    [
{ 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
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 10],
{ PARAMETER 4
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 269,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 5
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 6
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81,
  clc$optional_default_parameter, 0, 23],
{ PARAMETER 7
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [0, osc$max_segment_length, 10],
    '100000(16)'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    229, [[1, 0, clc$keyword_type], [6], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ACTIVE                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['J                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['JOB                            ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['M                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['MONITOR                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    20, [[1, 0, clc$integer_type], [0, 0ffffffff(16), 10]]
    ,
    'active'],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [0, 3, 10],
    '0'],
{ PARAMETER 6
    [[1, 0, clc$keyword_type], [2], [
    ['PROCESS_VIRTUAL_ADDRESS        ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['PVA                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ,
    'process_virtual_address'],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

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

    CONST
      p$address = 1,
      p$file = 2,
      p$byte_count = 3,
      p$exchange = 4,
      p$processor = 5,
      p$address_mode = 6,
      p$status = 7;

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

    VAR
      attachment: [STATIC, READ] array [1 .. 1] of fst$attachment_option := [[fsc$access_and_share_modes,
            [fsc$specific_access_modes, [fsc$read, fsc$shorten, fsc$append, fsc$modify]],
            [fsc$determine_from_access_modes]]],
      attributes: [STATIC, READ] array [1 .. 1] of fst$file_cycle_attribute :=
            [[fsc$record_type, amc$undefined]],
      address: t$address_parameter,
      bytes: ost$segment_length,
      bytes_returned: ost$segment_length,
      copy_count: integer,
      fid: amt$file_identifier,
      file_open: boolean,
      file_pointer: amt$segment_pointer,
      local_status: ost$status,
      memory_buffer: ^SEQ ( * );

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      clean_up;

    PROCEND abort_handler;
?? OLDTITLE ??
?? NEWTITLE := '    clean_up', EJECT ??

    PROCEDURE [INLINE] clean_up;

      VAR ignore_status: ost$status;

      IF file_open THEN
        fsp$close_file (fid, ignore_status);
      IFEND;

    PROCEND clean_up;
?? TITLE := '    main routine', EJECT ??

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

    address.value := pvt [p$address].value^.integer_value.value;

    file_open := false;
    osp$establish_block_exit_hndlr (^abort_handler);

    bytes := pvt [p$byte_count].value^.integer_value.value;

    fsp$open_file (pvt [p$file].value^.file_value^, amc$segment, ^attachment, ^attributes, NIL, NIL, NIL, fid,
         status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    file_open := true;
    amp$get_segment_pointer (fid, amc$sequence_pointer, file_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    memory_buffer := NIL;
    IF (file_pointer.sequence_pointer <> NIL) THEN
      RESET file_pointer.sequence_pointer;
      NEXT memory_buffer: [[REP bytes OF cell]] IN file_pointer.sequence_pointer;
    IFEND;

    IF (memory_buffer = NIL) THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
            'getting pointer to file for memory copy.', status);
    ELSE
      copy_count := bytes;
      RESET file_pointer.sequence_pointer;

      REPEAT
        NEXT memory_buffer:[[REP copy_count OF cell]] IN file_pointer.sequence_pointer;
        RESET memory_buffer;

        IF (copy_count > 16384) THEN
          bytes_returned := 16384;
        ELSE
          bytes_returned := copy_count;
        IFEND;

        dup$move_bytes (#address (1, address.pva.seg, address.
              pva.offset), #LOC (memory_buffer^), bytes_returned, status);

        IF status.normal THEN
          copy_count := copy_count - bytes_returned;

          IF (copy_count > 0) THEN
            RESET file_pointer.sequence_pointer TO memory_buffer;
            NEXT memory_buffer: [[REP bytes_returned of cell]] IN
                  file_pointer.sequence_pointer;
            address.pva.offset := address.pva.offset + bytes_returned;
          IFEND;
        ELSE
          copy_count := 0;
          RESET file_pointer.sequence_pointer TO memory_buffer;
          amp$set_segment_eoi (fid, file_pointer, local_status);
        IFEND;
      UNTIL copy_count <= 0;

      IF status.normal THEN
        amp$set_segment_eoi (fid, file_pointer, status);
      IFEND;
    IFEND;

    fsp$close_file (fid, local_status);
    IF (status.normal AND NOT local_status.normal) THEN
      status := local_status;
    IFEND;

    osp$disestablish_cond_handler;
  PROCEND dup$anas_copy_memory_command;
?? OLDTITLE ??
?? TITLE := '  display_memory', EJECT ??

  PROCEDURE display_memory (VAR display_control:
    clt$display_control;
        memory_parameter: ^SEQ ( * );
        bytes: integer;
        start_address: ost$segment_offset;
        numeric_display: boolean;
        ascii_display: boolean;
    VAR status: ost$status);

    PROCEDURE [inline] convert_byte_to_hex_string (byte: 0 .. 0ff(16);
      VAR str: string (2));

      VAR
        ptr: ^packed record
          left: 0 .. 0f(16),
          right: 0 .. 0f(16)
        recend;

      ptr := #LOC (byte);
      str (1) := hex_chars [ptr^.left];
      str (2) := hex_chars [ptr^.right];

    PROCEND convert_byte_to_hex_string;

    CONST
      bytes_in_item = 8,
      size_of_address = 8,
      spaces_bet_ad_and_display = 3,
      fixed = size_of_address + spaces_bet_ad_and_display,
      space_for_numeric_byte = 2;

    VAR
      ascii_tab_column: 1 .. 256,
      byte: ^0 .. 0ff(16),
      byte_count: 1 .. 2,
      bytes_displayed: integer,
      bytes_this_line: 0 .. 132,
      char_index: 0 .. 255,
      current_item: 1 .. 63,
      display_address: ost$segment_length,
      first_item: ^cell,
      first_line: boolean,
      half_words: 1 .. 2,
      half_half_words: 1 .. 2,
      hex_chars: [static] array [0 .. 0f(16)] of char :=
         ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A',
          'B', 'C', 'D', 'E', 'F'],
      item_ascii: ^string ( * ),
      items_per_line: 0 .. 100,
      line_buffer: ^string ( * ),
      line_index: 1 .. 256,
      local_status: ost$status,
      memory: ^SEQ ( * ),
      page_width: amt$page_width,
      previous_line: ^string ( * ),
      repeated_lines: integer,
      space_for_numeric_item: 0 .. 132,
      space_for_ascii_item: 0 .. 132;

    memory := memory_parameter;

    IF display_control.page_width > 132 THEN
      page_width := 132;
    ELSEIF display_control.page_width < 40 THEN
      page_width := 40;
    ELSE
      page_width := display_control.page_width;
    IFEND;


    IF numeric_display THEN
      space_for_numeric_item := bytes_in_item * space_for_numeric_byte + 6;
    ELSE
      space_for_numeric_item := 0;
    IFEND;
    IF ascii_display THEN
      space_for_ascii_item := bytes_in_item;
    ELSE
      space_for_ascii_item := 0;
    IFEND;

    items_per_line := (page_width - fixed) DIV (space_for_ascii_item +
          space_for_numeric_item);
    IF items_per_line = 0 THEN
      items_per_line := 1;
      page_width := fixed + space_for_ascii_item + space_for_numeric_item;
    IFEND;
    ascii_tab_column := fixed + (items_per_line * space_for_numeric_item) + 1;

    PUSH line_buffer: [page_width];
    PUSH previous_line: [page_width];
    IF (line_buffer = NIL) OR (previous_line = NIL) THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
        'processing display_memory', status);
      RETURN;
    IFEND;

    previous_line^ := ' ';
    repeated_lines := 0;
    display_address := start_address;
    bytes_displayed := 0;
    bytes_this_line := items_per_line * space_for_ascii_item;
    first_line := TRUE;

  /display_items/
    WHILE TRUE DO
      line_buffer^ := ' ';
      line_index := 1;
      clp$convert_integer_to_rjstring (display_address, 16, FALSE, '0',
            line_buffer^ (line_index, size_of_address), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      line_index := line_index + size_of_address + spaces_bet_ad_and_display;
      NEXT byte IN memory;
      IF byte = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
          'processing display_memory', status);
        RETURN;
      IFEND;
      first_item := byte;
      RESET memory TO first_item;

      IF numeric_display THEN
        bytes_this_line := 0;

      /format_numeric/
        FOR current_item := 1 TO items_per_line DO
          FOR half_words := 1 TO 2 DO
            FOR half_half_words := 1 TO 2 DO
              FOR byte_count := 1 TO 2 DO
                NEXT byte IN memory;
                IF byte = NIL THEN
                  osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
                        'processing display_memory', status);
                  RETURN;
                IFEND;
                convert_byte_to_hex_string (byte^, line_buffer^
                       (line_index, 2));
                line_index := line_index + 2;
                bytes_this_line := bytes_this_line + 1;
                bytes_displayed := bytes_displayed + 1;
                IF bytes_displayed >= bytes THEN
                  IF first_line THEN
                    line_index := line_index + 3;
                  ELSE
                    line_index := ascii_tab_column;
                  IFEND;
                  EXIT /format_numeric/;
                IFEND;
              FOREND;
              line_index := line_index + 1;
            FOREND;
          FOREND;
          line_index := line_index + 2;
        FOREND /format_numeric/;
      IFEND;
      IF ascii_display THEN
        IF NOT numeric_display THEN
          IF (bytes - bytes_displayed) < bytes_this_line THEN
            bytes_this_line := bytes - bytes_displayed;
          IFEND;
          bytes_displayed := bytes_displayed + bytes_this_line;
        IFEND;
        RESET memory TO first_item;
        NEXT item_ascii: [bytes_this_line] IN memory;
        IF item_ascii = NIL THEN
          osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
            'processing display_memory', status);
          RETURN;
        IFEND;
        #translate (v$control_codes_to_space, item_ascii^, line_buffer^
              (line_index, bytes_this_line));
      IFEND;
      IF ((line_buffer^ (size_of_address + 1, * )) = (previous_line^
            (size_of_address + 1, * ))) AND (bytes_displayed < bytes) THEN
        previous_line^ := line_buffer^;
        repeated_lines := repeated_lines + 1;
      ELSE
        IF repeated_lines > 1 THEN
          osp$set_status_abnormal (duc$dump_analyzer_id, due$skipped_lines, '', local_status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                repeated_lines, 10, FALSE, local_status);
          display_status_message (local_status, display_control, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSEIF repeated_lines = 1 THEN
          clp$put_display (display_control, previous_line^, clc$trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        repeated_lines := 0;
        clp$put_display (display_control, line_buffer^, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        previous_line^ := line_buffer^;
      IFEND;
      display_address := display_address + bytes_this_line;
      IF bytes_displayed >= bytes THEN
        EXIT /display_items/;
      IFEND;
      first_line := FALSE;
    WHILEND /display_items/;


  PROCEND display_memory;
?? TITLE := '  dup$anas_display_memory_command', EJECT??

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

{ PROCEDURE display_memory, dism (
{   address, a: integer = $required
{   bytes, b: integer 0..duc$maximum_memory_display = 8
{   exchange, e: any of
{       key
{         (active, a)
{         (monitor, m)
{         (job, j)
{       keyend
{       integer 0..0ffffffff(16)
{     anyend = active
{   processor, p: integer 0..3 = 0
{   address_mode, am: key
{       (process_virtual_address, pva)
{     keyend = process_virtual_address
{   display_option, do: list 1..2 of key
{       (numeric, n)
{       (ascii, a)
{     keyend = (numeric,    ascii)
{   title, t: string 1..31 = 'display_memory'
{   radix, r: integer 8..16 = 16
{   repeat_count, rc: integer = 0
{   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 .. 21] of clt$pdt_parameter_name,
      parameters: array [1 .. 11] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      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,
        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 .. 6] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (23),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 4] of clt$keyword_specification,
        recend,
        default_value: string (19),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (16),
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type10: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type11: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 3, 28, 15, 35, 18, 789],
    clc$command, 21, 11, 1, 0, 0, 0, 11, ''], [
    ['A                              ',clc$abbreviation_entry, 1],
    ['ADDRESS                        ',clc$nominal_entry, 1],
    ['ADDRESS_MODE                   ',clc$nominal_entry, 5],
    ['AM                             ',clc$abbreviation_entry, 5],
    ['B                              ',clc$abbreviation_entry, 2],
    ['BYTES                          ',clc$nominal_entry, 2],
    ['DISPLAY_OPTION                 ',clc$nominal_entry, 6],
    ['DO                             ',clc$abbreviation_entry, 6],
    ['E                              ',clc$abbreviation_entry, 3],
    ['EXCHANGE                       ',clc$nominal_entry, 3],
    ['O                              ',clc$abbreviation_entry, 10],
    ['OUTPUT                         ',clc$nominal_entry, 10],
    ['P                              ',clc$abbreviation_entry, 4],
    ['PROCESSOR                      ',clc$nominal_entry, 4],
    ['R                              ',clc$abbreviation_entry, 8],
    ['RADIX                          ',clc$nominal_entry, 8],
    ['RC                             ',clc$abbreviation_entry, 9],
    ['REPEAT_COUNT                   ',clc$nominal_entry, 9],
    ['STATUS                         ',clc$nominal_entry, 11],
    ['T                              ',clc$abbreviation_entry, 7],
    ['TITLE                          ',clc$nominal_entry, 7]],
    [
{ 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
    [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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 3
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 269,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [14, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81,
  clc$optional_default_parameter, 0, 23],
{ PARAMETER 6
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 171,
  clc$optional_default_parameter, 0, 19],
{ PARAMETER 7
    [21, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_default_parameter, 0, 16],
{ PARAMETER 8
    [16, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 9
    [18, 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 10
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 11
    [19, 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], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, duc$maximum_memory_display, 10],
    '8'],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    229, [[1, 0, clc$keyword_type], [6], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ACTIVE                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['J                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['JOB                            ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['M                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['MONITOR                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    20, [[1, 0, clc$integer_type], [0, 0ffffffff(16), 10]]
    ,
    'active'],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [0, 3, 10],
    '0'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['PROCESS_VIRTUAL_ADDRESS        ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['PVA                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ,
    'process_virtual_address'],
{ PARAMETER 6
    [[1, 0, clc$list_type], [155, 1, 2, FALSE],
      [[1, 0, clc$keyword_type], [4], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['ASCII                          ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['NUMERIC                        ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    '(numeric,    ascii)'],
{ PARAMETER 7
    [[1, 0, clc$string_type], [1, 31, FALSE],
    '''display_memory'''],
{ PARAMETER 8
    [[1, 0, clc$integer_type], [8, 16, 10],
    '16'],
{ PARAMETER 9
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '0'],
{ PARAMETER 10
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 11
    [[1, 0, clc$status_type]]];

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

    CONST
      p$address = 1,
      p$bytes = 2,
      p$exchange = 3,
      p$processor = 4,
      p$address_mode = 5,
      p$display_option = 6,
      p$title = 7,
      p$radix = 8,
      p$repeat_count = 9,
      p$output = 10,
      p$status = 11;

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

    CONST
      ascii = 'ASCII                          ',
      numeric = 'NUMERIC                        ';

    VAR
      address: t$address_parameter,
      ascii_display: boolean,
      buffer_size: ost$segment_length,
      bytes: ost$segment_length,
      bytes_returned: ost$segment_length,
      display_control: clt$display_control,
      display_count: integer,
      len: integer,
      local_status: ost$status,
      memory_buffer: ^SEQ ( * ),
      numeric_display: boolean,
      output_open: boolean,
      p_element: ^clt$data_value,
      p_list: ^clt$data_value,
      radix: 8 .. 16,
      rc: integer,
      repeat_count: integer,
      ring_attributes: amt$ring_attributes,
      str: string (osc$max_string_size);

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      clean_up;

    PROCEND abort_handler;
?? OLDTITLE ??
?? NEWTITLE := '    clean_up', EJECT ??

    PROCEDURE [INLINE] clean_up;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND clean_up;
?? TITLE := '    main routine', EJECT ??

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

    address.value := pvt [p$address].value^.integer_value.value;
    repeat_count := pvt [p$repeat_count].value^.integer_value.value;

    numeric_display := FALSE;
    ascii_display := FALSE;

    p_list := pvt [p$display_option].value;
    WHILE (p_list <> NIL) DO
      p_element := p_list^.element_value;
      p_list := p_list^.link;
      IF (p_element <> NIL) THEN
        IF (p_element^.keyword_value = numeric) THEN
          numeric_display := TRUE;
        ELSEIF (p_element^.keyword_value = ascii) THEN
          ascii_display := TRUE;
        IFEND;
      IFEND;
    WHILEND;

    output_open := FALSE;
    osp$establish_block_exit_hndlr (^abort_handler);

    ring_attributes.r1 := #RING (^ring_attributes);
    ring_attributes.r2 := #RING (^ring_attributes);
    ring_attributes.r3 := #RING (^ring_attributes);

    clp$open_display_reference (pvt [p$output].value^.file_value^, ^new_page_procedure, fsc$list,
          ring_attributes, display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_open := TRUE;

    v$titles_built := FALSE;
    v$command_name := pvt [p$title].value^.string_value^;

    bytes := pvt [p$bytes].value^.integer_value.value;

    IF bytes > duc$maximum_memory_display THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$memory_display_overflow, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            duc$maximum_memory_display, 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, bytes, 10,
            FALSE, status);
      RETURN;
    ELSEIF bytes = 0 THEN
      RETURN;
    IFEND;

    radix := pvt [p$radix].value^.integer_value.value;
    IF (radix <> 16) AND ((bytes MOD 8) <> 0) THEN
      bytes := bytes + (8 - (bytes MOD 8));
    IFEND;
    buffer_size := bytes;
    IF radix = 8 THEN
      address.value := address.value - (address.value MOD 8);
    IFEND;

    STRINGREP (str, len, 'segment =', address.pva.seg: #(16));
    clp$put_display (display_control, str(1, len), clc$no_trim, status);

    PUSH memory_buffer: [[REP buffer_size OF cell]];
    IF memory_buffer = NIL THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
        'getting buffer for memory to be displayed.', status);
      RETURN;
    IFEND;

    FOR rc := 0 TO repeat_count DO
      display_count := bytes;

      REPEAT
        RESET memory_buffer;

        IF (display_count > 16384) THEN
          bytes_returned := 16384;
        ELSE
          bytes_returned := display_count;
        IFEND;

        dup$move_bytes (#address (1, address.pva.seg, address.
              pva.offset), #LOC (memory_buffer^), bytes_returned, status);

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

        IF bytes_returned > 0 THEN
          RESET memory_buffer;
          IF radix = 16 THEN
            display_memory (display_control, memory_buffer, bytes_returned,
                  address.pva.offset, numeric_display, ascii_display, status);
          ELSE
            display_octal_memory (display_control, memory_buffer,
                  bytes_returned, address.pva.offset, numeric_display,
                  ascii_display, radix, status);
          IFEND;
          IF NOT status.normal THEN
            clean_up;
            RETURN;
          IFEND;
        IFEND;

        display_count := display_count - bytes_returned;
        address.pva.offset := address.pva.offset + bytes_returned;
      UNTIL display_count <= 0;
    FOREND;

    clean_up;

    osp$disestablish_cond_handler;
  PROCEND dup$anas_display_memory_command;
?? OLDTITLE ??
?? TITLE := '  display_octal_memory', EJECT ??

  PROCEDURE display_octal_memory (VAR display_control:
    clt$display_control;
        octal_memory_parameter: ^SEQ ( * );
        bytes: integer;
        start_address: ost$segment_offset;
        numeric_display: boolean;
        ascii_display: boolean;
        radix: 8 .. 16;
    VAR status: ost$status);

    CONST
      bytes_in_item = 8,
      size_of_address = 8,
      spaces_bet_ad_and_display = 2,
      fixed = size_of_address + spaces_bet_ad_and_display,
      space_for_numeric_word = 30;

    VAR
      ascii_tab_column: 1 .. 256,
      byte_count: 1 .. 2,
      bytes_displayed: integer,
      bytes_this_line: 0 .. 132,
      char_index: 0 .. 255,
      current_item: 1 .. 63,
      display_address: ost$segment_length,
      first_item: ^cell,
      first_line: boolean,
      half_words: 1 .. 2,
      half_half_words: 1 .. 2,
      item_ascii: ^string ( * ),
      items_per_line: 0 .. 100,
      line_buffer: ^string ( * ),
      line_index: 1 .. 256,
      local_status: ost$status,
      octal_memory: ^SEQ ( * ),
      ost_str: ost$string,
      page_width: amt$page_width,
      previous_line: ^string ( * ),
      repeated_lines: integer,
      space_for_numeric_item: 0 .. 132,
      space_for_ascii_item: 0 .. 132,
      word_index: 1 .. 22,
      word_str: string (22),
      temp_word: record
        case boolean of
        = true =
          value: integer,
        = false =
          s: s0to63,
        casend,
      recend,
      word: ^record
        case boolean of
        = true =
          value: integer,
        = false =
          s: s0to63,
        casend,
      recend;

    octal_memory := octal_memory_parameter;

    IF display_control.page_width > 132 THEN
      page_width := 132;
    ELSEIF display_control.page_width < 40 THEN
      page_width := 40;
    ELSE
      page_width := display_control.page_width;
    IFEND;


    IF numeric_display THEN
      space_for_numeric_item := space_for_numeric_word;
    ELSE
      space_for_numeric_item := 0;
    IFEND;
    IF ascii_display THEN
      space_for_ascii_item := bytes_in_item;
    ELSE
      space_for_ascii_item := 0;
    IFEND;

    items_per_line := (page_width - fixed) DIV (space_for_ascii_item +
          space_for_numeric_item);
    IF items_per_line = 0 THEN
      items_per_line := 1;
      page_width := fixed + space_for_ascii_item + space_for_numeric_item;
    IFEND;
    ascii_tab_column := fixed + (items_per_line * space_for_numeric_item) + 1;

    PUSH line_buffer: [page_width];
    PUSH previous_line: [page_width];
    IF (line_buffer = NIL) OR (previous_line = NIL) THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
        'processing display_memory', status);
      RETURN;
    IFEND;

    previous_line^ := ' ';
    repeated_lines := 0;
    display_address := start_address;
    bytes_displayed := 0;
    bytes_this_line := items_per_line * space_for_ascii_item;
    first_line := TRUE;

  /display_octal/
    WHILE TRUE DO
      line_buffer^ := ' ';
      line_index := 1;
      clp$convert_integer_to_rjstring (display_address, 16, FALSE, '0',
            line_buffer^ (line_index, size_of_address), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      line_index := line_index + size_of_address + spaces_bet_ad_and_display;
      NEXT word IN octal_memory;
      IF word = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
          'processing display_memory', status);
        RETURN;
      IFEND;
      first_item := word;
      RESET octal_memory TO first_item;

      IF numeric_display THEN
        bytes_this_line := 0;

      /format_octal/
        FOR current_item := 1 TO items_per_line DO
          NEXT word IN octal_memory;
          IF word = NIL THEN
            osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
                  'processing display_memory', status);
            RETURN;
          IFEND;
          IF (radix = 8) AND  (word^.value < 0) THEN
            temp_word.s := word^.s - $s0to63[0];
            clp$convert_integer_to_rjstring (temp_word.value,  radix, FALSE, '0',
                  word_str, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            word_str (1) := '1';
          ELSEIF radix = 8  THEN
            clp$convert_integer_to_rjstring (word^.value,  radix, FALSE, '0',
                  word_str, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          ELSE
            clp$convert_integer_to_string (word^.value,  radix, FALSE,
                  ost_str, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            word_str := '';
            word_str (strlength(word_str) - ost_str.size + 1, ost_str.size)
                  := ost_str.value (1, ost_str.size);
          IFEND;
          line_buffer^ (line_index, 2) := word_str (1, 2);
          line_index := line_index + 3;
          FOR half_words := 1 TO 2 DO
            FOR half_half_words := 1 TO 2 DO
              word_index := 3 + ((half_words - 1) * 10) + ((half_half_words
                    - 1) * 5);
              line_buffer^ (line_index, 5) := word_str (word_index, 5);
              line_index := line_index + 6;
            FOREND;
            line_index := line_index + 1;
          FOREND;
          line_index := line_index + 1;
          bytes_this_line := bytes_this_line + 8;
          bytes_displayed := bytes_displayed + 8;
          IF bytes_displayed >= bytes THEN
            IF NOT first_line THEN
              line_index := ascii_tab_column;
            IFEND;
            EXIT /format_octal/;
          IFEND;
        FOREND /format_octal/;
      IFEND;
      IF ascii_display THEN
        IF NOT numeric_display THEN
          IF (bytes - bytes_displayed) < bytes_this_line THEN
            bytes_this_line := bytes - bytes_displayed;
          IFEND;
          bytes_displayed := bytes_displayed + bytes_this_line;
        IFEND;
        RESET octal_memory TO first_item;
        NEXT item_ascii: [bytes_this_line] IN octal_memory;
        IF item_ascii = NIL THEN
          osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer,
            'processing display_memory', status);
          RETURN;
        IFEND;
        #translate (v$control_codes_to_space, item_ascii^, line_buffer^
              (line_index, bytes_this_line));
      IFEND;
      IF ((line_buffer^ (size_of_address + 1, * )) = (previous_line^
            (size_of_address + 1, * ))) AND (bytes_displayed < bytes) THEN
        previous_line^ := line_buffer^;
        repeated_lines := repeated_lines + 1;
      ELSE
        IF repeated_lines > 1 THEN
          osp$set_status_abnormal (duc$dump_analyzer_id, due$skipped_lines, '', local_status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                repeated_lines, 10, FALSE, local_status);
          display_status_message (local_status, display_control, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSEIF repeated_lines = 1 THEN
          clp$put_display (display_control, previous_line^, clc$trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        repeated_lines := 0;
        clp$put_display (display_control, line_buffer^, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        previous_line^ := line_buffer^;
      IFEND;
      display_address := display_address + bytes_this_line;
      IF bytes_displayed >= bytes THEN
        EXIT /display_octal/;
      IFEND;
      first_line := FALSE;
    WHILEND /display_octal/;


  PROCEND display_octal_memory;
?? TITLE := '  display_status_message', EJECT ??

  PROCEDURE display_status_message (status_message: ost$status;
    VAR display_control: clt$display_control;
    VAR status: ost$status);

    VAR
      line_counter: ost$status_message_line_count,
      line_count: ^ost$status_message_line_count,
      line_size: ^ost$status_message_line_size,
      message: ^ost$status_message,
      message_level: ost$status_message_level,
      message_width: ost$max_status_message_line,
      message_line: ^string ( * );

    osp$get_message_level (message_level, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    PUSH message;
    RESET message;
    IF display_control.page_width < LOWERVALUE (message_width) THEN
      message_width := LOWERVALUE (message_width);
    ELSEIF display_control.page_width > UPPERVALUE (message_width) THEN
      message_width := UPPERVALUE (message_width);
    ELSE
      message_width := display_control.page_width;
    IFEND;
    osp$format_message (status_message, message_level, message_width,
          message^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    RESET message;
    NEXT line_count IN message;
    FOR line_counter := 1 TO line_count^ DO
      NEXT line_size IN message;
      NEXT message_line: [line_size^] IN message;
      clp$put_display (display_control, message_line^, clc$no_trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND display_status_message;
?? TITLE := '  dup$anas_memory_function', EJECT ??

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

{ FUNCTION $memory, $mem (
{   address: integer 0..0ffffffffffff(16) = $required
{   bytes: integer 1..8 = 6
{   exchange: any of
{       key
{         (active, a)
{         (monitor, m)
{         (job, j)
{       keyend
{       integer 0..0ffffffff(16)
{     anyend = active
{   processor: integer 0..3 = 0
{   address_mode: key
{       (process_virtual_address, pva)
{     keyend = process_virtual_address
{   )

?? 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 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      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,
        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 .. 6] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (23),
      recend,
    recend := [
    [1,
    [89, 3, 28, 17, 4, 14, 320],
    clc$function, 5, 5, 1, 0, 0, 0, 0, ''], [
    ['ADDRESS                        ',clc$nominal_entry, 1],
    ['ADDRESS_MODE                   ',clc$nominal_entry, 5],
    ['BYTES                          ',clc$nominal_entry, 2],
    ['EXCHANGE                       ',clc$nominal_entry, 3],
    ['PROCESSOR                      ',clc$nominal_entry, 4]],
    [
{ 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 2
    [3, 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 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 269,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [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, 81,
  clc$optional_default_parameter, 0, 23]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 0ffffffffffff(16), 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, 8, 10],
    '6'],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    229, [[1, 0, clc$keyword_type], [6], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ACTIVE                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['J                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['JOB                            ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['M                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['MONITOR                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    20, [[1, 0, clc$integer_type], [0, 0ffffffff(16), 10]]
    ,
    'active'],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [0, 3, 10],
    '0'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['PROCESS_VIRTUAL_ADDRESS        ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['PVA                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ,
    'process_virtual_address']];

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

    CONST
      p$address = 1,
      p$bytes = 2,
      p$exchange = 3,
      p$processor = 4,
      p$address_mode = 5;

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

    VAR
      address: t$address_parameter,
      p_cell: ^cell,
      size: integer;

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

    address.value := pvt [p$address].value^.integer_value.value;
    size := pvt [p$bytes].value^.integer_value.value;

    NEXT p_value IN p_work;
    p_value^.kind := clc$integer;
    p_value^.integer_value.value := 0;
    p_value^.integer_value.radix := 16;
    p_value^.integer_value.radix_specified := TRUE;

    p_cell := #LOC (p_value^.integer_value.value);
    p_cell := #address (#ring (p_cell), #segment (p_cell), #offset (p_cell) + 8 - size);

    dup$move_bytes (#address (1, address.pva.seg, address.pva.offset), p_cell, size, status);

  PROCEND dup$anas_memory_function;
?? TITLE := '  dup$anas_memory_string_function', EJECT ??

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

{ FUNCTION $memory_string, $ms (
{   address: integer 0..0ffffffffffff(16) = $required
{   bytes: integer 0..osc$max_string_size = 1
{   exchange: any of
{       key
{         (active, a)
{         (monitor, m)
{         (job, j)
{       keyend
{       integer 0..0ffffffff(16)
{     anyend = active
{   processor: integer 0..3 = 0
{   address_mode: key
{       (process_virtual_address, pva)
{     keyend = process_virtual_address
{   )

?? 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 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      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,
        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 .. 6] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (23),
      recend,
    recend := [
    [1,
    [89, 3, 28, 17, 11, 17, 41],
    clc$function, 5, 5, 1, 0, 0, 0, 0, ''], [
    ['ADDRESS                        ',clc$nominal_entry, 1],
    ['ADDRESS_MODE                   ',clc$nominal_entry, 5],
    ['BYTES                          ',clc$nominal_entry, 2],
    ['EXCHANGE                       ',clc$nominal_entry, 3],
    ['PROCESSOR                      ',clc$nominal_entry, 4]],
    [
{ 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 2
    [3, 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 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 269,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [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, 81,
  clc$optional_default_parameter, 0, 23]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 0ffffffffffff(16), 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, osc$max_string_size, 10],
    '1'],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    229, [[1, 0, clc$keyword_type], [6], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ACTIVE                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['J                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['JOB                            ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['M                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['MONITOR                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    20, [[1, 0, clc$integer_type], [0, 0ffffffff(16), 10]]
    ,
    'active'],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [0, 3, 10],
    '0'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['PROCESS_VIRTUAL_ADDRESS        ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['PVA                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ,
    'process_virtual_address']];

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

    CONST
      p$address = 1,
      p$bytes = 2,
      p$exchange = 3,
      p$processor = 4,
      p$address_mode = 5;

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

    VAR
      address: t$address_parameter,
      size: integer;


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

    address.value := pvt [p$address].value^.integer_value.value;
    size := pvt [p$bytes].value^.integer_value.value;

    NEXT p_value IN p_work;
    p_value^.kind := clc$string;
    NEXT p_value^.string_value: [size] IN p_work;

    IF (size > 0) THEN
      dup$move_bytes (#address (1, address.pva.seg, address.pva.offset), #LOC (p_value^.string_value^), size,
            status);
    IFEND;
  PROCEND dup$anas_memory_string_function;
?? TITLE := '  new_page_procedure', EJECT ??

  PROCEDURE new_page_procedure (VAR display_control: clt$display_control;
        new_page_number: integer;
    VAR status: ost$status);

    VAR
      str: ost$string;

    clp$reset_for_next_display_page (display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF display_control.page_width < clc$narrow_page_width THEN
      page_width := clc$narrow_page_width;
    ELSE
      page_width := display_control.page_width;
    IFEND;

    wide := page_width >= clc$wide_page_width;

    clp$convert_integer_to_string (new_page_number, 10, FALSE, str, status);

    IF NOT v$titles_built THEN
      build_standard_title (wide, v$command_name, wide_title,
            narrow_title1, narrow_title2, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      v$titles_built := TRUE;
    IFEND;

    IF wide THEN
      wide_title (127, * ) := str.value (1, str.size);
      clp$put_display (display_control, wide_title, clc$trim, status);
    ELSE
      narrow_title1 (70, * ) := str.value;
      clp$put_display (display_control, narrow_title1, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_display (display_control, narrow_title2, clc$trim, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$new_display_line (display_control, 1, status);


  PROCEND new_page_procedure;
?? TITLE := '  dup$anas_quit_command', EJECT ??
  PROCEDURE [XDCL] dup$anas_quit_command (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE quit, qui (
{   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, 3, 28, 10, 51, 17, 40],
    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;

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

    IF status.normal THEN
      clp$end_include (c$utility_name, status);
    IFEND;
  PROCEND dup$anas_quit_command;
?? OLDTITLE ??
MODEND dum$analyze_system;
