?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Object Code Management: Compare Object Libraries or Files' ??
MODULE ocm$compare_object_library;

{  PURPOSE:
{    Compare two object files or two object libraries and produce a
{    listing of the differences.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc cst$menu_class
*copyc cst$menu_list
*copyc cyd$debug_symbol_table
*copyc cyd$debug_symbol_table_header
*copyc fdt$form_definition
*copyc llt$deferred_common_blocks
*copyc llt$deferred_entry_points
*copyc llt$form_definition
*copyc llt$load_module
*copyc oce$library_generator_errors
*copyc oct$display_toggles
*copyc oct$module_description
*copyc ost$message_template
*copyc ost$message_template_index
*copyc ost$mtm_condition_codes
*copyc ost$mtm_condition_names
*copyc ost$mtm_header
*copyc ost$mtm_menu_header
*copyc ost$status
?? POP ??
*copyc clp$evaluate_parameters
*copyc clp$extract_msg_module_contents
*copyc clp$get_next_scl_proc_line
*copyc ocp$close_all_open_files
*copyc ocp$close_output_file
*copyc ocp$convert_information_element
*copyc ocp$initialize_oc_environment
*copyc ocp$obtain_object_file
*copyc ocp$open_output_file
*copyc ocp$output
*copyc osp$generate_message
*copyc osp$set_status_abnormal
*copyc pmp$get_last_path_name
*copyc pmp$position_object_library
*copyc ocv$open_file_list
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    premature_end_of_file = 'PREMATURE END OF FILE';

  VAR { for error messages }
    old_object_text_descriptor: ^llt$object_text_descriptor,
    new_object_text_descriptor: ^llt$object_text_descriptor;

  VAR
    length: integer,
    number_of_compare_errors: [STATIC] integer := 0,
    strng: string (132);

?? OLDTITLE ??
?? NEWTITLE := '  SORT_MODULE_DIRECTORY', EJECT ??

  PROCEDURE sort_module_directory
    (VAR directory: array [1 .. * ] of oct$module_description);


    VAR
      changed_flag: integer,
      i: integer,
      sort_count: integer,
      temp: oct$module_description;


    changed_flag := UPPERBOUND (directory) - 1;

    REPEAT
      sort_count := changed_flag;
      changed_flag := 0;

      FOR i := 1 TO sort_count DO
        IF directory [i].name > directory [i + 1].name THEN
          changed_flag := i - 1;

          temp := directory [i];
          directory [i] := directory [i + 1];
          directory [i + 1] := temp;
        IFEND;
      FOREND;
    UNTIL changed_flag <= 0;


  PROCEND sort_module_directory;
?? OLDTITLE ??
?? NEWTITLE := '  COMPARE_MODULES', EJECT ??

  PROCEDURE compare_modules
    (VAR old_module: oct$module_description;
     VAR new_module: oct$module_description;
     VAR header_printed: boolean);

?? NEWTITLE := '    ERROR', EJECT ??

    PROCEDURE compare_error
      (    record_value: string ( * );
           old: ^cell;
           new: ^cell);


      VAR
        strng: string (10),
        l: integer,
        dummy: ost$status;


      number_of_compare_errors := number_of_compare_errors + 1;

      IF NOT header_printed THEN
        ocp$output (occ$new_page, 'Modules changed', 15, occ$end_of_line);
        ocp$output (occ$single_space, '~~~~~~~~~~~~~~~', 15, occ$end_of_line);

        header_printed := TRUE;
      IFEND;


      ocp$output (occ$single_space, new_module.name, #SIZE (new_module.name), occ$continue);
      ocp$output (' - ', 'First difference at record number', 33, occ$continue);

      STRINGREP (strng, l, record_number);
      ocp$output ('', strng (1, l), l, occ$continue);

      ocp$output (' - ', record_value, #SIZE (record_value), occ$end_of_line);

      display_error (old, new);

      error_in_compare := TRUE;

    PROCEND compare_error;
?? OLDTITLE ??
?? NEWTITLE := '    FORMAT_ERROR_STRING', EJECT ??

    PROCEDURE format_error_string
      (    error: ^0 .. 0ff(16);
           maximum_offset: ost$segment_length;
       VAR strng: string ( * );
       VAR lngth: integer);

      CONST
        half = 15,
        bytes_to_display = 2 * half;

      VAR
        offset: integer,
        hex_array: ^array [1 .. bytes_to_display] of 0 .. 0ff(16),
        ignore: integer,
        i: integer,
        number_to_display: 0 .. bytes_to_display;

      offset := #OFFSET (error) - half;
      IF (offset <= 0) THEN
        offset := 1;
      IFEND;

      hex_array := #ADDRESS (#RING (error), #SEGMENT (error), offset);

      IF #OFFSET(error) > maximum_offset THEN
        number_to_display := maximum_offset - #offset (hex_array) + 1;
      ELSE
        number_to_display := bytes_to_display;
      IFEND;

      lngth := 1;
      FOR i := 1 TO number_to_display DO
        STRINGREP (strng (lngth, 3), ignore, hex_array^ [i]: 3: #(16));
        lngth := lngth + 3;
      FOREND;

      lngth := lngth - 1;
    PROCEND format_error_string;
?? OLDTITLE ??
?? NEWTITLE := '    DISPLAY_ERROR', EJECT ??

    PROCEDURE display_error
      (    old: ^cell;
           new: ^cell);


      VAR
        old_array: ^array [1 .. 65536] of 0 .. 0ff(16),
        new_array: ^array [1 .. 65536] of 0 .. 0ff(16),
        error: integer,
        l: integer;


      IF (old = NIL) OR (new = NIL) THEN
        RETURN;
      IFEND;

      old_array := old;
      new_array := new;
      error := 1;

      WHILE (error < UPPERBOUND (old_array^)) AND (old_array^ [error] = new_array^ [error]) DO
        error := error + 1;
      WHILEND;

      format_error_string (^old_array^ [error], #size (old_module.file^), strng, l);
      ocp$output ('    REPLACED - ', strng, l, occ$end_of_line);
      format_error_string (^new_array^ [error], #size (new_module.file^), strng, l);
      ocp$output ('        WITH - ', strng, l, occ$end_of_line);

    PROCEND display_error;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE', EJECT ??

    PROCEDURE compare
      (    size: integer;
           record_kind: string ( * ));


      CONST
        buffer_size = 255;

      VAR
        s: integer,
        old: ^string ( * ),
        new: ^string ( * );


      s := size;

      WHILE s > 0 DO
        IF s > buffer_size THEN
          NEXT old: [buffer_size] IN old_module.file;
          NEXT new: [buffer_size] IN new_module.file;
        ELSE
          NEXT old: [s] IN old_module.file;
          NEXT new: [s] IN new_module.file;
        IFEND;

        s := s - buffer_size;


        IF (old = NIL) OR (new = NIL) THEN
          compare_error (premature_end_of_file, NIL, NIL);
          RETURN;
        IFEND;


        IF (old^ <> new^) THEN
          compare_error (record_kind, old, new);
          RETURN;
        IFEND;
      WHILEND;


    PROCEND compare;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_OBJECT_TEXT_DESCRIPTOR', EJECT ??

    PROCEDURE compare_object_text_descriptors
      (VAR old_object_text_descriptor: ^llt$object_text_descriptor;
       VAR new_object_text_descriptor: ^llt$object_text_descriptor);


      NEXT old_object_text_descriptor IN old_module.file;
      NEXT new_object_text_descriptor IN new_module.file;

      IF (old_object_text_descriptor = NIL) OR (new_object_text_descriptor = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;


      IF (old_object_text_descriptor^.kind <> new_object_text_descriptor^.kind) THEN
        compare_error ('OBJECT RECORD KIND', old_object_text_descriptor, new_object_text_descriptor);
        RETURN;
      IFEND;


    PROCEND compare_object_text_descriptors;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_IDENTIFICATION_RECORDS', EJECT ??

    PROCEDURE compare_identification_records;


      VAR
        old: ^llt$identification,
        new: ^llt$identification;


      NEXT old IN old_module.file;
      NEXT new IN new_module.file;


      IF (old = NIL) OR (new = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;


      IF old^.name = new^.name THEN
        IF old^.object_text_version = new^.object_text_version THEN
          IF old^.kind = new^.kind THEN
            IF old^.attributes = new^.attributes THEN
              IF old^.greatest_section_ordinal = new^.greatest_section_ordinal THEN

                RETURN;

              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;


      compare_error ('IDENTIFICATION RECORD', old, new);


    PROCEND compare_identification_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_TRANSFER_SYMBOLS', EJECT ??

    PROCEDURE compare_transfer_symbols;


      compare (#SIZE (llt$transfer_symbol), 'TRANSFER SYMBOL');


    PROCEND compare_transfer_symbols;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_SECTION_DEFINITIONS', EJECT ??

    PROCEDURE compare_section_definitions;


      compare (#SIZE (llt$section_definition), 'SECTION DEFINITION');


    PROCEND compare_section_definitions;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_ALLOTTED_SECTION_DEFS', EJECT ??

    PROCEDURE compare_allotted_section_defs
      (    old_size: integer;
           new_size: integer);


      CONST
        record_kind = 'ALLOTTED SECTION DEFINITION';

      VAR
        section_definition: ^llt$section_definition,
        old_reset: ^SEQ ( * ),
        new_reset: ^SEQ ( * ),
        valid_position: boolean;


      old_reset := old_module.file;

      compare (#SIZE (llt$section_definition), record_kind CAT ' LENGTH');
      IF error_in_compare THEN
        RETURN;
      IFEND;

      NEXT section_definition IN old_reset;

      old_reset := old_module.file;
      new_reset := new_module.file;

      pmp$position_object_library (old_module.file, old_size, valid_position);
      IF NOT valid_position THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      pmp$position_object_library (new_module.file, new_size, valid_position);
      IF NOT valid_position THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      compare (section_definition^.length, record_kind);
      IF error_in_compare THEN
        RETURN;
      IFEND;

      old_module.file := old_reset;
      new_module.file := new_reset;


    PROCEND compare_allotted_section_defs;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_SEGMENT_DEFINITIONS', EJECT ??

    PROCEDURE compare_segment_definitions;


      compare (#SIZE (llt$segment_definition), 'SEGMENT DEFINITION');


    PROCEND compare_segment_definitions;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_ALLOTTED_SEGMENT_DEFS', EJECT ??

    PROCEDURE compare_allotted_segment_defs;


      CONST
        record_kind = 'ALLOTTED SEGMENT DEFINITION';

      VAR
        old_segment_definition: ^llt$segment_definition,
        new_segment_definition: ^llt$segment_definition,
        old_position: ost$segment_length,
        new_position: ost$segment_length,
        old_allotted_segment_length: ost$segment_length,
        new_allotted_segment_length: ost$segment_length,
        length: ost$segment_length,
        old_reset: ^SEQ ( * ),
        new_reset: ^SEQ ( * ),
        valid_position: boolean;


      old_position := old_object_text_descriptor^.allotted_segment;
      new_position := new_object_text_descriptor^.allotted_segment;
      old_allotted_segment_length := old_object_text_descriptor^.allotted_segment_length;
      new_allotted_segment_length := new_object_text_descriptor^.allotted_segment_length;

      IF (old_allotted_segment_length <> new_allotted_segment_length) THEN
        compare_error ('ALLOTTED SEGMENT LENGTH', old_object_text_descriptor, new_object_text_descriptor);
      IFEND;

      NEXT old_segment_definition IN old_module.file;
      NEXT new_segment_definition IN new_module.file;
      IF (old_segment_definition = NIL) OR (new_segment_definition = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      IF (old_segment_definition^ <> new_segment_definition^) THEN
        compare_error (record_kind, old_segment_definition, new_segment_definition);
        RETURN;
      IFEND;

?? EJECT ??

      IF (old_allotted_segment_length <> 0) THEN
        length := old_allotted_segment_length;
      ELSE
        length := old_segment_definition^.section_definition.length;
      IFEND;

      old_reset := old_module.file;
      new_reset := new_module.file;

      pmp$position_object_library (old_module.file, old_position, valid_position);
      IF NOT valid_position THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      pmp$position_object_library (new_module.file, new_position, valid_position);
      IF NOT valid_position THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      compare (length, record_kind);
      IF error_in_compare THEN
        RETURN;
      IFEND;

      old_module.file := old_reset;
      new_module.file := new_reset;


    PROCEND compare_allotted_segment_defs;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_OBSOLETE_SEG_DEFS', EJECT ??

    PROCEDURE compare_obsolete_seg_defs;


      compare (#SIZE (llt$obsolete_segment_definition), 'OBSOLETE SEGMENT DEFINITION');


    PROCEND compare_obsolete_seg_defs;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_OBS_ALLOTTED_SEG_DEFS', EJECT ??

    PROCEDURE compare_obs_allotted_seg_defs;


      CONST
        record_kind = 'OBSOLETE ALLOTTED SEGMENT DEFINITION';

      VAR
        old_segment_definition: ^llt$obsolete_segment_definition,
        new_segment_definition: ^llt$obsolete_segment_definition,
        old_position: ost$segment_length,
        new_position: ost$segment_length,
        old_allotted_segment_length: ost$segment_length,
        new_allotted_segment_length: ost$segment_length,
        length: ost$segment_length,
        old_reset: ^SEQ ( * ),
        new_reset: ^SEQ ( * ),
        valid_position: boolean;


      old_position := old_object_text_descriptor^.allotted_segment;
      new_position := new_object_text_descriptor^.allotted_segment;
      old_allotted_segment_length := old_object_text_descriptor^.allotted_segment_length;
      new_allotted_segment_length := new_object_text_descriptor^.allotted_segment_length;

      IF (old_allotted_segment_length <> new_allotted_segment_length) THEN
        compare_error ('OBSOLETE ALLOTTED SEGMENT LENGTH', old_object_text_descriptor,
              new_object_text_descriptor);
      IFEND;

      NEXT old_segment_definition IN old_module.file;
      NEXT new_segment_definition IN new_module.file;
      IF (old_segment_definition = NIL) OR (new_segment_definition = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      IF (old_segment_definition^ <> new_segment_definition^) THEN
        compare_error (record_kind, old_segment_definition, new_segment_definition);
        RETURN;
      IFEND;

?? EJECT ??

      IF (old_allotted_segment_length <> 0) THEN
        length := old_allotted_segment_length;
      ELSE
        length := old_segment_definition^.section_definition.length;
      IFEND;

      old_reset := old_module.file;
      new_reset := new_module.file;

      pmp$position_object_library (old_module.file, old_position, valid_position);
      IF NOT valid_position THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      pmp$position_object_library (new_module.file, new_position, valid_position);
      IF NOT valid_position THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      compare (length, record_kind);
      IF error_in_compare THEN
        RETURN;
      IFEND;

      old_module.file := old_reset;
      new_module.file := new_reset;


    PROCEND compare_obs_allotted_seg_defs;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_BIT_STRING_INSERTIONS', EJECT ??

    PROCEDURE compare_bit_string_insertions;


      compare (#SIZE (llt$bit_string_insertion), 'BIT STRING INSERTION');


    PROCEND compare_bit_string_insertions;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_ENTRY_DEFINITIONS', EJECT ??

    PROCEDURE compare_entry_definitions;


      VAR
        old: ^llt$entry_definition,
        new: ^llt$entry_definition;


      NEXT old IN old_module.file;
      NEXT new IN new_module.file;

      IF (old = NIL) OR (new = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;


      IF old^.section_ordinal = new^.section_ordinal THEN
        IF old^.offset = new^.offset THEN
          IF old^.attributes = new^.attributes THEN
            IF old^.name = new^.name THEN
              IF old^.language = new^.language THEN
                IF old^.declaration_matching_required = new^.declaration_matching_required THEN
                  IF old^.declaration_matching_required THEN
                    IF old^.language = llc$cybil THEN
                      IF (old^.declaration_matching.object_encryption =
                            new^.declaration_matching.object_encryption) AND
                            (old^.declaration_matching.source_encryption =
                            new^.declaration_matching.source_encryption) THEN
                        RETURN;
                      IFEND;
                    ELSE
                      IF old^.declaration_matching.language_dependent_value =
                            new^.declaration_matching.language_dependent_value THEN
                        RETURN;
                      IFEND;
                    IFEND;
                  ELSE
                    RETURN;
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;


      compare_error ('ENTRY DEFINITION', old, new);


    PROCEND compare_entry_definitions;
?? OLDTITLE ??
?? NEWTITLE := 'compare_deferred_entry_points', EJECT ??

    PROCEDURE compare_deferred_entry_points
      (    old_size: 1 .. llc$max_deferred_entry_points;
           new_size: 1 .. llc$max_deferred_entry_points);

      CONST
        record_size = 'DEFERRED ENTRY POINT SIZE';

      VAR
        index: 1 .. llc$max_deferred_entry_points,
        new: ^llt$deferred_entry_points,
        old: ^llt$deferred_entry_points;


      IF old_size <> new_size THEN
        compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
        RETURN;
      IFEND;

      NEXT old: [1 .. old_size] IN old_module.file;
      NEXT new: [1 .. new_size] IN new_module.file;

      IF (old = NIL) OR (new = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      FOR index := 1 TO old_size DO
        IF (old^ [index].address.ring = new^ [index].address.ring) AND
              (old^ [index].address.segment = new^ [index].address.segment) AND
              (old^ [index].address.offset = new^ [index].address.offset) THEN
          IF old^ [index].section_ordinal = new^ [index].section_ordinal THEN
            IF old^ [index].attributes = new^ [index].attributes THEN
              IF old^ [index].name = new^ [index].name THEN
                IF old^ [index].language = new^ [index].language THEN
                  IF old^ [index].declaration_matching_required = new^ [index].
                        declaration_matching_required THEN
                    IF (old^ [index].binding_section_address.ring = new^ [index].
                          binding_section_address.ring) AND (old^ [index].binding_section_address.segment =
                          new^ [index].binding_section_address.segment) AND
                          (old^ [index].binding_section_address.offset =
                          new^ [index].binding_section_address.offset) THEN
                      IF old^ [index].declaration_matching_required THEN
                        IF old^ [index].language = llc$cybil THEN
                          IF (old^ [index].declaration_matching_value.object_encryption =
                                new^ [index].declaration_matching_value.object_encryption) AND
                                (old^ [index].declaration_matching_value.source_encryption =
                                new^ [index].declaration_matching_value.source_encryption) AND
                                (old^ [index].source_type_checking = new^ [index].source_type_checking) THEN
                            RETURN;
                          IFEND;
                        ELSE
                          IF old^ [index].declaration_matching_value.language_dependent_value =
                                new^ [index].declaration_matching_value.language_dependent_value THEN
                            RETURN;
                          IFEND;
                        IFEND;
                      ELSE
                        RETURN;
                      IFEND;
                    IFEND;
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND;

      compare_error ('DEFERRED ENTRY POINTS', old, new);


    PROCEND compare_deferred_entry_points;
?? OLDTITLE ??
?? NEWTITLE := 'compare_deferred_common_blocks', EJECT ??

    PROCEDURE compare_deferred_common_blocks
      (    old_size: 1 .. llc$max_deferred_common_blocks;
           new_size: 1 .. llc$max_deferred_common_blocks);

      CONST
        record_size = 'DEFERRED COMMON BLOCK SIZE';

      VAR
        index: 1 .. llc$max_deferred_common_blocks,
        new: ^llt$deferred_common_blocks,
        old: ^llt$deferred_common_blocks;


      IF old_size <> new_size THEN
        compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
        RETURN;
      IFEND;

      NEXT old: [1 .. old_size] IN old_module.file;
      NEXT new: [1 .. new_size] IN new_module.file;

      IF (old = NIL) OR (new = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;

      FOR index := 1 TO old_size DO
        IF (old^ [index].name = new^ [index].name) AND (old^ [index].global_lock = new^ [index].
              global_lock) AND (old^ [index].loaded_ring = new^ [index].loaded_ring) THEN
          IF (old^ [index].address.ring = new^ [index].address.ring) AND
                (old^ [index].address.segment = new^ [index].address.segment) AND
                (old^ [index].address.offset = new^ [index].address.offset) THEN
            IF (old^ [index].allocation_length = new^ [index].allocation_length) AND
                  (old^ [index].allocation_alignment = new^ [index].allocation_alignment) AND
                  (old^ [index].allocation_offset = new^ [index].allocation_offset) THEN
              IF (old^ [index].access_attributes = new^ [index].access_attributes) AND
                    (old^ [index].segment_access_control = new^ [index].segment_access_control) AND
                    (old^ [index].extensible = new^ [index].extensible) THEN
                IF old^ [index].unallocated_common = new^ [index].unallocated_common THEN
                  IF old^ [index].unallocated_common THEN
                    IF old^ [index].unallocated_common_segment = new^ [index].unallocated_common_segment THEN
                      IF old^ [index].unallocated_common_open = new^ [index].unallocated_common_open THEN
                        IF old^ [index].unallocated_common_open THEN
                          IF old^ [index].unallocated_common_file_id = new^ [index].
                                unallocated_common_file_id THEN
                            RETURN;
                          IFEND;
                        ELSE
                          RETURN;
                        IFEND;
                      IFEND;
                    IFEND;
                  ELSE
                    RETURN;
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND;

      compare_error ('DEFERRED COMMON BLOCKS', old, new);


    PROCEND compare_deferred_common_blocks;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_BINDING_TEMPLATE', EJECT ??

    PROCEDURE compare_binding_templates;


      VAR
        old_binding_template: ^llt$binding_template,
        new_binding_template: ^llt$binding_template;


      NEXT old_binding_template IN old_module.file;
      NEXT new_binding_template IN new_module.file;

      IF (old_binding_template = NIL) OR (new_binding_template = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;


      IF old_binding_template^.binding_offset = new_binding_template^.binding_offset THEN
        IF old_binding_template^.kind = new_binding_template^.kind THEN
          CASE old_binding_template^.kind OF
          = llc$current_module =
            IF old_binding_template^.section_ordinal = new_binding_template^.section_ordinal THEN
              IF old_binding_template^.offset = new_binding_template^.offset THEN
                IF old_binding_template^.internal_address = new_binding_template^.internal_address THEN

                  RETURN;

                IFEND;
              IFEND;
            IFEND;

          = llc$external_reference =
            IF old_binding_template^.name = new_binding_template^.name THEN
              IF old_binding_template^.address = new_binding_template^.address THEN

                RETURN;

              IFEND;
            IFEND;
          ELSE
            compare_error ('Invalid BINDING TEMPLATE kind', NIL, NIL);
            RETURN;
          CASEND;
        IFEND;
      IFEND;


      compare_error ('BINDING TEMPLATE', old_binding_template, new_binding_template);


    PROCEND compare_binding_templates;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_LINE_TABLES', EJECT ??

    PROCEDURE compare_obsolete_line_tables
      (    old_size: integer;
           new_size: integer);


      CONST
        record_size = 'OBSOLETE LINE ADDRESS TABLE SIZE',
        record_kind = 'OBSOLETE LINE ADDRESS TABLE';

      VAR
        i: llt$line_address_table_size,
        old: ^llt$obsolete_line_address_table,
        new: ^llt$obsolete_line_address_table,
        dummy: ost$status;


      IF old_size <> new_size THEN
        compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
        RETURN;
      IFEND;


      NEXT old: [1 .. old_size] IN old_module.file;
      NEXT new: [1 .. new_size] IN new_module.file;

      IF (old = NIL) OR (new = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;


      IF old^.original_name = new^.original_name THEN
        IF old^.optimized_code = new^.optimized_code THEN
          IF old^.language = new^.language THEN
            IF old^.number_of_items = new^.number_of_items THEN

            /error_in_item/
              BEGIN

              /next_item/
                FOR i := 1 TO old^.number_of_items DO
                  IF old^.item [i].line_number = new^.item [i].line_number THEN
                    IF old^.item [i].section_ordinal = new^.item [i].section_ordinal THEN
                      IF old^.item [i].offset = new^.item [i].offset THEN
                        IF old^.item [i].extent = new^.item [i].extent THEN
                          IF old^.item [i].statement_labeled = new^.item [i].statement_labeled THEN
                            IF old^.item [i].breakpoint_permitted = new^.item [i].breakpoint_permitted THEN
                              CASE old^.language OF
                              = llc$cybil =
                                IF old^.item [i].cybil_line_kind = new^.item [i].cybil_line_kind THEN
                                  CYCLE /next_item/;
                                IFEND;
                              ELSE
                                compare_error ('Invalid LINE ADDRESS ITEM kind', NIL, NIL);
                                RETURN;
                              CASEND;
                              EXIT /error_in_item/;
                            IFEND;
                          IFEND;
                        IFEND;
                      IFEND;
                    IFEND;
                  IFEND;

                  EXIT /error_in_item/
                FOREND /next_item/;

                RETURN; {no errors}

              END /error_in_item/;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
      compare_error (record_kind, old, new);


    PROCEND compare_obsolete_line_tables;
?? OLDTITLE ??
?? NEWTITLE := ' COMPARE_LINE_TABLES', EJECT ??

    PROCEDURE compare_line_tables
      (    old_size: integer;
           new_size: integer);


      CONST
        record_size = 'LINE ADDRESS TABLE SIZE',
        record_kind = 'LINE ADDRESS TABLE';


      VAR
        i: llt$line_address_table_size,
        old: ^llt$line_address_table,
        new: ^llt$line_address_table,
        dummy: ost$status;


      IF old_size <> new_size THEN
        compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
        RETURN;
      IFEND;


      NEXT old: [1 .. old_size] IN old_module.file;
      NEXT new: [1 .. new_size] IN new_module.file;

      IF (old = NIL) OR (new = NIL) THEN
        compare_error (premature_end_of_file, NIL, NIL);
        RETURN;
      IFEND;



      IF old^.original_module_name = new^.original_module_name THEN
        IF old^.version = new^.version THEN
          IF old^.language = new^.language THEN
            IF old^.optimization_level = new^.optimization_level THEN
              IF old^.number_of_items = new^.number_of_items THEN

              /error_in_item/
                BEGIN

                /next_item/
                  FOR i := 1 TO old^.number_of_items DO
                    IF old^.item [i].line_number = new^.item [i].line_number THEN
                      IF old^.item [i].section_ordinal = new^.item [i].section_ordinal THEN
                        IF old^.item [i].offset = new^.item [i].offset THEN
                          IF old^.item [i].extent = new^.item [i].extent THEN
                            IF old^.item [i].nesting_level = new^.item [i].nesting_level THEN
                              IF old^.item [i].line_attributes = new^.item [i].line_attributes THEN
                                CASE old^.language OF
                                = llc$cybil =
                                  IF old^.item [i].cybil_statement_kind = new^.item [i].
                                       cybil_statement_kind THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               = llc$cobol =
                                 IF old^.item [i].cobol_statement_kind = new^.item [i].
                                       cobol_statement_kind THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               = llc$fortran =
                                 IF old^.item [i].fortran_statement_kind =
                                       new^.item [i].fortran_statement_kind THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               = llc$basic =
                                 IF old^.item [i].basic_statement_kind = new^.item [i].
                                       basic_statement_kind THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               = llc$pascal =
                                 IF old^.item [i].pascal_statement_kind = new^.item [i].
                                       pascal_statement_kind THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               = llc$the_c_language =
                                 IF old^.item [i].c_statement_kind = new^.item [i].
                                       c_statement_kind THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               ELSE
                                 compare_error ('invalid STATEMENT ADDRESS ITEM kind', NIL, NIL);
                                 RETURN;
                               CASEND;
                               EXIT /error_in_item/;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;


                   EXIT /error_in_item/
                 FOREND /next_item/;
                 RETURN; {no errors}
               END /error_in_item/;
             IFEND;
           IFEND;
         IFEND;
       IFEND;
     IFEND;
     compare_error (record_kind, old, NIL);


   PROCEND compare_line_tables;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_FORM_DEF_RECORDS', EJECT ??

   PROCEDURE compare_form_def_records;

     compare_error ('Form def found in object module', NIL, NIL);

   PROCEND compare_form_def_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_PPU_ABSOLUTE_RECORDS', EJECT ??

   PROCEDURE compare_ppu_absolute_records
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'PPU ABSOLUTE SIZE',
       record_kind = 'PPU ABSOLUTE';

     VAR
       dummy: ^llt$ppu_absolute;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [0 .. old_size];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_ppu_absolute_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_68000_ABSOLUTE_RECORDS', EJECT ??

   PROCEDURE compare_68000_absolute_records
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'MOTOROLA 68000 ABSOLUTE SIZE',
       record_kind = 'MOTOROLA 68000 ABSOLUTE';

     VAR
       dummy: ^llt$68000_absolute;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [[REP old_size OF cell]];

     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_68000_absolute_records;

?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_APPLICATION_IDENTIFIERS', EJECT ??

   PROCEDURE compare_application_identifiers;


     VAR
       old: ^llt$application_identifier,
       new: ^llt$application_identifier;


     NEXT old IN old_module.file;
     NEXT new IN new_module.file;


     IF (old = NIL) OR (new = NIL) THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     IF old^.name = new^.name THEN
       RETURN;
     IFEND;

     compare_error ('APPLICATION_IDENTIFIER', old, new);


   PROCEND compare_application_identifiers;

?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_LIBRARIES', EJECT ??

   PROCEDURE compare_libraries
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'NUMBER OF LIBRARIES',
       record_kind = 'LIBRARIES';

     VAR
       dummy: ^llt$libraries;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [1 .. old_size];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_libraries;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_TEXT_RECORDS', EJECT ??

   PROCEDURE compare_text_records
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'TEXT SIZE',
       record_kind = 'TEXT';

     VAR
       dummy: ^llt$text;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [1 .. old_size];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_text_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_REPLICATION_RECORDS', EJECT ??

   PROCEDURE compare_replication_records
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'REPLICATION SIZE',
       record_kind = 'REPLICATION';

     VAR
       dummy: ^llt$replication;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [1 .. old_size];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_replication_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_RELOCATION_RECORDS', EJECT ??

   PROCEDURE compare_relocation_records
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'RELOCATION SIZE',
       record_kind = 'RELOCATION';

     VAR
       dummy: ^llt$relocation;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [1 .. old_size];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_relocation_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_ADDRESS_FORMULATIONS', EJECT ??

   PROCEDURE compare_address_formulations
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'ADDRESS FORMULATION SIZE',
       record_kind = 'ADDRESS FORMULATION';

     VAR
       dummy: ^llt$address_formulation;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [1 .. old_size];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_address_formulations;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_EXTERNAL_LINKAGES', EJECT ??

   PROCEDURE compare_external_linkages
     (    old_size: integer;
          new_size: integer);



     CONST
       record_size = 'EXTERNAL LINKAGE SIZE',
       record_kind = 'EXTERNAL LINKAGE';

     VAR
       declaration_matching_passes: boolean,
       old: ^llt$external_linkage,
       new: ^llt$external_linkage,

       i: integer;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;

     NEXT old: [1 .. old_size] IN old_module.file;
     NEXT new: [1 .. new_size] IN new_module.file;

     IF (old = NIL) OR (new = NIL) THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;


     IF old^.name = new^.name THEN
       IF old^.language = new^.language THEN
         IF old^.declaration_matching_required = new^.declaration_matching_required THEN
           declaration_matching_passes := FALSE;
           IF old^.language = llc$cybil THEN
             IF (old^.declaration_matching.object_encryption =
                   new^.declaration_matching.object_encryption) AND
                   (old^.declaration_matching.source_encryption = new^.declaration_matching.source_encryption)
                   THEN
               declaration_matching_passes := TRUE;
             IFEND;
           ELSE
             IF old^.declaration_matching.language_dependent_value =
                   new^.declaration_matching.language_dependent_value THEN
               declaration_matching_passes := TRUE;
             IFEND;
           IFEND;
           IF (NOT old^.declaration_matching_required) OR declaration_matching_passes THEN

           /error_in_item/
             BEGIN

             /next_item/
               FOR i := 1 TO old_size DO
                 IF old^.item [i].section_ordinal = new^.item [i].section_ordinal THEN
                   IF old^.item [i].offset = new^.item [i].offset THEN
                     IF old^.item [i].kind = new^.item [i].kind THEN
                       IF (NOT ((old^.item [i].kind = llc$address_addition) OR
                             (old^.item [i].kind = llc$address_subtraction))) OR
                             (old^.item [i].offset_operand = new^.item [i].offset_operand) THEN
                         CYCLE /next_item/
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;

                 EXIT /error_in_item/;
               FOREND /next_item/;

               RETURN; { no errors }
             END /error_in_item/;
           IFEND;
         IFEND;
       IFEND;
     IFEND;


     compare_error (record_kind, old, new);


   PROCEND compare_external_linkages;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_FORMAL_PARAMETERS', EJECT ??

   PROCEDURE compare_formal_parameters
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'FORMAL PARAMETERS SIZE',
       record_kind = 'FORMAL PARAMETERS';

     VAR
       dummy: ^llt$formal_parameters;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [[REP old_size OF cell]];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_formal_parameters;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_ACTUAL_PARAMETERS', EJECT ??

   PROCEDURE compare_actual_parameters
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'ACTUAL PARAMETERS SIZE',
       record_kind = 'ACTUAL PARAMETERS';

     VAR
       dummy: ^llt$actual_parameters;


     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     PUSH dummy: [[REP old_size OF cell]];


     compare (#SIZE (dummy^), record_kind);


   PROCEND compare_actual_parameters;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_CYBIL_SYMBOL_TABLES', EJECT ??

   PROCEDURE compare_cybil_symbol_tables
     (    old_size: integer;
          new_size: integer);


     CONST
       cybil_symbol_table_size = 'CYBIL SYMBOL TABLE SIZE',
       cybil_symbol_table = 'CYBIL SYMBOL TABLE';

     VAR
       i: symbol_no,
       old: ^llt$debug_table_fragment,
       new: ^llt$debug_table_fragment,
       old_text: ^SEQ ( * ),
       new_text: ^SEQ ( * ),
       size_of_old_text: ost$segment_length,
       size_of_new_text: ost$segment_length,
       old_symbol_table_header: ^cyt$debug_symbol_table_header,
       new_symbol_table_header: ^cyt$debug_symbol_table_header,
       old_items: ^array [ * ] of cyt$debug_symbol_table_item,
       new_items: ^array [ * ] of cyt$debug_symbol_table_item,
       number_of_symbol_table_items: symbol_no,
       dummy: ost$status;


     IF old_size <> new_size THEN
       compare_error (cybil_symbol_table_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     NEXT old: [[REP old_size OF cell]] IN old_module.file;
     NEXT new: [[REP new_size OF cell]] IN new_module.file;

     IF (old = NIL) OR (new = NIL) THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;


     IF old^.offset = new^.offset THEN
       old_text := ^old^.text;
       RESET old_text;
       size_of_old_text := #SIZE (old_text^);
       new_text := ^new^.text;
       RESET new_text;
       size_of_new_text := #SIZE (new_text^);

     /compare_headers/
       BEGIN
         IF size_of_old_text = size_of_new_text THEN
           IF (size_of_old_text MOD #SIZE (cyt$debug_symbol_table_item)) <> 0 THEN
             NEXT old_symbol_table_header IN old_text;
             NEXT new_symbol_table_header IN new_text;
             IF (old_symbol_table_header = NIL) OR (new_symbol_table_header = NIL) THEN
               compare_error (premature_end_of_file, NIL, NIL);
               RETURN;
             IFEND;
             IF old_symbol_table_header^ = new_symbol_table_header^ THEN
               IF old_symbol_table_header^.language = new_symbol_table_header^.language THEN
                 IF old_symbol_table_header^.optimization_level =
                       new_symbol_table_header^.optimization_level THEN
                   IF old_symbol_table_header^.version = new_symbol_table_header^.version THEN
                     IF old_symbol_table_header^.module_symbol_list =
                           new_symbol_table_header^.module_symbol_list THEN
                       IF old_symbol_table_header^.number_of_symbols =
                             new_symbol_table_header^.number_of_symbols THEN
                         size_of_old_text := size_of_old_text - #SIZE (cyt$debug_symbol_table_header);
                         EXIT /compare_headers/;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               IFEND;
             IFEND;
             compare_error (cybil_symbol_table, old_symbol_table_header, new_symbol_table_header);
             RETURN;
           IFEND;
         IFEND;
       END /compare_headers/;
       number_of_symbol_table_items := size_of_old_text DIV #SIZE (cyt$debug_symbol_table_item);


       NEXT old_items: [1 .. number_of_symbol_table_items] IN old_text;
       NEXT new_items: [1 .. number_of_symbol_table_items] IN new_text;
       IF (old_items = NIL) OR (new_items = NIL) THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;

     /error_in_item/
       BEGIN

       /next_item/
         FOR i := 1 TO number_of_symbol_table_items DO
           IF old_items^ [i].symbol_name = new_items^ [i].symbol_name THEN
             IF old_items^ [i].end_of_chain = new_items^ [i].end_of_chain THEN
               IF old_items^ [i].symtab_no = new_items^ [i].symtab_no THEN
                 IF old_items^ [i].symbol_type = new_items^ [i].symbol_type THEN
                   CASE old_items^ [i].symbol_type OF
                   = int_kind, bool_kind, char_kind, real_kind, longreal_kind, cell_kind =
                     CYCLE /next_item/;
                   = var_kind =
                     IF old_items^ [i].var_type = new_items^ [i].var_type THEN
                       IF old_items^ [i].var_length = new_items^ [i].var_length THEN
                         IF old_items^ [i].base = new_items^ [i].base THEN
                           IF old_items^ [i].var_section_ordinal = new_items^ [i].var_section_ordinal THEN
                             IF old_items^ [i].var_offset = new_items^ [i].var_offset THEN
                               IF old_items^ [i].indirectly_referenced = new_items^ [i].
                                     indirectly_referenced THEN
                                 IF old_items^ [i].var_is_parameter = new_items^ [i].var_is_parameter THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = cons_kind =
                     IF old_items^ [i].cons_type = new_items^ [i].cons_type THEN
                       IF old_items^ [i].cons_length_type = new_items^ [i].cons_length_type THEN
                         IF old_items^ [i].cons_value = new_items^ [i].cons_value THEN
                           CYCLE /next_item/;
                         IFEND;
                       IFEND;
                     IFEND;
                   = label_kind =
                     IF old_items^ [i].line_no = new_items^ [i].line_no THEN
                       CYCLE /next_item/;
                     IFEND;
                   = ordinal_kind =
                     IF old_items^ [i].last_const = new_items^ [i].last_const THEN
                       IF old_items^ [i].upper_bound = new_items^ [i].upper_bound THEN
                         CYCLE /next_item/;
                       IFEND;
                     IFEND;
                   = subrange_kind =
                     IF old_items^ [i].subtype = new_items^ [i].subtype THEN
                       IF old_items^ [i].low_value_type = new_items^ [i].low_value_type THEN
                         IF old_items^ [i].high_value_type = new_items^ [i].high_value_type THEN
                           IF old_items^ [i].low_value = new_items^ [i].low_value THEN
                             IF old_items^ [i].high_value = new_items^ [i].high_value THEN
                               CYCLE /next_item/;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = proc_kind =
                     IF old_items^ [i].lexical_level = new_items^ [i].lexical_level THEN
                       IF old_items^ [i].symbol_list = new_items^ [i].symbol_list THEN
                         IF old_items^ [i].proc_section_ordinal = new_items^ [i].proc_section_ordinal THEN
                           IF old_items^ [i].proc_offset = new_items^ [i].proc_offset THEN
                             IF old_items^ [i].proc_length = new_items^ [i].proc_length THEN
                               IF old_items^ [i].parent_proc = new_items^ [i].parent_proc THEN
                                 IF old_items^ [i].return_type = new_items^ [i].return_type THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = pointer_kind =
                     IF old_items^ [i].ptr_type = new_items^ [i].ptr_type THEN
                       IF old_items^ [i].ptr_object_length = new_items^ [i].ptr_object_length THEN
                         CYCLE /next_item/;
                       IFEND;
                     IFEND;
                   = set_kind =
                     IF old_items^ [i].set_element_type = new_items^ [i].set_element_type THEN
                       IF old_items^ [i].set_len = new_items^ [i].set_len THEN
                         CYCLE /next_item/;
                       IFEND;
                     IFEND;
                   = string_kind =
                     IF old_items^ [i].len_type = new_items^ [i].len_type THEN
                       IF old_items^ [i].string_len = new_items^ [i].string_len THEN
                         CYCLE /next_item/;
                       IFEND;
                     IFEND;
                   = array_kind =
                     IF old_items^ [i].array_binding = new_items^ [i].array_binding THEN
                       IF old_items^ [i].array_packing = new_items^ [i].array_packing THEN
                         IF old_items^ [i].length_is_bits = new_items^ [i].length_is_bits THEN
                           IF old_items^ [i].index_type = new_items^ [i].index_type THEN
                             IF old_items^ [i].array_element_type = new_items^ [i].array_element_type THEN
                               IF old_items^ [i].element_length = new_items^ [i].element_length THEN
                                 CYCLE /next_item/;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = record_kind =
                     IF old_items^ [i].record_binding = new_items^ [i].record_binding THEN
                       IF old_items^ [i].record_packing = new_items^ [i].record_packing THEN
                         IF old_items^ [i].variation_flag = new_items^ [i].variation_flag THEN
                           IF old_items^ [i].first_field = new_items^ [i].first_field THEN
                             IF old_items^ [i].record_length = new_items^ [i].record_length THEN
                               IF old_items^ [i].selector = new_items^ [i].selector THEN
                                 CYCLE /next_item/;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = field_kind =
                     IF old_items^ [i].field_offset = new_items^ [i].field_offset THEN
                       IF old_items^ [i].field_length = new_items^ [i].field_length THEN
                         IF old_items^ [i].unit_addressed = new_items^ [i].unit_addressed THEN
                           IF old_items^ [i].field_type = new_items^ [i].field_type THEN
                             IF old_items^ [i].next_field = new_items^ [i].next_field THEN
                               CYCLE /next_item/;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = selector_kind =
                     IF old_items^ [i].variation = new_items^ [i].variation THEN
                       IF old_items^ [i].next_selector = new_items^ [i].next_selector THEN
                         IF old_items^ [i].low_selector = new_items^ [i].low_selector THEN
                           IF old_items^ [i].high_selector = new_items^ [i].high_selector THEN
                             CYCLE /next_item/;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   = heap_kind =
                     CYCLE /next_item/;
                   = seq_kind =
                     CYCLE /next_item/;
                   = bound_vrec_kind =
                     IF old_items^ [i].bound_type = new_items^ [i].bound_type THEN
                       CYCLE /next_item/;
                     IFEND;
                   = rel_ptr_kind =
                     IF old_items^ [i].parent_type = new_items^ [i].parent_type THEN
                       IF old_items^ [i].object_type = new_items^ [i].object_type THEN
                         IF old_items^ [i].rel_ptr_object_length = new_items^ [i].rel_ptr_object_length THEN
                           CYCLE /next_item/;
                         IFEND;
                       IFEND;
                     IFEND;
                   = error_kind, vstring_spare_kind, union_spare_kind, lbl_typ_spare_kind, nil_kind,
                         parameter_kind, proc_decl_kind, file_kind, union_spare_element_kind, span_elem_kind,
                         module_kind, prong_kind, synonym_kind, last_one, section_kind =
                     CYCLE /next_item/;
                   ELSE
                     compare_error ('Invalid CYBIL SYMBOL TABLE ITEM kind', NIL, NIL);
                     RETURN;
                   CASEND;
                 IFEND;
               IFEND;
             IFEND;
           IFEND;
           EXIT /error_in_item/;
         FOREND /next_item/;

         RETURN; {no errors}

       END /error_in_item/;
     IFEND;

     compare_error (cybil_symbol_table, old_items, new_items);


   PROCEND compare_cybil_symbol_tables;
?? OLDTITLE ??
?? NEWTITLE := '     COMPARE_DEBUG_SYMBOL_TABLES', EJECT ??

   PROCEDURE compare_debug_symbol_tables
     (    old_size: integer;
          new_size: integer);


     CONST
       record_size = 'DEBUG SYMBOL TABLE SIZE',
       record_kind = 'DEBUG SYMBOL TABLE';

     VAR
       i: llt$symbol_number,
       old: ^llt$symbol_table,
       new: ^llt$symbol_table,
       old_text: ^SEQ ( * ),
       new_text: ^SEQ ( * ),
       size_of_old_text: llt$section_length,
       size_of_new_text: llt$section_length,
       old_symbol_table_header: ^llt$debug_symbol_table,
       new_symbol_table_header: ^llt$debug_symbol_table,
       old_items: ^llt$debug_symbol_table,
       new_items: ^llt$debug_symbol_table,
       number_of_symbol_table_items: symbol_no,
       dummy: ost$status;



     IF old_size <> new_size THEN
       compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
       RETURN;
     IFEND;


     NEXT old: [[REP old_size OF cell]] IN old_module.file;
     NEXT new: [[REP new_size OF cell]] IN new_module.file;

     IF (old = NIL) OR (new = NIL) THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;


     IF old^.language = new^.language THEN
       old_text := ^old^.text;
       RESET old_text;
       size_of_old_text := #SIZE (old_text^);
       new_text := ^new^.text;
       RESET new_text;
       size_of_new_text := #SIZE (new_text^);

     /compare_headers/
       BEGIN
         IF size_of_old_text = size_of_new_text THEN
           IF (size_of_old_text MOD #SIZE (llt$symbol_table_item)) <> 0 THEN
             NEXT old_symbol_table_header: [1 .. 1] IN old_text;
             NEXT new_symbol_table_header: [1 .. 1] IN new_text;
             IF (old_symbol_table_header = NIL) OR (new_symbol_table_header = NIL) THEN
               compare_error (premature_end_of_file, NIL, NIL);
               RETURN;
             IFEND;
             IF old_symbol_table_header^.original_module_name =
                   new_symbol_table_header^.original_module_name THEN
               IF old_symbol_table_header^.language = new_symbol_table_header^.language THEN
                 IF old_symbol_table_header^.optimization_level =
                       new_symbol_table_header^.optimization_level THEN
                   IF old_symbol_table_header^.version = new_symbol_table_header^.version THEN
                     IF old_symbol_table_header^.first_symbol_for_module =
                           new_symbol_table_header^.first_symbol_for_module THEN
                       IF old_symbol_table_header^.number_of_items =
                             new_symbol_table_header^.number_of_items THEN
                         IF old_symbol_table_header^.attributes = new_symbol_table_header^.attributes THEN
                           EXIT /compare_headers/;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               IFEND;
             IFEND;
             compare_error (record_kind, old_symbol_table_header, new_symbol_table_header);
             RETURN;
           IFEND;
         IFEND;
       END /compare_headers/;
       number_of_symbol_table_items := old_symbol_table_header^.number_of_items;
       RESET old_text;
       RESET new_text;
       NEXT old_items: [1 .. number_of_symbol_table_items] IN old_text;
       NEXT new_items: [1 .. number_of_symbol_table_items] IN new_text;
       IF (old_items = NIL) OR (new_items = NIL) THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;

     /error_in_item/
       BEGIN

       /next_item/
         FOR i := 1 TO number_of_symbol_table_items DO
           IF old_items^.item [i].symbol_name = new_items^.item [i].symbol_name THEN
             IF old_items^.item [i].end_of_chain = new_items^.item [i].end_of_chain THEN
               IF old_items^.item [i].symbol_kind = new_items^.item [i].symbol_kind THEN
                 CASE old_items^.item [i].symbol_kind OF
                 = llc$integer_kind, llc$boolean_kind, llc$char_kind, llc$real_kind, llc$longreal_kind,
                       llc$cell_kind, llc$complex_kind, llc$ftn_logical_kind, llc$ftn_boolean_kind,
                       llc$bit_kind, llc$shortreal_kind, llc$ftn_subprogram_name, llc$ftn_character_kind,
                       llc$typeless_kind, llc$filename_kind, llc$bdp_pdu, llc$bdp_pdulsd, llc$bdp_pds,
                       llc$bdp_pdslsd, llc$bdp_udu, llc$bdp_udtsch, llc$bdp_udtss, llc$bdp_bu, llc$bdp_tpds,
                       llc$bdp_tpdslsd, llc$bdp_tbu, llc$bdp_tbs, llc$bdp_a, llc$cobol_justified,
                       llc$cobol_index_data_item, llc$cobol_index_name, llc$bdp_udlsch, llc$bdp_udlss,
                       llc$cobol_numeric_edited, llc$cobol_a_edited, llc$unsigned_integer_kind =
                   CYCLE /next_item/;
                 = llc$var_kind =
                   IF old_items^.item [i].var_type = new_items^.item [i].var_type THEN
                     IF old_items^.item [i].var_length = new_items^.item [i].var_length THEN
                       IF old_items^.item [i].var_base = new_items^.item [i].var_base THEN
                         IF old_items^.item [i].var_section_ordinal = new_items^.item [i].
                               var_section_ordinal THEN
                           IF old_items^.item [i].var_offset = new_items^.item [i].var_offset THEN
                             IF old_items^.item [i].var_attributes = new_items^.item [i].var_attributes THEN
                               IF old_items^.item [i].var_containing_symbol =
                                     new_items^.item [i].var_containing_symbol THEN
                                 IF old_items^.item [i].var_point_location =
                                       new_items^.item [i].var_point_location THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 = llc$cobol_array_kind =
                   IF old_items^.item [i].cobol_array_element_type =
                         new_items^.item [i].cobol_array_element_type THEN
                     IF old_items^.item [i].cobol_subscript_count = new_items^.item [i].
                           cobol_subscript_count THEN
                       IF old_items^.item [i].max_cobol_subscript_value =
                             new_items^.item [i].max_cobol_subscript_value THEN
                         IF old_items^.item [i].occurrence_length = new_items^.item [i].occurrence_length THEN
                           CYCLE /next_item/;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 = llc$constant_kind =
                   IF old_items^.item [i].constant_type = new_items^.item [i].constant_type THEN
                     IF old_items^.item [i].constant_length = new_items^.item [i].constant_length THEN
                       IF old_items^.item [i].constant_kind = new_items^.item [i].constant_kind THEN
                         CASE old_items^.item [i].constant_kind OF
                         = llc$short_constant =
                           IF old_items^.item [i].short_constant_value.kind =
                                 new_items^.item [i].short_constant_value.kind THEN
                             CASE old_items^.item [i].short_constant_value.kind OF
                             = llc$boolean_kind =
                               IF old_items^.item [i].short_constant_value.boolean_value = new_items^.
                                     item [i].short_constant_value.boolean_value THEN
                                 CYCLE /next_item/;
                               IFEND;

                             = llc$char_kind =
                               IF old_items^.item [i].short_constant_value.char_value =
                                     new_items^.item [i].short_constant_value.char_value THEN
                                 CYCLE /next_item/;
                               IFEND;

                             = llc$bit_kind =
                               IF old_items^.item [i].short_constant_value.bit_value =
                                     new_items^.item [i].short_constant_value.bit_value THEN
                                 CYCLE /next_item/;
                               IFEND;

                             = llc$integer_kind =
                               IF old_items^.item [i].short_constant_value.integer_value = new_items^.
                                     item [i].short_constant_value.integer_value THEN
                                 CYCLE /next_item/;
                               IFEND;
                             CASEND;
                           IFEND;
                         = llc$medium_constant =
                           IF old_items^.item [i].medium_constant_value.kind =
                                 new_items^.item [i].medium_constant_value.kind THEN
                             CASE old_items^.item [i].medium_constant_value.kind OF
                             = llc$integer_kind =
                               IF old_items^.item [i].medium_constant_value.integer_value = new_items^.
                                     item [i].medium_constant_value.integer_value THEN
                                 CYCLE /next_item/;
                               IFEND;
                             = llc$real_kind =
                               IF old_items^.item [i].medium_constant_value.real_value =
                                     new_items^.item [i].medium_constant_value.real_value THEN
                                 CYCLE /next_item/;
                               IFEND;
                             = llc$shortreal_kind =
                               IF old_items^.item [i].medium_constant_value.shortreal_value =
                                     new_items^.item [i].medium_constant_value.shortreal_value THEN
                                 CYCLE /next_item/;
                               IFEND;
                             CASEND;
                           IFEND;
                         = llc$long_constant =
                           IF old_items^.item [i].constant_section_ordinal =
                                 new_items^.item [i].constant_section_ordinal THEN
                             IF old_items^.item [i].constant_offset = new_items^.item [i].constant_offset THEN
                               CYCLE /next_item/;
                             IFEND;
                           IFEND;
                         ELSE
                           compare_error ('INVALID DEBUG SYMBOL TABLE ITEM CONSTANT', NIL, NIL);
                           RETURN;
                         CASEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 = llc$label_kind =
                   IF old_items^.item [i].label_attributes = new_items^.item [i].label_attributes THEN
                     IF old_items^.item [i].label_section_ordinal = new_items^.item [i].
                           label_section_ordinal THEN
                       IF old_items^.item [i].label_offset = new_items^.item [i].label_offset THEN
                         IF old_items^.item [i].label_scope = new_items^.item [i].label_scope THEN
                           IF old_items^.item [i].label_containing_symbol =
                                 new_items^.item [i].label_containing_symbol THEN
                             CYCLE /next_item/;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 = llc$ordinal_kind =
                   IF old_items^.item [i].last_constant = new_items^.item [i].last_constant THEN
                     IF old_items^.item [i].ordinal_upper_bound = new_items^.item [i].ordinal_upper_bound THEN
                       CYCLE /next_item/;
                     IFEND;
                   IFEND;
                 = llc$subrange_kind =
                   IF old_items^.item [i].subtype = new_items^.item [i].subtype THEN
                     IF old_items^.item [i].low_value_type = new_items^.item [i].low_value_type THEN
                       IF old_items^.item [i].high_value_type = new_items^.item [i].high_value_type THEN
                         IF old_items^.item [i].low_value = new_items^.item [i].low_value THEN
                           IF old_items^.item [i].high_value = new_items^.item [i].high_value THEN
                             CYCLE /next_item/;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 = llc$proc_kind =
                   IF old_items^.item [i].proc_lexical_level = new_items^.item [i].proc_lexical_level THEN
                     IF old_items^.item [i].first_symbol_for_proc = new_items^.item [i].
                           first_symbol_for_proc THEN
                       IF old_items^.item [i].proc_section_ordinal = new_items^.item [i].
                             proc_section_ordinal THEN
                         IF old_items^.item [i].proc_offset = new_items^.item [i].proc_offset THEN
                           IF old_items^.item [i].proc_length = new_items^.item [i].proc_length THEN
                             IF old_items^.item [i].proc_parent = new_items^.item [i].proc_parent THEN
                               IF old_items^.item [i].proc_attributes = new_items^.item [i].
                                     proc_attributes THEN
                                 IF old_items^.item [i].proc_return_type =
                                       new_items^.item [i].proc_return_type THEN
                                   IF old_items^.item [i].proc_return_length =
                                       new_items^.item [i].proc_return_length THEN
                                   CYCLE /next_item/;
                                 IFEND;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$pointer_kind =
                 IF old_items^.item [i].ptr_type = new_items^.item [i].ptr_type THEN
                   IF old_items^.item [i].ptr_object_length = new_items^.item [i].ptr_object_length THEN
                     CYCLE /next_item/;
                   IFEND;
                 IFEND;
               = llc$set_kind =
                 IF old_items^.item [i].set_element_type = new_items^.item [i].set_element_type THEN
                   IF old_items^.item [i].set_length = new_items^.item [i].set_length THEN
                     CYCLE /next_item/;
                   IFEND;
                 IFEND;
               = llc$string_kind =
                 IF old_items^.item [i].string_length_type = new_items^.item [i].string_length_type THEN
                   IF old_items^.item [i].string_length = new_items^.item [i].string_length THEN
                     CYCLE /next_item/;
                   IFEND;
                 IFEND;
               = llc$cybil_array_kind =
                 IF old_items^.item [i].cybil_array_binding = new_items^.item [i].cybil_array_binding THEN
                   IF old_items^.item [i].cybil_array_packing = new_items^.item [i].cybil_array_packing THEN
                     IF old_items^.item [i].cybil_array_attributes =
                           new_items^.item [i].cybil_array_attributes THEN
                       IF old_items^.item [i].cybil_index_type = new_items^.item [i].cybil_index_type THEN
                         IF old_items^.item [i].cybil_array_element_type =
                               new_items^.item [i].cybil_array_element_type THEN
                           IF old_items^.item [i].cybil_array_element_length =
                                 new_items^.item [i].cybil_array_element_length THEN
                             CYCLE /next_item/;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$record_kind =
                 IF old_items^.item [i].record_binding = new_items^.item [i].record_binding THEN
                   IF old_items^.item [i].record_packing = new_items^.item [i].record_packing THEN
                     IF old_items^.item [i].record_attributes = new_items^.item [i].record_attributes THEN
                       IF old_items^.item [i].record_first_field = new_items^.item [i].record_first_field THEN
                         IF old_items^.item [i].record_length = new_items^.item [i].record_length THEN
                           IF old_items^.item [i].record_selector = new_items^.item [i].record_selector THEN
                             CYCLE /next_item/;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$field_kind =
                 IF old_items^.item [i].field_offset = new_items^.item [i].field_offset THEN
                   IF old_items^.item [i].field_length = new_items^.item [i].field_length THEN
                     IF old_items^.item [i].field_attributes = new_items^.item [i].field_attributes THEN
                       IF old_items^.item [i].field_type = new_items^.item [i].field_type THEN
                         IF old_items^.item [i].next_field = new_items^.item [i].next_field THEN
                           CYCLE /next_item/;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$selector_kind =
                 IF old_items^.item [i].variation = new_items^.item [i].variation THEN
                   IF old_items^.item [i].next_selector = new_items^.item [i].next_selector THEN
                     IF old_items^.item [i].low_selector = new_items^.item [i].low_selector THEN
                       IF old_items^.item [i].high_selector = new_items^.item [i].high_selector THEN
                         CYCLE /next_item/;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$heap_kind =
                 CYCLE /next_item/;
               = llc$seq_kind =
                 CYCLE /next_item/;
               = llc$bound_vrec_kind =
                 IF old_items^.item [i].bound_type = new_items^.item [i].bound_type THEN
                   CYCLE /next_item/;
                 IFEND;
               = llc$rel_ptr_kind =
                 IF old_items^.item [i].parent_type = new_items^.item [i].parent_type THEN
                   IF old_items^.item [i].object_type = new_items^.item [i].object_type THEN
                     IF old_items^.item [i].rel_ptr_object_length = new_items^.item [i].
                           rel_ptr_object_length THEN
                       CYCLE /next_item/;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$ftn_array_kind =
                 IF old_items^.item [i].ftn_array_element_type = new_items^.item [i].
                       ftn_array_element_type THEN
                   IF old_items^.item [i].ftn_array_element_length =
                         new_items^.item [i].ftn_array_element_length THEN
                     IF old_items^.item [i].ftn_array_base = new_items^.item [i].ftn_array_base THEN
                       IF old_items^.item [i].ftn_array_section_ordinal =
                             new_items^.item [i].ftn_array_section_ordinal THEN
                         IF old_items^.item [i].ftn_array_offset = new_items^.item [i].ftn_array_offset THEN
                           IF old_items^.item [i].ftn_array_attributes =
                                 new_items^.item [i].ftn_array_attributes THEN
                             IF old_items^.item [i].dimension_info_section_ordinal =
                                   new_items^.item [i].dimension_info_section_ordinal THEN
                               IF old_items^.item [i].dimension_info_offset =
                                     new_items^.item [i].dimension_info_offset THEN
                                 CYCLE /next_item/;
                               IFEND;
                             IFEND;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$namelist_group_kind =
                 IF old_items^.item [i].namelist_info_section_ordinal =
                       new_items^.item [i].namelist_info_section_ordinal THEN
                   IF old_items^.item [i].namelist_info_offset = new_items^.item [i].namelist_info_offset THEN
                     CYCLE /next_item/;
                   IFEND;
                 IFEND;
               = llc$equated_label =
                 IF old_items^.item [i].first_equated_symbol = new_items^.item [i].first_equated_symbol THEN
                   CYCLE /next_item/;
                 IFEND;
               = llc$external_equate =
                 IF old_items^.item [i].operation = new_items^.item [i].operation THEN
                   IF old_items^.item [i].operand = new_items^.item [i].operand THEN
                     CYCLE /next_item/;
                   IFEND;
                 IFEND;
               = llc$basic_array_kind =
                 IF old_items^.item [i].basic_array_element_type =
                       new_items^.item [i].basic_array_element_type THEN
                   CYCLE /next_item/;
                 IFEND;
               = llc$pascal_conf_array_kind =
                 IF old_items^.item [i].conf_array_packing = new_items^.item [i].conf_array_packing THEN
                   IF old_items^.item [i].conf_array_attributes = new_items^.item [i].
                         conf_array_attributes THEN
                     IF old_items^.item [i].conf_array_lower_bound =
                           new_items^.item [i].conf_array_lower_bound THEN
                       IF old_items^.item [i].conf_array_upper_bound =
                             new_items^.item [i].conf_array_upper_bound THEN
                         IF old_items^.item [i].conf_array_element_kind =
                               new_items^.item [i].conf_array_element_kind THEN
                           IF old_items^.item [i].conf_array_element_length =
                                 new_items^.item [i].conf_array_element_length THEN
                             CYCLE /next_item/;
                           IFEND;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               = llc$pascal_file_kind =
                 IF old_items^.item [i].buffer_type = new_items^.item [i].buffer_type THEN
                   CYCLE /next_item/;
                 IFEND;
               = llc$pascal_with_kind =
                 IF old_items^.item [i].with_first_symbol = new_items^.item [i].with_first_symbol THEN
                   IF old_items^.item [i].with_section_ordinal = new_items^.item [i].with_section_ordinal THEN
                     IF old_items^.item [i].with_offset = new_items^.item [i].with_offset THEN
                       IF old_items^.item [i].with_length = new_items^.item [i].with_length THEN
                         IF old_items^.item [i].with_parent = new_items^.item [i].with_parent THEN
                           CYCLE /next_item/;
                         IFEND;
                       IFEND;
                     IFEND;
                   IFEND;
                 IFEND;
               ELSE
                 compare_error ('invalid DEBUG SYMBOL TABLE ITEM kind', NIL, NIL);
                 RETURN;
               CASEND;
             IFEND;
           IFEND;
         IFEND;
         EXIT /error_in_item/;
       FOREND /next_item/;
       RETURN; {no errors}

     END /error_in_item/;
   IFEND;

   compare_error (record_kind, old_items, new_items);

 PROCEND compare_debug_symbol_tables;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_SUPPLEMENTAL_DTABLES', EJECT ??

 PROCEDURE compare_supplemental_dtables
   (    old_size: integer;
        new_size: integer);

  VAR
    new: ^string ( * ),
    old: ^string ( * );

{ CV2 uses the supplemental debug table to store file names and time stamps for the included
{ files.  This information varies for every compilation.  Therefore, a difference will always
{ be detected, but it does not indicate that a significant change has occurred.  This table
{ will be skipped.

   NEXT old: [old_size] IN old_module.file;
   NEXT new: [new_size] IN new_module.file;
   RETURN;

 PROCEND compare_supplemental_dtables;

?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_OBS_FORMAL_PARAMETERS', EJECT ??

 PROCEDURE compare_obs_formal_parameters
   (    old_size: integer;
        new_size: integer);

   CONST
     record_size = 'OBSOLETE FORMAL PARAMETERS SIZE',
     record_kind = 'OBSOLETE FORMAL PARAMETERS';

   VAR
     dummy: ^llt$obsolete_formal_parameters;

   IF old_size <> new_size THEN
     compare_error (record_size, old_object_text_descriptor, new_object_text_descriptor);
     RETURN;
   IFEND;

   PUSH dummy: [[REP old_size OF cell]];

   compare (#SIZE (dummy^), record_kind);

 PROCEND compare_obs_formal_parameters;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_UNALLOC_COMMON_BLOCKS', EJECT ??

 PROCEDURE compare_unalloc_common_blocks;

   compare (#SIZE (llt$section_definition), 'UNALLOCATED COMMON BLOCK');

 PROCEND compare_unalloc_common_blocks;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_INTERPRETIVE_RECORDS', EJECT ??

 PROCEDURE compare_interpretive_records;


   record_number := record_number + 1;

   compare_identification_records;


   WHILE NOT error_in_compare DO
     record_number := record_number + 1;

     compare_object_text_descriptors (old_object_text_descriptor, new_object_text_descriptor);
     IF error_in_compare THEN
       RETURN;
     IFEND;

     CASE old_object_text_descriptor^.kind OF
     = llc$transfer_symbol =
       compare_transfer_symbols;
       RETURN;

     = llc$ppu_absolute =
       compare_ppu_absolute_records (old_object_text_descriptor^.number_of_words,
             new_object_text_descriptor^.number_of_words);
       RETURN;

     = llc$form_definition =
       compare_form_def_records;
       RETURN;

     = llc$68000_absolute =
       compare_68000_absolute_records (old_object_text_descriptor^.number_of_words,
             new_object_text_descriptor^.number_of_words);
       RETURN;

     = llc$application_identifier =
       compare_application_identifiers;

     = llc$libraries =
       compare_libraries (old_object_text_descriptor^.number_of_libraries,
             new_object_text_descriptor^.number_of_libraries);

     = llc$section_definition =
       compare_section_definitions;

     = llc$allotted_section_definition =
       compare_allotted_section_defs (old_object_text_descriptor^.allotted_section,
             new_object_text_descriptor^.allotted_section);

     = llc$segment_definition =
       compare_segment_definitions;

     = llc$allotted_segment_definition =
       compare_allotted_segment_defs;

     = llc$obsolete_segment_definition =
       compare_obsolete_seg_defs;

     = llc$obsolete_allotted_seg_def =
       compare_obs_allotted_seg_defs;

     = llc$text =
       compare_text_records (old_object_text_descriptor^.number_of_bytes,
             new_object_text_descriptor^.number_of_bytes);

     = llc$replication =
       compare_replication_records (old_object_text_descriptor^.number_of_bytes,
             new_object_text_descriptor^.number_of_bytes);

     = llc$bit_string_insertion =
       compare_bit_string_insertions;

     = llc$entry_definition =
       compare_entry_definitions;

     = llc$deferred_entry_points =
       compare_deferred_entry_points (old_object_text_descriptor^.number_of_entry_points,
             new_object_text_descriptor^.number_of_entry_points);

     = llc$deferred_common_blocks =
       compare_deferred_common_blocks (old_object_text_descriptor^.number_of_common_blocks,
             new_object_text_descriptor^.number_of_common_blocks);

     = llc$relocation =
       compare_relocation_records (old_object_text_descriptor^.number_of_rel_items,
             new_object_text_descriptor^.number_of_rel_items);

     = llc$address_formulation =
       compare_address_formulations (old_object_text_descriptor^.number_of_adr_items,
             new_object_text_descriptor^.number_of_adr_items);

     = llc$external_linkage =
       compare_external_linkages (old_object_text_descriptor^.number_of_ext_items,
             new_object_text_descriptor^.number_of_ext_items);

     = llc$formal_parameters =
       compare_formal_parameters (old_object_text_descriptor^.sequence_length,
             new_object_text_descriptor^.sequence_length);

     = llc$actual_parameters =
       compare_actual_parameters (old_object_text_descriptor^.sequence_length,
             new_object_text_descriptor^.sequence_length);

     = llc$binding_template =
       compare_binding_templates;

     = llc$obsolete_line_table =
       compare_obsolete_line_tables (old_object_text_descriptor^.number_of_line_items,
             new_object_text_descriptor^.number_of_line_items);

     = llc$line_table =
       compare_line_tables (old_object_text_descriptor^.number_of_line_items,
             new_object_text_descriptor^.number_of_line_items);

     = llc$cybil_symbol_table_fragment =
       compare_cybil_symbol_tables (old_object_text_descriptor^.sequence_length,
             new_object_text_descriptor^.sequence_length);

     = llc$symbol_table =
       compare_debug_symbol_tables (old_object_text_descriptor^.sequence_length,
             new_object_text_descriptor^.sequence_length);

     = llc$supplemental_debug_tables =
       compare_supplemental_dtables (old_object_text_descriptor^.sequence_length,
             new_object_text_descriptor^.sequence_length);

     = llc$obsolete_formal_parameters =
       compare_obs_formal_parameters (old_object_text_descriptor^.sequence_length,
             new_object_text_descriptor^.sequence_length);

     = llc$unallocated_common_block =
       compare_unalloc_common_blocks;

     ELSE
       compare_error ('INVALID OBJECT RECORD KIND', NIL, NIL);
     CASEND;
   WHILEND;


 PROCEND compare_interpretive_records;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_CPU_OBJECT_MODULES' ??
?? NEWTITLE := '    COMPARE_PPU_OBJECT_MODULES', EJECT ??

 PROCEDURE compare_cpu_object_modules;


   RESET old_module.file TO old_module.cpu_object_module_header^.identification;
   RESET new_module.file TO new_module.cpu_object_module_header^.identification;

   compare_interpretive_records;


 PROCEND compare_cpu_object_modules;
?? OLDTITLE ??






 PROCEDURE compare_ppu_object_modules;


   RESET old_module.file TO old_module.ppu_object_module_header;
   RESET new_module.file TO new_module.ppu_object_module_header;

   compare_interpretive_records;


 PROCEND compare_ppu_object_modules;
?? OLDTITLE ??
?? NEWTITLE := 'compare_library_member_headers', EJECT ??

 PROCEDURE compare_library_member_headers;

{ The purpose of this procedure is to compare two library member headers.

   VAR
     errors: boolean,
     new_aliases_p: ^pmt$module_list,
     new_header_p: ^llt$library_member_header,
     old_aliases_p: ^pmt$module_list,
     old_header_p: ^llt$library_member_header;

   NEXT old_header_p IN old_module.file;
   NEXT new_header_p IN new_module.file;

   IF (old_header_p = NIL) OR (new_header_p = NIL) THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   errors := TRUE;

   IF old_header_p^.name = new_header_p^.name THEN
     IF old_header_p^.kind = new_header_p^.kind THEN
       IF old_header_p^.generator_id = new_header_p^.generator_id THEN
         IF old_header_p^.generator_name_vers = new_header_p^.generator_name_vers THEN
           IF old_header_p^.commentary = new_header_p^.commentary THEN
             IF old_header_p^.member_size = new_header_p^.member_size THEN
               IF old_header_p^.number_of_aliases = new_header_p^.number_of_aliases THEN
                 IF old_header_p^.command_function_availability =
                       new_header_p^.command_function_availability THEN
                   IF old_header_p^.command_function_kind = new_header_p^.command_function_kind THEN
                     IF old_header_p^.command_log_option = new_header_p^.command_log_option THEN

                       errors := FALSE;

                     IFEND;
                   IFEND;
                 IFEND;
               IFEND;
             IFEND;
           IFEND;
         IFEND;
       IFEND;
     IFEND;
   IFEND;

   IF errors THEN
     compare_error ('LIBRARY MEMBER HEADER', old_header_p, new_header_p);
     RETURN;
   IFEND;

   IF old_header_p^.number_of_aliases <> 0 THEN
     old_aliases_p := #PTR (old_header_p^.aliases, old_module.file^);
     IF old_aliases_p = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     new_aliases_p := #PTR (new_header_p^.aliases, new_module.file^);
     IF new_aliases_p = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     RESET old_module.file TO old_aliases_p;
     RESET new_module.file TO new_aliases_p;

     compare ((old_header_p^.number_of_aliases * #SIZE (pmt$program_name)), 'ALIASES');
   IFEND;

 PROCEND compare_library_member_headers;
?? OLDTITLE ??
?? NEWTITLE := 'compare_program_attributes', EJECT ??

 PROCEDURE compare_program_attributes
   (VAR old_member_p: ^SEQ ( * );
    VAR new_member_p: ^SEQ ( * ));

{ The purpose of this procedure is to compare two groups of program attributes.

   VAR
     new_conditions_p: ^pmt$enable_inhibit_conditions,
     new_module_list_p: ^pmt$module_list,
     new_object_file_list_p: ^llt$object_file_list,
     new_object_library_list_p: ^llt$object_library_list,
     new_program_attributes_p: ^llt$program_attributes,
     old_conditions_p: ^pmt$enable_inhibit_conditions,
     old_module_list_p: ^pmt$module_list,
     old_object_file_list_p: ^llt$object_file_list,
     old_object_library_list_p: ^llt$object_library_list,
     old_program_attributes_p: ^llt$program_attributes;

   NEXT old_program_attributes_p IN old_member_p;
   IF old_program_attributes_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   NEXT new_program_attributes_p IN new_member_p;
   IF new_program_attributes_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_module.file TO old_program_attributes_p;
   RESET new_module.file TO new_program_attributes_p;

   IF (old_program_attributes_p^.contents <> new_program_attributes_p^.contents) THEN
     compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
     RETURN;
   IFEND;

   IF (pmc$starting_proc_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.starting_procedure <> new_program_attributes_p^.starting_procedure) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$load_map_file_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.load_map_file <> new_program_attributes_p^.load_map_file) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$load_map_options_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.load_map_options <> new_program_attributes_p^.load_map_options) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$term_error_level_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.termination_error_level <>
           new_program_attributes_p^.termination_error_level) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$preset_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.preset <> new_program_attributes_p^.preset) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$max_stack_size_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.maximum_stack_size <> new_program_attributes_p^.maximum_stack_size) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$debug_input_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.debug_input <> new_program_attributes_p^.debug_input) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$debug_output_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.debug_output <> new_program_attributes_p^.debug_output) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$abort_file_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.abort_file <> new_program_attributes_p^.abort_file) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$debug_mode_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.debug_mode <> new_program_attributes_p^.debug_mode) THEN
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$object_file_list_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.number_of_object_files = new_program_attributes_p^.number_of_object_files)
           THEN
       NEXT old_object_file_list_p: [1 .. old_program_attributes_p^.number_of_object_files] IN old_member_p;
       IF old_object_file_list_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       NEXT new_object_file_list_p: [1 .. new_program_attributes_p^.number_of_object_files] IN new_member_p;
       IF new_object_file_list_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       RESET old_module.file TO old_object_file_list_p;
       RESET new_module.file TO new_object_file_list_p;
       compare (old_program_attributes_p^.number_of_object_files * #SIZE (amt$local_file_name),
             'PROGRAM DESCRIPTION');
       IF error_in_compare THEN
         RETURN;
       IFEND;
     ELSE
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$module_list_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.number_of_modules = new_program_attributes_p^.number_of_modules) THEN
       NEXT old_module_list_p: [1 .. old_program_attributes_p^.number_of_modules] IN old_member_p;
       IF old_module_list_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       NEXT new_module_list_p: [1 .. new_program_attributes_p^.number_of_modules] IN new_member_p;
       IF new_module_list_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       RESET old_module.file TO old_module_list_p;
       RESET new_module.file TO new_module_list_p;
       compare (old_program_attributes_p^.number_of_modules * #SIZE (pmt$program_name),
             'PROGRAM DESCRIPTION');
       IF error_in_compare THEN
         RETURN;
       IFEND;
     ELSE
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$library_list_specified IN old_program_attributes_p^.contents) THEN
     IF (old_program_attributes_p^.number_of_libraries = new_program_attributes_p^.number_of_libraries) THEN
       NEXT old_object_library_list_p: [1 .. old_program_attributes_p^.number_of_libraries] IN old_member_p;
       IF old_object_library_list_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       NEXT new_object_library_list_p: [1 .. new_program_attributes_p^.number_of_libraries] IN new_member_p;
       IF new_object_library_list_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       RESET old_module.file TO old_object_library_list_p;
       RESET new_module.file TO new_object_library_list_p;
       compare (old_program_attributes_p^.number_of_libraries * #SIZE (amt$local_file_name),
             'PROGRAM DESCRIPTION');
       IF error_in_compare THEN
         RETURN;
       IFEND;
     ELSE
       compare_error ('PROGRAM DESCRIPTION', old_program_attributes_p, new_program_attributes_p);
       RETURN;
     IFEND;
   IFEND;

   IF (pmc$condition_specified IN old_program_attributes_p^.contents) THEN
     NEXT old_conditions_p IN old_member_p;
     IF old_conditions_p = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;
     NEXT new_conditions_p IN new_member_p;
     IF new_conditions_p = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;
     RESET old_module.file TO old_conditions_p;
     RESET new_module.file TO new_conditions_p;
     compare (#SIZE (pmt$enable_inhibit_conditions), 'PROGRAM DESCRIPTION');
   IFEND;
 PROCEND compare_program_attributes;
?? OLDTITLE ??
?? NEWTITLE := 'compare_program_descriptions', EJECT ??

 PROCEDURE compare_program_descriptions;

{ The purpose of this procedure is to compare two program descriptions.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * );

   RESET old_module.file TO old_module.program_description_header;
   RESET new_module.file TO new_module.program_description_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.program_description_header;
   new_header_p := new_module.program_description_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   compare_program_attributes (old_member_p, new_member_p);

 PROCEND compare_program_descriptions;
?? OLDTITLE ??
?? NEWTITLE := 'compare_command_procedures', EJECT ??

 PROCEDURE compare_command_procedures;

{ The purpose of this procedure is to compare two command procedures.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     new_scl_procedure_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * ),
     old_scl_procedure_p: ^SEQ ( * );

   RESET old_module.file TO old_module.command_procedure_header;
   RESET new_module.file TO new_module.command_procedure_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.command_procedure_header;
   new_header_p := new_module.command_procedure_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   NEXT old_scl_procedure_p: [[REP old_header_p^.member_size OF cell]] IN old_member_p;
   IF old_scl_procedure_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   NEXT new_scl_procedure_p: [[REP new_header_p^.member_size OF cell]] IN new_member_p;
   IF new_scl_procedure_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   compare_scl_procedures (old_scl_procedure_p, new_scl_procedure_p);
 PROCEND compare_command_procedures;
?? OLDTITLE ??
?? NEWTITLE := 'compare_scl_procedures', EJECT ??

 PROCEDURE compare_scl_procedures
   (VAR old_scl_procedure_p: ^SEQ ( * );
    VAR new_scl_procedure_p: ^SEQ ( * ));

{ The purpose of this procedure is to compare two SCL procedures.

   VAR
     ignore_status: ost$status,
     new_line_p: ^clt$command_line,
     old_line_p: ^clt$command_line;

{ Compare SCL procedures line-by-line. Procedure clp$get_next_scl_proc_line
{ advances pointers old_scl_procedure_p and new_scl_procedure_p.

   WHILE TRUE DO
     clp$get_next_scl_proc_line (old_scl_procedure_p, old_line_p, ignore_status);
     clp$get_next_scl_proc_line (new_scl_procedure_p, new_line_p, ignore_status);
     IF (old_line_p = NIL) OR (new_line_p = NIL) THEN
       IF (old_line_p = NIL) AND (new_line_p = NIL) THEN
         RETURN;
       ELSE
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
     ELSE
       IF (old_line_p^ <> new_line_p^) THEN
         compare_error ('SCL PROCEDURE', old_line_p, new_line_p);
         RETURN;
       IFEND;
     IFEND;
   WHILEND;
 PROCEND compare_scl_procedures;
?? OLDTITLE ??
?? NEWTITLE := 'compare_command_descriptions', EJECT ??

 PROCEDURE compare_command_descriptions;

{ The purpose of this procedure is to compare two command descriptions.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * );

   RESET old_module.file TO old_module.command_description_header;
   RESET new_module.file TO new_module.command_description_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.command_description_header;
   new_header_p := new_module.command_description_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   compare_command_desc_contents (old_member_p, new_member_p);

 PROCEND compare_command_descriptions;
?? OLDTITLE ??
?? NEWTITLE := 'compare_command_desc_contents', EJECT ??

 PROCEDURE compare_command_desc_contents
   (VAR old_member_p: ^SEQ ( * );
    VAR new_member_p: ^SEQ ( * ));

{ The purpose of this procedure is to compare two groups of command description contents.

   VAR
     new_command_desc_contents_p: ^llt$command_desc_contents,
     new_file_reference_p: ^fst$file_reference,
     old_command_desc_contents_p: ^llt$command_desc_contents,
     old_file_reference_p: ^fst$file_reference;

   NEXT old_command_desc_contents_p IN old_member_p;
   IF old_command_desc_contents_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   NEXT new_command_desc_contents_p IN new_member_p;
   IF new_command_desc_contents_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   IF (old_command_desc_contents_p^.version <> new_command_desc_contents_p^.version) THEN
     compare_error ('COMMAND DESCRIPTION', old_command_desc_contents_p, new_command_desc_contents_p);
     RETURN;
   IFEND;

   IF (old_command_desc_contents_p^.system_command <> new_command_desc_contents_p^.system_command) THEN
     compare_error ('COMMAND DESCRIPTION', old_command_desc_contents_p, new_command_desc_contents_p);
     RETURN;
   IFEND;
   IF old_command_desc_contents_p^.system_command THEN
     IF (old_command_desc_contents_p^.system_command_name <> new_command_desc_contents_p^.system_command_name)
           THEN
       compare_error ('COMMAND DESCRIPTION', old_command_desc_contents_p, new_command_desc_contents_p);
       RETURN;
     IFEND;
   ELSE
     IF (old_command_desc_contents_p^.starting_procedure <> new_command_desc_contents_p^.starting_procedure)
           THEN
       compare_error ('COMMAND DESCRIPTION', old_command_desc_contents_p, new_command_desc_contents_p);
       RETURN;
     IFEND;
     IF (old_command_desc_contents_p^.library_path_size <> new_command_desc_contents_p^.library_path_size)
           THEN
       compare_error ('COMMAND DESCRIPTION', old_command_desc_contents_p, new_command_desc_contents_p);
       RETURN;
     IFEND;
     IF (old_command_desc_contents_p^.library_path_size > 0) THEN
       NEXT old_file_reference_p: [old_command_desc_contents_p^.library_path_size] IN old_member_p;
       IF old_file_reference_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       NEXT new_file_reference_p: [new_command_desc_contents_p^.library_path_size] IN new_member_p;
       IF new_file_reference_p = NIL THEN
         compare_error (premature_end_of_file, NIL, NIL);
         RETURN;
       IFEND;
       IF (old_file_reference_p^ <> new_file_reference_p^) THEN
         compare_error ('COMMAND DESCRIPTION', old_file_reference_p, new_file_reference_p);
         RETURN;
       IFEND;
     IFEND;
   IFEND;

 PROCEND compare_command_desc_contents;
?? OLDTITLE ??
?? NEWTITLE := 'compare_function_procedures', EJECT ??

 PROCEDURE compare_function_procedures;

{ The purpose of this procedure is to compare two function procedures.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     new_scl_procedure_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * ),
     old_scl_procedure_p: ^SEQ ( * );

   RESET old_module.file TO old_module.function_procedure_header;
   RESET new_module.file TO new_module.function_procedure_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.function_procedure_header;
   new_header_p := new_module.function_procedure_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   NEXT old_scl_procedure_p: [[REP old_header_p^.member_size OF cell]] IN old_member_p;
   IF old_scl_procedure_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   NEXT new_scl_procedure_p: [[REP new_header_p^.member_size OF cell]] IN new_member_p;
   IF new_scl_procedure_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   compare_scl_procedures (old_scl_procedure_p, new_scl_procedure_p);

 PROCEND compare_function_procedures;
?? OLDTITLE ??
?? NEWTITLE := 'compare_function_descriptions', EJECT ??

 PROCEDURE compare_function_descriptions;

{ The purpose of this procedure is to compare two function descriptions.

   VAR
     new_function_desc_contents_p: ^llt$function_desc_contents,
     new_file_reference_p: ^fst$file_reference,
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     old_function_desc_contents_p: ^llt$function_desc_contents,
     old_file_reference_p: ^fst$file_reference,
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * );

   RESET old_module.file TO old_module.function_description_header;
   RESET new_module.file TO new_module.function_description_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.function_description_header;
   new_header_p := new_module.function_description_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   NEXT old_function_desc_contents_p IN old_member_p;
   IF old_function_desc_contents_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   NEXT new_function_desc_contents_p IN new_member_p;
   IF new_function_desc_contents_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   IF (old_function_desc_contents_p^.version <> new_function_desc_contents_p^.version) THEN
     compare_error ('LIBRARY_MEMBER', old_function_desc_contents_p, new_function_desc_contents_p);
     RETURN;
   IFEND;

   IF (old_function_desc_contents_p^.starting_procedure <> new_function_desc_contents_p^.starting_procedure)
         THEN
     compare_error ('LIBRARY_MEMBER', old_function_desc_contents_p, new_function_desc_contents_p);
     RETURN;
   IFEND;
   IF (old_function_desc_contents_p^.library_path_size <> new_function_desc_contents_p^.library_path_size)
         THEN
     compare_error ('LIBRARY_MEMBER', old_function_desc_contents_p, new_function_desc_contents_p);
     RETURN;
   IFEND;
   IF (old_function_desc_contents_p^.library_path_size > 0) THEN
     NEXT old_file_reference_p: [old_function_desc_contents_p^.library_path_size] IN old_member_p;
     IF old_file_reference_p = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;
     NEXT new_file_reference_p: [new_function_desc_contents_p^.library_path_size] IN new_member_p;
     IF new_file_reference_p = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;
     IF (old_file_reference_p^ <> new_file_reference_p^) THEN
       compare_error ('LIBRARY_MEMBER', old_file_reference_p, new_file_reference_p);
       RETURN;
     IFEND;
   IFEND;

 PROCEND compare_function_descriptions;
?? OLDTITLE ??
?? NEWTITLE := 'compare_applic_program_descrip', EJECT ??

 PROCEDURE compare_applic_program_descrip;

{ The purpose of this procedure is to compare two application program descriptions.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * );

   RESET old_module.file TO old_module.applic_program_description_hdr;
   RESET new_module.file TO new_module.applic_program_description_hdr;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

   IF old_module.applic_program_description_hdr^.application_identifier.name <>
         new_module.applic_program_description_hdr^.application_identifier.name THEN
     compare_error ('APPLICATION IDENTIFIER', ^old_module.applic_program_description_hdr^.
           application_identifier.name, ^new_module.applic_program_description_hdr^.application_identifier.
           name);
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := ^old_module.applic_program_description_hdr^.library_member_header;
   new_header_p := ^new_module.applic_program_description_hdr^.library_member_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   compare_program_attributes (old_member_p, new_member_p);

 PROCEND compare_applic_program_descrip;
?? OLDTITLE ??
?? NEWTITLE := 'compare_applic_command_procs', EJECT ??

 PROCEDURE compare_applic_command_procs;

{ The purpose of this procedure is to compare two application command procedures.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     new_scl_procedure_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * ),
     old_scl_procedure_p: ^SEQ ( * );

   RESET old_module.file TO old_module.applic_command_procedure_header;
   RESET new_module.file TO new_module.applic_command_procedure_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

   IF old_module.applic_command_procedure_header^.application_identifier.name <>
         new_module.applic_command_procedure_header^.application_identifier.name THEN
     compare_error ('APPLICATION IDENTIFIER', ^old_module.applic_command_procedure_header^.
           application_identifier.name, ^new_module.applic_command_procedure_header^.application_identifier.
           name);
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := ^old_module.applic_command_procedure_header^.library_member_header;
   new_header_p := ^new_module.applic_command_procedure_header^.library_member_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, old_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   NEXT old_scl_procedure_p: [[REP old_header_p^.member_size OF cell]] IN old_member_p;
   IF old_scl_procedure_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   NEXT new_scl_procedure_p: [[REP new_header_p^.member_size OF cell]] IN new_member_p;
   IF new_scl_procedure_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   compare_scl_procedures (old_scl_procedure_p, new_scl_procedure_p);
 PROCEND compare_applic_command_procs;
?? OLDTITLE ??
?? NEWTITLE := 'compare_applic_command_descrip', EJECT ??

 PROCEDURE compare_applic_command_descrip;

{ The purpose of this procedure is to compare two application command descriptions.

   VAR
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * );

   RESET old_module.file TO old_module.applic_command_description_hdr;
   RESET new_module.file TO new_module.applic_command_description_hdr;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

   IF old_module.applic_command_description_hdr^.application_identifier.name <>
         new_module.applic_command_description_hdr^.application_identifier.name THEN
     compare_error ('APPLICATION IDENTIFIER', ^old_module.applic_command_description_hdr^.
           application_identifier.name, ^new_module.applic_command_description_hdr^.application_identifier.
           name);
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here. That would have
{ been caught by compare_library_member_headers.

   old_header_p := ^old_module.applic_command_description_hdr^.library_member_header;
   new_header_p := ^new_module.applic_command_description_hdr^.library_member_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   compare_command_desc_contents (old_member_p, new_member_p);

 PROCEND compare_applic_command_descrip;
?? OLDTITLE ??
?? NEWTITLE := 'compare_message_modules', EJECT ??

 PROCEDURE compare_message_modules;

{ The purpose of this procedure is to compare two message modules.

   VAR
     errors: boolean,
     new_codes_p: ^ost$mtm_condition_codes,
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     new_menu_classes_p: cst$menu_class, { this type is a pointer }
     new_menu_header_p: ^ost$mtm_menu_header,
     new_menu_items_p: cst$menu_list, { this type is a pointer }
     new_mtm_header_p: ^ost$mtm_header,
     new_names_p: ^ost$mtm_condition_names,
     new_template_p: ^ost$message_template,
     old_codes_p: ^ost$mtm_condition_codes,
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * ),
     old_menu_classes_p: cst$menu_class, { this type is a pointer }
     old_menu_header_p: ^ost$mtm_menu_header,
     old_menu_items_p: cst$menu_list, { this type is a pointer }
     old_mtm_header_p: ^ost$mtm_header,
     old_names_p: ^ost$mtm_condition_names,
     old_template_p: ^ost$message_template,
     template_index: ost$message_template_index;

   RESET old_module.file TO old_module.message_module_header;
   RESET new_module.file TO new_module.message_module_header;

   compare_library_member_headers;
   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here.  That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.message_module_header;
   new_header_p := new_module.message_module_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_member_p;
   RESET new_member_p;

   clp$extract_msg_module_contents (old_member_p, old_mtm_header_p, old_codes_p, old_names_p);
   IF old_mtm_header_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   clp$extract_msg_module_contents (new_member_p, new_mtm_header_p, new_codes_p, new_names_p);
   IF new_mtm_header_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

{ Compare message template module headers.

   errors := TRUE;
   IF old_mtm_header_p^.version = new_mtm_header_p^.version THEN
     IF old_mtm_header_p^.language = new_mtm_header_p^.language THEN
       IF old_mtm_header_p^.online_manual_name = new_mtm_header_p^.online_manual_name THEN
         IF old_mtm_header_p^.number_of_codes = new_mtm_header_p^.number_of_codes THEN
           IF old_mtm_header_p^.number_of_names = new_mtm_header_p^.number_of_names THEN
             errors := FALSE;
           IFEND;
         IFEND;
       IFEND;
     IFEND;
   IFEND;
   IF errors THEN
     compare_error ('LIBRARY MEMBER', old_mtm_header_p, new_mtm_header_p);
     RETURN;
   IFEND;

{ Compare message template contents.

   IF (old_mtm_header_p^.number_of_codes > 0) AND (old_codes_p = NIL) THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   IF (new_mtm_header_p^.number_of_codes > 0) AND (new_codes_p = NIL) THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   IF old_names_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;
   IF new_names_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   FOR template_index := 0 TO old_mtm_header_p^.number_of_names - 1 DO
     errors := TRUE;
     IF old_names_p^ [template_index].name = new_names_p^ [template_index].name THEN
       IF old_names_p^ [template_index].kind = new_names_p^ [template_index].kind THEN
         CASE old_names_p^ [template_index].kind OF
         = osc$status_message =
           old_template_p := #PTR (old_names_p^ [template_index].template, old_member_p^);
           IF old_template_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           new_template_p := #PTR (new_names_p^ [template_index].template, new_member_p^);
           IF new_template_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           IF old_template_p^ = new_template_p^ THEN
             IF old_names_p^ [template_index].code = new_names_p^ [template_index].code THEN
               IF old_names_p^ [template_index].severity = new_names_p^ [template_index].severity THEN
                 errors := FALSE;
               IFEND;
             IFEND;
           IFEND;
         = osc$brief_help, osc$full_help =
           old_template_p := #PTR (old_names_p^ [template_index].template, old_member_p^);
           IF old_template_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           new_template_p := #PTR (new_names_p^ [template_index].template, new_member_p^);
           IF new_template_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           IF old_template_p^ = new_template_p^ THEN
             errors := FALSE;
           IFEND;
         = osc$parameter_prompt, osc$parameter_assistance_prompt, osc$parameter_help =
           old_template_p := #PTR (old_names_p^ [template_index].template, old_member_p^);
           IF old_template_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           new_template_p := #PTR (new_names_p^ [template_index].template, new_member_p^);
           IF new_template_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           IF old_template_p^ = new_template_p^ THEN
             errors := FALSE;
           IFEND;
         = osc$application_menu =
           old_menu_header_p := #PTR (old_names_p^ [template_index].menu_header, old_member_p^);
           IF old_menu_header_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           new_menu_header_p := #PTR (new_names_p^ [template_index].menu_header, new_member_p^);
           IF new_menu_header_p = NIL THEN
             compare_error (premature_end_of_file, NIL, NIL);
             RETURN;
           IFEND;
           IF old_menu_header_p^.number_of_classes = new_menu_header_p^.number_of_classes THEN
             IF old_menu_header_p^.number_of_menu_items = new_menu_header_p^.number_of_menu_items THEN
               errors := FALSE;
               RESET old_member_p TO old_menu_header_p;
               NEXT old_menu_header_p IN old_member_p;
               NEXT old_menu_classes_p: [1 .. old_menu_header_p^.number_of_classes] IN old_member_p;
               IF (old_menu_classes_p = NIL) THEN
                 compare_error (premature_end_of_file, NIL, NIL);
                 RETURN;
               IFEND;
               RESET new_member_p TO new_menu_header_p;
               NEXT new_menu_header_p IN new_member_p;
               NEXT new_menu_classes_p: [1 .. new_menu_header_p^.number_of_classes] IN new_member_p;
               IF (new_menu_classes_p = NIL) THEN
                 compare_error (premature_end_of_file, NIL, NIL);
                 RETURN;
               IFEND;
               RESET old_member_p TO old_menu_classes_p;
               RESET new_member_p TO new_menu_classes_p;
               compare (old_menu_header_p^.number_of_classes * #SIZE (cst$class_name), 'APPLICATION MENUS');
               IF error_in_compare THEN
                 RETURN;
               IFEND;

               NEXT old_menu_items_p: [1 .. old_menu_header_p^.number_of_menu_items] IN old_member_p;
               IF (old_menu_items_p = NIL) THEN
                 compare_error (premature_end_of_file, NIL, NIL);
                 RETURN;
               IFEND;
               NEXT new_menu_items_p: [1 .. new_menu_header_p^.number_of_menu_items] IN new_member_p;
               IF (new_menu_items_p = NIL) THEN
                 compare_error (premature_end_of_file, NIL, NIL);
                 RETURN;
               IFEND;
               RESET old_member_p TO old_menu_items_p;
               RESET new_member_p TO new_menu_items_p;
               compare (old_menu_header_p^.number_of_menu_items * #SIZE (cst$menu_item),
                     'APPLICATIONS MENUS');
               IF error_in_compare THEN
                 RETURN;
               IFEND;
             IFEND;
           IFEND;
         ELSE
           ;
         CASEND;
       IFEND;
     IFEND;
     IF errors THEN
       compare_error ('LIBRARY MEMBER', old_member_p, new_member_p);
       RETURN;
     IFEND;
   FOREND;

 PROCEND compare_message_modules;
?? OLDTITLE ??
?? NEWTITLE := 'compare_panel_modules', EJECT ??

 PROCEDURE compare_panel_modules;

{ The purpose of this procedure is to compare two form (panel) modules.

   VAR
     errors: boolean,
     new_header_p: ^llt$library_member_header,
     new_member_p: ^SEQ ( * ),
     old_header_p: ^llt$library_member_header,
     old_member_p: ^SEQ ( * );

   RESET old_module.file TO old_module.panel_module_header;
   RESET new_module.file TO new_module.panel_module_header;

   compare_library_member_headers;

   IF error_in_compare THEN
     RETURN;
   IFEND;

{ Pointers old_header_p and new_header_p won't be NIL here.  That would have
{ been caught by compare_library_member_headers.

   old_header_p := old_module.panel_module_header;
   new_header_p := new_module.panel_module_header;

   old_member_p := #PTR (old_header_p^.member, old_module.file^);
   IF old_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_member_p := #PTR (new_header_p^.member, new_module.file^);
   IF new_member_p = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_module.file TO old_member_p;
   RESET new_module.file TO new_member_p;

   compare (old_header_p^.member_size, 'LIBRARY MEMBER');
   IF error_in_compare THEN
     RETURN;
   IFEND;

 PROCEND compare_panel_modules;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_INFO_ELEMENT_HEADERS', EJECT ??

 PROCEDURE compare_info_element_headers
   (    old_info_element_header: ^llt$info_element_header;
        new_info_element_header: ^llt$info_element_header);


   CONST
     info_element_header = 'INFORMATION ELEMENT HEADER';

   VAR
     i: integer,
     old_relocation: ^llt$relocation,
     new_relocation: ^llt$relocation,
     old_binding_section_template: ^llt$binding_section_template,
     new_binding_section_template: ^llt$binding_section_template,
     old_section_maps: ^llt$section_maps,
     new_section_maps: ^llt$section_maps,
     old_map: ^llt$section_map_items,
     new_map: ^llt$section_map_items;


   IF old_info_element_header^.number_of_rel_items <> new_info_element_header^.number_of_rel_items THEN
     compare_error (info_element_header, old_info_element_header, new_info_element_header);
     RETURN;
   IFEND;

   IF old_info_element_header^.number_of_template_items <>
         new_info_element_header^.number_of_template_items THEN
     compare_error (info_element_header, old_info_element_header, new_info_element_header);
     RETURN;
   IFEND;


   IF old_info_element_header^.number_of_section_maps <> new_info_element_header^.number_of_section_maps THEN
     compare_error (info_element_header, old_info_element_header, new_info_element_header);
     RETURN;
   IFEND;
?? EJECT ??

   IF old_info_element_header^.number_of_rel_items <> 0 THEN
     old_relocation := #PTR (old_info_element_header^.relocation_ptr, old_module.file^);
     IF old_relocation = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     new_relocation := #PTR (new_info_element_header^.relocation_ptr, new_module.file^);
     IF new_relocation = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     RESET old_module.file TO old_relocation;
     RESET new_module.file TO new_relocation;


     record_number := record_number + 1;
     compare ((old_info_element_header^.number_of_rel_items * #SIZE (llt$relocation_item)),
           info_element_header);
     IF error_in_compare THEN
       RETURN;
     IFEND;
   IFEND;


   IF old_info_element_header^.number_of_template_items <> 0 THEN
     old_binding_section_template := #PTR (old_info_element_header^.binding_template_ptr, old_module.file^);
     IF old_binding_section_template = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     new_binding_section_template := #PTR (new_info_element_header^.binding_template_ptr, new_module.file^);
     IF new_binding_section_template = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     RESET old_module.file TO old_binding_section_template;
     RESET new_module.file TO new_binding_section_template;

     FOR i := 1 TO old_info_element_header^.number_of_template_items DO
       record_number := record_number + 1;

       compare_binding_templates;

       IF error_in_compare THEN
         RETURN;
       IFEND;
     FOREND;
   IFEND;
?? EJECT ??

   IF old_info_element_header^.number_of_section_maps <> 0 THEN
     old_section_maps := #PTR (old_info_element_header^.section_maps, old_module.file^);
     IF old_section_maps = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     new_section_maps := #PTR (new_info_element_header^.section_maps, new_module.file^);
     IF new_section_maps = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     FOR i := 0 TO UPPERBOUND (old_section_maps^) DO
       IF old_section_maps^ [i].number_of_items <> new_section_maps^ [i].number_of_items THEN
         compare_error ('NUMBER OF MAP ITEMS', old_section_maps, new_section_maps);
         RETURN;
       IFEND;

       IF old_section_maps^ [i].number_of_items > 0 THEN
         old_map := #PTR (old_section_maps^ [i].map, old_module.file^);
         IF old_map = NIL THEN
           compare_error (premature_end_of_file, NIL, NIL);
           RETURN;
         IFEND;

         new_map := #PTR (new_section_maps^ [i].map, new_module.file^);
         IF new_map = NIL THEN
           compare_error (premature_end_of_file, NIL, NIL);
           RETURN;
         IFEND;

         RESET old_module.file TO old_map;
         RESET new_module.file TO new_map;

         compare (#SIZE (old_map^), 'BINARY SECTION MAP');
         IF error_in_compare THEN
           RETURN;
         IFEND;
       IFEND;
     FOREND;
   IFEND;


 PROCEND compare_info_element_headers;
?? OLDTITLE ??
?? NEWTITLE := '    COMPARE_LOAD_MODULES', EJECT ??

 PROCEDURE compare_load_modules;


   VAR
     old_info_element_header: ^llt$info_element_header,
     new_info_element_header: ^llt$info_element_header,
     old_header: llt$info_element_header,
     new_header: llt$info_element_header;


   IF old_module.load_module_header^.elements_defined <> new_module.load_module_header^.elements_defined THEN
     compare_error ('ELEMENTS DEFINED', old_module.load_module_header, new_module.load_module_header);
     RETURN;
   IFEND;

   IF old_module.load_module_header^.interpretive_header.elements_defined <>
         new_module.load_module_header^.interpretive_header.elements_defined THEN
     compare_error ('INTERPRETIVE ELEMENTS DEFINED', old_module.load_module_header,
           new_module.load_module_header);
     RETURN;
   IFEND;


   old_object_text_descriptor := #PTR (old_module.load_module_header^.interpretive_element, old_module.file^);
   IF old_object_text_descriptor = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   new_object_text_descriptor := #PTR (new_module.load_module_header^.interpretive_element, new_module.file^);
   IF new_object_text_descriptor = NIL THEN
     compare_error (premature_end_of_file, NIL, NIL);
     RETURN;
   IFEND;

   RESET old_module.file TO old_object_text_descriptor;
   RESET new_module.file TO new_object_text_descriptor;

   NEXT old_object_text_descriptor IN old_module.file;
   NEXT new_object_text_descriptor IN new_module.file;


   compare_interpretive_records;

   IF error_in_compare THEN
     RETURN;
   IFEND;
?? EJECT ??


   IF llc$information_element IN old_module.load_module_header^.elements_defined THEN
     old_info_element_header := #PTR (old_module.load_module_header^.information_element, old_module.file^);
     IF old_info_element_header = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     IF (old_info_element_header^.version <> llc$info_element_version) THEN
       ocp$convert_information_element (old_info_element_header, old_header);
       old_info_element_header := ^old_header;
     IFEND;


     new_info_element_header := #PTR (new_module.load_module_header^.information_element, new_module.file^);
     IF new_info_element_header = NIL THEN
       compare_error (premature_end_of_file, NIL, NIL);
       RETURN;
     IFEND;

     IF (new_info_element_header^.version <> llc$info_element_version) THEN
       ocp$convert_information_element (new_info_element_header, new_header);
       new_info_element_header := ^new_header;
     IFEND;

     compare_info_element_headers (old_info_element_header, new_info_element_header);
     IF error_in_compare THEN
       RETURN;
     IFEND;
   IFEND;


 PROCEND compare_load_modules;
?? OLDTITLE ??
?? EJECT ??


 VAR
   record_number: integer,
   error_in_compare: boolean;


 record_number := 0;
 error_in_compare := FALSE;


 IF old_module.kind <> new_module.kind THEN
   compare_error ('MODULE KIND', NIL, NIL);
   RETURN;
 IFEND;


 CASE old_module.kind OF
 = occ$cpu_object_module =
   compare_cpu_object_modules;

 = occ$ppu_object_module =
   compare_ppu_object_modules;

 = occ$load_module =
   compare_load_modules;

 = occ$program_description =
   compare_program_descriptions;

 = occ$command_procedure =
   compare_command_procedures;

 = occ$command_description =
   compare_command_descriptions;

 = occ$function_procedure =
   compare_function_procedures;

 = occ$function_description =
   compare_function_descriptions;

 = occ$message_module =
   compare_message_modules;

 = occ$panel_module =
   compare_panel_modules;

 = occ$applic_program_description =
   compare_applic_program_descrip;

 = occ$applic_command_procedure =
   compare_applic_command_procs;

 = occ$applic_command_description =
   compare_applic_command_descrip;

 ELSE
   compare_error ('***** internal error 1 *****', NIL, NIL);
 CASEND;


 PROCEND compare_modules;
?? OLDTITLE ??
?? NEWTITLE := '  OCP$COMPARE_OBJECT_LIBRARY', EJECT ??

 PROGRAM [XDCL, #GATE] ocp$compare_object_library
   (    parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE (ocm$comol) compare_object_library, comol (
{   file, f: file = $required
{   with, w: file = $required
{   output, o: file = $output
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 24, 14, 33, 32, 145],
    clc$command, 7, 4, 2, 0, 0, 0, 4, 'OCM$COMOL'], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['W                              ',clc$abbreviation_entry, 2],
    ['WITH                           ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 4
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

   CONST
     p$file = 1,
     p$with = 2,
     p$output = 3,
     p$status = 4;

   VAR
     pvt: array [1 .. 4] of clt$parameter_value;


   VAR
     old_library: ^oct$open_file_list,
     old_library_name: amt$local_file_name,
     new_library: ^oct$open_file_list,
     new_library_name: amt$local_file_name,
     old: llt$module_index,
     new: llt$module_index,
     found: boolean,
     header_printed: boolean,
     page_header: string (86),
     dummy: ost$status;


 /compare_processing/
   BEGIN

     clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;


     ocp$initialize_oc_environment (status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;


     ocp$obtain_object_file (pvt [p$file].value^.file_value^, old_library, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

     IF old_library^.name = osc$null_name THEN
       osp$set_status_abnormal ('OC', oce$e_non_object_file, pvt [p$file].value^.file_value^, status);
       RETURN;
     ELSE
       pmp$get_last_path_name (pvt [p$file].value^.file_value^, old_library_name, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;
     IFEND;


     ocp$obtain_object_file (pvt [p$with].value^.file_value^, new_library, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

     IF new_library^.name = osc$null_name THEN
       osp$set_status_abnormal ('OC', oce$e_non_object_file, pvt [p$with].value^.file_value^, status);
       RETURN;
     ELSE
       pmp$get_last_path_name (pvt [p$with].value^.file_value^, new_library_name, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;
     IFEND;


     IF old_library^.kind <> new_library^.kind THEN
       osp$set_status_abnormal ('OC', oce$e_cant_compare_file_and_lib, '', status);
       RETURN;
     IFEND;


     sort_module_directory (old_library^.directory^);
     sort_module_directory (new_library^.directory^);


     page_header (1, * ) := 'COMPARE LISTING of';
     page_header (20, 31) := old_library_name;
     page_header (52, 3) := 'and';
     page_header (56, 31) := new_library_name;

     ocp$open_output_file (pvt [p$output].value^.file_value^, ^page_header, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;


     IF old_library^.name = new_library^.name THEN
       EXIT /compare_processing/;
     IFEND;


     header_printed := FALSE;

     FOR old := 1 TO UPPERBOUND (old_library^.directory^) DO
       new := 1;
       WHILE (new <= UPPERBOUND (new_library^.directory^)) AND
             (old_library^.directory^ [old].name <> new_library^.directory^ [new].name) DO
         new := new + 1;
       WHILEND;

       IF new > UPPERBOUND (new_library^.directory^) THEN
         IF NOT header_printed THEN
           ocp$output (occ$new_page, 'Old modules deleted from', 24, occ$continue);
           ocp$output (' ', old_library_name, #SIZE (old_library_name), occ$end_of_line);
           ocp$output (occ$single_space, '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~', 56,
                 occ$end_of_line);
           header_printed := TRUE;
         IFEND;

         ocp$output (occ$single_space, old_library^.directory^
               [old].name, #SIZE (old_library^.directory^ [old].name), occ$end_of_line);
       IFEND;
     FOREND;


     header_printed := FALSE;

     FOR new := 1 TO UPPERBOUND (new_library^.directory^) DO
       old := 1;
       WHILE (old <= UPPERBOUND (old_library^.directory^)) AND
             (new_library^.directory^ [new].name <> old_library^.directory^ [old].name) DO
         old := old + 1;
       WHILEND;

       IF old > UPPERBOUND (old_library^.directory^) THEN
         IF NOT header_printed THEN
           ocp$output (occ$new_page, 'New modules added to', 20, occ$continue);
           ocp$output (' ', new_library_name, #SIZE (new_library_name), occ$end_of_line);
           ocp$output (occ$single_space, '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~', 52,
                 occ$end_of_line);
           header_printed := TRUE;
         IFEND;

         ocp$output (occ$single_space, new_library^.directory^
               [new].name, #SIZE (new_library^.directory^ [new].name), occ$end_of_line);
       IFEND;
     FOREND;


     header_printed := FALSE;

     FOR new := 1 TO UPPERBOUND (new_library^.directory^) DO
       old := 1;

       WHILE (old <= UPPERBOUND (old_library^.directory^)) AND
             (new_library^.directory^ [new].name <> old_library^.directory^ [old].name) DO
         old := old + 1;
       WHILEND;

       IF old <= UPPERBOUND (old_library^.directory^) THEN
         compare_modules (old_library^.directory^ [old], new_library^.directory^ [new], header_printed);
       IFEND;
     FOREND;

   END /compare_processing/;


   ocp$close_all_open_files (ocv$open_file_list);

   STRINGREP (strng, length, number_of_compare_errors);
   ocp$output (occ$triple_space, 'Number of compare errors:', 25, occ$continue);
   ocp$output ('', strng (1, length), length, occ$end_of_line);

   ocp$close_output_file (status);
   IF NOT status.normal THEN
     RETURN;
   IFEND;

 PROCEND ocp$compare_object_library;

 MODEND ocm$compare_object_library;
