MODULE ram$alter_string;

*copyc clp$evaluate_parameters
*copyc clp$change_variable
*copyc clp$trimmed_string_size

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

{ PROCEDURE (ram$alts) alter_pdt (
{   alter_string_command, asc: string = $required
{   old_string, os: string = $required
{   new_string, ns: (VAR) string = $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,
          qualifier: clt$string_type_qualifier,
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type4: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 5, 16, 18, 5, 38, 887], clc$command, 7, 4, 3, 0, 0,
            1, 4, 'RAM$ALTS'], [['ALTER_STRING_COMMAND           ',
            clc$nominal_entry, 1], ['ASC                            ',
            clc$abbreviation_entry, 1], ['NEW_STRING                     ',
            clc$nominal_entry, 3], ['NS                             ',
            clc$abbreviation_entry, 3], ['OLD_STRING                     ',
            clc$nominal_entry, 2], ['OS                             ',
            clc$abbreviation_entry, 2], ['STATUS                         ',
            clc$nominal_entry, 4]], [
{ 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, 8,
            clc$required_parameter, 0, 0],
{ PARAMETER 2
      [5, 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 3
      [3, clc$normal_usage_entry, clc$non_secure_parameter,
            $clt$parameter_spec_methods [clc$specify_by_name,
            clc$specify_positionally], clc$pass_by_reference,
            clc$immediate_evaluation, clc$standard_parameter_checking, 8,
            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$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 3
      [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 4
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$alter_string_command = 1,
      p$old_string = 2,
      p$new_string = 3,
      p$status = 4;

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

    VAR
      alter_string: ost$string,
      alter_string_char: char,
      alter_string_index: integer,
      i: integer,
      new_string: ost$string,
      new_string_index: integer,
      new_string_value: ^clt$data_value,
      old_string: ost$string,
      old_string_index: integer;

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

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

    old_string.value := pvt [p$old_string].value^.string_value^;
    old_string.size := clp$trimmed_string_size (old_string.value);

    new_string.value := '';
    new_string.size := 0;
    alter_string_index := 1;
    old_string_index := 1;
    new_string_index := 1;

  /process_alter_command/
    WHILE alter_string_index <= alter_string.size DO

      CASE alter_string.value (alter_string_index) OF

      = ' ' =
        IF old_string_index <= old_string.size THEN {Retain character.
          new_string.value (new_string_index) :=
                old_string.value (old_string_index);
        ELSE
          new_string.value (new_string_index) := ' ';
        IFEND;
        new_string_index := new_string_index + 1;
        old_string_index := old_string_index + 1;
        alter_string_index := alter_string_index + 1;

      = '#' = {Skip character from old_string.
        old_string_index := old_string_index + 1;
        alter_string_index := alter_string_index + 1;

      = '&' = {Replace old_string character with space.
        new_string.value (new_string_index) := ' ';
        new_string_index := new_string_index + 1;
        old_string_index := old_string_index + 1;
        alter_string_index := alter_string_index + 1;

      = '!' = {Truncate old_string.
        old_string_index := old_string.size + 1;
        EXIT /process_alter_command/;

      = '^' = {Insert characters from alter_string until # or end.
        alter_string_index := alter_string_index + 1;
        WHILE (alter_string.value (alter_string_index) <> '#') AND
              (alter_string_index <= alter_string.size) DO
          new_string.value (new_string_index) :=
                alter_string.value (alter_string_index);
          new_string_index := new_string_index + 1;
          alter_string_index := alter_string_index + 1;
        WHILEND;
        alter_string_index := alter_string_index + 1;

      ELSE {Copy from alter_string.
        new_string.value (new_string_index) :=
              alter_string.value (alter_string_index);
        new_string_index := new_string_index + 1;
        old_string_index := old_string_index + 1;
        alter_string_index := alter_string_index + 1;
      CASEND;

    WHILEND /process_alter_command/;

    FOR i := old_string_index TO old_string.size DO
      new_string.value (new_string_index) := old_string.value (i);
      new_string_index := new_string_index + 1;
    FOREND;
    new_string.size := new_string_index - 1;

    PUSH new_string_value;
    new_string_value^.kind := clc$string;
    PUSH new_string_value^.string_value: [new_string.size];
    new_string_value^.string_value^ := new_string.value (1, new_string.size);
    clp$change_variable (pvt [p$new_string].variable^, new_string_value,
          status);

  PROCEND rap$alter_string;
MODEND ram$alter_string;
