MODULE ram$alter_file;

*copyc amp$get_next
*copyc amp$put_next
*copyc clp$evaluate_parameters
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file

  PROGRAM rap$alter_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE (ram$altf) alter_pdt (
{   alter_command, ac: string = $required
{   input, i: file = $required
{   output, o: file = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 5, 16, 17, 54, 19, 270],
    clc$command, 7, 4, 3, 0, 0, 0, 4, 'RAM$ALTF'], [
    ['AC                             ',clc$abbreviation_entry, 1],
    ['ALTER_COMMAND                  ',clc$nominal_entry, 1],
    ['I                              ',clc$abbreviation_entry, 2],
    ['INPUT                          ',clc$nominal_entry, 2],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [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, 8, 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
    [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, 3, clc$required_parameter, 0, 0],
{ PARAMETER 4
    [7, 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$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$file_type]],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$alter_command = 1,
    p$input = 2,
    p$output = 3,
    p$status = 4;

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

    TYPE
      work_files = (input_file, output_file);

    VAR
      alter_command: ost$string,
      file: work_files,
      file_identifier: array [work_files] of amt$file_identifier,
      ignore_byte_address: amt$file_byte_address,
      input_line: ost$string,
      local_status: ost$status,
      output_line: ost$string,
      position_of_file: amt$file_position,
      transfer_count: amt$transfer_count;

    PROCEDURE alter_line
      (    alter_command: ost$string,
           old_string: ost$string;
       VAR new_string: ost$string);

      VAR
        alter_command_char: char,
        alter_command_pos: 0 .. 256,
        old_string_pos: 0 .. 256,
        old_string_pos_prev: 0 .. 256;


      PROCEDURE [INLINE] get_char;

        alter_command_char := alter_command.value (old_string_pos);
        old_string_pos := old_string_pos + 1;
      PROCEND get_char;

      alter_command_pos := 1;
      old_string_pos := 1;
      IF old_string.size = 0 THEN
        new_string.value := ' ';
      ELSE
        new_string.value := old_string.value;
      IFEND;

    /process_alter_command/
      WHILE old_string_pos <= alter_command.size DO
        get_char;

        CASE alter_command_char OF
        = ' ' =
          alter_command_pos := alter_command_pos + 1;

        = '&' =
          new_string.value (alter_command_pos) := ' ';
          alter_command_pos := alter_command_pos + 1;

        = '#' =
          IF old_string_pos <= old_string.size THEN
            new_string.value (alter_command_pos, * ) :=
                  old_string.value (old_string_pos, * );
          IFEND;

        = '^' =
          old_string_pos_prev := old_string_pos - 1;
          get_char;
          WHILE alter_command_char <> '#' DO
            new_string.value (alter_command_pos) := alter_command_char;
            alter_command_pos := alter_command_pos + 1;
            get_char;
          WHILEND;
          IF old_string_pos_prev <= old_string.size THEN
            new_string.value (alter_command_pos, * ) :=
                  old_string.value (old_string_pos_prev, * );
          IFEND;
          alter_command_pos := alter_command_pos + old_string_pos -
                old_string_pos_prev;

        = '!' =
          EXIT /process_alter_command/;

        ELSE
          new_string.value (alter_command_pos) := alter_command_char;
          alter_command_pos := alter_command_pos + 1;
        CASEND;

      WHILEND /process_alter_command/;

      alter_command_pos := alter_command_pos - 1;
      IF (alter_command.size < old_string.size) AND
            (alter_command_char <> '!') THEN
        alter_command_pos := alter_command_pos + old_string.size -
              alter_command.size;
      IFEND;
{Trim trailing blanks.
      WHILE (alter_command_pos > 0) AND (new_string.value (alter_command_pos) =
            ' ') DO
        alter_command_pos := alter_command_pos - 1;
      WHILEND;

      new_string.size := alter_command_pos;
    PROCEND alter_line;

    PROCEDURE open_files
      (VAR local_status: ost$status);

      VAR
        file_attachment: array [1 .. 3] of fst$attachment_option;

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

      fsp$open_file (pvt [p$input].value^.file_value^, amc$record,
            ^file_attachment, NIL, NIL, NIL, NIL, file_identifier [input_file],
            local_status);
      IF NOT local_status.normal THEN
        RETURN;
      IFEND;

      file_attachment [1].selector := fsc$access_and_share_modes;
      file_attachment [1].access_modes.selector := fsc$specific_access_modes;
      file_attachment [1].access_modes.value :=
            $fst$file_access_options [fsc$append, fsc$shorten];
      file_attachment [1].share_modes.selector := fsc$specific_share_modes;
      file_attachment [1].share_modes.value := $fst$file_access_options [];
      file_attachment [2].selector := fsc$access_and_share_modes;
      file_attachment [2].access_modes.selector := fsc$specific_access_modes;
      file_attachment [2].access_modes.value :=
            $fst$file_access_options [fsc$append];
      file_attachment [2].share_modes.selector := fsc$specific_share_modes;
      file_attachment [2].share_modes.value := $fst$file_access_options [];
      file_attachment [3].selector := fsc$open_share_modes;
      file_attachment [3].open_share_modes := -$fst$file_access_options [];

      fsp$open_file (pvt [p$output].value^.file_value^, amc$record,
            ^file_attachment, NIL, NIL, NIL, NIL,
            file_identifier [output_file], local_status);
      IF NOT local_status.normal THEN
        fsp$close_file (file_identifier [input_file], local_status);
        RETURN;
      IFEND;
    PROCEND open_files;

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

    alter_command.value := pvt [p$alter_command].value^.string_value^;
    alter_command.size := clp$trimmed_string_size (alter_command.value);
    alter_command.value (alter_command.size + 1) := '#';

    open_files (local_status);
    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;

  /process_input_file/
    WHILE TRUE DO

      input_line.value := ' ';
      amp$get_next (file_identifier [input_file], ^input_line.value,
            osc$max_string_size, transfer_count, ignore_byte_address,
            position_of_file, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF position_of_file = amc$eoi THEN
        EXIT /process_input_file/;
      IFEND;
      input_line.size := transfer_count;
      alter_line (alter_command, input_line, output_line);
      amp$put_next (file_identifier [output_file],
            ^output_line.value (1, output_line.size), output_line.size,
            ignore_byte_address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    WHILEND /process_input_file/;

    FOR file := LOWERVALUE (file) TO UPPERVALUE (file) DO
      fsp$close_file (file_identifier [file], local_status);
      IF (NOT local_status.normal) AND status.normal THEN
        status := local_status;
      IFEND;
    FOREND;
  PROCEND rap$alter_file;
MODEND ram$alter_file;
