?? RIGHT := 110 ??
?? TITLE := 'PUM$EXTRACT_ERRORS_FROM_LISTING' ??
MODULE pum$extract_errors_from_listing;
?? PUSH (LISTEXT := ON) ??
*copyc ost$stack_frame_save_area
*copyc pmt$condition
*copyc pmt$condition_information
?? POP ??
*copyc amp$get_next
*copyc amp$put_next
*copyc amp$put_partial
*copyc clp$convert_file_ref_to_string
*copyc clp$convert_str_to_path_handle
*copyc clp$evaluate_parameters
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler

  VAR
    abort_conditions: [STATIC, READ] pmt$condition :=
          [pmc$condition_combination, [pmc$block_exit_processing, ifc$interactive_condition]];


?? TITLE := 'condition handler', EJECT ??
{ PURPOSE:
{   This procedure is a condition handler which will be executed in the event
{   of a pause break or a terminate break.

  PROCEDURE condition_handler
    (    condition: pmt$condition;
         condition_description: ^pmt$condition_information;
         save_area: ^ost$stack_frame_save_area;
     VAR cond_status: ost$status);

    pmp$continue_to_cause (pmc$execute_standard_procedure, cond_status);
  PROCEND condition_handler;
  PROCEDURE [XDCL, #GATE] pup$extract_errors_from_listing
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{   PROCEDURE (osm$extefl) extract_errors_from_listing, extefl (
{     backup_listing, bl: file = $required
{     output, o: file = $output
{     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,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 18, 13, 38, 39, 697],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'OSM$EXTEFL'], [
    ['BACKUP_LISTING                 ',clc$nominal_entry, 1],
    ['BL                             ',clc$abbreviation_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',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, 3, 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$optional_default_parameter, 0, 7],
{ 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$file_type]],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$backup_listing = 1,
      p$output = 2,
      p$status = 3;

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

    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      backup_file_path: fst$path,
      backup_file_path_size: fst$path_size,
      backup_path_handle_name: fst$path_handle_name,
      blank_string: [STATIC] string (132) :=
            '                                ' CAT
            '                                                                ' CAT
            '                                    ',
      byte_address: amt$file_byte_address,
      established_abort_handler: pmt$established_handler,
      evaluated_file_reference: fst$evaluated_file_reference,
      file_position: amt$file_position,
      input_line: string (132),
      listing_file_identifier: amt$file_identifier,
      local_status: ost$status,
      output_file_identifier: amt$file_identifier,
      output_file_path: fst$path,
      output_file_path_size: fst$path_size,
      output_path_handle_name: fst$path_handle_name,
      tranfer_count: amt$transfer_count;

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

    pmp$establish_condition_handler (abort_conditions, ^condition_handler, ^established_abort_handler,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /extract_errors/
    BEGIN
      clp$convert_str_to_path_handle (pvt [p$backup_listing].value^.file_value^, {delete_allowed} TRUE,
            {resolve_path} TRUE, {include_open_pos_in_handle} TRUE, backup_path_handle_name,
            evaluated_file_reference, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      clp$convert_file_ref_to_string (evaluated_file_reference, {include_open_position} TRUE,
            backup_file_path, backup_file_path_size, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      clp$convert_str_to_path_handle (pvt [p$output].value^.file_value^, {delete_allowed} TRUE,
            {resolve_path} TRUE, {include_open_pos_in_handle} TRUE, output_path_handle_name,
            evaluated_file_reference, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      clp$convert_file_ref_to_string (evaluated_file_reference, {include_open_position} TRUE,
            output_file_path, output_file_path_size, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      attachment_option [1].selector := fsc$access_and_share_modes;
      attachment_option [1].access_modes.selector := fsc$specific_access_modes;
      attachment_option [1].access_modes.value := $fst$file_access_options [fsc$read];
      attachment_option [1].share_modes.selector := fsc$specific_share_modes;
      attachment_option [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
      attachment_option [2].selector := fsc$create_file;
      attachment_option [2].create_file := FALSE;

      fsp$open_file (backup_file_path, amc$record, ^attachment_option, {default_creation_attributes} NIL,
            {mandated_creation_attributes} NIL, {attribute_validation} NIL, {attribute_override} NIL,
            listing_file_identifier, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      fsp$open_file (output_file_path, amc$record, {file_attachment} NIL, {default_creation_attributes} NIL,
            {mandated_creation_attributes} NIL, {attribute_validation} NIL, {attribute_override} NIL,
            output_file_identifier, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      input_line := blank_string;
      amp$get_next (listing_file_identifier, ^input_line, #SIZE (input_line), tranfer_count, byte_address,
            file_position, status);
      IF NOT status.normal THEN
        EXIT /extract_errors/;
      IFEND;

      WHILE file_position <> amc$eoi DO
        IF input_line (3, 7) = '--ERROR' THEN
          amp$put_partial (output_file_identifier, ^input_line, tranfer_count, byte_address, amc$start,
                status);
          IF NOT status.normal THEN
            EXIT /extract_errors/;
          IFEND;

          input_line := blank_string;
          amp$get_next (listing_file_identifier, ^input_line, #SIZE (input_line), tranfer_count,
                byte_address, file_position, status);
          IF NOT status.normal THEN
            EXIT /extract_errors/;
          IFEND;

          WHILE input_line (3) <> ' ' DO
            input_line := input_line(2, (#SIZE (input_line) - 1));
            amp$put_partial (output_file_identifier, ^input_line, tranfer_count - 1, byte_address,
                  amc$continue, status);
            IF NOT status.normal THEN
              EXIT /extract_errors/;
            IFEND;

            input_line := blank_string;
            amp$get_next (listing_file_identifier, ^input_line, #SIZE (input_line), tranfer_count,
                  byte_address, file_position, status);
            IF NOT status.normal THEN
              EXIT /extract_errors/;
            IFEND;
          WHILEND;
          amp$put_partial (output_file_identifier, NIL, 0, byte_address, amc$terminate, status);
          IF NOT status.normal THEN
            EXIT /extract_errors/;
          IFEND;

          input_line := blank_string;
          amp$put_next (output_file_identifier, ^input_line, tranfer_count, byte_address, status);
          IF NOT status.normal THEN
            EXIT /extract_errors/;
          IFEND;
        IFEND;

        input_line := blank_string;
        amp$get_next (listing_file_identifier, ^input_line, #SIZE (input_line), tranfer_count, byte_address,
              file_position, status);
        IF NOT status.normal THEN
          EXIT /extract_errors/;
        IFEND;
      WHILEND;
    END /extract_errors/;

    fsp$close_file (listing_file_identifier, local_status);
    IF status.normal THEN
      status := local_status;
    IFEND;
    fsp$close_file (output_file_identifier, local_status);
    IF status.normal THEN
      status := local_status;
    IFEND;

    pmp$disestablish_cond_handler (abort_conditions, local_status);
    IF status.normal THEN
      status := local_status;
    IFEND;
  PROCEND pup$extract_errors_from_listing;

MODEND pum$extract_errors_from_listing;
