?? RIGHT := 110 ??
MODULE ram$prepare_element_list;
*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc amv$nil_file_identifier
*copyc rac$status_id
*copyc rae$error_messages
*copyc rat$file_values
*copyc rat$table_version
*copyc rat$header_record
*copyc rat$installation_table
*copyc rat$element_descriptor
*copyc rat$open_file_list
*copyc rav$correction_package_header
*copyc rav$format_types
*copyc rav$installation_table
*copyc rav$new_system_catalog
*copyc rav$old_system_catalog
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc clp$convert_string_to_file
*copyc clp$get_path_description
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc rap$build_element_list
*copyc rap$issue_message
*copyc oss$job_paged_literal
*copyc cli$compare_display_file_input
?? POP ??
?? OLDTITLE ??
?? TITLE := '  rap$prepare_element_list' ??

*copyc rah$prepare_element_list
{  Global variable declarations. }

  VAR
    file_control: clt$get_control_record,
    with_control: clt$get_control_record;

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


{   pdt preel_pdt (
{     previous_system_catalog, psc: file
{     element_list, el: file = $output
{     status)

?? PUSH (LISTEXT := ON) ??

  VAR
    preel_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^preel_pdt_names, ^preel_pdt_params
      ];

  VAR
    preel_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['PREVIOUS_SYSTEM_CATALOG', 1], ['PSC', 1], ['ELEMENT_LIST', 2], ['EL'
      , 2], ['STATUS', 3]];

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

{ PREVIOUS_SYSTEM_CATALOG PSC }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ ELEMENT_LIST EL }
    [[clc$optional_with_default, ^preel_pdt_dv2], 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]]];

  VAR
    preel_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$output';

?? POP ??
?? TITLE := '    abort_handler', EJECT ??

    PROCEDURE abort_handler (condition: pmt$condition;
          condition_information: ^pmt$condition_information;
          save_area: ^ost$stack_frame_save_area;
      VAR handler_status: ost$status);


      IF file_control.file_id <> amv$nil_file_identifier THEN
        clp$close_for_get (file_control, handler_status);
      IFEND;
      IF with_control.file_id <> amv$nil_file_identifier THEN
        clp$close_for_get (with_control, handler_status);
      IFEND;

      handler_status.normal := TRUE;

    PROCEND abort_handler;

?? TITLE := '  rap$prepare_element_list', EJECT ??

    VAR
      byte_address: amt$file_byte_address,
      compare: boolean,
      cs: clt$cycle_selector,
      element_list: ^array [1 .. * ] of rat$element_descriptor,
      i: rat$element_index,
      ignore_status: ost$status,
      last: rat$element_index,
      length: integer,
      list_file: amt$local_file_name,
      list_fid: amt$file_identifier,
      message_status: ost$status,
      new_cat_ref: clt$file_reference,
      new_file: clt$file,
      op: clt$open_position,
      parameter_specified: boolean,
      path: ^pft$path,
      path_name: clt$path_name,
      pc: clt$path_container,
      previous_cat_ref: clt$file_reference,
      previous_file: clt$file,
      previous_system_catalog: clt$file,
      response_file: [STATIC] amt$local_file_name := '$RESPONSE                      ',
      value: clt$value,
      write_attachment: array [1 .. 2] of fst$attachment_option;


    status.normal := TRUE;

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

    clp$test_parameter ('PREVIOUS_SYSTEM_CATALOG', parameter_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter_specified THEN
      clp$get_value ('PREVIOUS_SYSTEM_CATALOG', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      previous_system_catalog := value.file;
    ELSE
      previous_system_catalog := rav$old_system_catalog;
    IFEND;

    clp$get_path_description (previous_system_catalog, previous_cat_ref, pc, path, cs, op, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_path_description (rav$new_system_catalog, new_cat_ref, pc, path, cs, op, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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


    get_element_list (element_list, last, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_control.file_id := amv$nil_file_identifier;
    #spoil (file_control);
    with_control.file_id := amv$nil_file_identifier;
    #spoil (with_control);
    osp$establish_block_exit_hndlr (^abort_handler);

  /prepare_list/
    BEGIN

      FOR i := 1 TO last DO

        STRINGREP (path_name, length, previous_cat_ref.path_name (1, previous_cat_ref.path_name_size), '.',
              element_list^ [i].name);
        clp$convert_string_to_file (path_name (1, length), previous_file, status);
        IF NOT status.normal THEN
          EXIT /prepare_list/;
        IFEND;

        STRINGREP (path_name, length, new_cat_ref.path_name (1, new_cat_ref.path_name_size), '.',
              element_list^ [i].name);
        clp$convert_string_to_file (path_name (1, length), new_file, status);
        IF NOT status.normal THEN
          EXIT /prepare_list/;
        IFEND;

        compare := TRUE;

        compare_elements (previous_file.local_file_name, new_file.local_file_name, compare,
              message_status);
        IF NOT message_status.normal THEN
          rap$issue_message (response_file, message_status, status);
          IF NOT status.normal THEN
            EXIT /prepare_list/;
          IFEND;
        IFEND;

        IF compare THEN
          element_list^ [i].name := osc$null_name;
        IFEND;

      FOREND;


      {  Open the ELEMENT LIST FILE for write access and put the names of elements }
      {  that did not compare into it.                                             }

      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$shorten, 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;

      fsp$open_file (list_file, amc$record, ^write_attachment, NIL, NIL, NIL, NIL, list_fid, status);
      IF NOT status.normal THEN
        EXIT /prepare_list/;
      IFEND;

    /output_list/
      FOR i := 1 TO last DO
        IF element_list^ [i].name <> osc$null_name THEN
          amp$put_next (list_fid, ^element_list^ [i].name, #SIZE (element_list^ [i].name), byte_address,
                status);
          IF NOT status.normal THEN
            EXIT /output_list/;
          IFEND;
        IFEND;
      FOREND /output_list/;

      IF status.normal THEN
        fsp$close_file (list_fid, status);
      ELSE
        fsp$close_file (list_fid, ignore_status);
      IFEND;
      IF NOT status.normal THEN
        EXIT /prepare_list/;
      IFEND;

    END /prepare_list/;

    FREE element_list;

    osp$disestablish_cond_handler;

  PROCEND rap$prepare_element_list;

?? TITLE := '  compare_elements', EJECT ??

  PROCEDURE compare_elements (file: amt$local_file_name;
        with: amt$local_file_name;
    VAR compare: boolean;
    VAR status: ost$status);


    TYPE
      word_set = set of 0 .. 63,

      comparer = record
        case 1 .. 3 of
        = 1 =
          word: word_set,
        = 2 =
          digits: packed array [0 .. 15] of 0 .. 15,
        = 3 =
          bytes: packed array [1 .. bytes_per_word] of cell,
        casend,
      recend;

    VAR
      current_byte_address: amt$file_byte_address,
      file_buffer_required: boolean,
      file_position: amt$file_position,
      file_transfer_count: amt$transfer_count,
      file_transfer_word: ^comparer,
      i: 0 .. clc$max_value_sets,
      ignore_status: ost$status,
      with_buffer_required: boolean,
      with_position: amt$file_position,
      with_transfer_count: amt$transfer_count,
      with_transfer_word: ^comparer,
      word_from_file: comparer,
      word_from_with: comparer;

    CONST
      bytes_per_word = 8;


    status.normal := TRUE;

    clp$open_for_get (file, 'PREPARE_ELEMENT_LIST', FALSE, file_position, file_control,
          file_buffer_required, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$open_for_get (with, 'PREPARE_ELEMENT_LIST', FALSE, with_position, with_control,
          with_buffer_required, status);
    IF NOT status.normal THEN
      clp$close_for_get (file_control, ignore_status);
      RETURN;
    IFEND;

    IF file_buffer_required THEN
      ALLOCATE file_control.sequence_pointer: [[REP clc$input_buffer_size OF cell]];
      #spoil (file_control);
    IFEND;
    IF with_buffer_required THEN
      ALLOCATE with_control.sequence_pointer: [[REP clc$input_buffer_size OF cell]];
      #spoil (with_control);
    IFEND;

    compare := TRUE;
    file_transfer_count := 0;
    with_transfer_count := 0;

  /compare_loop/
    WHILE (file_position < amc$eoi) AND (with_position < amc$eoi) DO
      clp$get_next_bytes (bytes_per_word, file_transfer_count, file_position, file_control,
            file_transfer_word, status);
      IF NOT status.normal THEN
        EXIT /compare_loop/;
      IFEND;
      clp$get_next_bytes (bytes_per_word, with_transfer_count, with_position, with_control,
            with_transfer_word, status);
      IF NOT status.normal THEN
        EXIT /compare_loop/;
      IFEND;
      IF file_transfer_count <> with_transfer_count THEN
        compare := FALSE;
        EXIT /compare_loop/;
      IFEND;

      IF file_transfer_count = 0 THEN
        EXIT /compare_loop/;
      ELSEIF file_transfer_count < bytes_per_word THEN
        word_from_file.word := $word_set [];
        word_from_with.word := $word_set [];
        FOR i := 1 TO file_transfer_count DO
          word_from_file.bytes [i] := file_transfer_word^.bytes [i];
          word_from_with.bytes [i] := with_transfer_word^.bytes [i];
        FOREND;
      ELSE
        word_from_file.word := file_transfer_word^.word;
        word_from_with.word := with_transfer_word^.word;
      IFEND;

      IF word_from_file.word <> word_from_with.word THEN
        compare := FALSE;
        EXIT /compare_loop/;
      IFEND;

      current_byte_address := current_byte_address + bytes_per_word;
    WHILEND /compare_loop/;

    IF file_position <> with_position THEN
      compare := FALSE;
    IFEND;


    IF status.normal THEN
      clp$close_for_get (file_control, status);
    ELSE
      clp$close_for_get (file_control, ignore_status);
    IFEND;
    IF status.normal THEN
      clp$close_for_get (with_control, status);
    ELSE
      clp$close_for_get (with_control, ignore_status);
    IFEND;

    IF file_buffer_required THEN
      FREE file_control.sequence_pointer;
      #spoil (file_control);
    IFEND;
    IF with_buffer_required THEN
      FREE with_control.sequence_pointer;
      #spoil (with_control);
    IFEND;

  PROCEND compare_elements;

?? TITLE := '  get_element_list', EJECT ??

  PROCEDURE get_element_list (VAR element_list: ^array [1 .. * ] OF rat$element_descriptor;
    VAR last: rat$element_index;
    VAR status: ost$status);

    VAR
      element_list_allocated: boolean,
      key_all: [STATIC] ost$name := 'ALL                            ',
      ignore_status: ost$status,
      read_only_attachment: array [1 .. 2] of fst$attachment_option,
      table: ^rat$installation_table,
      table_fid: amt$file_identifier,
      table_header: ^rat$header_record,
      table_ptr: amt$segment_pointer,
      table_version: ^rat$table_version;


{   A list is built using the installation table, of all the elements to be compared. }

    status.normal := TRUE;
    element_list_allocated := FALSE;

  /get_list/
    BEGIN

      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 (rav$installation_table, amc$segment, ^read_only_attachment, NIL, NIL, NIL, NIL,
            table_fid, status);
      IF NOT status.normal THEN
        EXIT /get_list/;
      IFEND;

      amp$get_segment_pointer (table_fid, amc$sequence_pointer, table_ptr, status);
      IF NOT status.normal THEN
        EXIT /get_list/;
      IFEND;

      RESET table_ptr.sequence_pointer;
      NEXT table_version IN table_ptr.sequence_pointer;
      IF table_version = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'INSTALLATION_TABLE',
              status);
        EXIT /get_list/;
      IFEND;

      NEXT table_header IN table_ptr.sequence_pointer;
      IF table_header = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'INSTALLATION_TABLE',
              status);
        EXIT /get_list/;
      IFEND;

      NEXT table: [1 .. table_header^.number_of_files] IN table_ptr.sequence_pointer;
      IF table = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'INSTALLATION_TABLE',
              status);
        EXIT /get_list/;
      IFEND;

      ALLOCATE element_list: [1 .. table_header^.number_of_files];
      element_list_allocated := TRUE;

      last := 0;
      rap$build_element_list (table, key_all, element_list, last, status);
      IF NOT status.normal THEN
        EXIT /get_list/;
      IFEND;

    END /get_list/;

    IF status.normal THEN
      fsp$close_file (table_fid, status);
    ELSE
      fsp$close_file (table_fid, ignore_status);
    IFEND;
    IF NOT status.normal THEN
      IF element_list_allocated THEN
        FREE element_list;
      IFEND;
      RETURN;
    IFEND;

  PROCEND get_element_list;

MODEND ram$prepare_element_list
