?? RIGHT := 110 ??
MODULE ram$package_corrections;
*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc rac$status_id
*copyc rac$upgrade_system_version
*copyc rae$upgrade_errors
*copyc rat$correction_package
*copyc rat$correction_package_header
*copyc rat$header_record
*copyc rat$table_version
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc clp$get_path_description
*copyc clp$get_value
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc osp$set_status_abnormal
?? POP ??
*copyc rah$package_corrections

  VAR
    pc_utility_name: [STATIC, XDCL] ost$name := 'PACKAGE_CORRECTIONS',
    pc_prompt_string: [STATIC, XDCL] string (2) := 'PC',
    rav$correction_package_header: [STATIC, XDCL] ^rat$correction_package_header,
    rav$corp: [STATIC, XDCL] amt$segment_pointer,
    rav$elements: [STATIC, XDCL] ^rat$correction_package,
    rav$installation_table: [STATIC, XDCL] amt$local_file_name,
    rav$new_system_catalog: [STATIC, XDCL] clt$file,
    rav$old_system_catalog: [STATIC, XDCL] clt$file;

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

{ pdt pack_pdt (
{   installation_table, it: file = $required
{   old_system_catalog, osc: file
{   new_system_catalog, nsc: file
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pack_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^pack_pdt_names, ^pack_pdt_params];

    VAR
      pack_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
        clt$parameter_name_descriptor := [['INSTALLATION_TABLE', 1], ['IT', 1], ['OLD_SYSTEM_CATALOG', 2],
        ['OSC', 2], ['NEW_SYSTEM_CATALOG', 3], ['NSC', 3], ['STATUS', 4]];

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

{ INSTALLATION_TABLE IT }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ OLD_SYSTEM_CATALOG OSC }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ NEW_SYSTEM_CATALOG NSC }
      [[clc$optional], 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 ??

{ table pacc_command_list t=c s=xdcl
{ command (generate_correction, generate_corrections, genc) p=rap$generate_correction cm=xref
{ command (generate_correction_package, gencp) p=rap$write_correction_package cm=xref
{ command (prepare_element_list, preel) p=rap$prepare_element_list cm=xref
{ command (remove_correction, remove_corrections, remc) p=rap$remove_correction cm=xref
{ command (add_correction, add_corrections, addc) p=rap$add_correction cm=xref
{ command (add_psr, add_psrs, addp) p=rap$add_psrs cm=xref
{ command (display_correction_package, discp) p=rap$display_correction_package cm=proc
{ command (add_applier, adda) p=rap$add_applier cm=xref
{ command (rap$display_corrections_command) p=rap$display_corrections_command cm=xref a=hidden
{ command (rap$write_cp_to_scratch_file) p=rap$write_cp_to_scratch_file cm=xref a=hidden
{ command (quit, qui) p=rap$quit_package_corrections cm=xref

?? PUSH (LISTEXT := ON) ??
VAR
  pacc_command_list: [XDCL, READ] ^clt$command_table := ^pacc_command_list_entries,

  pacc_command_list_entries: [STATIC, READ] array [1 .. 24] of  clt$command_table_entry := [
  {} ['ADDA                           ', clc$abbreviation_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^rap$add_applier],
  {} ['ADDC                           ', clc$abbreviation_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$add_correction],
  {} ['ADDP                           ', clc$abbreviation_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$add_psrs],
  {} ['ADD_APPLIER                    ', clc$nominal_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^rap$add_applier],
  {} ['ADD_CORRECTION                 ', clc$nominal_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$add_correction],
  {} ['ADD_CORRECTIONS                ', clc$alias_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$add_correction],
  {} ['ADD_PSR                        ', clc$nominal_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$add_psrs],
  {} ['ADD_PSRS                       ', clc$alias_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$add_psrs],
  {} ['DISCP                          ', clc$abbreviation_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$proc_call, 'RAP$DISPLAY_CORRECTION_PACKAGE'],
  {} ['DISPLAY_CORRECTION_PACKAGE     ', clc$nominal_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$proc_call, 'RAP$DISPLAY_CORRECTION_PACKAGE'],
  {} ['GENC                           ', clc$abbreviation_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$generate_correction],
  {} ['GENCP                          ', clc$abbreviation_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$write_correction_package],
  {} ['GENERATE_CORRECTION            ', clc$nominal_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$generate_correction],
  {} ['GENERATE_CORRECTIONS           ', clc$alias_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$generate_correction],
  {} ['GENERATE_CORRECTION_PACKAGE    ', clc$nominal_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$write_correction_package],
  {} ['PREEL                          ', clc$abbreviation_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$prepare_element_list],
  {} ['PREPARE_ELEMENT_LIST           ', clc$nominal_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$prepare_element_list],
  {} ['QUI                            ', clc$abbreviation_entry, clc$advertised_entry, 11,
        clc$automatically_log, clc$linked_call, ^rap$quit_package_corrections],
  {} ['QUIT                           ', clc$nominal_entry, clc$advertised_entry, 11,
        clc$automatically_log, clc$linked_call, ^rap$quit_package_corrections],
  {} ['RAP$DISPLAY_CORRECTIONS_COMMAND', clc$nominal_entry, clc$hidden_entry, 9, clc$automatically_log,
         clc$linked_call, ^rap$display_corrections_command],
  {} ['RAP$WRITE_CP_TO_SCRATCH_FILE   ', clc$nominal_entry, clc$hidden_entry, 10,
        clc$automatically_log, clc$linked_call, ^rap$write_cp_to_scratch_file],
  {} ['REMC                           ', clc$abbreviation_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$remove_correction],
  {} ['REMOVE_CORRECTION              ', clc$nominal_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$remove_correction],
  {} ['REMOVE_CORRECTIONS             ', clc$alias_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$remove_correction]];

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

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

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

  PROCEDURE [XREF] rap$display_corrections_command (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$generate_correction (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$prepare_element_list (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$quit_package_corrections (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$remove_correction (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$write_correction_package (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEDURE [XREF] rap$write_cp_to_scratch_file (parameter_list: clt$parameter_list;
    VAR status: ost$status);

?? POP ??

    VAR
      access_sel: amt$file_access_selections,
      corp_fid: amt$file_identifier,
      corp_lfn: amt$local_file_name,
      cycle_sel: clt$cycle_selector,
      file_ref: clt$file_reference,
      inst_fid: amt$file_identifier,
      install_header: ^rat$header_record,
      install_table: amt$segment_pointer,
      it_path: clt$path_name,
      open_p: clt$open_position,
      path: ^pft$path,
      path_container: clt$path_container,
      value: clt$value,
      version: ^rat$table_version;


    status.normal := TRUE;

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

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

    PUSH access_sel: [1 .. 1];
    access_sel^ [1].key := amc$access_mode;
    access_sel^ [1].access_mode := $pft$usage_selections [pfc$read];

    amp$open (rav$installation_table, amc$segment, access_sel, inst_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (inst_fid, amc$sequence_pointer, install_table, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET install_table.sequence_pointer;
    NEXT version IN install_table.sequence_pointer;
    IF version = NIL THEN
      osp$set_status_abnormal (rac$status_id, rae$file_not_installation_table, it_path, status);
      RETURN;
    IFEND;
    NEXT install_header IN install_table.sequence_pointer;
    IF (install_header = NIL) OR (install_header^.title <> ' INSTALLATION TABLE') THEN
      osp$set_status_abnormal (rac$status_id, rae$file_not_installation_table, it_path, status);
      RETURN;
    IFEND;

    IF version^ <> rac$upgrade_system_version THEN
      osp$set_status_abnormal (rac$status_id, rae$invalid_table_version, it_path, status);
      RETURN;
    IFEND;

    clp$get_value ('OLD_SYSTEM_CATALOG', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      rav$old_system_catalog := value.file;
    IFEND;

    clp$get_value ('NEW_SYSTEM_CATALOG', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      rav$new_system_catalog := value.file;
    IFEND;

    corp_lfn := 'current_correction_package';
    amp$open (corp_lfn, amc$segment, NIL, corp_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (corp_fid, amc$sequence_pointer, rav$corp, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET rav$corp.sequence_pointer;
    NEXT rav$correction_package_header IN rav$corp.sequence_pointer;
    IF rav$correction_package_header = NIL THEN
      osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, corp_lfn, status);
      RETURN;
    IFEND;

    rav$correction_package_header^.identification := rac$correction_package_id;
    rav$correction_package_header^.version := rac$correction_package_version;
    rav$correction_package_header^.size_of_applier := 0;
    NEXT rav$elements: [1 .. install_header^.number_of_files] IN rav$corp.sequence_pointer;
    IF rav$elements = NIL THEN
      osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, corp_lfn, status);
      RETURN;
    IFEND;

    rav$correction_package_header^.number_of_elements := 0;

    amp$close (inst_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$push_utility (pc_utility_name, clc$global_command_search, pacc_command_list, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_command_file (clc$current_command_input, pc_utility_name, pc_prompt_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
  PROCEND rap$package_corrections;
MODEND ram$package_corrections;
