?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Display PP Registers Command' ??
MODULE dum$display_pp_regs_command;

{ PURPOSE:
{   This module contains the code for the display_pp_registers command.
{
{   This command displays the contents of the A, P, Q and K registers for each PP that was assigned
{   to NOS/VE at the time the dump was taken (if the contents equal zero, the PP was not assigned).
{   There are several records on the dump file containing A, P, Q and K registers.
{     PSR = A, P, Q and K registers for IOU0 on non s0 mainframes.
{     PS1 = A, P, Q and K registers for IOU1 on non s0 mainframes.
{     PPR = A, P, Q and K registers for s0 mainframes.
{     DFT = A, P, Q and K registers from the DFT buffer.
{
{   PSR and PS1 dump records contain two sets of APQK registers for each PP; one set taken before the
{   PP was idled, and the second taken after.  Each set consists of 9 twelve-bit bytes (with each byte
{   containing 8 bits of right shifted valid data - except byte 6 which is 2 bits) in the following format:
{     byte 00 - P Register - Most Significant Bits (MSB)
{          01 - P Register - Least Significant Bits (LSB)
{          02 - Q Register - MSB
{          03 - Q Register - LSB
{          04 - K Register - MSB
{          05 - K Register - LSB
{          06 - A Register - Most Significant Two Bits
{          07 - A Register - 2nd LSB
{          08 - A Register - LSB
{
{   PPR contains the APDK registers for the S0.
{
{   DFT:  At a defined interval (currently 30 seconds) DFT writes the contents of the A/P/Q/K registers to a
{   buffer within the DFT/OS buffer.  It holds these values in two separate fields.  Each field is written
{   alternately at the appointed interval so the two most recent samples are available.

?? 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$determine_dump_information
*copyc dup$find_record_list_entry
*copyc dup$new_page_procedure
*copyc dup$retrieve_dft_pointers
*copyc osp$append_status_integer
*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 := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    c$number_of_s0_pps = 10,
    c$possible_number_of_pps = 60;

  TYPE
    t$a_register = PACKED RECORD
      CASE 0 .. 2 OF
      = 0 =
        register: 0 .. 3ffff(16),
      = 1 =
        ms2: 0 .. 3,
        ls2: 0 ..0ff(16),
        lsb: 0 .. 0ff(16),
      = 2 =
        bit_1: 0 .. 1,
        bit_2: 0 .. 1,
        rest: 0 .. 0ffff(16),
      CASEND,
    RECEND,

    t$apqdk_register = PACKED RECORD
      pp_available: boolean,
      iou_number: 0 .. duc$de_maximum_ious,
      pp_number: 0 .. 0ff(16),
      pp_type: t$pp_type,
      p: t$p_register,
      a: t$a_register,
      q_d: t$q_d_register,
      k: t$k_register,
      post_p: t$p_register,
      post_a: t$a_register,
      post_q_d: t$q_d_register,
      post_k: t$k_register,
    RECEND,

    t$apqdk_register_list = RECORD
      use_q_register: boolean,
      list: ARRAY [1 .. c$possible_number_of_pps] OF t$apqdk_register,
    RECEND,

    t$dec_mac_registers = RECORD
      available: boolean,
      list: ARRAY [1 .. c$number_of_s0_pps] OF t$register,
    RECEND,

    t$k_register = PACKED RECORD
      CASE 0 .. 2 OF
      = 0 =
        register: 0 .. 0ffff(16),
      = 1 =
        msb: 0 .. 0ff(16),
        lsb: 0 .. 0ff(16),
      = 2 =
        bit_1: 0 .. 1,
        zero_1: 0 .. 7,
        rest: 0 .. 03f(16),
        zero_2: 0 .. 3f(16),
      CASEND,
    RECEND,

    t$p_register = RECORD
      CASE boolean OF
      = TRUE =
        register: 0 .. 0ffff(16),
      = FALSE =
        msb: 0 .. 0ff(16),
        lsb: 0 .. 0ff(16),
      CASEND,
    RECEND,

    t$pp_type = (c$nio_0_11, c$nio_20_31, c$cio_0_11),

    t$q_d_register = PACKED RECORD
      CASE 0 .. 2 OF
      = 0 =
        q_register: 0 .. 0ffff(16),
      = 1 =
        d_register: 0 .. 3f(16),
        unused: 0 .. 3f(16),
      = 2 =
        msb: 0 .. 0ff(16),
        lsb: 0 .. 0ff(16),
      CASEND,
    RECEND,

    t$register = PACKED RECORD
      pp_number: 0 .. 0ff(16),
      CASE boolean OF
      = TRUE =
        register_word: ARRAY [1 .. 8] OF 0 .. 0ff(16),
      = FALSE =
        register: PACKED ARRAY [0 .. 63] OF 0 .. 1,
      CASEND,
    RECEND,

    t$register_list = RECORD
      dec: t$dec_mac_registers,
      psr_ppr_idle: t$apqdk_register_list,
      dft_idle: t$apqdk_register_list,
      mac: t$dec_mac_registers,
    RECEND;

?? OLDTITLE ??
?? NEWTITLE := 'build_dft_registers', EJECT ??

{ PURPOSE:
{   This procedure builds the registers from the DFT record.

  PROCEDURE build_dft_registers
    (    use_q_register: boolean;
     VAR dft_data_invalid: boolean;
     VAR register_list: t$register_list);

    TYPE
      t$dft_a_register = PACKED RECORD
        unused: 0 .. 3fff(16),
        register: 0 .. 3ffff(16),
      RECEND,

      t$dft_apqdk = RECORD
        p: t$dft_p_q_d_k_register,
        q_d: t$dft_p_q_d_k_register,
        k: t$dft_p_q_d_k_register,
        a: t$dft_a_register,
        post_p: t$dft_p_q_d_k_register,
        post_q_d: t$dft_p_q_d_k_register,
        post_k: t$dft_p_q_d_k_register,
        post_a: t$dft_a_register,
      RECEND,

      t$dft_p_q_d_k_register = RECORD
        unused: 0 .. 0ffff(16),
        register: 0 .. 0ffff(16),
      RECEND,

      t$offset = RECORD
        rfu: 0 .. 0ffffffff(16),
        offset: 0 .. 0ffffffff(16),
      RECEND;

    VAR
      apqdk_p: ^t$dft_apqdk,
      data_length_valid: boolean,
      data_size: integer,
      data_valid: boolean,
      dft_data: dut$dft_data,
      index: integer,
      iou_number: 0 .. duc$de_maximum_ious,
      offset_p: ^t$offset,
      pp_number: 0 .. 0ff(16),
      pp_type: t$pp_type,
      restart_file_seq_p: ^SEQ ( * );

    dft_data_invalid := TRUE;
    dup$retrieve_dft_pointers (dft_data, data_length_valid, data_valid);
    IF NOT data_valid OR NOT data_length_valid OR
          (dft_data.buffer [dsc$dftb_rpw_pp_reg_save_area].cell_p = NIL) THEN
      RETURN;  {---->
    IFEND;
    restart_file_seq_p := duv$execution_environment.data_file_p^.segment_pointer.sequence_pointer;
    RESET restart_file_seq_p TO dft_data.buffer [dsc$dftb_rpw_pp_reg_save_area].cell_p;

    data_size := dft_data.buffer [dsc$dftb_rpw_pp_reg_save_area].size * 8;
    NEXT offset_p IN restart_file_seq_p;
    IF offset_p = NIL THEN
      RETURN;  {---->
    IFEND;
    data_size := data_size - #SIZE (offset_p^);
    register_list.dft_idle.use_q_register := use_q_register;
    iou_number := 0;
    pp_number := 0;
    pp_type := c$nio_0_11;
    index := 1;

    WHILE data_size >= #SIZE (t$dft_apqdk) DO
      NEXT apqdk_p IN restart_file_seq_p;
      IF apqdk_p = NIL THEN
        RETURN;  {---->
      IFEND;
      data_size := data_size - #SIZE (t$dft_apqdk);
      register_list.dft_idle.list [index].pp_available := TRUE;
      register_list.dft_idle.list [index].iou_number := iou_number;
      register_list.dft_idle.list [index].pp_number := pp_number;
      register_list.dft_idle.list [index].pp_type := pp_type;
      register_list.dft_idle.list [index].p.register := apqdk_p^.p.register;
      register_list.dft_idle.list [index].q_d.q_register := apqdk_p^.q_d.register;
      register_list.dft_idle.list [index].a.register := apqdk_p^.a.register;
      register_list.dft_idle.list [index].k.register := apqdk_p^.k.register;
      register_list.dft_idle.list [index].post_p.register := apqdk_p^.post_p.register;
      register_list.dft_idle.list [index].post_q_d.q_register := apqdk_p^.post_q_d.register;
      register_list.dft_idle.list [index].post_a.register := apqdk_p^.post_a.register;
      register_list.dft_idle.list [index].post_k.register := apqdk_p^.post_k.register;
      increment_pp_number (pp_number, pp_type, iou_number);
      index := index + 1;
    WHILEND;
    dft_data_invalid := FALSE;

  PROCEND build_dft_registers;
?? OLDTITLE ??
?? NEWTITLE := 'build_other_registers', EJECT ??

{ PURPOSE:
{   This procedure builds the registers for non S0 mainframes.

  PROCEDURE build_other_registers
    (    entry_p: ^dut$de_other_record_entry;
     VAR register_list: t$register_list);

    TYPE
      t$other_a_register = PACKED RECORD
        unused_1: 0 .. 0f(16),
        unused_2: 0 .. 3f(16),
        ms2: 0 .. 3,
        unused_3: 0 .. 0f(16),
        ls2: 0 .. 0ff(16),
        unused_4: 0 .. 0f(16),
        lsb: 0 .. 0ff(16),
      RECEND,

      t$other_p_q_k_register = PACKED RECORD
        unused_1: 0 .. 0f(16),
        msb: 0 .. 0ff(16),
        unused_2: 0 .. 0f(16),
        lsb: 0 .. 0ff(16),
      RECEND,

      t$other_register = PACKED RECORD
        p: t$other_p_q_k_register,
        q: t$other_p_q_k_register,
        k: t$other_p_q_k_register,
        a: t$other_a_register,
        post_p: t$other_p_q_k_register,
        post_q: t$other_p_q_k_register,
        post_k: t$other_p_q_k_register,
        post_a: t$other_a_register,
      RECEND;

    VAR
      cell_p: ^cell,
      checked_ps1: boolean,
      data_size: integer,
      data_value: clt$data_value,
      index: 1 .. c$possible_number_of_pps,
      iou_number: 0 .. duc$de_maximum_ious,
      pp_number: 0 .. 0ff(16),
      pp_registers_still_exist: boolean,
      pp_type: t$pp_type,
      ps1_entry_p: ^dut$de_other_record_entry,
      restart_file_seq_p: ^SEQ ( * ),
      other_register_p: ^t$other_register;

    iou_number := 0;
    pp_number := 0;
    pp_type := c$nio_0_11;
    register_list.dec.available := FALSE;
    register_list.psr_ppr_idle.use_q_register := TRUE;
    register_list.mac.available := FALSE;
    index := 1;

    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_p^.first_byte);
    RESET restart_file_seq_p TO cell_p;
    data_size := entry_p^.size;
    checked_ps1 := FALSE;
    pp_registers_still_exist := TRUE;

    WHILE pp_registers_still_exist DO
      NEXT other_register_p IN restart_file_seq_p;
      IF other_register_p = NIL THEN
        RETURN;  {---->
      IFEND;
      data_size := data_size - #SIZE (t$other_register);
      register_list.psr_ppr_idle.list [index].pp_available := TRUE;
      register_list.psr_ppr_idle.list [index].iou_number := iou_number;
      register_list.psr_ppr_idle.list [index].pp_number := pp_number;
      register_list.psr_ppr_idle.list [index].pp_type := pp_type;
      register_list.psr_ppr_idle.list [index].p.msb := other_register_p^ .p.msb;
      register_list.psr_ppr_idle.list [index].p.lsb := other_register_p^ .p.lsb;
      register_list.psr_ppr_idle.list [index].q_d.msb := other_register_p^ .q.msb;
      register_list.psr_ppr_idle.list [index].q_d.lsb := other_register_p^ .q.lsb;
      register_list.psr_ppr_idle.list [index].k.msb := other_register_p^ .k.msb;
      register_list.psr_ppr_idle.list [index].k.lsb := other_register_p^ .k.lsb;
      register_list.psr_ppr_idle.list [index].a.ms2 := other_register_p^ .a.ms2;
      register_list.psr_ppr_idle.list [index].a.ls2 := other_register_p^ .a.ls2;
      register_list.psr_ppr_idle.list [index].a.lsb := other_register_p^ .a.lsb;
      register_list.psr_ppr_idle.list [index].post_p.msb := other_register_p^ .post_p.msb;
      register_list.psr_ppr_idle.list [index].post_p.lsb := other_register_p^ .post_p.lsb;
      register_list.psr_ppr_idle.list [index].post_q_d.msb := other_register_p^ .post_q.msb;
      register_list.psr_ppr_idle.list [index].post_q_d.lsb := other_register_p^ .post_q.lsb;
      register_list.psr_ppr_idle.list [index].post_k.msb := other_register_p^ .post_k.msb;
      register_list.psr_ppr_idle.list [index].post_k.lsb := other_register_p^ .post_k.lsb;
      register_list.psr_ppr_idle.list [index].post_a.ms2 := other_register_p^ .post_a.ms2;
      register_list.psr_ppr_idle.list [index].post_a.ls2 := other_register_p^ .post_a.ls2;
      register_list.psr_ppr_idle.list [index].post_a.lsb := other_register_p^ .post_a.lsb;
      increment_pp_number (pp_number, pp_type, iou_number);
      index := index + 1;
      IF data_size < #SIZE (t$other_register) THEN
        IF checked_ps1 THEN
          pp_registers_still_exist := FALSE;
        ELSE
          checked_ps1 := TRUE;
          data_value.kind := clc$name;
          data_value.name_value := 'PS1';
          dup$find_record_list_entry (data_value, ps1_entry_p);
          IF ps1_entry_p = NIL THEN
            pp_registers_still_exist := FALSE;
          ELSE
            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),
                  ps1_entry_p^.first_byte);
            RESET restart_file_seq_p TO cell_p;
            data_size := ps1_entry_p^.size;
            pp_registers_still_exist := (data_size >= #SIZE (t$other_register));
          IFEND;
        IFEND;
      IFEND;
    WHILEND;

  PROCEND build_other_registers;
?? OLDTITLE ??
?? NEWTITLE := 'build_s0_registers', EJECT ??

{ PURPOSE:
{   This procedure builds the register array for the S0.

  PROCEDURE build_s0_registers
    (    entry_p: ^dut$de_other_record_entry;
     VAR register_list: t$register_list);

    TYPE
      t$s0_register = PACKED RECORD
        unused: 0 .. 0ff(16),
        subsystem_id: 0 .. 0f(16),
        subsystem_number: 0 .. 0f(16),
        register_type: 0 .. 0ff(16),
        number: 0 .. 0ff(16),
        CASE 0 .. 2 OF
        = 0 =
          register: PACKED ARRAY [0 .. 63] OF 0 .. 1,
        = 1 =
          unused_1: 0 .. 3ff(16),
          d: 0 .. 3f(16),
          unused_2: 0 .. 1,
          k_bit_1: 0 .. 1,
          k_rest: 0 .. 3f(16),
          a_bit_1: 0 .. 1,
          a_bit_2: 0 .. 1,
          unused_3: 0 .. 1,
          micrand_step_address: 0 .. 1f(16),
          unused_4: 0 .. 0ffffffff(16),
        = 2 =
          p: 0 .. 0ffff(16),
          a_rest: 0 .. 0ffff(16),
          unused_5: 0 .. 0ffffffff(16),
        CASEND,
      RECEND;

    VAR
     cell_p: ^cell,
      index: 1 .. c$number_of_s0_pps,
      iou_number: 0 .. duc$de_maximum_ious,
      pp_number: 0 .. 0ff(16),
      pp_type: t$pp_type,
      restart_file_seq_p: ^SEQ ( * ),
      s0_register_p: ^t$s0_register,
      two_s0_registers_p: ^ARRAY [1 .. 2] OF t$s0_register;

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

    { Save the DEC registers.

    pp_number := 0;
    FOR index := 1 TO c$number_of_s0_pps DO
      NEXT s0_register_p IN restart_file_seq_p;
      IF s0_register_p = NIL THEN
        RETURN;  {---->
      IFEND;
      register_list.dec.list [index].pp_number := pp_number;
      register_list.dec.list [index].register := s0_register_p^.register;
      pp_number := pp_number + 1;
      IF pp_number = 5(8) THEN
        pp_number := 20(8);
      IFEND;
    FOREND;
    register_list.dec.available := TRUE;

    { Save the PRE A/P/D/K registers.

    iou_number := 0;
    pp_number := 0;
    pp_type := c$nio_0_11;
    register_list.psr_ppr_idle.use_q_register := FALSE;
    FOR index := 1 TO c$number_of_s0_pps DO
      NEXT two_s0_registers_p IN restart_file_seq_p;
      IF two_s0_registers_p = NIL THEN
        RETURN;  {---->
      IFEND;
      register_list.psr_ppr_idle.list [index].pp_available := TRUE;
      register_list.psr_ppr_idle.list [index].iou_number := iou_number;
      register_list.psr_ppr_idle.list [index].pp_number := pp_number;
      register_list.psr_ppr_idle.list [index].pp_type := pp_type;
      register_list.psr_ppr_idle.list [index].p.register := two_s0_registers_p^ [2].p;
      register_list.psr_ppr_idle.list [index].a.bit_1 := two_s0_registers_p^ [1].a_bit_1;
      register_list.psr_ppr_idle.list [index].a.bit_2 := two_s0_registers_p^ [1].a_bit_2;
      register_list.psr_ppr_idle.list [index].a.rest := two_s0_registers_p^ [2].a_rest;
      register_list.psr_ppr_idle.list [index].q_d.d_register := two_s0_registers_p^ [1].d;
      register_list.psr_ppr_idle.list [index].k.bit_1 := two_s0_registers_p^ [1].k_bit_1;
      register_list.psr_ppr_idle.list [index].k.zero_1 := 0;
      register_list.psr_ppr_idle.list [index].k.rest := two_s0_registers_p^ [1].k_rest;
      register_list.psr_ppr_idle.list [index].k.zero_2 := 0;
      pp_number := pp_number + 1;
      IF pp_number = 5(8) THEN
        pp_number := 20(8);
        pp_type := c$nio_20_31;
      IFEND;
    FOREND;

    { Save the POST A/P/D/K registers.

    FOR index := 1 TO c$number_of_s0_pps DO
      NEXT two_s0_registers_p IN restart_file_seq_p;
      IF two_s0_registers_p = NIL THEN
        RETURN;  {---->
      IFEND;
      register_list.psr_ppr_idle.list [index].p.register := two_s0_registers_p^ [2].p;
      register_list.psr_ppr_idle.list [index].post_a.bit_1 := two_s0_registers_p^ [1].a_bit_1;
      register_list.psr_ppr_idle.list [index].post_a.bit_2 := two_s0_registers_p^ [1].a_bit_2;
      register_list.psr_ppr_idle.list [index].post_a.rest := two_s0_registers_p^ [2].a_rest;
      register_list.psr_ppr_idle.list [index].post_q_d.d_register := two_s0_registers_p^ [1].d;
      register_list.psr_ppr_idle.list [index].post_k.bit_1 := two_s0_registers_p^ [1].k_bit_1;
      register_list.psr_ppr_idle.list [index].post_k.zero_1 := 0;
      register_list.psr_ppr_idle.list [index].post_k.rest := two_s0_registers_p^ [1].k_rest;
      register_list.psr_ppr_idle.list [index].post_k.zero_2 := 0;
    FOREND;

    { Save the MAC registers.

    NEXT s0_register_p IN restart_file_seq_p;
    IF s0_register_p = NIL THEN
      RETURN;  {---->
    IFEND;
    register_list.mac.list [1].pp_number := 20(8);
    register_list.mac.list [1].register := s0_register_p^.register;
    NEXT s0_register_p IN restart_file_seq_p;
    IF s0_register_p = NIL THEN
      RETURN;  {---->
    IFEND;
    register_list.mac.list [2].pp_number := 21(8);
    register_list.mac.list [2].register := s0_register_p^.register;
    register_list.mac.available := TRUE;

  PROCEND build_s0_registers;
?? OLDTITLE ??
?? NEWTITLE := 'display_data', EJECT ??

{ PURPOSE:
{   This procedure displays the data.

  PROCEDURE display_data
    (    dft_data_invalid: boolean;
         register_list: t$register_list;
     VAR display_control: clt$display_control);

    TYPE
      t$apqdk_data_line = RECORD
        CASE boolean OF
        = TRUE =
          line: string (70),
        = FALSE =
          space_1: string (1),
          iou_string: string (3),
          iou_number: string (2),
          space_2: string (2),
          cio_id: string (1),
          pp_string: string (2),
          pp_number: string (2),
          space_3: string (2),
          message: string (15),
          space_4: string (2),
          p: string (6),
          space_5: string (2),
          a: string (6),
          space_6: string (2),
          q_d: string (6),
          space_7: string (2),
          k: string (6),
        CASEND,
      RECEND,

      t$dec_data_line = RECORD
        CASE boolean OF
        = TRUE =
          line: string (60),
        = FALSE =
          space_1: string (1),
          pp_string: string (2),
          pp_number: string (2),
          space_2: string (2),
          register: ARRAY [1 .. 8] OF string (2),
        CASEND,
      RECEND;

    VAR
      apqdk_data_line: t$apqdk_data_line,
      dec_data_line: t$dec_data_line,
      dft_pp_found: boolean,
      dft_pp_entry: 1 .. c$possible_number_of_pps,
      dump_information: dut$dump_information,
      ignore_status: ost$status,
      index: 1 .. c$possible_number_of_pps,
      index_2: 1 .. 8,
      index_3: 1 .. c$possible_number_of_pps,
      iou_number: 0 .. duc$de_maximum_ious;

    dup$determine_dump_information (dump_information);

    IF register_list.psr_ppr_idle.use_q_register THEN
      clp$put_display (display_control, 'A/P/Q/K Register History', clc$trim, ignore_status);
    ELSE
      clp$put_display (display_control, 'A/P/D/K Register History', clc$trim, ignore_status);
    IFEND;
    apqdk_data_line.line := ' ';
    apqdk_data_line.p := '   P  ';
    apqdk_data_line.a := '   A  ';
    IF register_list.psr_ppr_idle.use_q_register THEN
      apqdk_data_line.q_d := '   Q  ';
    ELSE
      apqdk_data_line.q_d := '   D  ';
    IFEND;
    apqdk_data_line.k := '   K  ';
    clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);
    apqdk_data_line.line := ' ';
    apqdk_data_line.p := '------';
    apqdk_data_line.a := '------';
    apqdk_data_line.q_d := '------';
    apqdk_data_line.k := '------';
    clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);

   /display_apqdk_loop/
    FOR index := 1 TO c$possible_number_of_pps DO
      IF NOT register_list.psr_ppr_idle.list [index].pp_available THEN
        EXIT /display_apqdk_loop/;  {---->
      IFEND;

      iou_number := register_list.psr_ppr_idle.list [index].iou_number;
      IF register_list.psr_ppr_idle.list [index].pp_type = c$cio_0_11 THEN
        CASE dump_information.iou [iou_number].model OF
        = duc$di_im_i1_1x, duc$di_im_i2_20, duc$di_im_i4_43, duc$di_im_i4_44, duc$di_im_i4_46 =
          CYCLE /display_apqdk_loop/;  {---->
        ELSE
        CASEND;
      IFEND;

      apqdk_data_line.line := ' ';
      apqdk_data_line.iou_string := 'IOU';
      clp$convert_integer_to_rjstring (iou_number, 8, FALSE, '0', apqdk_data_line.iou_number, ignore_status);
      IF (register_list.psr_ppr_idle.list [index].pp_type = c$cio_0_11) OR
            (dump_information.iou [iou_number].model = duc$di_im_i4_43) OR
            (dump_information.iou [iou_number].model = duc$di_im_i4_44) OR
            (dump_information.iou [iou_number].model = duc$di_im_i4_46) THEN
        apqdk_data_line.cio_id := 'C';
      IFEND;
      apqdk_data_line.pp_string := 'PP';
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].pp_number, 8, FALSE, '0',
            apqdk_data_line.pp_number, ignore_status);
      IF register_list.psr_ppr_idle.use_q_register THEN
        apqdk_data_line.message := 'PSR:  pre-idle';
      ELSE
        apqdk_data_line.message := 'PPR:  pre-idle';
      IFEND;
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].p.register, 8,
            FALSE, ' ', apqdk_data_line.p, ignore_status);
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].a.register, 8,
            FALSE, ' ', apqdk_data_line.a, ignore_status);
      IF register_list.psr_ppr_idle.use_q_register THEN
        clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].q_d.q_register, 8,
              FALSE, ' ', apqdk_data_line.q_d, ignore_status);
      ELSE
        clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].q_d.d_register, 8,
              FALSE, ' ', apqdk_data_line.q_d, ignore_status);
      IFEND;
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].k.register, 8,
            FALSE, ' ', apqdk_data_line.k, ignore_status);
      clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);

      apqdk_data_line.line := ' ';
      IF register_list.psr_ppr_idle.use_q_register THEN
        apqdk_data_line.message := 'PSR:  post-idle';
      ELSE
        apqdk_data_line.message := 'PPR:  post-idle';
      IFEND;
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].post_p.register, 8,
            FALSE, ' ', apqdk_data_line.p, ignore_status);
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].post_a.register, 8,
            FALSE, ' ', apqdk_data_line.a, ignore_status);
      IF register_list.psr_ppr_idle.use_q_register THEN
        clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].post_q_d.q_register, 8,
              FALSE, ' ', apqdk_data_line.q_d, ignore_status);
      ELSE
        clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].post_q_d.d_register, 8,
              FALSE, ' ', apqdk_data_line.q_d, ignore_status);
      IFEND;
      clp$convert_integer_to_rjstring (register_list.psr_ppr_idle.list [index].post_k.register, 8,
            FALSE, ' ', apqdk_data_line.k, ignore_status);
      clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);

      IF dump_information.dump_type = duc$di_dt_cy2000 THEN
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
        CYCLE /display_apqdk_loop/;  {---->
      IFEND;

      IF NOT dft_data_invalid THEN
        dft_pp_found := FALSE;

       /find_dft_pp_entry/
        FOR index_3 := 1 TO c$possible_number_of_pps DO
          IF (iou_number = register_list.dft_idle.list [index_3].iou_number) AND
                (register_list.psr_ppr_idle.list [index].pp_number =
                register_list.dft_idle.list [index_3].pp_number) AND
                (register_list.psr_ppr_idle.list [index].pp_type =
                register_list.dft_idle.list [index_3].pp_type) THEN
            dft_pp_found := TRUE;
            dft_pp_entry := index_3;
            EXIT /find_dft_pp_entry/;  {---->
          IFEND;
        FOREND /find_dft_pp_entry/;
      IFEND;

      IF dft_data_invalid OR NOT dft_pp_found THEN
        apqdk_data_line.line := ' ';
        apqdk_data_line.message := 'DFT:  buffer 1';
        apqdk_data_line.p := '******';
        apqdk_data_line.a := '******';
        apqdk_data_line.q_d := '******';
        apqdk_data_line.k := '******';
        clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);
        apqdk_data_line.message := 'DFT:  buffer 2';
        clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);
      ELSE
        apqdk_data_line.line := ' ';
        apqdk_data_line.message := 'DFT:  buffer 1';
        clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].p.register, 8,
              FALSE, ' ', apqdk_data_line.p, ignore_status);
        clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].a.register, 8,
              FALSE, ' ', apqdk_data_line.a, ignore_status);
        IF register_list.psr_ppr_idle.use_q_register THEN
          clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].q_d.q_register, 8,
                FALSE, ' ', apqdk_data_line.q_d, ignore_status);
        ELSE
          clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].q_d.d_register, 8,
                FALSE, ' ', apqdk_data_line.q_d, ignore_status);
        IFEND;
        clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].k.register, 8,
              FALSE, ' ', apqdk_data_line.k, ignore_status);
        clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);
        apqdk_data_line.line := ' ';
        apqdk_data_line.message := 'DFT:  buffer 2';
        clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].post_p.register, 8,
              FALSE, ' ', apqdk_data_line.p, ignore_status);
        clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].post_a.register, 8,
              FALSE, ' ', apqdk_data_line.a, ignore_status);
        IF register_list.psr_ppr_idle.use_q_register THEN
          clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].post_q_d.q_register, 8,
                FALSE, ' ', apqdk_data_line.q_d, ignore_status);
        ELSE
          clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].post_q_d.d_register, 8,
                FALSE, ' ', apqdk_data_line.q_d, ignore_status);
        IFEND;
        clp$convert_integer_to_rjstring (register_list.dft_idle.list [dft_pp_entry].post_k.register, 8,
              FALSE, ' ', apqdk_data_line.k, ignore_status);
        clp$put_display (display_control, apqdk_data_line.line, clc$trim, ignore_status);
      IFEND;

      clp$put_display (display_control, ' ', clc$trim, ignore_status);
    FOREND /display_apqdk_loop/;

    IF register_list.dec.available THEN
      clp$put_display (display_control, ' ', clc$trim, ignore_status);
      clp$put_display (display_control, 'DEC Registers:', clc$trim, ignore_status);
      clp$put_display (display_control, ' ', clc$trim, ignore_status);

      FOR index := 1 TO c$number_of_s0_pps DO
        dec_data_line.line := ' ';
        dec_data_line.pp_string := 'PP';
        clp$convert_integer_to_rjstring (register_list.dec.list [index].pp_number, 8, FALSE, '0',
              dec_data_line.pp_number, ignore_status);
        FOR index_2 := 1 TO 8 DO
          clp$convert_integer_to_rjstring (register_list.dec.list [index].register_word [index_2],
                16, FALSE, '0', dec_data_line.register [index_2], ignore_status);
        FOREND;
        clp$put_display (display_control, dec_data_line.line, clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
      FOREND;
    IFEND;

    IF register_list.mac.available THEN
      clp$put_display (display_control, ' ', clc$trim, ignore_status);
      clp$put_display (display_control, 'MAC Registers:', clc$trim, ignore_status);
      clp$put_display (display_control, ' ', clc$trim, ignore_status);

      FOR index := 1 TO 2 DO
        dec_data_line.line := ' ';
        clp$convert_integer_to_rjstring (register_list.mac.list [index].pp_number, 8, FALSE, '0',
              dec_data_line.pp_number, ignore_status);
        FOR index_2 := 1 TO 8 DO
          clp$convert_integer_to_rjstring (register_list.mac.list [index].register_word [index_2],
                16, FALSE, '0', dec_data_line.register [index_2], ignore_status);
        FOREND;
        clp$put_display (display_control, dec_data_line.line, clc$trim, ignore_status);
        clp$put_display (display_control, ' ', clc$trim, ignore_status);
      FOREND;
    IFEND;

  PROCEND display_data;
?? OLDTITLE ??
?? NEWTITLE := 'increment_pp_number', EJECT ??

{ PURPOSE:
{   This procedure increments the pp number, iou number and pp type.

  PROCEDURE increment_pp_number
    (VAR pp_number: 0 .. 0ff(16);
     VAR pp_type: t$pp_type;
     VAR iou_number: 0 .. duc$de_maximum_ious);

    VAR
      dump_information: dut$dump_information;

{I know, this is not the fastes way to do it, but who cares. It's only the dispr command od anad....
{And anyway, it is not so terribly slow, too ...

    dup$determine_dump_information (dump_information);

{Maybe, the SP on the CY2000 does not fill the PSR and PS1 record with binary 0's as it should or
{its format was changed and the change newer made it into this routine.
{The way it appears is, that PSR and PS1 contain each 20 PP registers and some rest. Unfortunatly,
{the rest is bigger than one register information.
{
{  non I4_46 naming                    I4_46 naming
{
{  PP(10) PP(8) Type IOU Record        PP(10) PP(8) Type IOU Record  Comment
{  ----------------------------        ------------------------------------------------
{  00-09  00-11 NIO  0   PSR           00-09  00-11 NIO  0   PSR     00-09 IOU0 CIO PPs
{  16-25  20-31 NIO  0   PSR           16-25  20-31 NIO  0   PSR     16-25 IOU0 CIO PPs
{  00     00    CIO  0   PSR           00     00    CIO  0   PSR     junk
{  01-09  01-11 CIO  0   PS1           00-09  01-11 NIO  1   PS1     00-09 IOU1 CIO PPs
{  00-09  00-11 NIO  1   PS1           16-25  20-31 NIO  1   PS1     16-25 IOU1 CIO PPs
{  16-17  20-21 NIO  1   PS1           00     00    CIO  1   PS1     junk

    IF dump_information.iou [iou_number].model = duc$di_im_i4_46 THEN
      IF pp_type = c$cio_0_11 THEN
        iou_number := 1;
        pp_number := 0;
        pp_type := c$nio_0_11;
      ELSEIF pp_number = 11(8) THEN
          pp_number := 20(8);
          pp_type := c$nio_20_31;
      ELSEIF pp_number = 31(8) THEN
        pp_number := 0;
        pp_type := c$cio_0_11;
      ELSE
        pp_number := pp_number + 1;
      IFEND;
    ELSE
      IF pp_number = 11(8) THEN
        IF pp_type = c$nio_0_11 THEN
          pp_number := 20(8);
          pp_type := c$nio_20_31;
        ELSE  { pp_type = c$cio_0_11
          iou_number := 1;
          pp_number := 0;
          pp_type := c$nio_0_11;
        IFEND;
      ELSEIF pp_number = 31(8) THEN
        pp_number := 0;
        pp_type := c$cio_0_11;
      ELSE
        pp_number := pp_number + 1;
      IFEND;
    IFEND;

  PROCEND increment_pp_number;
?? OLDTITLE ??
?? NEWTITLE := 'dup$display_pp_regs_command', EJECT ??

{ PURPOSE:
{   This procedure displays the pp registers.

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

{ PROCEDURE display_pp_registers, dispr (
{   output, o: file = $optional
{   title, t: string 1..31 = 'display_pp_registers'
{   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 (22),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 4, 18, 9, 1, 31, 218],
    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, 22],
{ 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_pp_registers'''],
{ 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_value: clt$data_value,
      dft_data_invalid: boolean,
      display_control: clt$display_control,
      entry_p: ^dut$de_other_record_entry,
      ignore_status: ost$status,
      index: 1 .. c$possible_number_of_pps,
      output_display_opened: boolean,
      register_list: t$register_list,
      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^;

      register_list.dec.available := FALSE;
      register_list.mac.available := FALSE;
      FOR index := 1 TO c$possible_number_of_pps DO
        register_list.psr_ppr_idle.list [index].pp_available := FALSE;
        register_list.dft_idle.list [index].pp_available := FALSE;
      FOREND;

      data_value.kind := clc$name;
      data_value.name_value := 'PPR';
      dup$find_record_list_entry (data_value, entry_p);
      IF entry_p <> NIL THEN
        build_s0_registers (entry_p, register_list);
        build_dft_registers (FALSE, dft_data_invalid, register_list);
      ELSE
        data_value.kind := clc$name;
        data_value.name_value := 'PSR';
        dup$find_record_list_entry (data_value, entry_p);
        IF entry_p <> NIL THEN
          build_other_registers (entry_p, register_list);
          build_dft_registers (TRUE, dft_data_invalid, register_list);
        ELSE
          osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump, 'The specified record is',
                status);
          EXIT /display_opened/;  {---->
        IFEND;
      IFEND;

      display_data (dft_data_invalid, register_list, display_control);

    END /display_opened/;

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

  PROCEND dup$display_pp_regs_command;
MODEND dum$display_pp_regs_command;
