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

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

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc due$exception_condition_codes
?? POP ??
*copyc clp$close_display
*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 dup$retrieve_register
*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$display_control_store', EJECT ??

{ PURPOSE:
{   This procedure displays the control store from the restart file.

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

{ PROCEDURE display_control_store, discs (
{   processor, p: integer 0..3 = 0
{   shadow, s: boolean = FALSE
{   output, o: file
{   title, t: string 1..31 = 'display_control_store'
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (23),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 9, 18, 15, 19, 34, 45],
    clc$command, 9, 5, 0, 0, 0, 0, 5, ''], [
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['P                              ',clc$abbreviation_entry, 1],
    ['PROCESSOR                      ',clc$nominal_entry, 1],
    ['S                              ',clc$abbreviation_entry, 2],
    ['SHADOW                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['T                              ',clc$abbreviation_entry, 4],
    ['TITLE                          ',clc$nominal_entry, 4]],
    [
{ 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, 20,
  clc$optional_default_parameter, 0, 1],
{ 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, 3,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 4
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_default_parameter, 0, 23],
{ PARAMETER 5
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 3, 10],
    '0'],
{ PARAMETER 2
    [[1, 0, clc$boolean_type],
    'FALSE'],
{ PARAMETER 3
    [[1, 0, clc$file_type]],
{ PARAMETER 4
    [[1, 0, clc$string_type], [1, 31, FALSE],
    '''display_control_store'''],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

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

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

    TYPE
      t$integer_or_string = RECORD
        CASE boolean OF
        = TRUE =
          integer_part: integer,
        = FALSE =
          string_part: string (8),
        CASEND,
      RECEND;

    VAR
      cell_p: ^cell,
      control_store_entry: dut$de_control_store_entry,
      default_list: ARRAY [1 .. 1] OF dut$default_change_list_entry,
      display_control: clt$display_control,
      ignore_status: ost$status,
      integer_or_string: t$integer_or_string,
      model_number: 0 .. 0ff(16),
      model_number_upper: 0 .. 0ff(16),
      output_display_opened: boolean,
      processor: 0 .. duc$de_maximum_processors,
      register: dut$de_maintenance_register,
      restart_file_buffer_p: ^ARRAY [0 .. * ] OF dut$de_control_store_word,
      restart_file_seq_p: ^SEQ ( * ),
      ring_attributes: amt$ring_attributes;

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

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

    PROCEDURE [INLINE] clean_up;

      VAR
        ignore_status: ost$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);

    { 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
        RETURN;  {---->
      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;

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

      { Get model number from EID register to find where control store word is located (ref arh5234).

      model_number := 0;
      dup$retrieve_register (duc$de_cpu, processor, 10(16), register);
      IF register.available THEN
        model_number := register.value [duc$de_model_byte_number];
      IFEND;

      { Display the control store word.

      IF model_number = 0 THEN
        clp$put_partial_display (display_control, 'CONTROLWARE PART NUMBER/REVISION LEVEL IS UNKNOWN',
              clc$no_trim, amc$start, status);
        clp$new_display_line (display_control, 1, status);
        EXIT /display_opened/;  {---->
      IFEND;

      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;

      NEXT restart_file_buffer_p: [0 .. control_store_entry.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 /display_opened/;  {---->
      IFEND;

      model_number_upper := model_number DIV 10(16);
      CASE model_number_upper OF
      = 2 = {P2}
        integer_or_string.integer_part := restart_file_buffer_p^ [1].lower;
      = 3 = {P3}
        integer_or_string.integer_part := restart_file_buffer_p^ [0].lower;
      = 4 = {THETA}
        integer_or_string.integer_part := restart_file_buffer_p^ [4fc(16)].upper;
      ELSE
        integer_or_string.integer_part := restart_file_buffer_p^ [1].upper;
      CASEND;

      clp$put_partial_display (display_control, 'CONTROLWARE PART NUMBER/REVISION LEVEL = ', clc$no_trim,
            amc$start, status);
      clp$put_partial_display (display_control, integer_or_string.string_part, clc$no_trim, amc$continue,
            status);
      clp$new_display_line (display_control, 1, status);
    END /display_opened/;  { ---->

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

  PROCEND dup$display_control_store;
MODEND dum$display_control_store;
