?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Display Report Record Command' ??
MODULE dum$display_report_record;

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

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc due$exception_condition_codes
?? POP ??
*copyc clp$close_display
*copyc clp$evaluate_parameters
*copyc clp$open_display_reference
*copyc clp$put_display
*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 := 'Global Declarations Declared by This Module', EJECT ??
  VAR
    v$restart_file_seq_p: ^SEQ ( * );

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

{ PURPOSE:
{   This procedure retrieves a line from the report record.

  PROCEDURE retrieve_line
    (VAR report_line: string (80);
     VAR report_length: integer;
     VAR status: ost$status);

    CONST
      c$line_feed = 0a(16);

    TYPE
      t$report_line_array = RECORD
        CASE boolean OF
        = TRUE =
          line_part: string (80),
        = FALSE =
          array_part: ARRAY [1 .. 80] OF 0 .. 0ff(16),
        CASEND,
      RECEND;

    VAR
      index: 0 .. 81,
      report_byte_p: ^0 .. 0ff(16),
      report_line_array: t$report_line_array;

    status.normal := TRUE;

    report_line_array.line_part := ' ';
    report_line := ' ';
    index := 1;
    REPEAT
      NEXT report_byte_p IN v$restart_file_seq_p;
      IF report_byte_p = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
        RETURN;  {---->
      IFEND;
      report_length := report_length - 1;
      IF (report_length = 0) AND (report_byte_p^ <> c$line_feed) THEN
        RETURN;  {---->
      IFEND;
      IF (index = 81) AND (report_byte_p^ <> c$line_feed) THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$bad_report_record, '', status);
        RETURN;  {---->
      IFEND;
      IF report_byte_p^ <> c$line_feed THEN
        report_line_array.array_part [index] := report_byte_p^;
        index := index + 1;
      IFEND;
    UNTIL report_byte_p^ = c$line_feed;
    report_line := report_line_array.line_part;

  PROCEND retrieve_line;
?? OLDTITLE ??
?? NEWTITLE := 'dup$display_report_record', EJECT ??

{ PURPOSE:
{   This procedure displays a report record from the restart file.

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

{ PROCEDURE display_dump_record, disdr (
{   record_identifier, ri: any of
{       string 1..3
{       integer
{       name
{     anyend = $required
{   output, o: file
{   title, t: string 1..31 = 'display_report_record'
{   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$string_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (23),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 4, 16, 9, 16, 59, 904],
    clc$command, 7, 4, 1, 0, 0, 0, 4, ''], [
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['RECORD_IDENTIFIER              ',clc$nominal_entry, 1],
    ['RI                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['T                              ',clc$abbreviation_entry, 3],
    ['TITLE                          ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [3, 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, 57, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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 3
    [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 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$name_type, clc$string_type],
    TRUE, 3],
    8, [[1, 0, clc$string_type], [1, 3, FALSE]],
    20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$string_type], [1, 31, FALSE],
    '''display_report_record'''],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

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

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

    VAR
      cell_p: ^cell,
      display_control: clt$display_control,
      display_string: string (osc$max_string_size),
      entry_p: ^dut$de_other_record_entry,
      header_line_count: 0 .. 0ff(16),
      header_lines_p: ^ARRAY [1 .. *] OF string (80),
      ignore_status: ost$status,
      index: 0 .. 0ff(16),
      output_display_opened: boolean,
      report_length: integer,
      report_line: string (80),
      ring_attributes: amt$ring_attributes,
      string_length: integer;

*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 ??
?? NEWTITLE := 'new_page_procedure', EJECT ??

{ PURPOSE:
{   This procedure calls the standard new page procedure and then displays some header lines.

    PROCEDURE new_page_procedure
      (VAR display_control: clt$display_control;
           new_page_number: integer;
       VAR status: ost$status);

      VAR
        index: 0 .. 0ff(16);

      status.normal := TRUE;
      dup$new_page_procedure (display_control, new_page_number, status);

      IF header_lines_p <> NIL THEN
        FOR index := 1 TO header_line_count DO
          clp$put_display (display_control, header_lines_p^ [index], clc$trim, status);
        FOREND;
      IFEND;

    PROCEND new_page_procedure;
?? 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;

    dup$find_record_list_entry (pvt [p$record_identifier].value^, entry_p);
    IF entry_p = NIL THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump, 'The specified record is',
            status);
      RETURN;  {---->
    IFEND;

    IF entry_p^.record_type <> duc$de_ort_report THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$record_type_supported, 'REPORT', status);
      RETURN;  {---->
    IFEND;

    header_line_count := 0;
    header_lines_p := NIL;
    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^, ^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;
      IF pvt [p$title].specified THEN
        duv$title_data.command_name := pvt [p$title].value^.string_value^;
      ELSE
        STRINGREP (display_string, string_length, 'display_report_record :  ', entry_p^.name);
        duv$title_data.command_name := display_string (1, string_length);
      IFEND;

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

      header_line_count := entry_p^.header_line_count;
      IF header_line_count > 0 THEN
        PUSH header_lines_p: [1 .. header_line_count];
      IFEND;
      FOR index := 1 TO header_line_count DO
        header_lines_p^ [index] := ' ';
      FOREND;

      report_length := entry_p^.report_record_length * 8;

      FOR index := 1 TO header_line_count DO
        retrieve_line (header_lines_p^ [index], report_length, status);
        IF NOT status.normal OR (report_length <= 0) THEN
          EXIT /display_opened/;  {---->
        IFEND;
      FOREND;

      WHILE report_length > 0 DO
        retrieve_line (report_line, report_length, status);
        IF NOT status.normal THEN
          EXIT /display_opened/;  {---->
        IFEND;
        clp$put_display (display_control, report_line, clc$trim, ignore_status);
      WHILEND;

    END /display_opened/;

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

  PROCEND dup$display_report_record;
MODEND dum$display_report_record;
