?? RIGHT := 110 ??
?? TITLE := 'NOS/VE : loader : actual/formal parm matching', EJECT ??
MODULE lom$actual_formal_parm_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.

?? PUSH (LISTEXT := ON) ??
*copyc cyd$cybil_structure_definitions
*copyc loe$abort_load
*copyc lot$loader_type_definitions
*copyc llt$formal_parameters
*copyc llt$obsolete_formal_parameters
*copyc llt$fortran_argument_desc
*copyc llt$fortran_argument_type
*copyc llt$fortran_argument_kind
*copyc llt$argument_usage
*copyc lot$loader_options
*copyc oss$job_paged_literal
*copyc pmc$default_user_stack_size
?? POP ??
*copyc lop$report_error
*copyc lop$create_unsat_ref_segment
*copyc lop$find_matching_entry_point
*copyc mmp$create_segment
*copyc osp$reset_heap
*copyc pmp$cause_condition
*copyc pmp$exit
*copyc lov$secondary_status
*copyc lov$unsatisfied_ref_container


  TYPE
    valid_languages = set of llt$module_generator;


  VAR
    lov$param_linkage_list: [XDCL] lot$param_matching_list := [NIL, NIL];



  PROCEDURE find_linkage_name_lists
    (    linkage_name: pmt$program_name;
     VAR linkage: ^lot$param_matching_node);

    VAR
      lov$secondary_status: [XREF] ost$status;

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

{!  Temporary code until RESET works for heaps used by task services.

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

{!  End temporary code.

  /normal_sequence/
    BEGIN
      IF lov$param_linkage_list.container = NIL THEN
        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$param_linkage_list.container := segment_pointer.heap_pointer;
        lov$param_linkage_list.first := NIL;

{!      RESET lov$param_linkage_list.container
{!  Temporary code until RESET works for heaps used by task services.

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

{!  End temporary code.

      IFEND;
    END /normal_sequence/;


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

    ALLOCATE linkage IN lov$param_linkage_list.container^;
    linkage^.name := linkage_name;
    linkage^.definitions := NIL;
    linkage^.references := NIL;
    linkage^.nnext := lov$param_linkage_list.first;
    lov$param_linkage_list.first := linkage;

  PROCEND find_linkage_name_lists;
?? TITLE := '     report_mismatch_error', EJECT ??

{ PURPOSE:
{   The purpose of this ungainly code is to squeeze several pieces of information
{   into the parameters passed to lop$report_error.

  PROCEDURE report_mismatch_error
    (    error_condition: ost$status_condition;
         text_1: pmt$program_name;
         text_2: string ( * {<=31} );
         number_1: integer;
         number_2: integer);

    VAR
      status_string_1: string (255),
      status_string_2: string (255),
      status_string_length_1: integer,
      status_string_length_2: integer;

    IF (error_condition = lle$bad_char_length) THEN
      STRINGREP (status_string_1, status_string_length_1, text_1);
      STRINGREP (status_string_2, status_string_length_2, text_2, ', actual length = ', number_1,
            ' and formal length = ', number_2);
    ELSEIF (error_condition = lle$actual_less_than_formal) THEN
      STRINGREP (status_string_1, status_string_length_1, text_1);
      STRINGREP (status_string_2, status_string_length_2, text_2, ' actual length of ', number_1,
            ' less than formal length of ', number_2);
    ELSE
      STRINGREP (status_string_1, status_string_length_1, ' Parameter number', number_1, ' of procedure ',
            text_1);
      STRINGREP (status_string_2, status_string_length_2, 'at line number', number_2, ' of module ', text_2);
    IFEND;
    lop$report_error (error_condition, status_string_1 (1, status_string_length_1),
          status_string_2 (1, status_string_length_2), 0);
  PROCEND report_mismatch_error;



?? TITLE := '     fortran_argument_checking', EJECT ??

  PROCEDURE fortran_argument_checking
    (VAR actual_parameters: ^llt$actual_parameters;
         formal_parameters: ^lot$formal_param_definition;
         module_name: pmt$program_name);

    TYPE
      formal_type_array = array [llt$fortran_argument_type] of boolean,
      actual_type_array = array [llt$fortran_argument_type] of formal_type_array,
      formal_kind_array = array [llt$fortran_argument_kind] of boolean,
      actual_kind_array = array [llc$fortran_variable .. llc$fortran_array_element] of formal_kind_array,
      formal_usage_array = array [llt$argument_usage] of boolean,
      actual_usage_array = array [llt$argument_usage] of formal_usage_array;

?? FMT (FORMAT := OFF) ??

    VAR
      fortran_argument_type_checking: [STATIC, READ, oss$job_paged_literal] actual_type_array := [
                  {  L      I      R      DR    COMP   CHAR    B      NT     SL     HR     BIT  }
      {    L   }  [ TRUE,  FALSE, FALSE, FALSE, FALSE, FALSE, TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {    I   }  [ FALSE, TRUE,  FALSE, FALSE, FALSE, FALSE, TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {    R   }  [ FALSE, FALSE, TRUE,  FALSE, FALSE, FALSE, TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {    DR  }  [ FALSE, FALSE, FALSE, TRUE,  FALSE, FALSE, TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {   COMP }  [ FALSE, FALSE, FALSE, FALSE, TRUE,  FALSE, TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {   CHAR }  [ FALSE, FALSE, FALSE, FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {    B   }  [ TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {    NT  }  [ TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE ],
      {    SL  }  [ FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE,  FALSE, FALSE ],
      {    HR  }  [ FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE,  FALSE ],
      {   BIT  }  [ FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE ]];


    VAR
      fortran_argument_kind_checking: [STATIC, READ, oss$job_paged_literal] actual_kind_array := [
                {  V      A      X      AE     U    }
      {  V  }   [ TRUE,  FALSE, FALSE, FALSE, TRUE  ],
      {  A  }   [ FALSE, TRUE,  FALSE, FALSE, FALSE ],
      {  X  }   [ FALSE, FALSE, TRUE,  FALSE, TRUE  ],
      {  AE }   [ TRUE,  TRUE,  FALSE, FALSE, TRUE ]];


    VAR
      fortran_argument_usage_checking: [STATIC, READ, oss$job_paged_literal] actual_usage_array := [

                {  W      NW  }
      {  W   }  [ TRUE,  TRUE ],
      {  NW  }  [ FALSE, TRUE ]];

?? FMT (FORMAT := ON) ??

    VAR
      actual_seq: ^SEQ ( * ),
      formal_seq: ^SEQ ( * ),
      actual_parameter_descriptor: ^llt$fortran_argument_desc,
      formal_parameter_descriptor: ^llt$fortran_argument_desc,
      type_valid: boolean,
      kind_valid: boolean,
      usage_valid: boolean,
      valid: boolean,
      actual_length: integer,
      formal_length: integer,
      parameter_number: integer,
      parameter_number_size: integer,
      parameter_number_string: string (31);

    actual_seq := ^actual_parameters^.specification;
    formal_seq := ^formal_parameters^.definition.specification;
    RESET actual_seq;
    RESET formal_seq;

    NEXT actual_parameter_descriptor IN actual_seq;
    NEXT formal_parameter_descriptor IN formal_seq;

    parameter_number := 0;

    WHILE (actual_parameter_descriptor <> NIL) AND (formal_parameter_descriptor <> NIL) DO
      type_valid := fortran_argument_type_checking [actual_parameter_descriptor^.argument_type]
            [formal_parameter_descriptor^.argument_type];
      IF NOT type_valid THEN
        report_mismatch_error (lle$invalid_type_matching, actual_parameters^.callee_name, module_name,
              parameter_number, actual_parameters^.line_number_of_call);
      ELSE
        kind_valid := fortran_argument_kind_checking [actual_parameter_descriptor^.argument_kind]
              [formal_parameter_descriptor^.argument_kind];
        IF NOT kind_valid THEN
          report_mismatch_error (lle$invalid_kind_matching, actual_parameters^.callee_name, module_name,
                parameter_number, actual_parameters^.line_number_of_call);
        ELSE
          usage_valid := fortran_argument_usage_checking [actual_parameter_descriptor^.mode]
                [formal_parameter_descriptor^.mode];
          IF NOT usage_valid THEN
            report_mismatch_error (lle$invalid_mode_matching, actual_parameters^.callee_name, module_name,
                  parameter_number, actual_parameters^.line_number_of_call);
          IFEND;
        IFEND;
      IFEND;

      IF (actual_parameter_descriptor^.argument_type = llc$fortran_char) AND
            (formal_parameter_descriptor^.argument_type = llc$fortran_boolean) THEN
        valid := actual_parameter_descriptor^.string_length.number_of_characters >= 8;
        IF NOT valid THEN
          STRINGREP (parameter_number_string, parameter_number_size, parameter_number);
          report_mismatch_error (lle$bad_char_length, module_name,
                parameter_number_string (1, parameter_number_size),
                actual_parameter_descriptor^.string_length.number_of_characters,
                formal_parameter_descriptor^.string_length.number_of_characters);
        IFEND;
      IFEND;

      IF (actual_parameter_descriptor^.argument_type = llc$fortran_char) AND
            (formal_parameter_descriptor^.argument_type = llc$fortran_char) AND
            (NOT (llc$fortran_assumed_len_string IN actual_parameter_descriptor^.string_length.attributes))
            THEN
        valid := actual_parameter_descriptor^.string_length.number_of_characters >=
              formal_parameter_descriptor^.string_length.number_of_characters;
        IF NOT valid THEN
          STRINGREP (parameter_number_string, parameter_number_size, parameter_number);
          report_mismatch_error (lle$bad_char_length, actual_parameters^.callee_name,
                parameter_number_string (1, parameter_number_size),
                actual_parameter_descriptor^.string_length.number_of_characters,
                formal_parameter_descriptor^.string_length.number_of_characters);
        IFEND;
      IFEND;

      IF ((actual_parameter_descriptor^.argument_type = llc$fortran_char) AND
            (formal_parameter_descriptor^.argument_type = llc$fortran_char)) THEN
        IF (((actual_parameter_descriptor^.argument_kind = llc$fortran_array) AND
              (NOT (llc$fortran_adaptable_array IN actual_parameter_descriptor^.array_size.attributes) AND
              NOT (llc$fortran_assumed_len_array IN actual_parameter_descriptor^.array_size.attributes)) OR
              (actual_parameter_descriptor^.argument_kind = llc$fortran_array_element) AND
              (NOT (llc$fortran_assumed_len_string IN actual_parameter_descriptor^.string_length.
              attributes))) AND (formal_parameter_descriptor^.argument_kind = llc$fortran_array) AND
              (NOT (llc$fortran_adaptable_array IN formal_parameter_descriptor^.array_size.attributes) AND
              NOT (llc$fortran_assumed_len_array IN formal_parameter_descriptor^.array_size.attributes))) THEN
          IF actual_parameter_descriptor^.argument_kind = llc$fortran_array THEN
            actual_length := actual_parameter_descriptor^.array_size.number_of_elements *
                  actual_parameter_descriptor^.string_length.number_of_characters;
          ELSE
            actual_length := actual_parameter_descriptor^.string_length.number_of_characters;
          IFEND;

          IF formal_parameter_descriptor^.argument_kind = llc$fortran_array THEN
            formal_length := formal_parameter_descriptor^.array_size.number_of_elements *
                  formal_parameter_descriptor^.string_length.number_of_characters;
          ELSE
            formal_length := formal_parameter_descriptor^.string_length.number_of_characters;
          IFEND;
          valid := actual_length >= formal_length;
          IF NOT valid THEN
            STRINGREP (parameter_number_string, parameter_number_size, parameter_number);
            report_mismatch_error (lle$actual_less_than_formal, actual_parameters^.callee_name,
                  parameter_number_string (1, parameter_number_size), actual_length, formal_length);
          IFEND;
        IFEND;
      IFEND;

      IF (actual_parameter_descriptor^.argument_type = llc$fortran_integer) AND
            (formal_parameter_descriptor^.argument_type = llc$fortran_integer) THEN

{ The purpose of the following code is to maintain compatibility with binary files
{ compiled before INTEGER*N code is available in FORTRAN.

        IF actual_parameter_descriptor^.string_length.number_of_characters = 0 THEN
          actual_length := 8;
        ELSE
          actual_length := actual_parameter_descriptor^.string_length.number_of_characters;
        IFEND;
        IF formal_parameter_descriptor^.string_length.number_of_characters = 0 THEN
          formal_length := 8;
        ELSE
          formal_length := formal_parameter_descriptor^.string_length.number_of_characters;
        IFEND;

{ End of code to maintain compatibility

        valid := actual_length = formal_length;
        IF NOT valid THEN
          report_mismatch_error (lle$bad_integer_length, actual_parameters^.callee_name, module_name,
                parameter_number, actual_parameters^.line_number_of_call);
        IFEND;
      IFEND;

      valid := TRUE;

      IF (formal_parameter_descriptor^.argument_kind = llc$fortran_array) AND
            (llc$fortran_assumed_shape_array IN formal_parameter_descriptor^.array_size.attributes) THEN
        IF (actual_parameter_descriptor^.argument_kind <> llc$fortran_array) OR
              (llc$fortran_assumed_len_array IN actual_parameter_descriptor^.array_size.attributes) OR
              (actual_parameter_descriptor^.array_size.rank <> formal_parameter_descriptor^.array_size.rank)
              THEN
          valid := FALSE;
        IFEND;
      ELSE
        IF formal_parameter_descriptor^.argument_kind = llc$fortran_array THEN
          IF (actual_parameter_descriptor^.argument_kind = llc$fortran_array) AND
                ((llc$fortran_array_section IN actual_parameter_descriptor^.array_size.attributes) OR
                (llc$fortran_assumed_shape_array IN actual_parameter_descriptor^.array_size.attributes)) THEN
            valid := FALSE;
          IFEND;
        IFEND;
      IFEND;

      IF NOT valid THEN
        report_mismatch_error (lle$invalid_array_size_matching, actual_parameters^.callee_name, module_name,
              parameter_number, actual_parameters^.line_number_of_call);
      IFEND;

      NEXT actual_parameter_descriptor IN actual_seq;
      NEXT formal_parameter_descriptor IN formal_seq;

      parameter_number := parameter_number + 1;

    WHILEND;

    IF (actual_parameter_descriptor = NIL) AND (formal_parameter_descriptor <> NIL) THEN
      lop$report_error (lle$invalid_matching, actual_parameters^.callee_name, module_name, 0);
    IFEND;

  PROCEND fortran_argument_checking;

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

  PROCEDURE [XDCL] lop$define_formal_parameters
    (    formal_parameters: ^llt$formal_parameters;
         attributes: lot$module_attributes;
         module_descriptor: {input} ^lot$module_descriptor;
         allocated_sections: {input} ^lot$allocated_sections;
         control_options {control} : lot$control_options);

{  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.

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

    PROCEDURE [INLINE] add_definition_to_list
      (    entry_descriptor: ^lot$entry_point_descriptor;
           formal_parameters: ^llt$formal_parameters;
       VAR definition: ^lot$formal_param_definition;
       VAR linkage: ^lot$param_matching_node;
       VAR duplicate_entry_point {control} : boolean);

      VAR
        segment_pointer: mmt$segment_pointer,
        linkage_name: pmt$program_name,
        formal_seq: ^SEQ ( * ),
        abort_status: ^ost$status;

{!  Temporary code until RESET works for heaps used by task services.

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

*copy rhp$initialize
?? PUSH (LISTEXT := ON) ??
*copy ost$heap
?? POP ??

{!  End temporary code.


      find_linkage_name_lists (entry_descriptor^.name, linkage);
      definition := linkage^.definitions;
      WHILE definition <> NIL DO
        IF ((definition^.global_lock = entry_descriptor^.attributes.global_lock) OR
              (definition^.gated AND entry_descriptor^.attributes.gated) OR
              ((definition^.gated OR entry_descriptor^.attributes.gated) AND
              ((definition^.global_lock = loc$no_lock) OR (entry_descriptor^.attributes.global_lock =
              loc$no_lock)))) AND NOT ((definition^.loaded_ring >
              entry_descriptor^.attributes.call_bracket) OR (definition^.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;
        definition := definition^.nnext;
      WHILEND;
      duplicate_entry_point := FALSE;

    /normal_sequence/
      BEGIN
        IF lov$param_linkage_list.container = NIL THEN
          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$param_linkage_list.container := segment_pointer.heap_pointer;

{!      RESET lov$param_linkage_list.containe
{!  Temporary code until RESET works for heaps used by task services.

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

{!  End temporary code.

        IFEND;
      END /normal_sequence/;

      ALLOCATE definition: [[REP #SIZE (formal_parameters^.specification) OF cell]] IN
            lov$param_linkage_list.container^;
      IF definition <> NIL THEN
        definition^.nnext := linkage^.definitions;
        linkage^.definitions := definition;
        definition^.global_lock := entry_descriptor^.attributes.global_lock;
        definition^.loaded_ring := entry_descriptor^.attributes.loaded_ring;
        definition^.call_bracket := entry_descriptor^.attributes.call_bracket;
        definition^.gated := entry_descriptor^.attributes.gated;
        definition^.defining_module := entry_descriptor^.defining_module;
        definition^.definition := formal_parameters^;
      ELSE
        lop$report_error (lle$unable_to_load_attributes, 'ENTRY POINT DEFINITIONS', '', 0);
      IFEND;
    PROCEND add_definition_to_list;




?? TITLE := '    satisfy_entry_point_references', EJECT ??


    PROCEDURE [INLINE] satisfy_entry_point_references
      (    linkage: ^lot$param_matching_node;
           definition {input_output} : ^lot$formal_param_definition);

      VAR
        current_group: ^^lot$actual_param_group,
        temp1: ^lot$actual_param_list_item,
        temp2: ^lot$actual_param_group,
        temp_var: ^lot$actual_param_list_item,
        parm_var: ^llt$actual_parameters,
        module_name: pmt$program_name;

?? OLDTITLE, EJECT ??
      current_group := ^linkage^.references;
      WHILE current_group^ <> NIL DO
        IF ((current_group^^.global_key = definition^.global_lock) OR
              (definition^.gated AND ((definition^.global_lock = loc$no_lock) OR
              (current_group^^.global_key = loc$master_key)))) AND
              ((current_group^^.ring >= definition^.loaded_ring) AND
              (current_group^^.ring <= definition^.call_bracket)) THEN
          WHILE current_group^^.list <> NIL DO
            temp_var := current_group^^.list;
            parm_var := ^temp_var^.definition;
            fortran_argument_checking (parm_var, definition, temp_var^.module_name);
            temp1 := current_group^^.list;
            current_group^^.list := temp1^.nnext;
            FREE temp1 IN lov$unsatisfied_ref_container^;
          WHILEND;
          temp2 := current_group^;
          current_group^ := temp2^.nnext;
          FREE temp2 IN lov$unsatisfied_ref_container^;
        ELSE
          current_group := ^current_group^^.nnext;
        IFEND;
      WHILEND;
    PROCEND satisfy_entry_point_references;
?? OLDTITLE, EJECT ??

    VAR
      definition: ^lot$formal_param_definition,
      linkage_info: ^lot$param_matching_node,
      i: llt$section_ordinal,
      duplicate_entry_point: boolean,
      external_descriptor: lot$external_descriptor,
      entry_point_defined: boolean,
      dummy: ^lot$linkage_name_lists,
      entry_definition: ^lot$entry_definition,
      entry_descriptor: lot$entry_point_descriptor;

    entry_descriptor.name := formal_parameters^.procedure_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;
    external_descriptor.name := formal_parameters^.procedure_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, dummy, entry_definition);

    IF NOT entry_point_defined THEN
      RETURN; { **** Temporary **** OCU is omitting entry points but not the corresponding actual params.}
      lop$report_error (lle$def_before_param, 'ENTRY_DEFINITION_PRECEEDS_ACTUAL_PARAMETERS', '', 0);
      RETURN;
    IFEND;

    entry_descriptor.attributes.gated := entry_definition^.attributes.gated;
    entry_descriptor.attributes.call_bracket := entry_definition^.attributes.call_bracket;


    IF formal_parameters^.language IN -$valid_languages [] THEN
      entry_descriptor.attributes.language := formal_parameters^.language;
    ELSE
      entry_descriptor.attributes.language := llc$unknown_generator;
      lop$report_error (lle$unknown_language, 'formal_parameters', '', #OFFSET (formal_parameters));
    IFEND;
    add_definition_to_list (^entry_descriptor, formal_parameters, definition, linkage_info,
          duplicate_entry_point);
    IF (NOT duplicate_entry_point) AND (linkage_info^.references <> NIL) THEN
      satisfy_entry_point_references (linkage_info, definition);
    IFEND;
  PROCEND lop$define_formal_parameters;
?? TITLE := '  [XDCL] lop$link_actual_parameters', EJECT ??

  PROCEDURE [XDCL] lop$link_actual_parameters
    (    actual_parameters: ^llt$actual_parameters;
         module_descriptor: {input} ^lot$module_descriptor;
         control_options {control} : lot$control_options);

{  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.

    TYPE
      valid_address_kinds = set of llt$address_kind;

    VAR
      reference_descriptor: lot$reference_descriptor,
      external_descriptor: lot$external_descriptor,
      entry_definition: ^lot$formal_param_definition,
      temp_entry_definition: lot$entry_definition,
      linkage_info: ^lot$param_matching_node,
      linkage_size: 0 .. 16,
      greatest_allocated_section: 0 .. llc$max_section_ordinal,
      entry_point_defined: boolean,
      declaration_mismatch: boolean,
      actual_param: ^llt$actual_parameters,
      entry_point_unaligned: boolean;

    external_descriptor.name := actual_parameters^.callee_name;
    external_descriptor.global_key := module_descriptor^.attributes.global_key_lock;
    external_descriptor.reference_ring := module_descriptor^.attributes.loaded_ring;
    find_matching_formal_param (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;
    ELSE
      actual_param := actual_parameters;
      fortran_argument_checking (actual_param, entry_definition, module_descriptor^.name);
      RETURN;
    IFEND;

    IF actual_parameters^.language IN -$valid_languages [] THEN
      reference_descriptor.details.language := actual_parameters^.language;
    ELSE
      reference_descriptor.details.language := llc$unknown_generator;
      lop$report_error (lle$unknown_language, 'actual_parameters', '', #OFFSET (actual_parameters));
    IFEND;

    add_unsatisfied_ref_to_list (actual_parameters, reference_descriptor, module_descriptor^.name,
          linkage_info);

  PROCEND lop$link_actual_parameters;
?? TITLE := '  find_matching_entry_point', EJECT ??

  PROCEDURE [INLINE] find_matching_formal_param
    (    external_descriptor: lot$external_descriptor;
     VAR formal_param_defined {control} : boolean;
     VAR linkage: ^lot$param_matching_node;
     VAR entry_definition: ^lot$formal_param_definition);

    VAR
      definition: ^lot$formal_param_definition;

    find_linkage_name_lists (external_descriptor.name, linkage);
    definition := linkage^.definitions;
    WHILE definition <> NIL DO
      IF ((external_descriptor.global_key = definition^.global_lock) OR
            (definition^.gated AND ((definition^.global_lock = loc$no_lock) OR
            (external_descriptor.global_key = loc$master_key)))) AND
            ((external_descriptor.reference_ring >= definition^.loaded_ring) AND
            (external_descriptor.reference_ring <= definition^.call_bracket)) THEN
        formal_param_defined := TRUE;
        entry_definition := definition;
        RETURN
      IFEND;
      definition := definition^.nnext;
    WHILEND;
    formal_param_defined := FALSE;
  PROCEND find_matching_formal_param;
?? TITLE := '  add_unsatisfied_ref_to_list', EJECT ??

  PROCEDURE [INLINE] add_unsatisfied_ref_to_list
    (    actual_parameters: ^llt$actual_parameters;
         reference_descriptor: lot$reference_descriptor;
         module_name: pmt$program_name;
     VAR linkage: ^lot$param_matching_node);

    VAR
      destination_group: ^lot$actual_param_group,
      new_reference: ^lot$actual_param_list_item,
      abort_status: ^ost$status;


  /normal_sequence/
    BEGIN
      IF lov$unsatisfied_ref_container = NIL THEN
        lop$create_unsat_ref_segment;
      IFEND;

      ALLOCATE new_reference: [[REP #SIZE (actual_parameters^.specification) OF cell]] IN
            lov$unsatisfied_ref_container^;
      IF new_reference = NIL THEN
        EXIT /normal_sequence/
      IFEND;
      new_reference^.definition := actual_parameters^;
      new_reference^.module_name := module_name;

    /find_destination_group/
      BEGIN
        destination_group := linkage^.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;
        ALLOCATE destination_group IN lov$unsatisfied_ref_container^;
        IF destination_group = NIL THEN
          EXIT /normal_sequence/
        IFEND;
        destination_group^.nnext := linkage^.references;
        linkage^.references := destination_group;
        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;
      RETURN
    END /normal_sequence/;
    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^);
  PROCEND add_unsatisfied_ref_to_list;
MODEND lom$actual_formal_parm_matching;
