?? RIGHT := 110 ??
MODULE ram$add_applier;
*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$fetch_access_information
*copyc amp$get_segment_pointer
*copyc amp$set_segment_eoi
*copyc clp$scan_parameter_list
*copyc clp$get_path_description
*copyc clp$get_value
*copyc fsp$open_file
*copyc fsp$close_file
*copyc osp$set_status_abnormal
?? POP ??

*copyc rah$add_applier

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


{  pdt adda_pdt (
{    correction_package, cp: file = $required
{    applier, a: file = $required
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      adda_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^adda_pdt_names, ^adda_pdt_params];

    VAR
      adda_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
        clt$parameter_name_descriptor := [['CORRECTION_PACKAGE', 1], ['CP', 1], ['APPLIER', 2], ['A', 2], [
        'STATUS', 3]];

    VAR
      adda_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]],

{ APPLIER A }
      [[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 ??

    VAR
      applier: amt$segment_pointer,
      applier_fid: amt$file_identifier,
      applier_file: ^SEQ ( * ),
      applier_lfn: amt$local_file_name,
      applier_path: clt$path_name,
      correction_package: amt$segment_pointer,
      cycle_sel: clt$cycle_selector,
      end_of_cp: ^SEQ ( * ),
      file_ref: clt$file_reference,
      ignore_status: ost$status,
      message_status: ost$status,
      offset: array [1 .. 1] of amt$access_info,
      open_p: clt$open_position,
      package_applier: ^SEQ ( * ),
      package_fid: amt$file_identifier,
      package_header: ^rat$correction_package_header,
      package_lfn: amt$local_file_name,
      package_path: clt$path_name,
      path: ^pft$path,
      path_container: clt$path_container,
      read_only_attachment: array [1 .. 2] of fst$attachment_option,
      value: clt$value,
      write_attachment: array [1 .. 2] of fst$attachment_option;


    status.normal := TRUE;

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


    {  Open the CORRECTION_PACKAGE   for write segment access. }

    clp$get_value ('CORRECTION_PACKAGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    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;
    package_path := file_ref.path_name (1, file_ref.path_name_size);

    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 := FALSE;

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

  /add_applier_command/
    BEGIN


      {  Verify that the CORRECTION PACKAGE is a compatable version   }
      { and that an APPLIER is'nt already present.                    }

      amp$get_segment_pointer (package_fid, amc$sequence_pointer, correction_package, status);
      IF NOT status.normal THEN
        EXIT /add_applier_command/;
      IFEND;

      RESET correction_package.sequence_pointer;
      NEXT package_header IN correction_package.sequence_pointer;
      IF (package_header = NIL) OR (package_header^.identification <> rac$correction_package_id) THEN
        osp$set_status_abnormal (rac$status_id, rae$file_not_correction_package, package_path, status);
        EXIT /add_applier_command/;
      IFEND;

      IF package_header^.version <> rac$correction_package_version THEN
        osp$set_status_abnormal (rac$status_id, rae$invalid_cp_version, package_path, status);
        EXIT /add_applier_command/;
      IFEND;

      IF package_header^.size_of_applier > 0 THEN
        osp$set_status_abnormal (rac$status_id, rae$applier_already_exists, package_path, status);
        EXIT /add_applier_command/;
      IFEND;


      {  Open the APPLIER for read only segment access. }

      clp$get_value ('APPLIER', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /add_applier_command/;
      IFEND;
      applier_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;
      applier_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 (applier_lfn, amc$segment, ^read_only_attachment, NIL, NIL, NIL, NIL, applier_fid,
            status);
      IF NOT status.normal THEN
        EXIT /add_applier_command/;
      IFEND;

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

      RESET applier.sequence_pointer;

      package_header^.size_of_applier := #SIZE (applier.sequence_pointer^);
      NEXT applier_file: [[REP 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_path, status);
        EXIT /add_applier_command/;
      IFEND;


      {  Append the APPLIER to the end of the CORRECTION_PACKAGE and }
      { set the applier pointer in the header.                       }

      offset [1].key := amc$eoi_byte_address;

      amp$fetch_access_information (package_fid, offset, status);
      IF NOT status.normal THEN
        EXIT /add_applier_command/;
      IFEND;

      RESET correction_package.sequence_pointer;
      NEXT end_of_cp: [[REP offset [1].eoi_byte_address OF cell]] IN correction_package.
            sequence_pointer;
      IF end_of_cp = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, package_path, status);
        EXIT /add_applier_command/;
      IFEND;

      NEXT package_applier: [[REP package_header^.size_of_applier OF cell]] IN correction_package.
            sequence_pointer;
      IF package_applier = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, package_path, status);
        EXIT /add_applier_command/;
      IFEND;

      package_applier^ := applier_file^;
      package_header^.applier := #REL (package_applier, correction_package.sequence_pointer^);

      amp$set_segment_eoi (package_fid, correction_package, status);
      IF NOT status.normal THEN
        EXIT /add_applier_command/;
      IFEND;

    END /add_applier_command/;

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

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

    IF NOT status.normal THEN
      RETURN;
    IFEND;


  PROCEND rap$add_applier;
MODEND ram$add_applier;
