?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Object Code Utilities : Product Reference Utility' ??
MODULE ocm$product_reference_utility;

{ PURPOSE:
{   This module contains the command and subcommands for the NOS/VE Product
{ Reference Utility.  The utility is used as an aid to insure and verify
{ compatibility of software.
{
{ NOTES:
{   This utility is a standalone utility outside of the operating system.  It is
{ available to all users.
{
{   This utility runs in the caller's ring.
{
{   A reference file is composed of a header that describes the version of the
{ file and the number of entry point and external reference definitions in the
{ file.  The header is followed by the entry point definitions which is followed
{ by the external reference definitions.
{
{   This utility uses the concept of a working file.  The file is empty at the
{ start of the utility and "add" commands are used to augment the working file.
{ The other utility commands and the utility functions use the working file
{ as the basis for their information.  The working file is internally represented
{ as two files, one that contains entry point definitions and another that
{ contains external reference definitions.  Externally, the two files "appear"
{ as a single reference file.  Using multiple files for the internal
{ representation is for performance reasons only.
{
{   Unlike the CREATE_OBJECT_LIBRARY utility, the "add" commands do not leave
{ the file open.  The command performs a function against the working file and
{ closes the file(s) as part of command completion.
{
{   For performance reasons, a list of modules and products referenced by the
{ working reference file is maintained.  This is primarily necessary for the
{ functions that return lists of these values.  The list of modules and products
{ is maintained via binary insertion.  The expected number of unique values in
{ these lists is expected to be relatively small.  The most important thing in
{ maintaining this lists is that searching (binary search) must be optimal.
{ Searching frequency is expected to be done one to two orders of magnitude
{ over the frequency of insertion.  If these assumptions turn out to be invalid
{ a balanced tree structure would seem to be a viable alternative, to improve
{ insertion overhead, but as a result, searching overhead becomes very slightly
{ more expensive.  (Knuth knows.)
{
{   Due to duplicate language identifiers for the CYBIL I/M and CYBIL I/I
{ compilers, and that CDCNET has reused NOS/VE product identifiers and duplicated
{ interface names, M68000 modules are not supported by this utility.  If the
{ need arises (there is no defined usefulness for this right now) several things
{ must be considered.  The CYBIL I/I compiler generates both an object and source
{ hash, the CYBIL I/M compiler does not.  The duplication of CDCNET and NOS/VE
{ interfaces, e.g. osp$set_status_abnormal, must be resolved or worked around.
{
{   The routines used to crack an object library are a stripped down version of
{ the routines used for the display_object_text command.
{
{   In the procedure ocp$_add_library, there are several reference to fatal_error
{ and end_of_file.  Currently, these variables are handled the same.  The type of
{ error is not reported.  I have chosen, to leave them here since performance is
{ not largely affected.  Since there is a good likely-hood that the type of error
{ encountered should someday be reported, these variables have been retained.
{
{   There are several small procedures that are NOT INLINE because they PUSH data
{ on the stack and are called within loops.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc cyd$cybil_structure_definitions
*copyc cyd$debug_symbol_table
*copyc llt$deferred_common_blocks
*copyc llt$deferred_entry_points
*copyc llt$load_module
*copyc llt$object_library
*copyc llt$object_module
*copyc lot$task_services_entry_point
*copyc oce$interrupt_exceptions
*copyc oce$object_converter_exceptions
*copyc oce$rm_builder_exceptions
*copyc oce$ve_linker_exceptions
*copyc oct$task_services_entry_point
*copyc osd$integer_limits
*copyc ost$status
*copyc pmt$linker_debug_table_header
*copyc pmt$virtual_memory_image_header
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$set_segment_eoi
*copyc clp$build_pattern_for_wild_card
*copyc clp$begin_utility
*copyc clp$build_standard_title
*copyc clp$change_variable
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_file
*copyc clp$count_list_elements
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc clp$make_list_value
*copyc clp$make_name_value
*copyc clp$make_program_name_value
*copyc clp$make_record_value
*copyc clp$match_string_pattern
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$reset_for_next_display_page
*copyc clp$trimmed_string_size
*copyc fsp$build_file_ref_from_elems
*copyc fsp$close_file
*copyc fsp$get_open_information
*copyc fsp$open_file
*copyc i#current_sequence_position
*copyc i#move
*copyc mmp$create_user_segment
*copyc mmp$delete_scratch_segment
*copyc osp$append_status_file
*copyc osp$append_status_parameter
*copyc osp$establish_condition_handler
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$format_message
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$continue_to_cause
*copyc pmp$log
*copyc pmp$position_object_library
*copyc clv$value_descriptors
*copyc osv$lower_to_upper
*copyc osv$lower_to_upper_26
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

*copy clv$display_variables

  SECTION
    read_only: READ;

  TYPE
    module_kind_set = set of llt$module_kind;

{ For now, only allow C180 CPU code.  See module NOTES section for more information.

  VAR
    valid_module_kinds: module_kind_set := [llc$mi_virtual_state, llc$vector_virtual_state,
          llc$vector_extended_state];

  TYPE
    t$entry_external_file_header = record
      identification: ost$name,
      entry_point_count: ost$non_negative_integers,
      external_count: ost$non_negative_integers,
    recend;

  TYPE
    t$entry_external_files = array [1 .. * ] of t$entry_external_file_element;

  TYPE
    t$entry_external_file_element = record
      entry_point_list_p: ^t$entry_external_list,
      external_list_p: ^t$entry_external_list,
    recend;

  CONST
    c$entry_external_id = 'PRODUCT REFERENCE FILE V1.0';

  TYPE
    t$entry_external_list = array [1 .. * ] of t$entry_external;

  TYPE
    t$entry_external = record
      name: pmt$program_name,
      language: llt$module_generator,
      declaration_matching_required: boolean,
      declaration_matching: llt$declaration_matching_value,
      product_name: ost$name,
      module_name: pmt$program_name,
      attributes: llt$entry_point_attributes,
    recend;

{ This constant represents the size of the type t$entry_external

  CONST
    c$entry_external_record_size = 104; { in bytes

  TYPE
    t$comparison_converter = record
      case boolean of
      = TRUE =
        entry_external_p: ^t$entry_external,
      = FALSE =
        value_p: ^string (c$entry_external_record_size),
      casend,
    recend;

  TYPE
    t$reference_kind = (c$rk_entry_point, c$rk_external);

  VAR
    v$working_file: [STATIC] record
      entry_points_p: ^SEQ ( * ),
      externals_p: ^SEQ ( * ),
    recend := [NIL, NIL];

  VAR
    v$module_list: [STATIC] array [t$reference_kind] of record
      element_count: ost$non_negative_integers,
      elements_p: ^array [1 .. * ] of clt$data_value,
    recend := [[0, NIL], [0, NIL]];

  VAR
    v$product_list: [STATIC] array [t$reference_kind] of record
      element_count: ost$non_negative_integers,
      elements_p: ^array [1 .. * ] of clt$data_value,
    recend := [[0, NIL], [0, NIL]];

  CONST
    c$utility_prompt = 'PRU';

  VAR
    c$utility_name: [STATIC, READ, read_only] clt$utility_name := 'product_reference_utility';

  VAR
    v$display_control: clt$display_control,
    v$output_file_open: [STATIC] boolean := FALSE;

?? OLDTITLE ??
?? NEWTITLE := 'Commands for the Product_Reference_Utility', EJECT ??

{ table name=proru_commands type=command section_name=read_only scope=local
{ command (add_library                    , add_libraries, addl) p=ocp$_add_library cm=local
{ command (add_reference_file             , add_reference_files, addrf) p=ocp$_add_reference_file cm=local
{ command (add_task_services              , addts) p=ocp$_add_task_services cm=local
{ command (compare_reference_file         , comrf) p=ocp$_compare_reference_file cm=local
{ command (quit                           , qui) p=ocp$_quit cm=local
{ command (write_reference_file           , wrirf) p=ocp$_write_reference_file cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

  VAR
    proru_commands: [STATIC, READ, read_only] ^clt$command_table := ^proru_commands_entries,

    proru_commands_entries: [STATIC, READ, read_only] array [1 .. 14] of clt$command_table_entry := [
          {} ['ADDL                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^ocp$_add_library],
          {} ['ADDRF                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^ocp$_add_reference_file],
          {} ['ADDTS                          ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^ocp$_add_task_services],
          {} ['ADD_LIBRARIES                  ', clc$alias_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^ocp$_add_library],
          {} ['ADD_LIBRARY                    ', clc$nominal_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^ocp$_add_library],
          {} ['ADD_REFERENCE_FILE             ', clc$nominal_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^ocp$_add_reference_file],
          {} ['ADD_REFERENCE_FILES            ', clc$alias_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^ocp$_add_reference_file],
          {} ['ADD_TASK_SERVICES              ', clc$nominal_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^ocp$_add_task_services],
          {} ['COMPARE_REFERENCE_FILE         ', clc$nominal_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^ocp$_compare_reference_file],
          {} ['COMRF                          ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^ocp$_compare_reference_file],
          {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^ocp$_quit],
          {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^ocp$_quit],
          {} ['WRIRF                          ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
          clc$automatically_log, clc$linked_call, ^ocp$_write_reference_file],
          {} ['WRITE_REFERENCE_FILE           ', clc$nominal_entry, clc$normal_usage_entry, 6,
          clc$automatically_log, clc$linked_call, ^ocp$_write_reference_file]];

?? POP ??

{ table name=proru_functions type=function section_name=read_only scope=local
{ function ($compare_reference_file       ,$comrf) p=ocp$$compare_reference_file cm=local
{ function ($module_information            ) p=ocp$$module_information cm=local
{ function ($module_list                   ) p=ocp$$module_list cm=local
{ function ($product_information           ) p=ocp$$product_information cm=local
{ function ($product_list                  ) p=ocp$$product_list cm=local
{ function ($reference_information         ) p=ocp$$reference_information cm=local
{ function ($reference_list                ) p=ocp$$reference_list cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

  VAR
    proru_functions: [STATIC, READ, read_only] ^clt$function_processor_table := ^proru_functions_entries,

    proru_functions_entries: [STATIC, READ, read_only] array [1 .. 8] of clt$function_proc_table_entry := [
          {} ['$COMPARE_REFERENCE_FILE        ', clc$nominal_entry, clc$normal_usage_entry, 1,
          clc$linked_call, ^ocp$$compare_reference_file],
          {} ['$COMRF                         ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
          clc$linked_call, ^ocp$$compare_reference_file],
          {} ['$MODULE_INFORMATION            ', clc$nominal_entry, clc$normal_usage_entry, 2,
          clc$linked_call, ^ocp$$module_information],
          {} ['$MODULE_LIST                   ', clc$nominal_entry, clc$normal_usage_entry, 3,
          clc$linked_call, ^ocp$$module_list],
          {} ['$PRODUCT_INFORMATION           ', clc$nominal_entry, clc$normal_usage_entry, 4,
          clc$linked_call, ^ocp$$product_information],
          {} ['$PRODUCT_LIST                  ', clc$nominal_entry, clc$normal_usage_entry, 5,
          clc$linked_call, ^ocp$$product_list],
          {} ['$REFERENCE_INFORMATION         ', clc$nominal_entry, clc$normal_usage_entry, 6,
          clc$linked_call, ^ocp$$reference_information],
          {} ['$REFERENCE_LIST                ', clc$nominal_entry, clc$normal_usage_entry, 7,
          clc$linked_call, ^ocp$$reference_list]];

?? POP ??
?? OLDTITLE ??
?? NEWTITLE := 'clp$new_page_procedure', EJECT ??
*copy clp$new_page_procedure
?? OLDTITLE ??
?? NEWTITLE := 'add_to_module_list', EJECT ??

{   The purpose of this request is to add module name in the supplied entry external
{ to the module list for the specified reference kind.

  PROCEDURE add_to_module_list
    (    reference_kind: t$reference_kind;
         entry_external: t$entry_external);

    CONST
      estimated_number_of_modules = 1000;

    VAR
      high_index: ost$non_negative_integers,
      index: ost$non_negative_integers,
      insertion_index: ost$non_negative_integers,
      low_index: ost$non_negative_integers,
      module_list_p: ^array [1 .. * ] of clt$data_value,
      temp: integer,
      number_of_modules: ost$non_negative_integers;

    module_list_p := v$module_list [reference_kind].elements_p;
    number_of_modules := v$module_list [reference_kind].element_count;

{ If there is no module list, create one.

    IF number_of_modules = 0 THEN
      ALLOCATE v$module_list [reference_kind].elements_p: [1 .. estimated_number_of_modules];
      v$module_list [reference_kind].element_count := 1;
      v$module_list [reference_kind].elements_p^ [1].kind := clc$program_name;
      v$module_list [reference_kind].elements_p^ [1].program_name_value := entry_external.module_name;
      RETURN;
    IFEND;

{ See if the module is already in the module list.

    high_index := number_of_modules;
    low_index := 1;

    REPEAT
      temp := low_index + high_index;
      insertion_index := temp DIV 2;
      IF entry_external.module_name = module_list_p^ [insertion_index].program_name_value THEN
        RETURN;
      ELSEIF entry_external.module_name > module_list_p^ [insertion_index].program_name_value THEN
        low_index := insertion_index + 1;
      ELSE
        high_index := insertion_index - 1;
      IFEND;
    UNTIL (low_index > high_index);

{ Adjust the insertion_index to point to the element to insert BEFORE.
{ If the last partition indicated to insert AFTER the current entry,
{ increment the insertion_index.

    IF low_index > insertion_index THEN
      insertion_index := insertion_index + 1;
    IFEND;

{ Increase the size of the module list if necessary.

    IF (number_of_modules + 1) > UPPERBOUND (module_list_p^) THEN
      ALLOCATE module_list_p: [1 .. number_of_modules + estimated_number_of_modules];
      i#move (v$module_list [reference_kind].elements_p, module_list_p,
            #SIZE (module_list_p^ [1]) * number_of_modules);
      FREE v$module_list [reference_kind].elements_p;
      v$module_list [reference_kind].elements_p := module_list_p;
    IFEND;

{ Can't do i#move .. darn

    FOR index := number_of_modules DOWNTO insertion_index DO
      module_list_p^ [index + 1] := module_list_p^ [index];
    FOREND;
    module_list_p^ [insertion_index].kind := clc$program_name;
    module_list_p^ [insertion_index].program_name_value := entry_external.module_name;

    v$module_list [reference_kind].element_count := number_of_modules + 1;
  PROCEND add_to_module_list;
?? OLDTITLE ??
?? NEWTITLE := 'add_to_product_list', EJECT ??

{   The purpose of this request is to add the product name of the supplied entry
{ external to the product list for the specified reference kind.

  PROCEDURE add_to_product_list
    (    reference_kind: t$reference_kind;
         entry_external: t$entry_external);

    CONST
      estimated_number_of_products = 100;

    VAR
      high_index: ost$non_negative_integers,
      index: ost$non_negative_integers,
      insertion_index: ost$non_negative_integers,
      low_index: ost$non_negative_integers,
      number_of_products: ost$non_negative_integers,
      temp: integer,
      product_list_p: ^array [1 .. * ] of clt$data_value;

    product_list_p := v$product_list [reference_kind].elements_p;
    number_of_products := v$product_list [reference_kind].element_count;

{ If there is no product list, create one.

    IF number_of_products = 0 THEN
      ALLOCATE v$product_list [reference_kind].elements_p: [1 .. estimated_number_of_products];
      v$product_list [reference_kind].element_count := 1;
      v$product_list [reference_kind].elements_p^ [1].kind := clc$name;
      v$product_list [reference_kind].elements_p^ [1].name_value := entry_external.product_name;
      RETURN;
    IFEND;

{ See if the product is already in the product list.

    high_index := number_of_products;
    low_index := 1;

    REPEAT
      temp := low_index + high_index;
      insertion_index := temp DIV 2;
      IF entry_external.product_name = product_list_p^ [insertion_index].name_value THEN
        RETURN;
      ELSEIF entry_external.product_name > product_list_p^ [insertion_index].name_value THEN
        low_index := insertion_index + 1;
      ELSE
        high_index := insertion_index - 1;
      IFEND;
    UNTIL (low_index > high_index);

{ Adjust the insertion_index to point to the element to insert BEFORE.
{ If the last partition indicated to insert AFTER the current entry,
{ increment the insertion_index.

    IF low_index > insertion_index THEN
      insertion_index := insertion_index + 1;
    IFEND;

{ Increase the size of the product list if necessary.

    IF (number_of_products + 1) > UPPERBOUND (product_list_p^) THEN
      ALLOCATE product_list_p: [1 .. number_of_products + estimated_number_of_products];
      i#move (v$product_list [reference_kind].elements_p, product_list_p,
            #SIZE (product_list_p^ [1]) * number_of_products);
      FREE v$product_list [reference_kind].elements_p;
      v$product_list [reference_kind].elements_p := product_list_p;
    IFEND;

{ Can't do i#move .. darn

    FOR index := number_of_products DOWNTO insertion_index DO
      product_list_p^ [index + 1] := product_list_p^ [index];
    FOREND;
    product_list_p^ [insertion_index].kind := clc$name;
    product_list_p^ [insertion_index].name_value := entry_external.product_name;

    v$product_list [reference_kind].element_count := number_of_products + 1;
  PROCEND add_to_product_list;
?? OLDTITLE ??
?? NEWTITLE := 'close_output_file', EJECT ??

{   The purpose of this request is to close the files used for the output of a
{ display command.

  PROCEDURE close_output_file
    (VAR status: ost$status);

    IF v$output_file_open THEN
      clp$close_display (v$display_control, status);
      IF status.normal THEN
        v$output_file_open := FALSE;
        #SPOIL (v$output_file_open);
      IFEND;
    IFEND;

  PROCEND close_output_file;
?? OLDTITLE ??
?? NEWTITLE := 'close_segment', EJECT ??

{ The purpose of this request is to close (delete) a scratch segment.

  PROCEDURE close_segment
    (    segment_p: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      segment_pointer: amt$segment_pointer;

    status.normal := TRUE;

    IF segment_p <> NIL THEN
      segment_pointer.kind := amc$sequence_pointer;
      segment_pointer.sequence_pointer := segment_p;
      mmp$delete_scratch_segment (segment_pointer, status);
    IFEND;
  PROCEND close_segment;
?? OLDTITLE ??
?? NEWTITLE := 'close_target_file', EJECT ??

{   The purpose of this request is to close a segment access file that has been
{ written.  The sequence position of the sequence pointer supplied on the request
{ is used to set the file's end of information (EOI).

  PROCEDURE close_target_file
    (    file_p: ^SEQ ( * );
         file_identifier: amt$file_identifier;
     VAR status: ost$status);

    VAR
      segment_pointer: amt$segment_pointer;

    IF file_p <> NIL THEN
      segment_pointer.kind := amc$sequence_pointer;
      segment_pointer.sequence_pointer := file_p;
      amp$set_segment_eoi (file_identifier, segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      fsp$close_file (file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
  PROCEND close_target_file;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] declaration_mismatch', EJECT ??

{   The purpose of this request is to determine if the two entry externals
{ match for the supplied object or source checking value.  If the languages are
{ the same and both entry externals require declaration matching, then the
{ compiler generated hashes must match.  If the languages are not the same or
{ the one of the entry externals does not require declaration matching then
{ the entry externals match.  This is the same comparison that is used by the
{ NOS/VE loader to detect declaration mismatches.
{
{ NOTE:
{   This function should be used when comparing entry externals to see if they
{ mismatch.

  FUNCTION [INLINE] declaration_mismatch
    (    object_checking: boolean;
         x: t$entry_external;
         y: t$entry_external): boolean;

    IF (x.language = y.language) AND (x.declaration_matching_required) AND
          (y.declaration_matching_required) THEN
      IF x.language = llc$cybil THEN
        IF object_checking THEN
          declaration_mismatch := x.declaration_matching.object_encryption <>
                y.declaration_matching.object_encryption;
        ELSE
          declaration_mismatch := x.declaration_matching.source_encryption <>
                y.declaration_matching.source_encryption;
        IFEND;
      ELSE
        declaration_mismatch := x.declaration_matching.language_dependent_value <>
              y.declaration_matching.language_dependent_value;
      IFEND;
    ELSE
      declaration_mismatch := FALSE;
    IFEND;
  FUNCEND declaration_mismatch;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] declaration_values_match', EJECT ??

{   The purpose of this function is to determine if the two supplied entry externals
{ have the same language, declaration matching required and hash values.  If they
{ do they match, otherwise they do not.
{
{ NOTE:
{   This request should be used to compare two entry externals to see if they
{ match.

  FUNCTION [INLINE] declaration_values_match
    (    x: t$entry_external;
         y: t$entry_external): boolean;

    IF (x.language = y.language) AND (x.declaration_matching_required = y.declaration_matching_required) THEN
      IF x.language = llc$cybil THEN
        declaration_values_match := (x.declaration_matching.object_encryption =
              y.declaration_matching.object_encryption) AND (x.declaration_matching.source_encryption =
              y.declaration_matching.source_encryption);
      ELSE
        declaration_values_match := x.declaration_matching.language_dependent_value =
              y.declaration_matching.language_dependent_value;
      IFEND;
    ELSE
      declaration_values_match := FALSE;
    IFEND;
  FUNCEND declaration_values_match;
?? OLDTITLE ??
?? NEWTITLE := 'display_output_string', EJECT ??

{   The purpose of this request is to display a string to the output file of a
{ display command.  If the output file is not open, the string is discarded.

  PROCEDURE display_output_string
    (    output_string: string ( * );
     VAR status: ost$status);

    IF NOT v$output_file_open THEN
      RETURN;
    IFEND;

    clp$put_display (v$display_control, output_string, clc$trim, status);
  PROCEND display_output_string;
?? OLDTITLE ??
?? NEWTITLE := 'establish_display_title', EJECT ??

{   The purpose of this request is to define the title for a display command.

  PROCEDURE [INLINE] establish_display_title
    (    command_title: string ( * ));

    clv$titles_built := FALSE;
    clv$command_name := command_title;

  PROCEND establish_display_title;
?? OLDTITLE ??
?? NEWTITLE := 'get_entry_external_list', EJECT ??

{   The purpose of this request is to get the entry point list or external
{ reference list from the working file based on the reference type supplied.

  PROCEDURE get_entry_external_list
    (    reference_type: ost$name;
     VAR entry_external_list_p: ^t$entry_external_list;
     VAR status: ost$status);

    VAR
      entry_external_header_p: ^t$entry_external_file_header;

    IF reference_type = 'ENTRY_POINT' THEN
      IF v$working_file.entry_points_p <> NIL THEN
        RESET v$working_file.entry_points_p;
        NEXT entry_external_header_p IN v$working_file.entry_points_p;
        IF entry_external_header_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 011', status);
          RETURN;
        IFEND;
        IF entry_external_header_p^.entry_point_count > 0 THEN
          NEXT entry_external_list_p: [1 .. entry_external_header_p^.entry_point_count] IN
                v$working_file.entry_points_p;
          IF entry_external_list_p = NIL THEN
            osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 012', status);
            RETURN;
          IFEND;
        ELSE
          entry_external_list_p := NIL;
        IFEND;
      ELSE
        entry_external_list_p := NIL;
      IFEND;
    ELSE { IF reference_type = 'EXTERNAL_REFERENCE' THEN
      IF v$working_file.externals_p <> NIL THEN
        RESET v$working_file.externals_p;
        NEXT entry_external_header_p IN v$working_file.externals_p;
        IF entry_external_header_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 013', status);
          RETURN;
        IFEND;
        IF entry_external_header_p^.external_count > 0 THEN
          NEXT entry_external_list_p: [1 .. entry_external_header_p^.external_count] IN
                v$working_file.externals_p;
          IF entry_external_list_p = NIL THEN
            osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 014', status);
            RETURN;
          IFEND;
        ELSE
          entry_external_list_p := NIL;
        IFEND;
      ELSE
        entry_external_list_p := NIL;
      IFEND;
    IFEND;

  PROCEND get_entry_external_list;
?? OLDTITLE ??
?? NEWTITLE := 'greater_than: boolean', EJECT ??

{   The purpose of this function is to determine if the first entry/external is
{ lexically greater in value than the second entry/external.  Entry external files
{ have the entry/external records in lexically increasing order.

  FUNCTION greater_than
    (    x: t$entry_external;
         y: t$entry_external): boolean;

    VAR
      x_compare: t$comparison_converter,
      y_compare: t$comparison_converter;

    x_compare.entry_external_p := ^x;
    y_compare.entry_external_p := ^y;

    greater_than := x_compare.value_p^ > y_compare.value_p^;
  FUNCEND greater_than;
?? OLDTITLE ??
?? NEWTITLE := 'log_message', EJECT ??

{   The purpose of this request is to log a message to the executing job's
{ job log.

  PROCEDURE log_message
    (    message: string ( * ));

    VAR
      ignore_status: ost$status;

    pmp$log (message (1, clp$trimmed_string_size (message)), ignore_status);
  PROCEND log_message;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] make_entry_external_record', EJECT ??

{   The purpose of this request is to create an SCL record that defines an
{ entry/external.  This record is returned by functions that return a list of
{ entry/external definitions.

  PROCEDURE [INLINE] make_entry_external_record
    (    entry_external: t$entry_external;
     VAR work_area_p: {input, output} ^clt$work_area;
     VAR value_p: ^clt$data_value);

    clp$make_record_value (3, work_area_p, value_p);
    value_p^.field_values^ [1].name := 'REFERENCE_NAME';
    clp$make_program_name_value (entry_external.name, work_area_p, value_p^.field_values^ [1].value);
    value_p^.field_values^ [2].name := 'PRODUCT_NAME';
    clp$make_name_value (entry_external.product_name, work_area_p, value_p^.field_values^ [2].value);
    value_p^.field_values^ [3].name := 'MODULE_NAME';
    clp$make_program_name_value (entry_external.module_name, work_area_p, value_p^.field_values^ [3].value);
  PROCEND make_entry_external_record;
?? OLDTITLE ??
?? NEWTITLE := 'merge_with_working_file', EJECT ??

{   The purpose of this request is to combine the specified list of entry external
{ record lists with the working file.  Duplicate entries are ignored.  The working
{ file is created in lexically increasing order.

  PROCEDURE merge_with_working_file
    (    new_file_list_p: ^t$entry_external_files;
     VAR status: ost$status);

    VAR
      candidate_compare: t$comparison_converter,
      current_compare: t$comparison_converter,
      current_index: 0 .. clc$max_list_size,
      file_index: 1 .. clc$max_list_size,
      merge_file_list_p: ^array [1 .. * ] of record
        element: t$entry_external_file_element,
        entry_point_count: ost$non_negative_integers,
        entry_point_index: ost$non_negative_integers,
        external_count: ost$non_negative_integers,
        external_index: ost$non_negative_integers,
      recend,
      new_entry_external_list_p: ^t$entry_external_list,
      new_entry_external_p: ^t$entry_external,
      new_entry_point_header_p: ^t$entry_external_file_header,
      new_entry_point_p: ^SEQ ( * ),
      new_external_header_p: ^t$entry_external_file_header,
      new_external_p: ^SEQ ( * ),
      rebuild_entry_point_lists: boolean,
      rebuild_external_lists: boolean,
      working_file_header_p: ^t$entry_external_file_header;

?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.
{ When this handler gets control, the working file is left in a state
{ equivalent to if the command had never been executed.

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        close_segment (new_entry_point_p, ignore_status);
        close_segment (new_external_p, ignore_status);
        rebuild_module_and_product_list (c$rk_entry_point);
        rebuild_module_and_product_list (c$rk_external);

      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;
    PROCEND abort_handler;
?? OLDTITLE ??
?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.
{   Ignore terminate break conditions.  This is considered a "critical section."

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

{ Ignore terminate break during a critical section.

      IF (condition.selector = ifc$interactive_condition) AND
            (condition.interactive_condition = ifc$terminate_break) THEN
        RETURN;

      ELSEIF condition.selector = pmc$block_exit_processing THEN
        close_segment (new_entry_point_p, ignore_status);
        close_segment (new_external_p, ignore_status);
        reset_working_file;

        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
?? EJECT ??

    status.normal := TRUE;
    new_entry_point_p := NIL;
    new_external_p := NIL;
    #SPOIL (new_entry_point_p, new_external_p);

    rebuild_entry_point_lists := FALSE;
    rebuild_external_lists := FALSE;

{   This condition handler will ignore terminate break.  The whole utility
{ will get messed up if this process is interrupted.

    osp$establish_block_exit_hndlr (^abort_handler);

    open_segment (new_entry_point_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT new_entry_point_header_p IN new_entry_point_p;
    IF new_entry_point_header_p = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 001', status);
      RETURN;
    IFEND;
    new_entry_point_header_p^.identification := c$entry_external_id;
    new_entry_point_header_p^.entry_point_count := 0;
    new_entry_point_header_p^.external_count := 0;

    open_segment (new_external_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT new_external_header_p IN new_external_p;
    IF new_external_header_p = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 002', status);
      RETURN;
    IFEND;
    new_external_header_p^.identification := c$entry_external_id;
    new_external_header_p^.entry_point_count := 0;
    new_external_header_p^.external_count := 0;

{ Add the working file to the merge list.  Make it the first entry as the working file
{ will, most often be the one with the most entries and thus less data movement will need
{ to take place when merging.

    PUSH merge_file_list_p: [1 .. (UPPERBOUND (new_file_list_p^) + 1)];
    FOR file_index := 1 TO UPPERBOUND (new_file_list_p^) DO
      merge_file_list_p^ [file_index + 1].element := new_file_list_p^ [file_index];
      merge_file_list_p^ [file_index + 1].entry_point_index := 1;
      merge_file_list_p^ [file_index + 1].external_index := 1;
      IF new_file_list_p^ [file_index].entry_point_list_p = NIL THEN
        merge_file_list_p^ [file_index + 1].entry_point_count := 0;
      ELSE
        merge_file_list_p^ [file_index + 1].entry_point_count :=
              UPPERBOUND (new_file_list_p^ [file_index].entry_point_list_p^);
      IFEND;
      IF new_file_list_p^ [file_index].external_list_p = NIL THEN
        merge_file_list_p^ [file_index + 1].external_count := 0;
      ELSE
        merge_file_list_p^ [file_index + 1].external_count :=
              UPPERBOUND (new_file_list_p^ [file_index].external_list_p^);
      IFEND;
    FOREND;

    IF v$working_file.entry_points_p <> NIL THEN
      RESET v$working_file.entry_points_p;
      NEXT working_file_header_p IN v$working_file.entry_points_p;
      IF working_file_header_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 003', status);
        RETURN;
      IFEND;
      IF working_file_header_p^.entry_point_count > 0 THEN
        NEXT merge_file_list_p^ [1].element.entry_point_list_p:
              [1 .. working_file_header_p^.entry_point_count] IN v$working_file.entry_points_p;
        IF merge_file_list_p^ [1].element.entry_point_list_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 004', status);
          RETURN;
        IFEND;
        merge_file_list_p^ [1].entry_point_count := working_file_header_p^.entry_point_count;
      ELSE
        merge_file_list_p^ [1].element.entry_point_list_p := NIL;
        merge_file_list_p^ [1].entry_point_count := 0;
      IFEND;
    ELSE
      merge_file_list_p^ [1].element.entry_point_list_p := NIL;
      merge_file_list_p^ [1].entry_point_count := 0;
    IFEND;

    IF v$working_file.externals_p <> NIL THEN
      RESET v$working_file.externals_p;
      NEXT working_file_header_p IN v$working_file.externals_p;
      IF working_file_header_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 005', status);
        RETURN;
      IFEND;
      IF working_file_header_p^.external_count > 0 THEN
        NEXT merge_file_list_p^ [1].element.external_list_p: [1 .. working_file_header_p^.external_count] IN
              v$working_file.externals_p;
        IF merge_file_list_p^ [1].element.external_list_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 006', status);
          RETURN;
        IFEND;
        merge_file_list_p^ [1].external_count := working_file_header_p^.external_count;
      ELSE
        merge_file_list_p^ [1].element.external_list_p := NIL;
        merge_file_list_p^ [1].external_count := 0;
      IFEND;
    ELSE
      merge_file_list_p^ [1].element.external_list_p := NIL;
      merge_file_list_p^ [1].external_count := 0;
    IFEND;
    merge_file_list_p^ [1].entry_point_index := 1;
    merge_file_list_p^ [1].external_index := 1;

{ Merge Entry Points...
{ If the working file is empty and only one file is being added....
{ Just move the added file to the new list.

    IF (merge_file_list_p^ [1].element.entry_point_list_p = NIL) AND (UPPERBOUND (merge_file_list_p^) =
          2) THEN
      IF merge_file_list_p^ [2].element.entry_point_list_p <> NIL THEN
        NEXT new_entry_external_list_p: [1 .. merge_file_list_p^ [2].entry_point_count] IN new_entry_point_p;
        new_entry_external_list_p^ := merge_file_list_p^ [2].element.entry_point_list_p^;
        new_entry_point_header_p^.entry_point_count := UPPERBOUND (new_entry_external_list_p^);
        rebuild_entry_point_lists := TRUE;
      IFEND;
    ELSE
      REPEAT
        current_index := 0;

      /find_next_entry_point/
        FOR file_index := 1 TO UPPERBOUND (merge_file_list_p^) DO
          IF merge_file_list_p^ [file_index].entry_point_index <=
                merge_file_list_p^ [file_index].entry_point_count THEN
            IF current_index > 0 THEN
              candidate_compare.entry_external_p := ^merge_file_list_p^ [file_index].element.
                    entry_point_list_p^ [merge_file_list_p^ [file_index].entry_point_index];

{ Check for duplicate entry points.

              WHILE candidate_compare.value_p^ = current_compare.value_p^ DO
                merge_file_list_p^ [file_index].entry_point_index :=
                      merge_file_list_p^ [file_index].entry_point_index + 1;
                IF merge_file_list_p^ [file_index].entry_point_index >
                      merge_file_list_p^ [file_index].entry_point_count THEN
                  CYCLE /find_next_entry_point/;
                IFEND;
                candidate_compare.entry_external_p := ^merge_file_list_p^ [file_index].element.
                      entry_point_list_p^ [merge_file_list_p^ [file_index].entry_point_index];
              WHILEND;

              IF current_compare.value_p^ > candidate_compare.value_p^ THEN
                current_index := file_index;
                current_compare := candidate_compare;
              IFEND;
            ELSE
              current_index := file_index;
              current_compare.entry_external_p := ^merge_file_list_p^ [file_index].element.
                    entry_point_list_p^ [merge_file_list_p^ [file_index].entry_point_index];
            IFEND;
          IFEND;
        FOREND /find_next_entry_point/;
        IF current_index > 0 THEN
          new_entry_point_header_p^.entry_point_count := new_entry_point_header_p^.entry_point_count + 1;
          NEXT new_entry_external_p IN new_entry_point_p;
          IF new_entry_external_p = NIL THEN
            osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 007', status);
            RETURN;
          IFEND;
          new_entry_external_p^ := merge_file_list_p^ [current_index].
                element.entry_point_list_p^ [merge_file_list_p^ [current_index].entry_point_index];
          merge_file_list_p^ [current_index].entry_point_index :=
                merge_file_list_p^ [current_index].entry_point_index + 1;

{ If the entry point is not already in the working file module or product list, then add it.

          IF current_index > 1 THEN
            add_to_module_list (c$rk_entry_point, new_entry_external_p^);
            add_to_product_list (c$rk_entry_point, new_entry_external_p^);
          IFEND;
        IFEND;
      UNTIL current_index = 0;
    IFEND;

{ Now Merge the externals
{ If the working file is empty and only one file is being added....
{ Just move the added file to the new list.

    IF (merge_file_list_p^ [1].element.external_list_p = NIL) AND (UPPERBOUND (merge_file_list_p^) = 2) THEN
      IF merge_file_list_p^ [2].element.external_list_p <> NIL THEN
        NEXT new_entry_external_list_p: [1 .. merge_file_list_p^ [2].external_count] IN new_external_p;
        new_entry_external_list_p^ := merge_file_list_p^ [2].element.external_list_p^;
        new_external_header_p^.external_count := UPPERBOUND (new_entry_external_list_p^);
        rebuild_external_lists := TRUE;
      IFEND;
    ELSE

      REPEAT
        current_index := 0;

      /find_next_external/
        FOR file_index := 1 TO UPPERBOUND (merge_file_list_p^) DO
          IF merge_file_list_p^ [file_index].external_index <= merge_file_list_p^ [file_index].
                external_count THEN
            IF current_index > 0 THEN
              candidate_compare.entry_external_p := ^merge_file_list_p^ [file_index].element.
                    external_list_p^ [merge_file_list_p^ [file_index].external_index];

{ Check for duplicate external references.

              WHILE candidate_compare.value_p^ = current_compare.value_p^ DO
                merge_file_list_p^ [file_index].external_index :=
                      merge_file_list_p^ [file_index].external_index + 1;
                IF merge_file_list_p^ [file_index].external_index >
                      merge_file_list_p^ [file_index].external_count THEN
                  CYCLE /find_next_external/;
                IFEND;
                candidate_compare.entry_external_p := ^merge_file_list_p^ [file_index].element.
                      external_list_p^ [merge_file_list_p^ [file_index].external_index];
              WHILEND;

              IF current_compare.value_p^ > candidate_compare.value_p^ THEN
                current_index := file_index;
                current_compare := candidate_compare;
              IFEND;
            ELSE
              current_index := file_index;
              current_compare.entry_external_p := ^merge_file_list_p^ [file_index].
                    element.external_list_p^ [merge_file_list_p^ [file_index].external_index];
            IFEND;
          IFEND;
        FOREND /find_next_external/;
        IF current_index > 0 THEN
          new_external_header_p^.external_count := new_external_header_p^.external_count + 1;
          NEXT new_entry_external_p IN new_external_p;
          IF new_entry_external_p = NIL THEN
            osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 008', status);
            RETURN;
          IFEND;
          new_entry_external_p^ := merge_file_list_p^ [current_index].
                element.external_list_p^ [merge_file_list_p^ [current_index].external_index];
          merge_file_list_p^ [current_index].external_index :=
                merge_file_list_p^ [current_index].external_index + 1;

{ If the external is not already in the working file module or product list, then add it.

          IF current_index > 1 THEN
            add_to_module_list (c$rk_external, new_entry_external_p^);
            add_to_product_list (c$rk_external, new_entry_external_p^);
          IFEND;
        IFEND;
      UNTIL current_index = 0;
    IFEND;

{ Make the new files the working file.

    close_segment (v$working_file.entry_points_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    close_segment (v$working_file.externals_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ This establishment overwrites the establishment of the current handler.
{ This is considered "critical" code and terminate break is ignored.

    osp$establish_condition_handler (^condition_handler, {block_exit} TRUE);

    v$working_file.entry_points_p := new_entry_point_p;
    v$working_file.externals_p := new_external_p;
    IF rebuild_entry_point_lists THEN
      rebuild_module_and_product_list (c$rk_entry_point);
    IFEND;
    IF rebuild_external_lists THEN
      rebuild_module_and_product_list (c$rk_external);
    IFEND;
    osp$disestablish_cond_handler;
  PROCEND merge_with_working_file;
?? OLDTITLE ??
?? NEWTITLE := 'open_output_file', EJECT ??

{   The purpose of this request is to open a file to be used for the output of
{ a display command.

  PROCEDURE open_output_file
    (    output_file: fst$file_reference;
     VAR status: ost$status);

    VAR
      default_ring_attributes: amt$ring_attributes;

    status.normal := TRUE;
    IF NOT v$output_file_open THEN

      default_ring_attributes.r1 := #RING (^default_ring_attributes);
      default_ring_attributes.r2 := #RING (^default_ring_attributes);
      default_ring_attributes.r3 := #RING (^default_ring_attributes);

      clp$open_display_reference (output_file, ^clp$new_page_procedure, fsc$list, default_ring_attributes,
            v$display_control, status);
      IF status.normal THEN
        v$output_file_open := TRUE;
        #SPOIL (v$output_file_open);
      IFEND;
    IFEND;

  PROCEND open_output_file;
?? OLDTITLE ??
?? NEWTITLE := 'open_segment', EJECT ??

{   The purpose of this request is to create a new scratch segment.
{ This request returns with the segment pointer already RESET.

  PROCEDURE open_segment
    (VAR segment_p: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      segment_attributes_p: ^array [ * ] of mmt$user_attribute_descriptor,
      segment_pointer: amt$segment_pointer;

    status.normal := TRUE;
    PUSH segment_attributes_p: [1 .. 1];

    segment_attributes_p^ [1].keyword := mmc$ua_preset_value;
    segment_attributes_p^ [1].preset_value := pmc$initialize_to_zero;
    mmp$create_user_segment (segment_attributes_p, amc$sequence_pointer, mmc$as_sequential, segment_pointer,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    segment_p := segment_pointer.sequence_pointer;
    RESET segment_p;

  PROCEND open_segment;
?? OLDTITLE ??
?? NEWTITLE := 'open_source_file', EJECT ??

{   The purpose of this request is to open an existing segment access file.
{ This request returns with the sequence reset.

  PROCEDURE open_source_file
    (    file_reference: fst$file_reference;
     VAR file_p: ^SEQ ( * );
     VAR file_identifier: amt$file_identifier;
     VAR status: ost$status);

    VAR
      attachment_options: array [1 .. 3] of fst$attachment_option,
      ignore_status: ost$status,
      segment_pointer: amt$segment_pointer;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [2].selector := fsc$sequential_access;
    attachment_options [2].sequential_access := TRUE;
    attachment_options [3].selector := fsc$free_behind;
    attachment_options [3].free_behind := TRUE;

    fsp$open_file (file_reference, amc$segment, ^attachment_options, NIL, NIL, NIL, NIL, file_identifier,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier, ignore_status);
      RETURN;
    IFEND;

    file_p := segment_pointer.sequence_pointer;
    RESET file_p;
  PROCEND open_source_file;
?? OLDTITLE ??
?? NEWTITLE := 'open_target_file', EJECT ??

{   The purpose of this request is to open up a file to which data is to be
{ written.  The file is opened for segment access.  The sequence returned is
{ reset by this procedure.

  PROCEDURE open_target_file
    (    file_reference: fst$file_reference;
     VAR file_p: ^SEQ ( * );
     VAR file_identifier: amt$file_identifier;
     VAR status: ost$status);

    VAR
      attachment_options: array [1 .. 3] of fst$attachment_option,
      ignore_status: ost$status,
      segment_pointer: amt$segment_pointer;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options
          [fsc$read, fsc$shorten, fsc$append, fsc$modify];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [];
    attachment_options [2].selector := fsc$sequential_access;
    attachment_options [2].sequential_access := TRUE;
    attachment_options [3].selector := fsc$free_behind;
    attachment_options [3].free_behind := TRUE;

    fsp$open_file (file_reference, amc$segment, ^attachment_options, NIL, NIL, NIL, NIL, file_identifier,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier, ignore_status);
      RETURN;
    IFEND;

    file_p := segment_pointer.sequence_pointer;
    RESET file_p;
  PROCEND open_target_file;
?? OLDTITLE ??
?? NEWTITLE := 'put_subtitle', EJECT ??

{  This is a dummy procedure used by clp$new_page_procedure for output commands.

  PROCEDURE [INLINE] put_subtitle
    (VAR display_control: clt$display_control;
     VAR status: ost$status);

{ These displays do not have subtitles.  This is merely a dummy routine to keep the module consistant
{ with those that do produce subtitles.

  PROCEND put_subtitle;
?? OLDTITLE ??
?? NEWTITLE := 'rebuild_module_and_product_list', EJECT ??

{   The purpose of this request is to discard the current module and product list
{ and create a new one based on the working file.

  PROCEDURE rebuild_module_and_product_list
    (    reference_kind: t$reference_kind);

    VAR
      entry_external_file_header_p: ^t$entry_external_file_header,
      entry_external_list_p: ^t$entry_external_list,
      index: ost$non_negative_integers;

{ Go through the entry points.

    IF v$module_list [reference_kind].elements_p <> NIL THEN
      FREE v$module_list [reference_kind].elements_p;
    IFEND;
    v$module_list [reference_kind].element_count := 0;
    IF v$product_list [reference_kind].elements_p <> NIL THEN
      FREE v$product_list [reference_kind].elements_p;
    IFEND;
    v$product_list [reference_kind].element_count := 0;

    entry_external_list_p := NIL;
    IF reference_kind = c$rk_entry_point THEN
      IF v$working_file.entry_points_p <> NIL THEN
        RESET v$working_file.entry_points_p;
        NEXT entry_external_file_header_p IN v$working_file.entry_points_p;
        IF entry_external_file_header_p^.entry_point_count > 0 THEN
          NEXT entry_external_list_p: [1 .. entry_external_file_header_p^.entry_point_count] IN
                v$working_file.entry_points_p;
        IFEND;
      IFEND;
    ELSE { IF reference_kind = c$rk_external  THEN
      IF v$working_file.externals_p <> NIL THEN
        RESET v$working_file.externals_p;
        NEXT entry_external_file_header_p IN v$working_file.externals_p;
        IF entry_external_file_header_p^.external_count > 0 THEN
          NEXT entry_external_list_p: [1 .. entry_external_file_header_p^.external_count] IN
                v$working_file.externals_p;
        IFEND;
      IFEND;
    IFEND;

    IF entry_external_list_p <> NIL THEN
      FOR index := 1 TO UPPERBOUND (entry_external_list_p^) DO
        add_to_module_list (reference_kind, entry_external_list_p^ [index]);
        add_to_product_list (reference_kind, entry_external_list_p^ [index]);
      FOREND;
    IFEND;
  PROCEND rebuild_module_and_product_list;
?? OLDTITLE ??
?? NEWTITLE := 'remove_duplicates', EJECT ??

{   The purpose of this request is to remove duplicate entries from the file it is passed.
{
{ NOTE:
{   It is assumed that this is only done on one of the working files, and therefore,
{ there are only entry point or externals in the file, and not both.

  PROCEDURE remove_duplicates
    (VAR file_p: ^SEQ ( * ));

    TYPE
      t$entry_external_list = array [1 .. * ] of string (c$entry_external_record_size);

    VAR
      entry_external_header_p: ^t$entry_external_file_header,
      entry_external_list_p: ^t$entry_external_list,
      index: integer,
      low_index: integer;

    IF file_p = NIL THEN
      RETURN;
    IFEND;

{ Can't return NIL.  Segments have already been verified.

    RESET file_p;
    NEXT entry_external_header_p IN file_p;

    IF entry_external_header_p^.entry_point_count > 0 THEN
      NEXT entry_external_list_p: [1 .. entry_external_header_p^.entry_point_count] IN file_p;
    ELSEIF entry_external_header_p^.external_count > 0 THEN
      NEXT entry_external_list_p: [1 .. entry_external_header_p^.external_count] IN file_p;
    ELSE
      RETURN;
    IFEND;

    low_index := 1;
    FOR index := 2 TO UPPERBOUND (entry_external_list_p^) DO
      IF entry_external_list_p^ [index] <> entry_external_list_p^ [low_index] THEN
        low_index := low_index + 1;
        IF low_index <> index THEN
          entry_external_list_p^ [low_index] := entry_external_list_p^ [index];
        IFEND;
      IFEND;
    FOREND;
    IF entry_external_header_p^.entry_point_count > 0 THEN
      entry_external_header_p^.entry_point_count := low_index;
    ELSE { IF entry_exernal_header_p^.external_count > 0 THEN
      entry_external_header_p^.external_count := low_index;
    IFEND;
  PROCEND remove_duplicates;
?? OLDTITLE ??
?? NEWTITLE := 'reset_working_file', EJECT ??

{   The purpose of this request is to discard the working file, module list and
{ product list.  This resets the utility to the point it was at upon entry.

  PROCEDURE reset_working_file;

    VAR
      ignore_status: ost$status;

    close_segment (v$working_file.entry_points_p, ignore_status);
    close_segment (v$working_file.externals_p, ignore_status);
    v$working_file.entry_points_p := NIL;
    v$working_file.externals_p := NIL;
    IF v$module_list [c$rk_entry_point].elements_p <> NIL THEN
      FREE v$module_list [c$rk_entry_point].elements_p;
    IFEND;
    v$module_list [c$rk_entry_point].element_count := 0;
    IF v$module_list [c$rk_external].elements_p <> NIL THEN
      FREE v$module_list [c$rk_external].elements_p;
    IFEND;
    v$module_list [c$rk_external].element_count := 0;
    IF v$product_list [c$rk_entry_point].elements_p <> NIL THEN
      FREE v$product_list [c$rk_entry_point].elements_p;
    IFEND;
    v$product_list [c$rk_entry_point].element_count := 0;
    IF v$product_list [c$rk_external].elements_p <> NIL THEN
      FREE v$product_list [c$rk_external].elements_p;
    IFEND;
    v$product_list [c$rk_external].element_count := 0;
  PROCEND reset_working_file;
?? OLDTITLE ??
?? NEWTITLE := 'sort_entry_external_list', EJECT ??

{   The purpose of this request is to sort the supplied entry external list.

  PROCEDURE sort_entry_external_list
    (    entry_external_list_p: ^t$entry_external_list);

    VAR
      gap: integer,
      start: integer,
      current: integer,
      swap: t$entry_external;

    gap := UPPERBOUND (entry_external_list_p^);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := 1 TO UPPERBOUND (entry_external_list_p^) - gap DO
        current := start;
        WHILE (current > 0) AND greater_than (entry_external_list_p^ [current],
              entry_external_list_p^ [current + gap]) DO
          swap := entry_external_list_p^ [current];
          entry_external_list_p^ [current] := entry_external_list_p^ [current + gap];
          entry_external_list_p^ [current + gap] := swap;
          current := current - gap;
        WHILEND;
      FOREND;
    WHILEND;
  PROCEND sort_entry_external_list;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$compare_reference_file', EJECT ??

{   The purpose of this function is to compare the reference type for the
{ working file with the reference type for the specified reference file.
{
{ DESIGN:
{   Get the correct entry external list from the working file.
{   Open the reference file and get the correct entry external list.
{   Set result to empty list.
{   working_index := 1;   working_list [working_index] is called working_entry
{   compare_index := 1;   compare_list [compare_index] is called compare_entry
{   WHILE working_index and compare_index < the size of their respective entry external lists DO
{     IF working_entry.name = compare_entry.name THEN
{       IF declaration mismatch (working_entry, compare_entry) THEN
{         add mismatch to result list
{       IFEND
{       compare_index := compare_index + 1; {get the next compare list element
{     ELSEIF working_entry.name < compare_entry.name THEN
{       working_index := working_index + 1;
{          need to backup the compare list in case the next working entry is
{          the same as the current compare entry.  This happens as a side
{          effect from the first part of the IF.  This happens when the working
{          file contains entries with the same name.
{       WHILE compare_entry.name = working_entry.name DO
{         compare_index := compare_index - 1;
{       WHILEND;
{     ELSE
{       compare_index := compare_index + 1;
{     IFEND
{   WHILEND
{   close the reference file.

  PROCEDURE ocp$$compare_reference_file
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_comrf) $compare_reference_file, $comrf (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   reference_file: record
{       file: file
{       reference_type: key
{         (entry_point, entry_points, ep)
{         (external_reference, external_references, er)
{       keyend
{     recend = $required
{   cybil_parameter_checking: key
{       (object, o)
{       (source, s)
{     keyend = object
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$record_type_qualifier,
        field_spec_1: clt$field_specification,
        element_type_spec_1: record
          header: clt$type_specification_header,
        recend,
        field_spec_2: clt$field_specification,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 6] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (6),
      recend,
    recend := [
    [1,
    [90, 3, 28, 23, 10, 55, 29],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'OCM$$PRORU_COMRF'], [
    ['CYBIL_PARAMETER_CHECKING       ',clc$nominal_entry, 3],
    ['REFERENCE_FILE                 ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 311,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 6]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$record_type], [2],
    ['FILE                           ', clc$required_field, 3], [[1, 0, clc$file_type]],
    ['REFERENCE_TYPE                 ', clc$required_field, 229], [[1, 0, clc$keyword_type], [6], [
      ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
      ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['O                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['OBJECT                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['SOURCE                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'object']];

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

    CONST
      p$reference_type = 1,
      p$reference_file = 2,
      p$cybil_parameter_checking = 3;

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

    VAR
      compare_fid: amt$file_identifier,
      compare_file_p: ^SEQ ( * ),
      compare_header_p: ^t$entry_external_file_header,
      compare_index: ost$non_negative_integers,
      compare_list_p: ^t$entry_external_list,
      data_value_pp: ^^clt$data_value,
      object_checking: boolean,
      working_index: ost$non_negative_integers,
      working_list_p: ^t$entry_external_list;

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        fsp$close_file (compare_fid, ignore_status);
        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] make_compare_record', EJECT ??

{   The purpose of this request is create an SCL record element to be returned by  the
{ $compare_reference_file function.

    PROCEDURE [INLINE] make_compare_record
      (    working_entry_external: t$entry_external;
           compare_entry_external: t$entry_external;
       VAR work_area_p: {input, output} ^clt$work_area;
       VAR value_p: ^clt$data_value);

      clp$make_record_value (5, work_area_p, value_p);
      value_p^.field_values^ [1].name := 'REFERENCE_NAME';
      clp$make_program_name_value (working_entry_external.name, work_area_p, value_p^.field_values^ [1].
            value);
      value_p^.field_values^ [2].name := 'WORKING_PRODUCT_NAME';
      clp$make_name_value (working_entry_external.product_name, work_area_p, value_p^.field_values^ [2].
            value);
      value_p^.field_values^ [3].name := 'WORKING_MODULE_NAME';
      clp$make_program_name_value (working_entry_external.module_name, work_area_p, value_p^.
            field_values^ [3].value);
      value_p^.field_values^ [4].name := 'FILE_PRODUCT_NAME';
      clp$make_name_value (compare_entry_external.product_name, work_area_p, value_p^.field_values^ [4].
            value);
      value_p^.field_values^ [5].name := 'FILE_MODULE_NAME';
      clp$make_program_name_value (compare_entry_external.module_name, work_area_p, value_p^.
            field_values^ [5].value);
    PROCEND make_compare_record;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;

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

    object_checking := pvt [p$cybil_parameter_checking].value^.keyword_value = 'OBJECT';

{ Determine which part of the working file to use, entry points or externals

    IF pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT' THEN
      compare_file_p := v$working_file.entry_points_p;
      IF compare_file_p = NIL THEN
        clp$make_list_value (work_area, result);
        RETURN;
      IFEND;

      RESET compare_file_p;
      NEXT compare_header_p IN compare_file_p;
      IF (compare_file_p = NIL) OR (compare_header_p^.entry_point_count = 0) THEN
        clp$make_list_value (work_area, result);
        RETURN;
      IFEND;
      NEXT working_list_p: [1 .. compare_header_p^.entry_point_count] IN compare_file_p;
      IF working_list_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 009', status);
        RETURN;
      IFEND;
    ELSE
      compare_file_p := v$working_file.externals_p;
      IF compare_file_p = NIL THEN
        clp$make_list_value (work_area, result);
        RETURN;
      IFEND;

      RESET compare_file_p;
      NEXT compare_header_p IN compare_file_p;
      IF (compare_file_p = NIL) OR (compare_header_p^.external_count = 0) THEN
        clp$make_list_value (work_area, result);
        RETURN;
      IFEND;
      NEXT working_list_p: [1 .. compare_header_p^.external_count] IN compare_file_p;
      IF working_list_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 010', status);
        RETURN;
      IFEND;
    IFEND;

    osp$establish_block_exit_hndlr (^condition_handler);

{ Open the reference file to compare with and locate the requested entry points or externals

    open_source_file (pvt [p$reference_file].value^.field_values^ [1].value^.file_value^, compare_file_p,
          compare_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT compare_header_p IN compare_file_p;
    IF pvt [p$reference_file].value^.field_values^ [2].value^.keyword_value = 'ENTRY_POINT' THEN
      IF (compare_header_p = NIL) OR (compare_header_p^.entry_point_count = 0) THEN
        osp$set_status_condition (oce$missing_or_empty_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
      NEXT compare_list_p: [1 .. compare_header_p^.entry_point_count] IN compare_file_p;
      IF compare_list_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
    ELSE
      IF (compare_header_p = NIL) OR (compare_header_p^.external_count = 0) THEN
        osp$set_status_condition (oce$missing_or_empty_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
      IF compare_header_p^.entry_point_count > 0 THEN
        NEXT compare_list_p: [1 .. compare_header_p^.entry_point_count] IN compare_file_p;
        IF compare_list_p = NIL THEN
          osp$set_status_condition (oce$premature_eof_in_segment, status);
          osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].value^.
                field_values^ [1].value^.file_value^, status);
          RETURN;
        IFEND;
      IFEND;
      NEXT compare_list_p: [1 .. compare_header_p^.external_count] IN compare_file_p;
      IF compare_list_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
    IFEND;

    result := NIL;
    data_value_pp := ^result;

{ Compare the entry points and externals.

    working_index := 1;
    compare_index := 1;

    WHILE (working_index <= UPPERBOUND (working_list_p^)) AND (compare_index <= UPPERBOUND (compare_list_p^))
          DO
      IF working_list_p^ [working_index].name = compare_list_p^ [compare_index].name THEN
        IF declaration_mismatch (object_checking, working_list_p^ [working_index],
              compare_list_p^ [compare_index]) THEN
          clp$make_list_value (work_area, data_value_pp^);
          make_compare_record (working_list_p^ [working_index], compare_list_p^ [compare_index],
                work_area, data_value_pp^^.element_value);
          data_value_pp := ^data_value_pp^^.link;
        IFEND;
        compare_index := compare_index + 1;
      ELSEIF working_list_p^ [working_index].name < compare_list_p^ [compare_index].name THEN
        working_index := working_index + 1;
        IF working_index <= UPPERBOUND (working_list_p^) THEN
          WHILE (compare_index > 1) AND (compare_list_p^ [compare_index - 1].
                name = working_list_p^ [working_index].name) DO
            compare_index := compare_index - 1;
          WHILEND;
        IFEND;
      ELSE
        compare_index := compare_index + 1;
      IFEND;
    WHILEND;

    fsp$close_file (compare_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    osp$disestablish_cond_handler;

{ If result is still NIL, no references were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

  PROCEND ocp$$compare_reference_file;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$module_information', EJECT ??

  PROCEDURE ocp$$module_information
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_modi) $module_information (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   modules: any of
{       key
{         all
{       keyend
{       list of program_name
{     anyend = all
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        default_value: string (3),
      recend,
    recend := [
    [1,
    [90, 3, 28, 23, 11, 40, 702],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OCM$$PRORU_MODI'], [
    ['MODULES                        ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83,
  clc$optional_default_parameter, 0, 3]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$program_name_type]]
      ]
    ,
    'all']];

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

    CONST
      p$reference_type = 1,
      p$modules = 2;

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

    VAR
      all_selected: boolean,
      data_value_pp: ^^clt$data_value,
      entry_external_header_p: ^t$entry_external_file_header,
      entry_external_list_p: ^t$entry_external_list,
      index: ost$non_negative_integers,
      match: boolean,
      node_p: ^clt$data_value;

    status.normal := TRUE;

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

{ Determine whether to use entry points or externals.

    get_entry_external_list (pvt [p$reference_type].value^.keyword_value, entry_external_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ If there are none, return an empty list.

    IF entry_external_list_p = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

{ Return the desired records.

    all_selected := pvt [p$modules].value^.kind = clc$keyword;
    result := NIL;
    data_value_pp := ^result;
    index := 1;
    WHILE (index <= UPPERBOUND (entry_external_list_p^)) DO
      IF NOT all_selected THEN
        match := FALSE;
        node_p := pvt [p$modules].value;
        WHILE (NOT match) AND (node_p <> NIL) DO
          match := node_p^.element_value^.program_name_value = entry_external_list_p^ [index].module_name;
          node_p := node_p^.link;
        WHILEND;
      IFEND;

      IF all_selected OR match THEN
        clp$make_list_value (work_area, data_value_pp^);
        make_entry_external_record (entry_external_list_p^ [index], work_area, data_value_pp^^.element_value);
        data_value_pp := ^data_value_pp^^.link;
      IFEND;
      index := index + 1;
    WHILEND;

{ If result is still NIL, no references were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

  PROCEND ocp$$module_information;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$module_list', EJECT ??

  PROCEDURE ocp$$module_list
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_modl) $module_list (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   module: any of
{       key
{         all
{       keyend
{       list defer_expansion of program_name
{     anyend = all
{   pattern_type: key
{       (basic, b)
{       (extended, e)
{     keyend = $scl_options.wild_card_pattern_type
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (35),
      recend,
    recend := [
    [1,
    [90, 3, 28, 23, 12, 0, 511],
    clc$function, 3, 3, 1, 0, 0, 0, 0, 'OCM$$PRORU_MODL'], [
    ['MODULE                         ',clc$nominal_entry, 2],
    ['PATTERN_TYPE                   ',clc$nominal_entry, 3],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, TRUE, FALSE],
        [[1, 0, clc$program_name_type]]
      ]
    ,
    'all'],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    '$scl_options.wild_card_pattern_type']];

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

    CONST
      p$reference_type = 1,
      p$module = 2,
      p$pattern_type = 3;

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

    TYPE
      patterns = array [1 .. * ] of record
        case pattern: boolean of
        = TRUE =
          pattern_p: ^clt$string_pattern,
        = FALSE =
          name: pmt$program_name,
        casend,
      recend;

    VAR
      all_selected: boolean,
      candidate_p: ^clt$string_value,
      data_value_pp: ^^clt$data_value,
      index: ost$non_negative_integers,
      match: boolean,
      match_info: clt$string_pattern_match_info,
      module_list_p: ^array [1 .. * ] of clt$data_value,
      node_p: ^clt$data_value,
      number_of_modules: ost$non_negative_integers,
      original_pattern_p: ^clt$string_value,
      pattern_index: ost$non_negative_integers,
      pattern_p: ^clt$string_value,
      pattern_type: clt$wild_card_pattern_type,
      selected_patterns_p: ^patterns;

    status.normal := TRUE;

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

    IF pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT' THEN
      module_list_p := v$module_list [c$rk_entry_point].elements_p;
      number_of_modules := v$module_list [c$rk_entry_point].element_count;
    ELSE { pvt [p$reference_type].value^.keyword_value = 'EXTERNAL_REFERENCE' THEN
      module_list_p := v$module_list [c$rk_external].elements_p;
      number_of_modules := v$module_list [c$rk_external].element_count;
    IFEND;

{ If there are none, return an empty list.

    IF module_list_p = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

    IF pvt [p$pattern_type].value^.keyword_value = 'BASIC' THEN
      pattern_type := clc$wc_basic_pattern;
    ELSE
      pattern_type := clc$wc_extended_pattern;
    IFEND;

    all_selected := pvt [p$module].value^.kind = clc$keyword;

{ Convert the supplied patterns to an internal pattern representation.  Do this only once
{ then they can be compared individually later.

    IF NOT all_selected THEN
      PUSH selected_patterns_p: [1 .. clp$count_list_elements (pvt [p$module].value)];
      node_p := pvt [p$module].value;
      FOR pattern_index := 1 TO UPPERBOUND (selected_patterns_p^) DO
        IF node_p^.element_value^.kind = clc$program_name THEN
          selected_patterns_p^ [pattern_index].pattern := FALSE;
          selected_patterns_p^ [pattern_index].name := node_p^.element_value^.program_name_value;
        ELSE { it's a pattern
          original_pattern_p := node_p^.element_value^.application_value;
          PUSH pattern_p: [STRLENGTH (original_pattern_p^)];

          IF pattern_type = clc$wc_basic_pattern THEN
            #TRANSLATE (osv$lower_to_upper, original_pattern_p^, pattern_p^);
          ELSE
            #TRANSLATE (osv$lower_to_upper_26, original_pattern_p^, pattern_p^);
          IFEND;

          selected_patterns_p^ [pattern_index].pattern := TRUE;
          clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts
                [clc$sp_match_at_right, clc$sp_ignore_matched_substring], pattern_p^, work_area,
                selected_patterns_p^ [pattern_index].pattern_p, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        node_p := node_p^.link;
      FOREND;
    IFEND;
    result := NIL;
    data_value_pp := ^result;

    index := 1;
    WHILE (index <= number_of_modules) DO
      IF NOT all_selected THEN

{ Compare the name with the selected pattern.

        match := FALSE;

        pattern_index := 1;
        WHILE (NOT match) AND (pattern_index <= UPPERBOUND (selected_patterns_p^)) DO
          IF selected_patterns_p^ [pattern_index].pattern THEN
            clp$match_string_pattern (module_list_p^ [index].program_name_value
                  (1, clp$trimmed_string_size (module_list_p^ [index].program_name_value)),
                  selected_patterns_p^ [pattern_index].pattern_p, clc$sp_anchored, clc$sp_quick_scan,
                  match_info, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            match := match_info.result = clc$sp_success;
          ELSE
            match := selected_patterns_p^ [pattern_index].name = module_list_p^ [index].program_name_value;
          IFEND;
          pattern_index := pattern_index + 1;
        WHILEND;
      IFEND;

      IF all_selected OR match THEN
        clp$make_list_value (work_area, data_value_pp^);
        data_value_pp^^.element_value := ^module_list_p^ [index];
        data_value_pp := ^data_value_pp^^.link;
      IFEND;
      index := index + 1;
    WHILEND;

{ If result is still NIL, no references were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

  PROCEND ocp$$module_list;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$product_information', EJECT ??

  PROCEDURE ocp$$product_information
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_proi) $product_information (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   product: any of
{       key
{         all
{       keyend
{       list of name
{     anyend = all
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        default_value: string (3),
      recend,
    recend := [
    [1,
    [90, 4, 13, 9, 3, 9, 947],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OCM$$PRORU_PROI'], [
    ['PRODUCT                        ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 85,
  clc$optional_default_parameter, 0, 3]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$name_type], [1, osc$max_name_size]]
      ]
    ,
    'all']];

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

    CONST
      p$reference_type = 1,
      p$product = 2;

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

    VAR
      all_selected: boolean,
      data_value_pp: ^^clt$data_value,
      entry_external_header_p: ^t$entry_external_file_header,
      entry_external_list_p: ^t$entry_external_list,
      index: ost$non_negative_integers,
      match: boolean,
      node_p: ^clt$data_value;

    status.normal := TRUE;

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

{ Determine if entry points or externals should be used.

    get_entry_external_list (pvt [p$reference_type].value^.keyword_value, entry_external_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ If there are none, return an empty list.

    IF entry_external_list_p = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

    all_selected := pvt [p$product].value^.kind = clc$keyword;
    result := NIL;
    data_value_pp := ^result;
    index := 1;
    WHILE (index <= UPPERBOUND (entry_external_list_p^)) DO
      IF NOT all_selected THEN
        match := FALSE;
        node_p := pvt [p$product].value;
        WHILE (NOT match) AND (node_p <> NIL) DO
          match := node_p^.element_value^.name_value = entry_external_list_p^ [index].product_name;
          node_p := node_p^.link;
        WHILEND;
      IFEND;

      IF all_selected OR match THEN
        clp$make_list_value (work_area, data_value_pp^);
        make_entry_external_record (entry_external_list_p^ [index], work_area, data_value_pp^^.element_value);
        data_value_pp := ^data_value_pp^^.link;
      IFEND;
      index := index + 1;
    WHILEND;

{ If result is still NIL, no references were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

  PROCEND ocp$$product_information;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$product_list', EJECT ??

  PROCEDURE ocp$$product_list
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_prol) $product_list (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   product: any of
{       key
{         all
{       keyend
{       list defer_expansion of name
{     anyend = all
{   pattern_type: key
{       (basic, b)
{       (extended, e)
{     keyend = $scl_options.wild_card_pattern_type
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (35),
      recend,
    recend := [
    [1,
    [90, 3, 28, 23, 12, 25, 249],
    clc$function, 3, 3, 1, 0, 0, 0, 0, 'OCM$$PRORU_PROL'], [
    ['PATTERN_TYPE                   ',clc$nominal_entry, 3],
    ['PRODUCT                        ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 85,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, 0, TRUE, FALSE],
        [[1, 0, clc$name_type], [1, osc$max_name_size]]
      ]
    ,
    'all'],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    '$scl_options.wild_card_pattern_type']];

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

    CONST
      p$reference_type = 1,
      p$product = 2,
      p$pattern_type = 3;

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

    TYPE
      patterns = array [1 .. * ] of record
        case pattern: boolean of
        = TRUE =
          pattern_p: ^clt$string_pattern,
        = FALSE =
          name: ost$name,
        casend,
      recend;

    VAR
      all_selected: boolean,
      candidate_p: ^clt$string_value,
      data_value_pp: ^^clt$data_value,
      index: ost$non_negative_integers,
      match: boolean,
      match_info: clt$string_pattern_match_info,
      node_p: ^clt$data_value,
      number_of_products: ost$non_negative_integers,
      original_pattern_p: ^clt$string_value,
      pattern_index: ost$non_negative_integers,
      pattern_p: ^clt$string_value,
      pattern_type: clt$wild_card_pattern_type,
      product_list_p: ^array [1 .. * ] of clt$data_value,
      selected_patterns_p: ^patterns;

    status.normal := TRUE;

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

    IF pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT' THEN
      product_list_p := v$product_list [c$rk_entry_point].elements_p;
      number_of_products := v$product_list [c$rk_entry_point].element_count;
    ELSE { pvt [p$reference_type].value^.keyword_value = 'EXTERNAL_REFERENCE' THEN
      product_list_p := v$product_list [c$rk_external].elements_p;
      number_of_products := v$product_list [c$rk_external].element_count;
    IFEND;

{ If there are none, return an empty list.

    IF product_list_p = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

    IF pvt [p$pattern_type].value^.keyword_value = 'BASIC' THEN
      pattern_type := clc$wc_basic_pattern;
    ELSE
      pattern_type := clc$wc_extended_pattern;
    IFEND;

    all_selected := pvt [p$product].value^.kind = clc$keyword;
    IF NOT all_selected THEN

{ Convert the supplied patterns to the internal pattern representation.  Do this only once
{ and then compare with the names in the list.

      PUSH selected_patterns_p: [1 .. clp$count_list_elements (pvt [p$product].value)];
      node_p := pvt [p$product].value;
      FOR pattern_index := 1 TO UPPERBOUND (selected_patterns_p^) DO
        IF node_p^.element_value^.kind = clc$name THEN
          selected_patterns_p^ [pattern_index].pattern := FALSE;
          selected_patterns_p^ [pattern_index].name := node_p^.element_value^.name_value;
        ELSE { it's a pattern
          original_pattern_p := node_p^.element_value^.application_value;
          PUSH pattern_p: [STRLENGTH (original_pattern_p^)];

          IF pattern_type = clc$wc_basic_pattern THEN
            #TRANSLATE (osv$lower_to_upper, original_pattern_p^, pattern_p^);
          ELSE
            #TRANSLATE (osv$lower_to_upper_26, original_pattern_p^, pattern_p^);
          IFEND;

          selected_patterns_p^ [pattern_index].pattern := TRUE;
          clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts
                [clc$sp_match_at_right, clc$sp_ignore_matched_substring], pattern_p^, work_area,
                selected_patterns_p^ [pattern_index].pattern_p, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        node_p := node_p^.link;
      FOREND;
    IFEND;
    result := NIL;
    data_value_pp := ^result;
    index := 1;
    WHILE (index <= number_of_products) DO
      IF NOT all_selected THEN

{ Compare the name with the patterns.

        match := FALSE;

        pattern_index := 1;
        WHILE (NOT match) AND (pattern_index <= UPPERBOUND (selected_patterns_p^)) DO
          IF selected_patterns_p^ [pattern_index].pattern THEN
            clp$match_string_pattern (product_list_p^ [index].
                  name_value (1, clp$trimmed_string_size (product_list_p^ [index].name_value)),
                  selected_patterns_p^ [pattern_index].pattern_p, clc$sp_anchored, clc$sp_quick_scan,
                  match_info, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            match := match_info.result = clc$sp_success;
          ELSE
            match := selected_patterns_p^ [pattern_index].name = product_list_p^ [index].name_value;
          IFEND;
          pattern_index := pattern_index + 1;
        WHILEND;
      IFEND;

      IF all_selected OR match THEN
        clp$make_list_value (work_area, data_value_pp^);
        data_value_pp^^.element_value := ^product_list_p^ [index];
        data_value_pp := ^data_value_pp^^.link;
      IFEND;
      index := index + 1;
    WHILEND;

{ If result is still NIL, no products were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

  PROCEND ocp$$product_list;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$reference', EJECT ??

  PROCEDURE ocp$$reference_information
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_refi) $reference_information (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   references: any of
{       key
{         all
{       keyend
{       list of program_name
{     anyend = all
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        default_value: string (3),
      recend,
    recend := [
    [1,
    [90, 3, 28, 23, 12, 36, 829],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OCM$$PRORU_REFI'], [
    ['REFERENCES                     ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83,
  clc$optional_default_parameter, 0, 3]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$program_name_type]]
      ]
    ,
    'all']];

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

    CONST
      p$reference_type = 1,
      p$references = 2;

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

    VAR
      all_selected: boolean,
      data_value_pp: ^^clt$data_value,
      entry_external_header_p: ^t$entry_external_file_header,
      entry_external_list_p: ^t$entry_external_list,
      index: ost$non_negative_integers,
      match: boolean,
      node_p: ^clt$data_value;

    status.normal := TRUE;

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

{ Decide whether to use entry points or externals.

    get_entry_external_list (pvt [p$reference_type].value^.keyword_value, entry_external_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ If there are none, return an empty list.

    IF entry_external_list_p = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

    all_selected := pvt [p$references].value^.kind = clc$keyword;
    result := NIL;
    data_value_pp := ^result;
    index := 1;
    WHILE (index <= UPPERBOUND (entry_external_list_p^)) DO
      IF NOT all_selected THEN
        match := FALSE;
        node_p := pvt [p$references].value;
        WHILE (NOT match) AND (node_p <> NIL) DO
          match := node_p^.element_value^.program_name_value = entry_external_list_p^ [index].name;
          node_p := node_p^.link;
        WHILEND;
      IFEND;

      IF all_selected OR match THEN
        clp$make_list_value (work_area, data_value_pp^);
        make_entry_external_record (entry_external_list_p^ [index], work_area, data_value_pp^^.element_value);
        data_value_pp := ^data_value_pp^^.link;
      IFEND;
      index := index + 1;
    WHILEND;

{ If result is still NIL, no references were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

  PROCEND ocp$$reference_information;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$$reference_list', EJECT ??

  PROCEDURE ocp$$reference_list
    (    parameter_list: clt$parameter_list;
     VAR work_area { input, output } : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (ocm$$proru_refl) $reference_list (
{   reference_type: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   references: any of
{       key
{         all
{       keyend
{       list defer_expansion of program_name
{     anyend = all
{   pattern_type: key
{       (basic, b)
{       (extended, e)
{     keyend = $scl_options.wild_card_pattern_type
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (35),
      recend,
    recend := [
    [1,
    [90, 3, 28, 23, 12, 48, 86],
    clc$function, 3, 3, 1, 0, 0, 0, 0, 'OCM$$PRORU_REFL'], [
    ['PATTERN_TYPE                   ',clc$nominal_entry, 3],
    ['REFERENCES                     ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, TRUE, FALSE],
        [[1, 0, clc$program_name_type]]
      ]
    ,
    'all'],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    '$scl_options.wild_card_pattern_type']];

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

    CONST
      p$reference_type = 1,
      p$references = 2,
      p$pattern_type = 3;

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


    TYPE
      patterns = array [1 .. * ] of record
        case pattern: boolean of
        = TRUE =
          pattern_p: ^clt$string_pattern,
        = FALSE =
          name: pmt$program_name,
        casend,
      recend;

    VAR
      all_selected: boolean,
      candidate_p: ^clt$string_value,
      data_value_pp: ^^clt$data_value,
      entry_external_header_p: ^t$entry_external_file_header,
      entry_external_list_p: ^t$entry_external_list,
      index: ost$non_negative_integers,
      match: boolean,
      match_info: clt$string_pattern_match_info,
      next_index: ost$non_negative_integers,
      node_p: ^clt$data_value,
      original_pattern_p: ^clt$string_value,
      pattern_index: ost$non_negative_integers,
      pattern_p: ^clt$string_value,
      pattern_type: clt$wild_card_pattern_type,
      selected_patterns_p: ^patterns;

    status.normal := TRUE;

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

{ Determine whether to use entry points or externals.

    get_entry_external_list (pvt [p$reference_type].value^.keyword_value, entry_external_list_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ If there are none, return an empty list.

    IF entry_external_list_p = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

    IF pvt [p$pattern_type].value^.keyword_value = 'BASIC' THEN
      pattern_type := clc$wc_basic_pattern;
    ELSE
      pattern_type := clc$wc_extended_pattern;
    IFEND;

    all_selected := pvt [p$references].value^.kind = clc$keyword;
    IF NOT all_selected THEN

{ Convert the specified patterns to their internal representation.  Do this only once
{ and then compare with the names later.

      PUSH selected_patterns_p: [1 .. clp$count_list_elements (pvt [p$references].value)];
      node_p := pvt [p$references].value;
      FOR pattern_index := 1 TO UPPERBOUND (selected_patterns_p^) DO
        IF node_p^.element_value^.kind = clc$program_name THEN
          selected_patterns_p^ [pattern_index].pattern := FALSE;
          selected_patterns_p^ [pattern_index].name := node_p^.element_value^.program_name_value;
        ELSE { it's a pattern
          original_pattern_p := node_p^.element_value^.application_value;
          PUSH pattern_p: [STRLENGTH (original_pattern_p^)];

          IF pattern_type = clc$wc_basic_pattern THEN
            #TRANSLATE (osv$lower_to_upper, original_pattern_p^, pattern_p^);
          ELSE
            #TRANSLATE (osv$lower_to_upper_26, original_pattern_p^, pattern_p^);
          IFEND;

          selected_patterns_p^ [pattern_index].pattern := TRUE;
          clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts
                [clc$sp_match_at_right, clc$sp_ignore_matched_substring], pattern_p^, work_area,
                selected_patterns_p^ [pattern_index].pattern_p, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        node_p := node_p^.link;
      FOREND;
    IFEND;
    result := NIL;
    data_value_pp := ^result;
    index := 1;
    WHILE (index <= UPPERBOUND (entry_external_list_p^)) DO
      IF NOT all_selected THEN

{ Compare the name with the patterns.

        match := FALSE;

        pattern_index := 1;
        WHILE (NOT match) AND (pattern_index <= UPPERBOUND (selected_patterns_p^)) DO
          IF selected_patterns_p^ [pattern_index].pattern THEN
            clp$match_string_pattern (entry_external_list_p^ [index].
                  name (1, clp$trimmed_string_size (entry_external_list_p^ [index].name)),
                  selected_patterns_p^ [pattern_index].pattern_p, clc$sp_anchored, clc$sp_quick_scan,
                  match_info, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            match := match_info.result = clc$sp_success;
          ELSE
            match := selected_patterns_p^ [pattern_index].name = entry_external_list_p^ [index].name;
          IFEND;
          pattern_index := pattern_index + 1;
        WHILEND;
      IFEND;

      IF all_selected OR match THEN
        clp$make_list_value (work_area, data_value_pp^);
        clp$make_program_name_value (entry_external_list_p^ [index].name, work_area,
              data_value_pp^^.element_value);
        data_value_pp := ^data_value_pp^^.link;
      IFEND;
      next_index := index + 1;
      WHILE (next_index <= UPPERBOUND (entry_external_list_p^)) AND
            (entry_external_list_p^ [index].name = entry_external_list_p^ [next_index].name) DO
        next_index := next_index + 1;
      WHILEND;
      index := next_index;
    WHILEND;

{ If result is still NIL, no references were selected.

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;
  PROCEND ocp$$reference_list;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_add_library', EJECT ??

{ NOTE:
{   The procedure contained within this procedure to "crack" object libraries are
{ stripped down versions of the procedures for the command display_object_text.

  PROCEDURE ocp$_add_library
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru_addl) add_library, add_libraries, addl (
{   library, f, file, files, libraries, l: list of file = $required
{   product_name, pn: name = $required
{   control_data_names_only, cdno: (BY_NAME) boolean = TRUE
{   reference_type, rt: (BY_NAME) key
{       all
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = all
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 7] of clt$keyword_specification,
        default_value: string (3),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 3, 23, 10, 59, 57, 990],
    clc$command, 13, 5, 2, 0, 0, 0, 5, 'OCM$PRORU_ADDL'], [
    ['CDNO                           ',clc$abbreviation_entry, 3],
    ['CONTROL_DATA_NAMES_ONLY        ',clc$nominal_entry, 3],
    ['F                              ',clc$alias_entry, 1],
    ['FILE                           ',clc$alias_entry, 1],
    ['FILES                          ',clc$alias_entry, 1],
    ['L                              ',clc$abbreviation_entry, 1],
    ['LIBRARIES                      ',clc$alias_entry, 1],
    ['LIBRARY                        ',clc$nominal_entry, 1],
    ['PN                             ',clc$abbreviation_entry, 2],
    ['PRODUCT_NAME                   ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 4],
    ['RT                             ',clc$abbreviation_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [8, 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, 19, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [10, 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, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 4
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 266,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 5
    [13, 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$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [7], [
    ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 3]]
    ,
    'all'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$library = 1,
      p$product_name = 2,
      p$control_data_names_only = 3,
      p$reference_type = 4,
      p$status = 5;

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

    VAR
      add_entry_points: boolean,
      add_externals: boolean,
      control_data_names_only: boolean,
      entry_point_file_header_p: ^t$entry_external_file_header,
      entry_point_file_p: ^SEQ ( * ),
      external_file_header_p: ^t$entry_external_file_header,
      external_file_p: ^SEQ ( * ),
      file: ^SEQ ( * ),
      file_contents: amt$file_contents,
      file_identifier: amt$file_identifier,
      file_list_p: ^clt$data_value,
      file_name: ost$name,
      ignore_status: ost$status,
      module_name: pmt$program_name,
      new_entry_externals_p: ^t$entry_external_files,
      product_name: ost$name,
      sort_entry_external_list_p: ^t$entry_external_list,
      sort_file_header_p: ^t$entry_external_file_header,
      sort_file_p: ^SEQ ( * );

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        close_segment (entry_point_file_p, ignore_status);
        close_segment (external_file_p, ignore_status);
        fsp$close_file (file_identifier, ignore_status);
        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
?? NEWTITLE := 'name_okay: boolean', EJECT ??

{   The purpose of this request is to determine if the format of the name matches
{ the requested name form.

    FUNCTION name_okay
      (    name: pmt$program_name;
           control_data_names_only: boolean): boolean;

      VAR
        s2: string (2);

      IF control_data_names_only THEN
        s2 := name (3, 2);
        name_okay := (s2 = 'P$') OR (s2 = 'V$') OR (s2 = 'p$') OR (s2 = 'v$');
      ELSE
        name_okay := TRUE;
      IFEND;
    FUNCEND name_okay;
?? OLDTITLE ??
?? NEWTITLE := 'process_object_text_descriptor', EJECT ??

    PROCEDURE process_object_text_descriptor
      (VAR file: ^SEQ ( * );
       VAR fatal_error: boolean;
       VAR end_of_file: boolean;
       VAR kind: llt$object_record_kind;
       VAR size: integer);

      VAR
        object_text_descriptor: ^llt$object_text_descriptor,
        file_position: ost$segment_offset;

      end_of_file := FALSE;

      NEXT object_text_descriptor IN file;
      IF object_text_descriptor = NIL THEN
        file_position := i#current_sequence_position (file);
        IF file_position >= #SIZE (file^) THEN
          end_of_file := TRUE;
        ELSE
          fatal_error := TRUE;
        IFEND;
        RETURN;
      IFEND;

      kind := object_text_descriptor^.kind;
      CASE object_text_descriptor^.kind OF
      = llc$identification, llc$section_definition, llc$bit_string_insertion, llc$entry_definition,
            llc$binding_template, llc$transfer_symbol, llc$segment_definition, llc$unallocated_common_block,
            llc$application_identifier, llc$obsolete_segment_definition =
        fatal_error := FALSE;

      = llc$libraries =
        size := object_text_descriptor^.number_of_libraries;
        fatal_error := object_text_descriptor^.number_of_libraries = 0;

      = llc$allotted_section_definition =
        size := object_text_descriptor^.allotted_section;

      = llc$allotted_segment_definition, llc$obsolete_allotted_seg_def =
        size := object_text_descriptor^.allotted_segment;
        size := (size * 100000000(16)) + object_text_descriptor^.allotted_segment_length; {kludge}

      = llc$text, llc$replication =
        size := object_text_descriptor^.number_of_bytes;
        fatal_error := object_text_descriptor^.number_of_bytes = 0;

      = llc$relocation =
        size := object_text_descriptor^.number_of_rel_items;
        fatal_error := object_text_descriptor^.number_of_rel_items = 0;

      = llc$address_formulation =
        size := object_text_descriptor^.number_of_adr_items;
        fatal_error := object_text_descriptor^.number_of_adr_items = 0;

      = llc$deferred_entry_points =
        size := object_text_descriptor^.number_of_entry_points;

      = llc$deferred_common_blocks =
        size := object_text_descriptor^.number_of_common_blocks;

      = llc$external_linkage =
        size := object_text_descriptor^.number_of_ext_items;
        fatal_error := object_text_descriptor^.number_of_ext_items = 0;

      = llc$obsolete_line_table, llc$line_table =
        size := object_text_descriptor^.number_of_line_items;
        fatal_error := object_text_descriptor^.number_of_line_items = 0;

      = llc$obsolete_formal_parameters, llc$formal_parameters, llc$actual_parameters,
            llc$cybil_symbol_table_fragment, llc$68000_absolute, llc$symbol_table, llc$form_definition,
            llc$supplemental_debug_tables =
        size := object_text_descriptor^.sequence_length;
        fatal_error := object_text_descriptor^.sequence_length = 0;

      = llc$ppu_absolute =
        size := object_text_descriptor^.number_of_words;
        fatal_error := object_text_descriptor^.number_of_words > llc$max_ppu_size;

      ELSE
        fatal_error := TRUE;
      CASEND;
    PROCEND process_object_text_descriptor;
?? OLDTITLE ??
?? NEWTITLE := 'process_identification_record', EJECT ??

    PROCEDURE process_identification_record
      (VAR file: ^SEQ ( * );
       VAR fatal_error: boolean;
       VAR module_kind: llt$module_kind);

      VAR
        valid: boolean,
        identification: ^llt$identification;

      NEXT identification IN file;
      fatal_error := identification = NIL;
      IF fatal_error THEN
        RETURN;
      IFEND;

      module_kind := identification^.kind;
      module_name := identification^.name;
    PROCEND process_identification_record;
?? OLDTITLE ??
?? NEWTITLE := 'process_entry_definition_record', EJECT ??

    PROCEDURE process_entry_definition_record
      (    module_kind: llt$module_kind;
       VAR file: ^SEQ ( * );
       VAR fatal_error: boolean);

      VAR
        entry_point_p: ^t$entry_external,
        entry_definition: ^llt$entry_definition;

      NEXT entry_definition IN file;
      fatal_error := entry_definition = NIL;
      IF fatal_error THEN
        RETURN;
      IFEND;

      IF (NOT (module_kind IN valid_module_kinds)) OR (NOT add_entry_points) THEN
        RETURN;
      IFEND;

      IF entry_point_file_p = NIL THEN
        RETURN;
      IFEND;

      IF name_okay (entry_definition^.name, control_data_names_only) THEN
        NEXT entry_point_p IN entry_point_file_p;
        entry_point_file_header_p^.entry_point_count := entry_point_file_header_p^.entry_point_count + 1;
        entry_point_p^.name := entry_definition^.name;
        entry_point_p^.module_name := module_name;
        entry_point_p^.product_name := product_name;
        entry_point_p^.language := entry_definition^.language;
        entry_point_p^.declaration_matching_required := entry_definition^.declaration_matching_required;
        entry_point_p^.declaration_matching := entry_definition^.declaration_matching;
        entry_point_p^.attributes := entry_definition^.attributes;
      IFEND;
    PROCEND process_entry_definition_record;
?? OLDTITLE ??
?? NEWTITLE := 'process_deferred_entry_points', EJECT ??

{ PURPOSE:
{   The purpose of this request is to display the deferred entry point object text record.

    PROCEDURE process_deferred_entry_points
      (    module_kind: llt$module_kind;
           number_of_entry_points: 1 .. llc$max_deferred_entry_points;
       VAR file: ^SEQ ( * );
       VAR fatal_error: boolean);

      VAR
        entry_point_p: ^t$entry_external,
        deferred_entry_points: ^llt$deferred_entry_points,
        entry_point_index: 1 .. llc$max_deferred_entry_points;

      NEXT deferred_entry_points: [1 .. number_of_entry_points] IN file;
      fatal_error := deferred_entry_points = NIL;
      IF fatal_error THEN
        RETURN;
      IFEND;

      IF (NOT (module_kind IN valid_module_kinds)) OR (NOT add_entry_points) THEN
        RETURN;
      IFEND;

      IF entry_point_file_p = NIL THEN
        RETURN;
      IFEND;

      FOR entry_point_index := 1 TO number_of_entry_points DO

        IF name_okay (deferred_entry_points^ [entry_point_index].name, control_data_names_only) THEN
          NEXT entry_point_p IN entry_point_file_p;
          entry_point_file_header_p^.entry_point_count := entry_point_file_header_p^.entry_point_count + 1;
          entry_point_p^.name := deferred_entry_points^ [entry_point_index].name;
          entry_point_p^.module_name := module_name;
          entry_point_p^.product_name := product_name;
          entry_point_p^.language := deferred_entry_points^ [entry_point_index].language;
          entry_point_p^.declaration_matching_required := deferred_entry_points^ [entry_point_index].
                declaration_matching_required;
          entry_point_p^.declaration_matching := deferred_entry_points^ [entry_point_index].
                declaration_matching_value;
          entry_point_p^.attributes := deferred_entry_points^ [entry_point_index].attributes;
        IFEND;
      FOREND;
    PROCEND process_deferred_entry_points;
?? OLDTITLE ??
?? NEWTITLE := 'process_external_linkage', EJECT ??

    PROCEDURE process_external_linkage
      (    module_kind: llt$module_kind;
           number_of_ext_items: 1 .. llc$max_ext_items;
       VAR file: ^SEQ ( * );
       VAR fatal_error: boolean);

      VAR
        external_p: ^t$entry_external,
        external: ^llt$external_linkage,
        i: 1 .. llc$max_ext_items;

      NEXT external: [1 .. number_of_ext_items] IN file;
      fatal_error := external = NIL;
      IF fatal_error THEN
        RETURN;
      IFEND;

      IF (NOT (module_kind IN valid_module_kinds)) OR (NOT add_externals) THEN
        RETURN;
      IFEND;

      IF external_file_p = NIL THEN
        RETURN;
      IFEND;

      IF name_okay (external^.name, control_data_names_only) THEN
        NEXT external_p IN external_file_p;
        external_file_header_p^.external_count := external_file_header_p^.external_count + 1;
        external_p^.name := external^.name;
        external_p^.module_name := module_name;
        external_p^.product_name := product_name;
        external_p^.language := external^.language;
        external_p^.declaration_matching_required := external^.declaration_matching_required;
        external_p^.declaration_matching := external^.declaration_matching;
        external_p^.attributes := $llt$entry_point_attributes [];
      IFEND;
    PROCEND process_external_linkage;
?? OLDTITLE ??
?? NEWTITLE := 'process_cpu_module', EJECT ??

    PROCEDURE process_cpu_module
      (    module_kind: llt$module_kind;
       VAR file: ^SEQ ( * );
       VAR fatal_error: boolean);

      VAR
        actual_parameters: ^llt$actual_parameters,
        address_formulation: ^llt$address_formulation,
        application_identifier: ^llt$application_identifier,
        binding_template: ^llt$binding_template,
        bit_insertion: ^llt$bit_string_insertion,
        debug_table_fragment: ^llt$debug_table_fragment,
        deferred_common_blocks: ^llt$deferred_common_blocks,
        end_of_file: boolean,
        formal_parameters: ^llt$formal_parameters,
        libraries: ^llt$libraries,
        line_address_table: ^llt$line_address_table,
        m68000_absolute: ^llt$68000_absolute,
        obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
        obsolete_line_address_table: ^llt$obsolete_line_address_table,
        obsolete_segment_definition: ^llt$obsolete_segment_definition,
        record_kind: llt$object_record_kind,
        relocation: ^llt$relocation,
        replication: ^llt$replication,
        s: llt$section_ordinal,
        section_definition: ^llt$section_definition,
        segment_definition: ^llt$segment_definition,
        size: integer,
        supplemental_debug_tables: ^llt$supplemental_debug_tables,
        symbol_table: ^llt$symbol_table,
        text: ^llt$text,
        transfer_symbol: ^llt$transfer_symbol;

      REPEAT
        process_object_text_descriptor (file, fatal_error, end_of_file, record_kind, size);
        IF NOT fatal_error THEN
          IF end_of_file THEN
            fatal_error := TRUE;
          ELSE
            CASE record_kind OF
            = llc$identification =
              fatal_error := TRUE;

            = llc$libraries =
              NEXT libraries: [1 .. size] IN file;
              fatal_error := libraries = NIL;

            = llc$section_definition, llc$unallocated_common_block =
              NEXT section_definition IN file;
              fatal_error := section_definition = NIL;

            = llc$allotted_section_definition =
              NEXT section_definition IN file;
              fatal_error := section_definition = NIL;

            = llc$segment_definition =
              NEXT segment_definition IN file;
              fatal_error := segment_definition = NIL;

            = llc$allotted_segment_definition =
              NEXT segment_definition IN file;
              fatal_error := segment_definition = NIL;

            = llc$obsolete_segment_definition =
              NEXT obsolete_segment_definition IN file;
              fatal_error := obsolete_segment_definition = NIL;

            = llc$obsolete_allotted_seg_def =
              NEXT obsolete_segment_definition IN file;
              fatal_error := obsolete_segment_definition = NIL;

            = llc$text =
              NEXT text: [1 .. size] IN file;
              fatal_error := text = NIL;

            = llc$replication =
              NEXT replication: [1 .. size] IN file;
              fatal_error := replication = NIL;

            = llc$bit_string_insertion =
              NEXT bit_insertion IN file;
              fatal_error := bit_insertion = NIL;

            = llc$entry_definition =
              process_entry_definition_record (module_kind, file, fatal_error);

            = llc$deferred_entry_points =
              process_deferred_entry_points (module_kind, size, file, fatal_error);

            = llc$deferred_common_blocks =
              NEXT deferred_common_blocks: [1 .. size] IN file;
              fatal_error := deferred_common_blocks = NIL;

            = llc$relocation =
              NEXT relocation: [1 .. size] IN file;
              fatal_error := relocation = NIL;

            = llc$obsolete_formal_parameters =
              NEXT obsolete_formal_parameters: [[REP size OF cell]] IN file;
              fatal_error := obsolete_formal_parameters = NIL;

            = llc$formal_parameters =
              NEXT formal_parameters: [[REP size OF cell]] IN file;
              fatal_error := formal_parameters = NIL;

            = llc$actual_parameters =
              NEXT actual_parameters: [[REP size OF cell]] IN file;
              fatal_error := actual_parameters = NIL;

            = llc$obsolete_line_table =
              NEXT obsolete_line_address_table: [1 .. size] IN file;
              fatal_error := obsolete_line_address_table = NIL;

            = llc$cybil_symbol_table_fragment =
              NEXT debug_table_fragment: [[REP size OF cell]] IN file;
              fatal_error := debug_table_fragment = NIL;

            = llc$line_table =
              NEXT line_address_table: [1 .. size] IN file;
              fatal_error := line_address_table = NIL;

            = llc$symbol_table =
              NEXT symbol_table: [[REP size OF cell]] IN file;
              fatal_error := symbol_table = NIL;

            = llc$supplemental_debug_tables =
              NEXT supplemental_debug_tables: [[REP size OF cell]] IN file;
              fatal_error := supplemental_debug_tables = NIL;

            = llc$form_definition =
              ;

            = llc$application_identifier =
              NEXT application_identifier IN file;
              fatal_error := application_identifier = NIL;

            = llc$address_formulation =
              NEXT address_formulation: [1 .. size] IN file;
              fatal_error := address_formulation = NIL;

            = llc$external_linkage =
              process_external_linkage (module_kind, size, file, fatal_error);

            = llc$binding_template =
              NEXT binding_template IN file;
              fatal_error := binding_template = NIL;

            = llc$68000_absolute =
              NEXT m68000_absolute: [[REP size OF cell]] IN file;
              fatal_error := m68000_absolute = NIL;

            = llc$transfer_symbol =
              NEXT transfer_symbol IN file;
              fatal_error := transfer_symbol = NIL;

            ELSE
              fatal_error := TRUE;
            CASEND;
          IFEND;
        IFEND;
      UNTIL fatal_error OR (record_kind = llc$transfer_symbol);

    PROCEND process_cpu_module;
?? OLDTITLE ??
?? NEWTITLE := 'process_iou_module', EJECT ??

    PROCEDURE process_iou_module
      (VAR file: ^SEQ ( * );
       VAR fatal_error: boolean);

      VAR
        ppu_absolute: ^llt$ppu_absolute,
        end_of_file: boolean,
        record_kind: llt$object_record_kind,
        size: integer;

      process_object_text_descriptor (file, fatal_error, end_of_file, record_kind, size);

      IF NOT fatal_error THEN
        IF end_of_file THEN
          fatal_error := TRUE;
        ELSE
          IF record_kind = llc$ppu_absolute THEN
            NEXT ppu_absolute: [0 .. size - 1] IN file;
            fatal_error := ppu_absolute = NIL;
          ELSE
            fatal_error := TRUE;
          IFEND;
        IFEND;
      IFEND;
    PROCEND process_iou_module;
?? OLDTITLE ??
?? NEWTITLE := 'process_object_file', EJECT ??

    PROCEDURE process_object_file
      (VAR file: ^SEQ ( * ));

      VAR
        fatal_error: [STATIC] boolean := FALSE,
        end_of_file: boolean,
        record_kind: llt$object_record_kind,
        size: integer,
        module_kind: llt$module_kind;

      REPEAT
        process_object_text_descriptor (file, fatal_error, end_of_file, record_kind, size);

        IF NOT (end_of_file OR fatal_error) THEN
          IF record_kind <> llc$identification THEN
            fatal_error := TRUE;
          ELSE
            process_identification_record (file, fatal_error, module_kind);
          IFEND;

          IF NOT fatal_error THEN
            CASE module_kind OF
            = llc$mi_virtual_state, llc$vector_virtual_state, llc$motorola_68000, llc$motorola_68000_absolute,
                  llc$vector_extended_state =
              process_cpu_module (module_kind, file, fatal_error);
            = llc$iou =
              process_iou_module (file, fatal_error);
            ELSE
              fatal_error := TRUE;
            CASEND;
          IFEND;
        IFEND;

      UNTIL end_of_file OR fatal_error;
    PROCEND process_object_file;
?? OLDTITLE ??
?? NEWTITLE := 'process_object_library', EJECT ??

    PROCEDURE process_object_library
      (VAR file: ^SEQ ( * ));

?? NEWTITLE := 'process_library_module', EJECT ??

      PROCEDURE process_library_modules
        (    number_of_modules: 0 .. llc$max_modules_in_library;
             module_dictionary: ^llt$module_dictionary;
         VAR file: ^SEQ ( * ));

        VAR
          application_member_header: ^llt$application_member_header,
          valid_position: boolean,
          i: 1 .. llc$max_modules_in_library,
          load_module_header: ^llt$load_module_header,
          object_text_descriptor: ^llt$object_text_descriptor,
          library_member_header: ^llt$library_member_header;

?? NEWTITLE := 'process_interpretive_element', EJECT ??

        PROCEDURE process_interpretive_element
          (    load_module_header: ^llt$load_module_header;
           VAR file: ^SEQ ( * ));

          VAR
            interpretive_element: ^llt$object_text_descriptor,
            fatal_error: boolean,
            end_of_file: boolean,
            record_kind: llt$object_record_kind,
            size: integer,
            module_kind: llt$module_kind;

          fatal_error := FALSE;

          interpretive_element := #PTR (load_module_header^.interpretive_element, file^);
          fatal_error := interpretive_element = NIL;
          IF fatal_error THEN
            RETURN;
          IFEND;
          RESET file TO interpretive_element;

          process_object_text_descriptor (file, fatal_error, end_of_file, record_kind, size);
          IF NOT fatal_error THEN
            IF NOT end_of_file THEN
              IF record_kind <> llc$identification THEN
                fatal_error := TRUE;
              ELSE
                process_identification_record (file, fatal_error, module_kind);
                IF NOT fatal_error THEN
                  CASE module_kind OF
                  = llc$mi_virtual_state, llc$vector_virtual_state, llc$motorola_68000,
                        llc$motorola_68000_absolute, llc$vector_extended_state =
                    process_cpu_module (module_kind, file, fatal_error);
                  ELSE
                  CASEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        PROCEND process_interpretive_element;
?? OLDTITLE ??
?? EJECT ??

        FOR i := 1 TO number_of_modules DO
          IF module_dictionary^ [i].kind = llc$load_module THEN
            load_module_header := #PTR (module_dictionary^ [i].module_header, file^);
            IF (llc$interpretive_element IN load_module_header^.elements_defined) THEN
              process_interpretive_element (load_module_header, file);
            IFEND;
          IFEND;
        FOREND;
      PROCEND process_library_modules;
?? OLDTITLE ??
?? EJECT ??

      VAR
        library_header: ^llt$object_library_header,
        library_hdr: ^llt$object_library_header_v1_0,
        module_dictionary: ^llt$module_dictionary,
        module_dictionary_size: 0 .. llc$max_modules_in_library,
        dictionary_size: integer,
        library_dictionary: ^llt$object_library_dictionaries,
        i: 0 .. llc$max_dictionaries_on_library;


      NEXT library_header IN file;
      IF library_header = NIL THEN
        RETURN;
      IFEND;

      IF library_header^.version = llc$object_library_version THEN
        NEXT library_dictionary: [1 .. library_header^.number_of_dictionaries] IN file;
        IF library_dictionary = NIL THEN
          RETURN;
        IFEND;

        FOR i := LOWERBOUND (library_dictionary^) TO UPPERBOUND (library_dictionary^) DO

          CASE library_dictionary^ [i].kind OF

          = llc$module_dictionary =
            module_dictionary := #PTR (library_dictionary^ [i].module_dictionary, file^);
            module_dictionary_size := UPPERBOUND (module_dictionary^);

          ELSE
          CASEND;

        FOREND;

        process_library_modules (module_dictionary_size, module_dictionary, file);

      ELSEIF library_header^.version = 'V1.0' THEN

        RESET file;
        NEXT library_hdr IN file;

        module_dictionary := #PTR (library_hdr^.module_dictionary, file^);
        IF module_dictionary = NIL THEN
          RETURN;
        IFEND;

        process_library_modules (library_hdr^.number_of_modules, module_dictionary, file);

      IFEND;

    PROCEND process_object_library;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_object_file', EJECT ??

    PROCEDURE obtain_object_file
      (    file_reference: fst$file_reference;
       VAR file_name: ost$name;
       VAR file: ^SEQ ( * );
       VAR file_contents: amt$file_contents;
       VAR file_identifier: amt$file_identifier;
       VAR status: ost$status);

      VAR
        attachment_options: array [1 .. 5] of fst$attachment_option,
        cycle_attribute_values: fst$cycle_attribute_values,
        ignore_user_defined_attr_size: fst$user_defined_attribute_size,
        resolved_file_reference: fst$resolved_file_reference,
        segment: amt$segment_pointer,
        validation_attributes: array [1 .. 2] of fst$file_cycle_attribute;

      validation_attributes [1].selector := fsc$file_contents_and_processor;
      validation_attributes [1].file_contents := fsc$object_library;
      validation_attributes [1].file_processor := osc$null_name;
      validation_attributes [2].selector := fsc$file_contents_and_processor;
      validation_attributes [2].file_contents := fsc$object_data;
      validation_attributes [2].file_processor := osc$null_name;
      attachment_options [1].selector := fsc$access_and_share_modes;
      attachment_options [1].access_modes.selector := fsc$specific_access_modes;
      attachment_options [1].access_modes.value := $fst$file_access_options [fsc$read];
      attachment_options [1].share_modes.selector := fsc$specific_share_modes;
      attachment_options [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
      attachment_options [2].selector := fsc$open_share_modes;
      attachment_options [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
      attachment_options [3].selector := fsc$create_file;
      attachment_options [3].create_file := FALSE;
      attachment_options [4].selector := fsc$sequential_access;
      attachment_options [4].sequential_access := TRUE;
      attachment_options [5].selector := fsc$free_behind;
      attachment_options [5].free_behind := TRUE;

      fsp$open_file (file_reference, amc$segment, ^attachment_options, NIL, NIL, ^validation_attributes, NIL,
            file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fsp$get_open_information (file_identifier, NIL, NIL, NIL, ^cycle_attribute_values, NIL,
            ^resolved_file_reference, NIL, ignore_user_defined_attr_size, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      file_name := resolved_file_reference.path (resolved_file_reference.file_name.index,
            resolved_file_reference.file_name.size);
      file_contents := cycle_attribute_values.file_contents;

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

      file := segment.sequence_pointer;
      RESET file;

    PROCEND obtain_object_file;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;

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

    control_data_names_only := pvt [p$control_data_names_only].value^.boolean_value.value;
    product_name := pvt [p$product_name].value^.name_value;
    add_entry_points := (pvt [p$reference_type].value^.keyword_value = 'ALL') OR
          (pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT');
    add_externals := (pvt [p$reference_type].value^.keyword_value = 'ALL') OR
          (pvt [p$reference_type].value^.keyword_value = 'EXTERNAL_REFERENCE');

    entry_point_file_p := NIL;
    external_file_p := NIL;
    #SPOIL (entry_point_file_p, external_file_p);
    osp$establish_block_exit_hndlr (^condition_handler);

{ Create a scratch file for entry points and another one for externals.

    open_segment (entry_point_file_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT entry_point_file_header_p IN entry_point_file_p;
    IF entry_point_file_header_p = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 027', status);
      RETURN;
    IFEND;
    entry_point_file_header_p^.identification := c$entry_external_id;
    entry_point_file_header_p^.entry_point_count := 0;
    entry_point_file_header_p^.external_count := 0;

    open_segment (external_file_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT external_file_header_p IN external_file_p;
    IF external_file_header_p = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 028', status);
      RETURN;
    IFEND;
    external_file_header_p^.identification := c$entry_external_id;
    external_file_header_p^.entry_point_count := 0;
    external_file_header_p^.external_count := 0;

    file_list_p := pvt [p$library].value;
    WHILE file_list_p <> NIL DO
      obtain_object_file (file_list_p^.element_value^.file_value^, file_name, file, file_contents,
            file_identifier, status);
      log_message ('Cannot open library or object file:');
      log_message (file_list_p^.element_value^.file_value^);
      IF status.normal THEN
        IF file_contents = fsc$object_library THEN
          process_object_library (file);
        ELSE
          process_object_file (file);
        IFEND;

        fsp$close_file (file_identifier, ignore_status);
      IFEND;

      file_list_p := file_list_p^.link;
    WHILEND;

{ File has been verified.  Don't need to check for NIL.

    IF entry_point_file_header_p^.entry_point_count > 0 THEN
      sort_file_p := entry_point_file_p;
      RESET sort_file_p;
      NEXT sort_file_header_p IN sort_file_p;
      NEXT sort_entry_external_list_p: [1 .. sort_file_header_p^.entry_point_count] IN sort_file_p;
      sort_entry_external_list (sort_entry_external_list_p);
      remove_duplicates (entry_point_file_p);
    IFEND;

    IF external_file_header_p^.external_count > 0 THEN
      sort_file_p := external_file_p;
      RESET sort_file_p;
      NEXT sort_file_header_p IN sort_file_p;
      NEXT sort_entry_external_list_p: [1 .. sort_file_header_p^.external_count] IN sort_file_p;
      sort_entry_external_list (sort_entry_external_list_p);
      remove_duplicates (external_file_p);
    IFEND;

    PUSH new_entry_externals_p: [1 .. 1];
    RESET entry_point_file_p;
    NEXT entry_point_file_header_p IN entry_point_file_p;
    IF entry_point_file_header_p^.entry_point_count > 0 THEN
      NEXT new_entry_externals_p^ [1].entry_point_list_p: [1 .. entry_point_file_header_p^.
            entry_point_count] IN entry_point_file_p;
    ELSE
      new_entry_externals_p^ [1].entry_point_list_p := NIL;
    IFEND;
    RESET external_file_p;
    NEXT external_file_header_p IN external_file_p;
    IF external_file_header_p^.external_count > 0 THEN
      NEXT new_entry_externals_p^ [1].external_list_p: [1 .. external_file_header_p^.external_count] IN
            external_file_p;
    ELSE
      new_entry_externals_p^ [1].external_list_p := NIL;
    IFEND;

    merge_with_working_file (new_entry_externals_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    close_segment (entry_point_file_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    close_segment (external_file_p, status);
    osp$disestablish_cond_handler;
  PROCEND ocp$_add_library;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_add_reference_file', EJECT ??

  PROCEDURE ocp$_add_reference_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru_addrf) add_reference_file, add_reference_files, addrf (
{   file, files, f: list 1..1000 of file = $required
{   reference_type, rt: (BY_NAME) key
{       all
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = all
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 7] of clt$keyword_specification,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 3, 19, 19, 51, 47, 439],
    clc$command, 6, 3, 1, 0, 0, 0, 3, 'OCM$PRORU_ADDRF'], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['FILES                          ',clc$alias_entry, 1],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 2],
    ['RT                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ 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, 19, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 266,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [6, 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$list_type], [3, 1, 1000, 0, FALSE, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [7], [
    ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 3]]
    ,
    'all'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$file = 1,
      p$reference_type = 2,
      p$status = 3;

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

    TYPE
      source_list = record
        file_identifier: amt$file_identifier,
        file_p: ^SEQ ( * ),
      recend;

    VAR
      add_entry_points: boolean,
      add_externals: boolean,
      entry_external_file_list_p: ^clt$data_value,
      entry_external_files_p: ^t$entry_external_files,
      entry_external_header_p: ^t$entry_external_file_header,
      file_index: 1 .. clc$max_list_size,
      source_file_count: 1 .. clc$max_list_size,
      source_file_list_p: ^array [1 .. * ] of source_list,
      target_entry_external_p: ^t$entry_external,
      target_fid: amt$file_identifier,
      target_file_header_p: ^t$entry_external_file_header,
      target_file_p: ^SEQ ( * );

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        FOR file_index := 1 TO source_file_count DO
          fsp$close_file (source_file_list_p^ [file_index].file_identifier, ignore_status);
        FOREND;
        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
    status.normal := TRUE;

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

    add_entry_points := (pvt [p$reference_type].value^.keyword_value = 'ALL') OR
          (pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT');
    add_externals := (pvt [p$reference_type].value^.keyword_value = 'ALL') OR
          (pvt [p$reference_type].value^.keyword_value = 'EXTERNAL_REFERENCE');
    source_file_count := clp$count_list_elements (pvt [p$file].value);
    #SPOIL (source_file_count);
    PUSH source_file_list_p: [1 .. source_file_count];
    PUSH entry_external_files_p: [1 .. source_file_count];
    entry_external_file_list_p := pvt [p$file].value;
    osp$establish_block_exit_hndlr (^condition_handler);

{ Open all of the specified reference files and add the files to the merge file list.

    FOR file_index := 1 TO source_file_count DO
      open_source_file (entry_external_file_list_p^.element_value^.file_value^,
            source_file_list_p^ [file_index].file_p, source_file_list_p^ [file_index].file_identifier,
            status);
      #SPOIL (source_file_list_p^ [file_index]);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      NEXT entry_external_header_p IN source_file_list_p^ [file_index].file_p;

      IF (entry_external_header_p = NIL) OR (entry_external_header_p^.identification <> c$entry_external_id)
            THEN
        osp$set_status_condition (oce$e_bad_input_file, status);
        osp$append_status_file (osc$status_parameter_delimiter,
              entry_external_file_list_p^.element_value^.file_value^, status);
        RETURN;
      IFEND;

      IF entry_external_header_p^.entry_point_count > 0 THEN
        NEXT entry_external_files_p^ [file_index].entry_point_list_p:
              [1 .. entry_external_header_p^.entry_point_count] IN source_file_list_p^ [file_index].file_p;
        IF entry_external_files_p^ [file_index].entry_point_list_p = NIL THEN
          osp$set_status_condition (oce$premature_eof_in_segment, status);
          osp$append_status_file (osc$status_parameter_delimiter,
                entry_external_file_list_p^.element_value^.file_value^, status);
          RETURN;
        IFEND;
      ELSE
        entry_external_files_p^ [file_index].entry_point_list_p := NIL;
      IFEND;
      IF entry_external_header_p^.external_count > 0 THEN
        NEXT entry_external_files_p^ [file_index].external_list_p:
              [1 .. entry_external_header_p^.external_count] IN source_file_list_p^ [file_index].file_p;
        IF entry_external_files_p^ [file_index].external_list_p = NIL THEN
          osp$set_status_condition (oce$premature_eof_in_segment, status);
          osp$append_status_file (osc$status_parameter_delimiter,
                entry_external_file_list_p^.element_value^.file_value^, status);
          RETURN;
        IFEND;
      ELSE
        entry_external_files_p^ [file_index].external_list_p := NIL;
      IFEND;
      entry_external_file_list_p := entry_external_file_list_p^.link;
    FOREND;

    merge_with_working_file (entry_external_files_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR file_index := 1 TO source_file_count DO
      fsp$close_file (source_file_list_p^ [file_index].file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;
    osp$disestablish_cond_handler;
  PROCEND ocp$_add_reference_file;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_add_task_services', EJECT ??

  PROCEDURE ocp$_add_task_services
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru_addts) add_task_services, addts (
{   product_name, pn: name = $required
{   job_image, ji: file = $required
{   system_debug_table, sdt: file = $required
{   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,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 3, 26, 9, 39, 29, 416],
    clc$command, 7, 4, 3, 0, 0, 0, 4, 'OCM$PRORU_ADDTS'], [
    ['JI                             ',clc$abbreviation_entry, 2],
    ['JOB_IMAGE                      ',clc$nominal_entry, 2],
    ['PN                             ',clc$abbreviation_entry, 1],
    ['PRODUCT_NAME                   ',clc$nominal_entry, 1],
    ['SDT                            ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['SYSTEM_DEBUG_TABLE             ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [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, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [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 3
    [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 4
    [6, 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$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$file_type]],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$product_name = 1,
      p$job_image = 2,
      p$system_debug_table = 3,
      p$status = 4;

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

    VAR
      debug_fid: amt$file_identifier,
      debug_file_p: ^SEQ ( * ),
      debug_header_p: ^pmt$linker_debug_table_header,
      entry_point_fid: amt$file_identifier,
      entry_point_file_p: ^SEQ ( * ),
      entry_point_header_p: ^t$entry_external_file_header,
      entry_point_p: ^t$entry_external,
      found: boolean,
      index: integer,
      job_image_fid: amt$file_identifier,
      job_image_file_p: ^SEQ ( * ),
      job_image_header_p: ^pmt$virtual_memory_image_header,
      new_entry_externals_p: ^t$entry_external_files,
      task_services_address: pmt$segment_and_offset,
      task_services_entry_points_p: ^array [1 .. * ] of oct$task_services_entry_point;

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        fsp$close_file (debug_fid, ignore_status);
        fsp$close_file (job_image_fid, ignore_status);
        close_segment (entry_point_file_p, ignore_status);
        clp$close_display (v$display_control, ignore_status);
        v$output_file_open := FALSE;
        #SPOIL (v$output_file_open);
        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
?? NEWTITLE := 'find_task_services_address', EJECT ??

    PROCEDURE find_task_services_address
      (VAR found: boolean;
       VAR address: pmt$segment_and_offset);

      CONST
        task_services_entry_points = 'LOV$TASK_SERVICES_ENTRY_POINTS';

      VAR
        temp: integer,
        entry_points: ^pmt$entry_point_items,
        lower: pmt$number_of_debug_items,
        upper: pmt$number_of_debug_items,
        mid: pmt$number_of_debug_items;

      found := FALSE;
      IF debug_header_p^.number_of_entry_points = 0 THEN
        RETURN;
      IFEND;

      entry_points := #PTR (debug_header_p^.entry_point_items, debug_file_p^);
      lower := LOWERBOUND (entry_points^);
      upper := UPPERBOUND (entry_points^);
      WHILE (lower <= upper) DO
        temp := lower + upper;
        mid := temp DIV 2;
        IF (entry_points^ [mid].name = task_services_entry_points) THEN
          address := entry_points^ [mid].address;
          found := TRUE;
          RETURN;
        ELSEIF (entry_points^ [mid].name < task_services_entry_points) THEN
          lower := mid + 1;
        ELSE
          upper := mid - 1;
        IFEND;
      WHILEND;

    PROCEND find_task_services_address;
?? OLDTITLE ??
?? NEWTITLE := 'find_task_services_in_image', EJECT ??

    PROCEDURE find_task_services_in_image
      (    task_services_address: pmt$segment_and_offset;
       VAR image_file_p: ^SEQ ( * );
       VAR task_services_entry_points_p: ^array [1 .. * ] of oct$task_services_entry_point;
       VAR status: ost$status);

      VAR
        adaptable_array_p: ^ost$adaptable_array_pointer,
        address_converter: record
          case boolean of
          = TRUE =
            segment_and_offset: pmt$segment_and_offset,
          = FALSE =
            segment_number: ost$segment,
            segment_length: ost$segment_length,
          casend,
        recend,
        first_segment_description_p: ^pmt$linked_segment_description,
        found: boolean,
        hunk_p: ^array [0 .. * ] of cell,
        image_file_header_p: ^pmt$virtual_memory_image_header,
        pva_converter: record
          case boolean of
          = TRUE =
            cell_p: ^cell,
          = FALSE =
            pva: ost$pva,
          casend,
        recend,
        segment_description_p: ^pmt$linked_segment_description;

?? NEWTITLE := 'find_segment', EJECT ??

      PROCEDURE find_segment
        (    segment_number: ost$segment;
             image_file_header_p: ^pmt$virtual_memory_image_header;
         VAR image_file_p: ^SEQ ( * );
         VAR segment_description_p: ^pmt$linked_segment_description;
         VAR found: boolean);

        VAR
          hunk_p: ^array [0 .. * ] of cell,
          index: ost$segment;

        found := FALSE;
        FOR index := 1 TO image_file_header_p^.number_of_segments DO
          NEXT segment_description_p IN image_file_p;
          IF segment_description_p = NIL THEN
            RETURN;
          IFEND;
          IF segment_description_p^.segment_number = segment_number THEN
            found := TRUE;
            RETURN;
          ELSE
            NEXT hunk_p: [0 .. segment_description_p^.length - 1] IN image_file_p;
          IFEND;
        FOREND;

      PROCEND find_segment;

?? OLDTITLE ??
?? EJECT ??

      status.normal := TRUE;
      address_converter.segment_and_offset := task_services_address;

      NEXT image_file_header_p IN image_file_p;
      IF (image_file_header_p = NIL) OR (image_file_header_p^.version <> pmc$image_version) THEN
        osp$set_status_condition (oce$e_bad_input_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$job_image].value^.file_value^, status);
        RETURN;
      IFEND;

      NEXT first_segment_description_p IN image_file_p;
      IF first_segment_description_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$job_image].value^.file_value^, status);
        RETURN;
      IFEND;
      RESET image_file_p TO first_segment_description_p;

      find_segment (address_converter.segment_number, image_file_header_p, image_file_p,
            segment_description_p, found);
      IF NOT found THEN
        osp$set_status_abnormal ('OC', oce$e_section_or_seg_not_found, 'TASK SERVICES', status);
        RETURN;
      IFEND;

      NEXT hunk_p: [0 .. (address_converter.segment_length - 1)] IN image_file_p;
      IF hunk_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$job_image].value^.file_value^, status);
        RETURN;
      IFEND;
      NEXT adaptable_array_p IN image_file_p;
      IF adaptable_array_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$job_image].value^.file_value^, status);
        RETURN;
      IFEND;
      pva_converter.cell_p := adaptable_array_p^.pointer;

      RESET image_file_p TO first_segment_description_p;
      find_segment (pva_converter.pva.seg, image_file_header_p, image_file_p, segment_description_p, found);
      IF NOT found THEN
        osp$set_status_abnormal ('OC', oce$e_section_or_seg_not_found, 'TASK SERVICES', status);
        RETURN;
      IFEND;

      NEXT hunk_p: [0 .. (pva_converter.pva.offset - 1)] IN image_file_p;
      IF hunk_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$job_image].value^.file_value^, status);
        RETURN;
      IFEND;
      NEXT task_services_entry_points_p: [1 .. (adaptable_array_p^.array_size DIV
            adaptable_array_p^.element_size)] IN image_file_p;
      IF task_services_entry_points_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$job_image].value^.file_value^, status);
        RETURN;
      IFEND;
    PROCEND find_task_services_in_image;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;

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

    entry_point_file_p := NIL;
    #SPOIL (entry_point_file_p);
    osp$establish_block_exit_hndlr (^condition_handler);

    open_source_file (pvt [p$system_debug_table].value^.file_value^, debug_file_p, debug_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    #SPOIL (debug_fid);

    NEXT debug_header_p IN debug_file_p;
    IF (debug_header_p = NIL) OR (debug_header_p^.version <> pmc$linker_debug_table_version) THEN
      osp$set_status_condition (oce$e_file_is_not_symbol_table, status);
      osp$append_status_file (osc$status_parameter_delimiter, pvt [p$system_debug_table].value^.file_value^,
            status);
      RETURN;
    IFEND;

    find_task_services_address (found, task_services_address);
    IF NOT found THEN
      osp$set_status_abnormal ('OC', oce$e_section_or_seg_not_found, 'TASK SERVICES', status);
      RETURN;
    IFEND;

    fsp$close_file (debug_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    open_source_file (pvt [p$job_image].value^.file_value^, job_image_file_p, job_image_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    #SPOIL (job_image_fid);

    find_task_services_in_image (task_services_address, job_image_file_p, task_services_entry_points_p,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    open_segment (entry_point_file_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT entry_point_header_p IN entry_point_file_p;
    IF entry_point_header_p = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 029', status);
      RETURN;
    IFEND;
    entry_point_header_p^.identification := c$entry_external_id;
    entry_point_header_p^.entry_point_count := 0;
    entry_point_header_p^.external_count := 0;

    FOR index := 1 TO UPPERBOUND (task_services_entry_points_p^) DO
      entry_point_header_p^.entry_point_count := entry_point_header_p^.entry_point_count + 1;
      NEXT entry_point_p IN entry_point_file_p;
      IF entry_point_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 030', status);
        RETURN;
      IFEND;
      entry_point_p^.name := task_services_entry_points_p^ [index].ep.name;
      entry_point_p^.module_name := 'OSM$TASK_SERVICES';
      entry_point_p^.product_name := pvt [p$product_name].value^.name_value;
      entry_point_p^.language := task_services_entry_points_p^ [index].ep.language;
      entry_point_p^.declaration_matching_required := task_services_entry_points_p^ [index].ep.
            declaration_matching_required;
      entry_point_p^.declaration_matching := task_services_entry_points_p^ [index].ep.declaration_matching;
      IF task_services_entry_points_p^ [index].ep.gated THEN
        entry_point_p^.attributes := $llt$entry_point_attributes
              [llc$gated_entry_point, llc$retain_entry_point];
      ELSE
        entry_point_p^.attributes := $llt$entry_point_attributes [];
      IFEND;
    FOREND;

    fsp$close_file (job_image_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Segments have been verified.  Don't need to check for NIL.

    PUSH new_entry_externals_p: [1 .. 1];
    RESET entry_point_file_p;
    NEXT entry_point_header_p IN entry_point_file_p;
    NEXT new_entry_externals_p^ [1].entry_point_list_p: [1 .. entry_point_header_p^.entry_point_count] IN
          entry_point_file_p;
    new_entry_externals_p^ [1].external_list_p := NIL;
    merge_with_working_file (new_entry_externals_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    close_segment (entry_point_file_p, status);
    osp$disestablish_cond_handler;
  PROCEND ocp$_add_task_services;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_compare_reference_file', EJECT ??

  PROCEDURE ocp$_compare_reference_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru_comrf) compare_reference_file, comrf (
{   reference_type, rt: key
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = $required
{   reference_file, rf: record
{       file: file
{       reference_type: key
{         (entry_point, entry_points, ep)
{         (external_reference, external_references, er)
{       keyend
{     recend = $required
{   cybil_parameter_checking, cpc: (BY_NAME) key
{       (object, o)
{       (source, s)
{     keyend = object
{   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 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$record_type_qualifier,
        field_spec_1: clt$field_specification,
        element_type_spec_1: record
          header: clt$type_specification_header,
        recend,
        field_spec_2: clt$field_specification,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 6] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (6),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 3, 30, 12, 47, 18, 693],
    clc$command, 9, 5, 2, 0, 0, 0, 5, 'OCM$PRORU_COMRF'], [
    ['CPC                            ',clc$abbreviation_entry, 3],
    ['CYBIL_PARAMETER_CHECKING       ',clc$nominal_entry, 3],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OUTPUT                         ',clc$nominal_entry, 4],
    ['REFERENCE_FILE                 ',clc$nominal_entry, 2],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 1],
    ['RF                             ',clc$abbreviation_entry, 2],
    ['RT                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [6, 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, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [5, 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, 311,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [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 5
    [9, 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$keyword_type], [6], [
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 2
    [[1, 0, clc$record_type], [2],
    ['FILE                           ', clc$required_field, 3], [[1, 0, clc$file_type]],
    ['REFERENCE_TYPE                 ', clc$required_field, 229], [[1, 0, clc$keyword_type], [6], [
      ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 1],
      ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 2]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['O                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['OBJECT                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['SOURCE                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'object'],
{ PARAMETER 4
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$reference_type = 1,
      p$reference_file = 2,
      p$cybil_parameter_checking = 3,
      p$output = 4,
      p$status = 5;

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

    CONST
      declared_by = 'Declared By',
      referenced_by = 'Referenced By';

    CONST
      maximum_label_string_size = 13; { referenced_by

    VAR
      compare_fid: amt$file_identifier,
      compare_file_p: ^SEQ ( * ),
      compare_header_p: ^t$entry_external_file_header,
      compare_index: ost$non_negative_integers,
      compare_label: string (maximum_label_string_size),
      compare_list_p: ^t$entry_external_list,
      displayed_mismatch: boolean,
      done: boolean,
      mismatch: boolean,
      object_checking: boolean,
      save_compare_index: ost$non_negative_integers,
      working_index: ost$non_negative_integers,
      working_label: string (maximum_label_string_size),
      working_list_p: ^t$entry_external_list;

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        IF v$output_file_open THEN
          clp$close_display (v$display_control, ignore_status);
          v$output_file_open := FALSE;
          #SPOIL (v$output_file_open);
        IFEND;
        fsp$close_file (compare_fid, ignore_status);


        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
?? NEWTITLE := 'display_entry_external', EJECT ??

{   The purpose of this request is to display the entry/external entry to the output file.

    PROCEDURE display_entry_external
      (    label: string ( * <= maximum_label_string_size);
           entry_external: t$entry_external;
       VAR status: ost$status);

      VAR
        line: string (79);

      status.normal := TRUE;

      line (1, 2) := '';
      line (3, 14) := label;
      line (17, 32) := entry_external.product_name;
      line (49, 31) := entry_external.module_name;
      display_output_string (line, status);
    PROCEND display_entry_external;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;

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

    object_checking := pvt [p$cybil_parameter_checking].value^.keyword_value = 'OBJECT';

{ Determine whether to use entry points or externals.

    IF pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT' THEN
      compare_file_p := v$working_file.entry_points_p;
      IF compare_file_p = NIL THEN
        RETURN;
      IFEND;
      RESET compare_file_p;
      NEXT compare_header_p IN compare_file_p;
      IF (compare_header_p = NIL) OR (compare_header_p^.entry_point_count = 0) THEN
        RETURN;
      IFEND;
      NEXT working_list_p: [1 .. compare_header_p^.entry_point_count] IN compare_file_p;
      IF working_list_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 031', status);
        RETURN;
      IFEND;
      working_label := declared_by;
    ELSE
      compare_file_p := v$working_file.externals_p;
      IF compare_file_p = NIL THEN
        RETURN;
      IFEND;
      RESET compare_file_p;
      NEXT compare_header_p IN compare_file_p;
      IF (compare_header_p = NIL) OR (compare_header_p^.external_count = 0) THEN
        RETURN;
      IFEND;
      NEXT working_list_p: [1 .. compare_header_p^.external_count] IN compare_file_p;
      IF working_list_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 032', status);
        RETURN;
      IFEND;
      working_label := referenced_by;
    IFEND;

    osp$establish_block_exit_hndlr (^condition_handler);

{ Open the reference file and determine whether to use entry points or externals.

    open_source_file (pvt [p$reference_file].value^.field_values^ [1].value^.file_value^, compare_file_p,
          compare_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT compare_header_p IN compare_file_p;
    IF pvt [p$reference_file].value^.field_values^ [2].value^.keyword_value = 'ENTRY_POINT' THEN
      IF (compare_header_p = NIL) OR (compare_header_p^.entry_point_count = 0) THEN
        osp$set_status_condition (oce$missing_or_empty_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
      NEXT compare_list_p: [1 .. compare_header_p^.entry_point_count] IN compare_file_p;
      IF compare_list_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
      compare_label := declared_by;
    ELSE
      IF (compare_header_p = NIL) OR (compare_header_p^.external_count = 0) THEN
        osp$set_status_condition (oce$missing_or_empty_file, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
      IF compare_header_p^.entry_point_count > 0 THEN
        NEXT compare_list_p: [1 .. compare_header_p^.entry_point_count] IN compare_file_p;
        IF compare_list_p = NIL THEN
          osp$set_status_condition (oce$premature_eof_in_segment, status);
          osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].value^.
                field_values^ [1].value^.file_value^, status);
          RETURN;
        IFEND;
      IFEND;
      NEXT compare_list_p: [1 .. compare_header_p^.external_count] IN compare_file_p;
      IF compare_list_p = NIL THEN
        osp$set_status_condition (oce$premature_eof_in_segment, status);
        osp$append_status_file (osc$status_parameter_delimiter, pvt [p$reference_file].
              value^.field_values^ [1].value^.file_value^, status);
        RETURN;
      IFEND;
      compare_label := referenced_by;
    IFEND;

    establish_display_title ('compare_reference_file');

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

    compare_index := 1;
    working_index := 1;

  /compare_entries_and_externals/
    WHILE (working_index <= UPPERBOUND (working_list_p^)) AND (compare_index <= UPPERBOUND (compare_list_p^))
          DO
      IF working_list_p^ [working_index].name = compare_list_p^ [compare_index].name THEN
        save_compare_index := compare_index;
        mismatch := declaration_mismatch (object_checking, working_list_p^ [working_index],
              compare_list_p^ [compare_index]);
        done := FALSE;

{ Determine if there is a mismatch.

        WHILE (compare_index < UPPERBOUND (compare_list_p^)) AND (NOT mismatch) AND (NOT done) DO
          compare_index := compare_index + 1;
          done := working_list_p^ [working_index].name <> compare_list_p^ [compare_index].name;
          IF NOT done THEN
            mismatch := declaration_mismatch (object_checking, working_list_p^ [working_index],
                  compare_list_p^ [compare_index]);
          IFEND;
        WHILEND;

        IF mismatch THEN

{ If there is a mismatch, then display the entry/external name.

          display_output_string (working_list_p^ [working_index].name, status);
          IF NOT status.normal THEN
            EXIT /compare_entries_and_externals/;
          IFEND;

{ Display all entry/externals in the working file that have the same declaration matching value.

          display_entry_external (working_label, working_list_p^ [working_index], status);
          IF NOT status.normal THEN
            EXIT /compare_entries_and_externals/;
          IFEND;

          WHILE (working_index < UPPERBOUND (working_list_p^)) AND
                (working_list_p^ [working_index].name = working_list_p^ [working_index + 1].name) AND
                declaration_values_match (working_list_p^ [working_index],
                working_list_p^ [working_index + 1]) DO
            working_index := working_index + 1;

            display_entry_external ('', working_list_p^ [working_index], status);
            IF NOT status.normal THEN
              EXIT /compare_entries_and_externals/;
            IFEND;

          WHILEND;

{ Display all entry/externals in the reference file for which there is a mismatch.

          compare_index := save_compare_index;
          displayed_mismatch := FALSE;
          WHILE (compare_index <= UPPERBOUND (compare_list_p^)) AND
                (working_list_p^ [working_index].name = compare_list_p^ [compare_index].name) DO
            IF declaration_mismatch (object_checking, working_list_p^ [working_index],
                  compare_list_p^ [compare_index]) THEN
              IF displayed_mismatch THEN
                display_entry_external ('', compare_list_p^ [compare_index], status);
                IF NOT status.normal THEN
                  EXIT /compare_entries_and_externals/;
                IFEND;
              ELSE
                display_entry_external (compare_label, compare_list_p^ [compare_index], status);
                IF NOT status.normal THEN
                  EXIT /compare_entries_and_externals/;
                IFEND;
                displayed_mismatch := TRUE;
              IFEND;
            IFEND;
            compare_index := compare_index + 1;
          WHILEND;
          working_index := working_index + 1;

{ Backup in the reference file if the next working file entry/external has the same name
{ as the one just displayed.

          IF working_index <= UPPERBOUND (working_list_p^) THEN
            WHILE (compare_index > 1) AND (compare_list_p^ [compare_index - 1].
                  name = working_list_p^ [working_index].name) DO
              compare_index := compare_index - 1;
            WHILEND;
          IFEND;
        ELSE { NOT mismatch

{ Skip all entry/externals in the working file for which the name and declaration values match.

          WHILE (working_index < UPPERBOUND (working_list_p^)) AND
                (working_list_p^ [working_index].name = working_list_p^ [working_index + 1].name) AND
                declaration_values_match (working_list_p^ [working_index],
                working_list_p^ [working_index + 1]) DO
            working_index := working_index + 1;
          WHILEND;

          working_index := working_index + 1;

{ Backup in the reference file if the next working file entry/external has the same name
{ as the ones just skipped.

          IF working_index <= UPPERBOUND (working_list_p^) THEN
            WHILE (compare_index > 1) AND (compare_list_p^ [compare_index - 1].
                  name = working_list_p^ [working_index].name) DO
              compare_index := compare_index - 1;
            WHILEND;
          IFEND;
        IFEND;

      ELSEIF working_list_p^ [working_index].name < compare_list_p^ [compare_index].name THEN
        working_index := working_index + 1;

{ Backup in the reference file if the next working file entry/external has the same name
{ as the ones just skipped.

        IF working_index <= UPPERBOUND (working_list_p^) THEN
          WHILE (compare_index > 1) AND (compare_list_p^ [compare_index - 1].
                name = working_list_p^ [working_index].name) DO
            compare_index := compare_index - 1;
          WHILEND;
        IFEND;
      ELSE
        compare_index := compare_index + 1;
      IFEND;
    WHILEND /compare_entries_and_externals/;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    fsp$close_file (compare_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    osp$disestablish_cond_handler;
  PROCEND ocp$_compare_reference_file;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_product_reference_utility', EJECT ??

{ PURPOSE:
{   This is the entry point that begins the product reference utility.

  PROGRAM ocp$_product_reference_utility
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru) product_reference_utility, product_references_utility, proru (
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 3, 19, 20, 3, 54, 198],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'OCM$PRORU'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, 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$status_type]]];

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

    CONST
      p$status = 1;

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

    VAR
      utility_attributes_p: ^clt$utility_attributes;

    status.normal := TRUE;

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

    IF #SIZE (t$entry_external) <> c$entry_external_record_size THEN
      osp$set_status_abnormal ('OC', oce$internal_error,
            'T$ENTRY_EXTERNAL/C$ENTRY_EXTERNAL_RECORD_SIZE mismatch', status);
      RETURN;
    IFEND;

    PUSH utility_attributes_p: [1 .. 5];
    utility_attributes_p^ [1].key := clc$utility_command_search_mode;
    utility_attributes_p^ [1].command_search_mode := clc$global_command_search;
    utility_attributes_p^ [2].key := clc$utility_command_table;
    utility_attributes_p^ [2].command_table := proru_commands;
    utility_attributes_p^ [3].key := clc$utility_prompt;
    utility_attributes_p^ [3].prompt.value := c$utility_prompt;
    utility_attributes_p^ [3].prompt.size := STRLENGTH (c$utility_prompt);
    utility_attributes_p^ [4].key := clc$utility_termination_command;
    utility_attributes_p^ [4].termination_command := 'quit';
    utility_attributes_p^ [5].key := clc$utility_function_proc_table;
    utility_attributes_p^ [5].function_processor_table := proru_functions;

{ Begin the utility environment.  Establish the command list, and scan the
{ command file for commands.

    clp$begin_utility (c$utility_name, utility_attributes_p^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$include_file (clc$current_command_input, c$utility_prompt, c$utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Close the working file segments - a.k.a., cleanup.

    reset_working_file;

{ End the utility environment and exit the utility.

    clp$end_utility (c$utility_name, status);
  PROCEND ocp$_product_reference_utility;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_quit', EJECT ??

  PROCEDURE ocp$_quit
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru_qui) quit, qui (
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 3, 19, 20, 4, 15, 743],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'OCM$PRORU_QUI'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, 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$status_type]]];

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

    CONST
      p$status = 1;

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

    VAR
      ignore_status: ost$status;

    status.normal := TRUE;

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

    clp$end_include (c$utility_name, status);

{ Exit the utility.

  PROCEND ocp$_quit;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_write_reference_file', EJECT ??

  PROCEDURE ocp$_write_reference_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$proru_wrirf) write_reference_file, wrirf (
{   file, f: file = $required
{   discard_working_file, dwf: (BY_NAME) boolean = true
{   reference_type, rt: (BY_NAME) key
{       all
{       (entry_point, entry_points, ep)
{       (external_reference, external_references, er)
{     keyend = all
{   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,
        default_value: string (4),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 7] of clt$keyword_specification,
        default_value: string (3),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 4, 13, 9, 4, 13, 47],
    clc$command, 7, 4, 1, 0, 0, 0, 4, 'OCM$PRORU_WRIRF'], [
    ['DISCARD_WORKING_FILE           ',clc$nominal_entry, 2],
    ['DWF                            ',clc$abbreviation_entry, 2],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['REFERENCE_TYPE                 ',clc$nominal_entry, 3],
    ['RT                             ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 266,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 4
    [7, 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$boolean_type],
    'true'],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [7], [
    ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ENTRY_POINT                    ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['ENTRY_POINTS                   ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['EP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['ER                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['EXTERNAL_REFERENCE             ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['EXTERNAL_REFERENCES            ', clc$alias_entry, clc$normal_usage_entry, 3]]
    ,
    'all'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$file = 1,
      p$discard_working_file = 2,
      p$reference_type = 3,
      p$status = 4;

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

    VAR
      target_entry_external_list_p: ^t$entry_external_list,
      target_fid: amt$file_identifier,
      target_file_header_p: ^t$entry_external_file_header,
      target_file_p: ^SEQ ( * ),
      working_entry_external_list_p: ^t$entry_external_list,
      working_file_header_p: ^t$entry_external_file_header;

?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.
{   Ignore terminate break conditions.  This is considered a "critical section."

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        fsp$close_file (target_fid, ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;
    PROCEND abort_handler;
?? OLDTITLE ??
?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   Attempt to cleanup on block exit if something doesn't work.
{   Ignore terminate break conditions.  This is considered a "critical section."

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

{ Ignore terminate break during a critical section.

      IF (condition.selector = ifc$interactive_condition) AND
            (condition.interactive_condition = ifc$terminate_break) THEN
        RETURN;

      ELSEIF condition.selector = pmc$block_exit_processing THEN
        fsp$close_file (target_fid, ignore_status);
        IF pvt [p$discard_working_file].value^.boolean_value.value THEN
          reset_working_file;
        IFEND;
        RETURN;
      IFEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;

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

    osp$establish_block_exit_hndlr (^abort_handler);

{ Open the file to write the working file to.

    open_target_file (pvt [p$file].value^.file_value^, target_file_p, target_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ The target file has already been reset.  Setup the file header.

    NEXT target_file_header_p IN target_file_p;
    IF target_file_header_p = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 033', status);
      RETURN;
    IFEND;
    target_file_header_p^.identification := c$entry_external_id;

{ Move the working files entry points and externals to the target file.

    IF (v$working_file.entry_points_p <> NIL) AND ((pvt [p$reference_type].value^.keyword_value = 'ALL') OR
          (pvt [p$reference_type].value^.keyword_value = 'ENTRY_POINT')) THEN

      RESET v$working_file.entry_points_p;
      NEXT working_file_header_p IN v$working_file.entry_points_p;
      IF working_file_header_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 034', status);
        RETURN;
      IFEND;
      target_file_header_p^.entry_point_count := working_file_header_p^.entry_point_count;
      IF target_file_header_p^.entry_point_count > 0 THEN
        NEXT target_entry_external_list_p: [1 .. target_file_header_p^.entry_point_count] IN target_file_p;
        IF target_entry_external_list_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 035', status);
          RETURN;
        IFEND;
        NEXT working_entry_external_list_p: [1 .. target_file_header_p^.entry_point_count] IN
              v$working_file.entry_points_p;
        IF working_entry_external_list_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 036', status);
          RETURN;
        IFEND;
        target_entry_external_list_p^ := working_entry_external_list_p^;
      IFEND;
    ELSE
      target_file_header_p^.entry_point_count := 0;
    IFEND;

    IF (v$working_file.externals_p <> NIL) AND ((pvt [p$reference_type].value^.keyword_value = 'ALL') OR
          (pvt [p$reference_type].value^.keyword_value = 'EXTERNAL_REFERENCE')) THEN

      RESET v$working_file.externals_p;
      NEXT working_file_header_p IN v$working_file.externals_p;
      IF working_file_header_p = NIL THEN
        osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 037', status);
        RETURN;
      IFEND;
      target_file_header_p^.external_count := working_file_header_p^.external_count;
      IF target_file_header_p^.external_count > 0 THEN
        NEXT target_entry_external_list_p: [1 .. target_file_header_p^.external_count] IN target_file_p;
        IF target_entry_external_list_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 038', status);
          RETURN;
        IFEND;
        NEXT working_entry_external_list_p: [1 .. target_file_header_p^.external_count] IN
              v$working_file.externals_p;
        IF working_entry_external_list_p = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_storage_allocation_failed, 'NEXT 039', status);
          RETURN;
        IFEND;
        target_entry_external_list_p^ := working_entry_external_list_p^;
      IFEND;
    ELSE
      target_file_header_p^.external_count := 0;
    IFEND;

{ The target file must be positioned at EOI when close is called.

    close_target_file (target_file_p, target_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Discard the current working file if requested.
{ The establishment of this handler overwrites the previous handler.
{ This is considered a critical section.

    osp$establish_condition_handler (^condition_handler, {block_exit} TRUE);
    IF pvt [p$discard_working_file].value^.boolean_value.value THEN
      reset_working_file;
    IFEND;
    osp$disestablish_cond_handler;
  PROCEND ocp$_write_reference_file;
?? OLDTITLE ??
MODEND ocm$product_reference_utility;
