?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : BCU Generation' ??
MODULE ram$verify_object_library;

{ PURPOSE:
{   The purpose of this module is to determine if the contents of an
{   object library contain binary section maps for bound modules and
{   no compiler debug tables.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc llt$deferred_common_blocks
*copyc llt$deferred_entry_points
*copyc llt$form_definition
*copyc llt$load_module
*copyc oce$library_generator_errors
*copyc rae$package_software_cc
?? POP ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc clp$get_path_description
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] rap$verify_object_library', EJECT ??
*copyc rah$verify_object_library

  PROCEDURE [XDCL] rap$verify_object_library
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  pdt vol_pdt (
{    object_library, ol: file = $required
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      vol_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^vol_pdt_names, ^vol_pdt_params];

    VAR
      vol_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['OBJECT_LIBRARY', 1], ['OL', 1], ['STATUS', 2]];

    VAR
      vol_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ OBJECT_LIBRARY OL

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS

      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      access_sel: amt$file_access_selections,
      cycle_sel: clt$cycle_selector,
      file_ref: clt$file_reference,
      found: boolean,
      i: 0 .. llc$max_dictionaries_on_library,
      interpretive_element: ^llt$object_text_descriptor,
      j: llt$module_index,
      library_fid: amt$file_identifier,
      library_lfn: amt$local_file_name,
      library_name: clt$path_name,
      library_seg: amt$segment_pointer,
      module_dictionary: ^llt$module_dictionary,
      module_header: ^llt$load_module_header,
      object_library: ^SEQ ( * ),
      object_library_dictionaries: ^llt$object_library_dictionaries,
      object_library_header: ^llt$object_library_header,
      object_text_descriptor: ^llt$object_text_descriptor,
      open_p: clt$open_position,
      path: ^pft$path,
      path_container: clt$path_container,
      value: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, vol_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('OBJECT_LIBRARY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    library_lfn := value.file.local_file_name;

    clp$get_path_description (value.file, file_ref, path_container, path, cycle_sel, open_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    library_name := file_ref.path_name (1, file_ref.path_name_size);

    PUSH access_sel: [1 .. 1];
    access_sel^ [1].key := amc$access_mode;
    access_sel^ [1].access_mode := $pft$usage_selections [pfc$read];

    amp$open (library_lfn, amc$segment, access_sel, library_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (library_fid, amc$sequence_pointer, library_seg, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    object_library := library_seg.sequence_pointer;

    RESET object_library;
    NEXT object_library_header IN object_library;
    IF object_library_header^.version <> llc$object_library_version THEN
      osp$set_status_abnormal ('OC', oce$e_invalid_library_version, object_library_header^.version, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, library_name, status);
      RETURN;
    IFEND;

    NEXT object_library_dictionaries: [1 .. object_library_header^.number_of_dictionaries] IN object_library;

    i := 1;
    found := FALSE;
    WHILE (i <= object_library_header^.number_of_dictionaries) AND NOT found DO
      IF object_library_dictionaries^ [i].kind = llc$module_dictionary THEN
        found := TRUE;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;

    IF NOT found THEN
      osp$set_status_abnormal ('RA', rae$no_modules_on_library, library_name, status);
      RETURN;
    IFEND;

    module_dictionary := #PTR (object_library_dictionaries^ [i].module_dictionary, object_library^);

    FOR j := 1 TO UPPERBOUND (module_dictionary^) DO
      CASE module_dictionary^ [j].kind OF
      = llc$load_module =
        module_header := #PTR (module_dictionary^ [j].module_header, object_library^);
        IF llc$interpretive_element IN module_header^.elements_defined THEN
          interpretive_element := #PTR (module_header^.interpretive_element, object_library^);
          RESET object_library TO interpretive_element;
          NEXT object_text_descriptor IN object_library;
          IF object_text_descriptor^.kind <> llc$identification THEN
            osp$set_status_abnormal ('RA', rae$identification_not_first, library_name, status);
            RETURN;
          IFEND;

          check_for_section_maps (module_header, object_library, library_name, module_dictionary^ [j].name,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          check_for_debug_tables (interpretive_element, object_library, library_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      ELSE
        ;
      CASEND;
    FOREND;
    amp$close (library_fid, status);
  PROCEND rap$verify_object_library;
?? OLDTITLE ??
?? NEWTITLE := 'check_for_debug_tables', EJECT ??

{ PURPOSE:
{   The purpose of this request is to search through the object library record pairs for
{   debug tables and to return an error message if any are found.

  PROCEDURE check_for_debug_tables
    (    interpretive_element: ^llt$object_text_descriptor;
         p_object_library: ^SEQ ( * );
         library_name: clt$path_name;
     VAR status: ost$status);

    VAR
      abs_68000: ^llt$68000_absolute,
      actual_parameters: ^llt$actual_parameters,
      adr: ^llt$address_formulation,
      application_identifier: ^llt$application_identifier,
      binding_template: ^llt$binding_template,
      bti: ^llt$bit_string_insertion,
      deferred_common_blocks: ^llt$deferred_common_blocks,
      deferred_entry_points: ^llt$deferred_entry_points,
      entry_definition: ^llt$entry_definition,
      ext: ^llt$external_linkage,
      form_definition: ^llt$form_definition,
      formal_parameters: ^llt$formal_parameters,
      found: boolean,
      identification: ^llt$identification,
      libraries: ^llt$libraries,
      module_name: pmt$program_name,
      object_library: ^SEQ ( * ),
      object_text_descriptor: ^llt$object_text_descriptor,
      obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
      obsolete_segment_definition: ^llt$obsolete_segment_definition,
      ppu: ^llt$ppu_absolute,
      record_number: integer,
      relocation: ^llt$relocation,
      replication: ^llt$replication,
      section_definition: ^llt$section_definition,
      segment_definition: ^llt$segment_definition,
      text: ^llt$text;

    status.normal := TRUE;

    object_library := p_object_library;
    module_name := osc$null_name;
    RESET object_library TO interpretive_element;
    NEXT object_text_descriptor IN object_library;
    record_number := 1;
    found := FALSE;
    WHILE NOT found AND (object_text_descriptor^.kind <> llc$transfer_symbol) DO
      CASE object_text_descriptor^.kind OF
      = llc$line_table, llc$symbol_table, llc$obsolete_line_table, llc$symbol_table_fragment,
            llc$line_table_fragment, llc$cybil_symbol_table_fragment, llc$supplemental_debug_tables =
        found := TRUE;
      = llc$identification =
        NEXT identification IN object_library;
        module_name := identification^.name;
      = llc$section_definition, llc$allotted_section_definition, llc$unallocated_common_block =
        NEXT section_definition IN object_library;
      = llc$bit_string_insertion =
        NEXT bti IN object_library;
      = llc$entry_definition =
        NEXT entry_definition IN object_library;
      = llc$binding_template =
        NEXT binding_template IN object_library;
      = llc$obsolete_segment_definition, llc$obsolete_allotted_seg_def =
        NEXT obsolete_segment_definition IN object_library;
      = llc$segment_definition, llc$allotted_segment_definition =
        NEXT segment_definition IN object_library;
      = llc$libraries =
        NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN object_library;
      = llc$deferred_common_blocks =
        NEXT deferred_common_blocks: [1 .. object_text_descriptor^.number_of_common_blocks] IN object_library;
      = llc$deferred_entry_points =
        NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN object_library;
      = llc$text =
        NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN object_library;
      = llc$replication =
        NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN object_library;
      = llc$relocation =
        NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN object_library;
      = llc$address_formulation =
        NEXT adr: [1 .. object_text_descriptor^.number_of_adr_items] IN object_library;
      = llc$external_linkage =
        NEXT ext: [1 .. object_text_descriptor^.number_of_ext_items] IN object_library;
      = llc$form_definition =
        NEXT form_definition: [[REP object_text_descriptor^.sequence_length OF cell]] IN object_library;
      = llc$obsolete_formal_parameters =
        NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
              object_library;
      = llc$formal_parameters =
        NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN object_library;
      = llc$actual_parameters =
        NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN object_library;
      = llc$ppu_absolute =
        NEXT ppu: [0 .. object_text_descriptor^.number_of_words - 1] IN object_library;
      = llc$68000_absolute =
        NEXT abs_68000: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN object_library;
      = llc$application_identifier =
        NEXT application_identifier IN object_library;
      ELSE
        osp$set_status_abnormal ('OC', oce$e_invalid_object_rec_kind, module_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, record_number, 10, FALSE, status);
        RETURN;
      CASEND;
      IF NOT found THEN
        NEXT object_text_descriptor IN object_library;
        record_number := record_number + 1;
      IFEND;
    WHILEND;

    IF found THEN
      osp$set_status_abnormal ('RA', rae$debug_tables_on_library, library_name, status);
      RETURN;
    IFEND;

  PROCEND check_for_debug_tables;
?? OLDTITLE ??
?? NEWTITLE := 'check_for_section_maps', EJECT ??

{ PURPOSE:
{   The purpose of this request is to check to see if a bound module has section maps.
{   If it doesn't an error message is returned.

  PROCEDURE check_for_section_maps
    (    module_header: ^llt$load_module_header;
         object_library: ^SEQ ( * );
         library_name: clt$path_name;
         module_name: pmt$program_name;
     VAR status: ost$status);

    VAR
      info_element_header: ^llt$info_element_header;

    status.normal := TRUE;

    IF llc$information_element IN module_header^.elements_defined THEN
      info_element_header := #PTR (module_header^.information_element, object_library^);
      IF (info_element_header^.version <> llc$info_element_version) AND
            (info_element_header^.version <> llc$info_element_version_1_0) THEN
        osp$set_status_abnormal ('RA', rae$invalid_info_version, library_name, status);
        RETURN;
      IFEND;

      IF (info_element_header^.number_of_components > 0) AND
            (info_element_header^.number_of_section_maps < 1) THEN
        osp$set_status_abnormal ('RA', rae$no_section_maps, module_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, library_name, status);
        RETURN;
      IFEND;
    IFEND;
  PROCEND check_for_section_maps;
?? OLDTITLE ??
MODEND ram$verify_object_library;
