?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Object Code Management : Correction Generation' ??
MODULE ocm$build_second_inter_ol;

{ PURPOSE:
{   This module contains the procedures that build "move items" using the breaklists
{   for both the old and new object libraries.  The move items are generated by finding
{   matching breaklist items and calculating where a specific portion of the old object
{   library is in the new object library.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oct$breaklist
*copyc oct$move_items
?? POP ??
*copyc i#move
*copyc ocp$apply_move_items
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    breaklist_symbol_table = array [1 .. *] of breaklist_symbol_table_item,
    breaklist_symbol_table_item = record
      old_count: symbol_table_index,
      new_count: symbol_table_index,
      index_into_old_array: symbol_table_index,
    recend,
    difference_array = array [1 .. *] of difference_map,
    difference_map = record
      CASE index_into: index_kind OF
      = symbol_table_entry =
        symbol_table_index: symbol_table_index,
      = other_array =
        array_index: 1 .. 7fffffff(16),
      CASEND,
    RECEND,
    index_kind = (symbol_table_entry, other_array),
    items_deleted = array [1 .. * ] of oct$breaklist_length,
    symbol_table_index = 0 .. 7fffffff(16);

?? OLDTITLE ??
?? NEWTITLE := 'build_move_items', EJECT ??
*copy och$build_move_items

  PROCEDURE build_move_items
    (    new_array: ^difference_array;
         new_breaklist: ^oct$breaklist;
         number_of_new_breaklist_items: oct$breaklist_length;
         old_array: ^difference_array;
         old_breaklist: ^oct$breaklist;
         number_of_old_breaklist_items: oct$breaklist_length;
     VAR scratch_segment: ^SEQ ( * );
     VAR move_items: ^oct$move_items;
     VAR number_of_move_items: oct$breaklist_index);

    VAR
      anything_left: boolean,
      i: oct$breaklist_length,
      interchange: boolean,
      j: oct$breaklist_length,
      length: oct$breaklist_length,
      move_item: ^oct$move_item,
      new_offset: oct$offset,
      old_offset: oct$offset,
      pass: oct$breaklist_index,
      save_original_position: ^SEQ ( * ),
      temp_move_item: oct$move_item;


    save_original_position := scratch_segment;
    number_of_move_items := 0;
    i := 1;
    anything_left := TRUE;
    WHILE anything_left DO
      IF new_array^ [i].index_into = other_array THEN
        j := new_array^ [i].array_index;
        length := 0;
        old_offset := old_breaklist^ [j].offset;
        new_offset := new_breaklist^ [i].offset;
        REPEAT
          length := length + old_breaklist^ [j].length;
          j := j + 1;
          i := i + 1;
        UNTIL (i > number_of_new_breaklist_items) OR (j > number_of_old_breaklist_items) OR
              (new_array^ [i].index_into = symbol_table_entry) OR
              ((new_array^ [i].index_into = other_array) AND (new_array^ [i].array_index <> j));
        NEXT move_item IN scratch_segment;
        number_of_move_items := number_of_move_items + 1;
        move_item^.old_offset := old_offset;
        move_item^.new_offset := new_offset;
        move_item^.length := length;
        IF i > number_of_new_breaklist_items THEN
          anything_left := FALSE;
        IFEND;
      ELSE
        IF i = number_of_new_breaklist_items THEN
          anything_left := FALSE;
        ELSE
          i := i + 1;
        IFEND;
      IFEND;
    WHILEND;

    scratch_segment := save_original_position;
    NEXT move_items: [1 .. number_of_move_items] IN scratch_segment;

    interchange := TRUE;
    pass := 1;
    WHILE (pass <= number_of_move_items - 1) AND interchange DO
      interchange := FALSE;
      FOR j := 1 TO (number_of_move_items - pass) DO
        IF move_items^ [j].new_offset > move_items^ [j + 1].new_offset THEN
          interchange := TRUE;
          temp_move_item := move_items^ [j];
          move_items^ [j] := move_items^ [j + 1];
          move_items^ [j + 1] := temp_move_item;
        IFEND;
      FOREND;
      pass := pass + 1;
    WHILEND;
    FOR i := 2 TO number_of_move_items DO
      move_items^ [i].new_offset := move_items^ [i - 1].new_offset + move_items^ [i - 1].length;
    FOREND;
  PROCEND build_move_items;
?? OLDTITLE ??
?? NEWTITLE := 'build_symbol_table', EJECT ??
*copy och$build_symbol_table

  PROCEDURE build_symbol_table
    (    old_breaklist: ^oct$breaklist;
         new_breaklist: ^oct$breaklist;
         number_of_old_breaklist_items: oct$breaklist_length;
         number_of_new_breaklist_items: oct$breaklist_length;
     VAR old_array: ^difference_array;
     VAR new_array: ^difference_array;
     VAR symbol_table: ^breaklist_symbol_table);

    CONST
      fold_size = 10000(16);

    VAR
      fold_number: 0 .. 0fffff(16),
      i: symbol_table_index,
      index: symbol_table_index,
      j: 1 .. 4,
      number: integer,
      save_number: integer,
      two_bytes: 0 .. 0ffff(16);

    FOR i := 1 TO UPPERBOUND (symbol_table^) DO
      symbol_table^ [i].new_count := 0;
      symbol_table^ [i].old_count := 0;
      symbol_table^ [i].index_into_old_array := 0;
    FOREND;

    FOR i := 1 TO number_of_new_breaklist_items DO
      convert_name_to_integer (new_breaklist^ [i].module_name, number);
      save_number := number;
      convert_name_to_integer (new_breaklist^ [i].major_name, number);
      save_number := save_number + number;
      convert_name_to_integer (new_breaklist^ [i].minor_name, number);
      save_number := save_number + number;
      save_number := save_number + $INTEGER (new_breaklist^ [i].kind);
      save_number := save_number - new_breaklist^ [i].section_ordinal;
      save_number := save_number + new_breaklist^ [i].secondary_section_ordinal;

      fold_number := 0;
      FOR j := 1 TO 4 DO
        two_bytes := save_number MOD fold_size;
        fold_number := (fold_number + two_bytes) * 2;
        fold_number := (fold_number MOD fold_size) + (fold_number DIV fold_size);
        save_number := save_number DIV fold_size;
      FOREND;
      index := (fold_number MOD UPPERBOUND (symbol_table^)) + 1;

      new_array^ [i].index_into := symbol_table_entry;
      new_array^ [i].symbol_table_index := index;
      symbol_table^ [index].new_count := symbol_table^ [index].new_count + 1;
    FOREND;

    FOR i := 1 TO number_of_old_breaklist_items DO
      convert_name_to_integer (old_breaklist^ [i].module_name, number);
      save_number := number;
      convert_name_to_integer (old_breaklist^ [i].major_name, number);
      save_number := save_number + number;
      convert_name_to_integer (old_breaklist^ [i].minor_name, number);
      save_number := save_number + number;
      save_number := save_number + $INTEGER (old_breaklist^ [i].kind);
      save_number := save_number - old_breaklist^ [i].section_ordinal;
      save_number := save_number + old_breaklist^ [i].secondary_section_ordinal;

      fold_number := 0;
      FOR j := 1 TO 4 DO
        two_bytes := save_number MOD fold_size;
        fold_number := (fold_number + two_bytes) * 2;
        fold_number := (fold_number MOD fold_size) + (fold_number DIV fold_size);
        save_number := save_number DIV fold_size;
      FOREND;
      index := (fold_number MOD UPPERBOUND (symbol_table^)) + 1;

      old_array^ [i].index_into := symbol_table_entry;
      old_array^ [i].symbol_table_index := index;
      symbol_table^ [index].old_count := symbol_table^ [index].old_count + 1;
      symbol_table^ [index].index_into_old_array := i;
    FOREND;
  PROCEND build_symbol_table;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] convert_name_to_integer', EJECT ??

{ PURPOSE:
{   This procedure converts a name to an integer by folding
{   six bytes at a time.

  PROCEDURE [INLINE] convert_name_to_integer
    (    name: ost$name;
     VAR save_number: integer);

    VAR
      i: 1 .. 31,
      j: 1 .. 6,
      number: 0 .. 0ff(16),
      number_value: integer;

    save_number := 0;
    number_value := 0;
    i := 1;
    WHILE i < 30 DO
      FOR j := 1 TO 6 DO
        number := $INTEGER (name (i, 1));
        number_value := number_value * 256 + number;
        i := i + 1;
      FOREND;
      save_number := save_number + number_value;
      number_value := 0;
    WHILEND;
    save_number := save_number + $INTEGER (name (31, 1));
  PROCEND convert_name_to_integer;
?? OLDTITLE ??
?? NEWTITLE := 'find_match_breaklist_items', EJECT ??
*copy och$find_match_breaklist_items

  PROCEDURE find_match_breaklist_items
    (    old_breaklist: ^oct$breaklist;
         new_breaklist: ^oct$breaklist;
     VAR old_array: ^difference_array;
     VAR new_array: ^difference_array;
     VAR symbol_table: ^breaklist_symbol_table);

    VAR
      i: oct$breaklist_length,
      j: oct$breaklist_length;

    new_array^ [1].index_into := other_array;
    new_array^ [1].array_index := 1;
    old_array^ [1].index_into := other_array;
    old_array^ [1].array_index := 1;

    i := UPPERBOUND (old_array^);
    j := UPPERBOUND (new_array^);
    IF (new_array^ [j].index_into = symbol_table_entry) AND
          (old_array^ [i].index_into = symbol_table_entry) AND
          (new_array^ [j].symbol_table_index = old_array^ [i].symbol_table_index) THEN
      new_array^ [j].index_into := other_array;
      new_array^ [j].array_index := i;
      old_array^ [i].index_into := other_array;
      old_array^ [i].array_index := j;
    IFEND;

    FOR i := 1 TO UPPERBOUND (new_array^) DO
      IF (symbol_table^ [new_array^ [i].symbol_table_index].new_count = 1) AND
            (symbol_table^ [new_array^ [i].symbol_table_index].old_count = 1) THEN
        j := symbol_table^ [new_array^ [i].symbol_table_index].index_into_old_array;
        IF (new_breaklist^ [i].module_name = old_breaklist^ [j].module_name) AND
              (new_breaklist^ [i].major_name = old_breaklist^ [j].major_name) AND
              (new_breaklist^ [i].minor_name = old_breaklist^ [j].minor_name) AND
              (new_breaklist^ [i].kind = old_breaklist^ [j].kind) AND
              (new_breaklist^ [i].section_ordinal = old_breaklist^ [j].section_ordinal) AND
              (new_breaklist^ [i].secondary_section_ordinal = old_breaklist^ [j].secondary_section_ordinal)
              THEN
          new_array^ [i].index_into := other_array;
          new_array^ [i].array_index := j;
          old_array^ [j].index_into := other_array;
          old_array^ [j].array_index := i;
        IFEND;
      IFEND;
    FOREND;

    FOR i := 1 TO UPPERBOUND (new_array^) - 1 DO
      IF new_array^ [i].index_into = other_array THEN
        j := new_array^ [i].array_index;
        IF j < UPPERBOUND (old_array^) THEN
          IF (new_array^ [i + 1].index_into = symbol_table_entry) AND
                (old_array^ [j + 1].index_into = symbol_table_entry) AND
                (old_array^ [j + 1].symbol_table_index = new_array^ [i + 1].symbol_table_index) THEN
            IF (new_breaklist^ [i + 1].module_name = old_breaklist^ [j + 1].module_name) AND
                  (new_breaklist^ [i + 1].major_name = old_breaklist^ [j + 1].major_name) AND
                  (new_breaklist^ [i + 1].minor_name = old_breaklist^ [j + 1].minor_name) AND
                  (new_breaklist^ [i + 1].kind = old_breaklist^ [j + 1].kind) AND
                  (new_breaklist^ [i + 1].section_ordinal = old_breaklist^ [j + 1].section_ordinal) AND
                  (new_breaklist^ [i + 1].secondary_section_ordinal =
                  old_breaklist^ [j + 1].secondary_section_ordinal) THEN
              old_array^ [j + 1].index_into := other_array;
              old_array^ [j + 1].array_index := i + 1;
              new_array^ [i + 1].index_into := other_array;
              new_array^ [i + 1].array_index := j + 1;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

    FOR i := UPPERBOUND (new_array^) DOWNTO 2 DO
      IF new_array^ [i].index_into = other_array THEN
        j := new_array^ [i].array_index;
        IF j > 1 THEN
          IF (new_array^ [i - 1].index_into = symbol_table_entry) AND
                (old_array^ [j - 1].index_into = symbol_table_entry) AND
                (old_array^ [j - 1].symbol_table_index = new_array^ [i - 1].symbol_table_index) THEN
            IF (new_breaklist^ [i - 1].module_name = old_breaklist^ [j - 1].module_name) AND
                  (new_breaklist^ [i - 1].major_name = old_breaklist^ [j - 1].major_name) AND
                  (new_breaklist^ [i - 1].minor_name = old_breaklist^ [j - 1].minor_name) AND
                  (new_breaklist^ [i - 1].kind = old_breaklist^ [j - 1].kind) AND
                  (new_breaklist^ [i - 1].section_ordinal = old_breaklist^ [j - 1].section_ordinal) AND
                  (new_breaklist^ [i - 1].secondary_section_ordinal =
                  old_breaklist^ [j - 1].secondary_section_ordinal) THEN
              old_array^ [j - 1].index_into := other_array;
              old_array^ [j - 1].array_index := i - 1;
              new_array^ [i - 1].index_into := other_array;
              new_array^ [i - 1].array_index := j - 1;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    FOREND;
  PROCEND find_match_breaklist_items;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$build_second_inter_ol', EJECT ??
*copy och$build_second_inter_ol

  PROCEDURE [XDCL] ocp$build_second_inter_ol
    (    first_intermediate_ol: ^SEQ ( * );
         new_breaklist: ^oct$breaklist;
         length_of_new_breaklist: oct$breaklist_length;
     VAR old_breaklist: ^oct$breaklist;
     VAR length_of_old_breaklist: oct$breaklist_length;
     VAR second_intermediate_ol: ^SEQ ( * );
     VAR scratch_segment: ^SEQ ( * );
     VAR move_items: ^oct$move_items;
     VAR number_of_move_items: oct$breaklist_index);

    VAR
      i: oct$breaklist_index,
      interchange: boolean,
      j: oct$breaklist_index,
      new_array: ^difference_array,
      old_array: ^difference_array,
      old_offset_sorted_move_items: ^oct$move_items,
      pass: oct$breaklist_index,
      symbol_table: ^breaklist_symbol_table,
      symbol_table_size: symbol_table_index,
      temp_move_item: oct$move_item;

    NEXT new_array: [1 .. length_of_new_breaklist] IN scratch_segment;
    NEXT old_array: [1 .. length_of_old_breaklist] IN scratch_segment;
    symbol_table_size := 17 * (length_of_new_breaklist + length_of_old_breaklist);
    NEXT symbol_table: [1 .. symbol_table_size] IN scratch_segment;

    build_symbol_table (old_breaklist, new_breaklist, length_of_old_breaklist, length_of_new_breaklist,
          old_array, new_array, symbol_table);

    find_match_breaklist_items (old_breaklist, new_breaklist, old_array, new_array, symbol_table);

    build_move_items (new_array, new_breaklist, length_of_new_breaklist, old_array, old_breaklist,
          length_of_old_breaklist, scratch_segment, move_items, number_of_move_items);

    PUSH old_offset_sorted_move_items: [1 .. number_of_move_items];

    old_offset_sorted_move_items^ := move_items^;

    interchange := TRUE;
    pass := 1;
    WHILE (pass <= number_of_move_items - 1) AND interchange DO
      interchange := FALSE;
      FOR j := 1 TO (number_of_move_items - pass) DO
        IF old_offset_sorted_move_items^ [j].old_offset > old_offset_sorted_move_items^ [j + 1].
              old_offset THEN
          interchange := TRUE;
          temp_move_item := old_offset_sorted_move_items^ [j];
          old_offset_sorted_move_items^ [j] := old_offset_sorted_move_items^ [j + 1];
          old_offset_sorted_move_items^ [j + 1] := temp_move_item;
        IFEND;
      FOREND;
      pass := pass + 1;
    WHILEND;

    update_old_breaklist (old_offset_sorted_move_items, number_of_move_items, old_breaklist,
          length_of_old_breaklist);

    ocp$apply_move_items (first_intermediate_ol, move_items, number_of_move_items, second_intermediate_ol);

  PROCEND ocp$build_second_inter_ol;
?? OLDTITLE ??
?? NEWTITLE := 'sort_breaklist', EJECT ??

{ PURPOSE:
{   The purpose of this request is to sort a breaklist.

  PROCEDURE sort_breaklist
    (    number: integer;
     VAR breaklist: ^oct$breaklist);

    VAR
      i: integer,
      j: integer,
      key: llt$section_offset,
      left: integer,
      right: integer,
      temp: oct$breaklist_item;

    IF number <= 1 THEN
      RETURN;
    ELSEIF number = 2 THEN
      IF breaklist^ [1].offset > breaklist^ [2].offset THEN
        temp := breaklist^ [1];
        breaklist^ [1] := breaklist^ [2];
        breaklist^ [2] := temp;
      IFEND;
      RETURN;
    IFEND;

    left := (number DIV 2) + 1;
    right := number;

  /outer_loop/
    WHILE TRUE DO
      IF left > 1 THEN
        left := left - 1;
        temp := breaklist^ [left];
        key := breaklist^ [left].offset;
      ELSE
        temp := breaklist^ [right];
        key := breaklist^ [right].offset;
        breaklist^ [right] := breaklist^ [1];
        right := right - 1;
        IF right = 1 THEN
          breaklist^ [right] := temp;
          RETURN;
        IFEND;
      IFEND;

      j := left;

    /inner_loop/
      WHILE TRUE DO
        i := j;
        j := j + j;
        IF j < right THEN
          IF (breaklist^ [j].offset < breaklist^ [j + 1].offset) THEN
            j := j + 1;
          IFEND;
        ELSEIF j > right THEN
          EXIT /inner_loop/;
        IFEND;

        IF key >= breaklist^ [j].offset THEN
          EXIT /inner_loop/;
        IFEND;

        breaklist^ [i] := breaklist^ [j];
      WHILEND /inner_loop/;

      breaklist^ [i] := temp;
    WHILEND /outer_loop/;
  PROCEND sort_breaklist;
?? OLDTITLE ??
?? NEWTITLE := 'update_old_breaklist', EJECT ??
*copy och$update_old_breaklist

  PROCEDURE update_old_breaklist
    (    move_items: ^oct$move_items;
         number_of_move_items: oct$breaklist_index;
     VAR old_breaklist: ^oct$breaklist;
     VAR length_of_old_breaklist: oct$breaklist_length);

    VAR
      delete_index: ^items_deleted,
      i: oct$breaklist_length,
      j: oct$breaklist_index,
      k: oct$breaklist_length,
      l: oct$breaklist_length,
      number_of_delete_items: oct$breaklist_length;

    PUSH delete_index: [1 .. length_of_old_breaklist];
    k := 1;
    j := 1;
    i := 1;
    WHILE (i <= length_of_old_breaklist) AND (j <= number_of_move_items) DO
      IF (move_items^ [j].old_offset <= old_breaklist^ [i].offset) AND
            (old_breaklist^ [i].offset < (move_items^ [j].old_offset + move_items^ [j].length)) THEN
        old_breaklist^ [i].offset := old_breaklist^ [i].offset - move_items^ [j].old_offset +
              move_items^ [j].new_offset;
        i := i + 1;
      ELSEIF (old_breaklist^ [i].offset >= (move_items^ [j].old_offset + move_items^ [j].length)) THEN
        j := j + 1;
      ELSE
        delete_index^ [k] := i;
        k := k + 1;
        i := i + 1;
      IFEND;
    WHILEND;

    IF (j > number_of_move_items) AND (i <= length_of_old_breaklist) THEN
      FOR l := i TO length_of_old_breaklist DO
        delete_index^ [k] := l;
        k := k + 1;
      FOREND;
    IFEND;

    number_of_delete_items := k - 1;
    l := 1;
    k := 1;

  /delete_entries/
    FOR i := 1 TO length_of_old_breaklist DO
      IF (k <= number_of_delete_items) AND (delete_index^ [k] = i) THEN
        k := k + 1;
        CYCLE /delete_entries/
      IFEND;
      old_breaklist^ [l] := old_breaklist^ [i];
      l := l + 1;
    FOREND /delete_entries/;

    length_of_old_breaklist := l - 1;

    sort_breaklist (length_of_old_breaklist, old_breaklist);
  PROCEND update_old_breaklist;
?? OLDTITLE ??
MODEND ocm$build_second_inter_ol;
