?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Display Register File Command' ??
MODULE dum$display_register_file;

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

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

{ PURPOSE:
{   This procedure writes the register file data to the output file.

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

{ PROCEDURE display_register_file, disrf (
{   processor, p: any of
{       key
{         (all a)
{       keyend
{       integer 0..3
{     anyend = 0
{   title, t: string 1..31 = 'display_register_file'
{   output, o: file
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (1),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (23),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 6, 12, 10, 17, 32, 971],
    clc$command, 7, 4, 0, 0, 0, 0, 4, ''], [
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['P                              ',clc$abbreviation_entry, 1],
    ['PROCESSOR                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['T                              ',clc$abbreviation_entry, 2],
    ['TITLE                          ',clc$nominal_entry, 2]],
    [
{ 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, 121,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 2
    [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, 8,
  clc$optional_default_parameter, 0, 23],
{ 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
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    81, [[1, 0, clc$keyword_type], [2], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    20, [[1, 0, clc$integer_type], [0, 3, 10]]
    ,
    '0'],
{ PARAMETER 2
    [[1, 0, clc$string_type], [1, 31, FALSE],
    '''display_register_file'''],
{ PARAMETER 3
    [[1, 0, clc$file_type]],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

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

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

    TYPE
      t$array_or_integer = RECORD
        CASE boolean OF
        = TRUE =
          array_part: ARRAY [1 .. 4] of 0 .. 0ffff(16),
        = FALSE =
          integer_part: integer,
        CASEND,
      RECEND;

    VAR
      array_or_integer: t$array_or_integer,
      default_list: ARRAY [1 .. 1] OF dut$default_change_list_entry,
      display_control: clt$display_control,
      ending_processor: 0 .. duc$de_maximum_processors,
      group_index: 1 .. 4,
      ignore_status: ost$status,
      output_display_opened: boolean,
      processor: 0 .. duc$de_maximum_processors,
      register: dut$de_register_file_entry,
      register_displayed: boolean,
      register_index: 0 .. duc$de_max_register_number,
      ring_attributes: amt$ring_attributes,
      starting_processor: 0 .. duc$de_maximum_processors,
      string_2: string (2),
      string_4: string (4);

*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;

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

   /display_opened/
    BEGIN

      { 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 /display_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^;

      { Determine the starting and ending processor number to display.

      IF pvt [p$processor].value^.kind = clc$integer THEN
        starting_processor := pvt [p$processor].value^.integer_value.value;
        ending_processor := starting_processor;
      ELSE
        starting_processor := 0;
        ending_processor := duc$de_maximum_processors;
      IFEND;
      register_displayed := FALSE;

      { Display the register file.

     /display_processor/
      FOR processor := starting_processor TO ending_processor DO
        IF NOT duv$dump_environment_p^.register_file [processor].available THEN
          IF (processor = ending_processor) AND NOT register_displayed THEN
            IF starting_processor = ending_processor THEN
              osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,
                    'The register file for processor', status);
              osp$append_status_integer (osc$status_parameter_delimiter, processor, 10, FALSE, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, 'is', status);
            ELSE
              osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,
                    'The register file for the processor is', status);
            IFEND;
            EXIT /display_opened/;  {---->
          IFEND;
          CYCLE /display_processor/;  {---->
        IFEND;
        register_displayed := TRUE;

        display_control.line_number := display_control.page_length + 1;
        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);
        clp$new_display_line (display_control, 1, ignore_status);

       /display_register/
        FOR register_index := 0 TO
              (duv$dump_environment_p^.register_file [processor].number_of_registers - 1) DO
          register := duv$dump_environment_p^.register_file [processor].register [register_index];
          IF NOT register.available THEN
            CYCLE /display_register/;  {---->
          IFEND;

          { Display the register index.

          string_4 := ' XXXX';
          clp$convert_integer_to_rjstring (register_index, 16, FALSE, '0', string_4, ignore_status);
          clp$put_partial_display (display_control, string_4, clc$trim, amc$start, ignore_status);
          clp$put_partial_display (display_control, '  ', clc$no_trim, amc$continue, ignore_status);

          { Display the registers in groups of sixteen bits.

          array_or_integer.integer_part := register.value;
          FOR group_index := 1 TO 4 DO
            string_4 := 'XXXX';
            clp$convert_integer_to_rjstring (array_or_integer.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;
        FOREND /display_register/;
        clp$new_display_line (display_control, 1, ignore_status);

      FOREND /display_processor/;
    END /display_opened/;

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

  PROCEND dup$display_reg_file_cmd;
MODEND dum$display_register_file;
