
?? RIGHT := 110 ??
?? NEWTITLE := '  qcm$correct_v_file' , EJECT ??
MODULE qcm$correct_v_file;

{ Purpose:  This module contains the necessary code to correct
{           a file with a bad end-of-information.


*copyc amp$close
*copyc amp$get_next
*copyc amp$open
*copyc amp$put_next
*copyc amp$skip
*copyc clp$get_value
*copyc clp$scan_parameter_list


?? TITLE := '    qcp$correct_v_file', EJECT ??

  PROCEDURE [XDCL] qcp$correct_v_file (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ PDT fix_eoi_pdt (
{       file, f : file = $REQUIRED
{       status)

?? PUSH (LISTEXT := ON) ??

  VAR
    fix_eoi_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^fix_eoi_pdt_names,
      ^fix_eoi_pdt_params];

  VAR
    fix_eoi_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['FILE', 1], ['F', 1], ['STATUS', 2]];

  VAR
    fix_eoi_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ FILE F }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??

    CONST
      working_storage_area_size = 100000;

    VAR
      value: clt$value,
      working_storage_area: ^ SEQ ( * ),
      access_selections: amt$file_access_selections,
      transfer_count: amt$transfer_count,
      byte_address: amt$file_byte_address,
      file_position: amt$file_position,
      file_identifier: amt$file_identifier,
      ignore_status: ost$status;

    status.normal := true;
    ignore_status.normal := true;

    clp$scan_parameter_list (parameter_list, fix_eoi_pdt, status);
    if not status.normal then
      return;
    ifend;

    clp$get_value ('FILE', 1, 1, clc$low, value, status);
    if not status.normal then
      return;
    ifend;

    push working_storage_area: [[rep working_storage_area_size of cell]];

    push access_selections: [1 .. 2];
    access_selections^[1].key := amc$access_mode;
    access_selections^[1].access_mode := $pft$usage_selections [ pfc$shorten,pfc$append,pfc$read];
    access_selections^[2].key := amc$open_position;
    access_selections^[2].open_position := amc$open_at_boi;

    amp$open (value.file.local_file_name, amc$record, access_selections, file_identifier, status);
    if not status.normal then
      return;
    ifend;

    repeat
      amp$get_next (file_identifier, working_storage_area, working_storage_area_size, transfer_count,
                  byte_address, file_position, status);
    until not status.normal;

    if status.condition= ame$improper_record_header then
      status.normal := true;

      amp$skip (file_identifier, amc$backward, amc$skip_record, 1, file_position, status);
      if not status.normal then
        amp$close (file_identifier, ignore_status);
        return;
      ifend;

      amp$get_next (file_identifier, working_storage_area, working_storage_area_size, transfer_count,
                 byte_address, file_position, status);
      if not status.normal then
        amp$close (file_identifier, ignore_status);
        return;
      ifend;

      amp$skip (file_identifier, amc$backward, amc$skip_record, 1, file_position, status);
      if not status.normal then
        amp$close (file_identifier, ignore_status);
        return;
      ifend;

      amp$put_next (file_identifier, working_storage_area, transfer_count, byte_address, status);
      if not status.normal then
        amp$close (file_identifier, ignore_status);
        return;
      ifend;

      amp$close (file_identifier, status);
    else
      if status.condition = ame$input_after_eoi then
        status.normal := TRUE;
      ifend;
      amp$close (file_identifier, ignore_status);
    ifend;
  PROCEND qcp$correct_v_file;
MODEND qcm$correct_v_file;
