?? RIGHT := 110 ??                                                                                            
?? NEWTITLE := 'NOS/VE Dump Analyzer : Copy PP Memory Command' ??                                             
MODULE dum$copy_pp_memory_command;                                                                            
                                                                                                              
{ PURPOSE:                                                                                                    
{   This module contains the code for the copy_pp_memory command.                                             
                                                                                                              
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??                                      
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc due$exception_condition_codes                                                                          
?? POP ??                                                                                                     
*copyc amp$get_segment_pointer                                                                                
*copyc amp$set_segment_eoi                                                                                    
*copyc dup$determine_dump_information                                                                         
*copyc dup$evaluate_parameters                                                                                
*copyc fsp$close_file                                                                                         
*copyc fsp$open_file                                                                                          
*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                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'dup$copy_pp_memory_command', EJECT ??                                                         
                                                                                                              
{ Purpose:                                                                                                    
{   This procedure copies the pp memory from the restart file to the output file.                             
                                                                                                              
  PROCEDURE [XDCL] dup$copy_pp_memory_command                                                                 
    (    parameter_list: clt$parameter_list;                                                                  
     VAR status: ost$status);                                                                                 
                                                                                                              
{ PROCEDURE copy_pp_memory, copm (                                                                            
{   pp_number, pn: integer  0..25 = $required                                                                 
{   file, f: file = $required                                                                                 
{   pp_type, pt: key                                                                                          
{       (normal n) (concurrent_input_output cio c)                                                            
{     keyend = concurrent_input_output                                                                        
{   address, a: integer 0..16383 = 0                                                                          
{   words, w, word_count, wc: integer 1..16384 = 16384                                                        
{   iou, i: integer 0..1 = 0                                                                                  
{   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 .. 7] of clt$pdt_parameter,                                                        
      type1: record                                                                                           
        header: clt$type_specification_header,                                                                
        qualifier: clt$integer_type_qualifier,                                                                
      recend,                                                                                                 
      type2: record                                                                                           
        header: clt$type_specification_header,                                                                
      recend,                                                                                                 
      type3: record                                                                                           
        header: clt$type_specification_header,                                                                
        qualifier: clt$keyword_type_qualifier,                                                                
        keyword_specs: array [1 .. 5] of clt$keyword_specification,                                           
        default_value: string (23),                                                                           
      recend,                                                                                                 
      type4: record                                                                                           
        header: clt$type_specification_header,                                                                
        qualifier: clt$integer_type_qualifier,                                                                
        default_value: string (1),                                                                            
      recend,                                                                                                 
      type5: record                                                                                           
        header: clt$type_specification_header,                                                                
        qualifier: clt$integer_type_qualifier,                                                                
        default_value: string (5),                                                                            
      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,                                                                
      recend,                                                                                                 
    recend := [                                                                                               
    [1,                                                                                                       
    [90, 3, 1, 5, 25, 0, 578],                                                                                
    clc$command, 15, 7, 2, 0, 0, 0, 7, ''], [                                                                 
    ['A                              ',clc$abbreviation_entry, 4],                                            
    ['ADDRESS                        ',clc$nominal_entry, 4],                                                 
    ['F                              ',clc$abbreviation_entry, 2],                                            
    ['FILE                           ',clc$nominal_entry, 2],                                                 
    ['I                              ',clc$abbreviation_entry, 6],                                            
    ['IOU                            ',clc$nominal_entry, 6],                                                 
    ['PN                             ',clc$abbreviation_entry, 1],                                            
    ['PP_NUMBER                      ',clc$nominal_entry, 1],                                                 
    ['PP_TYPE                        ',clc$nominal_entry, 3],                                                 
    ['PT                             ',clc$abbreviation_entry, 3],                                            
    ['STATUS                         ',clc$nominal_entry, 7],                                                 
    ['W                              ',clc$alias_entry, 5],                                                   
    ['WC                             ',clc$abbreviation_entry, 5],                                            
    ['WORDS                          ',clc$nominal_entry, 5],                                                 
    ['WORD_COUNT                     ',clc$alias_entry, 5]],                                                  
    [                                                                                                         
{ PARAMETER 1                                                                                                 
    [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, 20, clc$required_parameter, 
  0, 0],                                                                                                      
{ PARAMETER 2                                                                                                 
    [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, 3, clc$required_parameter, 0
  , 0],                                                                                                       
{ PARAMETER 3                                                                                                 
    [9, 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, 192,                        
  clc$optional_default_parameter, 0, 23],                                                                     
{ PARAMETER 4                                                                                                 
    [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 5                                                                                                 
    [14, 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 6                                                                                                 
    [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, 20,                         
  clc$optional_default_parameter, 0, 1],                                                                      
{ PARAMETER 7                                                                                                 
    [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$integer_type], [0, 25, 10]],                                                                  
{ PARAMETER 2                                                                                                 
    [[1, 0, clc$file_type]],                                                                                  
{ PARAMETER 3                                                                                                 
    [[1, 0, clc$keyword_type], [5], [                                                                         
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],                   
    ['CIO                            ', clc$alias_entry, clc$normal_usage_entry, 2],                          
    ['CONCURRENT_INPUT_OUTPUT        ', clc$nominal_entry, clc$normal_usage_entry, 2],                        
    ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],                   
    ['NORMAL                         ', clc$nominal_entry, clc$normal_usage_entry, 1]]                        
    ,                                                                                                         
    'concurrent_input_output'],                                                                               
{ PARAMETER 4                                                                                                 
    [[1, 0, clc$integer_type], [0, 16383, 10],                                                                
    '0'],                                                                                                     
{ PARAMETER 5                                                                                                 
    [[1, 0, clc$integer_type], [1, 16384, 10],                                                                
    '16384'],                                                                                                 
{ PARAMETER 6                                                                                                 
    [[1, 0, clc$integer_type], [0, 1, 10],                                                                    
    '0'],                                                                                                     
{ PARAMETER 7                                                                                                 
    [[1, 0, clc$status_type]]];                                                                               
?? FMT (FORMAT := ON) ??                                                                                      
?? POP ??                                                                                                     
                                                                                                              
    CONST                                                                                                     
      p$pp_number = 1,                                                                                        
      p$file = 2,                                                                                             
      p$pp_type = 3,                                                                                          
      p$address = 4,                                                                                          
      p$words = 5,                                                                                            
      p$iou = 6,                                                                                              
      p$status = 7;                                                                                           
                                                                                                              
    VAR                                                                                                       
      pvt: array [1 .. 7] of clt$parameter_value;                                                             
                                                                                                              
    VAR                                                                                                       
      address: 0 .. 16383,                                                                                    
      cell_p: ^cell,                                                                                          
      default_list: ARRAY [1 .. 2] OF dut$default_change_list_entry,                                          
      dump_information: dut$dump_information,                                                                 
      fa_p: ^fst$attachment_options,                                                                          
      file_buffer_p: ^SEQ ( * ),                                                                              
      file_identifier: amt$file_identifier,                                                                   
      file_pointer: amt$segment_pointer,                                                                      
      ignore_status: ost$status,                                                                              
      iou_number: 0 .. duc$de_maximum_ious,                                                                   
      output_file_opened: boolean,                                                                            
      pp_number: 0 .. duc$de_max_pp_memories,                                                                 
      restart_file_buffer_p: ^SEQ ( * ),                                                                      
      restart_file_seq_p: ^SEQ ( * ),                                                                         
      skip_pp_data_p: ^SEQ ( * ),                                                                             
      words: 0 .. 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_file_opened THEN                                                                              
        fsp$close_file (file_identifier, ignore_status);                                                      
      IFEND;                                                                                                  
                                                                                                              
    PROCEND clean_up;                                                                                         
?? OLDTITLE, EJECT ??                                                                                         
                                                                                                              
    status.normal := TRUE;                                                                                    
                                                                                                              
    { Change the default value for the PP_TYPE and IOU parameters.                                            
                                                                                                              
    default_list [1].default_name := duc$dp_pp_type;                                                          
    default_list [1].number := p$pp_type;                                                                     
    default_list [2].default_name := duc$dp_iou;                                                              
    default_list [2].number := p$iou;                                                                         
    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;                                                                                                    
                                                                                                              
    { Check the availability of the pp memory.                                                                
                                                                                                              
    pp_number := pvt [p$pp_number].value^.integer_value.value;                                                
    iou_number := pvt [p$iou].value^.integer_value.value;                                                     
                                                                                                              
   /determine_pp_availability/                                                                                
    BEGIN                                                                                                     
      IF (pvt [p$pp_type].value^.keyword_value = 'NORMAL') AND                                                
            duv$dump_environment_p^.iou_memory [iou_number].nio_pp [pp_number].available THEN                 
        EXIT /determine_pp_availability/;  {---->                                                             
      ELSEIF (pp_number <= duc$de_max_cio_pp_memories) AND                                                    
            duv$dump_environment_p^.iou_memory [iou_number].cio_pp [pp_number].available THEN                 
        EXIT /determine_pp_availability/;  {---->                                                             
      IFEND;                                                                                                  
      osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,                                    
            'The peripheral processor', status);                                                              
      osp$append_status_integer (osc$status_parameter_delimiter, pp_number, 8, TRUE, status);                 
      osp$append_status_parameter (osc$status_parameter_delimiter, 'is', status);                             
      RETURN;  {---->                                                                                         
    END /determine_pp_availability/;                                                                          
                                                                                                              
    { Determine how many words to copy.                                                                       
                                                                                                              
    address := pvt [p$address].value^.integer_value.value;                                                    
    words := pvt [p$words].value^.integer_value.value;                                                        
    dup$determine_dump_information (dump_information);                                                        
    IF address >= dump_information.iou [iou_number].pp_word_size THEN                                         
      osp$set_status_abnormal (duc$dump_analyzer_id, due$invalid_address, '', status);                        
      osp$append_status_integer (osc$status_parameter_delimiter, address,                                     
            pvt [p$address].value^.integer_value.radix, TRUE, status);                                        
      RETURN;  {---->                                                                                         
    ELSEIF (address + words) > dump_information.iou [iou_number].pp_word_size THEN                            
      words := dump_information.iou [iou_number].pp_word_size - address;                                      
    IFEND;                                                                                                    
                                                                                                              
    output_file_opened := FALSE;                                                                              
    osp$establish_block_exit_hndlr (^abort_handler);                                                          
                                                                                                              
   /file_opened/                                                                                              
    BEGIN                                                                                                     
                                                                                                              
      { Open the output 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, fsc$shorten, fsc$append, fsc$modify];                         
      fa_p^ [1].share_modes.selector := fsc$specific_share_modes;                                             
      fa_p^ [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$shorten, fsc$append, fsc$modify];
                                                                                                              
      fsp$open_file (pvt [p$file].value^.file_value^, amc$segment, fa_p, NIL, NIL, NIL, NIL, file_identifier, 
            status);                                                                                          
      IF NOT status.normal THEN                                                                               
        EXIT /file_opened/;  {---->                                                                           
      IFEND;                                                                                                  
      output_file_opened := TRUE;                                                                             
                                                                                                              
      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;                                                                    
                                                                                                              
      { Retrieve a sequence pointer to the pp memory data on the restart file.                                
                                                                                                              
      restart_file_seq_p := duv$execution_environment.data_file_p^.segment_pointer.sequence_pointer;          
      IF pvt [p$pp_type].value^.keyword_value = 'NORMAL' THEN                                                 
        cell_p := #ADDRESS (#RING (restart_file_seq_p), #SEGMENT (restart_file_seq_p),                        
              duv$dump_environment_p^.iou_memory [iou_number].nio_pp [pp_number].first_byte);                 
      ELSE                                                                                                    
        cell_p := #ADDRESS (#RING (restart_file_seq_p), #SEGMENT (restart_file_seq_p),                        
              duv$dump_environment_p^.iou_memory [iou_number].cio_pp [pp_number].first_byte);                 
      IFEND;                                                                                                  
      RESET restart_file_seq_p TO cell_p;                                                                     
                                                                                                              
      { Skip to the desired address in the pp memory data.                                                    
                                                                                                              
      IF address > 0 THEN                                                                                     
        NEXT skip_pp_data_p: [[REP (address * 2) OF cell]] IN restart_file_seq_p;                             
        IF skip_pp_data_p = NIL THEN                                                                          
          osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);                        
          EXIT /file_opened/;  {---->                                                                         
        IFEND;                                                                                                
      IFEND;                                                                                                  
                                                                                                              
      { Retrieve a pointer to the pp memory data on the restart file.                                         
                                                                                                              
      NEXT restart_file_buffer_p: [[REP words * 2 OF cell]] IN restart_file_seq_p;                            
      IF restart_file_buffer_p = NIL THEN                                                                     
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);                          
        EXIT /file_opened/;  {---->                                                                           
      IFEND;                                                                                                  
      RESET restart_file_buffer_p;                                                                            
                                                                                                              
      { Retrieve a pointer to the output file for the pp memory data.                                         
                                                                                                              
      NEXT file_buffer_p: [[REP words * 2 OF cell]] IN file_pointer.sequence_pointer;                         
      IF file_buffer_p = NIL THEN                                                                             
        osp$set_status_abnormal (duc$dump_analyzer_id, due$nil_pointer, '', status);                          
        EXIT /file_opened/;  {---->                                                                           
      IFEND;                                                                                                  
      RESET file_buffer_p;                                                                                    
                                                                                                              
      { Copy the pp memory data from the restart file to the output file.                                     
                                                                                                              
      file_buffer_p^ := restart_file_buffer_p^;                                                               
      amp$set_segment_eoi (file_identifier, file_pointer, status);                                            
    END /file_opened/;                                                                                        
                                                                                                              
    IF output_file_opened THEN                                                                                
      fsp$close_file (file_identifier, ignore_status);                                                        
    IFEND;                                                                                                    
    osp$disestablish_cond_handler;                                                                            
                                                                                                              
  PROCEND dup$copy_pp_memory_command;                                                                         
MODEND dum$copy_pp_memory_command;                                                                            
