?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : Loader : Load library modules' ??
MODULE lom$library_entity_locator;

{  PURPOSE:
{    This module contains procedures to support the Program Interfaces which find named entities
{    on object libraries.

?? NEWTITLE := '  Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc fst$file_reference
*copyc fst$path_handle_name
*copyc fst$resolved_file_reference
*copyc lle$loader_status_conditions
*copyc lle$load_map_diagnostics
*copyc llt$load_module
*copyc loc$deferred_entry_pt_library
*copyc loc$task_services_library_name
*copyc osd$integer_limits
*copyc osd$virtual_address
*copyc ost$caller_identifier
*copyc ost$status
*copyc pmt$program_name
?? POP ??
*copyc clp$convert_string_to_file_path
*copyc dbp$entry_point_table_address
*copyc dbp$module_table_address
*copyc fsp$get_open_information
*copyc lop$find_matching_entry_point
*copyc osp$set_status_abnormal
*copyc pmp$convert_entry_point_to_cmnd
*copyc pmp$log
*copyc pmp$verify_library
*copyc lov$file_descriptors
*copyc lov$library_list
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] lop$find_command_in_program', EJECT ??
*copy loh$find_command_in_program

  PROCEDURE [XDCL, #GATE] lop$find_command_in_program
    (    command_name: pmt$program_name;
     VAR command_dictionary_item: llt$command_dictionary_item;
     VAR library: ^SEQ ( * );
     VAR library_name: amt$local_file_name;
     VAR library_rings: amt$ring_attributes;
     VAR library_privilege: ost$name;
     VAR status: ost$status);


    VAR
      caller: ost$caller_identifier,
      command_found: boolean,
      current_library: ^lot$library_descriptor,
      entry_point_dictionary_item: llt$entry_point_dictionary_item,
      entry_point_found: boolean,
      library_file: lot$load_file,
      version: string (4);

    #CALLER_ID (caller);

    status.normal := TRUE;
    IF (lov$library_list.first <> NIL) THEN
      current_library := lov$library_list.first;

    /search_libraries/
      REPEAT
        IF (caller.ring >= osc$tsrv_ring) AND (caller.ring <= current_library^.ring_brackets.r3) THEN
          library_file := current_library^.segment;
          IF library_file <> NIL THEN
            pmp$verify_library (library_file, version, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF version = llc$object_library_version THEN
              find_command_in_library (^command_name, library_file, command_found, command_dictionary_item);
            ELSEIF version = 'V1.0' THEN
              find_entry_point_in_library (^command_name, library_file, entry_point_found,
                    entry_point_dictionary_item, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF entry_point_found THEN
                pmp$convert_entry_point_to_cmnd (entry_point_dictionary_item,
                      LOWERVALUE (clt$named_entry_ordinal), command_dictionary_item);
                command_found := TRUE;
              IFEND;
            IFEND;
            IF command_found THEN
              EXIT /search_libraries/;
            IFEND;
          IFEND;
        IFEND;
        current_library := current_library^.nnext;
      UNTIL current_library = NIL;
    IFEND;

    IF command_found THEN
      library := current_library^.segment;
      library_name := current_library^.attributes.name;
      library_rings := current_library^.ring_brackets;
      library_privilege := 'OBJECT';
    ELSE
      osp$set_status_abnormal ('PM', lle$entry_point_not_found, command_name, status);
    IFEND;

  PROCEND lop$find_command_in_program;
?? OLDTITLE ??
?? NEWTITLE := 'find_command_in_library', EJECT ??

{  PURPOSE:
{    This procedure searchs the command dictionary of the specified library for name.
{    If the name is located, the corresponding command dictionary item is returned.

  PROCEDURE find_command_in_library
    (    name: {input} ^pmt$program_name;
         library_file: lot$load_file;
     VAR command_found: boolean;
     VAR command_dictionary_item: llt$command_dictionary_item);

?? NEWTITLE := 'search_command_dictionary', EJECT ??

    PROCEDURE search_command_dictionary
      (    name: {input} ^pmt$program_name;
           command_dictionary: {input} ^llt$command_dictionary;
       VAR command_found: {control} boolean;
       VAR dictionary_index: 1 .. llc$max_commands_in_library);

      VAR
        temp: integer,
        lower: 1 .. llc$max_commands_in_library,
        upper: 0 .. llc$max_commands_in_library;

      lower := LOWERBOUND (command_dictionary^);
      upper := UPPERBOUND (command_dictionary^);
      command_found := FALSE;

    /binary_search/
      WHILE (lower <= upper) AND (NOT command_found) DO
        temp := lower + upper;
        dictionary_index := temp DIV 2;
        IF name^ = command_dictionary^ [dictionary_index].name THEN
          command_found := TRUE;
        ELSEIF name^ > command_dictionary^ [dictionary_index].name THEN
          lower := dictionary_index + 1;
        ELSE
          upper := dictionary_index - 1;
        IFEND;
      WHILEND /binary_search/;
    PROCEND search_command_dictionary;
?? OLDTITLE, EJECT ??

    VAR
      command_dictionary: ^llt$command_dictionary,
      dictionary_index: 1 .. llc$max_commands_in_library,
      i: 0 .. llc$max_dictionaries_on_library,
      library: lot$load_file,
      library_header: ^llt$object_library_header,
      library_dictionary: ^llt$object_library_dictionaries,
      number_of_commands: 0 .. llc$max_commands_in_library;


    library := library_file;
    RESET library;
    NEXT library_header IN library;
    NEXT library_dictionary: [1 .. library_header^.number_of_dictionaries] IN library;

    command_found := FALSE;
    number_of_commands := 0;

  /find_command_dictionary/
    FOR i := LOWERBOUND (library_dictionary^) TO UPPERBOUND (library_dictionary^) DO
      IF library_dictionary^ [i].kind = llc$command_dictionary THEN
        command_dictionary := #PTR (library_dictionary^ [i].command_dictionary, library^);
        number_of_commands := UPPERBOUND (command_dictionary^);
        EXIT /find_command_dictionary/;
      IFEND;
    FOREND /find_command_dictionary/;

    IF number_of_commands > 0 THEN
      search_command_dictionary (name, command_dictionary, command_found, dictionary_index);
      IF command_found THEN
        command_dictionary_item := command_dictionary^ [dictionary_index];
      IFEND;
    IFEND;

  PROCEND find_command_in_library;
?? OLDTITLE ??
?? NEWTITLE := 'find_entry_point_in_library', EJECT ??

{  PURPOSE:
{    This procedure searches the entry_point dictionary of the specified library for name.
{    If the name is located, the corresponding entry_point dictionary item is returned.

  PROCEDURE find_entry_point_in_library
    (    name: {input} ^pmt$program_name;
         library_file: lot$load_file;
     VAR entry_point_found: boolean;
     VAR entry_point_dictionary_item: llt$entry_point_dictionary_item;
     VAR status: ost$status);

?? NEWTITLE := 'search_entry_point_dictionary', EJECT ??

    PROCEDURE search_entry_point_dictionary
      (    name: {input} ^pmt$program_name;
           entry_point_dictionary: {input} ^llt$entry_point_dictionary;
       VAR entry_point_found: {control} boolean;
       VAR dictionary_index: 1 .. llc$max_entry_points_in_library);

      VAR
        temp: integer,
        lower: 1 .. llc$max_entry_points_in_library,
        upper: 0 .. llc$max_entry_points_in_library;

      lower := LOWERBOUND (entry_point_dictionary^);
      upper := UPPERBOUND (entry_point_dictionary^);
      entry_point_found := FALSE;

    /binary_search/
      WHILE (lower <= upper) AND (NOT entry_point_found) DO
        temp := lower + upper;
        dictionary_index := temp DIV 2;
        IF name^ = entry_point_dictionary^ [dictionary_index].name THEN
          entry_point_found := TRUE;
        ELSEIF name^ > entry_point_dictionary^ [dictionary_index].name THEN
          lower := dictionary_index + 1;
        ELSE
          upper := dictionary_index - 1;
        IFEND;
      WHILEND /binary_search/;
    PROCEND search_entry_point_dictionary;
?? OLDTITLE, EJECT ??

    VAR
      dictionary_index: 1 .. llc$max_entry_points_in_library,
      entry_point_dictionary: ^llt$entry_point_dictionary,
      i: 0 .. llc$max_dictionaries_on_library,
      library: lot$load_file,
      library_dictionary: ^llt$object_library_dictionaries,
      library_hdr: ^llt$object_library_header_v1_0,
      library_header: ^llt$object_library_header,
      number_of_entry_points: 0 .. llc$max_entry_points_in_library;

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

    library := library_file;
    RESET library;
    NEXT library_header IN library;

    IF library_header^.version = llc$object_library_version THEN
      NEXT library_dictionary: [1 .. library_header^.number_of_dictionaries] IN library;
      IF library_dictionary = NIL THEN
        osp$set_status_abnormal ('PM', lle$library_header_missing, '', status);
        RETURN;
      IFEND;
      number_of_entry_points := 0;

    /find_entry_point_dictionary/
      FOR i := LOWERBOUND (library_dictionary^) TO UPPERBOUND (library_dictionary^) DO
        IF (library_dictionary^ [i].kind = llc$entry_point_dictionary) THEN
          entry_point_dictionary := #PTR (library_dictionary^ [i].entry_point_dictionary, library^);
          number_of_entry_points := UPPERBOUND (entry_point_dictionary^);
          EXIT /find_entry_point_dictionary/;
        IFEND;
      FOREND /find_entry_point_dictionary/;

    ELSEIF library_header^.version = 'V1.0' THEN
      RESET library;
      NEXT library_hdr IN library;
      number_of_entry_points := library_hdr^.number_of_entry_points;
      entry_point_dictionary := #PTR (library_hdr^.entry_point_dictionary, library^);

    ELSE
      osp$set_status_abnormal ('PM', lle$wrong_library_version, llc$object_library_version, status);
      RETURN;

    IFEND;

    IF number_of_entry_points > 0 THEN
      search_entry_point_dictionary (name, entry_point_dictionary, entry_point_found, dictionary_index);
      IF entry_point_found THEN
        entry_point_dictionary_item := entry_point_dictionary^ [dictionary_index];
      IFEND;
    IFEND;
  PROCEND find_entry_point_in_library;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$find_entry_point_residence', EJECT ??
*copy loh$find_entry_point_residence

  PROCEDURE [XDCL] lop$find_entry_point_residence
    (    entry_point: pmt$program_name;
     VAR loaded_ring: ost$valid_ring;
     VAR module_name: pmt$program_name;
     VAR file_reference: fst$file_reference;
     VAR status: ost$status);

    VAR
      current_library_p: ^lot$library_descriptor,
      entry_definition_p: ^lot$entry_definition,
      entry_point_defined: boolean,
      entry_point_offset: ost$segment_offset,
      entry_point_ring: ost$ring,
      entry_point_segment: ost$segment,
      entry_point_table_address_p: ^dbt$entry_point_table,
      external_descriptor: lot$external_descriptor,
      file_index: ost$non_negative_integers,
      ignore_dictionary_index: integer,
      ignore_linkage_p: ^lot$linkage_name_lists,
      ignore_path_handle_name: fst$path_handle_name,
      item_index: ost$non_negative_integers,
      load_file_found: boolean,
      module_table_address_p: ^dbt$module_address_table_item,
      resolved_file_reference_p: ^fst$resolved_file_reference,
      user_defined_attribute_size: fst$user_defined_attribute_size;

    status.normal := TRUE;
    load_file_found := FALSE;
    IF entry_point = osc$null_name THEN
      osp$set_status_abnormal ('LL', lle$entry_point_not_found, entry_point, status);
    ELSE
      external_descriptor.name := entry_point;
      external_descriptor.global_key := loc$master_key;
      external_descriptor.reference_ring := loaded_ring;
      lop$find_matching_entry_point (external_descriptor, entry_point_defined, ignore_linkage_p,
            entry_definition_p);
      IF NOT entry_point_defined THEN
        osp$set_status_abnormal ('LL', lle$entry_point_not_found, entry_point, status);
      ELSE
        IF entry_definition_p^.attributes.load_file_number = 0 THEN

{ Entry point is in task services.

          module_name := entry_definition_p^.defining_module;
          file_reference := ':$LOCAL.' CAT loc$task_services_library_name CAT '.1';
        ELSE { entry point is not in task services.

          entry_point_table_address_p := dbp$entry_point_table_address ();

{ Search the debug entry point table for the entry point name in the loaded ring.

          item_index := 1;

        /search_entry_point_table/
          WHILE (item_index <= UPPERBOUND (entry_point_table_address_p^.item)) DO
            IF entry_point_table_address_p^.item [item_index].name = entry_point THEN
              IF (entry_point_table_address_p^.item [item_index].loaded_ring <= loaded_ring) AND
                    (entry_point_table_address_p^.item [item_index].call_bracket >= loaded_ring) THEN
                loaded_ring := entry_point_table_address_p^.item [item_index].loaded_ring;
                entry_point_ring := entry_point_table_address_p^.item [item_index].address.ring;
                entry_point_segment := entry_point_table_address_p^.item [item_index].address.seg;
                entry_point_offset := entry_point_table_address_p^.item [item_index].address.offset;
                EXIT /search_entry_point_table/;
              IFEND;
            IFEND;
            item_index := item_index + 1;
          WHILEND /search_entry_point_table/;

          IF (entry_definition_p^.defining_module = 'DEFERRED_ENTRY_POINT') THEN
            module_name := entry_definition_p^.defining_module;
          ELSE

{ Search the debug module table for the module containing the address found in
{ the entry point table search.  Look only at code sections.

            module_table_address_p := dbp$module_table_address ();

          /search_module_table/
            WHILE (module_table_address_p <> NIL) DO
              item_index := 0;
              WHILE (item_index <= UPPERBOUND (module_table_address_p^.section_item)) DO
                IF module_table_address_p^.section_item [item_index].kind = llc$code_section THEN
                  IF (entry_point_ring = module_table_address_p^.section_item [item_index].address.ring) AND
                        (entry_point_segment = module_table_address_p^.section_item [item_index].
                        address.seg) AND ((entry_point_offset >= module_table_address_p^.
                        section_item [item_index].address.offset) AND
                        (entry_point_offset < module_table_address_p^.section_item [item_index].address.
                        offset + module_table_address_p^.section_item [item_index].length)) THEN
                    module_name := module_table_address_p^.name;
                    EXIT /search_module_table/;
                  IFEND;
                IFEND;
                item_index := item_index + 1;
              WHILEND;
              module_table_address_p := module_table_address_p^.next_module;
            WHILEND /search_module_table/;
          IFEND;

{ Find the file or library with the load_file_number matching the one returned by
{ lop$find_matching_entry_point.  Search the file list before the library list
{ since we are most likely looking for a starting procedure which is more likely
{ to be on a load file than a library.

          IF lov$file_descriptors <> NIL THEN

          /search_files/
            FOR file_index := 1 TO UPPERBOUND (lov$file_descriptors^) DO
              IF lov$file_descriptors^ [file_index].attributes.load_file_number =
                    entry_definition_p^.attributes.load_file_number THEN
                load_file_found := TRUE;
                PUSH resolved_file_reference_p;
                fsp$get_open_information (lov$file_descriptors^ [file_index].file_identifier,
                      {attachment_information} NIL, {catalog_information} NIL, {cycle_attribute_sources} NIL,
                      {cycle_attribute_values} NIL, {instance_information} NIL, resolved_file_reference_p,
                      {user_defined_attributes} NIL, {ignore} user_defined_attribute_size, status);
                IF NOT status.normal THEN
                  RETURN;
                ELSE
                  file_reference := resolved_file_reference_p^.path
                        (1, resolved_file_reference_p^.cycle_path_size);
                IFEND;
                EXIT /search_files/;
              IFEND;
            FOREND /search_files/;
          IFEND;
          IF NOT load_file_found THEN
            IF lov$library_list.first <> NIL THEN
              current_library_p := lov$library_list.first;

            /search_libraries/
              REPEAT
                IF (current_library_p^.attributes.load_file_number =
                      entry_definition_p^.attributes.load_file_number) AND
                      (current_library_p^.attributes.name (1, loc$deferred_entry_pt_lib_size) <>
                      loc$deferred_entry_pt_library) THEN
                  PUSH resolved_file_reference_p;
                  clp$convert_string_to_file_path (current_library_p^.attributes.name,
                        { use_$local_as_working_catalog } FALSE, { return_path_handle_name } FALSE,
                        ignore_path_handle_name, resolved_file_reference_p^, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;
                  file_reference := resolved_file_reference_p^.path;
                  EXIT /search_libraries/;
                IFEND;
                current_library_p := current_library_p^.nnext;
              UNTIL current_library_p = NIL;
            IFEND;
          IFEND; { load file not found
        IFEND; { entry_point is in task services
      IFEND; { entry_point not defined
    IFEND; { entry_point = osc$null_name
  PROCEND lop$find_entry_point_residence;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] lop$find_function_in_program', EJECT ??
*copy loh$find_function_in_program

  PROCEDURE [XDCL, #GATE] lop$find_function_in_program
    (    function_name: pmt$program_name;
     VAR function_dictionary_item: llt$function_dictionary_item;
     VAR library: ^SEQ ( * );
     VAR library_name: amt$local_file_name;
     VAR library_rings: amt$ring_attributes;
     VAR status: ost$status);


    VAR
      caller: ost$caller_identifier,
      current_library: ^lot$library_descriptor,
      function_found: boolean,
      library_file: lot$load_file,
      version: string (4);

    #CALLER_ID (caller);

    status.normal := TRUE;

    IF (lov$library_list.first <> NIL) THEN
      current_library := lov$library_list.first;

    /search_libraries/
      REPEAT
        IF (caller.ring >= osc$tsrv_ring) AND (caller.ring <= current_library^.ring_brackets.r3) THEN
          library_file := current_library^.segment;
          pmp$verify_library (library_file, version, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF version = llc$object_library_version THEN
            find_function_in_library (^function_name, library_file, function_found, function_dictionary_item);
          ELSE
            EXIT /search_libraries/;
          IFEND;
          IF function_found THEN
            EXIT /search_libraries/;
          IFEND;
        IFEND;
        current_library := current_library^.nnext;
      UNTIL (current_library = NIL);
    IFEND;

    IF function_found THEN
      library := current_library^.segment;
      library_name := current_library^.attributes.name;
      library_rings := current_library^.ring_brackets;
    ELSE
      osp$set_status_abnormal ('PM', lle$entry_point_not_found, function_name, status);
    IFEND;

  PROCEND lop$find_function_in_program;
?? OLDTITLE ??
?? NEWTITLE := 'find_function_in_library', EJECT ??

{  PURPOSE:
{    This procedure searchs the function dictionary of the specified library for name.
{    If the name is located, the corresponding function dictionary item is returned.

  PROCEDURE find_function_in_library
    (    name: {input} ^pmt$program_name;
         library_file: lot$load_file;
     VAR function_found: boolean;
     VAR function_dictionary_item: llt$function_dictionary_item);

?? NEWTITLE := 'search_function_dictionary', EJECT ??

    PROCEDURE search_function_dictionary
      (    name: {input} ^pmt$program_name;
           function_dictionary: {input} ^llt$function_dictionary;
       VAR function_found: {control} boolean;
       VAR dictionary_index: 1 .. llc$max_functions_in_library);

      VAR
        temp: integer,
        lower: 1 .. llc$max_functions_in_library,
        upper: 0 .. llc$max_functions_in_library;

      lower := LOWERBOUND (function_dictionary^);
      upper := UPPERBOUND (function_dictionary^);
      function_found := FALSE;

    /binary_search/
      WHILE (lower <= upper) AND (NOT function_found) DO
        temp := lower + upper;
        dictionary_index := temp DIV 2;
        IF name^ = function_dictionary^ [dictionary_index].name THEN
          function_found := TRUE;
        ELSEIF name^ > function_dictionary^ [dictionary_index].name THEN
          lower := dictionary_index + 1;
        ELSE
          upper := dictionary_index - 1;
        IFEND;
      WHILEND /binary_search/;
    PROCEND search_function_dictionary;
?? OLDTITLE, EJECT ??

    VAR
      dictionary_index: 1 .. llc$max_functions_in_library,
      function_dictionary: ^llt$function_dictionary,
      i: 0 .. llc$max_dictionaries_on_library,
      library: lot$load_file,
      library_dictionary: ^llt$object_library_dictionaries,
      library_header: ^llt$object_library_header,
      number_of_functions: 0 .. llc$max_functions_in_library;

    library := library_file;
    RESET library;
    NEXT library_header IN library;
    NEXT library_dictionary: [1 .. library_header^.number_of_dictionaries] IN library;

    function_found := FALSE;
    number_of_functions := 0;

  /find_function_dictionary/
    FOR i := LOWERBOUND (library_dictionary^) TO UPPERBOUND (library_dictionary^) DO
      IF (library_dictionary^ [i].kind = llc$function_dictionary) THEN
        function_dictionary := #PTR (library_dictionary^ [i].function_dictionary, library^);
        number_of_functions := UPPERBOUND (function_dictionary^);
        EXIT /find_function_dictionary/;
      IFEND;
    FOREND /find_function_dictionary/;

    IF number_of_functions > 0 THEN
      search_function_dictionary (name, function_dictionary, function_found, dictionary_index);
      IF function_found THEN
        function_dictionary_item := function_dictionary^ [dictionary_index];
      IFEND;
    IFEND;
  PROCEND find_function_in_library;
?? OLDTITLE ??
MODEND lom$library_entity_locator
