?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Compare Control Store Command' ??
MODULE dum$compare_control_store;

{ PURPOSE:
{   This module contains the code for the compare_control_store command.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc due$exception_condition_codes
?? POP ??
*copyc amp$get_segment_pointer
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_partial_display
*copyc dup$evaluate_parameters
*copyc dup$new_page_procedure
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
?? EJECT ??
*copyc duv$dump_environment_p
*copyc duv$execution_environment
*copyc duv$title_data
?? OLDTITLE ??
?? NEWTITLE := 'dup$compare_control_store', EJECT ??

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

{ PROCEDURE compare_control_store, comcs (
{   file, f: file = $required
{   processor, p: integer 0..3 = 0
{   shadow, s: boolean = FALSE
{   display_option, do: key
{       (brief b) (full f)
{     keyend = brief
{   title, t: string 1..31 = 'compare_control_store'
{   output, o: file = $optional
{   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,
      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,
        default_value: string (5),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (5),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (23),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 9, 19, 8, 4, 41, 678],
    clc$command, 13, 7, 1, 0, 0, 0, 7, ''], [
    ['DISPLAY_OPTION                 ',clc$nominal_entry, 4],
    ['DO                             ',clc$abbreviation_entry, 4],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 6],
    ['OUTPUT                         ',clc$nominal_entry, 6],
    ['P                              ',clc$abbreviation_entry, 2],
    ['PROCESSOR                      ',clc$nominal_entry, 2],
    ['S                              ',clc$abbreviation_entry, 3],
    ['SHADOW                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['T                              ',clc$abbreviation_entry, 5],
    ['TITLE                          ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [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, 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, 3,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 4
    [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, 155,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 5
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_default_parameter, 0, 23],
{ PARAMETER 6
    [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_parameter, 0
  , 0],
{ PARAMETER 7
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, 3, 10],
    '0'],
{ PARAMETER 3
    [[1, 0, clc$boolean_type],
    'FALSE'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BRIEF                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FULL                           ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'brief'],
{ PARAMETER 5
    [[1, 0, clc$string_type], [1, 31, FALSE],
    '''compare_control_store'''],
{ PARAMETER 6
    [[1, 0, clc$file_type]],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$file = 1,
      p$processor = 2,
      p$shadow = 3,
      p$display_option = 4,
      p$title = 5,
      p$output = 6,
      p$status = 7;

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

    TYPE
      t$array_or_word = RECORD
        CASE boolean OF
        = TRUE =
          array_part: ARRAY [1 .. 8] OF 0 .. 0ffff(16),
        = FALSE =
          word_part: dut$de_control_store_word,
        CASEND,
      RECEND;

    VAR
      actual_p: ^PACKED ARRAY [0 .. 127] OF 0 .. 1,
      array_or_word: t$array_or_word,
      bit: 0 .. 127,
      cell_p: ^cell,
      control_store_entry: dut$de_control_store_entry,
      control_store_size: 0 .. duc$de_control_store_size,
      default_list: ARRAY [1 .. 1] OF dut$default_change_list_entry,
      display_control: clt$display_control,
      error_count: 0 .. duc$de_control_store_size,
      expected_p: ^PACKED ARRAY [0 .. 127] OF 0 .. 1,
      fa_p: ^fst$attachment_options,
      file_buffer_p: ^ARRAY [0 .. *] OF dut$de_control_store_word,
      file_identifier: amt$file_identifier,
      file_pointer: amt$segment_pointer,
      group_index: 1 .. 8,
      ignore_status: ost$status,
      index: 0 .. duc$de_control_store_size,
      mca_p: ^fst$file_cycle_attributes,
      output_display_opened: boolean,
      processor: 0 .. 3,
      restart_file_buffer_p: ^ARRAY [0 .. *] OF dut$de_control_store_word,
      restart_file_seq_p: ^SEQ ( * ),
      ring_attributes: amt$ring_attributes,
      string_10: string (10),
      string_2: string (2),
      string_3: string (3),
      string_4: string (4);

*copy dup$abort_handler
?? NEWTITLE := 'clean_up', EJECT ??

{ PURPOSE:
{   This procedure is called from the abort handler to close the files.

    PROCEDURE [INLINE] clean_up;

      VAR
        ignore_status: ost$status;

      fsp$close_file (file_identifier, ignore_status);
      IF output_display_opened THEN
        clp$close_display (display_control, ignore_status);
      IFEND;

    PROCEND clean_up;
?? OLDTITLE , EJECT ??

    status.normal := TRUE;

    { Change the default value for the PROCESSOR parameter.

    default_list [1].default_name := duc$dp_processor;
    default_list [1].number := p$processor;
    dup$evaluate_parameters (parameter_list, default_list, #SEQ (pdt), ^pvt, status);
    IF NOT status.normal THEN
      RETURN;  {---->
    IFEND;

    IF duv$dump_environment_p = NIL THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$no_restart_file, '', status);
      RETURN;  {---->
    IFEND;

    processor := pvt [p$processor].value^.integer_value.value;
    IF pvt [p$shadow].value^.boolean_value.value THEN
      control_store_entry := duv$dump_environment_p^.control_store.shadow [processor];
    ELSE
      control_store_entry := duv$dump_environment_p^.control_store.main [processor];
    IFEND;
    IF NOT control_store_entry.available THEN
      IF pvt [p$shadow].value^.boolean_value.value THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,
              'The shadow control store for processor', status);
      ELSE
        osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,
              'The main control store for processor', status);
      IFEND;
      osp$append_status_integer (osc$status_parameter_delimiter, processor, 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'is', status);
      RETURN;  {---->
    IFEND;

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

    { Open the input compare file.

    PUSH fa_p: [1 .. 1];
    fa_p^ [1].selector := fsc$access_and_share_modes;
    fa_p^ [1].access_modes.selector := fsc$specific_access_modes;
    fa_p^ [1].access_modes.value := $fst$file_access_options [fsc$read];
    fa_p^ [1].share_modes.selector := fsc$specific_share_modes;
    fa_p^ [1].share_modes.value := $fst$file_access_options [fsc$read];

    PUSH mca_p: [1 .. 2];
    mca_p^ [1].selector := fsc$record_type;
    mca_p^ [1].record_type := amc$undefined;
    mca_p^ [2].selector := fsc$preset_value;
    mca_p^ [2].preset_value := -1;

    fsp$open_file (pvt [p$file].value^.file_value^, amc$segment, fa_p, NIL, mca_p, NIL, NIL, file_identifier,
          status);
    IF NOT status.normal THEN
      RETURN;  {---->
    IFEND;

   /file_opened/
    BEGIN
      amp$get_segment_pointer (file_identifier, amc$sequence_pointer, file_pointer, status);
      IF NOT status.normal THEN
        EXIT /file_opened/;  {---->
      IFEND;
      IF file_pointer.sequence_pointer = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
        EXIT /file_opened/;  {---->
      IFEND;
      RESET file_pointer.sequence_pointer;

      { Prepare the output display file.

      IF pvt [p$output].specified THEN
        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^, ^dup$new_page_procedure, fsc$list,
              ring_attributes, display_control, status);
        IF NOT status.normal THEN
          EXIT /file_opened/;  {---->
        IFEND;
        output_display_opened := TRUE;
      ELSE
        display_control := duv$execution_environment.output_file.display_control;
        display_control.line_number := display_control.page_length + 1;
      IFEND;

      duv$title_data.build_title := TRUE;
      duv$title_data.command_name := pvt [p$title].value^.string_value^;

      { Build a sequence pointer to the control store data in the restart file.

      restart_file_seq_p := duv$execution_environment.data_file_p^.segment_pointer.sequence_pointer;
      cell_p := #ADDRESS (#RING (restart_file_seq_p), #SEGMENT (restart_file_seq_p),
            control_store_entry.first_byte);
      RESET restart_file_seq_p TO cell_p;
      control_store_size := control_store_entry.size;

      { Retrieve the control store data from the restart file.

      NEXT restart_file_buffer_p: [0 .. control_store_size - 1] IN restart_file_seq_p;
      IF restart_file_buffer_p = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
        EXIT /file_opened/;  {---->
      IFEND;

      { Retrieve the control store data from the input file.

      RESET file_pointer.sequence_pointer;
      NEXT file_buffer_p: [0 .. control_store_size - 1] IN file_pointer.sequence_pointer;
      IF file_buffer_p = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
        EXIT /file_opened/;  {---->
      IFEND;

      { Display the processor number.

      clp$new_display_line (display_control, 1, ignore_status);
      clp$put_partial_display (display_control, '   PROCESSOR   ', clc$no_trim, amc$continue, ignore_status);
      string_2 := 'XX';
      clp$convert_integer_to_rjstring (processor, 16, FALSE, '0', string_2, ignore_status);
      clp$put_partial_display (display_control, string_2, clc$no_trim, amc$terminate, ignore_status);

      error_count := 0;

      { Compare the control store data on the restart file with the control store data on the input file
      { word by word.

      FOR index := 0 TO (control_store_size - 1) DO
        IF restart_file_buffer_p^ [index] <> file_buffer_p^ [index] THEN
          error_count := error_count + 1;
          clp$new_display_line (display_control, 1, ignore_status);

          { Display the address of the failing word.

          clp$put_partial_display (display_control, '    word = ', clc$no_trim, amc$start, ignore_status);
          string_10 := 'XXXXXXXXXX';
          clp$convert_integer_to_rjstring (index, 16, TRUE, '0', string_10, ignore_status);
          clp$put_partial_display (display_control, string_10, clc$trim, amc$continue, ignore_status);

          { Display the identification of the failing bits.

          IF pvt [p$display_option].value^.name_value = 'FULL' THEN
            expected_p := #LOC (restart_file_buffer_p^ [index]);
            actual_p := #LOC (file_buffer_p^ [index]);
            FOR bit := 0 TO 127 DO
              IF expected_p^ [bit] <> actual_p^ [bit] THEN
                clp$put_partial_display (display_control, '     bit = ', clc$no_trim, amc$start,
                      ignore_status);
                string_3 := 'XXX';
                clp$convert_integer_to_rjstring (bit, 10, FALSE, ' ', string_3, ignore_status);
                clp$put_partial_display (display_control, string_3, clc$trim, amc$continue, ignore_status);
              IFEND;
            FOREND;
          IFEND;

          { Display the expected control store word.

          array_or_word.word_part := file_buffer_p^ [index];
          clp$put_partial_display (display_control, 'expected = ', clc$no_trim, amc$start, ignore_status);
          FOR group_index := 1 TO 8 DO
            string_4 := 'XXXX';
            clp$convert_integer_to_rjstring (array_or_word.array_part [group_index], 16, FALSE, '0', string_4,
                  ignore_status);
            clp$put_partial_display (display_control, string_4, clc$trim, amc$continue, ignore_status);
            clp$put_partial_display (display_control, ' ', clc$no_trim, amc$continue, ignore_status);
          FOREND;

         { Display the actual control store word.

          array_or_word.word_part := restart_file_buffer_p^ [index];
          clp$put_partial_display (display_control, '  actual = ', clc$no_trim, amc$start, ignore_status);
          FOR group_index := 1 TO 8 DO
            string_4 := 'XXXX';
            clp$convert_integer_to_rjstring (array_or_word.array_part [group_index], 16, FALSE, '0', string_4,
                  ignore_status);
            clp$put_partial_display (display_control, string_4, clc$trim, amc$continue, ignore_status);
            clp$put_partial_display (display_control, ' ', clc$no_trim, amc$continue, ignore_status);
          FOREND;
        IFEND;
      FOREND;

      { Display the number of control store words that were compared.

      clp$new_display_line (display_control, 2, ignore_status);
      string_10 := 'XXXXXXXXXX';
      clp$convert_integer_to_rjstring (control_store_size, 10, FALSE, ' ', string_10, ignore_status);
      clp$put_partial_display (display_control, string_10, clc$no_trim, amc$start, ignore_status);
      clp$put_partial_display (display_control, ' control store words were compared :', clc$trim,
            amc$continue, ignore_status);

      { Display the number of errors that were encountered.

      IF error_count = 0 THEN
        clp$put_partial_display (display_control, '  There were NO compare errors.', clc$no_trim,
              amc$terminate, ignore_status);
      ELSE
        string_10 := 'XXXXXXXXXX';
        clp$convert_integer_to_rjstring (error_count, 10, FALSE, ' ', string_10, ignore_status);
        clp$put_partial_display (display_control, string_10, clc$no_trim, amc$continue, ignore_status);
        clp$put_partial_display (display_control, ' errors were detected.', clc$trim, amc$terminate,
              ignore_status);
      IFEND;
    END /file_opened/;

    fsp$close_file (file_identifier, ignore_status);
    IF output_display_opened THEN
      clp$close_display (display_control, ignore_status);
    IFEND;
    osp$disestablish_cond_handler;

  PROCEND dup$compare_control_store;
MODEND dum$compare_control_store;
