?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Dump File Command Processor' ??
MODULE clm$dump_file_command;

{
{ PURPOSE:
{   This module contains the processor for the dump_file command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$improper_random_access
*copyc clc$page_widths
*copyc clt$parameter_list
*copyc cle$ecc_lexical
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_proc_declaration
*copyc clt$file_reference
*copyc clt$path_name
*copyc ost$status
?? POP ??
*copyc amv$nil_file_identifier
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$trimmed_string_size
*copyc clv$nil_display_control
*copyc osp$append_status_file
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
?? EJECT ??

  CONST
    address_size = 13,
    address_start = 1,
    bytes_per_word = 8,
    hex_start = 15,
    max_output_line_size = 114,
    max_words_per_line = 8,
    non_printable = ' ';

  TYPE
    dump_formats = (ascii, ascii_hex, hex);

  VAR
    output_descriptor: [STATIC, READ, oss$job_paged_literal] array [boolean] of array [dump_formats] of record
      words_per_line: 2 .. max_words_per_line,
      ascii_start: 2 .. max_output_line_size,
      line_size: 2 .. max_output_line_size,
    recend := [[[4, 15, 46], [2, 49, 64], [2, * , 47]], [[8, 15, 78], [4, 83, 114], [4, * , 81]]];

*copyc cli$compare_display_file_input

?? TITLE := 'clp$_display_file', EJECT ??

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

{ PROCEDURE (osm$disf) display_file, disf (
{   input, i: file = $required
{   output, o: file = $output
{   formats, format, f: list of key
{       ascii, hex
{     keyend = (ascii, hex)
{   byte_addresses, byte_address, ba: list of range of integer 0..amc$file_byte_limit = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 11] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: 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 .. 2] of clt$keyword_specification,
        recend,
        default_value: string (12),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$range_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 25, 14, 12, 12, 768],
    clc$command, 11, 5, 1, 0, 0, 0, 5, 'OSM$DISF'], [
    ['BA                             ',clc$abbreviation_entry, 4],
    ['BYTE_ADDRESS                   ',clc$alias_entry, 4],
    ['BYTE_ADDRESSES                 ',clc$nominal_entry, 4],
    ['F                              ',clc$abbreviation_entry, 3],
    ['FORMAT                         ',clc$alias_entry, 3],
    ['FORMATS                        ',clc$nominal_entry, 3],
    ['I                              ',clc$abbreviation_entry, 1],
    ['INPUT                          ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [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, 3, 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$optional_default_parameter, 0, 7],
{ 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, 97,
  clc$optional_default_parameter, 0, 12],
{ PARAMETER 4
    [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, 43, clc$optional_parameter,
  0, 0],
{ PARAMETER 5
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$list_type], [81, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [2], [
      ['ASCII                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['HEX                            ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ]
    ,
    '(ascii, hex)'],
{ PARAMETER 4
    [[1, 0, clc$list_type], [27, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$range_type], [20],
        [[1, 0, clc$integer_type], [0, amc$file_byte_limit, 10]]
      ]
    ],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$input = 1,
      p$output = 2,
      p$formats = 3,
      p$byte_addresses = 4,
      p$status = 5;

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

*copy clv$display_variables
?? NEWTITLE := 'abort_handler', EJECT ??

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


      clean_up;

    PROCEND abort_handler;
?? TITLE := 'clean_up', EJECT ??

    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;


      IF get_control.file_id <> amv$nil_file_identifier THEN
        clp$close_for_get (get_control, ignore_status);
      IFEND;
      clp$close_display (display_control, ignore_status);

    PROCEND clean_up;
*copy clp$new_page_procedure
?? TITLE := 'put_subtitle ', EJECT ??

    PROCEDURE put_subtitle
      (VAR display_control: clt$display_control;
       VAR status: ost$status);


      clp$put_path_reference_subtitle (pvt [p$input].value^.file_value^, 'FILE ', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      put_column_headers (display_control, status);

    PROCEND put_subtitle;
?? TITLE := 'put_column_headers', EJECT ??

    PROCEDURE put_column_headers
      (VAR display_control: clt$display_control;
       VAR status: ost$status);

      CONST
        ascii_title_centering = 8,
        ascii_title_only = 13,
        ascii_header_length = 5,
        hex_title_centering = 17,
        hex_header_length = 11;

      VAR
        display_column: 1 .. max_output_line_size;


      clp$put_partial_display (display_control, ' BYTE ADDRESS', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF dump_format = hex THEN
        display_column := hex_start + hex_header_length + (hex_title_centering * $INTEGER (clv$wide));
        clp$horizontal_tab_display (display_control, display_column, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, 'HEXADECIMAL', clc$no_trim, amc$terminate, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSEIF dump_format = ascii THEN
        display_column := output_descriptor [clv$wide] [dump_format].ascii_start + ascii_header_length +
              ascii_title_centering + (ascii_title_only * $INTEGER (clv$wide));
        clp$horizontal_tab_display (display_control, display_column, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, 'ASCII', clc$no_trim, amc$terminate, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSEIF dump_format = ascii_hex THEN
        display_column := hex_start + hex_header_length + (hex_title_centering * $INTEGER (clv$wide));
        clp$horizontal_tab_display (display_control, display_column, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, 'HEXADECIMAL', clc$no_trim, amc$continue, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        display_column := output_descriptor [clv$wide] [dump_format].ascii_start + ascii_header_length +
              (ascii_title_centering * $INTEGER (clv$wide));
        clp$horizontal_tab_display (display_control, display_column, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, 'ASCII', clc$no_trim, amc$terminate, status);
      IFEND;

    PROCEND put_column_headers;
*copy clp$put_path_reference_subtitle
?? TITLE := 'dump_part_of_file', EJECT ??

    PROCEDURE dump_part_of_file
      (    low_byte_address: amt$file_byte_address;
           high_byte_address: amt$file_byte_address;
           dump_format: dump_formats;
       VAR display_control {input, output} : clt$display_control;
       VAR get_control: clt$get_control_record;
       VAR status: ost$status);

       VAR
         v$non_legible_chars_to_spaces: [STATIC, READ, oss$job_paged_literal]
               string (256) := '                                 !"#$%&''()*+,-'
               CAT './0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcd' CAT
               'efghijkl' CAT 'mnopqrstuvwxyz{|}~';
       VAR
         hex_digits: [STATIC, READ, oss$job_paged_literal] array [0 .. 255] of
               string (2) := [{}
               '00', '01', '02', '03', '04', '05', '06', '07', '08', '09', '0a',
               '0b', '0c', '0d', '0e', '0f', '10', '11', '12', '13', '14', '15',
               '16', '17', '18', '19', '1a', '1b', '1c', '1d', '1e', '1f', '20',
               '21', '22', '23', '24', '25', '26', '27', '28', '29', '2a', '2b',
               '2c', '2d', '2e', '2f', '30', '31', '32', '33', '34', '35', '36',
               '37', '38', '39', '3a', '3b', '3c', '3d', '3e', '3f', '40', '41',
               '42', '43', '44', '45', '46', '47', '48', '49', '4a', '4b', '4c',
               '4d', '4e', '4f', '50', '51', '52', '53', '54', '55', '56', '57',
               '58', '59', '5a', '5b', '5c', '5d', '5e', '5f', '60', '61', '62',
               '63', '64', '65', '66', '67', '68', '69', '6a', '6b', '6c', '6d',
               '6e', '6f', '70', '71', '72', '73', '74', '75', '76', '77', '78',
               '79', '7a', '7b', '7c', '7d', '7e', '7f', '80', '81', '82', '83',
               '84', '85', '86', '87', '88', '89', '8a', '8b', '8c', '8d', '8e',
               '8f', '90', '91', '92', '93', '94', '95', '96', '97', '98', '99',
               '9a', '9b', '9c', '9d', '9e', '9f', 'a0', 'a1', 'a2', 'a3', 'a4',
               'a5', 'a6', 'a7', 'a8', 'a9', 'aa', 'ab', 'ac', 'ad', 'ae', 'af',
               'b0', 'b1', 'b2', 'b3', 'b4', 'b5', 'b6', 'b7', 'b8', 'b9', 'ba',
               'bb', 'bc', 'bd', 'be', 'bf', 'c0', 'c1', 'c2', 'c3', 'c4', 'c5',
               'c6', 'c7', 'c8', 'c9', 'ca', 'cb', 'cc', 'cd', 'ce', 'cf', 'd0',
               'd1', 'd2', 'd3', 'd4', 'd5', 'd6', 'd7', 'd8', 'd9', 'da', 'db',
               'dc', 'dd', 'de', 'df', 'e0', 'e1', 'e2', 'e3', 'e4', 'e5', 'e6',
               'e7', 'e8', 'e9', 'ea', 'eb', 'ec', 'ed', 'ee', 'ef', 'f0', 'f1',
               'f2', 'f3', 'f4', 'f5', 'f6', 'f7', 'f8', 'f9', 'fa', 'fb', 'fc',
               'fd', 'fe', 'ff'];

      VAR
        local_status: ost$status,
        line_size: integer,
        line: string (max_output_line_size),
        data: ^string (max_words_per_line * bytes_per_word),
        previous_data: string (max_words_per_line * bytes_per_word),
        duplicate_line_count: amt$file_byte_address,
        request_count: 2 * bytes_per_word .. max_words_per_line * bytes_per_word,
        current_byte_address: 0 .. amc$file_byte_limit + 1,
        line_index: 1 .. max_output_line_size + 1,
        data_index: 1 .. max_words_per_line * bytes_per_word,
        transfer_count: amt$transfer_count,
        ignore_byte_address: amt$file_byte_address,
        ignore_file_position: amt$file_position;

?? NEWTITLE := 'put_duplicate_line_count', EJECT ??

      PROCEDURE [INLINE] put_duplicate_line_count;


        IF duplicate_line_count <= 1 THEN
          RETURN;
        IFEND;
        IF duplicate_line_count = 2 THEN
          STRINGREP (line, line_size, '  ': hex_start + 1, 'Above line repeated 1 time.')
        ELSE
          STRINGREP (line, line_size, '  ': hex_start + 1, 'Above line repeated', duplicate_line_count - 1,
                ' times.');
        IFEND;
        clp$put_display (display_control, line (1, line_size), clc$no_trim, local_status);
        IF NOT local_status.normal THEN
          IF status.normal THEN
            status := local_status;
          IFEND;
          EXIT dump_part_of_file;
        IFEND;

      PROCEND put_duplicate_line_count;
?? OLDTITLE, EJECT ??

      status.normal := TRUE;
      clv$wide := display_control.page_width >= clc$wide_page_width;
      request_count := output_descriptor [clv$wide] [dump_format].words_per_line * bytes_per_word;
      duplicate_line_count := 0;

      current_byte_address := low_byte_address;
      WHILE current_byte_address <= high_byte_address DO
        clp$get_next_bytes (request_count, transfer_count, ignore_file_position, get_control, data, status);
        IF (NOT status.normal) OR (transfer_count = 0) THEN
          put_duplicate_line_count;
          IF status.normal AND (transfer_count = 0) THEN
            STRINGREP (line, line_size, '  ': hex_start + 1, 'End Of Information encountered.');
            clp$put_display (display_control, line (1, line_size), clc$no_trim, status);
          IFEND;
          RETURN;
        IFEND;
        IF transfer_count > (high_byte_address - current_byte_address + 1) THEN
          transfer_count := high_byte_address - current_byte_address + 1;
        IFEND;

        IF (duplicate_line_count > 0) AND (transfer_count = request_count) AND
              (data^ (1, request_count) = previous_data (1, request_count)) THEN
          duplicate_line_count := duplicate_line_count + 1;
        ELSE
          put_duplicate_line_count;
          duplicate_line_count := 1;
          previous_data (1, transfer_count) := data^ (1, transfer_count);

          line := '';
          clp$convert_integer_to_rjstring (current_byte_address, 10, FALSE, ' ',
                line (address_start, address_size), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF dump_format >= ascii_hex THEN
            line_index := hex_start - 1;
            FOR data_index := 1 TO transfer_count DO
              IF (data_index MOD bytes_per_word) = 1 THEN
                line_index := line_index + 1;
              IFEND;
              line (line_index, 2) := hex_digits [$INTEGER (data^ (data_index))];
              line_index := line_index + 2;
            FOREND;
          IFEND;
          IF dump_format <= ascii_hex THEN
            line_index := output_descriptor [clv$wide] [dump_format].ascii_start;
            #TRANSLATE (v$non_legible_chars_to_spaces, data^ (1, transfer_count),
                  line (line_index, transfer_count));
          IFEND;
          clp$put_display (display_control, line, clc$trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        IFEND;
        current_byte_address := current_byte_address + transfer_count;
      WHILEND;

    PROCEND dump_part_of_file;
?? OLDTITLE, EJECT ??

    TYPE
      dump_format_selections = set of (select_ascii, select_hex);

    VAR
      buffer_required: boolean,
      current_byte_address: ^clt$data_value,
      current_format: ^clt$data_value,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      dump_format: dump_formats,
      dump_format_selection: dump_format_selections,
      get_control: clt$get_control_record,
      high_byte_address: amt$file_byte_address,
      ignore_file_position: amt$file_position,
      ignore_status: ost$status,
      low_byte_address: amt$file_byte_address;


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

    current_format := pvt [p$formats].value;
    dump_format_selection := $dump_format_selections [];
    WHILE current_format <> NIL DO
      IF current_format^.element_value^.keyword_value = 'ASCII' THEN
        IF select_ascii IN dump_format_selection THEN
          osp$set_status_abnormal ('CL', cle$redundancy_in_selections, 'FORMAT', status);
          RETURN;
        IFEND;
        dump_format_selection := dump_format_selection + $dump_format_selections [select_ascii];
      ELSE {current_format^.element_value^.keyword_value = 'HEX'
        IF select_hex IN dump_format_selection THEN
          osp$set_status_abnormal ('CL', cle$redundancy_in_selections, 'FORMAT', status);
          RETURN;
        IFEND;
        dump_format_selection := dump_format_selection + $dump_format_selections [select_hex];
      IFEND;
      current_format := current_format^.link;
    WHILEND;

    IF dump_format_selection = $dump_format_selections [select_ascii, select_hex] THEN
      dump_format := ascii_hex;
    ELSEIF dump_format_selection = $dump_format_selections [select_ascii] THEN
      dump_format := ascii;
    ELSE
      dump_format := hex;
    IFEND;

    get_control.file_id := amv$nil_file_identifier;
    #SPOIL (get_control);
    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    osp$establish_block_exit_hndlr (^abort_handler);

  /dump_file/
    BEGIN
      clp$open_for_get (pvt [p$input].value^.file_value^, 'DISPLAY_FILE', pvt [p$byte_addresses].value <> NIL,
            ignore_file_position, get_control, buffer_required, status);
      IF NOT status.normal THEN
        EXIT /dump_file/;
      IFEND;
      IF buffer_required THEN
        PUSH get_control.sequence_pointer: [[REP clc$input_buffer_size OF cell]];
        #SPOIL (get_control);
      IFEND;

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

      clp$open_display_reference (pvt [p$output].value^.file_value^, ^clp$new_page_procedure, fsc$list,
            default_ring_attributes, display_control, status);
      IF NOT status.normal THEN
        clp$close_for_get (get_control, ignore_status);
        EXIT /dump_file/;
      IFEND;
      clv$titles_built := FALSE;
      clv$subtitles_built := FALSE;
      clv$command_name := 'display_file';

      IF (get_control.access_level = amc$segment) AND (get_control.sequence_pointer = NIL) THEN
        clp$put_display (display_control, '     Input file is empty.', clc$no_trim, ignore_status);
        clean_up;
        EXIT /dump_file/;
      IFEND;

      IF display_control.page_format = amc$continuous_form THEN
        clv$wide := display_control.page_width >= clc$wide_page_width;
        put_column_headers (display_control, status);
        IF NOT status.normal THEN
          clean_up;
          EXIT /dump_file/;
        IFEND;
      IFEND;

    /dump/
      BEGIN
        current_byte_address := pvt [p$byte_addresses].value;
        IF current_byte_address = NIL THEN
          dump_part_of_file (0, amc$file_byte_limit, dump_format, display_control, get_control, status);
        ELSE
          WHILE current_byte_address <> NIL DO
            low_byte_address := current_byte_address^.element_value^.low_value^.integer_value.value;
            high_byte_address := current_byte_address^.element_value^.high_value^.integer_value.value;
            IF low_byte_address <= high_byte_address THEN
              clp$seek_byte (low_byte_address, get_control, status);
              IF status.normal THEN
                dump_part_of_file (low_byte_address, high_byte_address, dump_format, display_control,
                      get_control, status);
              IFEND;
            ELSE
              osp$set_status_abnormal ('CL', cle$low_greater_than_high, 'BYTE_ADDRESS', status);
            IFEND;
            IF NOT status.normal THEN
              EXIT /dump/;
            IFEND;
            current_byte_address := current_byte_address^.link;
          WHILEND;
        IFEND;
      END /dump/;

      IF status.normal THEN
        clp$close_display (display_control, status);
      ELSE
        clp$close_display (display_control, ignore_status);
      IFEND;

      IF status.normal THEN
        clp$close_for_get (get_control, status);
      ELSE
        clp$close_for_get (get_control, ignore_status);
      IFEND;
    END /dump_file/;

    osp$disestablish_cond_handler;

  PROCEND clp$_display_file;

MODEND clm$dump_file_command;
