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

{ PURPOSE:
{   This module contains the code for the display_s0_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$evaluate_parameters
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc dup$display_xp_registers
*copyc dup$find_record_list_entry
*copyc dup$new_page_procedure
*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 := 'display_data', EJECT ??

{ PURPOSE:
{   This procedure displays the data.

  PROCEDURE display_data
    (    entry: dut$de_other_record_entry;
     VAR display_control: clt$display_control);

    TYPE
      t$data_line = RECORD
        CASE boolean OF
        = TRUE =
          line: string (50),
        = FALSE =
          first_part: t$first_part,
          space_1: string (2),
          name_part: string (8),
          space_2: string (1),
          number_1: string (4),
          space_3: string (1),
          number_2: string (4),
        CASEND,
      RECEND,

      t$first_part = RECORD
        CASE 1 .. 3 OF
        = 1 =
          name_1: string (6),
          space_1a: string (1),
          number_1a: string (4),
          space_1b: string (1),
          number_1b: string (4),
          space_1c: string (9),
        = 2 =
          name_2a: string (4),
          space_2a: string (1),
          number_2a: string (4),
          space_2b: string (2),
          name_2b: string (4),
          space_2c: string (1),
          number_2b: string (4),
          space_2d: string (5),
        = 3 =
          name_3a: string (3),
          space_3a: string (1),
          number_3a: string (2),
          space_3b: string (2),
          name_3b: string (3),
          space_3c: string (1),
          number_3b: string (2),
          space_3d: string (7),
          number_3c: string (4),
        CASEND,
      RECEND,

      t$register_1 = RECORD
        number_1: 0 .. 0ffff(16),
        number_2: 0 .. 0ffff(16),
        number_3: 0 .. 0ffff(16),
        number_4: 0 .. 0ffff(16),
      RECEND,

      t$register_2 = RECORD
        number_1: 0 .. 0ff(16),
        number_2: 0 .. 0ff(16),
        number_3: 0 .. 0ffff(16),
        number_4: 0 .. 0ffff(16),
        number_5: 0 .. 0ffff(16),
      RECEND,

      t$register_line = RECORD
        CASE boolean OF
        = TRUE =
          line: string (50),
        = FALSE =
          name_part: string (7),
          space_1: string (2),
          number_1: string (4),
          space_2: string (1),
          number_2: string (4),
          space_3: string (1),
          number_3: string (4),
          space_4: string (1),
          number_4: string (4),
        CASEND,
      RECEND;

    VAR
      cell_p: ^cell,
      data_line: t$data_line,
      ignore_status: ost$status,
      index: 0 .. 0ff(16),
      register_1_p: ^t$register_1,
      register_2_p: ^t$register_2,
      register_line: t$register_line,
      restart_file_seq_p: ^ SEQ ( * ),
      xp_data_p: ^dut$ee_xp_data;

    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), entry.first_byte);
    RESET restart_file_seq_p TO cell_p;

    NEXT xp_data_p IN restart_file_seq_p;
    IF xp_data_p = NIL THEN
      RETURN;  {---->
    IFEND;
    dup$display_xp_registers (xp_data_p^, display_control);

    FOR index := 24(16) TO 26(16) DO
      NEXT register_1_p IN restart_file_seq_p;
      IF register_1_p = NIL THEN
        RETURN;  {---->
      IFEND;
      register_line.line := ' ';
      register_line.name_part := 'reg XX:';
      clp$convert_integer_to_rjstring (index, 16, FALSE, '0', register_line.name_part (5, 2),
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_1, 16, FALSE, '0', register_line.number_1,
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_2, 16, FALSE, '0', register_line.number_2,
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_3, 16, FALSE, '0', register_line.number_3,
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_4, 16, FALSE, '0', register_line.number_4,
            ignore_status);
      clp$put_display (display_control, register_line.line, clc$trim, ignore_status);
    FOREND;
    clp$put_display (display_control, ' ', clc$trim, ignore_status);

    NEXT register_1_p IN restart_file_seq_p;
    IF register_1_p = NIL THEN
      RETURN;  {---->
    IFEND;
    data_line.line := ' ';
    data_line.first_part.name_1 := 'sit';
    clp$convert_integer_to_rjstring (register_1_p^.number_1, 16, FALSE, '0', data_line.first_part.number_1a,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_2, 16, FALSE, '0', data_line.first_part.number_1b,
          ignore_status);
    data_line.name_part := 'sit(rit)';
    clp$convert_integer_to_rjstring (register_1_p^.number_3, 16, FALSE, '0', data_line.number_1,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_4, 16, FALSE, '0', data_line.number_2,
          ignore_status);
    clp$put_display (display_control, data_line.line, clc$trim, ignore_status);

    NEXT register_2_p IN restart_file_seq_p;
    IF register_2_p = NIL THEN
      RETURN;  {---->
    IFEND;
    data_line.line := ' ';
    data_line.first_part.name_3a := 'psm';
    clp$convert_integer_to_rjstring (register_2_p^.number_1, 16, FALSE, '0', data_line.first_part.number_3a,
          ignore_status);
    data_line.first_part.name_3b := 'ptl';
    clp$convert_integer_to_rjstring (register_2_p^.number_2, 16, FALSE, '0', data_line.first_part.number_3b,
          ignore_status);
    clp$convert_integer_to_rjstring (register_2_p^.number_3, 16, FALSE, '0', data_line.first_part.number_3c,
          ignore_status);
    data_line.name_part := 'mps';
    clp$convert_integer_to_rjstring (register_2_p^.number_4, 16, FALSE, '0', data_line.number_1,
          ignore_status);
    clp$convert_integer_to_rjstring (register_2_p^.number_5, 16, FALSE, '0', data_line.number_2,
          ignore_status);
    clp$put_display (display_control, data_line.line, clc$trim, ignore_status);

    NEXT register_1_p IN restart_file_seq_p;
    IF register_1_p = NIL THEN
      RETURN;  {---->
    IFEND;
    data_line.line := ' ';
    data_line.first_part.name_1 := 'pta';
    clp$convert_integer_to_rjstring (register_1_p^.number_1, 16, FALSE, '0', data_line.first_part.number_1a,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_2, 16, FALSE, '0', data_line.first_part.number_1b,
          ignore_status);
    data_line.name_part := 'jps';
    clp$convert_integer_to_rjstring (register_1_p^.number_3, 16, FALSE, '0', data_line.number_1,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_4, 16, FALSE, '0', data_line.number_2,
          ignore_status);
    clp$put_display (display_control, data_line.line, clc$trim, ignore_status);

    NEXT register_1_p IN restart_file_seq_p;
    IF register_1_p = NIL THEN
      RETURN;  {---->
    IFEND;
    data_line.line := ' ';
    data_line.first_part.name_2a := 'vmcl';
    clp$convert_integer_to_rjstring (register_1_p^.number_1, 16, FALSE, '0', data_line.first_part.number_2a,
          ignore_status);
    data_line.first_part.name_2b := 'kypt';
    clp$convert_integer_to_rjstring (register_1_p^.number_2, 16, FALSE, '0', data_line.first_part.number_2b,
          ignore_status);
    data_line.name_part := 'buff';
    clp$convert_integer_to_rjstring (register_1_p^.number_3, 16, FALSE, '0', data_line.number_1,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_4, 16, FALSE, '0', data_line.number_2,
          ignore_status);
    clp$put_display (display_control, data_line.line, clc$trim, ignore_status);
    clp$put_display (display_control, ' ', clc$trim, ignore_status);

    FOR index := 0 TO 3 DO
      NEXT register_1_p IN restart_file_seq_p;
      IF register_1_p = NIL THEN
        RETURN;  {---->
      IFEND;
      data_line.line := ' ';
      data_line.first_part.name_1 := 'tempX';
      register_line.line := ' ';
      register_line.name_part := 'reg XX:';
      clp$convert_integer_to_rjstring (index, 16, FALSE, '0', data_line.first_part.name_1 (5),
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_1, 16, FALSE, '0', data_line.first_part.number_1a,
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_2, 16, FALSE, '0', data_line.first_part.number_1b,
            ignore_status);
      data_line.name_part := 'buff';
      clp$convert_integer_to_rjstring (register_1_p^.number_3, 16, FALSE, '0', data_line.number_1,
            ignore_status);
      clp$convert_integer_to_rjstring (register_1_p^.number_4, 16, FALSE, '0', data_line.number_2,
            ignore_status);
      clp$put_display (display_control, data_line.line, clc$trim, ignore_status);
    FOREND;

    NEXT register_1_p IN restart_file_seq_p;
    IF register_1_p = NIL THEN
      RETURN;  {---->
    IFEND;
    register_line.line := ' ';
    register_line.name_part := 'p-buff ';
    clp$convert_integer_to_rjstring (register_1_p^.number_1, 16, FALSE, '0', register_line.number_1,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_2, 16, FALSE, '0', register_line.number_2,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_3, 16, FALSE, '0', register_line.number_3,
          ignore_status);
    clp$convert_integer_to_rjstring (register_1_p^.number_4, 16, FALSE, '0', register_line.number_4,
          ignore_status);
    clp$put_display (display_control, register_line.line, clc$trim, ignore_status);

  PROCEND display_data;
?? OLDTITLE ??
?? NEWTITLE := 'dup$display_s0_register_file', EJECT ??

{ PURPOSE:
{   This procedure displays the information from the S0 records: RFP, RFS, RF1, RS1.

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

{ PROCEDURE display_s0_register_file, dissrf (
{   output, o: file = $optional
{   title, t: string 1..31 = 'display_s0_register_file'
{   status)

?? 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 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (26),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 4, 16, 9, 51, 37, 909],
    clc$command, 5, 3, 0, 0, 0, 0, 3, ''], [
    ['O                              ',clc$abbreviation_entry, 1],
    ['OUTPUT                         ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['T                              ',clc$abbreviation_entry, 2],
    ['TITLE                          ',clc$nominal_entry, 2]],
    [
{ 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, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 2
    [5, 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, 26],
{ PARAMETER 3
    [3, 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$string_type], [1, 31, FALSE],
    '''display_s0_register_file'''],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

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

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

    VAR
      data_displayed: boolean,
      data_value: clt$data_value,
      display_control: clt$display_control,
      entry_p: ^dut$de_other_record_entry,
      ignore_status: ost$status,
      index: 1 .. 8,
      output_display_opened: boolean,
      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;
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^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^;

      data_displayed := FALSE;

      data_value.kind := clc$name;
      data_value.name_value := 'RFP';
      dup$find_record_list_entry (data_value, entry_p);
      IF entry_p <> NIL THEN
        data_displayed := TRUE;
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' DUMP RECORD =  RFP', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        display_data (entry_p^, display_control);
      IFEND;

      data_value.kind := clc$name;
      data_value.name_value := 'RFS';
      dup$find_record_list_entry (data_value, entry_p);
      IF entry_p <> NIL THEN
        data_displayed := TRUE;
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' DUMP RECORD =  RFS', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        display_data (entry_p^, display_control);
      IFEND;

      data_value.kind := clc$name;
      data_value.name_value := 'RF1';
      dup$find_record_list_entry (data_value, entry_p);
      IF entry_p <> NIL THEN
        data_displayed := TRUE;
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' DUMP RECORD =  RF1', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        display_data (entry_p^, display_control);
      IFEND;

      data_value.kind := clc$name;
      data_value.name_value := 'RS1';
      dup$find_record_list_entry (data_value, entry_p);
      IF entry_p <> NIL THEN
        data_displayed := TRUE;
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        clp$put_display (display_control, ' DUMP RECORD =  RS1', clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        display_data (entry_p^, display_control);
      IFEND;

      IF NOT data_displayed THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,
              'The RFP/RF1 and RFS/RS1 records are', status);
      IFEND;

    END /display_opened/;

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

  PROCEND dup$display_s0_register_file;
MODEND dum$display_s0_register_file;
