?? RIGHT := 110 ??
?? TITLE := 'NOS/VE : Loader : Linkage_name_tree_mgmt' ??
?? NEWTITLE := '  Global declarations', EJECT ??
MODULE lom$linkage_name_tree_mgmt;

{  PURPOSE:
{    This module is responsible for all processing of the linkage name tree.  All procedures
{    which access the tree reside here in order to limit the scope of the tree.
{  DESIGN:
{    The linkage name tree is a balanced binary tree which is keyed by linkage name (entry_point
{    name or external name).  Each node of the tree contains a pointer to a list of entry
{    definitions for the linkage name and a pointer to a list of unsatisfied references for the
{    linkage name.  The various procedures in this module exist to provide different types of
{    access to the information in the tree.
{
{    The purpose of the linkage name tree is to provide an "index" to the linkage name lists.
{    Since searches of the entry definitions list and unsatisfied references list are frequent, it is
{    desireable to minimize both the search time and the amount of virtual memory traversed by a
{    search.  Using a balanced tree structure reduces the search time.  Having the tree contain only
{    information necessary to perform the search reduces virtual memory usage.

{  NOTE:
{    Conditions raised: LOE$ABORT_LOAD, LOE$LOADER_MALFUNCTION.
?? PUSH (LISTEXT := ON) ??
*copyc LOT$LOADER_TYPE_DEFINITIONS
*copyc LOE$ABORT_LOAD
?? POP ??
*copyc MMP$CREATE_SEGMENT
*copyc MMP$DELETE_SEGMENT
*copyc PMP$CAUSE_CONDITION
*copyc PMP$EXIT
*copyc LOP$REPORT_ERROR

  TYPE
    lot$linkage_tree = record
      root: ^lot$linkage_tree_node,
      container: ^SEQ ( * ),
    recend,

    lot$linkage_tree_node = record
      linkage_info: lot$linkage_name_lists,
      balance: lot$node_balance_factor,
      less,
      greater: ^lot$linkage_tree_node,
    recend,

    lot$node_balance_factor = (loc$balanced, loc$weighted_less, loc$weighted_greater);

  VAR
    linkage_tree: [STATIC] lot$linkage_tree := [NIL, NIL];

?? TITLE := '  [XDCL] lop$find_linkage_name_lists' ??
?? EJECT ??

  PROCEDURE [XDCL] lop$find_linkage_name_lists (linkage_name: pmt$program_name;
    VAR linkage: ^lot$linkage_name_lists);

{  PURPOSE:
{    This procedure is responsible for finding the node of the linkage name tree corresponding to a
{    specified linkage name and returning the list pointers contained in the node.  If no node
{    exists for the specified linkage name, then a new node is created and inserted into the proper
{    position in the tree.
*copyc LOV$SECONDARY_STATUS

    VAR
      node_created: boolean,
      node,
      subtree_root,
      new_subtree_root,
      subtree_changed_branch: ^lot$linkage_tree_node,
      subtree_pointer: ^^lot$linkage_tree_node,
      new_balance,
      opposite_balance: lot$node_balance_factor,
      segment_pointer: mmt$segment_pointer,
      abort_status: ^ost$status;

    IF linkage_tree.container = NIL THEN
      mmp$create_segment (NIL, mmc$sequence_pointer, loc$loader_ring, segment_pointer, lov$secondary_status);
      IF NOT lov$secondary_status.normal THEN
        lop$report_error (lle$unable_to_create_table, 'LINKAGE NAME TREE', '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;
      linkage_tree.container := segment_pointer.seq_pointer;
      NEXT linkage_tree.root IN linkage_tree.container;
      IF linkage_tree.root = NIL THEN
        lop$report_error (lle$loader_table_overflow, 'LINKAGE NAME TREE', '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;
      node := linkage_tree.root;
      node^.linkage_info.name := linkage_name;
      node^.balance := loc$balanced;
      node^.less := NIL;
      node^.greater := NIL;
      node^.linkage_info.definitions_list := NIL;
      node^.linkage_info.unsat_references_list := NIL;
      linkage := ^node^.linkage_info;
      RETURN
    IFEND;
    subtree_pointer := ^linkage_tree.root;
    node := subtree_pointer^;
    subtree_root := subtree_pointer^;
    node_created := FALSE;

    REPEAT
      IF linkage_name = node^.linkage_info.name THEN
        linkage := ^node^.linkage_info;
        RETURN
      ELSE
        IF linkage_name < node^.linkage_info.name THEN
          IF node^.less = NIL THEN
            NEXT node^.less IN linkage_tree.container;
            IF node^.less = NIL THEN
              lop$report_error (lle$loader_table_overflow, 'LINKAGE NAME TREE', '', 0);
              PUSH abort_status;
              pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
              pmp$exit (abort_status^);
            IFEND;
            node_created := TRUE;
          ELSE
            IF node^.less^.balance <> loc$balanced THEN
              subtree_pointer := ^node^.less;
              subtree_root := subtree_pointer^;
            IFEND;
          IFEND;
          node := node^.less;
        ELSE
          IF node^.greater = NIL THEN
            NEXT node^.greater IN linkage_tree.container;
            IF node^.greater = NIL THEN
              lop$report_error (lle$loader_table_overflow, 'LINKAGE NAME TREE', '', 0);
              PUSH abort_status;
              pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
              pmp$exit (abort_status^);
            IFEND;
            node_created := TRUE;
          ELSE
            IF node^.greater^.balance <> loc$balanced THEN
              subtree_pointer := ^node^.greater;
              subtree_root := subtree_pointer^;
            IFEND;
          IFEND;
          node := node^.greater;
        IFEND;
      IFEND;
    UNTIL node_created;

    node^.linkage_info.name := linkage_name;
    node^.balance := loc$balanced;
    node^.less := NIL;
    node^.greater := NIL;
    node^.linkage_info.definitions_list := NIL;
    node^.linkage_info.unsat_references_list := NIL;
    linkage := ^node^.linkage_info;

    IF linkage_name < subtree_root^.linkage_info.name THEN
      node := subtree_root^.less;
      new_balance := loc$weighted_less;
    ELSE
      node := subtree_root^.greater;
      new_balance := loc$weighted_greater;
    IFEND;
    subtree_changed_branch := node;
    WHILE linkage_name <> node^.linkage_info.name DO
      IF linkage_name < node^.linkage_info.name THEN
        node^.balance := loc$weighted_less;
        node := node^.less;
      ELSE
        node^.balance := loc$weighted_greater;
        node := node^.greater;
      IFEND;
    WHILEND;

    IF subtree_root^.balance = loc$balanced THEN
      subtree_root^.balance := new_balance;
    ELSE
      IF subtree_root^.balance = new_balance THEN {tree is out of balance}
        IF subtree_changed_branch^.balance = new_balance THEN {perform single rotation}
          new_subtree_root := subtree_changed_branch;
          IF new_balance = loc$weighted_less THEN
            subtree_root^.less := subtree_changed_branch^.greater;
            subtree_changed_branch^.greater := subtree_root;
          ELSE
            subtree_root^.greater := subtree_changed_branch^.less;
            subtree_changed_branch^.less := subtree_root;
          IFEND;
          subtree_root^.balance := loc$balanced;
          subtree_changed_branch^.balance := loc$balanced;
        ELSE {perform double rotation}
          IF new_balance = loc$weighted_less THEN
            new_subtree_root := subtree_changed_branch^.greater;
            subtree_changed_branch^.greater := new_subtree_root^.less;
            new_subtree_root^.less := subtree_changed_branch;
            subtree_root^.less := new_subtree_root^.greater;
            new_subtree_root^.greater := subtree_root;
            opposite_balance := loc$weighted_greater;
          ELSE
            new_subtree_root := subtree_changed_branch^.less;
            subtree_changed_branch^.less := new_subtree_root^.greater;
            new_subtree_root^.greater := subtree_changed_branch;
            subtree_root^.greater := new_subtree_root^.less;
            new_subtree_root^.less := subtree_root;
            opposite_balance := loc$weighted_less;
          IFEND;
          IF new_subtree_root^.balance = loc$balanced THEN
            subtree_root^.balance := loc$balanced;
            subtree_changed_branch^.balance := loc$balanced;
          ELSE
            IF new_subtree_root^.balance = new_balance THEN
              subtree_root^.balance := opposite_balance;
              subtree_changed_branch^.balance := loc$balanced;
            ELSE
              subtree_root^.balance := loc$balanced;
              subtree_changed_branch^.balance := new_balance;
            IFEND;
          IFEND;
          new_subtree_root^.balance := loc$balanced;
        IFEND;
        subtree_pointer^ := new_subtree_root;
      ELSE {tree has gotten more balanced}
        subtree_root^.balance := loc$balanced;
      IFEND;
    IFEND;
  PROCEND lop$find_linkage_name_lists;

?? TITLE := '  [XDCL] lop$process_all_entry_definitns', EJECT ??

  PROCEDURE [XDCL] lop$process_all_entry_definitns (processor: ^procedure (name: pmt$program_name;
        ptr: ^^lot$entry_definition));

{  PURPOSE:
{    This procedure scans the linkage name tree (in lexical order) for nodes which have non_NIL
{    entry definition list pointers.  For each such node, a procedure (which has been supplied
{    as a parameter) is called to process the list of entry definitions.

    IF linkage_tree.root <> NIL THEN
      process_nodes_in_lexical_order (processor, linkage_tree.root);
    IFEND;
  PROCEND lop$process_all_entry_definitns;
?? TITLE := '  process_nodes_in_lexical_order', EJECT ??

  PROCEDURE process_nodes_in_lexical_order (processor: ^procedure (name: pmt$program_name;
        ptr: ^^lot$entry_definition);
        node: ^lot$linkage_tree_node);

{  PURPOSE:
{    This procedure performs a lexical order scan of the linkage name tree.  It examines each node
{    to determine if the node has a non_NIL list pointer of appropriate type (entry definition or
{    unsatisfied reference, depending on an input parameter) and, if so, calls a procedure to process
{    the list.
{  NOTE:
{    This procedure could be implemented as an inline loop with its own stacking mechanism if the
{    cost of recursion proves excessive.

    IF node^.less <> NIL THEN
      process_nodes_in_lexical_order (processor, node^.less);
    IFEND;
    IF node^.linkage_info.definitions_list <> NIL THEN
      processor^ (node^.linkage_info.name, ^node^.linkage_info.definitions_list);
    IFEND;
    IF node^.greater <> NIL THEN
      process_nodes_in_lexical_order (processor, node^.greater);
    IFEND;

  PROCEND process_nodes_in_lexical_order;
?? TITLE := '[XDCL] lop$delete_linkage_tree', EJECT ??

*copyc loh$delete_linkage_tree

  PROCEDURE [XDCL] lop$delete_linkage_tree;

    linkage_tree.container := NIL;
    linkage_tree.root := NIL;

  PROCEND lop$delete_linkage_tree;
MODEND lom$linkage_name_tree_mgmt;
