?? RIGHT := 110 ??
MODULE ram$add_correction;
*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc rac$status_id
*copyc rae$error_messages
*copyc rat$correction_package_header
*copyc rat$correction_package
*copyc rav$elements
*copyc rav$correction_package_header
*copyc rav$corp
*copyc amp$get_segment_pointer
*copyc amp$set_segment_eoi
*copyc clp$scan_parameter_list
*copyc clp$get_value
*copyc clp$get_set_count
*copyc clp$get_path_description
*copyc fsp$open_file
*copyc fsp$close_file
*copyc osp$set_status_abnormal
*copyc rap$issue_message
*copyc rap$merge_correctors
*copyc rap$move_correction
?? POP ??

{ pdt add_pdt (
{   correction_package, cp: file = $required
{   element, elements, e: list of name
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    add_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^add_pdt_names, ^add_pdt_params];

  VAR
    add_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of clt$parameter_name_descriptor
      := [['CORRECTION_PACKAGE', 1], ['CP', 1], ['ELEMENT', 2], ['ELEMENTS', 2], ['E', 2], ['STATUS', 3]];

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

{ CORRECTION_PACKAGE CP }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ ELEMENT ELEMENTS E }
    [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1,
      osc$max_name_size]],

{ 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_correction

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

    VAR
      add_correction_elements: ^rat$correction_package,
      add_fid: amt$file_identifier,
      add_package: ^SEQ ( * ),
      add_package_applier: ^SEQ ( * ),
      add_package_header: ^rat$correction_package_header,
      add_package_lfn: amt$local_file_name,
      add_seg: amt$segment_pointer,
      applier: amt$segment_pointer,
      applier_fid: amt$file_identifier,
      applier_file: ^SEQ ( * ),
      applier_lfn: amt$local_file_name,
      attribute: array [1 .. 1] of fst$file_cycle_attribute,
      cp_path: clt$path_name,
      cycle_sel: clt$cycle_selector,
      element_list: ^array [1 .. * ] of ost$name,
      file_ref: clt$file_reference,
      found: boolean,
      hi: rat$element_index,
      i: rat$element_index,
      ignore_status: ost$status,
      j: rat$element_index,
      k: rat$element_index,
      l: rat$element_index,
      low: rat$element_index,
      message_status: ost$status,
      mid: rat$element_index,
      number: 0 .. clc$max_value_sets,
      open_p: clt$open_position,
      os_elements: ^array [1 .. * ] of ost$name,
      output_lfn: [STATIC, READ] amt$local_file_name := '$OUTPUT',
      path: ^pft$path,
      path_container: clt$path_container,
      read_only_attachment: array [1 .. 2] of fst$attachment_option,
      temp: integer,
      temp_elements: ^array [1 .. * ] of ost$name,
      value: clt$value,
      write_attachment: array [1 .. 3] of fst$attachment_option;

    status.normal := TRUE;

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

    clp$get_value ('CORRECTION_PACKAGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    add_package_lfn := value.file.local_file_name;

    clp$get_path_description (value.file, file_ref, path_container, path, cycle_sel, open_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    cp_path := file_ref.path_name (1, file_ref.path_name_size);

    read_only_attachment [1].selector := fsc$access_and_share_modes;
    read_only_attachment [1].access_modes.selector := fsc$specific_access_modes;
    read_only_attachment [1].access_modes.value := $fst$file_access_options [fsc$read];
    read_only_attachment [1].share_modes.selector := fsc$determine_from_access_modes;
    read_only_attachment [2].selector := fsc$create_file;
    read_only_attachment [2].create_file := FALSE;

    fsp$open_file (add_package_lfn, amc$segment, ^read_only_attachment, NIL, NIL, NIL, NIL, add_fid,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (add_fid, amc$sequence_pointer, add_seg, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    add_package := add_seg.sequence_pointer;

    RESET add_package;
    NEXT add_package_header IN add_package;
    IF (add_package_header = NIL) OR (add_package_header^.identification <> rac$correction_package_id) THEN
      osp$set_status_abnormal (rac$status_id, rae$file_not_correction_package, cp_path, status);
      RETURN;
    IFEND;

    IF add_package_header^.version <> rac$correction_package_version THEN
      osp$set_status_abnormal (rac$status_id, rae$invalid_cp_version, cp_path, status);
      RETURN;
    IFEND;

    NEXT add_correction_elements: [1 .. add_package_header^.number_of_elements] IN add_package;
    IF add_correction_elements = NIL THEN
      osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, cp_path, status);
      RETURN;
    IFEND;

    clp$get_set_count ('ELEMENT', number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF number > 0 THEN
      k := 1;
      l := 1;
      ALLOCATE temp_elements: [1 .. number];
      FOR i := 1 TO number DO
        clp$get_value ('ELEMENT', i, 1, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF (value.name.value = 'OS') AND (k = 1) THEN
          ALLOCATE os_elements: [1 .. add_package_header^.number_of_elements];
          FOR j := 1 TO add_package_header^.number_of_elements DO
            IF add_correction_elements^ [j].class = rac$os THEN
              os_elements^ [k] := add_correction_elements^ [j].name;
              k := k + 1;
            IFEND;
          FOREND;
        ELSEIF (value.name.value <> 'OS') THEN
          temp_elements^ [l] := value.name.value;
          l := l + 1;
        IFEND;
      FOREND;
      number := l - 1 + k - 1;
      PUSH element_list: [1 .. number];
      FOR i := 1 TO l - 1 DO
        element_list^ [i] := temp_elements^ [i];
      FOREND;
      j := 1;
      FOR i := l TO (k - 2 + l) DO
        element_list^ [i] := os_elements^ [j];
        j := j + 1;
      FOREND;
      FREE temp_elements;
      IF k > 1 THEN
        FREE os_elements;
      IFEND;
    IFEND;

    IF number = 0 THEN
      FOR j := 1 TO add_package_header^.number_of_elements DO
        rap$merge_correctors (add_package, j, add_correction_elements, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
    ELSEIF number > 0 THEN

    /merge/
      FOR k := 1 TO number DO
        found := FALSE;
        hi := add_package_header^.number_of_elements;
        low := 1;
        WHILE (low <= hi) AND NOT found DO
          temp := low + hi;
          mid := temp DIV 2;
          IF element_list^ [k] = add_correction_elements^ [mid].name THEN
            found := TRUE;
          ELSEIF (element_list^ [k] < add_correction_elements^ [mid].name) THEN
            hi := mid - 1;
          ELSE
            low := mid + 1;
          IFEND;
        WHILEND;
        IF NOT found THEN
          osp$set_status_abnormal (rac$status_id, rae$element_not_found, element_list^ [k], message_status);
          rap$issue_message (output_lfn, message_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          CYCLE /merge/
        IFEND;
        rap$merge_correctors (add_package, mid, add_correction_elements, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND /merge/;
    IFEND;


    {  When an APPLIER is found on  the CORRECTION_PACKAGE you are   }
    { adding from, copy that APPLIER to $LOCAL.APPLIER.$EOI and put  }
    { out an informative message to the user.                        }

    IF add_package_header^.size_of_applier > 0 THEN

      osp$set_status_abnormal (rac$status_id, rae$applier_copied_to_lfn, cp_path, message_status);
      rap$issue_message (output_lfn, message_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      add_package_applier := #PTR (add_package_header^.applier, add_package^);
      RESET add_package TO add_package_applier;
      NEXT add_package_applier: [[REP add_package_header^.size_of_applier OF cell]] IN add_package;
      IF add_package_applier = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, cp_path, status);
        RETURN;
      IFEND;

      applier_lfn := 'APPLIER                        ';

      write_attachment [1].selector := fsc$access_and_share_modes;
      write_attachment [1].access_modes.selector := fsc$specific_access_modes;
      write_attachment [1].access_modes.value := $fst$file_access_options [fsc$read, fsc$append, fsc$modify];
      write_attachment [1].share_modes.selector := fsc$determine_from_access_modes;
      write_attachment [2].selector := fsc$create_file;
      write_attachment [2].create_file := TRUE;
      write_attachment [3].selector := fsc$open_position;
      write_attachment [3].open_position := amc$open_at_eoi;

      attribute [1].selector := fsc$record_type;
      attribute [1].record_type := amc$variable;

      fsp$open_file (applier_lfn, amc$segment, ^write_attachment, ^attribute, NIL, NIL, NIL, applier_fid,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    /copy_applier_to_lfn/
      BEGIN

        amp$get_segment_pointer (applier_fid, amc$sequence_pointer, applier, status);
        IF NOT status.normal THEN
          EXIT /copy_applier_to_lfn/;
        IFEND;

        NEXT applier_file: [[REP add_package_header^.size_of_applier OF cell]] IN applier.sequence_pointer;
        IF applier_file = NIL THEN
          osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, applier_lfn, status);
          EXIT /copy_applier_to_lfn/;
        IFEND;

        applier_file^ := add_package_applier^;

        amp$set_segment_eoi (applier_fid, applier, status);
        IF NOT status.normal THEN
          EXIT /copy_applier_to_lfn/;
        IFEND;

      END /copy_applier_to_lfn/;

      IF status.normal THEN
        fsp$close_file (applier_fid, status);
      ELSE
        fsp$close_file (applier_fid, ignore_status);
      IFEND;
    IFEND;

    IF status.normal THEN
      fsp$close_file (add_fid, status);
    ELSE
      fsp$close_file (add_fid, ignore_status);
    IFEND;

    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND rap$add_correction;
MODEND ram$add_correction;
