?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Dump Analyzer : Copy Buffer Controlware Command' ??
MODULE dum$copy_buffer_controlware;

{ PURPOSE:
{   This module contains the code for the copy_buffer_controlware 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 clp$evaluate_parameters
*copyc dup$retrieve_bc_entry
*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_buffer_controlware', EJECT ??

{ PURPOSE:
{   This procedure copies the buffer controlware to an output file.

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

{ PROCEDURE copy_buffer_controlware, copbc (
{   channel_number, cn: integer 0..33 = $required
{   file, f: file = $required
{   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,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 2, 11, 10, 54, 506],
    clc$command, 5, 3, 2, 0, 0, 0, 3, ''], [
    ['CHANNEL_NUMBER                 ',clc$nominal_entry, 1],
    ['CN                             ',clc$abbreviation_entry, 1],
    ['F                              ',clc$abbreviation_entry, 2],
    ['FILE                           ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [1, 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
    [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$integer_type], [0, 33, 10]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$channel_number = 1,
      p$file = 2,
      p$status = 3;

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

    VAR
      cell_p: ^cell,
      channel: 0 .. duc$de_maximum_channels,
      entry_p: ^dut$de_buffer_controlware_entry,
      fa_p: ^fst$attachment_options,
      file_buffer_p: ^SEQ ( * ),
      file_identifier: amt$file_identifier,
      file_pointer: amt$segment_pointer,
      ignore_status: ost$status,
      mca_p: ^fst$file_cycle_attributes,
      restart_file_buffer_p: ^SEQ ( * ),
      restart_file_seq_p: ^SEQ ( * );

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

      fsp$close_file (file_identifier, ignore_status);

    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;

    channel := pvt [p$channel_number].value^.integer_value.value;
    dup$retrieve_bc_entry (channel, entry_p);
    IF entry_p = NIL THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$data_not_on_dump,
            'The buffer controlware for channel', status);
      osp$append_status_integer (osc$status_parameter_delimiter, channel, 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'is', status);
      RETURN;  {---->
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

    { 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];

    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$file].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
      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 pointer to the buffer controlware data in the restart file.

      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;
      NEXT restart_file_buffer_p: [[REP entry_p^.words OF dut$de_buffer_controlware_word]] 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 buffer controlware data.

      NEXT file_buffer_p: [[REP entry_p^.words OF dut$de_buffer_controlware_word]] 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 buffer controlware 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/;

    fsp$close_file (file_identifier, ignore_status);
    osp$disestablish_cond_handler;

  PROCEND dup$copy_buffer_controlware;
MODEND dum$copy_buffer_controlware;
