?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Display S0 PP Memory Command' ??
MODULE dum$display_s0_pp_mem_command;

{ PURPOSE:
{   This module contains the code for the display_s0_pp_memory command.  It displays the contents of an S0 PP
{   memory which has been dumped to the PC floppy disk and manually moved to a NOS/VE file.  The output file
{   is in a format similar to the Analyze_Dump directive Display_PP_Memory.
{
{ DESIGN:
{   The input file is read, reformatted and displayed in the format specified by the input parameters.
{
{ NOTES:
{   After the S0 PP is dumped to the PC console floppy, the user must move the dump file from the floppy disk
{   to a NOS/VE file through the use of a micro program such as CONNECT.  The NOS/VE file is then specified as
{   the input parameter for this module.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc due$exception_condition_codes
?? POP ??
*copyc amp$get_segment_pointer
*copyc clp$close_display
*copyc clp$evaluate_parameters
*copyc clp$open_display_reference
*copyc dup$display_data
*copyc dup$new_page_procedure
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$set_status_abnormal
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
?? EJECT ??
*copyc duv$execution_environment
*copyc duv$title_data
?? TITLE := 'dup$display_s0_pp_memory', EJECT ??

{ PURPOSE:
{   This procedure cracks the command parameters, controls the input and output file opening and closing, and
{   calls the procedure which formats and writes the output.

  PROCEDURE [XDCL, #GATE] dup$display_s0_pp_memory
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE display_s0_pp_memory, disspm (
{   input, i: file = $required
{   output, o: file = $required
{   address, a: integer 0..16383 = 0
{   words, w: integer 1..16384 = 16384
{   display_option, do: list 1..2 of key
{       (numeric n) (ascii a) (display_code dc)
{     keyend = (numeric ascii)
{   radix, r: integer 8..16 = 8
{   title, t: string 1..osc$max_name_size = 'display_s0_pp_memory'
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 15] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (5),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 6] of clt$keyword_specification,
        recend,
        default_value: string (15),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (22),
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 1, 22, 11, 40, 37, 461],
    clc$command, 15, 8, 2, 0, 0, 0, 8, ''], [
    ['A                              ',clc$abbreviation_entry, 3],
    ['ADDRESS                        ',clc$nominal_entry, 3],
    ['DISPLAY_OPTION                 ',clc$nominal_entry, 5],
    ['DO                             ',clc$abbreviation_entry, 5],
    ['I                              ',clc$abbreviation_entry, 1],
    ['INPUT                          ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['R                              ',clc$abbreviation_entry, 6],
    ['RADIX                          ',clc$nominal_entry, 6],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['T                              ',clc$abbreviation_entry, 7],
    ['TITLE                          ',clc$nominal_entry, 7],
    ['W                              ',clc$abbreviation_entry, 4],
    ['WORDS                          ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [8, 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$required_parameter, 0
  , 0],
{ 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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 4
    [15, 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, 5],
{ PARAMETER 5
    [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, 245,
  clc$optional_default_parameter, 0, 15],
{ PARAMETER 6
    [10, 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 7
    [13, 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 8
    [11, 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$file_type]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [0, 16383, 10],
    '0'],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, 16384, 10],
    '16384'],
{ PARAMETER 5
    [[1, 0, clc$list_type], [229, 1, 2, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [6], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['ASCII                          ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['DC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['DISPLAY_CODE                   ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['NUMERIC                        ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    '(numeric ascii)'],
{ PARAMETER 6
    [[1, 0, clc$integer_type], [8, 16, 10],
    '8'],
{ PARAMETER 7
    [[1, 0, clc$string_type], [1, osc$max_name_size, FALSE],
    '''display_s0_pp_memory'''],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$input = 1,
      p$output = 2,
      p$address = 3,
      p$words = 4,
      p$display_option = 5,
      p$radix = 6,
      p$title = 7,
      p$status = 8;

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

    VAR
      address: 0 .. 16383,
      display_control: clt$display_control,
      end_of_input_file: boolean,
      fa_p: ^fst$attachment_options,
      file_identifier: amt$file_identifier,
      file_pointer: amt$segment_pointer,
      ignore_status: ost$status,
      mca_p: ^fst$file_cycle_attributes,
      output_display_opened: boolean,
      skip_pp_data_p: ^SEQ ( * ),
      radix: 8 .. 16,
      ring_attributes: amt$ring_attributes,
      words: 1 .. 16384;

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

    address := pvt [p$address].value^.integer_value.value;
    words := pvt [p$words].value^.integer_value.value;

    { Open the input compare file.

    PUSH fa_p: [1 .. 1];
    fa_p^ [1].selector := fsc$access_and_share_modes;
    fa_p^ [1].access_modes.selector := fsc$specific_access_modes;
    fa_p^ [1].access_modes.value := $fst$file_access_options [fsc$read];
    fa_p^ [1].share_modes.selector := fsc$specific_share_modes;
    fa_p^ [1].share_modes.value := $fst$file_access_options [fsc$read];

    PUSH mca_p: [1 .. 2];
    mca_p^ [1].selector := fsc$record_type;
    mca_p^ [1].record_type := amc$undefined;
    mca_p^ [2].selector := fsc$preset_value;
    mca_p^ [2].preset_value := -1;

    fsp$open_file (pvt [p$input].value^.file_value^, amc$segment, fa_p, NIL, mca_p, NIL, NIL, file_identifier,
          status);
    IF NOT status.normal THEN
      RETURN;  {---->
    IFEND;

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

      amp$get_segment_pointer (file_identifier, amc$sequence_pointer, file_pointer, status);
      IF NOT status.normal THEN
        EXIT /file_opened/;  {---->
      IFEND;
      IF file_pointer.sequence_pointer = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
        EXIT /file_opened/;  {---->
      IFEND;
      RESET file_pointer.sequence_pointer;

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

      radix := pvt [p$radix].value^.integer_value.value;

      { Return if there are no words to display.

      IF words = 0 THEN
        EXIT /file_opened/;  {---->
      IFEND;

      { Skip over sixteen-bit length value and skip to the desired address in the pp memory data.

      NEXT skip_pp_data_p: [[REP (2) OF cell]] IN file_pointer.sequence_pointer;
      IF skip_pp_data_p = NIL THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
        EXIT /file_opened/;  {---->
      IFEND;
      IF address <> 0 THEN
        NEXT skip_pp_data_p: [[REP (address * 2) OF cell]] IN file_pointer.sequence_pointer;
        IF skip_pp_data_p = NIL THEN
          osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);
          EXIT /file_opened/;  {---->
        IFEND;
      IFEND;

      { Display the data.

      dup$display_data (pvt [p$display_option].value, FALSE, radix, address, words, display_control,
            file_pointer.sequence_pointer, end_of_input_file, status);
      IF end_of_input_file THEN
        status.normal := TRUE;
      IFEND;
    END /file_opened/;

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

  PROCEND dup$display_s0_pp_memory;
MODEND dum$display_s0_pp_mem_command;
