?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : Loader : Entry/external matching' ??
MODULE lom$entry_external_matching;

{  PURPOSE:
{    This module contains components necessary to match external references to the appropriate entry
{    point definitions.  This matching process consists of comparing protection environment (ring, key/lock)
{    attributes as well as symbolic names.
{  DESIGN:
{    The essential work of this module consists of managing two conceptual lists -- an entry definitions
{    list and an unsatisfied references list.  As 'entry_definition' object text records are received,
{    definitions are added to the entry definitions list and any matching entries in the unsatisfied
{    references list are satisfied.  As 'external_linkage' object text records are received, the
{    entry definitions list is searched for a matching definition.  If one is found, then the external
{    reference is satisfied immediately.  Otherwise an item is added to the unsatisfied references list.
{
{    Each of the two conceptual lists is implemented as a series of sublists.  For each linkage name
{    (entry_point name or external name),  a subordinate procedure maintains pointers to the heads
{    of the entry definitions and unsatisfied references sublists for that linkage name.  For any
{    given object text record, only the sublists of the specified linkage name are processed.
{
{    The actual satisfying of an external reference is not accomplished by this module.  Its purpose
{    is simply to isolate matching pairs of entry definitions and enternal references.  These pairs
{    are then passed on to another module for actual linkage generation.

{  NOTE:
{    Conditions raised: LOE$ABORT_LOAD, LOE$INSUFFICIENT_MEMORY.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cyd$cybil_structure_definitions
*copyc loe$abort_load
*copyc lot$loader_options
*copyc lot$loader_type_definitions
?? POP ??
*copyc dbp$define_entry_point_address
*copyc lop$find_linkage_name_lists
*copyc lop$generate_load_map_text
*copyc lop$record_cross_reference
*copyc lop$report_error
*copyc lop$report_secondary_error
*copyc lop$store_intercept_linkage
*copyc lop$store_linkage
*copyc mmp$create_segment
*copyc mmp$delete_segment
*copyc osp$reset_heap
*copyc pmp$cause_condition
*copyc pmp$exit
*copyc lov$apd_load
*copyc lov$loi$nil
*copyc lov$param_linkage_list
*copyc lov$secondary_status
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
  ?VAR
    inline_procs: boolean := TRUE?;

  TYPE
    valid_languages = set of llt$module_generator;

  VAR
    entry_definition_container: ^SEQ ( * ) := NIL,
    excluded_entry_points: array [1 .. 2] of pmt$program_name :=
          ['PFP$FIND_CYCLE_ARRAY_VERSION_2', 'PFP$FIND_CYCLE_ENTRY_VERSION_2'],
    lov$unsatisfied_ref_container: [XDCL] ^HEAP ( * ) := NIL,
    lov$head_of_unsat_ref_list: [XDCL] ^lot$unsatisfied_reference_list := NIL,
    lov$unsatisfied_reference: [XDCL] ^lot$unsatisfied_reference_list := NIL,
    lov$free_unsat_reference: ^lot$unsatisfied_reference := NIL,
    lov$free_unsat_ref_group: ^lot$unsatisfied_reference_group := NIL,
    lov$free_unsat_ref_list: ^lot$unsatisfied_reference_list := NIL;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$define_entry_point', EJECT ??

{  PURPOSE:
{    This procedure processes 'entry_definition' object text records.  The new definition is added
{    to the entry definitions sublist for the specified linkage (entry point) name, unless it is a duplicate
{    definition.  Then the sublist of unsatisfied references for the linkage name is searched to
{    determine if any of the references can be satisfied by the new definition.
{  NOTE:
{    Since all of the unsatisfied references in the sublist being searched are for the same linkage
{    name, the matching process becomes one of comparing protection environments to verify
{    accessibility.  Similarly, testing for duplicate entry points becomes a matter of testing for
{    protection environment overlap.

  PROCEDURE [XDCL] lop$define_entry_point
    (    entry_definition: ^llt$entry_definition;
         module_descriptor: {input} ^lot$module_descriptor;
         allocated_sections: {input} ^lot$allocated_sections;
         control_options: {control} lot$control_options;
         load_file_number: lot$load_file_number;
     VAR duplicate_entry_point: boolean);

?? NEWTITLE := 'add_definition_to_list', EJECT ??

    ?IF inline_procs = TRUE THEN

      PROCEDURE [INLINE] add_definition_to_list
        (    entry_descriptor: {input} ^lot$entry_point_descriptor;
    ?ELSE

      PROCEDURE add_definition_to_list
        (    entry_descriptor: {input} ^lot$entry_point_descriptor;
    ?IFEND
         control_options: {control} lot$control_options;
     VAR entry_definition: ^lot$entry_definition;
     VAR linkage: ^lot$linkage_name_lists;
     VAR duplicate_entry_point: {control} boolean);

    VAR
      segment_pointer: mmt$segment_pointer,
      load_map_data: lot$load_map_data,
      debugger_entry_point_descriptor: dbt$entry_point_table_item,
      abort_status: ^ost$status;

    lop$find_linkage_name_lists (entry_descriptor^.name, linkage);
    entry_definition := linkage^.definitions_list;
    WHILE entry_definition <> NIL DO
      IF ((entry_definition^.attributes.global_lock = entry_descriptor^.attributes.global_lock) OR
            (entry_definition^.attributes.gated AND entry_descriptor^.attributes.gated) OR
            ((entry_definition^.attributes.gated OR entry_descriptor^.attributes.gated) AND
            ((entry_definition^.attributes.global_lock = loc$no_lock) OR
            (entry_descriptor^.attributes.global_lock = loc$no_lock)))) AND
            NOT ((entry_definition^.attributes.loaded_ring > entry_descriptor^.attributes.call_bracket) OR
            (entry_definition^.attributes.call_bracket < entry_descriptor^.attributes.loaded_ring)) THEN
        lop$report_error (lle$duplicate_entry_point, entry_descriptor^.name, '', 0);
        duplicate_entry_point := TRUE;
        RETURN;
      IFEND;
      entry_definition := entry_definition^.nnext;
    WHILEND;
    duplicate_entry_point := FALSE;
    IF entry_definition_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, 'ENTRY POINT DEFINITIONS', '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;
      entry_definition_container := segment_pointer.seq_pointer;
    IFEND;
    NEXT entry_definition IN entry_definition_container;
    IF entry_definition <> NIL THEN
      entry_definition^.nnext := linkage^.definitions_list;
      linkage^.definitions_list := entry_definition;
      entry_definition^.attributes := entry_descriptor^.attributes;
      entry_definition^.defining_module := entry_descriptor^.defining_module;
      entry_definition^.xref_list := NIL;
      entry_definition^.xref_listed := FALSE;
      IF pmc$entry_point_map IN control_options.map THEN
        load_map_data.code := loc$lm_entry_detail;
        load_map_data.entry_name := entry_descriptor^.name;
        load_map_data.entry_address := entry_definition^.attributes.address;
        IF entry_descriptor^.attributes.gated THEN
          load_map_data.entry_attribute := 'GATED';
        ELSE
          load_map_data.entry_attribute := '';
        IFEND;
        lop$generate_load_map_text (load_map_data);
      IFEND;
      debugger_entry_point_descriptor.name := entry_descriptor^.name;
      debugger_entry_point_descriptor.call_bracket := entry_descriptor^.attributes.call_bracket;
      debugger_entry_point_descriptor.loaded_ring := entry_descriptor^.attributes.loaded_ring;
      debugger_entry_point_descriptor.global_lock := entry_descriptor^.attributes.global_lock;
      debugger_entry_point_descriptor.address.ring := entry_descriptor^.attributes.address.ring;
      debugger_entry_point_descriptor.address.seg := entry_descriptor^.attributes.address.segment;
      debugger_entry_point_descriptor.address.offset := entry_descriptor^.attributes.address.offset;
      dbp$define_entry_point_address (debugger_entry_point_descriptor, lov$secondary_status);
      IF NOT lov$secondary_status.normal THEN
        lov$secondary_status.normal := TRUE;
        lop$report_secondary_error (lov$secondary_status);
      IFEND;
    ELSE
      lop$report_error (lle$loader_table_overflow, 'ENTRY POINT DEFINITIONS', '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;
  PROCEND add_definition_to_list;
?? OLDTITLE ??
?? NEWTITLE := 'satisfy_entry_point_references', EJECT ??

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] satisfy_entry_point_references
      (    control_options: {control} lot$control_options;
  ?ELSE

    PROCEDURE satisfy_entry_point_references
      (    control_options: {control} lot$control_options;
  ?IFEND
   VAR linkage: ^lot$linkage_name_lists;
   VAR entry_definition: {input, output} lot$entry_definition);

  VAR
    next_group: ^lot$unsatisfied_reference_group,
    current_group: ^^lot$unsatisfied_reference_group,
    current_reference: ^lot$unsatisfied_reference,
    next_reference: ^lot$unsatisfied_reference,
    binding_section_overwrite: boolean,
    declaration_mismatch: boolean,
    entry_point_unaligned: boolean;

  current_group := ^linkage^.unsat_references_list^.references;
  WHILE current_group^ <> NIL DO
    IF ((current_group^^.global_key = entry_definition.attributes.global_lock) OR
          (entry_definition.attributes.gated AND ((entry_definition.attributes.global_lock = loc$no_lock) OR
          (current_group^^.global_key = loc$master_key)))) AND
          ((current_group^^.ring >= entry_definition.attributes.loaded_ring) AND
          (current_group^^.ring <= entry_definition.attributes.call_bracket)) THEN
      current_reference := current_group^^.list;
      WHILE current_reference <> NIL DO
        IF lov$apd_flags.apd_load AND (current_reference^.details.kind = llc$external_proc) AND
              (entry_definition.attributes.in_target_text OR current_reference^.details.in_target_text) AND
              (entry_descriptor.name <> 'CYP$NIL') THEN
          lop$store_intercept_linkage (current_reference^.details, entry_descriptor.name, entry_definition,
                binding_section_overwrite, declaration_mismatch, entry_point_unaligned);
        ELSE
          lop$store_linkage (^current_reference^.details, ^entry_definition, binding_section_overwrite,
                declaration_mismatch, entry_point_unaligned);
        IFEND;
        IF binding_section_overwrite THEN
          lop$report_error (lle$binding_section_overwrite, entry_descriptor.name, current_reference^.mmodule,
                0);
        IFEND;
        IF declaration_mismatch AND (NOT exclude_declaration_mismatch (entry_descriptor.name)) THEN
          IF entry_definition.attributes.source_declaration_matching THEN
            lop$report_error (lle$declaration_mismatch, entry_descriptor.name, current_reference^.mmodule, 0);
          ELSE
            lop$report_error (lle$f_declaration_mismatch, entry_descriptor.name, current_reference^.mmodule,
                  0);
          IFEND;
        IFEND;
        IF entry_point_unaligned THEN
          lop$report_error (lle$entry_point_unaligned, entry_descriptor.name, current_reference^.mmodule, 0);
        IFEND;
        IF pmc$entry_point_xref IN control_options.map THEN
          lop$record_cross_reference (current_reference^.mmodule, entry_definition);
        IFEND;
        next_reference := current_reference^.nnext;
        current_reference^.nnext := lov$free_unsat_reference;
        lov$free_unsat_reference := current_reference;
        current_reference := next_reference;
      WHILEND;
      next_group := current_group^^.nnext;
      current_group^^.nnext := lov$free_unsat_ref_group;
      lov$free_unsat_ref_group := current_group^;
      current_group^ := next_group;
    ELSE
      current_group := ^current_group^^.nnext;
    IFEND;
  WHILEND;

  IF linkage^.unsat_references_list^.references = NIL THEN
    IF lov$unsatisfied_reference = linkage^.unsat_references_list THEN
      lov$unsatisfied_reference := linkage^.unsat_references_list^.b_link;
    IFEND;
    linkage^.unsat_references_list^.b_link^.f_link := linkage^.unsat_references_list^.f_link;
    linkage^.unsat_references_list^.f_link^.b_link := linkage^.unsat_references_list^.b_link;
    linkage^.unsat_references_list^.f_link := lov$free_unsat_ref_list;
    lov$free_unsat_ref_list := linkage^.unsat_references_list;
    linkage^.unsat_references_list := NIL;
  IFEND;
PROCEND satisfy_entry_point_references;
?? OLDTITLE, EJECT ??

VAR
  entry_descriptor: lot$entry_point_descriptor,
  definition: ^lot$entry_definition,
  linkage_info: ^lot$linkage_name_lists,
  i: llt$section_ordinal;

IF entry_definition^.section_ordinal > UPPERBOUND (allocated_sections^) THEN
  lop$report_error (lle$invalid_section_ordinal, 'entry definition record', '', #OFFSET (entry_definition));
ELSEIF allocated_sections^ [entry_definition^.section_ordinal].address = loc$nil THEN
  lop$report_error (lle$undefined_section, 'entry definition record', '', #OFFSET (entry_definition));
ELSEIF entry_definition^.offset >= allocated_sections^ [entry_definition^.section_ordinal].length THEN
  lop$report_error (lle$invalid_section_offset, 'entry definition record', '', #OFFSET (entry_definition));
ELSE
  entry_descriptor.name := entry_definition^.name;
  entry_descriptor.defining_module := module_descriptor^.name;
  entry_descriptor.attributes.global_lock := module_descriptor^.attributes.global_key_lock;
  entry_descriptor.attributes.loaded_ring := module_descriptor^.attributes.loaded_ring;
  entry_descriptor.attributes.binding_section_address :=
        module_descriptor^.attributes.binding_section_address;
  entry_descriptor.attributes.binding_section_address.ring := module_descriptor^.attributes.loaded_ring;
  IF (module_descriptor^.attributes.binding_section_address <> loc$nil) THEN
    entry_descriptor.attributes.binding_section_address.offset :=
          entry_descriptor.attributes.binding_section_address.offset +
          allocated_sections^ [entry_definition^.section_ordinal].binding_section_offset;
  IFEND;
  IF llc$gated_entry_point IN entry_definition^.attributes THEN
    entry_descriptor.attributes.gated := TRUE;
    entry_descriptor.attributes.call_bracket := module_descriptor^.attributes.call_bracket;
  ELSE
    entry_descriptor.attributes.gated := FALSE;
    entry_descriptor.attributes.call_bracket := module_descriptor^.attributes.loaded_ring;
  IFEND;
  entry_descriptor.attributes.vmid := module_descriptor^.attributes.vmid;
  entry_descriptor.attributes.address := allocated_sections^ [entry_definition^.section_ordinal].address;
  entry_descriptor.attributes.address.offset := entry_descriptor.attributes.address.offset +
        entry_definition^.offset;
  entry_descriptor.attributes.address.ring := module_descriptor^.attributes.loaded_ring;
  entry_descriptor.attributes.declaration_matching_required :=
        entry_definition^.declaration_matching_required;
  entry_descriptor.attributes.declaration_matching := entry_definition^.declaration_matching;
  entry_descriptor.attributes.source_declaration_matching :=
        module_descriptor^.attributes.source_declaration_matching;
  IF entry_definition^.language IN -$valid_languages [] THEN
    entry_descriptor.attributes.language := entry_definition^.language;
  ELSE
    entry_descriptor.attributes.language := llc$unknown_generator;
    lop$report_error (lle$unknown_language, 'entry definition record', '', #OFFSET (entry_definition));
  IFEND;
  entry_descriptor.attributes.load_file_number := load_file_number;
  IF lov$apd_flags.apd_load THEN
    IF lov$apd_flags.target_text THEN
      entry_descriptor.attributes.in_target_text := TRUE;
      entry_descriptor.attributes.block_id := allocated_sections^ [entry_definition^.section_ordinal].
            local_block_id;
    ELSE
      entry_descriptor.attributes.in_target_text := FALSE;
    IFEND;
    entry_descriptor.attributes.instrumented := FALSE;
  IFEND;
  add_definition_to_list (^entry_descriptor, control_options, definition, linkage_info,
        duplicate_entry_point);
  IF (NOT duplicate_entry_point) AND (linkage_info^.unsat_references_list <> NIL) THEN
    satisfy_entry_point_references (control_options, linkage_info, definition^);
  IFEND;
IFEND;
PROCEND lop$define_entry_point;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$link_external', EJECT ??

{  PURPOSE:
{    This procedure processes 'external_linkage' object text records.  The entry definitions sublist
{    for the specified linkage (enternal) name is searched to determine if an existing definition
{    satisfies the reference.  If so, the external reference is satisfied immediately.  If not,
{    the reference is added to the unsatisfied references sublist for the specified linkage name.
{  NOTE:
{    Since all of the entry definitions in the sublist being searched are for the same linkage
{    name, the matching process becomes one of comparing protection environments (ring, key/lock)
{    to verify accessibility.  To minimize search time for the unsatisfied references list,
{    unsatisfied references are clustered into 'groups' such that all members of a group will be
{    satisfied by the same entry definition.

PROCEDURE [XDCL] lop$link_external
  (    external_linkage: ^llt$external_linkage;
       allocated_sections: {input} ^lot$allocated_sections;
       module_descriptor: {input} ^lot$module_descriptor;
       control_options: {control} lot$control_options);

  TYPE
    valid_address_kinds = set of llt$address_kind;

  VAR
    reference_descriptor: lot$reference_descriptor,
    external_descriptor: lot$external_descriptor,
    entry_definition: ^lot$entry_definition,
    temp_entry_definition: lot$entry_definition,
    linkage_info: ^lot$linkage_name_lists,
    linkage_size: 0 .. 16,
    i: 1 .. llc$max_ext_items,
    greatest_allocated_section: 0 .. llc$max_section_ordinal,
    entry_point_defined: boolean,
    binding_section_overwrite: boolean,
    declaration_mismatch: boolean,
    entry_point_unaligned: boolean;

  external_descriptor.name := external_linkage^.name;
  external_descriptor.global_key := module_descriptor^.attributes.global_key_lock;
  external_descriptor.reference_ring := module_descriptor^.attributes.loaded_ring;
  lop$find_matching_entry_point (external_descriptor, entry_point_defined, linkage_info, entry_definition);

  IF NOT entry_point_defined THEN
    reference_descriptor.ring := external_descriptor.reference_ring;
    reference_descriptor.global_key := external_descriptor.global_key;
    reference_descriptor.mmodule := module_descriptor^.name;
  IFEND;

  reference_descriptor.details.declaration_matching_required :=
        external_linkage^.declaration_matching_required;
  reference_descriptor.details.declaration_matching := external_linkage^.declaration_matching;
  IF external_linkage^.language IN -$valid_languages [] THEN
    reference_descriptor.details.language := external_linkage^.language;
  ELSE
    reference_descriptor.details.language := llc$unknown_generator;
    lop$report_error (lle$unknown_language, 'external linkage item', '', #OFFSET (external_linkage));
  IFEND;
  reference_descriptor.details.in_target_text := lov$apd_flags.apd_load AND lov$apd_flags.target_text;

  greatest_allocated_section := UPPERBOUND (allocated_sections^);

/link_a_reference/
  FOR i := 1 TO UPPERBOUND (external_linkage^.item) DO
    IF external_linkage^.item [i].section_ordinal > greatest_allocated_section THEN
      lop$report_error (lle$invalid_section_ordinal, 'external linkage item', '',
            #OFFSET (#LOC (external_linkage^.item [i])));
    ELSEIF allocated_sections^ [external_linkage^.item [i].section_ordinal].address = loc$nil THEN
      lop$report_error (lle$undefined_section, 'external linkage item', '',
            #OFFSET (#LOC (external_linkage^.item [i])));
    ELSE
      CASE external_linkage^.item [i].kind OF
      = llc$external_proc =
        linkage_size := 16;
      = llc$internal_proc =
        linkage_size := 8;
      ELSE
        IF NOT (external_linkage^.item [i].kind IN -$valid_address_kinds [llc$short_address]) THEN
          lop$report_error (lle$unknown_address_kind, 'external linkage item', '',
                #OFFSET (#LOC (external_linkage^.item [i])));
          CYCLE /link_a_reference/
        IFEND;
        linkage_size := 6;
      CASEND;
      IF external_linkage^.item [i].offset + linkage_size >
            allocated_sections^ [external_linkage^.item [i].section_ordinal].length THEN
        lop$report_error (lle$invalid_section_offset, 'external linkage item', '',
              #OFFSET (#LOC (external_linkage^.item [i])));
      ELSE
        reference_descriptor.details.address := allocated_sections^
              [external_linkage^.item [i].section_ordinal].address;
        reference_descriptor.details.address.offset := reference_descriptor.details.address.offset +
              external_linkage^.item [i].offset;
        IF (allocated_sections^ [external_linkage^.item [i].section_ordinal].kind = llc$binding_section) THEN
          IF external_linkage^.item [i].kind IN $valid_address_kinds
                [llc$internal_proc, llc$external_proc] THEN
            IF (reference_descriptor.details.address.offset MOD 8 <> 0) THEN
              lop$report_error (lle$improper_linkage_alignment, 'external linkage item', '',
                    #OFFSET (#LOC (external_linkage^.item [i])));
              CYCLE /link_a_reference/
            IFEND;
          ELSE
            IF (reference_descriptor.details.address.offset MOD 8 <> 2) THEN
              lop$report_error (lle$improper_linkage_alignment, 'external linkage item', '',
                    #OFFSET (#LOC (external_linkage^.item [i])));
              CYCLE /link_a_reference/
            IFEND;
          IFEND;
          reference_descriptor.details.binding_section_destination := TRUE;
        ELSE
          IF (allocated_sections^ [external_linkage^.item [i].section_ordinal].kind = llc$code_section) OR
                allocated_sections^ [external_linkage^.item [i].section_ordinal].allotted THEN
            lop$report_error (lle$improper_linkage_item, external_linkage^.name, module_descriptor^.
                  name, #OFFSET (#LOC (external_linkage^.item [i])));
            CYCLE /link_a_reference/;
          IFEND;
          reference_descriptor.details.binding_section_destination := FALSE;
        IFEND;
        reference_descriptor.details.kind := external_linkage^.item [i].kind;
        reference_descriptor.details.offset_operand := external_linkage^.item [i].offset_operand;
        IF entry_point_defined THEN
          IF lov$apd_flags.apd_load AND (entry_definition^.attributes.in_target_text OR
                reference_descriptor.details.in_target_text) AND
                (external_linkage^.item [i].kind = llc$external_proc) AND
                (external_linkage^.name <> 'CYP$NIL') THEN
            lop$store_intercept_linkage (reference_descriptor.details, external_linkage^.name,
                  entry_definition^, binding_section_overwrite, declaration_mismatch, entry_point_unaligned);
          ELSE
            lop$store_linkage (^reference_descriptor.details, entry_definition, binding_section_overwrite,
                  declaration_mismatch, entry_point_unaligned);
          IFEND;
          IF binding_section_overwrite THEN
            lop$report_error (lle$binding_section_overwrite, external_linkage^.name, module_descriptor^.name,
                  0);
          IFEND;
          IF declaration_mismatch AND (NOT exclude_declaration_mismatch (external_linkage^.name)) THEN
            IF entry_definition^.attributes.source_declaration_matching THEN
              lop$report_error (lle$declaration_mismatch, external_linkage^.name, module_descriptor^.name, 0);
            ELSE
              lop$report_error (lle$f_declaration_mismatch, external_linkage^.name, module_descriptor^.name,
                    0);
            IFEND;
          IFEND;
          IF entry_point_unaligned THEN
            lop$report_error (lle$entry_point_unaligned, external_linkage^.name, module_descriptor^.name, 0);
          IFEND;
          IF pmc$entry_point_xref IN control_options.map THEN
            lop$record_cross_reference (module_descriptor^.name, entry_definition^);
          IFEND;
        ELSE
          lop$add_unsatisfied_ref_to_list (reference_descriptor, linkage_info);
        IFEND;
      IFEND;
    IFEND;
  FOREND /link_a_reference/;
PROCEND lop$link_external;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$find_matching_entry_point', EJECT ??

PROCEDURE [XDCL] lop$find_matching_entry_point
  (    external_descriptor: lot$external_descriptor;
   VAR entry_point_defined: {control} boolean;
   VAR linkage: ^lot$linkage_name_lists;
   VAR entry_definition: ^lot$entry_definition);

  VAR
    definition: ^lot$entry_definition;

  lop$find_linkage_name_lists (external_descriptor.name, linkage);
  definition := linkage^.definitions_list;
  WHILE definition <> NIL DO
    IF ((external_descriptor.global_key = definition^.attributes.global_lock) OR
          (definition^.attributes.gated AND ((definition^.attributes.global_lock = loc$no_lock) OR
          (external_descriptor.global_key = loc$master_key)))) AND
          ((external_descriptor.reference_ring >= definition^.attributes.loaded_ring) AND
          (external_descriptor.reference_ring <= definition^.attributes.call_bracket)) THEN
      entry_point_defined := TRUE;
      entry_definition := definition;
      RETURN;
    IFEND;
    definition := definition^.nnext;
  WHILEND;
  entry_point_defined := FALSE;
PROCEND lop$find_matching_entry_point;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$add_unsatisfied_ref_to_list', EJECT ??

PROCEDURE [XDCL] lop$add_unsatisfied_ref_to_list
  (    reference_descriptor: lot$reference_descriptor;
   VAR linkage: ^lot$linkage_name_lists);

  VAR
    destination_group: ^lot$unsatisfied_reference_group,
    new_reference: ^lot$unsatisfied_reference,
    new_unsatisfied_ref: ^lot$unsatisfied_reference_list;


  IF lov$unsatisfied_ref_container = NIL THEN
    lop$create_unsat_ref_segment;
  IFEND;

  IF (lov$free_unsat_reference = NIL) THEN
    allocate_free_unsat_references (lov$free_unsat_reference);
  IFEND;

  new_reference := lov$free_unsat_reference;
  lov$free_unsat_reference := lov$free_unsat_reference^.nnext;

  new_reference^.details := reference_descriptor.details;
  new_reference^.mmodule := reference_descriptor.mmodule;

  IF linkage^.unsat_references_list = NIL THEN
    IF (lov$free_unsat_ref_list = NIL) THEN
      allocate_free_unsat_ref_list (lov$free_unsat_ref_list);
    IFEND;

    new_unsatisfied_ref := lov$free_unsat_ref_list;
    lov$free_unsat_ref_list := lov$free_unsat_ref_list^.f_link;

    linkage^.unsat_references_list := new_unsatisfied_ref;
    new_unsatisfied_ref^.linkage_info := linkage;
    new_unsatisfied_ref^.f_link := lov$head_of_unsat_ref_list;
    new_unsatisfied_ref^.b_link := lov$head_of_unsat_ref_list^.b_link;
    new_unsatisfied_ref^.library_searched := 0;
    lov$head_of_unsat_ref_list^.b_link := new_unsatisfied_ref;
    new_unsatisfied_ref^.b_link^.f_link := new_unsatisfied_ref;
    new_unsatisfied_ref^.references := NIL;
  IFEND;
?? EJECT ??

/find_destination_group/
  BEGIN
    destination_group := linkage^.unsat_references_list^.references;
    WHILE destination_group <> NIL DO
      IF (reference_descriptor.global_key = destination_group^.global_key) AND
            (reference_descriptor.ring = destination_group^.ring) THEN
        EXIT /find_destination_group/
      IFEND;
      destination_group := destination_group^.nnext;
    WHILEND;

    IF (lov$free_unsat_ref_group = NIL) THEN
      allocate_free_unsat_ref_groups (lov$free_unsat_ref_group);
    IFEND;

    destination_group := lov$free_unsat_ref_group;
    lov$free_unsat_ref_group := lov$free_unsat_ref_group^.nnext;

    destination_group^.nnext := linkage^.unsat_references_list^.references;
    linkage^.unsat_references_list^.references := destination_group;
    destination_group^.logically_satisfied := FALSE;
    destination_group^.newly_created := TRUE;
    destination_group^.global_key := reference_descriptor.global_key;
    destination_group^.ring := reference_descriptor.ring;
    destination_group^.list := NIL;
  END /find_destination_group/;

  new_reference^.nnext := destination_group^.list;
  destination_group^.list := new_reference;


PROCEND lop$add_unsatisfied_ref_to_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$create_unsat_ref_segment', EJECT ??

PROCEDURE [XDCL] lop$create_unsat_ref_segment;


  VAR
    segment_pointer: mmt$segment_pointer,
    new_unsatisfied_ref: ^lot$unsatisfied_reference_list,
    linkage: ^lot$param_matching_node,
    abort_status: ^ost$status;

  VAR
    converter: record
      case dummy: 1 .. 2 of
      = 1 =
        heap_pointer: ^HEAP ( * ),
      = 2 =
        os_heap_ptr: cyt$adaptable_heap_pointer,
      casend,
    recend;


  mmp$create_segment (NIL, mmc$heap_pointer, loc$loader_ring, segment_pointer, lov$secondary_status);
  IF NOT lov$secondary_status.normal THEN
    lop$report_error (lle$unable_to_create_table, 'UNSATISFIED REFERENCES', '', 0);
    PUSH abort_status;
    pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
    pmp$exit (abort_status^);
  IFEND;

  lov$unsatisfied_ref_container := segment_pointer.heap_pointer;

  converter.heap_pointer := segment_pointer.heap_pointer;
  osp$reset_heap (converter.os_heap_ptr.pva, converter.os_heap_ptr.length, FALSE, 1);

  ALLOCATE lov$head_of_unsat_ref_list IN lov$unsatisfied_ref_container^;
  IF lov$head_of_unsat_ref_list = NIL THEN
    lop$report_error (lle$loader_table_overflow, 'UNSATISFIED REFERENCES', '', 0);
    PUSH abort_status;
    pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
    pmp$exit (abort_status^);
  IFEND;

  lov$head_of_unsat_ref_list^.linkage_info := NIL;
  lov$head_of_unsat_ref_list^.references := NIL;
  lov$head_of_unsat_ref_list^.f_link := lov$head_of_unsat_ref_list;
  lov$head_of_unsat_ref_list^.b_link := lov$head_of_unsat_ref_list;

  lov$free_unsat_reference := NIL;
  lov$free_unsat_ref_group := NIL;
  lov$free_unsat_ref_list := NIL;

  IF lov$param_linkage_list.first <> NIL THEN
    linkage := lov$param_linkage_list.first;
    WHILE linkage <> NIL DO
      linkage^.references := NIL;
      linkage := linkage^.nnext;
    WHILEND;
  IFEND;

PROCEND lop$create_unsat_ref_segment;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$release_unsat_ref_segment', EJECT ??

PROCEDURE [XDCL] lop$release_unsat_ref_segment;


  VAR
    segment_pointer: mmt$segment_pointer,
    abort_status: ^ost$status;

  IF lov$unsatisfied_ref_container <> NIL THEN
    lov$head_of_unsat_ref_list := NIL;
    lov$free_unsat_reference := NIL;
    lov$free_unsat_ref_group := NIL;
    lov$free_unsat_ref_list := NIL;

    segment_pointer.heap_pointer := lov$unsatisfied_ref_container;
    lov$unsatisfied_ref_container := NIL;

    segment_pointer.kind := mmc$heap_pointer;

    mmp$delete_segment (segment_pointer, loc$loader_ring, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      PUSH abort_status;
      pmp$cause_condition (loe$loader_malfunction, ^lov$secondary_status, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

  IFEND;


PROCEND lop$release_unsat_ref_segment;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] allocate_free_unsat_references', EJECT ??

PROCEDURE [INLINE] allocate_free_unsat_references
  (VAR free_unsatisfieds: ^lot$unsatisfied_reference);


  CONST
    allocation_size = 25;

  VAR
    unsat_array: ^array [1 .. allocation_size] of lot$unsatisfied_reference,
    i: integer,
    abort_status: ^ost$status;


  ALLOCATE unsat_array IN lov$unsatisfied_ref_container^;
  IF unsat_array = NIL THEN
    lop$report_error (lle$loader_table_overflow, 'UNSATISFIED REFERENCES', '', 0);
    PUSH abort_status;
    pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
    pmp$exit (abort_status^);
  IFEND;

  FOR i := 1 TO (allocation_size - 1) DO
    unsat_array^ [i].nnext := ^unsat_array^ [i + 1];
  FOREND;

  unsat_array^ [allocation_size].nnext := NIL;
  free_unsatisfieds := ^unsat_array^ [1];


PROCEND allocate_free_unsat_references;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] allocate_free_unsat_ref_groups', EJECT ??

PROCEDURE [INLINE] allocate_free_unsat_ref_groups
  (VAR free_unsatisfieds: ^lot$unsatisfied_reference_group);


  CONST
    allocation_size = 10;

  VAR
    unsat_array: ^array [1 .. allocation_size] of lot$unsatisfied_reference_group,
    i: integer,
    abort_status: ^ost$status;


  ALLOCATE unsat_array IN lov$unsatisfied_ref_container^;
  IF unsat_array = NIL THEN
    lop$report_error (lle$loader_table_overflow, 'UNSATISFIED REFERENCE GROUPS', '', 0);
    PUSH abort_status;
    pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
    pmp$exit (abort_status^);
  IFEND;

  FOR i := 1 TO (allocation_size - 1) DO
    unsat_array^ [i].nnext := ^unsat_array^ [i + 1];
  FOREND;

  unsat_array^ [allocation_size].nnext := NIL;
  free_unsatisfieds := ^unsat_array^ [1];


PROCEND allocate_free_unsat_ref_groups;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] allocate_free_unsat_ref_list', EJECT ??

PROCEDURE [INLINE] allocate_free_unsat_ref_list
  (VAR free_unsatisfieds: ^lot$unsatisfied_reference_list);


  CONST
    allocation_size = 10;

  VAR
    unsat_array: ^array [1 .. allocation_size] of lot$unsatisfied_reference_list,
    i: integer,
    abort_status: ^ost$status;


  ALLOCATE unsat_array IN lov$unsatisfied_ref_container^;
  IF unsat_array = NIL THEN
    lop$report_error (lle$loader_table_overflow, 'UNSATISFIED REFERENCE LIST', '', 0);
    PUSH abort_status;
    pmp$cause_condition (loe$insufficient_memory, NIL, abort_status^);
    pmp$exit (abort_status^);
  IFEND;

  FOR i := 1 TO (allocation_size - 1) DO
    unsat_array^ [i].f_link := ^unsat_array^ [i + 1];
  FOREND;

  unsat_array^ [allocation_size].f_link := NIL;
  free_unsatisfieds := ^unsat_array^ [1];


PROCEND allocate_free_unsat_ref_list;

?? NEWTITLE := '[INLINE] exclude_declaration_mismatch', EJECT ??

  FUNCTION [INLINE] exclude_declaration_mismatch
    (    name: pmt$program_name): boolean;

    VAR
      index: integer;

    exclude_declaration_mismatch := FALSE;
    FOR index := LOWERBOUND(excluded_entry_points) TO UPPERBOUND(excluded_entry_points) DO
      IF name = excluded_entry_points [index] THEN
        exclude_declaration_mismatch := TRUE;
        RETURN;
      IFEND;
    FOREND;

  FUNCEND exclude_declaration_mismatch;

MODEND lom$entry_external_matching;

