MODULE ptm$extract_binary_log_entries;
?? RIGHT := 110 ??

{ Purpose:
{   Extract Binary Log entries from one Binary Log and write them into another.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pte$ecc_anabl_exceptions
*copyc bat$record_header_type
*copyc ost$halfword
*copyc ost$status
*copyc amp$set_segment_eoi
*copyc osp$append_status_file
*copyc osp$set_status_condition
?? POP ??
*copyc amp$get_segment_pointer
*copyc clp$count_list_elements
*copyc clp$evaluate_parameters
*copyc fsp$close_file
*copyc fsp$open_file
*copyc lgp$close_log_file
*copyc lgp$get_next_statistic
*copyc lgp$open_log_file
*copyc lgp$rewind_log_file
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

  TYPE
    t$statistics = array [1 .. * ] of t$statistic_range,
    t$statistic_range = record
      low_value: sft$statistic_code,
      high_value: sft$statistic_code,
    recend;

  TYPE
    t$log_files = array [1 .. * ] of t$log_file,
    t$log_file = record
      active_log: boolean,
      open: boolean,
      log_file_identifier: lgt$log_file_identifier,
      file_identifier: amt$file_identifier,
      segment_pointer: amt$segment_pointer,
      previous_header_fba: amt$file_byte_address,
      access_level: amt$access_level,
      log_file_name_p: ^fst$file_reference,
    recend;

?? OLDTITLE ??
?? NEWTITLE := 'p$close_files', EJECT ??

  PROCEDURE p$close_files
    (VAR input_log_files: t$log_files;
     VAR output_log_file: t$log_file;
     VAR status: ost$status);

    VAR
      i: integer;

{Input Files
    FOR i := 1 TO UPPERBOUND (input_log_files) DO
      IF input_log_files [i].open THEN
        input_log_files [i].open := FALSE;
        lgp$close_log_file (input_log_files [i].log_file_identifier, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;
    FOREND;

{Output Files
    IF output_log_file.open THEN
      output_log_file.open := FALSE;
      amp$set_segment_eoi (output_log_file.file_identifier, output_log_file.segment_pointer, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      fsp$close_file (output_log_file.file_identifier, status);
    IFEND;

  PROCEND p$close_files;
?? OLDTITLE ??
?? NEWTITLE := 'p$evaluate_statistics', EJECT ??

  PROCEDURE p$evaluate_statistics
    (    data_value_p: ^clt$data_value;
     VAR statistics: t$statistics);

    VAR
      high_value: sft$statistic_code,
      i: integer,
      low_value: sft$statistic_code,
      value_p: ^clt$data_value;

    i := 0;
    value_p := data_value_p;
    WHILE (value_p <> NIL) AND (value_p^.kind = clc$list) DO
      IF value_p^.element_value <> NIL THEN
        i := i + 1;
        low_value := value_p^.element_value^.low_value^.statistic_code_value;
        high_value := value_p^.element_value^.high_value^.statistic_code_value;
        IF high_value >= low_value THEN
          statistics [i].high_value := high_value;
          statistics [i].low_value := low_value;
        ELSE
          statistics [i].high_value := low_value;
          statistics [i].low_value := high_value;
        IFEND;
      IFEND;

      value_p := value_p^.link;
    WHILEND;

  PROCEND p$evaluate_statistics;
?? OLDTITLE ??
?? NEWTITLE := 'p$extract_binary_log_entries', EJECT ??

  PROCEDURE p$extract_binary_log_entries
    (    include_statistics_p: ^t$statistics;
         exclude_statistics_p: ^t$statistics;
     VAR input_log_files: t$log_files;
     VAR output_log_file: t$log_file;
     VAR status: ost$status);

    VAR
      i: integer;

?? NEWTITLE := 'p$extract_entries_from_log', EJECT ??

    PROCEDURE p$extract_binary_log_entries
      (    include_statistics_p: ^t$statistics;
           exclude_statistics_p: ^t$statistics;
       VAR input_log: t$log_file;
       VAR output_log_file: t$log_file;
       VAR status: ost$status);

      VAR
        buffer: sft$statistic_buffer,
        counters_p: sft$counters,
        descriptive_data_p: ^sft$descriptive_data,
        statistic_header_p: ^sft$statistic_header;

?? NEWTITLE := '[inline] F$STATISTIC_SELECTED', EJECT ??

      FUNCTION [INLINE] f$statistic_selected
        (    statistic_code: sft$statistic_code;
             include_statistics_p: ^t$statistics;
             exclude_statistics_p: ^t$statistics): boolean;

        VAR
          i: integer,
          included: boolean,
          excluded: boolean;

        included := TRUE;
        IF include_statistics_p <> NIL THEN
          included := FALSE;

        /scan_included_statistics/
          FOR i := 1 TO UPPERBOUND (include_statistics_p^) DO
            IF (statistic_code >= include_statistics_p^ [i].low_value) AND
                  (statistic_code <= include_statistics_p^ [i].high_value) THEN
              included := TRUE;
              EXIT /scan_included_statistics/; {----->
            IFEND;
          FOREND /scan_included_statistics/;
        IFEND;

        excluded := FALSE;
        IF exclude_statistics_p <> NIL THEN

        /scan_excluded_statistics/
          FOR i := 1 TO UPPERBOUND (exclude_statistics_p^) DO
            IF (statistic_code >= exclude_statistics_p^ [i].low_value) AND
                  (statistic_code <= exclude_statistics_p^ [i].high_value) THEN
              excluded := TRUE;
              EXIT /scan_excluded_statistics/; {----->
            IFEND;
          FOREND /scan_excluded_statistics/;
        IFEND;

        f$statistic_selected := included AND (NOT excluded);

      FUNCEND f$statistic_selected;
?? OLDTITLE ??
?? EJECT ??
      lgp$rewind_log_file (input_log.log_file_identifier, status);
      IF NOT status.normal THEN
        status.normal := status.condition = lge$end_of_log;
        RETURN; {----->
      IFEND;

      lgp$get_next_statistic (input_log.log_file_identifier, ^buffer, statistic_header_p, counters_p,
            descriptive_data_p, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      WHILE statistic_header_p <> NIL DO
        IF f$statistic_selected (statistic_header_p^.statistic_code, include_statistics_p,
              exclude_statistics_p) THEN
          p$put_statistic_record (statistic_header_p, counters_p, descriptive_data_p, output_log_file,
                status);
{       write_statistic^ (statistic_header_p, counters_p, descriptive_data_p, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

        lgp$get_next_statistic (input_log.log_file_identifier, ^buffer, statistic_header_p, counters_p,
              descriptive_data_p, status);
        IF NOT status.normal THEN
          status.normal := status.condition = lge$end_of_log;
          RETURN; {----->
        IFEND;
      WHILEND;

    PROCEND p$extract_binary_log_entries;
?? OLDTITLE ??
?? EJECT ??

    FOR i := 1 TO UPPERBOUND (input_log_files) DO
      p$extract_binary_log_entries (include_statistics_p, exclude_statistics_p, input_log_files [i],
            output_log_file, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    FOREND;

  PROCEND p$extract_binary_log_entries;
?? OLDTITLE ??
?? NEWTITLE := 'p$open_files', EJECT ??

  PROCEDURE p$open_files
    (VAR input_log_files: t$log_files;
     VAR output_log_file: t$log_file;
     VAR status: ost$status);

    VAR
      i: integer;

{Input Files
    FOR i := 1 TO UPPERBOUND (input_log_files) DO
      p$open_log_file (FALSE, input_log_files [i], status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      input_log_files [i].open := TRUE;
    FOREND;

{Output Files
    p$open_log_file (TRUE, output_log_file, status);
    output_log_file.open := status.normal;
{} output_log_file.previous_header_fba := 0;

  PROCEND p$open_files;
?? OLDTITLE ??
?? NEWTITLE := 'p$open_log_file', EJECT ??

{ PURPOSE:
{   The purpose of this request is to open input or output log files for the generate_log, generate_report and
{ display_logged_statistics commands.
{
{ DESIGN
{   If read mode is selected, the logging interfaces will be used to read the log.

  PROCEDURE p$open_log_file
    (    write_mode: boolean;
     VAR log: {input/output} t$log_file;
     VAR status: ost$status);

    VAR
      v$log_file_attributes: [STATIC, READ] array [1 .. 2] of fst$file_cycle_attribute :=
            [[fsc$record_type, amc$variable], [fsc$file_contents_and_processor, fsc$binary_log,
            osc$null_name]];

    VAR

{ The read access mode for output file is temporary until PSR NV0Q772 is answered.  Until then,
{   the open_file needs read access in order to open the file at EOI and get the previous header
{   file byte address.

      v$write_attachment_option: [STATIC, READ] array [1 .. 7] of fst$attachment_option := [
            {} [fsc$access_and_share_modes, [fsc$specific_access_modes,
            [fsc$read, fsc$shorten, fsc$append, fsc$modify]], [fsc$determine_from_access_modes]],
            {} [fsc$create_file, TRUE],
            {} [fsc$open_share_modes, []],
            {} [fsc$delete_data, TRUE],
            {} [fsc$error_exit_procedure, NIL],
            {} [fsc$free_behind, TRUE],
            {} [fsc$sequential_access, TRUE]];

    status.normal := TRUE;

    IF write_mode THEN
      fsp$open_file (log.log_file_name_p^, amc$segment, {attachment options=} ^v$write_attachment_option,
            {default creation attributes=} ^v$log_file_attributes,
            {mandated creation attributes=} ^v$log_file_attributes,
            {attribute validation=} ^v$log_file_attributes, {attribute override=} NIL, log.file_identifier,
            status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      log.access_level := amc$segment;
      log.active_log := FALSE;
      log.log_file_identifier := osc$null_name;

      amp$get_segment_pointer (log.file_identifier, amc$sequence_pointer, log.segment_pointer, status);
    ELSE
      lgp$open_log_file (log.log_file_name_p^, log.active_log, log.log_file_identifier, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      log.access_level := amc$record;
    IFEND;

  PROCEND p$open_log_file;
?? OLDTITLE ??
?? NEWTITLE := 'p$put_statistic_record', EJECT ??

  PROCEDURE [INLINE] p$put_statistic_record
    (    statistic_header_p: ^sft$statistic_header;
         counters_p: sft$counters;
         descriptive_data_p: ^sft$descriptive_data;
     VAR output_log: t$log_file;
     VAR status: ost$status);

    VAR
      counters_out_p: sft$counters,
      descriptive_data_out_p: ^sft$descriptive_data,
      log_header_out_p: ^bat$record_header,
      statistic_header_out_p: ^sft$statistic_header;

    status.normal := TRUE;

    NEXT log_header_out_p IN output_log.segment_pointer.sequence_pointer;
    IF log_header_out_p = NIL THEN
      osp$set_status_condition (pte$unexpected_end_of_file, status);
      osp$append_status_file (osc$status_parameter_delimiter, output_log.log_file_name_p^, status);
      RETURN; {----->
    IFEND;
    log_header_out_p^.header_type := bac$full_record;
    log_header_out_p^.length := #SIZE (sft$statistic_header) + statistic_header_p^.number_of_counters *
          #SIZE (sft$counter) + statistic_header_p^.descriptive_data_size;
    log_header_out_p^.previous_header_fba := output_log.previous_header_fba;
    log_header_out_p^.unique_id := bac$record_header_unique_id;
    output_log.previous_header_fba := #OFFSET (log_header_out_p);

    NEXT statistic_header_out_p IN output_log.segment_pointer.sequence_pointer;
    IF statistic_header_p = NIL THEN
      osp$set_status_condition (pte$unexpected_end_of_file, status);
      osp$append_status_file (osc$status_parameter_delimiter, output_log.log_file_name_p^, status);
      RETURN; {----->
    IFEND;
    statistic_header_out_p^ := statistic_header_p^;

    IF statistic_header_p^.number_of_counters > 0 THEN
      NEXT counters_out_p: [1 .. statistic_header_p^.number_of_counters] IN
            output_log.segment_pointer.sequence_pointer;
      IF counters_out_p = NIL THEN
        osp$set_status_condition (pte$unexpected_end_of_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, output_log.log_file_name_p^, status);
        RETURN; {----->
      IFEND;
      counters_out_p^ := counters_p^;
    IFEND;

    IF statistic_header_p^.descriptive_data_size > 0 THEN
      NEXT descriptive_data_out_p: [statistic_header_p^.descriptive_data_size] IN
            output_log.segment_pointer.sequence_pointer;
      IF descriptive_data_out_p = NIL THEN
        osp$set_status_condition (pte$unexpected_end_of_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, output_log.log_file_name_p^, status);
        RETURN; {----->
      IFEND;
      descriptive_data_out_p^ := descriptive_data_p^;
    IFEND;

{   ptv$end_of_segment := output_log.segment_pointer;

  PROCEND p$put_statistic_record;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] PTP$_EXTRACT_BINARY_LOG_ENTRIES', EJECT ??

  PROCEDURE [XDCL] ptp$_extract_binary_log_entries
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE extract_binary_log_entries (
{   input, i: list of file = $required
{   output, o: file = $required
{   output_format, of: key
{       (binary, b)
{       (list, l)
{       (legible_data, ld)
{     keyend = binary
{   include_statistics, include_statistic, is: any of
{       key
{         all
{       keyend
{       list of range of statistic_code
{     anyend = all
{   exclude_statistics, exclude_statistic, es: any of
{       key
{         none
{       keyend
{       list of range of statistic_code
{     anyend = none
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      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 .. 6] of clt$keyword_specification,
        default_value: string (6),
      recend,
      type4: 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$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$range_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
            recend,
          recend,
        recend,
        default_value: string (3),
      recend,
      type5: 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$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$range_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
            recend,
          recend,
        recend,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [103, 3, 6, 15, 54, 51, 127],
    clc$command, 13, 6, 2, 0, 0, 0, 6, ''], [
    ['ES                             ',clc$abbreviation_entry, 5],
    ['EXCLUDE_STATISTIC              ',clc$alias_entry, 5],
    ['EXCLUDE_STATISTICS             ',clc$nominal_entry, 5],
    ['I                              ',clc$abbreviation_entry, 1],
    ['INCLUDE_STATISTIC              ',clc$alias_entry, 4],
    ['INCLUDE_STATISTICS             ',clc$nominal_entry, 4],
    ['INPUT                          ',clc$nominal_entry, 1],
    ['IS                             ',clc$abbreviation_entry, 4],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OF                             ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['OUTPUT_FORMAT                  ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [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, 19, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [11, 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
    [12, 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, 229,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [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, 90,
  clc$optional_default_parameter, 0, 3],
{ 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, 90,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [13, 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$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [6], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BINARY                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['L                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['LD                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['LEGIBLE_DATA                   ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['LIST                           ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'binary'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    26, [[1, 0, clc$list_type], [10, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$range_type], [3],
          [[1, 0, clc$statistic_code_type]]
        ]
      ]
    ,
    'all'],
{ PARAMETER 5
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    26, [[1, 0, clc$list_type], [10, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$range_type], [3],
          [[1, 0, clc$statistic_code_type]]
        ]
      ]
    ,
    'none'],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$input = 1,
      p$output = 2,
      p$output_format = 3,
      p$include_statistics = 4,
      p$exclude_statistics = 5,
      p$status = 6;

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

    VAR
      count: integer,
      data_value_p: ^clt$data_value,
      exclude_statistics_p: ^t$statistics,
      i: integer,
      include_statistics_p: ^t$statistics,
      input_log_files_p: ^t$log_files,
      output_log_file: t$log_file,
      status_p: ^ost$status;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{Evaluate Input
    count := clp$count_list_elements (pvt [p$input].value);
    PUSH input_log_files_p: [1 .. count];
    data_value_p := pvt [p$input].value;
    i := 0;
    WHILE (data_value_p <> NIL) AND (data_value_p^.kind = clc$list) DO
      IF data_value_p^.element_value <> NIL THEN
        i := i + 1;
        input_log_files_p^ [i].open := FALSE;
        input_log_files_p^ [i].log_file_name_p := data_value_p^.element_value^.file_value;
      IFEND;

      data_value_p := data_value_p^.link;
    WHILEND;

{Evaluate Output
    output_log_file.log_file_name_p := pvt [p$output].value^.file_value;
    output_log_file.open := FALSE;

{Include Statistics
    IF pvt [p$include_statistics].value^.kind = clc$keyword THEN
      include_statistics_p := NIL;
    ELSE
      count := clp$count_list_elements (pvt [p$include_statistics].value);
      PUSH include_statistics_p: [1 .. count];
      p$evaluate_statistics (pvt [p$include_statistics].value, include_statistics_p^);
    IFEND;

{Exclude Statistics
    IF pvt [p$exclude_statistics].value^.kind = clc$keyword THEN
      exclude_statistics_p := NIL;
    ELSE
      count := clp$count_list_elements (pvt [p$exclude_statistics].value);
      PUSH exclude_statistics_p: [1 .. count];
      p$evaluate_statistics (pvt [p$exclude_statistics].value, exclude_statistics_p^);
    IFEND;

    p$open_files (input_log_files_p^, output_log_file, status);
    IF NOT status.normal THEN
      PUSH status_p;
      p$close_files (input_log_files_p^, output_log_file, status_p^);
      RETURN; {----->
    IFEND;

    p$extract_binary_log_entries (include_statistics_p, exclude_statistics_p, input_log_files_p^,
          output_log_file, status);
    IF status.normal THEN
      status_p := ^status;
    ELSE
      PUSH status_p;
    IFEND;

    p$close_files (input_log_files_p^, output_log_file, status_p^);

  PROCEND ptp$_extract_binary_log_entries;
?? OLDTITLE ??
MODEND ptm$extract_binary_log_entries;
