?? RIGHT := 110 ??
MODULE ram$add_psrs;
*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc rac$correction_constants
*copyc rac$status_id
*copyc rae$error_messages
*copyc rav$corp
*copyc rav$correction_package_header
*copyc rav$elements
*copyc rat$psr_info
*copyc rat$correction_package
*copyc clp$scan_parameter_list
*copyc clp$get_value
*copyc amp$open
*copyc amp$close
*copyc amp$get_next
*copyc osp$set_status_abnormal
*copyc rap$issue_message
*copyc rap$get_corrector_element
?? POP ??

{ pdt add_psrs_pdt (
{   psr_info, pi: file = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    add_psrs_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^add_psrs_pdt_names,
      ^add_psrs_pdt_params];

  VAR
    add_psrs_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['PSR_INFO', 1], ['PI', 1], ['STATUS', 2]];

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

{ PSR_INFO PI }
    [[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 ??

*copyc rah$add_psrs

  PROCEDURE [XDCL] rap$add_psrs (parameter_list: clt$parameter_list;
    VAR status: ost$status);

    VAR
      access_sel: amt$file_access_selections,
      byte_address: amt$file_byte_address,
      done: boolean,
      file_p: amt$file_position,
      found: boolean,
      i: rat$element_index,
      interchange: boolean,
      input_line: string (256),
      j: rat$element_index,
      k: rat$element_index,
      l: rat$element_index,
      m: rat$element_index,
      message_status: ost$status,
      number: rat$element_index,
      old_psr_info: ^array [1 .. * ] of rat$psr_ident,
      old_psrs: ^array [1 .. * ] of rat$psr_ident,
      ordinal: 0 .. 255,
      output_lfn: [STATIC] amt$local_file_name := '$OUTPUT',
      pass: rat$element_index,
      psr: ^array [1 .. * ] of rat$psr_ident,
      psr_fid: amt$file_identifier,
      psr_info: ^array [1 .. * ] of rat$psr_info,
      psr_info_length: rat$element_index,
      start: rat$element_index,
      temp: rat$psr_info,
      tran_count: amt$transfer_count,
      value: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, add_psrs_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('PSR_INFO', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH access_sel: [1 .. 1];
    access_sel^ [1].key := amc$access_mode;
    access_sel^ [1].access_mode := $pft$usage_selections [pfc$read];
    amp$open (value.file.local_file_name, amc$record, access_sel, psr_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    psr_info_length := 0;
    done := FALSE;
    PUSH psr_info: [1 .. rac$max_psrs];
    WHILE NOT done DO
      input_line := ' ';
      amp$get_next (psr_fid, ^input_line, #SIZE (input_line), tran_count, byte_address, file_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF file_p = amc$eoi THEN
        done := TRUE;
      IFEND;
      FOR i := 1 TO 39 DO
        IF ($INTEGER (input_line (i, 1)) >= 97) AND ($INTEGER (input_line (i, 1)) <= 122) THEN
          ordinal := $INTEGER (input_line (i, 1)) - 32;
          input_line (i, 1) := $CHAR (ordinal);
        IFEND;
      FOREND;
      psr_info_length := psr_info_length + 1;
      psr_info^ [psr_info_length].ident := input_line (1, 8);
      psr_info^ [psr_info_length].element := input_line (9, 31);
    WHILEND;

    psr_info_length := psr_info_length - 1;

    interchange := TRUE;
    pass := 1;
    WHILE (pass <= psr_info_length - 1) AND interchange DO
      interchange := FALSE;
      FOR j := 1 TO (psr_info_length - pass) DO
        IF (psr_info^ [j].element > psr_info^ [j + 1].element) OR ((psr_info^ [j].element = psr_info^ [j + 1].
              element) AND (psr_info^ [j].ident > psr_info^ [j + 1].ident)) THEN
          interchange := TRUE;
          temp := psr_info^ [j];
          psr_info^ [j] := psr_info^ [j + 1];
          psr_info^ [j + 1] := temp;
        IFEND;
      FOREND;
      pass := pass + 1;
    WHILEND;

    i := 1;
    j := 1;
    WHILE i <= psr_info_length DO
      WHILE (i < psr_info_length) AND (psr_info^ [i] = psr_info^ [i + 1]) DO
        i := i + 1;
      WHILEND;
      psr_info^ [j] := psr_info^ [i];
      j := j + 1;
      i := i + 1;
    WHILEND;
    psr_info_length := j - 1;

    k := 1;
    i := 1;
    start := 1;

  /add_psrs_found/
    REPEAT
      i := i + 1;
      WHILE (i <= psr_info_length) AND (psr_info^ [i].element = psr_info^ [i - 1].element) DO
        i := i + 1;
      WHILEND;
      number := i - start;
      IF psr_info^ [start].element = 'OS' THEN
        j := 1;
        found := FALSE;
        WHILE (j <= rav$correction_package_header^.number_of_elements) AND NOT found DO
          IF rav$elements^ [j].class = rac$os THEN
            k := j;
            found := TRUE;
          IFEND;
          j := j + 1;
        WHILEND;
        IF NOT found THEN
          osp$set_status_abnormal (rac$status_id, rae$element_not_found, psr_info^ [start].element, status);
        IFEND;
      ELSE
        rap$get_corrector_element (psr_info^ [start].element, k, status);
      IFEND;
      IF NOT status.normal THEN
        IF status.condition = rae$element_not_found THEN
          message_status := status;
          rap$issue_message (output_lfn, message_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          start := start + number;
          CYCLE /add_psrs_found/;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      NEXT psr: [1 .. number] IN rav$corp.sequence_pointer;
      FOR j := 1 TO number DO
        psr^ [j] := psr_info^ [start].ident;
        start := start + 1;
      FOREND;

      IF rav$elements^ [k].number_of_psrs > 0 THEN
        old_psr_info := #PTR (rav$elements^ [k].psr_info, rav$corp.sequence_pointer^);
        j := 1;
        WHILE j <= rav$elements^ [k].number_of_psrs DO
          m := 1;
          found := FALSE;
          WHILE (m <= number) AND NOT found DO
            IF psr^ [m] = old_psr_info^ [j] THEN
              found := TRUE;
              FOR l := j + 1 TO rav$elements^ [k].number_of_psrs DO
                old_psr_info^ [l - 1] := old_psr_info^ [l];
              FOREND;
              rav$elements^ [k].number_of_psrs := rav$elements^ [k].number_of_psrs - 1;
            ELSE
              m := m + 1;
            IFEND;
          WHILEND;
          IF NOT found THEN
            j := j + 1;
          IFEND;
        WHILEND;
        IF rav$elements^ [k].number_of_psrs > 0 THEN
          NEXT old_psrs: [1 .. rav$elements^ [k].number_of_psrs] IN rav$corp.sequence_pointer;
          FOR m := 1 TO rav$elements^ [k].number_of_psrs DO
            old_psrs^ [m] := old_psr_info^ [m];
          FOREND;
        IFEND;
      IFEND;

      rav$elements^ [k].psr_info := #REL (psr, rav$corp.sequence_pointer^);
      rav$elements^ [k].number_of_psrs := rav$elements^ [k].number_of_psrs + number;

    UNTIL start > psr_info_length;
    amp$close (psr_fid, status);

  PROCEND rap$add_psrs;
MODEND ram$add_psrs;
